source: trunk/source/level-0/PPC/ppc-hash.lisp @ 15521

Last change on this file since 15521 was 15521, checked in by gb, 7 years ago

Do STRIP-TAG-TO-FIXNUM the same way on all platforms: clear the
argument's tag bits (making it an even fixnum) and then logically
shift right 1 bit.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.4 KB
Line 
1;;; -*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18;;; level-0;ppc;ppc-hash.lisp
19
20
21(in-package "CCL")
22
23(eval-when (:compile-toplevel :execute)
24  (require "HASHENV" "ccl:xdump;hashenv"))
25
26
27
28
29;;; This should stay in LAP so that it's fast
30;;; Equivalent to cl:mod when both args are positive fixnums
31(defppclapfunction fast-mod ((number arg_y) (divisor arg_z))
32  #+ppc32-target
33  (progn
34    (divwu imm0 number divisor)
35    (mullw arg_z imm0 divisor))
36  #+ppc64-target
37  (progn
38    (divdu imm0 number divisor)
39    (mulld arg_z imm0 divisor))
40  (subf arg_z arg_z number)
41  (blr))
42
43
44(defppclapfunction fast-mod-3 ((number arg_x) (divisor arg_y) (recip arg_z))
45  #+ppc32-target
46  (progn
47    (srwi imm0 number ppc32::fixnumshift)
48    (mulhw imm1 imm0 recip)
49    (mullw imm0 imm1 divisor))
50  #+ppc64-target
51  (progn
52    (srdi imm0 number ppc64::fixnumshift)
53    (mulhd imm1 imm0 recip)
54    (mulld imm0 imm1 divisor))
55  (sub number number imm0)
56  (sub number number divisor)
57  (srari imm0 number (1- target::nbits-in-word))
58  (and divisor divisor imm0)
59  (add arg_z number divisor)
60  (blr))
61
62#+ppc32-target
63(defppclapfunction %dfloat-hash ((key arg_z))
64  (lwz imm0 ppc32::double-float.value key)
65  (lwz imm1 ppc32::double-float.val-low key)
66  (add imm0 imm0 imm1)
67  (box-fixnum arg_z imm0)
68  (blr))
69
70#+ppc64-target
71(defppclapfunction %dfloat-hash ((key arg_z))
72  (ld imm0 ppc64::double-float.value key)
73  (box-fixnum arg_z imm0)
74  (blr))
75
76#+ppc32-target
77(defppclapfunction %sfloat-hash ((key arg_z))
78  (lwz imm0 ppc32::single-float.value key)
79  (box-fixnum arg_z imm0)
80  (blr))
81
82#+ppc64-target
83(defppclapfunction %sfloat-hash ((key arg_z))
84  (lis imm0 #x8000)
85  (srdi imm1 key 32)
86  (cmpw imm0 imm1)
87  (srdi arg_z key (- 32 ppc64::fixnumshift))
88  (bnelr)
89  (li arg_z 0)
90  (blr))
91
92(defppclapfunction %macptr-hash ((key arg_z))
93  (ldr imm0 target::macptr.address key)
94  (slri imm1 imm0 24)
95  (add imm0 imm0 imm1)
96  (clrrri arg_z imm0 target::fixnumshift)
97  (blr))
98
99#+ppc32-target
100(defppclapfunction %bignum-hash ((key arg_z))
101  (let ((header imm3)
102        (offset imm2)
103        (ndigits imm1)
104        (immhash imm0))
105    (li immhash 0)
106    (li offset ppc32::misc-data-offset)
107    (getvheader header key)
108    (header-size ndigits header)
109    (let ((next header))
110      @loop
111      (cmpwi cr0 ndigits 1)
112      (subi ndigits ndigits 1)
113      (lwzx next key offset)
114      (addi offset offset 4)
115      (rotlwi immhash immhash 13)
116      (add immhash immhash next)
117      (bne cr0 @loop))
118    (clrrwi arg_z immhash ppc32::fixnumshift)
119    (blr)))
120
121#+ppc64-target
122(defppclapfunction %bignum-hash ((key arg_z))
123  (let ((header imm3)
124        (offset imm2)
125        (ndigits imm1)
126        (immhash imm0))
127    (li immhash 0)
128    (li offset ppc64::misc-data-offset)
129    (getvheader header key)
130    (header-size ndigits header)
131    (let ((next header))
132      @loop
133      (cmpdi cr0 ndigits 1)
134      (subi ndigits ndigits 1)
135      (lwzx next key offset)
136      (rotldi immhash immhash 13)
137      (addi offset offset 4)
138      (add immhash immhash next)
139      (bne cr0 @loop))
140    (clrrdi arg_z immhash ppc64::fixnumshift)
141    (blr)))
142
143
144(defppclapfunction %get-fwdnum ()
145  (ref-global arg_z target::fwdnum)
146  (blr))
147
148
149(defppclapfunction %get-gc-count ()
150  (ref-global arg_z target::gc-count)
151  (blr))
152
153
154;;; Setting a key in a hash-table vector needs to
155;;; ensure that the vector header gets memoized as well
156(defppclapfunction %set-hash-table-vector-key ((vector arg_x) (index arg_y) (value arg_z))
157  (ba .SPset-hash-key))
158
159(defppclapfunction %set-hash-table-vector-key-conditional ((offset 0) (vector arg_x) (old arg_y) (new arg_z))
160  (ba .SPset-hash-key-conditional))
161
162;;; Strip the tag bits to turn x into a fixnum
163(defppclapfunction strip-tag-to-fixnum ((x arg_z))
164  (clrrri arg_z x target::ntagbits)
165  (srri arg_z arg_z (- target::ntagbits target::fixnumshift))
166  (blr))
167
168;;; end of ppc-hash.lisp
Note: See TracBrowser for help on using the repository browser.