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% 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% 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 (MUL (reg 2)) 51 % now we have 32 low bits in REG1, 32 high bits in REG4(=EDX) 52 (*MOVE (reg EDX) ($FLUID *second-value*)) 53 )) 54 55(put 'wxtimes2 'opencode % different version for $pxu/mbarith 56 '((IMUL (reg 2)) 57 (*MOVE (reg 4)($FLUID *second-value*)) 58 )) 59 60(put 'wquotientdouble 'opencode 61 % called with a double length number in params 1 and 2 62 % and a single length number in par 3. 63 % Result is the single length quotient. 64 % the remainder is placed in a fluid variable. 65 '( % adjusting the words first 66 (*MOVE (reg 1) (reg edx)) % high word 67 (*MOVE (reg 2) (reg eax)) % low word 68 (DIV (reg 3)) 69 (*MOVE (reg EDX) ($FLUID *second-value*)) 70 )) 71 72% add and set carry 73% 74% (a + b) -> (carry*,result) 75 76(put 'addAndSetCarry 'opencode 77 '( 78 (ADD (reg 2)(reg 1)) 79 % move cf to carry* 80 (SETC ($FLUID carry*)) 81 )) 82 83% add with carry 84% 85% (a + b + carry*) -> (carry*,result) 86 87(put 'addwithcarry 'opencode 88 '( 89 % move carry* to register CF 90 (*MOVE (wconst 0)(reg 3)) 91 (SUB ($fluid carry*)(reg 3)) 92 % add with carry 93 (ADC (reg 2)(reg 1)) 94 % move cf to carry* 95 (SETC ($FLUID carry*)) 96 )) 97 98% add and add carry 99% 100% (a + b) -> result, (*second-value* + carry) -> *second-value* 101 102(put 'addAndAddCarry 'opencode 103 '( 104 (*move ($FLUID *second-value*) (reg 3)) 105 (*move 0 (reg 4)) 106 % add (reg 2) to (reg 1) 107 (ADD (reg 2)(reg 1)) 108 % add carry to reg 3 109 (ADC (reg 4)(reg 3)) 110 (*move (reg 3) ($FLUID *second-value*)) 111 )) 112 113% subtract with borrow 114% 115% (a - (b + carry!*)) -> result, carry*=1 if borrow 116 117(put 'subtractwithborrow 'opencode 118 '( 119 % move carry* to cf 120 (*MOVE (wconst 0)(reg 3)) 121 (SUB ($fluid carry*)(reg 3)) 122 % subtract with borrow 123 (sbb (reg 2)(reg 1)) 124 % move new borrow to carry* 125 (SETC ($FLUID carry*)) 126 )) 127 128 129%------------------- unsigned greaterp --------------------- 130 131(commentoutcode 132 133 % machine independent version 134 135(put 'ugreaterp 'opencode '( 136 (*move (reg 1)(reg 3)) 137 (*move (reg 2)(reg 4)) 138 (*wshift (reg 1) -1) 139 (*wshift (reg 2) -1) 140 (*jumpnoteq (label ugne)(reg 1)(reg 2)) 141 (*move (reg 3)(reg 1)) 142 (*move (reg 4)(reg 2)) 143 (*wand (reg 1) (wconst 1)) 144 (*wand (reg 2) (wconst 1)) 145ugne 146 (*jumpwgreaterp ugt (reg 1)(reg 2)) 147 (*move (quote nil)(reg 1)) 148 (*jump ugret) 149ugt (*move (quote T) (reg 1)) 150ugret 151)) 152) 153 154% code based on integer carry; 155 156(put 'ugreaterp* 'opencode 157 % returns 1 if arg1 > arg2 unsigned. 158'( (sub (reg 1)(reg 2)) % compare, setting carry if r1>r2 159 (setc (reg 1)) % move carry to low byte 160 (*wand (reg 1) (wconst 1)) % clear leading bits 161)) 162 163(ds ugreaterp(a b)(eq 1 (ugreaterp* a b))) 164 165%--------------------- BIT operations -------------------------- 166 167(put 'wtz 'opencode 168'( (byte 2#00001111) % Instruction (BSF (reg 1)(reg 1)) 169 (byte 2#10111100) 170 (byte 2#11000000) )) 171