1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PXU:MULS.SL 4% Description: support for BIGNUM package with double INUM operations 5% lap source for MIPS processor 6% Author: H. Melenk, W. Neun 7% Created: 25 January 1989 8% Modified: 9% Mode: Lisp 10% Package: Utilities 11% Status: Experimental 12% 13% (c) Copyright 1989, Konrad-Zuse-Zentrum, all rights reserved. 14% 15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 16% Mac G4 version by W. Neun, ZIB Berlin 17% 18% this file is needed compiletime only 19% 20% Double length multiply and divide for the 68020 processor. 21% These are the open codes which embed the extended arithmetic 22% operations such that they are accessible from compiled LISP top level. 23% They map the 2*30 bit operations needed by BIG to the 2*32 bit operations 24% of the processor by shifting etc. 25 26(compiletime (load inum)) 27 28(fluid '(*second-value*)) 29 30(bothtimes 31(put 'wdivide 'opencode 32 '((divd (reg 3) (reg 1) (reg 2)) 33 (mulld (reg 4) (reg 3) (reg 2)) 34 (subf (reg 4) (reg 4) (reg 1)) 35 (*move (reg 3) (reg 1)) 36 (*move (reg 4) ($fluid *second-value*)))) 37) 38 39(put 'wtimesdouble 'opencode 40 % Called with two parameters of maximum bbase size 41 % the return value are the low order bits of the product. 42 % The high order bits are placed in fluid variable. 43 '(% double length unsigned mutiply; 44 (mulhd (reg 3) (reg 1) (reg 2)) 45 (mulld (reg 1) (reg 1) (reg 2)) 46 (*WSHIFT (reg 3) 2) 47 (*MOVE (reg 1) (reg 2)) 48 (*WSHIFT (reg 2) -62) 49 (*WOR (reg 3)(reg 2)) 50 (*MOVE (reg 3)($FLUID *second-value*)) 51 (*WSHIFT (reg 1) 2) 52 (*WSHIFT (reg 1) -2) )) 53 54 55(put 'wxtimes2 'opencode % different version for $pxu/mbarith 56 '((MULhd (reg 4) (reg 1) (reg 2)) 57 (mulld (reg 1) (reg 1) (reg 2)) 58 (*move (reg 4) ($FLUID *second-value*)))) 59 60 61(de wquotientdouble (arg1 arg2 arg3) 62 63 (prog (quot rem carrybit i) 64 65 % first divide the uper 30 bits by divisor and put the 66 % quotient into the result and continue with the remainder 67 68 (setq quot (wdivide arg1 arg3)) 69 (setq rem *second-value*) 70 71 (setq arg2 (wshift arg2 2)) %initial shift 72 73 (ifor (from i 0 61 1) (do 74 75 % now shift the remainder left by 1 and add the most significant 76 % bit of arg2. shift arg2 left one bit 77 % if sum is greater or equal divisor, add a bit '1' to remainder 78 % else add a '0'. 79 % do it until arg2 is eaten up. quot is the result (quotient), 80 % rem is the remainder (in *second-value*) 81 82 (progn 83 (setq quot (wshift quot 1)) 84 (setq carrybit (wshift arg2 -63)) 85 (setq arg2 (wshift arg2 1)) 86 (setq rem (wplus2 (wshift rem 1) carrybit)) 87 (when (wgeq rem arg3) (setq rem (wdifference rem arg3)) 88 (setq quot (wplus2 quot 1))) 89 ) ) ) 90 (setq *second-value* rem) 91 (return quot))) 92) 93 94(commentoutcode 95(put 'wquotientdouble 'opencode 96 % called with a double length number in params 1 and 2 97 % and a single length number in par 3. 98 % Result is the single length quotient. 99 % the remainder is placed in a fluid variable. 100 '( % adjusting the words first 101 (*MOVE (reg 1) (reg 4)) 102 (*WSHIFT (reg 1) -2) 103 (*WSHIFT (reg 4) 30) 104 (*WOR (reg 2) (reg 4)) 105 (mtspr (reg mq) (reg 2)) 106 % now we can divide and spread the results 107 %% (DIV (reg 1) (reg 1) (reg 3)) 108 (mfspr (reg 2) (reg mq)) 109 (*MOVE (reg 2) ($FLUID *second-value*))))) 110 111(fluid '(*second-value*)) 112 113(put 'addcarry 'opencode 114 '((*MOVE ($FLUID carry*) (reg 2)) 115 (*WPLUS2 (reg 1)(reg 2)) 116 (rldicl (reg 3) (reg 1) 2 62) 117 (*MOVE (reg 3) ($FLUID carry*)) 118 (*WSHIFT (reg 1) 2) 119 (*WSHIFT (reg 1) -2))) 120 121(put 'subcarry 'opencode 122 '((*MOVE ($FLUID carry*) (reg 2)) 123 (*WDIFFERENCE (reg 1)(reg 2)) 124 %(*MOVE (reg 1) (reg 2)) 125 %(*WSHIFT (reg 2) -31) 126 (rldicl (reg 2) (reg 1) 1 63) 127 (*MOVE (reg 2) ($FLUID carry*)) 128 (*WSHIFT (reg 2) 62) 129 (*WPLUS2 (reg 1) (reg 2)) 130 )) 131 132 133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 134% 135% functions supporting word arithmetic with bbase* 136% bbase* is too large to be stored in a fluid cell; 137% so we perform operations with bbase* by shift and mask 138% instructions. 139 140% get the value for bbase* into a register 141(put 'bbase** 'opencode 142 '((*MOVE 1 (reg 1)) 143 (*WSHIFT (reg 1) 62))) 144 145% get the value for logicalbits* into a register 146(put 'logicalbits** 'opencode 147 '((*MOVE -1 (reg 1)) 148 (*WSHIFT (reg 1) -2))) 149 150% calculate (remainder x bbase*) 151(put 'remainder-bbase 'opencode 152 '((*WSHIFT (reg 1) 2) 153 (*WSHIFT (reg 1) -2))) 154 155% calculate (quotient x bbase*) 156(put 'quotient-bbase 'opencode 157 '((*WSHIFT (reg 1) -62))) 158 159(put 'bbase** 'destroys '((reg 1))) 160(put 'logicalbits** 'destroys '((reg 1))) 161(put 'remainder-bbase 'destroys '((reg 1))) 162(put 'quotient-bbase 'destroys '((reg 1))) 163 164 165