Changeset 13822


Ignore:
Timestamp:
Jun 14, 2010, 10:15:29 AM (10 years ago)
Author:
gb
Message:

%WALK-DYNAMIC-AREA.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/level-0/ARM/arm-utils.lisp

    r13797 r13822  
    172172;;; (or at least preserves the relative order of objects in the heap.)
    173173
    174 #+notyet
    175174(defarmlapfunction %walk-dynamic-area ((a arg_y) (f arg_z))
    176   (let ((fun save0)
    177         (obj save1)
    178         (sentinel save2)
     175  (let ((fun temp0)
     176        (obj temp1)
     177        (sentinel temp2)
    179178        (header imm0)
    180179        (tag imm1)
    181         (subtag imm2)
    182         (bytes imm3)
    183         (elements imm4))
    184     (save-lisp-context)
    185     (:regsave sentinel 0)
    186     (vpush fun)
    187     (vpush obj)
    188     (vpush sentinel)
    189     (ref-global imm0 tenured-area)
    190     (cmpwi cr0 imm0 0)
    191     (li allocbase #xfff8)
    192     (la allocptr (- arm::fulltag-cons arm::cons.size) allocptr)
    193     (twllt allocptr allocbase)
     180        (subtag imm2))
     181    (ref-global imm1 tenured-area)   
     182    (build-lisp-frame)
     183    (mov allocptr (:$ -8))
     184    (str allocptr (:@ rcontext (:$ arm::tcr.save-allocbase)))
     185    (cmp imm1 (:$ 0))
     186    (mov fun f)
     187    (movne a imm1)
     188    (sub allocptr allocptr (:$ (- arm::cons.size arm::fulltag-cons)))
     189    (ldr imm1 (:@ rcontext (:$ arm::tcr.save-allocbase)))
     190    (cmp allocptr imm1)
     191    (uuo-alloc-trap (:? lo))
    194192    (mov sentinel allocptr)
    195     (clrrwi allocptr allocptr arm::ntagbits)
    196     (mov fun f)
    197     (if :ne
    198       (mov a imm0))   
    199     (lwz imm5 (:@ a (:$ arm::area.low)))
     193    (bic allocptr allocptr (:$ arm::fulltagmask))
     194    (ldr obj (:@ a (:$ arm::area.low)))
     195    (b @test)
    200196    @loop
    201     (lwz header (:@ imm5 (:$ 0)))
     197    (ldr header (:@ obj (:$ 0)))
    202198    (extract-fulltag tag header)
    203     (cmpwi cr0 tag arm::fulltag-immheader)
    204     (cmpwi cr1 tag arm::fulltag-nodeheader)
    205     (beq cr0 @misc)
    206     (beq cr1 @misc)
    207     (la obj arm::fulltag-cons imm5)
    208     (cmpw cr0 obj sentinel)
    209     (mov arg_z obj)
     199    (cmp tag (:$ arm::fulltag-immheader))   
     200    (cmpne tag (:$ arm::fulltag-nodeheader))
     201    (beq @misc)
     202    (add arg_z obj (:$ arm::fulltag-cons))
     203    (cmp arg_z sentinel)
     204    (bhs @done)
    210205    (set-nargs 1)
    211     (mov temp0 fun)
    212     (beq cr0 @done)
    213     (bla .SPfuncall)
    214     (la imm5 (- arm::cons.size arm::fulltag-cons) obj)
    215     (b @loop)
     206    (stmdb (:! vsp) (fun obj sentinel))
     207    (mov nfn fun)
     208    (bl .SPFuncall)
     209    (ldmia (:! vsp) (fun obj sentinel))
     210    (add obj obj (:$ arm::cons.size))
     211    (b @test)
    216212    @misc
    217     (la obj arm::fulltag-misc imm5)
    218     (mov arg_z obj)
     213    (add arg_z obj (:$ arm::fulltag-misc))
     214    (stmdb (:! vsp) (fun obj sentinel))
    219215    (set-nargs 1)
    220     (mov temp0 fun)
    221     (bla .SPFuncall)
    222     (getvheader header obj)
     216    (mov nfn fun)
     217    (bl .SPFuncall)
     218    (ldmia (:! vsp) (fun obj sentinel))
     219    (ldr header (:@ obj (:$ 0)))
    223220    (extract-fulltag tag header)
    224     (cmpwi cr1 tag arm::fulltag-nodeheader)
    225     (cmpwi cr7 tag arm::fulltag-immheader)
    226     (clrlwi subtag header (- 32 arm::num-subtag-bits))
    227     (cmpwi cr2 subtag arm::max-32-bit-ivector-subtag)
    228     (cmpwi cr3 subtag arm::max-8-bit-ivector-subtag)
    229     (cmpwi cr4 subtag arm::max-16-bit-ivector-subtag)
    230     (cmpwi cr5 subtag arm::subtag-double-float-vector)
    231     (header-size elements header)
    232     (slwi bytes elements 2)
    233     (beq cr1 @bump)
    234     (if (:cr7 :ne)
    235       (twle 0 0))
    236     (ble cr2 @bump)
    237     (mov bytes elements)
    238     (ble cr3 @bump)
    239     (slwi bytes elements 1)
    240     (ble cr4 @bump)
    241     (slwi bytes elements 3)
    242     (beq cr5 @bump)
    243     (la elements 7 elements)
    244     (srwi bytes elements 3)
     221    (cmp tag (:$ arm::fulltag-nodeheader))
     222    (extract-lowbyte subtag header)
     223    (bic header header (:$ arm::subtag-mask))
     224    (mov header (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
     225    (beq @bump)
     226    (cmp subtag (:$ arm::max-32-bit-ivector-subtag))
     227    (bls @bump)
     228    (cmp subtag (:$ arm::max-8-bit-ivector-subtag))
     229    (movls header (:lsr header (:$ 2)))
     230    (bls @bump)
     231    (cmp subtag (:$ arm::max-16-bit-ivector-subtag))
     232    (movls header (:lsr header (:$ 1)))
     233    (bls @bump)
     234    (cmp subtag (:$ arm::subtag-double-float-vector))
     235    (movls header (:lsl header (:$ 1)))
     236    (bls @bump)
     237    (mov header (:lsr header (:$ 2)))
     238    (add header header (:$ 7))
     239    (mov header (:lsr header (:$ 3)))
    245240    @bump
    246     (la bytes (+ 4 7) bytes)
    247     (clrrwi bytes bytes 3)
    248     (subi imm5 obj arm::fulltag-misc)
    249     (add imm5 imm5 bytes)
    250     (cmpw cr0 imm5  sentinel)
    251     (blt cr0 @loop)
    252     (uuo_interr 0 0)
    253     (b @loop)
     241    (add header header (:$ (+ 4 7)))
     242    (bic header header (:$ arm::fulltagmask))
     243    (add obj obj header)
     244    @test
     245    (cmp obj sentinel)
     246    (blo @loop)
     247    (uuo-debug-trap)
    254248    @done
    255     (li arg_z nil)
    256     (vpop sentinel)
    257     (vpop obj)
    258     (vpop fun)
    259     (restore-full-lisp-context)
    260     (bx lr)))
     249    (return-lisp-frame)))
    261250
    262251
Note: See TracChangeset for help on using the changeset viewer.