1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PXC/MULS32.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% Mode: Lisp 10% Status: Open Source: BSD License 11% 12% Redistribution and use in source and binary forms, with or without 13% modification, are permitted provided that the following conditions are met: 14% 15% * Redistributions of source code must retain the relevant copyright 16% notice, this list of conditions and the following disclaimer. 17% * Redistributions in binary form must reproduce the above copyright 18% notice, this list of conditions and the following disclaimer in the 19% documentation and/or other materials provided with the distribution. 20% 21% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 22% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 23% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 24% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR 25% CONTRIBUTORS 26% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 27% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 28% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 29% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 30% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 31% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32% POSSIBILITY OF SUCH DAMAGE. 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% 39% Full 32 bit version : 28-June 1993 (H. Melenk) 40 41(fluid '(*second-value* carry*)) 42 43 44(put 'wtimesdouble 'opencode 45 % Called with two parameters of maximum bbase size 46 % the return value are the low order bits of the product. 47 % The high order bits are placed in fluid variable. 48 '(% double length unsigned mutiply; 49 % EDX:EAX <- EAX * reg 50 (*move (reg 4)(reg t1)) % save this reg 51 (MUL (reg 2)) 52 % now we have 32 low bits in REG1, 32 high bits in REG4(=EDX) 53 (*MOVE (reg EDX) ($FLUID *second-value*)) 54 (*move (reg t1)(reg 4)) % restore 55 )) 56(put 'addAndSetCarry 'destroys '((reg 1)(reg 3))) 57 58 59(put 'wxtimes2 'opencode % different version for $pxu/mbarith 60 '((IMUL (reg 2)) 61 (*MOVE (reg 4)($FLUID *second-value*)) 62 )) 63 64(put 'wquotientdouble 'opencode 65 % called with a double length number in params 1 and 2 66 % and a single length number in par 3. 67 % Result is the single length quotient. 68 % the remainder is placed in a fluid variable. 69 '( % adjusting the words first 70 (*MOVE (reg 1) (reg edx)) % high word 71 (*MOVE (reg 2) (reg eax)) % low word 72 (DIV (reg 3)) 73 (*MOVE (reg EDX) ($FLUID *second-value*)) 74 )) 75 76% add and set carry 77% 78% (a + b) -> (carry*,result) 79 80(put 'addAndSetCarry 'opencode 81 '( 82 (ADD (reg 2)(reg 1)) 83 % move cf to carry* 84 (SETC ($FLUID carry*)) 85 )) 86(put 'addAndSetCarry 'destroys '((reg 1))) 87 88 89% add with carry 90% 91% (a + b + carry*) -> (carry*,result) 92 93(put 'addwithcarry 'opencode 94 '( 95 % move carry* to register CF 96 (*MOVE (wconst 0)(reg t1)) 97 (SUB ($fluid carry*)(reg t1)) 98 % add with carry 99 (ADC (reg 2)(reg 1)) 100 % move cf to carry* 101 (SETC ($FLUID carry*)) 102 )) 103(put 'addWithCarry 'destroys '((reg 1))) 104 105% add and add carry 106% 107% (a + b) -> result, (*second-value* + carry) -> *second-value* 108 109(put 'addAndAddCarry 'opencode 110 '( 111 (ADD (reg 2)(reg 1)) 112 (*move ($FLUID *second-value*) (reg 2)) 113 (ADC (wconst 0)(reg 2)) 114 (*move (reg 2) ($FLUID *second-value*)) 115 )) 116(put 'addAndAddCarry 'destroys '((reg 1)(reg 2))) 117 118% subtract with borrow 119% 120% (a - (b + carry!*)) -> result, carry*=1 if borrow 121 122(put 'subtractwithborrow 'opencode 123 '( 124 % move carry* to cf 125 (*MOVE (wconst 0)(reg t1)) 126 (SUB ($fluid carry*)(reg t1)) 127 % subtract with borrow 128 (sbb (reg 2)(reg 1)) 129 % move new borrow to carry* 130 (SETC ($FLUID carry*)) 131 )) 132(put 'subtractwithborrow 'destroys '((reg 1))) 133 134 135%------------------- unsigned greaterp --------------------- 136 137% code based on integer carry; 138 139(put 'ugreaterp* 'opencode 140 % returns 1 if arg1 > arg2 unsigned. 141'( (sub (reg 1)(reg 2)) % compare, setting carry if r1>r2 142 (setc (reg 1)) % move carry to low byte 143 (*wand (reg 1) (wconst 1)) % clear leading bits 144)) 145(ds ugreaterp(a b)(eq 1 (ugreaterp* a b))) 146 147 148