[13067] | 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 | |
---|
[7986] | 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)) |
---|
[10815] | 23 | (xorl (% edx) (% edx)) ;aka temp1 |
---|
| 24 | (mov (% number) (% imm0)) |
---|
| 25 | (div (% divisor)) ;boxed remainder goes into edx/temp1 |
---|
| 26 | (mov (% edx) (% arg_z)) |
---|
[7986] | 27 | (single-value-return)) |
---|
| 28 | |
---|
[10265] | 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)) |
---|
[13447] | 32 | (mark-as-imm temp1) |
---|
[10265] | 33 | (let ((imm1 temp1) |
---|
| 34 | (n temp0)) |
---|
| 35 | (movl (@ number (% esp)) (% n)) |
---|
| 36 | (movl (% n) (% imm0)) |
---|
[10272] | 37 | (shrl ($ target::fixnumshift) (% imm0)) ;logical shift is intentional |
---|
[10265] | 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))) |
---|
[13447] | 49 | (mark-as-node temp1) |
---|
[10265] | 50 | (single-value-return 3)) |
---|
| 51 | |
---|
[7986] | 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 | |
---|
[10731] | 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 | |
---|
[7986] | 122 | ;;; Strip the tag bits to turn x into a fixnum |
---|
| 123 | (defx8632lapfunction strip-tag-to-fixnum ((x arg_z)) |
---|
[15779] | 124 | (testb ($ target::fixnummask) (%b x)) |
---|
| 125 | (jz @done) |
---|
[15521] | 126 | (andl ($ (lognot target::fulltagmask)) (% x)) |
---|
| 127 | (shrl ($ (- target::ntagbits target::fixnumshift)) (% arg_z)) |
---|
[15779] | 128 | @done |
---|
[7986] | 129 | (single-value-return)) |
---|
| 130 | |
---|