Changeset 13789


Ignore:
Timestamp:
Jun 8, 2010, 1:14:53 AM (10 years ago)
Author:
gb
Message:

Lots of (mostly small) changes.

Location:
branches/arm
Files:
4 added
29 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/compiler/ARM/arm-arch.lisp

    r13780 r13789  
    1616
    1717(defpackage "ARM"
    18   (:use "CL"))
     18  (:use "CL")
     19  #+arm-target
     20  (:nicknames "TARGET"))
     21
    1922
    2023(require "ARCH")
     
    392395             (defarmsubprim .SPstkgvector)
    393396             (defarmsubprim .SPmisc-alloc)
    394              (defarmsubprim .SPmacro-bind)
    395              (defarmsubprim .SPdestructuring-bind)
    396              (defarmsubprim .SPdestructuring-bind-inner)
     397             (defarmsubprim .SPunused0)
     398             (defarmsubprim .SPunused1)
     399             (defarmsubprim .SPunused2)
    397400             (defarmsubprim .SPrecover-values)
    398401             (defarmsubprim .SPinteger-sign)
     
    406409             (defarmsubprim .SPmisc-alloc-init)
    407410             (defarmsubprim .SPstack-misc-alloc-init)
     411             (defarmsubprim .SPpopj)
    408412             (defarmsubprim .SPlexpr-entry)
    409413             (defarmsubprim .SPgetu64)
     
    431435             (defarmsubprim .SPsdiv32)
    432436             (defarmsubprim .SPeabi-ff-call)
     437             (defarmsubprim .SPdebind)
    433438             )))))
    434439
     
    894899
    895900(arm::define-storage-layout lisp-frame 0
    896   backlink
     901  marker
     902  savevsp
    897903  savefn
    898904  savelr
    899   savevsp
    900905)
    901906
     
    11961201                          :function-tag subtag-function
    11971202                          :function-tag-is-subtag t
    1198                           :big-endian t
     1203                          :big-endian nil
    11991204                          :misc-subtag-offset misc-subtag-offset
    12001205                          :car-offset cons.car
     
    13651370;;; A function's entrypoint should initially reference .SPfix-nfn-entrypoint,
    13661371;;; which will set it to a locative to the function's code-vector.
    1367 (defparameter *function-initial-entrypoint* (ash *arm-subprims-base* (- arm::fixnumshift)))
     1372(defconstant *function-initial-entrypoint* (ash *arm-subprims-base* (- arm::fixnumshift)))
    13681373
    13691374 
  • branches/arm/compiler/ARM/arm-asm.lisp

    r13780 r13789  
    117117    :rs
    118118    :fpaddr
     119    :@rn
    119120    ))
    120121
     
    372373      (#x00e00010 . #x0ff00090))
    373374     ())
    374    (define-arm-instruction tst (:rd :shifter)
     375   (define-arm-instruction tst (:rn :shifter)
    375376     #x01100000
    376377     ((#x03100000 . #x0ff00000)
     
    378379      (#x01100010 . #x0ff00090))
    379380     ())
    380    (define-arm-instruction tsts (:rd :shifter)
     381   (define-arm-instruction tsts (:rn :shifter)
    381382     #x01100000
    382383     ((#x03100000 . #x0ff00000)
     
    408409      (#x01d00010 . #x0ff00090))
    409410     ())
    410    (define-arm-instruction cmp (:rd :shifter)
     411   (define-arm-instruction cmp (:rn :shifter)
    411412     #x01500000
    412413     ((#x03500000 . #x0ff00000)
     
    414415      (#x01500010 . #x0ff00090))
    415416     ())
    416    (define-arm-instruction cmps (:rd :shifter)
     417   (define-arm-instruction cmps (:rn :shifter)
    417418     #x01500000
    418419     ((#x03500000 . #x0ff00000)
     
    686687     #x0f700f00
    687688     ())     
    688    (define-arm-instruction fsts (:sd :fpaddr)
     689   (define-arm-instruction flds (:sd :fpaddr)
    689690     #x0d100a00
    690691     #x0f300f00
    691692     ())
    692    ))
     693   (define-arm-instruction ldrex (:rd :@rn)
     694     #x01900f9f
     695     #x0ff00fff
     696     ())
     697   (define-arm-instruction strex (:rd :rm :@rn)
     698     #x01800f90
     699     #x0ff00ff0
     700     ())
     701   (define-arm-instruction clrex ()
     702     #xf57ff01f
     703     #xffffffff
     704     (:non-conditional))
     705   (define-arm-instruction clz (:rd :rm)
     706     #x016f0f10
     707     #x0fff0ff0
     708     ())
     709 ))
    693710
    694711(dotimes (i (length *arm-instruction-table*))
     
    11471164            (set-field-value instruction (byte 1 23) 1))
    11481165          (set-field-value instruction (byte 8 0) (ash offset-val -3)))))))
     1166
     1167(defun parse-@rn-operand (form instruction)
     1168  (when (or (atom form)
     1169          (not (eq (keywordize (car form)) :@)))
     1170    (error "Invalid register indirect operand: ~s" form))
     1171  (destructuring-bind (rn) (cdr form)
     1172    (set-field-value instruction (byte 4 16) (need-arm-gpr rn))))
    11491173 
    11501174(defparameter *arm-operand-parsers*
     
    11711195      parse-rs-operand
    11721196      parse-fpaddr-operand
     1197      parse-@rn-operand
    11731198      ))
    11741199
  • branches/arm/compiler/ARM/arm-disassemble.lisp

    r13764 r13789  
    266266    extract-arm-rd-operand                  ;rde
    267267    extract-arm-rs-operand
     268    extract-arm-fpaddr-operand
     269    extract-arm-@rn-operand
    268270    ))
    269271
  • branches/arm/compiler/ARM/arm-lap.lisp

    r13761 r13789  
    2626
    2727(defun arm-lap-macro-function (name)
     28  (declare (special *arm-backend*))
    2829  (gethash (string name) (backend-lap-macros *arm-backend*)))
    2930
    3031(defun (setf arm-lap-macro-function) (def name)
     32  (declare (special *arm-backend*))
    3133  (let* ((s (string name)))
    3234    (when (gethash s arm::*arm-instruction-ordinals*)
  • branches/arm/compiler/ARM/arm-vinsns.lisp

    r13780 r13789  
    572572  (rlwinm dest byteval bit-shift 29 29))
    573573
    574 #+notyet
    575574(define-arm-vinsn mem-ref-bit (((dest :u8))
    576575                               ((src :address)
     
    578577                               ((byte-index :s16)
    579578                                (bit-shift :u8)))
    580   (srwi byte-index bit-index (+ arm::fixnumshift 3))
    581   (extrwi bit-shift bit-index 3 27)
    582   (addi bit-shift bit-shift 29)
    583   (lbzx dest src byte-index)
    584   (rlwnm dest dest bit-shift 31 31))
    585 
    586 #+notyet
     579
     580  (mov byte-index (:lsr bit-index (:$ arm::fixnumshift)))
     581  (and bit-shift byte-index (:$ 7))
     582  (ldrb byte-index (:@ src (:lsr byte-index (:$ 5))))
     583  (mov dest (:lsr byte-index bit-shift))
     584  (and dest dest (:$ 1)))
     585
     586
    587587(define-arm-vinsn mem-ref-bit-fixnum (((dest :lisp))
    588588                                      ((src :address)
     
    590590                                      ((byte-index :s16)
    591591                                       (bit-shift :u8)))
    592   (srwi byte-index bit-index (+ arm::fixnumshift 3))
    593   (extrwi bit-shift bit-index 3 27)
    594   (addi bit-shift bit-shift 27)
    595   (lbzx byte-index src byte-index)
    596   (rlwnm dest
    597          byte-index
    598          bit-shift
    599          (- arm::least-significant-bit arm::fixnum-shift)
    600          (- arm::least-significant-bit arm::fixnum-shift)))
     592  (mov byte-index (:lsr bit-index (:$ arm::fixnumshift)))
     593  (and bit-shift byte-index (:$ 7))
     594  (ldrb byte-index (:@ src (:lsr byte-index (:$ 3))))
     595  (mov byte-index (:lsr byte-index bit-shift))
     596  (mov dest (:$ arm::fixnumone))
     597  (and dest dest (:lsl byte-index (:$ arm::fixnumshift))))
    601598
    602599(define-arm-vinsn mem-ref-c-double-float (((dest :double-float))
     
    713710  (strb val (:@ src index)))
    714711
    715 #+later
    716712(define-arm-vinsn mem-set-c-bit-0 (()
    717713                                   ((src :address)
    718714                                    (byte-index :s16const)
    719                                     (mask-begin :u8const)
    720                                     (mask-end :u8const))
     715                                    (mask :u8const))
    721716                                   ((val :u8)))
    722   (lbz val byte-index src)
    723   (rlwinm val val 0 mask-begin mask-end)
    724   (stb val byte-index src))
    725 
    726 #+later
     717  (ldrb val (:@ src (:$ byte-index)))
     718  (bic val val (:$ mask))
     719  (strb val (:@ src (:$ byte-index))))
     720
     721
    727722(define-arm-vinsn mem-set-c-bit-1 (()
    728723                                   ((src :address)
     
    730725                                    (mask :u8const))
    731726                                   ((val :u8)))
    732   (lbz val byte-index src)
    733   (ori val val mask)
    734   (stb val byte-index src))
    735 
    736 #+later
     727  (ldrb val (:@ src (:$ byte-index)))
     728  (orr val val (:$ mask))
     729  (strb val (:@ src (:$ byte-index))))
     730
     731
    737732(define-arm-vinsn mem-set-c-bit (()
    738733                                 ((src :address)
     
    740735                                  (bit-index :u8const)
    741736                                  (val :imm))
    742                                  ((byteval :u8)))
    743   (lbz byteval byte-index src)
    744   (rlwimi byteval val (:apply logand 31 (:apply - 29 bit-index)) bit-index bit-index)
    745   (stb byteval byte-index src))
     737                                 ((byteval :u8)
     738                                  (mask :u8)))
     739  (mov mask (:$ 1))
     740  (mov mask (:lsl mask bit-index))
     741  (cmp val (:$ 0))
     742  (ldrb byteval (:@ src (:$ byte-index)))
     743  (orrne byteval byteval mask)
     744  (biceq byteval byteval mask)
     745  (strb byteval (:@ src (:$ byte-index)))
     746)
    746747
    747748;;; Hey, they should be happy that it even works.  Who cares how big it is or how
    748749;;; long it takes ...
    749 #+later
    750750(define-arm-vinsn mem-set-bit (()
    751751                               ((src :address)
     
    753753                                (val :lisp))
    754754                               ((bit-shift :u32)
    755                                 (mask :u32)
    756                                 (byte-index :u32)))
    757   (cmplwi crf val (ash 1 arm::fixnumshift))
    758   (extrwi bit-shift bit-index 3 27)
    759   (li mask #x80)
    760   (srw mask mask bit-shift)
    761   (ble+ crf :got-it)
    762   (uuo_interr arch::error-object-not-bit src)
    763   :got-it
    764   (srwi bit-shift bit-index (+ 3 arm::fixnumshift))
    765   (lbzx bit-shift src bit-shift)
    766   (beq crf :set)
    767   (andc mask bit-shift mask)
    768   (b :done)
    769   :set
    770   (or mask bit-shift mask)
    771   :done
    772   (srwi bit-shift bit-index (+ 3 arm::fixnumshift))
    773   (stbx mask src bit-shift))
     755                                (mask :u32)))
     756  (cmp val (:$ (ash 1 arm::fixnumshift)))
     757  (mov bit-shift (:$ 7))
     758  (mov mask (:$ 1))
     759  (and bit-shift bit-shift (:lsr bit-index (:$ arm::fixnumshift)))
     760  (mov mask (:lsl mask bit-shift))
     761  (ldrb bit-shift (:@ src (:lsr bit-index (:$ (+ 3 arm::fixnumshift)))))
     762  (uuo-error-reg-not-xtype (:? hi) val (:$ arm::xtype-bit))
     763  (orrne bit-shift bit-shift mask)
     764  (biceq bit-shift bit-shift mask)
     765  (strb bit-shift (:@ src (:lsr bit-index (:$ (+ 3 arm::fixnumshift))))))
    774766     
    775767;;; Tag and subtag extraction, comparison, checking, trapping ...
     
    13461338  (cmp arg (:$ imm)))
    13471339
    1348 (define-arm-vinsn double-float-compare (()
     1340(define-arm-vinsn double-float-compare (((crf :crf))
    13491341                                        ((arg0 :double-float)
    13501342                                         (arg1 :double-float))
     
    14821474  (str cell (:@ new (:$ arm::cons.cdr))))
    14831475
    1484 #+later
     1476
    14851477(define-arm-vinsn load-adl (()
    14861478                            ((n :u32const)))
    1487   (lis nargs (:apply ldb (byte 16 16) n))
    1488   (ori nargs nargs (:apply ldb (byte 16 0) n)))
     1479  (mov nargs (:$ (:apply logand #x00ff0000 n)))
     1480  ((:not (:pred = 0 (:apply logand #xff000000 n)))
     1481   (orr nargs nargs (:$ (:apply logand #xff000000 n))))
     1482  ((:not (:pred = 0 (:apply logand #x0000ff00 n)))
     1483   (orr nargs nargs (:$ (:apply logand #x0000ff00 n))))
     1484  ((:not (:pred = 0 (:apply logand #x000000ff n)))
     1485   (orr nargs nargs (:$ (:apply logand #x000000ff n)))))
    14891486                           
    14901487(define-arm-vinsn set-nargs (()
     
    17831780  (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    17841781
    1785 (define-arm-vinsn set-eabi-single-c-arg (()
     1782
     1783(define-arm-vinsn set-single-eabi-c-arg (()
    17861784                                    ((argval :single-float)
    17871785                                     (argnum :u16const)))
    17881786  (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    17891787
    1790 (define-arm-vinsn set-eabi-double-c-arg (()
     1788(define-arm-vinsn set-double-eabi-c-arg (()
    17911789                                         ((argval :double-float)
    17921790                                          (argnum :u16const)))
     
    18741872  (sub allocptr allocptr (:$ (:apply
    18751873                              logand #xff
    1876                               (:apply - (:apply logand (lognot 7)
    1877                                                 (:apply + (+ 7 4) nbytes))))))
    1878   ((:pred > (:apply -
    1879                     (:apply logand (lognot 7)
    1880                             (:apply + (+ 7 4) nbytes))
     1874                              (:apply -  (:apply logand (lognot 7)
     1875                                                 (:apply + (+ 7 4) nbytes))
     1876                                      arm::fulltag-misc))))
     1877  ((:pred > (:apply - (:apply logand (lognot 7)
     1878                              (:apply + (+ 7 4) nbytes))
    18811879                    arm::fulltag-misc) #xff)
    18821880   (sub allocptr allocptr (:$ (:apply logand #xff00
    1883                                  (:apply -
    1884                                     (:apply logand (lognot 7)
    1885                                     (:apply + (+ 7 4) nbytes))
    1886                                     arm::fulltag-misc)))))
     1881                                      (:apply -
     1882                                              (:apply logand (lognot 7)
     1883                                                      (:apply + (+ 7 4) nbytes))
     1884                                              arm::fulltag-misc)))))
    18871885  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
    18881886  (cmp allocptr dest)
     
    26792677  (add sp sp (:$ arm::dnode-size)))
    26802678
    2681 #+notyet
    26822679(define-arm-vinsn (temp-push-double-float :push :doubleword :sp)
    26832680    (()
     
    26892686  (fstd d (:@ sp (:$ 8))))
    26902687
    2691 #+notyet
    26922688(define-arm-vinsn (temp-pop-double-float :pop :doubleword :sp)
    26932689    (()
     
    26962692  (add sp sp (:$ (* 2 arm::dnode-size))))
    26972693
    2698 #+notyet
     2694
    26992695(define-arm-vinsn (temp-push-single-float :push :word :tsp)
    27002696    (()
     
    27062702  (fsts s (:@ sp (:$ 4))))
    27072703
    2708 #+notyet
     2704
    27092705(define-arm-vinsn (temp-pop-single-float :pop :word :sp)
    27102706    (()
    27112707     ((s :single-float)))
    2712   (flds s (:@ sp 4))
     2708  (flds s (:@ sp (:$ 4)))
    27132709  (add sp sp (:$ arm::dnode-size)))
    27142710
     
    27342730(define-arm-vinsn zero-double-float-register (((dest :double-float))
    27352731                                              ()
    2736                                               ((temp t)))
     2732                                              ((temp :imm)))
    27372733  (mov temp (:$ 0))
    27382734  (fmsr dest temp))
     
    27402736(define-arm-vinsn zero-single-float-register (((dest :single-float))
    27412737                                              ()
    2742                                               ((temp t)))
     2738                                              ((temp :imm)))
    27432739  (mov temp (:$ 0))
    27442740  (fmdrr dest temp temp))
     
    28052801
    28062802
    2807 #+later
    2808 (define-arm-vinsn save-lisp-context-lexpr (()
    2809                                            ()
    2810                                            ((imm :u32)))
    2811   (stwu arm::sp (- arm::lisp-frame.size) arm::sp)
    2812   (str arm::rzero (:@ arm::sp (:$ arm::lisp-frame.savefn)))
    2813   (str arm::loc-pc (:@ arm::sp (:$ arm::lisp-frame.savelr)))
    2814   (str vsp (:@ arm::sp (:$ arm::lisp-frame.savevsp)))
    2815   (mr arm::fn arm::nfn)
    2816   ;; Do a stack-probe ...
    2817   (ldr imm (:@ rcontext (:$ arm::tcr.cs-limit)))
    2818   (twllt arm::sp imm))
    28192803 
    28202804(define-arm-vinsn save-cleanup-context (()
     
    28272811;; Vpush the argument registers.  We got at least "min-fixed" args;
    28282812;; that knowledge may help us generate better code.
    2829 #+later
    28302813(define-arm-vinsn (save-lexpr-argregs :call :subprim-call)
    28312814    (()
    28322815     ((min-fixed :u16const))
    2833      ((crfx :crf)
    2834       (crfy :crf)
    2835       (entry-vsp (:u32 #.arm::imm0))
    2836       (arg-temp :u32)))
     2816     ((entry-vsp (:u32 #.arm::imm1))
     2817      (arg-temp (:u32 #.arm::imm0))
     2818      (other-temp :imm)))
    28372819  ((:pred >= min-fixed $numarmargregs)
    2838    (stwu arm::arg_x -4 vsp)   
    2839    (stwu arm::arg_y -4 vsp)   
    2840    (stwu arm::arg_z -4 vsp))
     2820   (stm (:! vsp) (arg_z arg_y arg_x)))
    28412821  ((:pred = min-fixed 2)                ; at least 2 args
    2842    (cmplwi crfx nargs (ash 2 arm::word-shift))
    2843    (beq crfx :yz2)                      ; skip arg_x if exactly 2
    2844    (stwu arm::arg_x -4 vsp)
    2845    :yz2
    2846    (stwu arm::arg_y -4 vsp)
    2847    (stwu arm::arg_z -4 vsp))
     2822   (cmp nargs (:$ (ash 2 arm::word-shift)))
     2823   (strne arg_x (:@! vsp (:$ -4)))
     2824   (stm (:! vsp) (arg_z arg_y)))
    28482825  ((:pred = min-fixed 1)                ; at least one arg
    2849    (cmplwi crfx nargs (ash 2 arm::word-shift))
    2850    (blt crfx :z1)                       ; branch if exactly one
    2851    (beq crfx :yz1)                      ; branch if exactly two
    2852    (stwu arm::arg_x -4 vsp)
    2853    :yz1
    2854    (stwu arm::arg_y -4 vsp)   
    2855    :z1
    2856    (stwu arm::arg_z -4 vsp))
     2826   (cmp nargs (:$ (ash 2 arm::word-shift)))
     2827   (strlo arg_z (:@! vsp (:$ (- arm::node-size))))
     2828   (stmeq (:! vsp) (arg_z arg_y))
     2829   (stmhi (:! vsp) (arg_z arg_y arg_x)))
    28572830  ((:pred = min-fixed 0)
    2858    (cmplwi crfx nargs (ash 2 arm::word-shift))
    2859    (cmplwi crfy nargs 0)
    2860    (beq crfx :yz0)                      ; exactly two
    2861    (beq crfy :none)                     ; exactly zero
    2862    (blt crfx :z0)                       ; one
    2863                                         ; Three or more ...
    2864    (stwu arm::arg_x -4 vsp)
    2865    :yz0
    2866    (stwu arm::arg_y -4 vsp)
    2867    :z0
    2868    (stwu arm::arg_z -4 vsp)
    2869    :none
     2831   (cmp nargs (:$ 0))
     2832   (beq :done)
     2833   (cmp nargs (:$ (ash 2 arm::word-shift)))
     2834   (strlo arg_z (:@! vsp (:$ (- arm::node-size))))
     2835   (stmeq (:! vsp) (arg_z arg_y))
     2836   (stmhi (:! vsp) (arg_z arg_y arg_x))
     2837   :done
    28702838   )
    28712839  ((:pred = min-fixed 0)
    2872    (stwu nargs -4 vsp))
     2840   (str nargs (:@! vsp (:$ -4))))
    28732841  ((:not (:pred = min-fixed 0))
    2874    (subi arg-temp nargs (:apply ash min-fixed arm::word-shift))
    2875    (stwu arg-temp -4 vsp))
     2842   (sub arg-temp nargs (:$ (:apply ash min-fixed arm::word-shift)))
     2843   (str arg-temp (:@! vsp (:$ -4))))
    28762844  (add entry-vsp vsp nargs)
    2877   (la entry-vsp 4 entry-vsp)
    2878   (bl .SPlexpr-entry))
     2845  (mov other-temp (:$ (- arm::nil-value arm::fulltag-nil)))
     2846  (ldr other-temp (:@ other-temp (:$ (arm::%kernel-global 'arm::ret1valaddr))))
     2847  (add entry-vsp entry-vsp (:$ 4))
     2848  (cmp other-temp lr)
     2849  (mov arg-temp (:$ arm::lisp-frame-marker))
     2850  (stmdb (:! vsp) (arg-temp entry-vsp fn lr))
     2851  (mov fn (:$ 0))
     2852  (moveq lr (:$ (- arm::nil-value arm::fulltag-nil)))
     2853  (ldreq lr (:@ lr (:$ (arm::%kernel-global 'arm::lexpr-return))))
     2854  (stmdbeq (:! vsp) (arg-temp entry-vsp fn lr))
     2855  (moveq lr other-temp)
     2856  (movne lr (:$ (- arm::nil-value arm::fulltag-nil)))
     2857  (ldrne lr (:@ lr (:$ (arm::%kernel-global 'arm::lexpr-return1v))))
     2858  )
     2859
    28792860
    28802861
     
    32883269(define-arm-subprim-call-vinsn (slide-values) .SPmvslide)
    32893270
    3290 (define-arm-subprim-call-vinsn (macro-bind) .SPmacro-bind)
    3291 
    3292 (define-arm-subprim-call-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
    3293 
    3294 (define-arm-subprim-call-vinsn (destructuring-bind) .SPdestructuring-bind)
     3271
     3272(define-arm-subprim-call-vinsn (debind) .SPdebind)
    32953273
    32963274
  • branches/arm/compiler/ARM/arm2.lisp

    r13780 r13789  
    896896    (dotimes (i num-fixed)
    897897      (! copy-lexpr-argument))
    898     (! save-lisp-context-lexpr)))
     898    (! save-lisp-context-vsp)))
    899899
    900900(defun arm2-load-lexpr-address (seg dest)
     
    23092309           (expression-p (or (typep fn 'lreg) (and (fixnump fn) (not label-p))))
    23102310           (callable (or symp lfunp label-p))
    2311            (destreg (if symp ($ arm::fname) (if lfunp ($ arm::nfn) (unless label-p ($ arm::temp0)))))
     2311           (destreg (if symp ($ arm::fname) (if lfunp ($ arm::nfn) (unless label-p ($ arm::nfn)))))
    23122312           (alternate-tail-call
    23132313            (and tail-p label-p *arm2-tail-label* (eql nargs *arm2-tail-nargs*) (not spread-p)))
     
    31373137         (! double-float-compare dest ireg jreg)
    31383138         (^ cr-bit true-p))
    3139        (with-imm-temps () ((lowbit-reg :natural))
     3139       (progn
    31403140         (with-crf-target () flags
    31413141           (! double-float-compare flags ireg jreg)
    3142            (! crbit->bit31 lowbit-reg flags cr-bit))
    3143          (unless true-p
    3144            (! invert-lowbit lowbit-reg))
    3145          (ensuring-node-target (target dest)
    3146            (! lowbit->truth target lowbit-reg))
     3142
     3143           (! cond->boolean dest (if true-p cr-bit (logxor cr-bit 1))))
    31473144         (^)))
    31483145      (^))))
     
    45284525        (arm2-init-regvar seg var reg (arm2-vloc-ea vloc))
    45294526        (arm2-bind-var seg var vloc lcell)))
    4530     (let* ((v2 (%cdr var))
    4531            (v v2)
    4532            (vstack *arm2-vstack*)
    4533            (whole (pop v))
    4534            (req (pop v))
    4535            (opt (pop v))
    4536            (rest (pop v))
    4537            (keys (pop v)))
    4538      
    4539       (apply #'arm2-bind-structured-lambda seg
    4540              (arm2-spread-lambda-list seg (arm2-vloc-ea vloc) whole req opt rest keys context)
    4541              vstack context v2))))
     4527    (compiler-bug "Old destructuring code ...")))
    45424528
    45434529(defun arm2-bind-structured-lambda (seg lcells vloc context whole req opt rest keys auxen
     
    46734659            (compiler-bug "unknown payback token ~s" r)))))))
    46744660
    4675 (defun arm2-spread-lambda-list (seg listform whole req opt rest keys
    4676                                     &optional enclosing-ea cdr-p)
     4661(defun arm2-spread-lambda-list (seg listform whole req opt rest keys)
    46774662  (with-arm-local-vinsn-macros (seg)
    46784663    (let* ((numopt (length (%car opt)))
     
    46814666           (vtotal numreq)
    46824667           (old-top *arm2-top-vstack-lcell*)
    4683            (listreg ($ arm::temp3))
     4668           (listreg ($ arm::arg_z))
    46844669           (doadlword (dpb nkeys (byte 8 16) (dpb numopt (byte 8 8) (dpb numreq (byte 8 0) 0 )))))
    46854670      (declare (fixnum numopt nkeys numreq vtotal doadlword))
     
    46924677        (arm2-vpush-register seg listreg :reserved))
    46934678      (when keys
    4694         (setq doadlword (%ilogior2 (ash #x80000000 -6) doadlword))
     4679        (setq doadlword (%ilogior2 (ash 1 25) doadlword))
    46954680        (incf  vtotal (%ilsl 1 nkeys))
    46964681        (if (%car keys)                 ; &allow-other-keys
     
    47004685        (setq vtotal (%i+ vtotal numopt))
    47014686        (when (arm2-hard-opt-p opt)
    4702           (setq doadlword (%ilogior2 doadlword (ash #x80000000 -7)))
     4687          (setq doadlword (logior doadlword (ash 1 29)))
    47034688          (setq vtotal (%i+ vtotal numopt))))
    47044689      (when rest
    4705         (setq doadlword (%ilogior2 (ash #x80000000 -4) doadlword) vtotal (%i+ vtotal 1)))
     4690        (setq doadlword (%ilogior2 (ash 1 26) doadlword) vtotal (%i+ vtotal 1)))
    47064691      (arm2-reserve-vstack-lcells vtotal)
    47074692      (! load-adl doadlword)
    4708       (if cdr-p
    4709         (! macro-bind)
    4710         (if enclosing-ea
    4711           (progn
    4712             (arm2-store-ea seg enclosing-ea arm::arg_z)
    4713             (! destructuring-bind-inner))
    4714           (! destructuring-bind)))
     4693      (! debind)
    47154694      (arm2-set-vstack (%i+ *arm2-vstack* (* *arm2-target-node-size* vtotal)))
    47164695      (arm2-collect-lcells :reserved old-top))))
     
    49624941                (unless (or rest keys)
    49634942                  (! check-max-nargs (+ num-fixed num-opt)))
    4964                 (! save-lisp-context-variable)
     4943                (unless lexprp
     4944                  (! save-lisp-context-variable))
    49654945                ;; If there were &optional args, initialize their values
    49664946                ;; to NIL.  All of the argregs get vpushed as a result of this.
     
    64256405(defarm2 arm2-debind debind (seg vreg xfer lambda-list bindform req opt rest keys auxen whole body p2decls cdr-p)
    64266406  (declare (ignore lambda-list))
     6407  (when cdr-p
     6408    (compiler-bug "Unsupported: old destructuring code, cdr-p case."))
    64276409  (let* ((old-stack (arm2-encode-stack))
    64286410         (*arm2-top-vstack-lcell* *arm2-top-vstack-lcell*)
     
    64316413      (arm2-bind-structured-lambda
    64326414       seg
    6433        (arm2-spread-lambda-list seg bindform whole req opt rest keys nil cdr-p)
     6415       (arm2-spread-lambda-list seg bindform whole req opt rest keys)
    64346416       vloc (arm2-vloc-ea vloc) whole req opt rest keys auxen)
    64356417      (arm2-undo-body seg vreg xfer body old-stack)
     
    72187200                                          i ($ arm::arg_y)
    72197201                                          j ($ arm::arg_z))
    7220            (arm2-fixed-call-builtin seg vreg xfer 'SParef2))))  )
     7202           (arm2-fixed-call-builtin seg vreg xfer '.SParef2))))  )
    72217203
    72227204
     
    72767258                                         j ($ arm::arg_y)
    72777259                                         k ($ arm::arg_z))
    7278            (arm2-fixed-call-builtin seg vreg xfer 'SParef3)))))
     7260           (arm2-fixed-call-builtin seg vreg xfer '.SParef3)))))
    72797261
    72807262(defarm2 arm2-%aset2 simple-typed-aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1)
  • branches/arm/level-0/ARM/arm-clos.lisp

    r13699 r13789  
    2525;;; be used when there are less than 255 slots in the class.
    2626(defarmlapfunction %small-map-slot-id-lookup ((slot-id arg_z))
    27   (ldr temp1 'map nfn)
    28   (svref arg_x slot-id.index slot-id)
    29   (getvheader imm0 temp1)
    30   (header-length imm3 imm0)
    31   (ldr temp0 'table nfn)
    32   (cmplr arg_x imm3)
    33   (srri imm0 arg_x target::word-shift)
    34   (la imm0 target::misc-data-offset imm0)
    35   (li imm1 target::misc-data-offset)
    36   (bge @have-scaled-table-index)
    37   (lbzx imm1 temp1 imm0)
    38   (slri imm1 imm1 target::word-shift)
    39   (la imm1 target::misc-data-offset imm1)
    40   @have-scaled-table-index
    41   (ldrx arg_z temp0 imm1)
    42   (blr))
     27  (ldr temp1 (:@ nfn 'map))
     28  (svref arg_x slot-id.index slot-id)
     29  (getvheader imm0 temp1)
     30  (header-length imm1 imm0)
     31  (ldr temp0 (:@ nfn 'table))
     32  (cmp arg_x imm1)
     33  (mov imm0 (:lsr arg_x (:$ arm::word-shift)))
     34  (add imm0 imm0 (:$ arm::misc-data-offset))
     35  (mov imm1 (:$ arm::misc-data-offset))
     36  (ldrblo imm1 (:@ temp1 imm0))
     37  (movlo imm1 (:lsr imm1 (:$ arm::word-shift)))
     38  (addlo imm1 imm1 (:$ arm::misc-data-offset))
     39  (ldr arg_z (:@ temp0 imm1))
     40  (bx lr))
    4341
    4442;;; The same idea, only the map is a vector of (UNSIGNED-BYTE 32).
    4543(defarmlapfunction %large-map-slot-id-lookup ((slot-id arg_z))
    46   (ldr temp1 'map nfn)
    47   (svref arg_x slot-id.index slot-id)
    48   (getvheader imm0 temp1)
    49   (header-length imm3 imm0)
    50   (ldr temp0 'table nfn)
    51   (cmplr arg_x imm3)
    52   #+ppc64-target
    53   (progn
    54     (srdi imm0 imm0 1)
    55     (la imm0 target::misc-data-offset imm0))
    56   #+pp32-target
    57   (progn
    58     (la imm0 target::misc-data-offset arg_x))
    59   (li imm1 target::misc-data-offset)
    60   (bge @have-scaled-table-index)
    61   (lwzx imm1 temp1 imm0)
    62   (slri imm1 imm1 target::word-shift)
    63   (la imm1 target::misc-data-offset imm1)
     44  (ldr temp1 (:@ nfn 'map))
     45  (svref arg_x slot-id.index slot-id)
     46  (getvheader imm0 temp1)
     47  (header-length imm1 imm0)
     48  (ldr temp0 (:@ nfn 'table))
     49  (cmp arg_x imm1)
     50  (add imm0 arg_x (:$ arm::misc-data-offset))
     51  (mov imm1 (:$ arm::misc-data-offset))
     52  (ldrlo imm1 (:@ temp1 imm0))
     53  (movhi imm1 (:lsr imm1 (:$ arm::word-shift)))
     54  (addlo imm1 imm1 (:$ arm::misc-data-offset))
     55  (ldr arg_z (:@ temp0 imm1))
     56  (bx lr))
     57
     58(defarmlapfunction %small-slot-id-value ((instance arg_y) (slot-id arg_z))
     59  (ldr temp1 (:@ nfn 'map))
     60  (svref arg_x slot-id.index slot-id)
     61  (getvheader imm0 temp1)
     62  (ldr temp0 (:@ nfn 'table))
     63  (header-length imm1 imm0)
     64  (cmp arg_x imm1)
     65  (mov imm0 (:lsr arg_x (:$ arm::word-shift)))
     66  (add imm0 imm0 (:$ arm::misc-data-offset))
     67  (bhs @missing)
     68  (ldrb imm1 (:@ temp1 imm0))
     69  (cmp imm1 (:$ 0))
     70  (mov imm1 (:lsr imm1 (:$ arm::word-shift)))
     71  (add imm1 imm1 (:$ arm::misc-data-offset))
     72  (beq @missing)
     73  (ldr arg_z (:@ temp0 imm1))
     74  (ldr arg_x (:@ nfn 'class))
     75  (ldr nfn (:@ nfn '%maybe-std-slot-value))
     76  (set-nargs 3)
     77  (ldr pc (:@ nfn (:$ arm::function.entrypoint)))
     78  @missing                              ; (%slot-id-ref-missing instance id)
     79  (ldr nfn (:@ nfn '%slot-id-ref-missing))
     80  (set-nargs 2)
     81  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
     82
     83(defarmlapfunction %large-slot-id-value ((instance arg_y) (slot-id arg_z))
     84  (ldr temp1 (:@ nfn 'map))
     85  (svref arg_x slot-id.index slot-id)
     86  (getvheader imm0 temp1)
     87  (ldr temp0 (:@ nfn 'table))
     88  (header-length imm1 imm0)
     89  (cmp arg_x imm1)
     90  (add imm0 arg_x (:$ arm::misc-data-offset))
     91  (bhs @missing)
     92  (ldr imm1 (:@ temp1 imm0))
     93  (cmp imm1 (:$ 0))
     94  (mov imm1 (:lsr imm1 (:$ arm::word-shift)))
     95  (add imm1 imm1 (:$ arm::misc-data-offset))
     96  (beq @missing)
    6497  @have-scaled-table-index
    65   (ldrx arg_z temp0 imm1)
    66   (blr))
    67 
    68 (defarmlapfunction %small-slot-id-value ((instance arg_y) (slot-id arg_z))
    69   (ldr temp1 'map nfn)
    70   (svref arg_x slot-id.index slot-id)
    71   (getvheader imm0 temp1)
    72   (ldr temp0 'table nfn)
    73   (header-length imm3 imm0)
    74   (cmplr arg_x imm3)
    75   (srri imm0 arg_x target::word-shift)
    76   (la imm0 target::misc-data-offset imm0)
    77   (bge @missing)
    78   (lbzx imm1 temp1 imm0)
    79   (cmpri imm1 0)
    80   (slri imm1 imm1 target::word-shift)
    81   (la imm1 target::misc-data-offset imm1)
    82   (beq @missing)
    83   (ldrx arg_z temp0 imm1)
    84   (ldr arg_x 'class nfn)
    85   (ldr nfn '%maybe-std-slot-value nfn)
    86   (ldr temp0 target::misc-data-offset nfn)
    87   (set-nargs 3)
    88   (mtctr temp0)
    89   (bctr)
     98  (ldr arg_x (:@ nfn 'class))
     99  (ldr nfn (:@ nfn '%maybe-std-slot-value-using-class))
     100  (ldr arg_z (:@ temp0 imm1))
     101  (set-nargs 3)
     102  (ldr pc (:@ nfn (:$ arm::function.entrypoint)))
    90103  @missing                              ; (%slot-id-ref-missing instance id)
    91   (ldr nfn '%slot-id-ref-missing nfn)
     104  (ldr nfn (:@ nfn '%slot-id-ref-missing))
    92105  (set-nargs 2)
    93   (ldr temp0 target::misc-data-offset nfn)
    94   (mtctr temp0)
    95   (bctr))
    96 
    97 (defarmlapfunction %large-slot-id-value ((instance arg_y) (slot-id arg_z))
    98   (ldr temp1 'map nfn)
    99   (svref arg_x slot-id.index slot-id)
    100   (getvheader imm0 temp1)
    101   (ldr temp0 'table nfn)
    102   (header-length imm3 imm0)
    103   (cmplr arg_x imm3)
    104   #+ppc64-target
    105   (progn
    106     (srdi imm0 arg_x 1)
    107     (la imm0 target::misc-data-offset imm0))
    108   #+ppc32-target
    109   (progn
    110     (la imm0 target::misc-data-offset arg_x))
    111   (bge @missing)
    112   (lwzx imm1 temp1 imm0)
    113   (cmpri imm1 0)
    114   (slri imm1 imm1 target::word-shift)
    115   (la imm1 target::misc-data-offset imm1)
    116   (beq @missing)
    117   @have-scaled-table-index
    118   (ldr arg_x 'class nfn)
    119   (ldr nfn '%maybe-std-slot-value-using-class nfn)
    120   (ldrx arg_z temp0 imm1)
    121   (ldr temp0 target::misc-data-offset nfn)
    122   (set-nargs 3)
    123   (mtctr temp0)
    124   (bctr)
    125   @missing                              ; (%slot-id-ref-missing instance id)
    126   (ldr nfn '%slot-id-ref-missing nfn)
    127   (set-nargs 2)
    128   (ldr temp0 target::misc-data-offset nfn)
    129   (mtctr temp0)
    130   (bctr))
     106  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    131107 
    132108(defarmlapfunction %small-set-slot-id-value ((instance arg_x)
    133109                                             (slot-id arg_y)
    134110                                             (new-value arg_z))
    135   (ldr temp1 'map nfn)
    136   (svref imm3 slot-id.index slot-id)
    137   (getvheader imm0 temp1)
    138   (ldr temp0 'table nfn)
    139   (header-length imm5 imm0)
    140   (cmplr imm3 imm5)
    141   (srri imm0 imm3 target::word-shift)
    142   (la imm0 target::misc-data-offset imm0)
    143   (bge @missing)
    144   (lbzx imm1 temp1 imm0)
    145   (cmpwi imm1 0)
    146   (slri imm1 imm1 target::word-shift)
    147   (la imm1 target::misc-data-offset imm1)
     111  (ldr temp1 (:@ nfn 'map))
     112  (svref temp0 slot-id.index slot-id)
     113  (getvheader imm0 temp1)
     114  (ldr temp0 (:@ nfn 'table))
     115  (header-length imm1 imm0)
     116  (cmp temp0 imm1)
     117  (mov imm0 (:lsr temp0 (:$ arm::word-shift)))
     118  (add imm0 imm0 (:$ arm::misc-data-offset))
     119  (bhs @missing)
     120  (ldrb imm1 (:@ temp1 imm0))
     121  (cmp imm1 (:$ 0))
     122  (mov imm1 (:lsr imm1 (:$ arm::word-shift)))
     123  (add imm1 imm1 (:$ arm::misc-data-offset))
    148124  (beq @missing)
    149125  @have-scaled-table-index
    150   (ldr temp1 'class nfn)
    151   (ldrx arg_y temp0 imm1)
    152   (ldr nfn '%maybe-std-setf-slot-value-using-class nfn)
     126  (ldr temp1 (:@ nfn 'class))
     127  (ldr arg_y (:@ temp0 imm1))
     128  (ldr nfn (:@ nfn '%maybe-std-setf-slot-value-using-class))
    153129  (set-nargs 4)
    154   (ldr temp0 target::misc-data-offset nfn)
    155   (vpush temp1)
    156   (mtctr temp0)
    157   (bctr)
     130  (vpush1 temp1)
     131  (ldr pc (:@ nfn (:$ arm::function.entrypoint)))
    158132  @missing                              ; (%slot-id-set-missing instance id new-value)
    159   (ldr nfn '%slot-id-set-missing nfn)
    160   (set-nargs 3)
    161   (ldr temp0 target::misc-data-offset nfn)
    162   (mtctr temp0)
    163   (bctr))
     133  (ldr nfn (:@ nfn '%slot-id-set-missing))
     134  (set-nargs 3)
     135  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    164136
    165137(defarmlapfunction %large-set-slot-id-value ((instance arg_x)
    166138                                             (slot-id arg_y)
    167139                                             (new-value arg_z))
    168   (ldr temp1 'map nfn)
    169   (svref imm3 slot-id.index slot-id)
    170   (getvheader imm0 temp1)
    171   (ldr temp0 'table nfn)
    172   (header-length imm5 imm0)
    173   (cmplr imm3 imm5)
    174   #+ppc64-target (srdi imm3 imm3 1)
    175   (la imm0 target::misc-data-offset imm3)
    176   (bge @missing)
    177   (lwzx imm1 temp1 imm0)
    178   (cmpwi imm1 0)
    179   (slri imm1 imm1 target::word-shift)
    180   (la imm1 target::misc-data-offset imm1)
     140  (ldr temp1 (:@ nfn 'map))
     141  (svref temp0 slot-id.index slot-id)
     142  (getvheader imm0 temp1)
     143  (ldr temp0 (:@ nfn 'table))
     144  (header-length imm1 imm0)
     145  (cmp temp0 imm1)
     146  (add imm0 temp0 (:$ arm::misc-data-offset))
     147  (bhs @missing)
     148  (ldr imm1 (:@ temp1 imm0))
     149  (cmp imm1 (:$ 0))
     150  (mov imm1 (:lsr imm1 (:$ arm::word-shift)))
     151  (add imm1 imm1 (:$ arm::misc-data-offset))
    181152  (beq @missing)
    182153  @have-scaled-table-index
    183   (ldr temp1 'class nfn)
    184   (ldrx arg_y temp0 imm1)
    185   (ldr nfn '%maybe-std-setf-slot-value-using-class nfn)
     154  (ldr temp1 (:@ nfn 'class))
     155  (ldr arg_y (:@ temp0 imm1))
     156  (ldr nfn (:@ nfn '%maybe-std-setf-slot-value-using-class))
    186157  (set-nargs 4)
    187   (svref temp0 0 nfn)
    188   (vpush temp1)
    189   (mtctr temp0)
    190   (bctr)
     158  (vpush1 temp1)
     159  (ldr pc (:@ nfn (:$ arm::function.entrypoint)))
    191160  @missing                              ; (%slot-id-set-missing instance id new-value)
    192   (ldr nfn '%slot-id-ref-missing nfn)
    193   (set-nargs 3)
    194   (ldr temp0 target::misc-data-offset nfn)
    195   (mtctr temp0)
    196   (bctr))
    197 
    198 #-dont-use-lexprs
    199 (defparameter *gf-proto*
    200   (nfunction
    201    gag
    202    (lambda (&lap &lexpr args)
    203      (ppc-lap-function
    204       gag
    205       ()
    206       (mflr loc-pc)
    207       (vpush-argregs)
    208       (vpush nargs)
    209       (add imm0 vsp nargs)
    210       (la imm0 (ash 1 target::word-shift) imm0)                  ; caller's vsp
    211       (bla .SPlexpr-entry)
    212       (mtlr loc-pc)                     ; return to kernel
    213       (mr arg_z vsp)                    ; lexpr
    214       (svref arg_y gf.dispatch-table nfn) ; dispatch table
    215       (set-nargs 2)
    216       (svref nfn gf.dcode nfn)          ; dcode function
    217       (ldr temp0 target::misc-data-offset nfn)
    218       (mtctr temp0)
    219       (bctr)))))
    220 
    221 #+dont-use-lexprs
    222 (defparameter *gf-proto*
    223   (nfunction
    224    gag
    225    (lambda (&lap &rest args)
    226      (ppc-lap-function
    227       gag
    228       ()
    229       ;;(bkpt)
    230       (mflr loc-pc)
    231       (bla .SPstack-rest-arg)
    232       (vpop arg_z)
    233       (stru sp (- target::lisp-frame.size) sp)
    234       (str fn target::lisp-frame.savefn sp)
    235       (str loc-pc target::lisp-frame.savelr sp)
    236       (str vsp target::lisp-frame.savevsp sp)
    237       (mr fn nfn)
    238       ;; If we were called for multiple values, call the dcode
    239       ;; for multiple values.
    240       (ref-global imm0 ret1valaddr)
    241       (cmpr imm0 loc-pc)
    242       (svref arg_y gf.dispatch-table fn) ; dispatch table
    243       (set-nargs 2)
    244       (svref nfn gf.dcode fn)           ; dcode function
    245       (beq @multiple)
    246       (ldr temp0 target::misc-data-offset nfn)
    247       (mtctr temp0)
    248       (bctrl)
    249       (ldr tsp 0 tsp)
    250       (restore-full-lisp-context)
    251       (blr)
    252       @multiple
    253       (bl @getback)
    254       (mflr loc-pc)
    255       (stru sp (- target::lisp-frame.size) sp)
    256       (str fn target::lisp-frame.savefn sp)
    257       (str loc-pc target::lisp-frame.savelr sp)
    258       (str vsp target::lisp-frame.savevsp sp)
    259       (mtlr imm0)
    260       (li fn 0)
    261       (ldr temp0 target::misc-data-offset nfn)
    262       (mtctr temp0)
    263       (bctr)
    264       @getback
    265       (blrl)
    266       @back
    267       (ldr tsp 0 tsp)
    268       (ba .SPnvalret)))))
     161  (ldr nfn (:@ nfn '%slot-id-ref-missing))
     162  (set-nargs 3)
     163  (ldr pc (:@ nfn (:$ arm::function.entrypoint)))
     164)
     165
     166
     167
     168
    269169     
    270170     
     
    276176;;; This can't reference any of the function's constants.
    277177(defarmlapfunction unset-fin-trampoline ()
    278   (mflr loc-pc)
    279   (bla .SPheap-rest-arg)                ; cons up an &rest arg, vpush it
    280   (vpop arg_z)                          ; whoops, didn't really want to
    281   (bla .SPsavecontextvsp)
    282   (li arg_x '#.$XNOFINFUNCTION)
    283   (mr arg_y nfn)
    284   (set-nargs 3)
    285   (bla .SPksignalerr)
    286   (li arg_z nil)
    287   (ba .SPpopj))
     178  (build-lisp-frame)
     179  (bl .SPheap-rest-arg)                ; cons up an &rest arg, vpush it
     180  (vpop1 arg_z)                          ; whoops, didn't really want to
     181  (mov arg_x '#.$XNOFINFUNCTION)
     182  (mov arg_y nfn)
     183  (set-nargs 3)
     184  (bl .SPksignalerr)
     185  (mov arg_z 'nil)
     186  (return-lisp-frame))
    288187
    289188;;; is a winner - saves ~15%
     
    293192  (set-nargs 2)
    294193  (svref nfn gf.dcode nfn)
    295   (ldr temp0 target::misc-data-offset nfn)
    296   (mtctr temp0)
    297   (bctr))
     194  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    298195
    299196
     
    303200  (set-nargs 3)
    304201  (svref nfn gf.dcode nfn)
    305   (ldr temp0 target::misc-data-offset nfn)
    306   (mtctr temp0)
    307   (bctr))
     202  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    308203
    309204(defparameter *cm-proto*
     
    311206   gag
    312207   (lambda (&lap &lexpr args)
    313      (ppc-lap-function
     208     (arm-lap-function
    314209      gag
    315210      ()
    316       (mflr loc-pc)
    317211      (vpush-argregs)
    318       (vpush nargs)
    319       (add imm0 vsp nargs)
    320       (la imm0 target::node-size imm0)                  ; caller's vsp
    321       (bla .SPlexpr-entry)
    322       (mtlr loc-pc)                     ; return to kernel
    323       (mr arg_z vsp)                    ; lexpr
     212      (vpush1 nargs)
     213      (ref-global arg_x ret1valaddr)
     214      (add imm1 vsp nargs)
     215      (add imm1 imm1 (:$ arm::node-size))                  ; caller's vsp
     216      (cmp lr arg_x)
     217      (build-lisp-frame imm0 imm1)
     218      (mov fn (:$ 0))
     219      (moveq lr (:$ (- arm::nil-value arm::fulltag-nil)))
     220      (ldreq lr (:@ lr (:$ (arm::%kernel-global 'arm::lexpr-return))))
     221      (stmdbeq (:! vsp) (imm0 imm1 fn lr))
     222      (moveq lr arg_x)
     223      (movne lr (:$ (- arm::nil-value arm::fulltag-nil)))
     224      (ldrne lr (:@ lr (:$ (arm::%kernel-global 'arm::lexpr-return1v))))
     225      (mov arg_z vsp)
    324226      (svref arg_y combined-method.thing nfn) ; thing
    325227      (set-nargs 2)
    326228      (svref nfn combined-method.dcode nfn) ; dcode function
    327       (ldr temp0 target::misc-data-offset nfn)
    328       (mtctr temp0)
    329       (bctr)))))
     229      (ldr pc (:@ nfn (:$ arm::function.entrypoint)))))))
  • branches/arm/level-0/ARM/arm-def.lisp

    r13706 r13789  
    2020;;; If the GC moves this function while we're trying to flush the cache,
    2121;;; it'll flush the cache: no harm done in that case.
    22 #+notyet                                ;though we need to on ARM.
    23 (defppclapfunction %make-code-executable ((codev arg_z))
    24   (let ((len imm2)
    25         (word-offset imm0))
    26     (save-lisp-context)
    27     (getvheader word-offset codev)
    28     (header-size len word-offset)
    29     ;; The idea is that if we GC here, no harm is done (since the GC
    30     ;; will do any necessary cache-flushing.)  The idea may be
    31     ;; incorrect: if we pass an address that's not mapped anymore,
    32     ;; could we fault ?
    33     (stru sp (- (+ #+eabi-target ppc32::eabi-c-frame.minsize
    34                    #+poweropen-target target::c-frame.minsize target::lisp-frame.size)) sp)     ; make an FFI frame.
    35     (la imm0 target::misc-data-offset codev)
    36     (slri len len 2)
    37     (str imm0 #+eabi-target ppc32::eabi-c-frame.param0 #+poweropen-target target::c-frame.param0  sp)
    38     (str len #+eabi-target ppc32::eabi-c-frame.param1 #+poweropen-target target::c-frame.param1 sp)
    39     (ref-global imm3 kernel-imports)
    40     (ldr arg_z target::kernel-import-MakeDataExecutable imm3)
    41     (bla #+eabi-target .SPeabi-ff-call #+poweropen-target .SPpoweropen-ffcall)
    42     (li arg_z nil)
    43     (restore-full-lisp-context)
    44     (blr)))
     22
     23(defun %make-code-executable (codev)
     24  (with-macptrs (p)
     25    (let* ((nbytes (ash (uvsize codev) arm::word-shift)))
     26      (%vect-data-to-macptr codev p)
     27      (ff-call (%kernel-import arm::kernel-import-MakeDataExecutable)
     28               :address p
     29               :unsigned-fullword nbytes
     30               :void))))
    4531
    4632(defarmlapfunction %get-kernel-global-from-offset ((offset arg_z))
     
    7561  (moveq fixnum offset)
    7662  (moveq offset (:$ 0))
    77   @2-args
    7863  (unbox-fixnum imm0 offset)
    7964  (ldr arg_z (:@ imm0 fixnum))
     
    156141(defarmlapfunction %%frame-backlink ((p arg_z))
    157142  (check-nargs 1)
    158   (ldr arg_z target::lisp-frame.backlink arg_z)
     143  (add arg_z p (:$ arm::lisp-frame.size))
    159144  (bx lr))
    160145
     
    165150(defarmlapfunction %%frame-savefn ((p arg_z))
    166151  (check-nargs 1)
    167   (ldr arg_z target::lisp-frame.savefn arg_z)
     152  (ldr arg_z (:@ arg_z (:$ arm::lisp-frame.savefn)))
    168153  (bx lr))
    169154
    170155(defarmlapfunction %cfp-lfun ((p arg_z))
    171   (ldr arg_y target::lisp-frame.savefn p)
     156  (build-lisp-frame)
     157  (ldr arg_y (:@ p (:$ arm::lisp-frame.savefn)))
    172158  (extract-typecode imm0 arg_y)
    173   (cmpri imm0 target::subtag-function)
    174   (ldr loc-pc target::lisp-frame.savelr p)
     159  (cmp imm0 (:$ arm::subtag-function))
     160  (ldr lr (:@ p (:$ arm::lisp-frame.savelr)))
    175161  (bne @no)
    176   (ldr arg_x target::misc-data-offset arg_y)
    177   (sub imm1 loc-pc arg_x)
    178   (la imm1 (- target::misc-data-offset) imm1)
     162  (ldr arg_x (:@ arg_y (:$ (+ arm::node-size arm::misc-data-offset))))
     163  (sub imm1 lr arg_x)
     164  (add imm1 imm1 (:$ (- arm::misc-data-offset)))
    179165  (getvheader imm0 arg_x)
    180166  (header-length imm0 imm0)
    181   (cmplr imm1 imm0)
     167  (cmp imm1 imm0)
    182168  (box-fixnum imm1 imm1)
    183   (bge @no)
    184   (vpush arg_y)
    185   (vpush imm1)
     169  (bhs @no)
     170  (vpush1 arg_y)
     171  (vpush1 imm1)
    186172  @go
    187173  (set-nargs 2)
    188   (la temp0 '2 vsp)
    189   (ba .SPvalues)
     174  (ba .SPnvalret)
    190175  @no
    191   (li imm0 nil)
    192   (vpush imm0)
    193   (vpush imm0)
     176  (mov imm0 'nil)
     177  (vpush1 imm0)
     178  (vpush1 imm0)
    194179  (b @go))
    195180
     
    199184(defarmlapfunction %%frame-savevsp ((p arg_z))
    200185  (check-nargs 1)
    201   (ldr arg_z target::lisp-frame.savevsp arg_z)
    202   (bx lr))
    203 
    204 
    205 
    206 
    207 
    208 #+ppc32-target
    209 (eval-when (:compile-toplevel :execute)
    210   (assert (eql ppc32::t-offset #x11)))
     186  (ldr arg_z (:@ arg_z (:$ arm::lisp-frame.savevsp)))
     187  (bx lr))
     188
     189
     190
     191
     192
     193
    211194
    212195(defarmlapfunction %uvector-data-fixnum ((uv arg_z))
    213196  (check-nargs 1)
    214   (trap-unless-fulltag= arg_z target::fulltag-misc)
    215   (la arg_z target::misc-data-offset arg_z)
     197  (trap-unless-fulltag= arg_z arm::fulltag-misc)
     198  (add arg_z arg_z (:$ arm::misc-data-offset))
    216199  (bx lr))
    217200
    218201(defarmlapfunction %catch-top ((tcr arg_z))
    219202  (check-nargs 1)
    220   (ldr arg_z target::tcr.catch-top tcr)
    221   (cmpri cr0 arg_z 0)
    222   (bne @ret)
    223   (li arg_z nil)
    224  @ret
    225   (bx lr))
    226 
    227 (defarmlapfunction %catch-tsp ((catch arg_z))
    228   (check-nargs 1)
    229   (la arg_z (- (+ target::fulltag-misc
    230                                  (ash 1 (1+ target::word-shift)))) arg_z)
    231   (bx lr))
     203  (ldr arg_z (:@ tcr (:$ arm::tcr.catch-top)))
     204  (cmp arg_z (:$ 0))
     205  (moveq arg_z 'nil)
     206  (bx lr))
     207
     208
    232209
    233210
     
    243220
    244221(defarmlapfunction %save-standard-binding-list ((bindings arg_z))
    245   (ldr imm0 target::tcr.vs-area target::rcontext)
    246   (ldr imm1 target::area.high imm0)
    247   (push bindings imm1)
     222  (ldr imm0 (:@ arm::rcontext (:$ arm::tcr.vs-area)))
     223  (ldr imm1 (:@ imm0 (:$ arm::area.high)))
     224  (push1 bindings imm1)
    248225  (bx lr))
    249226
    250227(defarmlapfunction %saved-bindings-address ()
    251   (ldr imm0 target::tcr.vs-area target::rcontext)
    252   (ldr imm1 target::area.high imm0)
    253   (la arg_z (- target::node-size) imm1)
     228  (ldr imm0 (:@ arm::rcontext (:$ arm::tcr.vs-area)))
     229  (ldr imm1 (:@ imm0 (:$ arm::area.high)))
     230  (add arg_z imm1 (:$ (- arm::node-size)))
    254231  (bx lr))
    255232
    256233(defarmlapfunction %code-vector-pc ((code-vector arg_y) (pcptr arg_z))
     234  (build-lisp-frame)
    257235  (macptr-ptr imm0 pcptr)
    258   (ldr loc-pc 0 imm0)
    259   (sub imm0 loc-pc code-vector)
    260   (subi imm0 imm0 target::misc-data-offset)
     236  (ldr lr (:@ imm0 (:$ 0)))
     237  (sub imm0 lr code-vector)
     238  (sub imm0 imm0 (:$ arm::misc-data-offset))
    261239  (getvheader imm1 code-vector)
    262240  (header-size imm1 imm1)
    263   (slri imm1 imm1 2)
    264   (cmplr imm0 imm1)
    265   (li arg_z nil)
    266   (bgelr)
    267   (box-fixnum arg_z imm0)
    268   (bx lr))
    269 
     241  (mov imm1 (:lsr imm1 (:$ 2)))
     242  (cmp imm0 imm1)
     243  (movhs arg_z 'nil)
     244  (movlo arg_z (:lsl imm0 (:$ arm::fixnumshift)))
     245  (return-lisp-frame))
     246
     247#+notyet
     248(progn
    270249;;; FF-call, in LAP.
    271250#+eabi-target
     
    10501029    )
    10511030  )
     1031)
    10521032
    10531033
     
    10551035(defarmlapfunction %get-object ((macptr arg_y) (offset arg_z))
    10561036  (check-nargs 2)
    1057   (trap-unless-typecode= arg_y target::subtag-macptr)
     1037  (trap-unless-xtype= arg_y arm::subtag-macptr)
    10581038  (macptr-ptr imm0 arg_y)
    1059   (trap-unless-lisptag= arg_z target::tag-fixnum imm1)
     1039  (trap-unless-fixnum arg_z)
    10601040  (unbox-fixnum imm1 arg_z)
    1061   (ldrx arg_z imm0 imm1)
     1041  (ldr arg_z (:@ imm0 imm1))
    10621042  (bx lr))
    10631043
     
    10651045(defarmlapfunction %set-object ((macptr arg_x) (offset arg_y) (value arg_z))
    10661046  (check-nargs 3)
    1067   (trap-unless-typecode= arg_x target::subtag-macptr)
     1047  (trap-unless-xtype= arg_x arm::subtag-macptr)
    10681048  (macptr-ptr imm0 arg_x)
    1069   (trap-unless-lisptag= arg_y target::tag-fixnum imm1)
     1049  (trap-unless-fixnum arg_y)
    10701050  (unbox-fixnum imm1 arg_y)
    1071   (strx arg_z imm0 imm1)
     1051  (str arg_z (:@ imm0 imm1))
    10721052  (bx lr))
    10731053
     
    10771057                                                     (args arg_z))
    10781058  ;; Somebody's called (or tail-called) us.
    1079   ;; Put magic arg in ppc::next-method-context (= ppc::temp1).
    1080   ;; Put function in ppc::nfn (= ppc::temp2).
     1059  ;; Put magic arg in arm::next-method-context (= arm::temp1).
     1060  ;; Put function in arm::nfn (= arm::temp2).
    10811061  ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z,
    1082   ;;   but preserves ppc::nfn/ppc::next-method-context.
    1083   ;; Jump to the function in ppc::nfn.
    1084   (mov ppc::next-method-context magic)
    1085   (mov ppc::nfn function)
     1062  ;;   but preserves arm::nfn/arm::next-method-context.
     1063  ;; Jump to the function in arm::nfn.
     1064  (mov arm::next-method-context magic)
     1065  (mov arm::nfn function)
    10861066  (set-nargs 0)
    1087   (mflr loc-pc)
    1088   (bla .SPspread-lexpr-z)
    1089   (mtlr loc-pc)
    1090   (ldr temp0 target::misc-data-offset nfn)
    1091   (mtctr temp0)
    1092   (bctr))
     1067  (build-lisp-frame)
     1068  (bl .SPspread-lexprz)
     1069  (restore-lisp-frame)
     1070  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    10931071
    10941072
     
    10971075                                               (args arg_z))
    10981076  ;; Somebody's called (or tail-called) us.
    1099   ;; Put magic arg in ppc::next-method-context (= ppc::temp1).
    1100   ;; Put function in ppc::nfn (= ppc::temp2).
     1077  ;; Put magic arg in arm::next-method-context (= arm::temp1).
     1078  ;; Put function in arm::nfn (= arm::temp2).
    11011079  ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z,
    1102   ;;   but preserves ppc::nfn/ppc::next-method-context.
    1103   ;; Jump to the function in ppc::nfn.
    1104   (mov ppc::next-method-context magic)
    1105   (mov ppc::nfn function)
     1080  ;;   but preserves arm::nfn/arm::next-method-context.
     1081  ;; Jump to the function in arm::nfn.
     1082  (mov arm::next-method-context magic)
     1083  (mov arm::nfn function)
    11061084  (set-nargs 0)
    1107   (mflr loc-pc)
    1108   (bla .SPspreadargZ)
    1109   (mtlr loc-pc)
    1110   (ldr temp0 target::misc-data-offset nfn)
    1111   (mtctr temp0)
    1112   (bctr))
     1085  (build-lisp-frame)
     1086  (bl .SPspreadargZ)
     1087  (restore-lisp-frame)
     1088  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    11131089
    11141090
     
    11271103  ;; the first frame that .SPlexpr-entry pushed, restore vsp from (+
    11281104  ;; args node-size), pop the argregs, and jump to the function.
    1129   (mflr loc-pc)
    11301105  (ref-global imm0 ret1valaddr)
    1131   (cmpr cr2 loc-pc imm0)
    1132   (ldr nargs 0 args)
    1133   (mov imm5 nargs)
    1134   (cmpri cr0 nargs 0)
    1135   (cmpri cr1 nargs '2)
     1106  (cmp lr imm0)
     1107  (ldr nargs (:@ args (:$ 0)))
    11361108  (mov nfn method)
    1137   (ldr temp0 target::misc-data-offset nfn)
    1138   (mtctr temp0)
    1139   (if (:cr2 :eq)
    1140     (la sp target::lisp-frame.size sp))
    1141   (ldr loc-pc target::lisp-frame.savelr sp)
    1142   (ldr fn target::lisp-frame.savefn sp)
    1143   (ldr imm0 target::lisp-frame.savevsp sp)
     1109  (addeq sp sp (:$ arm::lisp-frame.size))
     1110  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr)))
     1111  (ldr fn (:@ sp (:$ arm::lisp-frame.savefn)))
     1112  (ldr imm0 (:@ sp (:$ arm::lisp-frame.savevsp)))
    11441113  (sub vsp imm0 nargs)
    1145   (mtlr loc-pc)
    1146   (la sp target::lisp-frame.size sp)
    1147   (beqctr)
    1148   (vpop arg_z)
    1149   (bltctr cr1)
    1150   (vpop arg_y)
    1151   (beqctr cr1)
    1152   (vpop arg_x)
    1153   (bctr))
     1114  (add sp sp (:$ arm::lisp-frame.size))
     1115  (cmp nargs (:$ 0))
     1116  (ldreq pc (:@ nfn (:$ arm::function.entrypoint)))
     1117  (cmp nargs '2)
     1118  (vpop1 arg_z)
     1119  (ldrlo pc (:@ nfn (:$ arm::function.entrypoint)))
     1120  (vpop1 arg_y)
     1121  (ldreq pc (:@ nfn (:$ arm::function.entrypoint)))
     1122  (vpop1 arg_x)
     1123  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    11541124
    11551125
     
    11621132        (error "Wrong size target ~s" target)))
    11631133    (%copy-gvector-to-gvector proto 0 new 0 total-size)
     1134    (setf (%svref new 0 )arm::*function-initial-entrypoint*)
    11641135    new))
    11651136
     
    11671138  (if (typep target-fn 'function)
    11681139    (if (typep proto-fn 'function)
    1169       (setf (uvref target-fn 0)
    1170             (uvref proto-fn 0))
     1140      (setf (uvref target-fn 0) arm::*function-initial-entrypoint*
     1141            (uvref target-fn 1) (uvref proto-fn 1))
    11711142      (report-bad-arg proto-fn 'function))
    11721143    (report-bad-arg target-fn 'function)))
     
    11741145(defun closure-function (fun)
    11751146  (while (and (functionp fun)  (not (compiled-function-p fun)))
    1176     (setq fun (%svref fun 1))
     1147    (setq fun (%svref fun 2))
    11771148    (when (vectorp fun)
    11781149      (setq fun (svref fun 0))))
     
    11821153;;; For use by (setf (apply ...) ...)
    11831154;;; (apply+ f butlast last) = (apply f (append butlast (list last)))
    1184 #+ppc-target
    1185 (defun apply+ (&lap function arg1 arg2 &rest other-args)
    1186   (ppc-lap-function apply+ ()
    1187    (check-nargs 3 nil)
    1188    (vpush arg_x)
    1189    (mov temp0 arg_z)                     ; last
    1190    (mov arg_z arg_y)                     ; butlast
    1191    (subi nargs nargs '2)                ; remove count for butlast & last
    1192    (mflr loc-pc)
    1193    (bla .SPspreadargz)
    1194    (cmpri cr0 nargs '3)
    1195    (mtlr loc-pc)
    1196    (addi nargs nargs '1)                ; count for last
    1197    (blt cr0 @nopush)
    1198    (vpush arg_x)
    1199 @nopush
    1200    (mov arg_x arg_y)
    1201    (mov arg_y arg_z)
    1202    (mov arg_z temp0)
    1203    (ldr temp0 'funcall nfn)
    1204    (ba .SPfuncall)))
    1205 
    1206 (lfun-bits #'apply+ (logior $lfbits-rest-bit
    1207                             (dpb 3 $lfbits-numreq 0)))
    1208 
    1209 ;;; end of ppc-def.lisp
     1155(defarmlapfunction apply+ ()
     1156  (:arglist (function arg1 arg2 &rest other-args))
     1157  (check-nargs 3 nil)
     1158  (vpush1 arg_x)
     1159  (mov temp0 arg_z)                     ; last
     1160  (mov arg_z arg_y)                     ; butlast
     1161  (sub nargs nargs '2)                  ; remove count for butlast & last
     1162  (build-lisp-frame)
     1163  (bl .SPspreadargz)
     1164  (cmp nargs '3)
     1165  (restore-lisp-frame)
     1166  (add nargs nargs '1)                  ; count for last
     1167  (strhs arg_x (:@! vsp (:$ -4)))
     1168  (mov arg_x arg_y)
     1169  (mov arg_y arg_z)
     1170  (mov arg_z temp0)
     1171  (ldr nfn (:@ nfn 'funcall))
     1172  (ba .SPfuncall))
     1173
     1174
     1175
     1176;;; end of arm-def.lisp
  • branches/arm/level-0/ARM/arm-misc.lisp

    r13706 r13789  
    371371    (bx lr)))
    372372
    373 #+notyet                                ; needs ARM subprim ?
    374373(defarmlapfunction set-%gcable-macptrs% ((ptr arm::arg_z))
    375   (li imm0 (+ (target-nil-value) (arm::kernel-global gcable-pointers)))
    376   @again
    377   (lrarx arg_y rzero imm0)
    378   (str arg_y arm::xmacptr.link ptr)
    379   (strcx. ptr rzero imm0)
     374  (mov imm0 (:$ (- arm::nil-value arm::fulltag-nil)))
     375  (add imm1 imm0 (:$ (arm::kernel-global gcable-pointers)))
     376  @again
     377  (ldrex arg_y (:@ imm1))
     378  (str arg_y (:@ ptr (:$ arm::xmacptr.link)))
     379  (strex imm0 ptr (:@ imm1))
     380  (cmp imm0 (:$ 0))
    380381  (bne @again)
    381   (isync)
    382382  (bx lr))
    383383
    384384;;; Atomically increment or decrement the gc-inhibit-count kernel-global
    385385;;; (It's decremented if it's currently negative, incremented otherwise.)
    386 #+notyet                                ;needs ARM subprim ?
    387386(defarmlapfunction %lock-gc-lock ()
    388   (li imm0 (+ (target-nil-value) (arm::kernel-global gc-inhibit-count)))
    389   @again
    390   (lrarx arg_y rzero imm0)
    391   (cmpri cr1 arg_y 0)
    392   (addi arg_z arg_y '1)
    393   (bge cr1 @store)
    394   (subi arg_z arg_y '1)
     387  (mov imm0 (:$ (- arm::nil-value arm::fulltag-nil)))
     388  (add imm1 imm0 (:$ (arm::kernel-global gc-inhibit-count)))
     389  @again
     390  (ldrex arg_y (:@ imm1))
     391  (cmp arg_y (:$ 0))
     392  (add arg_z arg_y '1)
     393  (sublt arg_z arg_y '1)
    395394  @store
    396   (strcx. arg_z rzero imm0)
     395  (strex imm0 arg_z (:@ imm1))
     396  (cmp imm0 (:$ 0))
    397397  (bne @again)
    398 ;;  (isync)
    399398  (bx lr))
    400399
     
    506505;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
    507506;;; was equal to OLDVAL.  Return the old value
    508 #notyet                                 ;still
     507#+notyet                                 ;still
    509508(defarmlapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
    510509  (macptr-ptr imm0 ptr)
     
    666665       
    667666
    668  
     667#+notyet
    669668(defarmlapfunction %%save-application ((flags arg_y) (fd arg_z))
    670669  (unbox-fixnum imm0 flags)
    671   (ori imm0 imm0 arch::gc-trap-function-save-application)
     670  (orr imm0 imm0 arch::gc-trap-function-save-application)
    672671  (unbox-fixnum imm1 fd)
    673672  (trlgei allocptr 0)
  • branches/arm/level-0/l0-cfm-support.lisp

    r13067 r13789  
    4646  ;; be more likely to be fixnums, for instance), so ensure that they
    4747  ;; aren't.
    48   #+x86-target
     48  #+(or x86-target arm-target)
    4949  (%setf-macptr addr (%int-to-ptr
    5050                      (if (< entry 0)
    5151                        (logand entry (1- (ash 1 target::nbits-in-word)))
    5252                        entry)))
    53   #-(or ppc-target x86-target) (dbg "Fix entry->addr"))
     53  #-(or ppc-target x86-target arm-target) (dbg "Fix entry->addr"))
    5454
    5555
     
    653653      (unless (%null-ptr-p addr)        ; No function can have address 0
    654654        (or (macptr->fixnum addr) (%inc-ptr addr 0))))
    655     #+x8632-target
     655    #+(or x8632-target arm-target)
    656656    (let* ((addr (ff-call (%kernel-import target::kernel-import-FindSymbol)
    657657                          :address handle
  • branches/arm/level-0/l0-hash.lisp

    r13279 r13789  
    9696    (declare (fixnum typecode))
    9797    (or (= typecode target::subtag-macptr)
    98         #+(or ppc32-target x8632-target)
     98        #+(or ppc32-target x8632-target arm-target)
    9999        (and (>= typecode target::min-numeric-subtag)
    100100             (<= typecode target::max-numeric-subtag))
  • branches/arm/level-0/l0-pred.lisp

    r13067 r13789  
    9090      (let* ((typecode (typecode x)))
    9191        (declare (fixnum typecode))
    92         #+(or ppc32-target x8632-target)
     92        #+(or ppc32-target x8632-target arm-target)
    9393        (and (>= typecode target::min-numeric-subtag)
    9494             (<= typecode target::max-rational-subtag))
     
    115115  (let* ((typecode (typecode x)))
    116116    (declare (fixnum typecode))
    117     #+(or ppc32-target x8632-target)
     117    #+(or ppc32-target x8632-target arm-target)
    118118    (or (= typecode target::tag-fixnum)
    119119        (and (>= typecode target::min-numeric-subtag)
     
    144144  (let* ((typecode (typecode x)))
    145145    (declare (fixnum typecode))
    146     #+(or ppc32-target x8632-target)
     146    #+(or ppc32-target x8632-target arm-target)
    147147    (or (= typecode target::tag-fixnum)
    148148        (and (>= typecode target::min-numeric-subtag)
     
    223223;;; things that it wasn't true of on the 68K.
    224224(defun gvectorp (x)
    225   #+(or ppc32-target x8632-target)
     225  #+(or ppc32-target x8632-target arm-target)
    226226  (= (the fixnum (logand (the fixnum (typecode x)) target::fulltagmask)) target::fulltag-nodeheader)
    227227  #+ppc64-target
     
    238238
    239239(defun ivectorp (x)
    240   #+(or ppc32-target x8632-target)
     240  #+(or ppc32-target x8632-target arm-target)
    241241  (= (the fixnum (logand (the fixnum (typecode x)) target::fulltagmask))
    242242     target::fulltag-immheader)
     
    254254
    255255(defun miscobjp (x)
    256   #+(or ppc32-target x8632-target x8664-target)
     256  #+(or ppc32-target x8632-target x8664-target arm-target)
    257257  (= (the fixnum (lisptag x)) target::tag-misc)
    258258  #+ppc64-target
     
    10531053(defun symbolp (thing)
    10541054  "Return true if OBJECT is a SYMBOL, and NIL otherwise."
    1055   #+(or ppc32-target x8632-target)
     1055  #+(or ppc32-target x8632-target arm-target)
    10561056  (if thing
    10571057    (= (the fixnum (typecode thing)) target::subtag-symbol)
  • branches/arm/level-0/l0-symbol.lisp

    r13279 r13789  
    206206(defun symbol-name (sym)
    207207  "Return SYMBOL's name as a string."
    208   #+(or ppc32-target x8632-target x8664-target)
     208  #+(or ppc32-target x8632-target x8664-target arm-target)
    209209  (%svref (symptr->symvector (%symbol->symptr sym)) target::symbol.pname-cell)
    210210  #+ppc64-target
  • branches/arm/level-1/l1-sockets.lisp

    r13382 r13789  
    949949            #+x8664-target (and (>= subtype x8664::min-8-bit-ivector-subtag)
    950950                                (<= subtype x8664::max-8-bit-ivector-subtag))
     951            #+arm-target (and (<= arm::min-8-bit-ivector-subtag subtype)
     952                                (<= subtype arm::max-8-bit-ivector-subtag))
    951953      (report-bad-arg buf `(or (array character)
    952954                               (array (unsigned-byte 8))
  • branches/arm/lib/compile-ccl.lisp

    r13779 r13789  
    102102(defparameter *x8632-xload-modules* '(xx8632fasload xfasload heap-image ))
    103103(defparameter *x8664-xload-modules* '(xx8664fasload xfasload heap-image ))
     104(defparameter *arm-xload-modules* '(xarmfasload xfasload heap-image ))
    104105
    105106
     
    107108(defparameter *ppc-xdev-modules* '(ppc-lapmacros ))
    108109(defparameter *x86-xdev-modules* '(x86-lapmacros ))
     110(defparameter *arm-xdev-modules* '(arm-lapmacros ))
    109111
    110112(defun target-xdev-modules (&optional (target
     
    113115  (case target
    114116    ((:ppc32 :ppc64) *ppc-xdev-modules*)
    115     ((:x8632 :x8664) *x86-xdev-modules*)))
     117    ((:x8632 :x8664) *x86-xdev-modules*)
     118    (:arm *arm-xdev-modules*)))
    116119
    117120(defun target-xload-modules (&optional (target
     
    120123    ((:ppc32 :ppc64) *ppc-xload-modules*)
    121124    (:x8632 *x8632-xload-modules*)
    122     (:x8664 *x8664-xload-modules*)))
     125    (:x8664 *x8664-xload-modules*)
     126    (:arm *arm-xload-modules*)))
    123127
    124128
     
    386390
    387391(defun target-xcompile-ccl (target &optional force)
    388   (require-update-modules *sysdef-modules* force) ;in the host
     392  (let* ((*target-backend* *host-backend*))
     393    (require-update-modules *sysdef-modules* force)) ;in the host
    389394  (let* ((backend (or (find-backend target) *target-backend*))
    390395         (arch (backend-target-arch-name backend))
  • branches/arm/lib/foreign-types.lisp

    r13067 r13789  
    102102                        (:win32 "ccl:win32-headers;")
    103103                        (:solarisx8632 "ccl:solarisx86-headers;")
    104                         (:freebsdx8632 "ccl:freebsd-headers;"))
     104                        (:freebsdx8632 "ccl:freebsd-headers;")
     105                        (:linuxarm "ccl:arm-headers;"))
    105106                    :interface-package-name
    106107                    #.(ftd-interface-package-name *target-ftd*)
  • branches/arm/lib/nfcomp.lisp

    r13757 r13789  
    144144      (warn "Unknown :TARGET : ~S.  Reverting to ~s ..." target *fasl-target*)
    145145      (setq target *fasl-target*  backend *target-backend*))
     146    (unless (eq *target-backend* *host-backend*)
     147      (setq save-source-locations nil))
    146148    (multiple-value-bind (output-file truename warnings-p serious-p)
    147149        (loop
  • branches/arm/lib/systems.lisp

    r13779 r13789  
    134134    (xx8632fasload    "ccl:xdump;xx8632-fasload"  ("ccl:xdump;xx8632-fasload.lisp"))
    135135    (xx8664fasload    "ccl:xdump;xx8664-fasload"  ("ccl:xdump;xx8664-fasload.lisp"))
     136    (xarmfasload      "ccl:xdump;xarm-fasload"   ("ccl:xdump;xarmfasload.lisp"))
    136137    (heap-image       "ccl:xdump;heap-image"     ("ccl:xdump;heap-image.lisp"))
    137138    (xsym             "ccl:xdump;xsym"           ("ccl:xdump;xsym.lisp"))
  • branches/arm/lisp-kernel/area.h

    r13719 r13789  
    153153#define PURESPACE_SIZE (1LL<<30LL)
    154154#else
     155#ifdef ARM
     156#define PURESPACE_RESERVE (8<<20)
     157#define PURESPACE_SIZE (4<<20)
     158#else
    155159#define PURESPACE_RESERVE (128<<20) /* MB */
    156160#define PURESPACE_SIZE (64<<20)
     161#endif
    157162#endif
    158163
  • branches/arm/lisp-kernel/arm-constants.s

    r13785 r13789  
    348348        _struct(lisp_frame,0)
    349349         _node(marker)
     350         _node(savevsp)
    350351         _node(savefn)
    351          _node(savevsp)
    352352         _node(savelr) 
    353353        _ends
  • branches/arm/lisp-kernel/arm-exceptions.c

    r13737 r13789  
    129129
    130130      instr = program_counter[-4];
    131       if (IS_SUB_LOW_FROM_ALLOCPTR(instr)) {
     131      if (IS_SUB_LO_FROM_ALLOCPTR(instr)) {
    132132        return -((signed_natural)(disp | (instr & 0xff)));
    133133      }
  • branches/arm/lisp-kernel/arm-spentry.s

    r13786 r13789  
    296296        __(beq _SPmakes64)
    297297        __(bgt 9f)
    298         __(mov imm1,imm1,asl imm2)
    299         __(rsb imm2,imm2,#32)
    300         __(orr imm1,imm1,imm0,asr imm2)
    301         __(unbox_fixnum(imm2,arg_z))
    302         __(mov imm0,imm0,asl imm2)
     298        __(rsb imm1,imm2,#32)
     299        __(mov imm1,imm0,asr imm1)
     300        __(mov imm0,imm0,lsl imm2)
    303301        __(b _SPmakes64)
    3043029: 
     
    803801        __(cmp arg_z,arg_y)
    804802        __(_rplaca(arg_y,arg_z))
    805         __(bxls lr)
     803        __(bxhs lr)
    806804        __(ref_global(temp0,ref_base))
    807805        __(sub imm0,arg_y,temp0)
    808806        __(mov imm0,imm0,lsr #dnode_shift)
    809         __(ref_global(temp0,oldspace_dnode_count))
    810         __(cmp imm0,temp0)
     807        __(ref_global(imm1,oldspace_dnode_count))
     808        __(cmp imm0,imm1)
    811809        __(bxhs lr)
    812810        __(and imm2,imm0,#31)
     
    814812        __(mov imm1,imm1,lsr imm2)
    815813        __(mov imm0,imm0,lsr #bitmap_shift)
    816         __(ref_global(imm2,refbits))
    817         __(add imm2,imm2,imm0,lsl #word_shift)
    818         __(ldr imm0,[imm2])
    819         __(ands imm0,imm0,imm1)
    820         __(bxne lr)
    821         __(build_lisp_frame(imm0))
    822         __(set_ref_bit(rplaca))
     814        __(ref_global(temp0,refbits))
     815        __(add temp0,temp0,imm0,lsl #word_shift)
     8160:      __(ldrex imm2,[temp0])
     817        __(orr imm2,imm2,imm1)
     818        __(strex imm0,imm2,[temp0])
     819        __(cmp imm0,#0)
     820        __(bne 0b)       
    823821        __(bx lr)
    824822
     
    829827        __(cmp arg_z,arg_y)
    830828        __(_rplacd(arg_y,arg_z))
    831         __(bxls lr)
     829        __(bxhs lr)
    832830        __(ref_global(temp0,ref_base))
    833831        __(sub imm0,arg_y,temp0)
    834832        __(mov imm0,imm0,lsr #dnode_shift)
    835         __(ref_global(temp0,oldspace_dnode_count))
    836         __(cmp imm0,temp0)
     833        __(ref_global(imm1,oldspace_dnode_count))
     834        __(cmp imm0,imm1)
    837835        __(bxhs lr)
    838836        __(and imm2,imm0,#31)
     
    840838        __(mov imm1,imm1,lsr imm2)
    841839        __(mov imm0,imm0,lsr #bitmap_shift)
    842         __(ref_global(imm2,refbits))
    843         __(add imm2,imm2,imm0,lsl #word_shift)
    844         __(ldr imm0,[imm2])
    845         __(ands imm0,imm0,imm1)
    846         __(bxne lr)
    847         __(build_lisp_frame(imm0))
    848         __(set_ref_bit(rplacd))
     840        __(ref_global(temp0,refbits))
     841        __(add temp0,temp0,imm0,lsl #word_shift)
     8420:      __(ldrex imm2,[temp0])
     843        __(orr imm2,imm2,imm1)
     844        __(strex imm0,imm2,[temp0])
     845        __(cmp imm0,#0)
     846        __(bne 0b)       
    849847        __(bx lr)
    850848       
     
    929927dnl         __(isync)
    930928dnl         __(bx lr)
    931 dnl         
    932 dnl /*
    933 dnl    Interrupt handling (in pc_luser_xp()) notes:
    934 dnl    If we are in this function and before the test which follows the
    935 dnl    conditional (at egc_store_node_conditional), or at that test
    936 dnl    and cr0`eq' is clear, pc_luser_xp() should just let this continue
    937 dnl    (we either haven't done the store conditional yet, or got a
    938 dnl    possibly transient failure.)  If we're at that test and the
    939 dnl    cr0`EQ' bit is set, then the conditional store succeeded and
    940 dnl    we have to atomically memoize the possible intergenerational
    941 dnl    reference.  Note that the local labels 4 and 5 are in the
    942 dnl    body of the next subprim (and at or beyond 'egc_write_barrier_end').
    943 dnl
    944 dnl    N.B: it's not possible to really understand what's going on just
    945 dnl    by the state of the cr0`eq' bit.  A transient failure in the
    946 dnl    conditional stores that handle memoization might clear cr0`eq'
    947 dnl    without having completed the memoization.
    948 dnl */
    949 dnl
     929
     930
     931/*
     932   Interrupt handling (in pc_luser_xp()) notes:
     933   If we are in this function and before the test which follows the
     934   conditional (at egc_store_node_conditional), or at that test
     935   and cr0`eq' is clear, pc_luser_xp() should just let this continue
     936   (we either haven't done the store conditional yet, or got a
     937   possibly transient failure.)  If we're at that test and the
     938   cr0`EQ' bit is set, then the conditional store succeeded and
     939   we have to atomically memoize the possible intergenerational
     940   reference.  Note that the local labels 4 and 5 are in the
     941   body of the next subprim (and at or beyond 'egc_write_barrier_end').
     942
     943   N.B: it's not possible to really understand what's going on just
     944   by the state of the cr0`eq' bit.  A transient failure in the
     945   conditional stores that handle memoization might clear cr0`eq'
     946   without having completed the memoization.
     947*/
     948
    950949            .globl C(egc_store_node_conditional)
    951950            .globl C(egc_write_barrier_end)
    952951_spentry(store_node_conditional)
    953952C(egc_store_node_conditional):
    954 dnl         __(cmplr(cr2,arg_z,arg_x))
    955 dnl         __(vpop(temp0))
    956 dnl         __(unbox_fixnum(imm4,temp0))
    957 dnl 1:      __(lrarx(temp1,arg_x,imm4))
    958 dnl         __(cmpr(cr1,temp1,arg_y))
    959 dnl         __(bne cr1,5f)
    960 dnl         __(strcx(arg_z,arg_x,imm4))
    961            .globl C(egc_store_node_conditional_test)
     953        __(vpop1(temp0))
     954         
     9551:      __(unbox_fixnum(imm2,temp0))
     956        __(add imm2,imm2,arg_x)
     957        __(ldrex temp1,[imm2])
     958        __(cmp temp1,arg_y)
     959        __(bne 5f)
     960        __(strex imm0,arg_z,[imm2])
     961        .globl C(egc_store_node_conditional_test)
    962962C(egc_store_node_conditional_test):
    963 dnl         __(bne 1b)
    964 dnl         __(isync)
    965 dnl         __(add imm0,imm4,arg_x)
    966 dnl         __(ref_global(imm2,ref_base))
    967 dnl         __(ref_global(imm1,oldspace_dnode_count))
    968 dnl         __(sub imm0,imm0,imm2)
    969 dnl         __(load_highbit(imm3))
    970 dnl         __(srri(imm0,imm0,dnode_shift))       
    971 dnl         __(cmplr(imm0,imm1))
    972 dnl         __(extract_bit_shift_count(imm2,imm0))
    973 dnl         __(srri(imm0,imm0,bitmap_shift))       
    974 dnl         __(srr(imm3,imm3,imm2))
    975 dnl         __(ref_global(imm2,refbits))
    976 dnl         __(bge 4f)
    977 dnl         __(slri(imm0,imm0,word_shift))
    978 dnl 2:      __(lrarx(imm1,imm2,imm0))
    979 dnl         __(or imm1,imm1,imm3)
    980 dnl         __(strcx( imm1,imm2,imm0))
    981 dnl         __(bne- 2b)
    982 dnl         __(isync)
    983 dnl         __(b 4f)
    984 dnl
    985 dnl /* arg_z = new value, arg_y = expected old value, arg_x = hash-vector,
    986 dnl    vsp`0' = (boxed) byte-offset
    987 dnl    Interrupt-related issues are as in store_node_conditional, but
    988 dnl    we have to do more work to actually do the memoization.*/
     963        __(cmp imm0,#0)
     964        __(bne 1b)
     965        __(cmp arg_z,arg_x)
     966        __(blo 4f)
     967
     968        __(ref_global(imm0,ref_base))
     969        __(ref_global(imm1,oldspace_dnode_count))
     970        __(sub imm0,imm2,imm0)
     971        __(mov imm0,imm0,lsr #dnode_shift)
     972        __(cmp imm0,imm1)
     973        __(bhs 4f)
     974        __(and imm1,imm0,#31)
     975        __(mov arg_x,#0x80000000)
     976        __(mov imm1,arg_x,lsr imm1)
     977        __(ref_global(temp0,refbits))
     978        __(mov imm0,imm0,lsr #bitmap_shift)
     979        __(add temp0,temp0,imm0,lsl #word_shift)
     9802:      __(ldrex imm2,[temp0])
     981        __(orr imm2,imm2,imm1)
     982        __(strex imm0,imm2,[temp0])
     983        __(cmp imm0,#0)
     984        __(bne 2b)
     985        __(b 4f)
     986 
     987/* arg_z = new value, arg_y = expected old value, arg_x = hash-vector,
     988    vsp`0' = (boxed) byte-offset
     989    Interrupt-related issues are as in store_node_conditional, but
     990l    we have to do more work to actually do the memoization.*/
    989991_spentry(set_hash_key_conditional)
    990992        .globl C(egc_set_hash_key_conditional)
     
    10371039dnl         __(isync)
    10381040C(egc_write_barrier_end):
    1039 dnl 4: __(mov arg_z,#t_value)
    1040 dnl  __(bx lr)
    1041 dnl 5:      __(mov imm0,#RESERVATION_DISCHARGE)
    1042 dnl         __(strcx(rzero,0,imm0))
    1043 dnl  __(mov arg_z,#nil_value)
    1044 dnl  __(bx lr)
    1045 dnl 
    1046 dnl 
    1047 dnl         
    1048 dnl 
    1049 dnl
     10414:      __(mov arg_z,#nil_value)
     1042        __(add arg_z,arg_z,#t_offset)
     1043        __(bx lr)
     10445:      __(clrex)
     1045        __(mov arg_z,#nil_value)
     1046        __(bx lr)
     1047
     1048
     1049
     1050
    10501051       
    10511052/* We always have to create a stack frame (even if nargs is 0), so the compiler  */
     
    13161317        /* (vpush (< imm1 nargs))  */
    13171318        __(cmp imm1,nargs)
     1319        __(add imm1,imm1,#fixnumone)
    13181320        __(subeq arg_x,arg_x,#t_offset)
    13191321        __(vpush1(arg_x))
     
    29402942popdef(`r',)               
    29412943       
     2944
     2945               
     2946_spentry(eabi_ff_call)
     2947        __(ldr arg_y,[rcontext,#tcr.last_lisp_frame])
     2948        __(stmdb vsp!,{arg_y,arg_x,temp0,temp1,temp2})
     2949/* There's a u32 vector on top of the stack ; its first data word points
     2950   to the previous stack object.  The 4 words at the bottom of the vector
     2951   are reserved for a lisp frame, which we construct carefully ... */
     2952        __(mov imm0,#lisp_frame_marker)
     2953        __(mov imm1,#0)
     2954        __(ldr temp0,[sp,#4])
     2955        __(sub temp0,temp0,#lisp_frame.size)
     2956        __(str imm0,[temp0,#lisp_frame.marker])
     2957        __(ldr imm0,[sp,#0])       
     2958        __(str imm1,[temp0,#lisp_frame.savefn])
     2959        __(str imm1,[temp0,#lisp_frame.savelr])
     2960        __(sub imm0,imm0,#(lisp_frame.size/4)<<num_subtag_bits)
     2961        __(str vsp,[temp0,#lisp_frame.savevsp])
     2962        __(str imm0,[sp,#0])
     2963        __(str lr,[temp0,#lisp_frame.savelr])
     2964        __(str fn,[temp0,#lisp_frame.savefn])
     2965        __(str allocptr,[rcontext,#tcr.save_allocptr])
     2966        __(str temp0,[rcontext,#tcr.last_lisp_frame])
     2967        __(mov temp0,rcontext)
     2968        __(mov imm0,#TCR_STATE_FOREIGN)
     2969        __(str imm0,[rcontext,#tcr.valence])
     2970        __(add sp,sp,#dnode_size)
     2971        __(ldmia sp!,{r0,r1,r2,r3})
     2972        __(blx arg_z)           /* fix this */
     2973        __(mov temp1,#0)
     2974        __(mov temp2,#0)
     2975        __(mov arg_z,#0)
     2976        __(mov arg_y,#0)
     2977        __(mov arg_x,#0)
     2978        __(mov fn,#0)
     2979        __(mov allocptr,#VOID_ALLOCPTR)
     2980        __(mov rcontext,temp0)
     2981        __(ldr sp,[rcontext,#tcr.last_lisp_frame])
     2982        __(str fn,[rcontext,#tcr.valence])
     2983        __(ldr allocptr,[rcontext,#tcr.save_allocptr])
     2984        __(restore_lisp_frame(temp0))
     2985        __(ldmia vsp!,{arg_y,arg_x,temp0,temp1,temp2})
     2986        __(str arg_y,[rcontext,#tcr.last_lisp_frame])
     2987        __(bx lr)
    29422988       
    2943 _spentry(eabi_ff_call)                               
     2989       
    29442990
    29452991_spentry(debind)
  • branches/arm/lisp-kernel/arm-subprims.s

    r13746 r13789  
    7676        __(mov imm0,imm0,lsl #num_subtag_bits-word_shift)
    7777        __(orr imm0,imm0,#subtag_u32_vector)
    78         __(stm sp!,{imm0,imm2})
     78        __(stmdb sp!,{imm0,imm2})
    7979        __(mov imm0,#TCR_STATE_LISP)
    8080        __(str imm0,[rcontext,#tcr.valence])
    8181        __(ldr allocptr,[rcontext,#tcr.save_allocptr])
    8282        __(bl toplevel_loop)
    83         __(ldr imm1,[sp,#4])
     83        __(ldmia sp!,{imm0,imm1})
    8484        __(mov imm0,#TCR_STATE_FOREIGN)
    8585        __(str imm1,[rcontext,#tcr.last_lisp_frame])
  • branches/arm/lisp-kernel/image.c

    r13511 r13789  
    353353        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_cons;
    354354#endif
     355#endif
     356#ifdef ARM
     357        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_nil;
    355358#endif
    356359        set_nil(image_nil);
  • branches/arm/lisp-kernel/linuxarm/Makefile

    r13753 r13789  
    2525CDEFINES = -DLINUX -DARM -D_REENTRANT -D_GNU_SOURCE
    2626CDEBUG = -g
    27 COPT = -O2
     27COPT = #-O2
    2828# Once in a while, -Wformat says something useful.  The odds are against that,
    2929# however.
  • branches/arm/lisp-kernel/platform-linuxarm.h

    r13737 r13789  
    2626
    2727
    28 #define MAXIMUM_MAPPABLE_MEMORY (1U<<30) /* uh, no */
    29 #define IMAGE_BASE_ADDRESS 0x31000000 /*  not likely */
     28#define MAXIMUM_MAPPABLE_MEMORY (256<<20) /* uh, no */
     29#define IMAGE_BASE_ADDRESS 0x10001000
    3030
    3131#include "lisptypes.h"
  • branches/arm/lisp-kernel/pmcl-kernel.c

    r13737 r13789  
    18161816#ifdef X86
    18171817  lisp_global(SUBPRIMS_BASE) = (LispObj)((1<<16)+(5<<10));
    1818 #else
     1818#endif
     1819#ifdef PPC
    18191820  lisp_global(SUBPRIMS_BASE) = (LispObj)(5<<10);
    18201821#endif
     1822#ifdef ARM
     1823  lisp_global(SUBPRIMS_BASE) = (LispObj)(9<<12);
     1824#endif
     1825
    18211826  lisp_global(RET1VALN) = (LispObj)&ret1valn;
    18221827  lisp_global(LEXPR_RETURN) = (LispObj)&nvalret;
     
    19411946xMakeDataExecutable(void *start, unsigned long nbytes)
    19421947{
    1943 #ifndef X86
     1948#ifdef PPC
    19441949  extern void flush_cache_lines();
    19451950  natural ustart = (natural) start, base, end;
     
    19481953  end = (ustart + nbytes + cache_block_size - 1) & ~(cache_block_size-1);
    19491954  flush_cache_lines(base, (end-base)/cache_block_size, cache_block_size);
     1955#endif
     1956#ifdef ARM
     1957  extern void flush_cache_lines(void *, void *);
     1958  flush_cache_lines(start,((char *)start)+nbytes);
    19501959#endif
    19511960}
  • branches/arm/lisp-kernel/thread_manager.c

    r13737 r13789  
    15241524  tcr->cs_area = a;
    15251525  a->owner = tcr;
     1526#ifdef ARM
     1527  tcr->last_lisp_frame = (lisp_frame *)(a->high);
     1528#endif
    15261529  if (!(tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN))) {
    15271530    tcr->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
  • branches/arm/xdump/xfasload.lisp

    r13279 r13789  
    10541054      ;; a function vector).  The code-vector in its 0th element should
    10551055      ;; report the appropriate error.
    1056       (let* ((udf-object (xload-make-gvector :simple-vector 1)))
    1057         (setf (xload-%svref udf-object 0) (xload-save-code-vector
    1058                                            (backend-xload-info-udf-code
    1059                                             *xload-target-backend*))))
     1056      ;; On the ARM: make a two-element vector: entrypoint, code-vector.
     1057      (let* ((udf-object (xload-make-gvector :simple-vector (target-arch-case (:arm 2) (otherwise 1)))))
     1058        (target-arch-case
     1059         (:arm
     1060          (setf (xload-%svref udf-object 0)
     1061                (subprim-name->offset '.SPfix-nfn-entrypoint *target-backend*)))
     1062         (otherwise ))
     1063        (setf (xload-%svref udf-object (target-arch-case
     1064                                        (:arm 1) (otherwise 0)))
     1065              (xload-save-code-vector
     1066               (backend-xload-info-udf-code
     1067                *xload-target-backend*))))
    10601068      (let* ((udf-object (xload-make-gvector :simple-vector 1)))
    10611069        (setf (xload-%svref udf-object 0) (backend-xload-info-udf-code
Note: See TracChangeset for help on using the changeset viewer.