1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PXC/MULS.SL 4% Description: support for BIGNUM package with double INUM operations 5% lap source for 80386 processor 6% Author: H. Melenk 7% Created: 11 Sept 1989 8% Modified: 9% Status: Open Source: BSD License 10% 11% Redistribution and use in source and binary forms, with or without 12% modification, are permitted provided that the following conditions are met: 13% 14% * Redistributions of source code must retain the relevant copyright 15% notice, this list of conditions and the following disclaimer. 16% * Redistributions in binary form must reproduce the above copyright 17% notice, this list of conditions and the following disclaimer in the 18% documentation and/or other materials provided with the distribution. 19% 20% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 22% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 23% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR 24% CONTRIBUTORS 25% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 26% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 27% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 28% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 29% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 30% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31% POSSIBILITY OF SUCH DAMAGE. 32% 33%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 34% 35% Double length multiply and divide for the processor. 36% These are the open codes which embed the extended arithmetic 37% operations such that they are accessible from compiled LISP top level. 38% They map the 2*30 bit operations needed by BIG to the 2*32 bit operations 39% of the processor by shifting etc. 40(fluid '(*second-value*)) 41 42 43(put 'wtimesdouble 'opencode 44 % Called with two parameters of maximum bbase size 45 % the return value are the low order bits of the product. 46 % The high order bits are placed in fluid variable. 47 '(% double length unsigned mutiply; 48 % EDX:EAX <- EAX * reg 49 (MUL (reg 2)) 50 % now we have 32 low bits in REG1, 32 high bits in REG4(=EDX) 51 (*MOVE (reg EDX) (reg 3)) 52 (*WSHIFT (reg 3) 2) 53 (*MOVE (reg 1) (reg 2)) 54 (*WSHIFT (reg 2) -30) 55 (*WOR (reg 3)(reg 2)) 56 (*MOVE (reg 3)($FLUID *second-value*)) 57 (*WSHIFT (reg 1) 2) 58 (*WSHIFT (reg 1) -2) )) 59 60(put 'wxtimes2 'opencode % different version for $pxu/mbarith 61 '((IMUL (reg 2)) 62 (*MOVE (reg 4)($FLUID *second-value*)) 63 )) 64 65(put 'wquotientdouble 'opencode 66 % called with a double length number in params 1 and 2 67 % and a single length number in par 3. 68 % Result is the single length quotient. 69 % the remainder is placed in a fluid variable. 70 '( % adjusting the words first 71 (*MOVE (reg 1) (reg 4)) 72 (*WSHIFT (reg 1) -2) 73 (*WSHIFT (reg 4) 30) 74 (*WOR (reg 2) (reg 4)) 75 % EDX:EAX / reg, EAX=Quo, EDX=Rem 76 (*MOVE (reg 1) (reg EDX)) % EDX 77 (*MOVE (reg 2) (reg EAX)) % EAX 78 (DIV (reg 3)) 79 (*MOVE (reg EDX) ($FLUID *second-value*)) 80 (*MOVE (reg EAX) (reg 1)))) 81 82(put 'addcarry 'opencode 83 '( 84 (*MOVE ($FLUID carry*) (reg 2)) 85 (*WPLUS2 (reg 1)(reg 2)) 86 (*MOVE (reg 1)(reg 3)) 87 (*WSHIFT (reg 3) -30) 88 (*MOVE (reg 3) ($FLUID carry*)) 89 (*WSHIFT (reg 1) 2) 90 (*WSHIFT (reg 1) -2))) 91 92(put 'subcarry 'opencode 93 '( 94 (*MOVE ($FLUID carry*) (reg 2)) 95 (*WDIFFERENCE (reg 1)(reg 2)) 96 (*MOVE (reg 1) (reg 2)) 97 (*WSHIFT (reg 2) -31) 98 (*MOVE (reg 2) ($FLUID carry*)) 99 (*WSHIFT (reg 2) 30) 100 (*WPLUS2 (reg 1) (reg 2)) 101 )) 102 103 104 105%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 106% 107% functions supporting word arithmetic with bbase* 108% bbase* is too large to be stored in a fluid cell; 109% so we perform operations with bbase* by shift and mask 110% instructions. 111 112% get the value for bbase* into a register 113(put 'bbase** 'opencode 114 '((*MOVE 1 (reg 1)) 115 (*WSHIFT (reg 1) 30))) 116 117% get the value for logicalbits* into a register 118(put 'logicalbits** 'opencode 119 '((*MOVE -1 (reg 1)) 120 (*WSHIFT (reg 1) -2))) 121 122% calculate (remainder x bbase*) 123(put 'remainder-bbase 'opencode 124 '((*WSHIFT (reg 1) 2) 125 (*WSHIFT (reg 1) -2))) 126 127% calculate (quotient x bbase*) 128(put 'quotient-bbase 'opencode 129 '((*WSHIFT (reg 1) -30))) 130 131(put 'bbase** 'destroys '((reg 1))) 132(put 'logicalbits** 'destroys '((reg 1))) 133(put 'remainder-bbase 'destroys '((reg 1))) 134(put 'quotient-bbase 'destroys '((reg 1))) 135 136 137