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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
13%
14% Redistribution and use in source and binary forms, with or without
15% modification, are permitted provided that the following conditions are met:
16%
17%    * Redistributions of source code must retain the relevant copyright
18%      notice, this list of conditions and the following disclaimer.
19%    * Redistributions in binary form must reproduce the above copyright
20%      notice, this list of conditions and the following disclaimer in the
21%      documentation and/or other materials provided with the distribution.
22%
23% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
24% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
25% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
27% CONTRIBUTORS
28% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
32% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
33% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34% POSSIBILITY OF SUCH DAMAGE.
35%
36%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37%
38% Double length multiply and divide for the  processor.
39% These are the open codes which embed the extended arithmetic
40% operations such that they are accessible from compiled LISP top level.
41%
42% Full 32 bit version : 28-June 1993 (H. Melenk)
43
44(fluid '(*second-value* carry*))
45
46
47(put 'wtimesdouble 'opencode
48     % Called with two parameters of maximum bbase size
49     % the return value are the low order bits of the product.
50     % The high order bits are placed in fluid variable.
51     '(% double length unsigned mutiply;
52       % reg1:reg2 <- reg1 * reg2
53       (UMULL (reg 1) (reg 2) (reg 1) (reg 2))
54      % now we have 32 low bits in REG1, 32 high bits in REG2
55       (*MOVE (reg 2) ($FLUID *second-value*))
56     ))
57(put 'wtimesdouble 'destroys '((reg 1)(reg 2)))
58
59
60(put 'wxtimes2 'opencode % different version for $pxu/mbarith
61     '((SMULL (reg 1) (reg 2) (reg 1) (reg 2))
62      (*MOVE (reg 2)($FLUID *second-value*))
63      ))
64
65(put 'wquotientdouble 'opencode
66      % called with a double length number in params 1 and 2
67      % (high word in (reg 1), low word in (reg 2))
68      % and a single length number in par 3.
69      % Result is the single length quotient.
70      % the remainder is placed in a fluid variable.
71      '(% to pass a 64 bit number, load high word in (reg 2) and low word in (reg 1)
72	(*Move (reg 1) (reg 4))
73	(*Move (reg 2) (reg 1))
74	(*Move (reg 4) (reg 2))
75        % load address of fluid variable in (reg 4)
76        (*Move (idloc *second-value*) (reg 4))
77	(ADD (reg 4) (reg symval) (regshifted 4 LSL 2))
78        (*Call wxquotientdouble)
79      ))
80
81% add and set carry
82%
83%   (a + b) -> (carry*,result)
84
85(put 'addAndSetCarry 'opencode
86       '(
87         (ADDS (reg 1) (reg 2) (reg 1))
88           % move cf to carry*
89         (MOVCC (reg t1) 0)
90         (MOVCS (reg t1) 1)
91         (*Move (reg t1) ($FLUID carry*))
92       ))
93(put 'addAndSetCarry 'destroys '((reg 1)))
94
95
96% add with carry
97%
98%   (a + b + carry*) -> (carry*,result)
99
100(put 'addwithcarry 'opencode
101       '(
102           % move carry* to register CF
103	 (*Move ($fluid carry*) (reg t1))
104         (MOVS (reg t1) (regshifted t1 LSR 1)) % shifted out bit goes into carry flag
105           % add with carry
106         (ADCS (reg 1) (reg 2) (reg 1))
107           % move cf to carry*
108         (MOVCC (reg t1) 0)
109         (MOVCS (reg t1) 1)
110         (*Move (reg t1) ($FLUID carry*))
111       ))
112(put 'addWithCarry 'destroys '((reg 1)))
113
114% add and add carry
115%
116%   (a + b) -> result,  (*second-value* + carry) -> *second-value*
117
118(put 'addAndAddCarry 'opencode
119       '(
120         (ADDS (reg 1) (reg 2) (reg 1))
121         (*move ($FLUID *second-value*) (reg 2))
122         (ADC (reg 2) (reg 2) (wconst 0))
123         (*move (reg 2) ($FLUID *second-value*))
124       ))
125(put 'addAndAddCarry 'destroys '((reg 1)(reg 2)))
126
127% subtract with borrow
128%
129%  (a - (b + carry!*)) -> result, carry*=1 if borrow
130
131(put 'subtractwithborrow 'opencode
132       '(
133           % move carry* to cf
134	 (*Move ($fluid carry*) (reg t1))
135         (RSBS (reg t1) (reg t1) (wconst 0))
136           % subtract with borrow
137         (SBCS (reg 1) (reg 1) (reg 2))
138           % move new borrow to carry*
139         (MOVHS (reg t1) 0)
140         (MOVLO (reg t1) 1)
141         (*Move (reg t1) ($FLUID carry*))
142       ))
143(put 'subtractwithborrow 'destroys '((reg 1)))
144
145
146%------------------- unsigned greaterp ---------------------
147
148% code based on integer carry;
149
150(put 'ugreaterp* 'opencode
151   % returns 1 if arg1 > arg2 unsigned.
152'( (RSBS (reg 1) (reg 1) (reg 2))        % compare, setting carry if r1>r2
153     % move carry to lowest bit
154   (MOVHS (reg 1) 0)
155   (MOVLO (reg 1) 1)
156))
157(ds ugreaterp(a b)(eq 1 (ugreaterp* a b)))
158
159(commentoutcode
160(put 'ugreaterp 'opencode
161   % returns 1 if arg1 > arg2 unsigned.
162'( (RSBS (reg 1) (reg 1) (reg 2))        % compare, setting carry if r1>r2
163     % load nil or t depending on carry
164   (MOVHI (reg 1) (reg nil))
165   (SUBLS (reg 1) (reg nil) (wconst nil-t-diff*))
166))
167
168 )
169
170
171