Changeset 13903


Ignore:
Timestamp:
Jun 30, 2010, 5:41:03 PM (9 years ago)
Author:
gb
Message:

arm-asm.lisp: had cs and cc condition names backwards. (not used very
often, I guess.) umull and umulls had the wrong opcode.

arm-bignum.lisp: %ADD-WITH-CARRY needs to use adcs to propagate carry out.
Define %SUBTRACT-WITH-BORROW, fix %NORMALIZE-BIGNUM-2.

arm-float: implement, fix some things.

arm-numbers: steal %FIXNUM-GCD from Wikipedia.

l0-array.lisp: *IMMHEADER-ARRAY-TYPES*, *NODEHEADER-ARRAY-TYPES* for ARM.

arm-trap-support.lisp: started.

ffi-linuxarm.lisp: more plausible callback support.

ARM stuff for MACHINE-TYPE, HEAP-UTILIZATION.

arm-exceptions.c: callback glue functions return Boolean.

arm-exceptions.h: typos in opcode test macros.

arm-spentry.s: .SPeabi_callback.

Location:
branches/arm
Files:
11 edited

Legend:

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

    r13897 r13903  
    2222
    2323(defparameter *arm-condition-names* '(("eq" . 0) ("ne" . 1)
    24                                       ("hs" . 2) ("cc" . 2) ("lo" . 3) ("cs" . 3)
     24                                      ("hs" . 2) ("cs" . 2) ("lo" . 3) ("cc" . 3)
    2525                                      ("mi" . 4) ("pl" . 5)
    2626                                      ("vs" . 6) ("vc" . 7)
     
    711711     ())
    712712   (define-arm-instruction umull (:rd :rn :rm :rs)
    713      #x00400090
     713     #x00800090
    714714     #x0ff000f0
    715715     ())
    716716   (define-arm-instruction umulls (:rd :rn :rm :rs)
    717      #x00500090
     717     #x00900090
    718718     #x0ff000f0
    719719     ())
  • branches/arm/level-0/ARM/arm-bignum.lisp

    r13897 r13903  
    139139  (ldr temp0 (:@ vsp (:$ k)))
    140140  (add vsp vsp (:$ 16)) 
    141   (adc imm0 imm1 imm2)
     141  (adcs imm0 imm1 imm2)
    142142  (add imm2 temp0 (:$ arm::misc-data-offset))
    143143  (str imm0 (:@ temp1 imm2))
     
    169169;;; Store the result of A[I] - B[J] - borrow into R[K], returning the borrow.
    170170;;; If I is NIL, A is a fixnum; likewise for J and B.
    171 #+notyet
    172171(defarmlapfunction %subtract-with-borrow ((r 12) (k 8) (borrow 4) (a 0) (i arg_x) (b arg_y) (j arg_z))
    173   (cmpwi cr0 i arm::nil-value)
    174   (cmpwi cr1 j arm::nil-value)
    175   (ldr temp0 vsp (:$ a))
    176   (unbox-fixnum imm2 b)
    177   (unbox-fixnum imm1 temp0)
    178   (beq cr1 @got-b)
    179   (add imm2 j (:$ arm::misc-data-offset))
    180   (ldr imm2 (:@ b imm2))
    181   @got-b
    182   (beq cr0 @got-a)
    183   (add imm1 i (:$ arm::misc-data-offset))
    184   (ldr imm1 (:@ temp0 imm1))
    185   @got-a
    186   (ldr temp0 vsp (:$ borrow))
     172  (cmp i 'nil)
     173  (ldr temp0 (:@ vsp (:$ a)))
     174  (moveq imm1 (:asr temp0 (:$ arm::fixnumshift)))
     175  (addne imm1 i (:$ arm::misc-data-offset))
     176  (ldrne imm1 (:@ temp0 imm1))
     177  (cmp j 'nil)
     178  (moveq imm2 (:asr b (:$ arm::fixnumshift)))
     179  (addne imm2 j (:$ arm::misc-data-offset))
     180  (ldrne imm2 (:@ b imm2))
     181  (ldr temp0 (:@ vsp (:$ borrow)))
    187182  (unbox-fixnum imm0 temp0)
    188   (addic imm0 imm0 -1)
    189   (ldr temp0 vsp (:$ r))
    190   (ldr temp1 vsp (:$ k))
     183  (subs imm0 imm0 (:$ -1))
     184  (ldr temp0 (:@ vsp (:$ r)))
     185  (ldr temp1 (:@ vsp (:$ k)))
    191186  (add vsp vsp (:$ 16)) 
    192   (subfe imm0 imm2 imm1)
     187  (sbcs imm0 imm2 imm1)
    193188  (add imm1 temp1 (:$ arm::misc-data-offset))
    194189  (str imm0 (:@ temp0 imm1))
    195   (addze imm0 rzero)
     190  (adc imm0 imm0 (:$ 0))
    196191  (box-fixnum arg_z imm0)
    197192  (bx lr))
     
    10491044    (cmp usign (:$ 0))
    10501045    (orr imm2 imm2 (:lsl len (:$ (- arm::num-subtag-bits arm::fixnumshift))))
    1051     (str imm2 (:@ res (:$ arm::misc-header-offset)))
    10521046    ;; 0 to tail if negative
    1053     (bxeq lr)
     1047    (beq @set-header)
    10541048    ;; zero from len inclusive to oldlen exclusive
    1055     (mov temp0 (:$ 0))
     1049    (mov imm1 (:$ 0))
    10561050    (add idx len (:$ arm::misc-data-offset))
    10571051    @loop2
    1058     (str temp0 (:@ idx res))
     1052    (str imm1 (:@ idx res))
    10591053    (add len len '1)
    10601054    (cmp len oldlen)
    10611055    (add idx idx '1)
    10621056    (blt @loop2)
     1057    @set-header
     1058    (str imm2 (:@ res (:$ arm::misc-header-offset)))
    10631059    (bx lr)))
    10641060
  • branches/arm/level-0/ARM/arm-float.lisp

    r13889 r13903  
    156156
    157157
    158 #+later
    159158(defarmlapfunction %%scale-dfloat! ((float arg_x)(int arg_y)(result arg_z))
    160   (let ((fl.h 8)
    161         (fl.l 12)
    162         (sc.h 16)
    163         (sc.l 20))
    164     (clear-fpu-exceptions)
    165     (ldr imm0 (:@ float (:$ arm::double-float.value)))
    166     (ldr imm1 (:@ float (:$ arm::double-float.val-low)))
    167     (stwu tsp -24 tsp)
    168     (stw tsp 4 tsp)
    169     (stw imm0 fl.h tsp)
    170     (stw imm1 fl.l tsp)
    171     (unbox-fixnum imm0 int)
    172     ;(addi imm0 imm0 1022)  ; bias exponent - we assume no ovf
    173     (slwi imm0 imm0 20)     ; more important - get it in right place
    174     (stw imm0 sc.h tsp)
    175     (stw rzero sc.l tsp)
    176     (lfd fp0 fl.h tsp)
    177     (lfd fp1 sc.h tsp)
    178     (ldr tsp (:@ tsp (:$ 0)))
    179     (fmul fp2 fp0 fp1)
    180     (stfd fp2 arm::double-float.value result)
    181     (bx lr)))
    182 
    183 
    184 
    185 #+later
     159  (unbox-fixnum imm2 int)               ;imm0/imm1 needed for ldrd, etc.
     160  (get-double-float d0 float)
     161  (mov temp0 (:$ 0))
     162  (mov imm2 (:lsl imm2 (:$ (- ieee-double-float-exponent-offset 32))))
     163  (fmdrr d1 temp0 imm2)
     164  (fmuld d0 d1 d0)
     165  (put-double-float d0 result)
     166  (bx lr))
     167
     168
     169
    186170(defarmlapfunction %%scale-sfloat! ((float arg_x)(int arg_y)(result arg_z))
    187   (let ((sc.h 12))
    188     (clear-fpu-exceptions)
    189     (lfs fp0 arm::single-float.value float)
    190     (unbox-fixnum imm0 int)
    191     (slwi imm0 imm0 IEEE-single-float-exponent-offset)
    192     (stwu tsp -16 tsp)
    193     (stw tsp 4 tsp)
    194     (stw imm0 sc.h tsp)
    195     (lfs fp1 sc.h tsp)
    196     (ldr tsp (:@ tsp (:$ 0)))
    197     (fmuls fp2 fp0 fp1)
    198     (stfs fp2 arm::single-float.value result)
    199     (bx lr)))
     171  (ldr imm1 (:@ float (:$ arm::single-float.value)))
     172  (mov imm0 (:lsl int (:$ (- IEEE-single-float-exponent-offset arm::fixnumshift))))
     173  (fmsr s0 imm1)
     174  (fmsr s2 imm0)
     175  (fmuls s0 s0 s2)
     176  (fmrs imm0 s0)
     177  (str imm0 (:@ result (:$ arm::single-float.value)))
     178  (bx lr))
    200179                   
    201180
     
    218197  (ldr imm1 (:@ n (:$ arm::double-float.val-high)))
    219198  (mov imm1 (:lsl imm1 (:$ 1)))
    220   (mov imm1 (:lsr imm1 (:$ 21)))
     199  (mov imm1 (:lsr imm1 (:$ (1+ (- ieee-double-float-exponent-offset 32)))))
    221200  (box-fixnum arg_z imm1)
    222201  (bx lr))
     
    240219(defarmlapfunction %short-float-exp ((n arg_z))
    241220  (ldr imm1 (:@ n (:$ arm::single-float.value)))
    242   (mov arg_z (:$ (ash #xff arm::fixnumshift)))
    243   (and arg_z arg_z (:lsr imm1 (:$ (- 23 arm::fixnumshift))))
     221  (mov imm1 (:lsl imm1 (:$ 1)))
     222  (mov imm1 (:lsr imm1 (:$ (1+ ieee-single-float-exponent-offset))))
     223  (box-fixnum arg_z imm1)
    244224  (bx lr))
    245225
     
    250230  (ldr imm1 (:@ float (:$ arm::single-float.value)))
    251231  (mov imm0 (:$ #xff000000))
    252   (bic imm1 imm1 (:lsr imm0 (:$ 1)))
    253   (and imm0 imm0 (:lsl exp (:$ (- 24 arm::fixnumshift))))
    254   (orr imm1 imm1 (:lsr imm0 (:$ 1)))
     232  (mvn imm0 (:lsr imm0 (:$ 1)))
     233  (and imm1 imm1 imm0)
     234  (orr imm1 imm1 (:lsl exp (:$ (- ieee-single-float-exponent-offset arm::fixnumshift))))
    255235  (str imm1 (:@ float (:$ arm::single-float.value)))
    256236  (bx lr))
     
    560540(defarmlapfunction %double-float-sign ((n arg_z))
    561541  (ldr imm0 (:@ n (:$ arm::double-float.val-high)))
    562   (cmp imm0 '($ 0))
     542  (cmp imm0 ($ 0))
    563543  (mov arg_z 'nil)
    564544  (addlt arg_z arg_z (:$ arm::t-offset))
     
    567547(defarmlapfunction %short-float-sign ((n arg_z))
    568548  (ldr imm0 (:@ n (:$ arm::single-float.value)))
    569   (cmp imm0 '($ 0))
     549  (cmp imm0 ($ 0))
    570550  (mov arg_z 'nil)
    571551  (addlt arg_z arg_z (:$ arm::t-offset))
  • branches/arm/level-0/ARM/arm-numbers.lisp

    r13889 r13903  
    181181
    182182;;; n1 and n2 must be positive (esp non zero)
    183 #+notyet
     183;;; See <http://en.wikipedia.org/wiki/Binary_GCD_algorithm>
    184184(defarmlapfunction %fixnum-gcd ((n1 arg_y)(n2 arg_z))
    185   (let ((temp imm0)
    186         (u imm1)
    187         (v imm2)
    188         (ut0 imm3)
    189         (vt0 imm4))
    190     (unbox-fixnum u n1)
    191     (unbox-fixnum v n2)
    192     (neg temp u)
    193     (and temp temp u)
    194     (cntlzw ut0 temp)
    195     (subfic ut0 ut0 31)
    196     (neg temp v)
    197     (and temp temp v)
    198     (cntlzw vt0 temp)
    199     (subfic vt0 vt0 31)
    200     (cmpw cr2 ut0 vt0)
    201     (srw u u ut0)
    202     (srw v v vt0)
    203     (addi ut0 ut0 arm32::fixnum-shift)
    204     (addi vt0 vt0 arm32::fixnum-shift)
    205     @loop
    206     (cmpw cr0 u v)
    207     (slw arg_z u ut0)
    208     (bgt cr0 @u>v)
    209     (blt cr0 @u<v)
    210     (blelr cr2)
    211     (slw arg_z u vt0)
    212     (blr)
    213     @u>v
    214     (sub u u v)
    215     @shiftu
    216     (andi. temp u (ash 1 1))
    217     (srwi u u 1)
    218     (beq cr0 @shiftu)
    219     (b @loop)
    220     @u<v
    221     (sub v v u)
    222     @shiftv
    223     (andi. temp v (ash 1 1))
    224     (srwi v v 1)
    225     (beq cr0 @shiftv)
    226     (b @loop)))
     185  (mov arg_x rcontext)                  ;need an extra imm reg
     186  (unbox-fixnum imm0 n1)
     187  (unbox-fixnum imm1 n2)
     188  (subs r3 imm0 imm0)                   ; zero power-of-2 counter, set c flag
     189  (orrs imm2 imm0 imm1)                 ; preserves carry, set other flags
     190  @remove-twos-loop
     191  (movsne imm2 (:lsr imm2 (:$ 1)))      ; carry = lsbit
     192  (addcc r3 r3 (:$ 1))                  ; increment counter if lsbit 0
     193  (bcc @remove-twos-loop)
     194  (movs imm0 (:lsr imm0 r3))
     195  (movsne imm1 (:lsr imm1 r3))
     196  (beq @finish)
     197  @check-two-r0
     198  (movs imm0 (:lsr imm0 (:$ 1)))
     199  (bcc @check-two-r0)
     200  @check-two-r1
     201  (movs imm1 (:lsr imm1 (:$ 1)))
     202  (bcc @check-two-r1)
     203  (subs imm1 imm1 imm0)
     204  (addcc imm0 imm0 imm1)
     205  (rsbcc imm1 imm1 (:$ 0))
     206  (bne @check-two-r1)
     207  (adc imm0 imm0 imm0)
     208  @finish
     209  (orr imm0 imm1 (:lsl imm0 r3))
     210  (mov rcontext arg_x)
     211  (box-fixnum arg_z imm0)
     212  (bx lr))
     213
    227214
    228215
  • branches/arm/level-0/l0-array.lisp

    r13840 r13903  
    172172   
    173173)
     174
     175#+arm-target
     176(defconstant arm::*immheader-array-types*
     177  '#(short-float
     178     (unsigned-byte 32)
     179     (signed-byte 32)
     180     fixnum
     181     character
     182     (unsigned-byte 8)
     183     (signed-byte 8)
     184     unused
     185     (unsigned-byte 16)
     186     (signed-byte 16)
     187     double-float
     188     bit))
    174189
    175190
     
    202217              (t
    203218               (%svref x8664::*immheader-0-array-types* idx))))
     219      #+arm-target
     220      (svref arm::*immheader-array-types*
     221             (ash (the fixnum (- subtag arm::min-cl-ivector-subtag)) -3))
    204222      )))
    205223
  • branches/arm/level-1/arm-trap-support.lisp

    r13889 r13903  
    1717(in-package "CCL")
    1818
    19 (defcallback xcmain ()
     19#+linuxarm-target
     20(progn
     21(defmacro with-xp-registers-and-gpr-offset ((xp register-number)
     22                                            (registers offset) &body body)
     23  (let* ((regform `(pref ,xp :ucontext.uc_mcontext)))
     24    `(with-macptrs ((,registers ,regform))
     25      (let ((,offset (xp-gpr-offset ,register-number)))
     26        ,@body))))
     27(defun xp-gpr-offset (register-number)
     28  (unless (and (fixnump register-number)
     29               (<= -3 (the fixnum register-number))
     30               (< (the fixnum register-number) 18))
     31    (setq register-number (require-type register-number '(integer -3 (18)))))
     32  (the fixnum (* (the fixnum (+ register-number 3)) arm::node-size)))
     33)
     34
     35(defun xp-gpr-lisp (xp register-number)
     36  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
     37    (values (%get-object registers offset))))
     38
     39(defun (setf xp-gpr-lisp) (value xp register-number)
     40  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
     41    (%set-object registers offset value)))
     42
     43(defun xp-gpr-signed-long (xp register-number)
     44  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
     45    (values (%get-signed-long registers offset))))
     46
     47
     48(defun xp-gpr-signed-doubleword (xp register-number)
     49  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
     50    (values (%%get-signed-longlong registers offset))))
     51 
     52
     53(defun xp-gpr-macptr (xp register-number)
     54  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
     55    (values (%get-ptr registers offset))))
     56
     57(defcallback xcmain (:address xp
     58                     :signed-fullword signal
     59                     :signed-fullword arg
     60                     :signed-fullword fnreg
     61                     :signed-fullword offset)
     62  (error "xcmain callback")
    2063  )
  • branches/arm/lib/ffi-linuxarm.lisp

    r13778 r13903  
    9090;;; A FOREIGN-TYPE representing the "actual" return type.
    9191;;; A form which can be used to initialize FP-ARGS-PTR, relative
    92 ;;;  to STACK-PTR.  (This is unused on linuxppc32.)
     92;;;  to STACK-PTR.  (This is unused on linuxarm.)
    9393;;; The byte offset of the foreign return address, relative to STACK-PTR
    9494(defun arm-linux::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)
     
    105105                  argspecs (cons :address argspecs)
    106106                  rtype *void-foreign-type*))))
    107           (let* ((offset  96)
    108                  (gpr 0)
    109                  (fpr 32))
     107          (let* ((offset 0)
     108                 (nextoffset offset))
    110109            (do* ((argvars argvars (cdr argvars))
    111110                  (argspecs argspecs (cdr argspecs)))
     
    114113              (let* ((name (car argvars))
    115114                     (spec (car argspecs))
    116                      (nextgpr gpr)
    117                      (nextfpr fpr)
    118                      (nextoffset offset)
    119                      (target gpr)
    120                      (bias 0)
    121115                     (argtype (parse-foreign-type spec)))
    122116                (if (typep argtype 'foreign-record-type)
     
    125119                        `(,(cond
    126120                            ((typep argtype 'foreign-single-float-type)
    127                              (incf nextfpr 8)
    128                              (if (< fpr 96)
    129                                (setq target fpr)
    130                                (setq target (+ offset (logand offset 4))
    131                                      nextoffset (+ target 8)))
     121                             (setq nextoffset (+ offset 4))
    132122                             '%get-single-float-from-double-ptr)
    133123                            ((typep argtype 'foreign-double-float-type)
    134                              (incf nextfpr 8)
    135                              (if (< fpr 96)
    136                                (setq target fpr)
    137                                (setq target (+ offset (logand offset 4))
    138                                      nextoffset (+ target 8)))
     124                             (when (logtest offset 4)
     125                               (incf offset 4))
     126                             (setq nextoffset (+ offset 8))
    139127                             '%get-double-float)
    140128                            ((and (typep argtype 'foreign-integer-type)
    141129                                  (= (foreign-integer-type-bits argtype) 64)
    142130                                  (foreign-integer-type-signed argtype))
    143                              (if (< gpr 56)
    144                                      (setq target (+ gpr (logand gpr 4))
    145                                            nextgpr (+ 8 target))
    146                                      (setq target (+ offset (logand offset 4))
    147                                            nextoffset (+ 8 offset)))
    148                                    '%%get-signed-longlong)
     131                             (when (logtest offset 4)
     132                               (incf offset 4))
     133                             (setq nextoffset (+ offset 8))
     134                             '%%get-signed-longlong)
    149135                            ((and (typep argtype 'foreign-integer-type)
    150136                                  (= (foreign-integer-type-bits argtype) 64)
    151137                                  (not (foreign-integer-type-signed argtype)))
    152                              (if (< gpr 56)
    153                                (setq target (+ gpr (logand gpr 4))
    154                                      nextgpr (+ 8 target))
    155                                (setq target (+ offset (logand offset 4))
    156                                      nextoffset (+ 8 offset)))
     138                             (when (logtest offset 4)
     139                               (incf offset 4))
     140                             (setq nextoffset (+ offset 8))
    157141                             '%%get-unsigned-longlong)
    158142                            (t
    159                              (incf nextgpr 4)
    160                              (if (< gpr 64)
    161                                (setq target gpr)
    162                                (setq target offset nextoffset (+ offset 4)))
     143                             (setq nextoffset (+ offset 4))
    163144                             (cond ((typep argtype 'foreign-pointer-type) '%get-ptr)
    164145                                   ((typep argtype 'foreign-integer-type)
     
    166147                                           (signed (foreign-integer-type-signed argtype)))
    167148                                      (cond ((<= bits 8)
    168                                              (setq bias 3)
    169149                                             (if signed
    170150                                               '%get-signed-byte '
    171151                                               '%get-unsigned-byte))
    172152                                            ((<= bits 16)
    173                                              (setq bias 2)
    174153                                             (if signed
    175154                                               '%get-signed-word
     
    184163                                    (error "Don't know how to access foreign argument of type ~s" (unparse-foreign-type argtype))))))
    185164                          ,stack-ptr
    186                           ,(+ target bias))))
     165                          ,offset)))
    187166                  (when name (lets (list name access-form)))
    188                   #+nil
    189                   (when (eq spec :address)
    190                     (dynamic-extent-names name))
    191                   (setq gpr nextgpr fpr nextfpr offset nextoffset))))))))
     167                  (setq offset nextoffset))))))))
    192168
    193169(defun arm-linux::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg)
    194170  (declare (ignore fp-args-ptr))
    195171  (unless (eq return-type *void-foreign-type*)
    196     (when (typep return-type 'foreign-single-float-type)
    197       (setq result `(float ,result 0.0d0)))   
    198172    (let* ((return-type-keyword
    199173            (if (typep return-type 'foreign-record-type)
     
    202176                :unsigned-doubleword)
    203177              (foreign-type-to-representation-type return-type)))
    204            (offset (case return-type-keyword
    205                    ((:single-float :double-float)
    206                     8)
    207                    (t 0))))
     178           (offset -8))
    208179      `(setf (,
    209180              (case return-type-keyword
  • branches/arm/lib/misc.lisp

    r13779 r13903  
    9494                              (read-line f nil nil))
    9595                        (target #+ppc-target "machine"
    96                                 #+x86-target "model name"))
     96                                #+x86-target "model name"
     97                                #+arm-target "Hardware"))
    9798                       ((null line))
    9899                    (let* ((matched (cpu-info-match target line)))
     
    11111112                    ((= lowtag ppc64::lowtag-nodeheader)
    11121113                     (%svref *nodeheader-types* (ash i -2)))))))
    1113     #+(or ppc32-target x8632-target)
     1114    #+(or ppc32-target x8632-target arm-target)
    11141115    (dotimes (i 256)
    11151116      (let* ((fulltag (logand i target::fulltagmask)))
  • branches/arm/lisp-kernel/arm-exceptions.c

    r13892 r13903  
    11651165}
    11661166
    1167 int
     1167Boolean
    11681168callback_for_trap (LispObj callback_macptr, ExceptionInformation *xp, natural info,natural arg)
    11691169{
     
    11711171}
    11721172
    1173 int
     1173Boolean
    11741174callback_to_lisp (LispObj callback_macptr, ExceptionInformation *xp,
    11751175                  natural arg1, natural arg2)
     
    12141214  /* Copy GC registers back into exception frame */
    12151215  xpGPR(xp, allocptr) = (LispObj) ptr_to_lispobj(tcr->save_allocptr);
     1216  return true;
    12161217}
    12171218
  • branches/arm/lisp-kernel/arm-exceptions.h

    r13848 r13903  
    8787
    8888
    89 #define IS_GC_TRAP(i)                (((i)*0x0fffffff) == 0x07f001f0)
    90 #define IS_DEBUG_TRAP(i)             (((i)*0x0fffffff) == 0x07f002f0)
    91 #define IS_DEFERRED_INTERRUPT(i)     (((i)*0x0fffffff) == 0x07f004f0)
    92 #define IS_DEFERRED_SUSPEND(i)       (((i)*0x0fffffff) == 0x07f005f0)
     89#define IS_GC_TRAP(i)                (((i)&0x0fffffff) == 0x07f002f0)
     90#define IS_DEBUG_TRAP(i)             (((i)&0x0fffffff) == 0x07f003f0)
     91#define IS_DEFERRED_INTERRUPT(i)     (((i)&0x0fffffff) == 0x07f004f0)
     92#define IS_DEFERRED_SUSPEND(i)       (((i)&0x0fffffff) == 0x07f005f0)
    9393
    9494
  • branches/arm/lisp-kernel/arm-spentry.s

    r13897 r13903  
    29602960       
    29612961_spentry(eabi_callback)
    2962         __(uuo_debug_trap(al))
    2963         __(uuo_debug_trap(al))
     2962        __(stmdb sp!,{r0,r1,r2,r3})
     2963        __(mov r0,sp)
     2964        __(sub sp,sp,#2*node_size) /* room for result */
     2965        __(stmdb sp!,{r4,r5,r6,r7,r8,r9,r10,r11,r12,lr})
     2966        __(mov r4,r0)
     2967        __(unbox_fixnum(r5,r12))
     2968        __(ref_global(r12,get_tcr,r0))
     2969        __(mov r0,#1)
     2970        __(blx r12)
     2971        __(mov rcontext,r0)
     2972        __(ldr imm2,[rcontext,#tcr.last_lisp_frame])
     2973        __(sub imm0,imm2,sp)
     2974        __(add imm0,imm0,#node_size)
     2975        __(mov imm0,imm0,lsl #num_subtag_bits-word_shift)
     2976        __(orr imm0,imm0,#subtag_u32_vector)
     2977        __(stmdb sp!,{imm0,imm2})
     2978        __(mov arg_x,#0)
     2979        __(mov temp0,#0)
     2980        __(mov temp1,#0)
     2981        __(mov temp2,#0)
     2982        __(mov allocptr,#VOID_ALLOCPTR)
     2983        __(mov fn,#0)
     2984        __(ldr vsp,[rcontext,#tcr.save_vsp])
     2985        __(mov imm0,#TCR_STATE_LISP)
     2986        __(str imm0,[rcontext,#tcr.valence])
     2987        __(ldr allocptr,[rcontext,#tcr.save_allocptr])
     2988        __(set_nargs(2))
     2989        __(ref_nrs_symbol(fname,callbacks,imm0))
     2990        __(ldr nfn,[fname,#symbol.fcell])
     2991        __(ldr lr,[nfn,#_function.entrypoint])
     2992        __(blx lr)
     2993        __(str vsp,[rcontext,#tcr.save_vsp])
     2994        __(ldr imm1,[sp,#4])
     2995        __(str vsp,[rcontext,#tcr.last_lisp_frame])
     2996        __(str allocptr,[rcontext,#tcr.save_allocptr])
     2997        __(mov imm0,#TCR_STATE_FOREIGN)
     2998        __(str imm0,[rcontext,#tcr.valence])
     2999        __(ldmia sp!,{r4,r5,r6,r7,r8,r9,r10,r11,r12,lr})
     3000        __(ldmia sp!,{r0,r1})
     3001        __(add sp,sp,#4*node_size)
     3002        __(bx lr)
    29643003       
    29653004/*  EOF, basically  */
     
    29673006_exportfn(C(misc_ref_common))
    29683007        __(adr imm0,(local_label(misc_ref_jmp)))
    2969         __(ldr pc,[imm0,imm1,lsl #2])       
     3008        __(ldr pc,[imm0,imm1,lsl #2])
    29703009
    29713010local_label(misc_ref_jmp):         
Note: See TracChangeset for help on using the changeset viewer.