[6] | 1 | ;;; -*- Mode: Lisp; Package: CCL -*- |
---|
| 2 | ;;; |
---|
[13067] | 3 | ;;; Copyright (C) 2009 Clozure Associates |
---|
[6] | 4 | ;;; Copyright (C) 1994-2001 Digitool, Inc |
---|
[13066] | 5 | ;;; This file is part of Clozure CL. |
---|
[6] | 6 | ;;; |
---|
[13066] | 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 |
---|
[6] | 9 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
[13066] | 10 | ;;; which is distributed with Clozure CL as the file "LGPL". Where these |
---|
[6] | 11 | ;;; conflict, the preamble takes precedence. |
---|
| 12 | ;;; |
---|
[13066] | 13 | ;;; Clozure CL is referenced in the preamble as the "LIBRARY." |
---|
[6] | 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 | |
---|
[1935] | 21 | (in-package "CCL") |
---|
[6] | 22 | |
---|
| 23 | (eval-when (:compile-toplevel :execute) |
---|
| 24 | (require "HASHENV" "ccl:xdump;hashenv")) |
---|
| 25 | |
---|
| 26 | |
---|
| 27 | |
---|
| 28 | |
---|
[1957] | 29 | ;;; This should stay in LAP so that it's fast |
---|
| 30 | ;;; Equivalent to cl:mod when both args are positive fixnums |
---|
[6] | 31 | (defppclapfunction fast-mod ((number arg_y) (divisor arg_z)) |
---|
[9932] | 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)) |
---|
[6] | 40 | (subf arg_z arg_z number) |
---|
| 41 | (blr)) |
---|
| 42 | |
---|
[9932] | 43 | |
---|
| 44 | (defppclapfunction fast-mod-3 ((number arg_x) (divisor arg_y) (recip arg_z)) |
---|
| 45 | #+ppc32-target |
---|
| 46 | (progn |
---|
[10028] | 47 | (srwi imm0 number ppc32::fixnumshift) |
---|
[9932] | 48 | (mulhw imm1 imm0 recip) |
---|
| 49 | (mullw imm0 imm1 divisor)) |
---|
| 50 | #+ppc64-target |
---|
| 51 | (progn |
---|
[10028] | 52 | (srdi imm0 number ppc64::fixnumshift) |
---|
[9932] | 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) |
---|
[6] | 60 | (blr)) |
---|
| 61 | |
---|
[1326] | 62 | #+ppc32-target |
---|
[6] | 63 | (defppclapfunction %dfloat-hash ((key arg_z)) |
---|
[78] | 64 | (lwz imm0 ppc32::double-float.value key) |
---|
| 65 | (lwz imm1 ppc32::double-float.val-low key) |
---|
[6] | 66 | (add imm0 imm0 imm1) |
---|
| 67 | (box-fixnum arg_z imm0) |
---|
| 68 | (blr)) |
---|
| 69 | |
---|
[1326] | 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 |
---|
[6] | 77 | (defppclapfunction %sfloat-hash ((key arg_z)) |
---|
[78] | 78 | (lwz imm0 ppc32::single-float.value key) |
---|
[6] | 79 | (box-fixnum arg_z imm0) |
---|
| 80 | (blr)) |
---|
| 81 | |
---|
[1326] | 82 | #+ppc64-target |
---|
| 83 | (defppclapfunction %sfloat-hash ((key arg_z)) |
---|
[1911] | 84 | (lis imm0 #x8000) |
---|
| 85 | (srdi imm1 key 32) |
---|
| 86 | (cmpw imm0 imm1) |
---|
[1558] | 87 | (srdi arg_z key (- 32 ppc64::fixnumshift)) |
---|
[1911] | 88 | (bnelr) |
---|
| 89 | (li arg_z 0) |
---|
[1326] | 90 | (blr)) |
---|
| 91 | |
---|
[6] | 92 | (defppclapfunction %macptr-hash ((key arg_z)) |
---|
[1326] | 93 | (ldr imm0 target::macptr.address key) |
---|
| 94 | (slri imm1 imm0 24) |
---|
[6] | 95 | (add imm0 imm0 imm1) |
---|
[1326] | 96 | (clrrri arg_z imm0 target::fixnumshift) |
---|
[6] | 97 | (blr)) |
---|
| 98 | |
---|
[1326] | 99 | #+ppc32-target |
---|
[6] | 100 | (defppclapfunction %bignum-hash ((key arg_z)) |
---|
| 101 | (let ((header imm3) |
---|
| 102 | (offset imm2) |
---|
| 103 | (ndigits imm1) |
---|
| 104 | (immhash imm0)) |
---|
| 105 | (li immhash 0) |
---|
[78] | 106 | (li offset ppc32::misc-data-offset) |
---|
[6] | 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)) |
---|
[78] | 118 | (clrrwi arg_z immhash ppc32::fixnumshift) |
---|
[6] | 119 | (blr))) |
---|
| 120 | |
---|
[1326] | 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))) |
---|
[6] | 142 | |
---|
| 143 | |
---|
| 144 | (defppclapfunction %get-fwdnum () |
---|
[1326] | 145 | (ref-global arg_z target::fwdnum) |
---|
[6] | 146 | (blr)) |
---|
| 147 | |
---|
| 148 | |
---|
| 149 | (defppclapfunction %get-gc-count () |
---|
[1326] | 150 | (ref-global arg_z target::gc-count) |
---|
[6] | 151 | (blr)) |
---|
| 152 | |
---|
| 153 | |
---|
[1957] | 154 | ;;; Setting a key in a hash-table vector needs to |
---|
| 155 | ;;; ensure that the vector header gets memoized as well |
---|
[6] | 156 | (defppclapfunction %set-hash-table-vector-key ((vector arg_x) (index arg_y) (value arg_z)) |
---|
[1199] | 157 | (ba .SPset-hash-key)) |
---|
[6] | 158 | |
---|
[10731] | 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 | |
---|
[1957] | 162 | ;;; Strip the tag bits to turn x into a fixnum |
---|
| 163 | (defppclapfunction strip-tag-to-fixnum ((x arg_z)) |
---|
| 164 | (unbox-fixnum imm0 x) |
---|
| 165 | (box-fixnum arg_z imm0) |
---|
| 166 | (blr)) |
---|
[6] | 167 | |
---|
[1957] | 168 | ;;; end of ppc-hash.lisp |
---|