Changeset 7453 for branches/working-0710


Ignore:
Timestamp:
Oct 16, 2007, 8:27:18 AM (12 years ago)
Author:
gb
Message:

Less cluless %init-misc.
(Note that %init-misc is used in MAKE-INSTANCE to create a standard
instance's slot-vector.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/level-0/X86/x86-array.lisp

    r6476 r7453  
    2626
    2727
    28 
    29 
    30 ;; rewrite in LAP someday (soon).
     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                    (logior (the (unsigned-byte 32)
     114                              (ash (the (mod #x110000) (char-code val))
     115                                   x8664::charcode-shift))
     116                            x8664::subtag-character))
     117                   (t
     118                    (require-type val '(unsigned-byte 32))))))
     119    (declare (type (unsigned-byte 32) u32val))
     120    (%init-ivector-u32 len u32val uvector)))
     121
     122(defun %init-misc (val uvector)
     123  (let* ((len (uvsize uvector))
     124         (typecode (typecode uvector))
     125         (fulltag (logand x8664::fulltagmask typecode)))
     126    (declare (type index len)
     127             (type (unsigned-byte 8) typecode)
     128             (type (mod 16) fulltag))
     129    (if (or (= fulltag x8664::fulltag-nodeheader-0)
     130            (= fulltag x8664::fulltag-nodeheader-1))
     131      (%init-gvector len val uvector)
     132      (if (= fulltag x8664::ivector-class-64-bit)
     133        (%init-ivector64 typecode len val uvector)
     134        (if (= fulltag x8664::ivector-class-32-bit)
     135          (%init-ivector32 typecode len val uvector)
     136          ;; Value must be a fixnum, 1, 8, 16 bits
     137          (case typecode
     138            (#.x8664::subtag-u16-vector
     139             (%init-ivector-u16 len
     140                                (require-type val '(unsigned-byte 16))
     141                                uvector))
     142            (#.x8664::subtag-s16-vector
     143             (%init-ivector-u16 len
     144                                (logand (the (signed-byte 16)
     145                                          (require-type val '(unsigned-byte 16)))
     146                                        #xffff)
     147                                uvector))
     148            (#.x8664::subtag-u8-vector
     149             (let* ((v0 (require-type val '(unsigned-byte 8)))
     150                    (l0 (ash (the fixnum (1+ len)) -1)))
     151               (declare (type (unsigned-byte 8) v0)
     152                        (type index l0))
     153               (%init-ivector-u16 l0
     154                                  (logior (the (unsigned-byte 16) (ash v0 8))
     155                                          v0)
     156                                  uvector)))
     157            (#.x8664::subtag-s8-vector
     158             (let* ((v0 (logand #xff
     159                                (the (signed-byte 8)
     160                                  (require-type val '(signed-byte 8)))))
     161                    (l0 (ash (the fixnum (1+ len)) -1)))
     162               (declare (type (unsigned-byte 8) v0)
     163                        (type index l0))
     164               (%init-ivector-u16 l0
     165                                  (logior (the (unsigned-byte 16) (ash v0 8))
     166                                          v0)
     167                                  uvector)))
     168            (#.x8664::subtag-bit-vector
     169             (if (eql 0 val)
     170               uvector
     171               (let* ((v0 (case val
     172                            (1 -1)
     173                            (t (report-bad-arg val 'bit))))
     174                      (l0 (ash (the fixnum (+ len 64)) -6)))
     175                 (declare (type (unsigned-byte 8) v0)
     176                          (type index l0))
     177                 (%%init-ivector64  l0 v0 uvector))))
     178            (t (report-bad-arg uvector
     179                               '(or simple-bit-vector
     180                                   (simple-array (signed-byte 8) (*))
     181                                   (simple-array (unsigned-byte 8) (*))
     182                                   (simple-array (signed-byte 16) (*))
     183                                   (simple-array (unsigned-byte 16) (*)))))))))))
     184             
     185
     186)
     187
     188#-x8664-target
    31189(defun %init-misc (val uvector)
    32190  (dotimes (i (uvsize uvector) uvector)
    33191    (setf (uvref uvector i) val)))
    34 
     192         
    35193
    36194;;; Make a new vector of size newsize whose subtag matches that of oldv-arg.
Note: See TracChangeset for help on using the changeset viewer.