| 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 | (in-package "CCL") |
|---|
| 18 | |
|---|
| 19 | (eval-when (:compile-toplevel :execute) |
|---|
| 20 | #+x8632-target |
|---|
| 21 | (require "X8632-ARCH") |
|---|
| 22 | #+x8664-target |
|---|
| 23 | (require "X8664-ARCH") |
|---|
| 24 | (require "X86-LAPMACROS")) |
|---|
| 25 | |
|---|
| 26 | |
|---|
| 27 | |
|---|
| 28 | #+x8664-target |
|---|
| 29 | (progn |
|---|
| 30 | ;;; None of the stores in here can be intergenerational; the vector |
|---|
| 31 | ;;; is known to be younger than the initial value |
|---|
| 32 | (defx86lapfunction %init-gvector ((len arg_x) (value arg_y) (vector arg_z)) |
|---|
| 33 | (jmp @test) |
|---|
| 34 | @loop |
|---|
| 35 | (movq (% value) (@ x8664::misc-data-offset (% vector) (% len))) |
|---|
| 36 | @test |
|---|
| 37 | (subq ($ x8664::fixnumone) (% len)) |
|---|
| 38 | (jns @loop) |
|---|
| 39 | (single-value-return)) |
|---|
| 40 | |
|---|
| 41 | ;;; "val" is either a fixnum or a uvector with 64-bits of data |
|---|
| 42 | ;;; (small bignum, DOUBLE-FLOAT). |
|---|
| 43 | (defx86lapfunction %%init-ivector64 ((len arg_x) (value arg_y) (vector arg_z)) |
|---|
| 44 | (unbox-fixnum value imm0) |
|---|
| 45 | (testb ($ x8664::fixnummask) (%b value)) |
|---|
| 46 | (je @test) |
|---|
| 47 | (movq (@ x8664::misc-data-offset (% value)) (% imm0)) |
|---|
| 48 | (jmp @test) |
|---|
| 49 | @loop |
|---|
| 50 | (movq (% imm0) (@ x8664::misc-data-offset (% vector) (% len))) |
|---|
| 51 | @test |
|---|
| 52 | (subq ($ x8664::fixnumone) (% len)) |
|---|
| 53 | (jns @loop) |
|---|
| 54 | (single-value-return)) |
|---|
| 55 | |
|---|
| 56 | (defun %init-ivector64 (typecode len val uvector) |
|---|
| 57 | (declare (type (mod 256) typecode)) |
|---|
| 58 | (%%init-ivector64 len |
|---|
| 59 | (case typecode |
|---|
| 60 | (#.x8664::subtag-fixnum-vector |
|---|
| 61 | (require-type val 'fixnum)) |
|---|
| 62 | (#.x8664::subtag-double-float-vector |
|---|
| 63 | (if (typep val 'double-float) |
|---|
| 64 | val |
|---|
| 65 | (require-type val 'double-float))) |
|---|
| 66 | (#.x8664::subtag-s64-vector |
|---|
| 67 | (require-type val '(signed-byte 64))) |
|---|
| 68 | (#.x8664::subtag-u64-vector |
|---|
| 69 | (require-type val '(unsigned-byte 64))) |
|---|
| 70 | (t (report-bad-arg uvector |
|---|
| 71 | '(or (simple-array fixnum (*)) |
|---|
| 72 | (simple-array double-float (*)) |
|---|
| 73 | (simple-array (signed-byte 64) (*)) |
|---|
| 74 | (simple-array (unsigned-byte 64) (*)))))) |
|---|
| 75 | uvector)) |
|---|
| 76 | |
|---|
| 77 | |
|---|
| 78 | (eval-when (:compile-toplevel :execute) |
|---|
| 79 | (declaim (inline %init-ivector-u32))) |
|---|
| 80 | |
|---|
| 81 | (defun %init-ivector-u32 (len u32val uvector) |
|---|
| 82 | (declare (type index len) |
|---|
| 83 | (type (unsigned-byte 32) u32val) |
|---|
| 84 | (type (simple-array (unsigned-byte 32) (*)) uvector) |
|---|
| 85 | (optimize (speed 3) (safety 0))) |
|---|
| 86 | (dotimes (i len uvector) |
|---|
| 87 | (setf (aref uvector i) u32val))) |
|---|
| 88 | |
|---|
| 89 | (eval-when (:compile-toplevel :execute) |
|---|
| 90 | (declaim (inline %init-ivector-u16))) |
|---|
| 91 | |
|---|
| 92 | (defun %init-ivector-u16 (len val uvector) |
|---|
| 93 | (declare (type index len) |
|---|
| 94 | (type (unsigned-byte 16) val) |
|---|
| 95 | (type (simple-array (unsigned-byte 16) (*)) uvector) |
|---|
| 96 | (optimize (speed 3) (safety 0))) |
|---|
| 97 | (dotimes (i len uvector) |
|---|
| 98 | (setf (aref uvector i) val))) |
|---|
| 99 | |
|---|
| 100 | |
|---|
| 101 | |
|---|
| 102 | (defun %init-ivector32 (typecode len val uvector) |
|---|
| 103 | (declare (type (unsigned-byte 32) typecode) |
|---|
| 104 | (type index len)) |
|---|
| 105 | (let* ((u32val (case typecode |
|---|
| 106 | (#.x8664::subtag-s32-vector |
|---|
| 107 | (logand (the (signed-byte 32) |
|---|
| 108 | (require-type val '(signed-byte 32))) |
|---|
| 109 | #xffffffff)) |
|---|
| 110 | (#.x8664::subtag-single-float-vector |
|---|
| 111 | (single-float-bits (require-type val 'single-float))) |
|---|
| 112 | (#.x8664::subtag-simple-base-string |
|---|
| 113 | (char-code val)) |
|---|
| 114 | (t |
|---|
| 115 | (require-type val '(unsigned-byte 32)))))) |
|---|
| 116 | (declare (type (unsigned-byte 32) u32val)) |
|---|
| 117 | (%init-ivector-u32 len u32val uvector))) |
|---|
| 118 | |
|---|
| 119 | (defun %init-misc (val uvector) |
|---|
| 120 | (let* ((len (uvsize uvector)) |
|---|
| 121 | (typecode (typecode uvector)) |
|---|
| 122 | (fulltag (logand x8664::fulltagmask typecode))) |
|---|
| 123 | (declare (type index len) |
|---|
| 124 | (type (unsigned-byte 8) typecode) |
|---|
| 125 | (type (mod 16) fulltag)) |
|---|
| 126 | (if (or (= fulltag x8664::fulltag-nodeheader-0) |
|---|
| 127 | (= fulltag x8664::fulltag-nodeheader-1)) |
|---|
| 128 | (%init-gvector len val uvector) |
|---|
| 129 | (if (= fulltag x8664::ivector-class-64-bit) |
|---|
| 130 | (%init-ivector64 typecode len val uvector) |
|---|
| 131 | (if (= fulltag x8664::ivector-class-32-bit) |
|---|
| 132 | (%init-ivector32 typecode len val uvector) |
|---|
| 133 | ;; Value must be a fixnum, 1, 8, 16 bits |
|---|
| 134 | (case typecode |
|---|
| 135 | (#.x8664::subtag-u16-vector |
|---|
| 136 | (%init-ivector-u16 len |
|---|
| 137 | (require-type val '(unsigned-byte 16)) |
|---|
| 138 | uvector)) |
|---|
| 139 | (#.x8664::subtag-s16-vector |
|---|
| 140 | (%init-ivector-u16 len |
|---|
| 141 | (logand (the (signed-byte 16) |
|---|
| 142 | (require-type val '(unsigned-byte 16))) |
|---|
| 143 | #xffff) |
|---|
| 144 | uvector)) |
|---|
| 145 | (#.x8664::subtag-u8-vector |
|---|
| 146 | (let* ((v0 (require-type val '(unsigned-byte 8))) |
|---|
| 147 | (l0 (ash (the fixnum (1+ len)) -1))) |
|---|
| 148 | (declare (type (unsigned-byte 8) v0) |
|---|
| 149 | (type index l0)) |
|---|
| 150 | (%init-ivector-u16 l0 |
|---|
| 151 | (logior (the (unsigned-byte 16) (ash v0 8)) |
|---|
| 152 | v0) |
|---|
| 153 | uvector))) |
|---|
| 154 | (#.x8664::subtag-s8-vector |
|---|
| 155 | (let* ((v0 (logand #xff |
|---|
| 156 | (the (signed-byte 8) |
|---|
| 157 | (require-type val '(signed-byte 8))))) |
|---|
| 158 | (l0 (ash (the fixnum (1+ len)) -1))) |
|---|
| 159 | (declare (type (unsigned-byte 8) v0) |
|---|
| 160 | (type index l0)) |
|---|
| 161 | (%init-ivector-u16 l0 |
|---|
| 162 | (logior (the (unsigned-byte 16) (ash v0 8)) |
|---|
| 163 | v0) |
|---|
| 164 | uvector))) |
|---|
| 165 | (#.x8664::subtag-bit-vector |
|---|
| 166 | (if (eql 0 val) |
|---|
| 167 | uvector |
|---|
| 168 | (let* ((v0 (case val |
|---|
| 169 | (1 -1) |
|---|
| 170 | (t (report-bad-arg val 'bit)))) |
|---|
| 171 | (l0 (ash (the fixnum (+ len 63)) -6))) |
|---|
| 172 | (declare (type (unsigned-byte 8) v0) |
|---|
| 173 | (type index l0)) |
|---|
| 174 | (%%init-ivector64 l0 v0 uvector)))) |
|---|
| 175 | (t (report-bad-arg uvector |
|---|
| 176 | '(or simple-bit-vector |
|---|
| 177 | (simple-array (signed-byte 8) (*)) |
|---|
| 178 | (simple-array (unsigned-byte 8) (*)) |
|---|
| 179 | (simple-array (signed-byte 16) (*)) |
|---|
| 180 | (simple-array (unsigned-byte 16) (*))))))))))) |
|---|
| 181 | |
|---|
| 182 | |
|---|
| 183 | ) |
|---|
| 184 | |
|---|
| 185 | #-x8664-target |
|---|
| 186 | (defun %init-misc (val uvector) |
|---|
| 187 | (dotimes (i (uvsize uvector) uvector) |
|---|
| 188 | (setf (uvref uvector i) val))) |
|---|
| 189 | |
|---|
| 190 | |
|---|
| 191 | ;;; Make a new vector of size newsize whose subtag matches that of oldv-arg. |
|---|
| 192 | ;;; Blast the contents of the old vector into the new one as quickly as |
|---|
| 193 | ;;; possible; leave remaining elements of new vector undefined (0). |
|---|
| 194 | ;;; Return new-vector. |
|---|
| 195 | (defun %extend-vector (start oldv newsize) |
|---|
| 196 | (declare (fixnum start)) |
|---|
| 197 | (let* ((typecode (typecode oldv)) |
|---|
| 198 | (new (%alloc-misc newsize typecode)) |
|---|
| 199 | (oldsize (uvsize oldv))) |
|---|
| 200 | (declare (fixnum oldsize typecode)) |
|---|
| 201 | (if (gvectorp oldv) |
|---|
| 202 | (%extend-gvector oldv start oldsize new) |
|---|
| 203 | (if (not (zerop start)) |
|---|
| 204 | (do* ((i 0 (1+ i)) |
|---|
| 205 | (j start (1+ j))) |
|---|
| 206 | ((= i oldsize) new) |
|---|
| 207 | (declare (fixnum i j)) |
|---|
| 208 | (setf (uvref new j) (uvref oldv i))) |
|---|
| 209 | (%copy-ivector-to-ivector oldv 0 new 0 (subtag-bytes typecode oldsize)))))) |
|---|
| 210 | |
|---|
| 211 | (defx86lapfunction %extend-gvector ((oldv 8) |
|---|
| 212 | #|(ra 0)|# |
|---|
| 213 | (start arg_x) |
|---|
| 214 | (oldsize arg_y) |
|---|
| 215 | (new arg_z)) |
|---|
| 216 | (let ((rold temp0) |
|---|
| 217 | (val temp1) |
|---|
| 218 | (out temp2)) |
|---|
| 219 | (movq (@ oldv (% rsp)) (% rold)) |
|---|
| 220 | (xorl (%l out) (%l out)) |
|---|
| 221 | (jmp @test) |
|---|
| 222 | @loop |
|---|
| 223 | (movq (@ x8664::misc-data-offset (% rold) (% start)) (% val)) |
|---|
| 224 | (movq (% val) (@ x8664::misc-data-offset (% new) (% out))) |
|---|
| 225 | (addq ($ '1) (% out)) |
|---|
| 226 | (addq ($ '1) (% start)) |
|---|
| 227 | @test |
|---|
| 228 | (cmpq (% start) (% oldsize)) |
|---|
| 229 | (jne @loop) |
|---|
| 230 | (single-value-return 3))) |
|---|
| 231 | |
|---|
| 232 | |
|---|
| 233 | ;;; argument is a vector header or an array header. Or else. |
|---|
| 234 | (defx86lapfunction %array-header-data-and-offset ((a arg_z)) |
|---|
| 235 | (let ((offset arg_y) |
|---|
| 236 | (temp temp1)) |
|---|
| 237 | (movq (% rsp) (% temp0)) |
|---|
| 238 | (movl ($ '0) (%l offset)) |
|---|
| 239 | (movq (% a) (% temp)) |
|---|
| 240 | @loop |
|---|
| 241 | (movq (@ target::arrayH.data-vector (% temp)) (% a)) |
|---|
| 242 | (extract-subtag a imm0) |
|---|
| 243 | (addq (@ target::arrayH.displacement (% temp)) (% offset)) |
|---|
| 244 | (rcmp (% imm0) ($ target::subtag-vectorH)) |
|---|
| 245 | (movq (% a) (% temp)) |
|---|
| 246 | (jle @loop) |
|---|
| 247 | (push (% a)) |
|---|
| 248 | (push (% offset)) |
|---|
| 249 | (set-nargs 2) |
|---|
| 250 | (jmp-subprim .SPvalues))) |
|---|
| 251 | |
|---|
| 252 | |
|---|
| 253 | |
|---|
| 254 | (defx86lapfunction %boole-clr ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 255 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 256 | (movq ($ 0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 257 | (single-value-return 3)) |
|---|
| 258 | |
|---|
| 259 | (defx86lapfunction %boole-set ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 260 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 261 | (movq ($ -1) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 262 | (single-value-return 3)) |
|---|
| 263 | |
|---|
| 264 | (defx86lapfunction %boole-1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 265 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 266 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 267 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 268 | (single-value-return 3)) |
|---|
| 269 | |
|---|
| 270 | (defx86lapfunction %boole-2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 271 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 272 | (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 273 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 274 | (single-value-return 3)) |
|---|
| 275 | |
|---|
| 276 | (defx86lapfunction %boole-c1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 277 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 278 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 279 | (notq (% imm0)) |
|---|
| 280 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 281 | (single-value-return 3)) |
|---|
| 282 | |
|---|
| 283 | (defx86lapfunction %boole-c2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 284 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 285 | (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 286 | (notq (% imm0)) |
|---|
| 287 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 288 | (single-value-return 3)) |
|---|
| 289 | |
|---|
| 290 | (defx86lapfunction %boole-and ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 291 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 292 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 293 | (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 294 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 295 | (single-value-return 3)) |
|---|
| 296 | |
|---|
| 297 | (defx86lapfunction %boole-ior ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 298 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 299 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 300 | (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 301 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 302 | (single-value-return 3)) |
|---|
| 303 | |
|---|
| 304 | (defx86lapfunction %boole-xor ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 305 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 306 | n (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 307 | (xorq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 308 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 309 | (single-value-return 3)) |
|---|
| 310 | |
|---|
| 311 | (defx86lapfunction %boole-eqv ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 312 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 313 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 314 | (xorq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 315 | (notq (% imm0)) |
|---|
| 316 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 317 | (single-value-return 3)) |
|---|
| 318 | |
|---|
| 319 | (defx86lapfunction %boole-nand ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 320 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 321 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 322 | (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 323 | (notq (% imm0)) |
|---|
| 324 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 325 | (single-value-return 3)) |
|---|
| 326 | |
|---|
| 327 | (defx86lapfunction %boole-nor ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 328 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 329 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 330 | (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 331 | (notq (% imm0)) |
|---|
| 332 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 333 | (single-value-return 3)) |
|---|
| 334 | |
|---|
| 335 | (defx86lapfunction %boole-andc1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 336 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 337 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 338 | (notq (% imm0)) |
|---|
| 339 | (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 340 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 341 | (single-value-return 3)) |
|---|
| 342 | |
|---|
| 343 | (defx86lapfunction %boole-andc2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 344 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 345 | (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 346 | (notq (% imm0)) |
|---|
| 347 | (andq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 348 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 349 | (single-value-return 3)) |
|---|
| 350 | |
|---|
| 351 | (defx86lapfunction %boole-orc1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 352 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 353 | (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 354 | (notq (% imm0)) |
|---|
| 355 | (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 356 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 357 | (single-value-return 3)) |
|---|
| 358 | |
|---|
| 359 | (defx86lapfunction %boole-orc2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z)) |
|---|
| 360 | (movq (@ idx (% rsp)) (% temp0)) |
|---|
| 361 | (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0)) |
|---|
| 362 | (notq (% imm0)) |
|---|
| 363 | (orq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0)) |
|---|
| 364 | (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0))) |
|---|
| 365 | (single-value-return 3)) |
|---|
| 366 | |
|---|
| 367 | (defparameter *simple-bit-boole-functions* ()) |
|---|
| 368 | |
|---|
| 369 | (setq *simple-bit-boole-functions* |
|---|
| 370 | (vector |
|---|
| 371 | #'%boole-clr |
|---|
| 372 | #'%boole-set |
|---|
| 373 | #'%boole-1 |
|---|
| 374 | #'%boole-2 |
|---|
| 375 | #'%boole-c1 |
|---|
| 376 | #'%boole-c2 |
|---|
| 377 | #'%boole-and |
|---|
| 378 | #'%boole-ior |
|---|
| 379 | #'%boole-xor |
|---|
| 380 | #'%boole-eqv |
|---|
| 381 | #'%boole-nand |
|---|
| 382 | #'%boole-nor |
|---|
| 383 | #'%boole-andc1 |
|---|
| 384 | #'%boole-andc2 |
|---|
| 385 | #'%boole-orc1 |
|---|
| 386 | #'%boole-orc2)) |
|---|
| 387 | |
|---|
| 388 | (defun %simple-bit-boole (op b1 b2 result) |
|---|
| 389 | (let* ((f (svref *simple-bit-boole-functions* op))) |
|---|
| 390 | (dotimes (i (ash (the fixnum (+ (length result) 63)) -6) result) |
|---|
| 391 | (funcall f i b1 b2 result)))) |
|---|
| 392 | |
|---|
| 393 | (defx86lapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z)) |
|---|
| 394 | (check-nargs 3) |
|---|
| 395 | (jmp-subprim .SParef2)) |
|---|
| 396 | |
|---|
| 397 | (defx86lapfunction %aref3 ((array 0) (i arg_x) (j arg_y) (k arg_z)) |
|---|
| 398 | (check-nargs 4) |
|---|
| 399 | (pop (% temp0)) |
|---|
| 400 | (discard-reserved-frame) |
|---|
| 401 | (jmp-subprim .SParef3)) |
|---|
| 402 | |
|---|
| 403 | (defx86lapfunction %aset2 ((array 0) (i arg_x) (j arg_y) (newval arg_z)) |
|---|
| 404 | (check-nargs 4) |
|---|
| 405 | (pop (% temp0)) |
|---|
| 406 | (discard-reserved-frame) |
|---|
| 407 | (jmp-subprim .SPaset2)) |
|---|
| 408 | |
|---|
| 409 | (defx86lapfunction %aset3 ((array 8) (i 0) (j arg_x) (k arg_y) (newval arg_z)) |
|---|
| 410 | (check-nargs 5) |
|---|
| 411 | (pop (% temp0)) |
|---|
| 412 | (pop (% temp1)) |
|---|
| 413 | (discard-reserved-frame) |
|---|
| 414 | (jmp-subprim .SPaset3)) |
|---|
| 415 | |
|---|
| 416 | |
|---|
| 417 | |
|---|
| 418 | |
|---|
| 419 | |
|---|
| 420 | |
|---|
| 421 | |
|---|
