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% 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% 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