Ignore:
Timestamp:
Aug 5, 2010, 7:33:28 AM (10 years ago)
Author:
gb
Message:

Changes from ARM branch. Need testing ...

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos-boot.lisp

    r13980 r14119  
    14521452                      (setf (%wrapper-cpl wrapper) cpl
    14531453                            (%class.own-wrapper class) wrapper
    1454                             (%wrapper-cpl-bits wrapper) #*1)
     1454                            (%wrapper-cpl-bits wrapper)
     1455                            (let* ((bv (make-array 1 :element-type 'bit)))
     1456                                     (setf (aref bv 0) 1)
     1457                                     bv))
    14551458                      (setf (%class.ctype class) (make-class-ctype class))
    14561459                      (setf (find-class 't) class)
     
    20932096              (find-class 'unsigned-doubleword-vector)
    20942097              (find-class 'double-float-vector))))
     2098
     2099  #+arm-target
     2100  (defparameter *ivector-vector-classes*
     2101    (vector (find-class 'short-float-vector)
     2102            (find-class 'unsigned-long-vector)
     2103            (find-class 'long-vector)
     2104            (find-class 'fixnum-vector)
     2105            (find-class 'base-string)
     2106            (find-class 'unsigned-byte-vector)
     2107            (find-class 'byte-vector)
     2108            *t-class*                   ; old base-string
     2109            (find-class 'unsigned-word-vector)
     2110            (find-class 'word-vector)
     2111            (find-class 'double-float-vector)
     2112            (find-class 'bit-vector)))
     2113
    20952114
    20962115
     
    23062325                (%svref v (+ slice x8664::fulltag-tra-1)) *tagged-return-address-class*
    23072326                (%svref v (+ slice x8664::fulltag-nil)) *null-class*))
     2327        #+arm-target
     2328        (do* ((slice 0 (+ 8 slice)))
     2329             ((= slice 256))
     2330          (declare (type (unsigned-byte 8) slice))
     2331          (setf (%svref v (+ slice arm::fulltag-even-fixnum)) *fixnum-class*
     2332                (%svref v (+ slice arm::fulltag-odd-fixnum))  *fixnum-class*
     2333                (%svref v (+ slice arm::fulltag-cons)) *cons-class*
     2334                (%svref v (+ slice arm::fulltag-nil)) *null-class*
     2335                (%svref v (+ slice arm::fulltag-imm)) *immediate-class*))
     2336
    23082337        (macrolet ((map-subtag (subtag class-name)
    23092338                     `(setf (%svref v ,subtag) (find-class ',class-name))))
     
    23132342          (map-subtag target::subtag-single-float short-float)
    23142343          (map-subtag target::subtag-dead-macptr ivector)
    2315           #-x86-target
    2316           (map-subtag target::subtag-code-vector code-vector)
     2344          #+ppc32-target
     2345          (map-subtag ppc32::subtag-code-vector code-vector)
     2346          #+ppc64-target
     2347          (map-subtag ppc64::subtag-code-vector code-vector)
     2348          #+arm-target
     2349          (map-subtag arm::subtag-code-vector code-vector)
    23172350          #+ppc32-target
    23182351          (map-subtag ppc32::subtag-creole-object creole-object)
     
    23782411              #'%class-of-instance)
    23792412        (setf (%svref v #+ppc-target target::subtag-symbol
     2413                      #+arm-target target::subtag-symbol
    23802414                      #+x8632-target target::subtag-symbol
    23812415                      #+x8664-target target::tag-symbol)
     
    23942428        (setf (%svref v
    23952429                      #+ppc-target target::subtag-function
     2430                      #+arm-target target::subtag-function
    23962431                      #+x8632-target target::subtag-function
    23972432                      #+x8664-target target::tag-function)
     
    24082443                              (ash (the fixnum (- subtype ppc32::min-cl-ivector-subtag))
    24092444                                   (- ppc32::ntagbits))
     2445                              #+arm-target
     2446                              (ash (the fixnum (- subtype arm::min-cl-ivector-subtag))
     2447                                   (- arm::ntagbits))
    24102448                              #+ppc64-target
    24112449                              (ash (the fixnum (logand subtype #x7f)) (- ppc64::nlowtagbits))
     
    25762614   'slot-id-value
    25772615   nil                          ;method-function name
    2578    (dpb 1 $lfbits-numreq (ash 1 $lfbits-method-bit))))
     2616   (dpb 1 $lfbits-numreq (ash 1 $lfbits-method-bit)))
     2617  #+arm-target
     2618  (gvector :function
     2619           arm::*function-initial-entrypoint*
     2620           (uvref *reader-method-function-proto* 1)
     2621           (ensure-slot-id (%slot-definition-name dslotd))
     2622           'slot-id-value
     2623           nil                          ;method-function name
     2624           (dpb 1 $lfbits-numreq (ash 1 $lfbits-method-bit))))
    25792625
    25802626(defmethod create-writer-method-function ((class slots-class)
     
    25952641     nil
    25962642     (dpb 2 $lfbits-numreq (ash 1 $lfbits-method-bit)))
     2643    #+arm-target
     2644    (gvector :function
     2645             arm::*function-initial-entrypoint*
     2646             (uvref *writer-method-function-proto* 1)
     2647             (ensure-slot-id (%slot-definition-name dslotd))
     2648             'set-slot-id-value
     2649             nil
     2650             (dpb 2 $lfbits-numreq (ash 1 $lfbits-method-bit)))
    25972651  )
    25982652
Note: See TracChangeset for help on using the changeset viewer.