source: release/1.9/source/level-0/X86/X8632/x8632-hash.lisp

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

propagate r15775 to 1.9

File size: 4.4 KB
Line 
1;;; Copyright 2009 Clozure Associates
2;;; This file is part of Clozure CL. 
3;;;
4;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU
5;;; Public License , known as the LLGPL and distributed with Clozure
6;;; CL as the file "LICENSE".  The LLGPL consists of a preamble and
7;;; the LGPL, which is distributed with Clozure CL as the file "LGPL".
8;;; Where these conflict, the preamble takes precedence.
9;;;
10;;; Clozure CL is referenced in the preamble as the "LIBRARY."
11;;;
12;;; The LLGPL is also available online at
13;;; http://opensource.franz.com/preamble.html
14
15(in-package "CCL")
16
17(eval-when (:compile-toplevel :execute)
18  (require "HASHENV" "ccl:xdump;hashenv"))
19
20;;; This should stay in LAP so that it's fast
21;;; Equivalent to cl:mod when both args are positive fixnums
22(defx8632lapfunction fast-mod ((number arg_y) (divisor arg_z))
23  (xorl (% edx) (% edx))                ;aka temp1
24  (mov (% number) (% imm0))
25  (div (% divisor))                     ;boxed remainder goes into edx/temp1
26  (mov (% edx) (% arg_z))
27  (single-value-return))
28
29;; Faster mod based on Bruce Hoult's Dylan version, modified to use a
30;; branch-free max.
31(defx8632lapfunction fast-mod-3 ((number 4) #|(ra 0)|# (divisor arg_y) (recip arg_z))
32  (mark-as-imm temp1)
33  (let ((imm1 temp1)
34        (n temp0))
35    (movl (@ number (% esp)) (% n))
36    (movl (% n) (% imm0))
37    (shrl ($ target::fixnumshift) (% imm0)) ;logical shift is intentional
38    (mov (% recip) (% imm1))
39    (mul (% imm1)) ;; -> hi word in imm1 (unboxed)
40    (mov (% divisor) (% imm0))
41    (mul (% imm1)) ;; -> lo word in imm0 (boxed)
42    (subl (% imm0) (% n))
43    (subl (% divisor) (% n))
44    (mov (% n) (% arg_z))
45    (mov (% n) (% imm0))
46    (sar ($ (1- target::nbits-in-word)) (% imm0))
47    (andl (% imm0) (% divisor))
48    (addl (% divisor) (% arg_z)))
49  (mark-as-node temp1)
50  (single-value-return 3))
51
52(defx8632lapfunction %dfloat-hash ((key arg_z))
53  (movl (@ x8632::double-float.value (% key)) (% imm0))
54  (addl (@ x8632::double-float.val-high (% key)) (% imm0))
55  (box-fixnum imm0 arg_z)
56  (single-value-return))
57
58(defx8632lapfunction %sfloat-hash ((key arg_z))
59  (movl (@ x8632::single-float.value (% key)) (% imm0))
60  (box-fixnum imm0 arg_z)
61  (single-value-return))
62
63(defx8632lapfunction %macptr-hash ((key arg_z))
64  (movl (@ x8632::macptr.address (% key)) (% imm0))
65  (box-fixnum imm0 temp0)
66  (shll ($ (- 24 x8632::fixnumshift)) (% temp0))
67  (addl (% temp0) (% imm0))
68  (movl ($ (lognot x8632::fixnummask)) (% arg_z))
69  (andl (% imm0) (% arg_z))
70  (single-value-return))
71
72(defx8632lapfunction %bignum-hash ((key arg_z))
73  (mark-as-imm temp1)
74  (let ((header imm0)
75        (offset temp1)
76        (ndigits temp0))
77    (getvheader key header)
78    (header-length header ndigits)
79    (xorl (% offset) (% offset))
80    (let ((immhash header))
81      @loop
82      (roll ($ 13) (% immhash))
83      (addl (@ x8632::misc-data-offset (% key) (% offset)) (% immhash))
84      (addl ($ 4) (% offset))
85      (subl ($ '1) (% ndigits))
86      (jne @loop)
87      (box-fixnum immhash arg_z)))
88  (mark-as-node temp1)
89  (single-value-return))
90
91(defx8632lapfunction %get-fwdnum ()
92  (ref-global target::fwdnum arg_z)
93  (single-value-return))
94
95(defx8632lapfunction %get-gc-count ()
96  (ref-global target::gc-count arg_z)
97  (single-value-return))
98
99;;; Setting a key in a hash-table vector needs to
100;;; ensure that the vector header gets memoized as well
101(defx8632lapfunction %set-hash-table-vector-key ((vector 4) #|(ra 0)|# (index arg_y) (value arg_z))
102  (pop (% temp1))                       ;return address
103  (pop (% temp0))                       ;.SPset-hash-key wants arg in temp0
104  (discard-reserved-frame)
105  (push (% temp1))
106  (jmp-subprim .SPset-hash-key))
107
108;;; This needs to be done out-of-line, to handle EGC memoization.
109(defx8632lapfunction %set-hash-table-vector-key-conditional ((offset 8)
110                                                             (vector 4)
111                                                             #|(ra 0)|#
112                                                             (old arg_y)
113                                                             (new arg_z))
114  (movl (@ offset (% esp)) (% temp0))
115  (movl (@ vector (% esp)) (% temp1))
116  (save-simple-frame)
117  (call-subprim .SPset-hash-key-conditional)
118  (restore-simple-frame)
119  (single-value-return 4))
120
121
122;;; Strip the tag bits to turn x into a fixnum
123(defx8632lapfunction strip-tag-to-fixnum ((x arg_z))
124  (testb ($ target::fixnummask) (%b x))
125  (jz @done)
126  (andl ($ (lognot target::fulltagmask)) (% x))
127  (shrl ($ (- target::ntagbits target::fixnumshift)) (% arg_z))
128  @done
129  (single-value-return))
130
Note: See TracBrowser for help on using the repository browser.