source: trunk/ccl/level-0/PPC/PPC64/ppc64-bignum.lisp @ 6009

Last change on this file since 6009 was 6009, checked in by gb, 13 years ago

Typo in comment.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.7 KB
Line 
1;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17
18(in-package "CCL")
19
20;;; The caller has allocated a two-digit bignum (quite likely on the stack).
21;;; If we can fit in a single digit (if the high word is just a sign
22;;; extension of the low word), truncate the bignum in place (the
23;;; trailing words should already be zeroed.
24(defppclapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
25  (unbox-fixnum imm0 fixnum)
26  (srdi imm1 imm0 32)
27  (srawi imm2 imm0 31)
28  (cmpw imm2 imm1)
29  (stw imm0 ppc64::misc-data-offset bignum)
30  (li imm2 ppc64::one-digit-bignum-header)
31  (beq @chop)
32  (stw imm1 (+ ppc64::misc-data-offset 4) bignum)
33  (blr)
34  @chop
35  (std imm2 ppc64::misc-header-offset bignum)
36  (blr))
37 
38
39
40;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.
41;;; Add the 32-bit "prev" digit and the 32-bit carry-in digit to that 64-bit
42;;; result; return the halves as (VALUES high low).
43(defppclapfunction %multiply-and-add4 ((x 0) (y arg_x) (prev arg_y) (carry-in arg_z))
44  (let ((unboxed-x imm0)
45        (unboxed-y imm1)
46        (unboxed-prev imm2)
47        (unboxed-carry-in imm3)
48        (result64 imm4)
49        (high arg_y)
50        (low arg_z))
51    (ld temp0 x vsp)
52    (unbox-fixnum unboxed-x temp0)
53    (unbox-fixnum unboxed-y y)
54    (unbox-fixnum unboxed-prev prev)
55    (unbox-fixnum unboxed-carry-in carry-in)
56    (mulld result64 unboxed-x unboxed-y)
57    (add result64 result64 unboxed-prev)
58    (add result64 result64 unboxed-carry-in)
59    (clrlsldi low result64 32 ppc64::fixnumshift)
60    (clrrdi high result64 32)
61    (srdi high high (- 32 ppc64::fixnumshift))
62    (std high 0 vsp)
63    (set-nargs 2)
64    (vpush low)
65    (la temp0 '2 vsp)
66    (ba .SPvalues)))
67
68(defppclapfunction %multiply-and-add3 ((x arg_x) (y arg_y) (carry-in arg_z))
69  (let ((unboxed-x imm0)
70        (unboxed-y imm1)
71        (unboxed-carry-in imm2)
72        (result64 imm3)
73        (high arg_y)
74        (low arg_z))
75    (unbox-fixnum unboxed-x arg_x)
76    (unbox-fixnum unboxed-y y)
77    (unbox-fixnum unboxed-carry-in carry-in)
78    (mulld result64 unboxed-x unboxed-y)
79    (add result64 result64 unboxed-carry-in)
80    (clrlsldi low result64 32 ppc64::fixnumshift)
81    (clrrdi high result64 32)
82    (srdi high high (- 32 ppc64::fixnumshift))
83    (vpush high)
84    (set-nargs 2)
85    (vpush low)
86    (la temp0 '2 vsp)
87    (ba .SPvalues)))
88
89;;; Return the (possibly truncated) 32-bit quotient and remainder
90;;; resulting from dividing hi:low by divisor.
91(defppclapfunction %floor ((num-high arg_x) (num-low arg_y) (divisor arg_z))
92  (let ((unboxed-num imm0)
93        (unboxed-low imm1)
94        (unboxed-divisor imm2)
95        (unboxed-quo imm3)
96        (unboxed-rem imm4))
97    (sldi unboxed-num num-high (- 32 ppc64::fixnumshift))
98    (unbox-fixnum unboxed-low num-low)
99    (unbox-fixnum unboxed-divisor divisor)
100    (or unboxed-num unboxed-low unboxed-num)
101    (divdu unboxed-quo unboxed-num unboxed-divisor)
102    (mulld unboxed-rem unboxed-quo unboxed-divisor)
103    (sub unboxed-rem unboxed-num unboxed-rem)
104    (clrlsldi arg_y unboxed-quo 32 ppc64::fixnumshift)
105    (clrlsldi arg_z unboxed-rem 32 ppc64::fixnumshift)
106    (mr temp0 vsp)
107    (vpush arg_y)
108    (vpush arg_z)
109    (set-nargs 2)
110    (ba .SPvalues)))
111
112;;; Multiply two (UNSIGNED-BYTE 32) arguments, return the high and
113;;; low halves of the 64-bit result
114(defppclapfunction %multiply ((x arg_y) (y arg_z))
115  (let ((unboxed-x imm0)
116        (unboxed-y imm1)
117        (unboxed-high imm2)
118        (unboxed-low imm3))
119    (unbox-fixnum unboxed-x x)
120    (unbox-fixnum unboxed-y y)
121    (mulld imm2 unboxed-x unboxed-y)
122    (clrlsldi arg_y imm2 32 ppc64::fixnumshift) ; arg_y = low32
123    (srdi imm2 imm2 32)
124    (box-fixnum arg_z imm2)             ; arg_z = high32
125    (mr temp0 vsp)
126    (vpush arg_z)
127    (set-nargs 2)
128    (vpush arg_y)
129    (ba .SPvalues)))
130
131;;; Any words in the "tail" of the bignum should have been
132;;; zeroed by the caller.
133(defppclapfunction %set-bignum-length ((newlen arg_y) (bignum arg_z))
134  (sldi imm0 newlen (- ppc64::num-subtag-bits ppc64::fixnumshift))
135  (ori imm0 imm0 ppc64::subtag-bignum)
136  (std imm0 ppc64::misc-header-offset bignum)
137  (blr))
138
139;;; Count the sign bits in the most significant digit of bignum;
140;;; return fixnum count.
141(defppclapfunction %bignum-sign-bits ((bignum arg_z))
142  (vector-size imm0 bignum imm0)
143  (sldi imm0 imm0 2)
144  (la imm0 (- ppc64::misc-data-offset 4) imm0) ; Reference last (most significant) digit
145  (lwzx imm0 bignum imm0)
146  (cmpwi imm0 0)
147  (not imm0 imm0)
148  (blt @wasneg)
149  (not imm0 imm0)
150  @wasneg
151  (cntlzw imm0 imm0)
152  (box-fixnum arg_z imm0)
153  (blr))
154
155(defppclapfunction %signed-bignum-ref ((bignum arg_y) (index arg_z))
156  (srdi imm0 index 1)
157  (la imm0 ppc64::misc-data-offset imm0)
158  (lwax imm0 bignum imm0)
159  (box-fixnum arg_z imm0)
160  (blr))
161
162
163;;; If the bignum is a one-digit bignum, return the value of the
164;;; single digit as a fixnum.  Otherwise, if it's a two-digit-bignum
165;;; and the two words of the bignum can be represented in a fixnum,
166;;; return that fixnum; else return nil.
167(defppclapfunction %maybe-fixnum-from-one-or-two-digit-bignum ((bignum arg_z))
168  (ld imm1 ppc64::misc-header-offset bignum)
169  (cmpdi cr1 imm1 ppc64::one-digit-bignum-header)
170  (cmpdi cr2 imm1 ppc64::two-digit-bignum-header)
171  (beq cr1 @one)
172  (bne cr2 @no)
173  (ld imm0 ppc64::misc-data-offset bignum)
174  (rotldi imm0 imm0 32)
175  (box-fixnum arg_z imm0)
176  (unbox-fixnum imm1 arg_z)
177  (cmpd imm0 imm1)
178  (beqlr)
179  @no
180  (li arg_z nil)
181  (blr)
182  @one
183  (lwa imm0 ppc64::misc-data-offset bignum)
184  (box-fixnum arg_z imm0)
185  (blr))
186
187
188(defppclapfunction %digit-logical-shift-right ((digit arg_y) (count arg_z))
189  (unbox-fixnum imm0 digit)
190  (unbox-fixnum imm1 count)
191  (srw imm0 imm0 imm1)
192  (box-fixnum arg_z imm0)
193  (blr))
194
195(defppclapfunction %ashr ((digit arg_y) (count arg_z))
196  (unbox-fixnum imm0 digit)
197  (unbox-fixnum imm1 count)
198  (sraw imm0 imm0 imm1)
199  (box-fixnum arg_z imm0)
200  (blr))
201
202(defppclapfunction %ashl ((digit arg_y) (count arg_z))
203  (unbox-fixnum imm0 digit)
204  (unbox-fixnum imm1 count)
205  (slw imm0 imm0 imm1)
206  (clrlsldi arg_z imm0 32 ppc64::fixnumshift)
207  (blr))
208
209(defppclapfunction macptr->fixnum ((ptr arg_z))
210  (macptr-ptr imm0 ptr)
211  (andi. imm1 imm0 7)
212  (li arg_z nil)
213  (bne @done)
214  (mr arg_z imm0)
215  @done
216  (blr))
217
218(defppclapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
219  (let ((w1 imm0)
220        (w2 imm1))
221    (ld w2 ppc64::misc-data-offset big)
222    (unbox-fixnum  w1 fix)
223    (rotldi w2 w2 32)
224    (cmpdi dest nil)
225    (and w1 w1 w2)
226    (bne @store)
227    (box-fixnum arg_z w1)
228    (blr)
229    @store
230    (rotldi w1 w1 32)
231    (std w1 ppc64::misc-data-offset dest)
232    (blr)))
233
234
235
236(defppclapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z))
237  (cmpdi dest nil)
238  (ld imm1 ppc64::misc-data-offset big)
239  (unbox-fixnum imm0 fix)
240  (rotldi imm1 imm1 32)
241  (andc imm1 imm0 imm1)
242  (bne @store)
243  (box-fixnum arg_z imm1)
244  (blr)
245  @store
246  (rotldi imm1 imm1 32)
247  (std imm1 ppc64::misc-data-offset dest)
248  (blr))
249
250(defppclapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z))
251  (cmpdi dest nil)
252  (ld imm1 ppc64::misc-data-offset big)
253  (unbox-fixnum imm0 fix)
254  (rotldi imm1 imm1 32)
255  (andc imm1 imm1 imm0)
256  (bne @store)
257  (box-fixnum arg_z imm1)
258  (blr)
259  @store
260  (rotldi imm1 imm1 32)
261  (std imm1 ppc64::misc-data-offset dest)
262  (blr))
263
264
Note: See TracBrowser for help on using the repository browser.