Changeset 7453 for branches/working0710/ccl
 Timestamp:
 Oct 16, 2007, 8:27:18 AM (14 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/working0710/ccl/level0/X86/x86array.lisp
r6476 r7453 26 26 27 27 28 29 30 ;; rewrite in LAP someday (soon). 28 #+x8664target 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 %initgvector ((len arg_x) (value arg_y) (vector arg_z)) 33 (jmp @test) 34 @loop 35 (movq (% value) (@ x8664::miscdataoffset (% vector) (% len))) 36 @test 37 (subq ($ x8664::fixnumone) (% len)) 38 (jns @loop) 39 (singlevaluereturn)) 40 41 ;;; "val" is either a fixnum or a uvector with 64bits of data 42 ;;; (small bignum, DOUBLEFLOAT). 43 (defx86lapfunction %%initivector64 ((len arg_x) (value arg_y) (vector arg_z)) 44 (unboxfixnum value imm0) 45 (testb ($ x8664::fixnummask) (%b value)) 46 (je @test) 47 (movq (@ x8664::miscdataoffset (% value)) (% imm0)) 48 (jmp @test) 49 @loop 50 (movq (% imm0) (@ x8664::miscdataoffset (% vector) (% len))) 51 @test 52 (subq ($ x8664::fixnumone) (% len)) 53 (jns @loop) 54 (singlevaluereturn)) 55 56 (defun %initivector64 (typecode len val uvector) 57 (declare (type (mod 256) typecode)) 58 (%%initivector64 len 59 (case typecode 60 (#.x8664::subtagfixnumvector 61 (requiretype val 'fixnum)) 62 (#.x8664::subtagdoublefloatvector 63 (if (typep val 'doublefloat) 64 val 65 (requiretype val 'doublefloat))) 66 (#.x8664::subtags64vector 67 (requiretype val '(signedbyte 64))) 68 (#.x8664::subtagu64vector 69 (requiretype val '(unsignedbyte 64))) 70 (t (reportbadarg uvector 71 '(or (simplearray fixnum (*)) 72 (simplearray doublefloat (*)) 73 (simplearray (signedbyte 64) (*)) 74 (simplearray (unsignedbyte 64) (*)))))) 75 uvector)) 76 77 78 (evalwhen (:compiletoplevel :execute) 79 (declaim (inline %initivectoru32))) 80 81 (defun %initivectoru32 (len u32val uvector) 82 (declare (type index len) 83 (type (unsignedbyte 32) u32val) 84 (type (simplearray (unsignedbyte 32) (*)) uvector) 85 (optimize (speed 3) (safety 0))) 86 (dotimes (i len uvector) 87 (setf (aref uvector i) u32val))) 88 89 (evalwhen (:compiletoplevel :execute) 90 (declaim (inline %initivectoru16))) 91 92 (defun %initivectoru16 (len val uvector) 93 (declare (type index len) 94 (type (unsignedbyte 16) val) 95 (type (simplearray (unsignedbyte 16) (*)) uvector) 96 (optimize (speed 3) (safety 0))) 97 (dotimes (i len uvector) 98 (setf (aref uvector i) val))) 99 100 101 102 (defun %initivector32 (typecode len val uvector) 103 (declare (type (unsignedbyte 32) typecode) 104 (type index len)) 105 (let* ((u32val (case typecode 106 (#.x8664::subtags32vector 107 (logand (the (signedbyte 32) 108 (requiretype val '(signedbyte 32))) 109 #xffffffff)) 110 (#.x8664::subtagsinglefloatvector 111 (singlefloatbits (requiretype val 'singlefloat))) 112 (#.x8664::subtagsimplebasestring 113 (logior (the (unsignedbyte 32) 114 (ash (the (mod #x110000) (charcode val)) 115 x8664::charcodeshift)) 116 x8664::subtagcharacter)) 117 (t 118 (requiretype val '(unsignedbyte 32)))))) 119 (declare (type (unsignedbyte 32) u32val)) 120 (%initivectoru32 len u32val uvector))) 121 122 (defun %initmisc (val uvector) 123 (let* ((len (uvsize uvector)) 124 (typecode (typecode uvector)) 125 (fulltag (logand x8664::fulltagmask typecode))) 126 (declare (type index len) 127 (type (unsignedbyte 8) typecode) 128 (type (mod 16) fulltag)) 129 (if (or (= fulltag x8664::fulltagnodeheader0) 130 (= fulltag x8664::fulltagnodeheader1)) 131 (%initgvector len val uvector) 132 (if (= fulltag x8664::ivectorclass64bit) 133 (%initivector64 typecode len val uvector) 134 (if (= fulltag x8664::ivectorclass32bit) 135 (%initivector32 typecode len val uvector) 136 ;; Value must be a fixnum, 1, 8, 16 bits 137 (case typecode 138 (#.x8664::subtagu16vector 139 (%initivectoru16 len 140 (requiretype val '(unsignedbyte 16)) 141 uvector)) 142 (#.x8664::subtags16vector 143 (%initivectoru16 len 144 (logand (the (signedbyte 16) 145 (requiretype val '(unsignedbyte 16))) 146 #xffff) 147 uvector)) 148 (#.x8664::subtagu8vector 149 (let* ((v0 (requiretype val '(unsignedbyte 8))) 150 (l0 (ash (the fixnum (1+ len)) 1))) 151 (declare (type (unsignedbyte 8) v0) 152 (type index l0)) 153 (%initivectoru16 l0 154 (logior (the (unsignedbyte 16) (ash v0 8)) 155 v0) 156 uvector))) 157 (#.x8664::subtags8vector 158 (let* ((v0 (logand #xff 159 (the (signedbyte 8) 160 (requiretype val '(signedbyte 8))))) 161 (l0 (ash (the fixnum (1+ len)) 1))) 162 (declare (type (unsignedbyte 8) v0) 163 (type index l0)) 164 (%initivectoru16 l0 165 (logior (the (unsignedbyte 16) (ash v0 8)) 166 v0) 167 uvector))) 168 (#.x8664::subtagbitvector 169 (if (eql 0 val) 170 uvector 171 (let* ((v0 (case val 172 (1 1) 173 (t (reportbadarg val 'bit)))) 174 (l0 (ash (the fixnum (+ len 64)) 6))) 175 (declare (type (unsignedbyte 8) v0) 176 (type index l0)) 177 (%%initivector64 l0 v0 uvector)))) 178 (t (reportbadarg uvector 179 '(or simplebitvector 180 (simplearray (signedbyte 8) (*)) 181 (simplearray (unsignedbyte 8) (*)) 182 (simplearray (signedbyte 16) (*)) 183 (simplearray (unsignedbyte 16) (*))))))))))) 184 185 186 ) 187 188 #x8664target 31 189 (defun %initmisc (val uvector) 32 190 (dotimes (i (uvsize uvector) uvector) 33 191 (setf (uvref uvector i) val))) 34 192 35 193 36 194 ;;; Make a new vector of size newsize whose subtag matches that of oldvarg.
Note: See TracChangeset
for help on using the changeset viewer.