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% IBM RS 6000 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(fluid '(*second-value*)) 26 27(bothtimes 28(put 'wdivide 'opencode 29 '((divs (reg 1) (reg 1) (reg 2)) 30 (mfspr (reg 3) (reg mq)) 31 (*move (reg 3) ($fluid *second-value*)))) 32) 33 34(put 'wtimesdouble 'opencode 35 % Called with two parameters of maximum bbase size 36 % the return value are the low order bits of the product. 37 % The high order bits are placed in fluid variable. 38 '(% double length unsigned mutiply; 39 (MUL (reg 3) (reg 1) (reg 2)) 40 (Mfspr (reg 1) (reg mq)) 41 (*WSHIFT (reg 3) 2) 42 (*MOVE (reg 1) (reg 2)) 43 (*WSHIFT (reg 2) -30) 44 (*WOR (reg 3)(reg 2)) 45 (*MOVE (reg 3)($FLUID *second-value*)) 46 (*WSHIFT (reg 1) 2) 47 (*WSHIFT (reg 1) -2) )) 48 49 50(put 'wxtimes2 'opencode % different version for $pxu/mbarith 51 '((MUL (reg 4) (reg 1) (reg 2)) 52 (Mfspr (reg 1) (reg mq)) 53 (*move (reg 4) ($FLUID *second-value*)))) 54 55 56(put 'wquotientdouble 'opencode 57 % called with a double length number in params 1 and 2 58 % and a single length number in par 3. 59 % Result is the single length quotient. 60 % the remainder is placed in a fluid variable. 61 '( % adjusting the words first 62 (*MOVE (reg 1) (reg 4)) 63 (*WSHIFT (reg 1) -2) 64 (*WSHIFT (reg 4) 30) 65 (*WOR (reg 2) (reg 4)) 66 (mtspr (reg mq) (reg 2)) 67 % now we can divide and spread the results 68 (DIV (reg 1) (reg 1) (reg 3)) 69 (mfspr (reg 2) (reg mq)) 70 (*MOVE (reg 2) ($FLUID *second-value*)))) 71 72(fluid '(*second-value*)) 73 74(put 'addcarry 'opencode 75 '((*MOVE ($FLUID carry*) (reg 2)) 76 (*WPLUS2 (reg 1)(reg 2)) 77 (sriq (reg 3) (reg 1) 30) 78 (*MOVE (reg 3) ($FLUID carry*)) 79 (*WSHIFT (reg 1) 2) 80 (*WSHIFT (reg 1) -2))) 81 82(put 'subcarry 'opencode 83 '((*MOVE ($FLUID carry*) (reg 2)) 84 (*WDIFFERENCE (reg 1)(reg 2)) 85 %(*MOVE (reg 1) (reg 2)) 86 %(*WSHIFT (reg 2) -31) 87 (sriq (reg 2) (reg 1) 31) 88 (*MOVE (reg 2) ($FLUID carry*)) 89 (*WSHIFT (reg 2) 30) 90 (*WPLUS2 (reg 1) (reg 2)) 91 )) 92 93 94%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 95% 96% functions supporting word arithmetic with bbase* 97% bbase* is too large to be stored in a fluid cell; 98% so we perform operations with bbase* by shift and mask 99% instructions. 100 101% get the value for bbase* into a register 102(put 'bbase** 'opencode 103% '((*MOVE 1 (reg 1)) 104% (*WSHIFT (reg 1) 30))) 105 '((cau (reg 1) (reg 0) 16#4000 ))) 106 107% get the value for logicalbits* into a register 108(put 'logicalbits** 'opencode 109 '((*MOVE -1 (reg 1)) 110 (*WSHIFT (reg 1) -2))) 111 112% calculate (remainder x bbase*) 113(put 'remainder-bbase 'opencode 114 '((*WSHIFT (reg 1) 2) 115 (*WSHIFT (reg 1) -2))) 116 117% calculate (quotient x bbase*) 118(put 'quotient-bbase 'opencode 119 '((*WSHIFT (reg 1) -30))) 120 121(put 'bbase** 'destroys '((reg 1))) 122(put 'logicalbits** 'destroys '((reg 1))) 123(put 'remainder-bbase 'destroys '((reg 1))) 124(put 'quotient-bbase 'destroys '((reg 1))) 125 126 127