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