Changeset 13889


Ignore:
Timestamp:
Jun 25, 2010, 1:39:28 PM (9 years ago)
Author:
gb
Message:

arm-arch.lisp: We don't have a tcr.ts-area on ARM (or a tcr.save-tsp
...). We do have a tcr.last-lisp-frame, and now have a (dummy)
.SPeabi-callback.

arm-asm.lisp: add umull, umulls; a few fixes.

arm-disassemble.lisp: extract-arm-fpaddr-operand, fix in
extract-arm-sd-operand.

arm-vinsns.lisp: fix alloc-eabi-c-frame. Add vinsns to return FP ffi results.
Handle > 255 args.

arm2.lisp: Handle > 255 args. Fix some cases involving comparisons to
integer constants. Don't do the "alternate tail call" thing
unless/until we can remember what it means (it's basically a way of skipping
saving/restoring NVRs on tail calls) and how that'd apply to the ARM.
Plausible-looking FF-call, for now.

arm-bignum.lisp: add missing functions.

arm-float.lisp: skeletal FP ffi exception stuff.

arm-misc.lisp: %UNLOCK-GC-LOCK, GET-SAVED-REGISTER-VALUES.

arm-numbers.lisp: %FIXNUM-TRUNCATE.

arm-pred.lisp: EQUAL doesn't want to funcall the value cell of 'EQL.

l0-bignum32.lisp: no Karatsuba multiplication on ARM, for now.

arm-callback-support.lisp: MAKE-CALLBACK-TRAMPOLINE.

arm-error-sigal.lisp: (empty) %XERR-DISP callback.

arm-thread-utils.lisp: some support for BOGUS-THING-P.

arm-trap-support.lisp: (empty) XCMAIN callback.

l1-clos-boot.lisp: really remove #+arm-target dbg trap from
NO-APPLICABLE-METHOD.

l1-lisp-threads.lisp: %INIT-THREAD-FROM-TCR: no tstack on ARM.

l1-strams.lisp: handle ARM tagging in MAKE-HEAP-IVECTOR.

arm-macros.s: set catch frame header to the right type.

arm-spentry.s: get _SPthrow working. Zero the stack block in
_SPmakestackblock0. Handle stack-allocation limits correctly
in _SPstack_cons_rest_arg. Add (but don't implement) _SPeabi_callback.

Loads all fasls, prints a prompt, and then gets lost in STREAM-PEEK-CHAR.

Location:
branches/arm
Files:
20 edited

Legend:

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

    r13859 r13889  
    436436             (defarmsubprim .SPeabi-ff-call)
    437437             (defarmsubprim .SPdebind)
     438             (defarmsubprim .SPeabi-callback)
    438439             )))))
    439440
     
    840841  cs-area                               ; cstack area pointer
    841842  vs-area                               ; vstack area pointer
    842   ts-area                               ; tstack area pointer
     843  last-lisp-frame
    843844  cs-limit                              ; cstack overflow limit
    844845  total-bytes-allocated-high
     
    11321133
    11331134(defparameter *arm-target-arch*
    1134   (arch::make-target-arch :name :arm
    1135                           :lisp-node-size 4
    1136                           :nil-value canonical-nil-value
    1137                           :fixnum-shift fixnumshift
    1138                           :most-positive-fixnum (1- (ash 1 (1- (- 32 fixnumshift))))
    1139                           :most-negative-fixnum (- (ash 1 (1- (- 32 fixnumshift))))
    1140                           :misc-data-offset misc-data-offset
    1141                           :misc-dfloat-offset misc-dfloat-offset
    1142                           :nbits-in-word 32
    1143                           :ntagbits 3
    1144                           :nlisptagbits 2
    1145                           :uvector-subtags *arm-target-uvector-subtags*
    1146                           :max-64-bit-constant-index max-64-bit-constant-index
    1147                           :max-32-bit-constant-index max-32-bit-constant-index
    1148                           :max-16-bit-constant-index max-16-bit-constant-index
    1149                           :max-8-bit-constant-index max-8-bit-constant-index
    1150                           :max-1-bit-constant-index max-1-bit-constant-index
    1151                           :word-shift 2
    1152                           :code-vector-prefix ()
    1153                           :gvector-types '(:ratio :complex :symbol :function
    1154                                            :catch-frame :struct :istruct
    1155                                            :pool :population :hash-vector
    1156                                            :package :value-cell :instance
    1157                                            :lock :slot-vector
    1158                                            :simple-vector)
    1159                           :1-bit-ivector-types '(:bit-vector)
    1160                           :8-bit-ivector-types '(:signed-8-bit-vector
    1161                                                  :unsigned-8-bit-vector)
    1162                           :16-bit-ivector-types '(:signed-16-bit-vector
    1163                                                   :unsigned-16-bit-vector)
    1164                           :32-bit-ivector-types '(:signed-32-bit-vector
    1165                                                   :unsigned-32-bit-vector
    1166                                                   :single-float-vector
    1167                                                   :fixnum-vector
    1168                                                   :single-float
    1169                                                   :double-float
    1170                                                   :bignum
    1171                                                   :simple-string)
    1172                           :64-bit-ivector-types '(:double-float-vector)
    1173                           :array-type-name-from-ctype-function
    1174                           #'arm-array-type-name-from-ctype
    1175                           :package-name "ARM"
    1176                           :t-offset t-offset
    1177                           :array-data-size-function #'arm-misc-byte-count
    1178                           :numeric-type-name-to-typecode-function
    1179                           #'(lambda (type-name)
    1180                               (ecase type-name
    1181                                 (fixnum tag-fixnum)
    1182                                 (bignum subtag-bignum)
    1183                                 ((short-float single-float) subtag-single-float)
    1184                                 ((long-float double-float) subtag-double-float)
    1185                                 (ratio subtag-ratio)
    1186                                 (complex subtag-complex)))
    1187                           :subprims-base arm::*arm-subprims-base*
    1188                           :subprims-shift arm::*arm-subprims-shift*
    1189                           :subprims-table arm::*arm-subprims*
    1190                           :primitive->subprims `(((0 . 23) . ,(ccl::%subprim-name->offset '.SPbuiltin-plus arm::*arm-subprims*)))
    1191                           :unbound-marker-value unbound-marker
    1192                           :slot-unbound-marker-value slot-unbound-marker
    1193                           :fixnum-tag tag-fixnum
    1194                           :single-float-tag subtag-single-float
    1195                           :single-float-tag-is-subtag t
    1196                           :double-float-tag subtag-double-float
    1197                           :cons-tag fulltag-cons
    1198                           :null-tag fulltag-nil
    1199                           :symbol-tag subtag-symbol
    1200                           :symbol-tag-is-subtag t
    1201                           :function-tag subtag-function
    1202                           :function-tag-is-subtag t
    1203                           :big-endian nil
    1204                           :misc-subtag-offset misc-subtag-offset
    1205                           :car-offset cons.car
    1206                           :cdr-offset cons.cdr
    1207                           :subtag-char subtag-character
    1208                           :charcode-shift charcode-shift
    1209                           :fulltagmask fulltagmask
    1210                           :fulltag-misc fulltag-misc
    1211                           :char-code-limit #x110000
    1212                           ))
     1135  (progn
     1136    (arch::make-target-arch :name :arm
     1137                            :lisp-node-size 4
     1138                            :nil-value canonical-nil-value
     1139                            :fixnum-shift fixnumshift
     1140                            :most-positive-fixnum (1- (ash 1 (1- (- 32 fixnumshift))))
     1141                            :most-negative-fixnum (- (ash 1 (1- (- 32 fixnumshift))))
     1142                            :misc-data-offset misc-data-offset
     1143                            :misc-dfloat-offset misc-dfloat-offset
     1144                            :nbits-in-word 32
     1145                            :ntagbits 3
     1146                            :nlisptagbits 2
     1147                            :uvector-subtags *arm-target-uvector-subtags*
     1148                            :max-64-bit-constant-index max-64-bit-constant-index
     1149                            :max-32-bit-constant-index max-32-bit-constant-index
     1150                            :max-16-bit-constant-index max-16-bit-constant-index
     1151                            :max-8-bit-constant-index max-8-bit-constant-index
     1152                            :max-1-bit-constant-index max-1-bit-constant-index
     1153                            :word-shift 2
     1154                            :code-vector-prefix ()
     1155                            :gvector-types '(:ratio :complex :symbol :function
     1156                                             :catch-frame :struct :istruct
     1157                                             :pool :population :hash-vector
     1158                                             :package :value-cell :instance
     1159                                             :lock :slot-vector
     1160                                             :simple-vector)
     1161                            :1-bit-ivector-types '(:bit-vector)
     1162                            :8-bit-ivector-types '(:signed-8-bit-vector
     1163                                                   :unsigned-8-bit-vector)
     1164                            :16-bit-ivector-types '(:signed-16-bit-vector
     1165                                                    :unsigned-16-bit-vector)
     1166                            :32-bit-ivector-types '(:signed-32-bit-vector
     1167                                                    :unsigned-32-bit-vector
     1168                                                    :single-float-vector
     1169                                                    :fixnum-vector
     1170                                                    :single-float
     1171                                                    :double-float
     1172                                                    :bignum
     1173                                                    :simple-string)
     1174                            :64-bit-ivector-types '(:double-float-vector)
     1175                            :array-type-name-from-ctype-function
     1176                            #'arm-array-type-name-from-ctype
     1177                            :package-name "ARM"
     1178                            :t-offset t-offset
     1179                            :array-data-size-function #'arm-misc-byte-count
     1180                            :numeric-type-name-to-typecode-function
     1181                            #'(lambda (type-name)
     1182                                (ecase type-name
     1183                                  (fixnum tag-fixnum)
     1184                                  (bignum subtag-bignum)
     1185                                  ((short-float single-float) subtag-single-float)
     1186                                  ((long-float double-float) subtag-double-float)
     1187                                  (ratio subtag-ratio)
     1188                                  (complex subtag-complex)))
     1189                            :subprims-base arm::*arm-subprims-base*
     1190                            :subprims-shift arm::*arm-subprims-shift*
     1191                            :subprims-table arm::*arm-subprims*
     1192                            :primitive->subprims `(((0 . 23) . ,(ccl::%subprim-name->offset '.SPbuiltin-plus arm::*arm-subprims*)))
     1193                            :unbound-marker-value unbound-marker
     1194                            :slot-unbound-marker-value slot-unbound-marker
     1195                            :fixnum-tag tag-fixnum
     1196                            :single-float-tag subtag-single-float
     1197                            :single-float-tag-is-subtag t
     1198                            :double-float-tag subtag-double-float
     1199                            :cons-tag fulltag-cons
     1200                            :null-tag fulltag-nil
     1201                            :symbol-tag subtag-symbol
     1202                            :symbol-tag-is-subtag t
     1203                            :function-tag subtag-function
     1204                            :function-tag-is-subtag t
     1205                            :big-endian nil
     1206                            :misc-subtag-offset misc-subtag-offset
     1207                            :car-offset cons.car
     1208                            :cdr-offset cons.cdr
     1209                            :subtag-char subtag-character
     1210                            :charcode-shift charcode-shift
     1211                            :fulltagmask fulltagmask
     1212                            :fulltag-misc fulltag-misc
     1213                            :char-code-limit #x110000
     1214                            )))
    12131215
    12141216;;; arch macros
  • branches/arm/compiler/ARM/arm-asm.lisp

    r13833 r13889  
    697697   (define-arm-instruction smulls (:rd :rn :rm :rs)
    698698     #x00d00090
     699     #x0ff000f0
     700     ())
     701   (define-arm-instruction umull (:rd :rn :rm :rs)
     702     #x00400090
     703     #x0ff000f0
     704     ())
     705   (define-arm-instruction umulls (:rd :rn :rm :rs)
     706     #x00500090
    699707     #x0ff000f0
    700708     ())
     
    12061214            (setq offset-val (- offset-val))
    12071215            (set-field-value instruction (byte 1 23) 1))
    1208           (set-field-value instruction (byte 8 0) (ash offset-val -3)))))))
     1216          (set-field-value instruction (byte 8 0) (ash offset-val -2)))))))
    12091217
    12101218(defun parse-@rn-operand (form instruction)
     
    18131821  (destructuring-bind (op rn offset) value
    18141822    (unless (eq op :@) (error "Bad FP address operand: ~s." value))
    1815     (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 12))
     1823    (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
    18161824    (destructuring-bind (marker offform) offset
    18171825      (unless (eq marker :$) (error "Bad FP offset: ~s" offset))
     
    20012009  (if (< value 0)
    20022010    (setq value (- value))
    2003     (set-field-value instruction (byte 1 23) value))
     2011    (set-field-value instruction (byte 1 23) 1))
    20042012  (set-field-value instruction (byte 8 0) (ash value -2)))
    20052013
  • branches/arm/compiler/ARM/arm-disassemble.lisp

    r13834 r13889  
    6565  (let* ((opcode (adi-opcode (svref opcodes i))))
    6666    (arm-gpr-name (ldb (byte 4 8) opcode))))
     67
     68(defun extract-arm-fpaddr-operand (opcodes i)
     69  (let* ((opcode (adi-opcode (svref opcodes i)))
     70         (offset (ash (ldb (byte 8 0) opcode) 2)))
     71    (unless (logbitp 23 opcode)
     72      (setq offset (- offset)))
     73    `(:@ ,(arm-gpr-name (ldb (byte 4 16) opcode)) (:$ ,offset))))
     74 
    6775
    6876(defparameter *arm-shift-ops* #(:lsl :lsr :asr :ror))
     
    244252(defun extract-arm-sn-operand (opcodes i)
    245253  (let* ((opcode (adi-opcode (svref opcodes i))))
    246     (arm-fprd-name (logior (ash (ldb (byte 4 16) opcode) 1)
     254    (arm-fprs-name (logior (ash (ldb (byte 4 16) opcode) 1)
    247255                           (ldb (byte 1 7) opcode)))))
    248256
  • branches/arm/compiler/ARM/arm-vinsns.lisp

    r13865 r13889  
    17551755                                       (size :imm)
    17561756                                       (prevsp :imm)))
    1757   (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 1 n-c-args) 1)) arm::num-subtag-bits)))
     1757  (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 4 1 n-c-args) 1)) arm::num-subtag-bits)))
    17581758  (mov size (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
    17591759  (orr header header (:$ arm::subtag-u32-vector))
     
    17891789
    17901790
     1791(define-arm-vinsn gpr-to-single-float (((dest :single-float))
     1792                                       ((src :u32)))
     1793  (fmsr dest src))
     1794
     1795(define-arm-vinsn gpr-pair-to-double-float (((dest :double-float))
     1796                                            ((low :u32)
     1797                                             (high :u32)))
     1798  (fmdrr dest low high))
    17911799
    17921800
     
    27752783  (uuo-error-wrong-nargs (:? ne)))
    27762784
     2785(define-arm-vinsn check-exact-nargs-large (()
     2786                                           ((n :u16const))
     2787                                           ((preserve (:u32 #.arm::nargs))
     2788                                            (temp :u32)))
     2789  (mov temp (:$ (:apply ash (:apply logand #xff n) 2)))
     2790  (orr temp temp (:$ (:apply ash (:apply logand #xff00 n) 2)))
     2791  (cmp nargs temp)
     2792  (uuo-error-wrong-nargs (:? ne)))
     2793
    27772794(define-arm-vinsn check-min-nargs (()
    27782795                                   ((min :u16const)))
     
    27802797  (uuo-error-wrong-nargs (:? lo)))
    27812798
     2799(define-arm-vinsn check-min-nargs-large (()
     2800                                         ((min :u16const))
     2801                                         ((preserve (:u32 #.arm::nargs))
     2802                                          (temp :u32)))
     2803  (mov temp (:$ (:apply ash (:apply logand #xff min) 2)))
     2804  (orr temp temp (:$ (:apply ash (:apply logand #xff00 min) 2)))
     2805  (cmp nargs temp)
     2806  (uuo-error-wrong-nargs (:? lo)))
     2807
    27822808
    27832809(define-arm-vinsn check-max-nargs (()
    27842810                                   ((max :u16const)))
    27852811  (cmp nargs (:$ (:apply ash max 2)))
     2812  (uuo-error-wrong-nargs (:? hi)))
     2813
     2814(define-arm-vinsn check-max-nargs-large (()
     2815                                         ((max :u16const))
     2816                                         ((preserve (:u32 #.arm::nargs))
     2817                                          (temp :u32)))
     2818  (mov temp (:$ (:apply ash (:apply logand #xff max) 2)))
     2819  (orr temp temp (:$ (:apply ash (:apply logand #xff00 max) 2)))
     2820  (cmp nargs temp)
    27862821  (uuo-error-wrong-nargs (:? hi)))
    27872822
  • branches/arm/compiler/ARM/arm2.lisp

    r13865 r13889  
    320320    (#.arm::arm-cond-ge arm::arm-cond-hs)))
    321321
    322 
     322;;; If we have to change the order of operands in a comparison, we
     323;;; generally need to change the condition we're testing.
     324(defun arm2-cr-bit-for-reversed-comparison (cr-bit)
     325  (ecase cr-bit
     326    (#.arm::arm-cond-eq arm::arm-cond-eq)
     327    (#.arm::arm-cond-ne arm::arm-cond-ne)
     328    (#.arm::arm-cond-lt arm::arm-cond-gt)
     329    (#.arm::arm-cond-le arm::arm-cond-ge)
     330    (#.arm::arm-cond-gt arm::arm-cond-lt)
     331    (#.arm::arm-cond-ge arm::arm-cond-le)))
     332
     333   
    323334   
    324335
     
    864875    (with-arm-local-vinsn-macros (seg)
    865876      (unless *arm2-reckless*
    866         (! check-exact-nargs nargs))
     877        (if (arm::encode-arm-immediate (ash nargs arm::fixnumshift))
     878          (! check-exact-nargs nargs)
     879          (! check-exact-nargs-large nargs)))
    867880      (arm2-argregs-entry seg rev-fixed-args))))
    868881
     
    877890      (unless *arm2-reckless*
    878891        (when rev-req-args
    879           (! check-min-nargs min))
    880         (! check-max-nargs max))
     892          (if (arm::encode-arm-immediate min)
     893            (! check-min-nargs min)
     894            (! check-min-nargs-large min)))
     895        (if (arm::encode-arm-immediate max)
     896          (! check-max-nargs max)
     897          (! check-max-nargs-large max)))
    881898      (if (= nopt 1)
    882899        (! default-1-arg min)
     
    11701187  (if (> n call-arguments-limit)
    11711188    (compiler-bug "~s exceeded." call-arguments-limit)
    1172     (with-arm-local-vinsn-macros (seg)
    1173       (! set-nargs n))))
     1189    (if (< n 256)     
     1190      (with-arm-local-vinsn-macros (seg)
     1191        (! set-nargs n))
     1192      (arm2-lri seg arm::nargs (ash n arm::word-shift)))))
    11741193
    11751194(defun arm2-single-float-bits (the-sf)
     
    23142333           )
    23152334      (when expression-p
    2316                                         ;Have to do this before spread args, since might be vsp-relative.
     2335        ;;Have to do this before spread args, since might be vsp-relative.
    23172336        (if nargs
    23182337          (arm2-do-lexical-reference seg destreg fn)
     
    30813100          (! compare-immediate vreg reg (or jconst iconst))
    30823101          (unless (or jconst (eq cr-bit arm::arm-cond-eq))
    3083             (setq cr-bit (logxor cr-bit 1)))
     3102            (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
    30843103          (^ cr-bit true-p))
    30853104        (if (and (eq cr-bit arm::arm-cond-eq)
     
    49574976               
    49584977                (when rev-fixed
    4959                   (arm2-reserve-vstack-lcells num-fixed)                   
    4960                   (! check-min-nargs num-fixed))
     4978                  (arm2-reserve-vstack-lcells num-fixed)
     4979                  (if (arm::encode-arm-immediate num-fixed)
     4980                    (! check-min-nargs num-fixed)
     4981                    (! check-min-nargs-large num-fixed)))
    49614982                (unless (or rest keys)
    4962                   (! check-max-nargs (+ num-fixed num-opt)))
     4983                  (let* ((max (+ num-fixed num-opt)))
     4984                    (if (arm::encode-arm-immediate max)
     4985                      (! check-max-nargs max)
     4986                      (! check-max-nargs-large max))))
    49634987                (unless lexprp
    49644988                  (! save-lisp-context-variable))
     
    50355059          ;; to worry about.
    50365060
    5037           (when (and (not (or opt rest keys))
     5061          (when (and nil
     5062                     (not (or opt rest keys))
    50385063                     (<= num-fixed $numarmargregs)
    50395064                     (not (some #'null arg-regs)))
     
    79177942      (^)))))
    79187943
    7919 ;;; Outgoing C stack frame will look like:
    7920 ;;;  backptr
    7921 ;;;  NIL  ; marker to keep GC happy, make GDB unhappy.
    7922 ;;;  8 words of GPR arg vals - will be loaded & popped by subprim
    7923 ;;;  N words of "other" (overflow) arguments
    7924 ;;;  F words of single-float values, to be loaded into FPR before subprim call
    7925 ;;;  D aligned doublewords of double-float values, to be loaded into FPR before call.
    79267944(defarm2 arm2-eabi-ff-call eabi-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
    79277945  (declare (ignore monitor))
     
    79297947         (*arm2-top-vstack-lcell* *arm2-top-vstack-lcell*)
    79307948         (*arm2-cstack* *arm2-cstack*)
    7931          (gpr-offset 0)
    7932          (other-offset 8)
    7933          (single-float-offset 8)
    7934          (double-float-offset 8)
    7935          (nsingle-floats 0)              ; F
    7936          (ndouble-floats 0)             ; D
    7937          (nother-words 0)
    7938          (nfpr-args 0)
    7939          (ngpr-args 0)
    7940          (fp-loads ()))
    7941       (declare (fixnum  nsingle-floats ndouble-floats nfpr-args ngpr-args nother-words
    7942                         gpr-offset other-offset single-float-offset double-float-offset))
     7949         (next-arg-word 0))
     7950      (declare (fixnum next-arg-word))
    79437951      (dolist (argspec argspecs)
    79447952        (case argspec
    7945           (:double-float (incf nfpr-args)
    7946                          (if (<= nfpr-args 8)
    7947                            (incf ndouble-floats)
    7948                            (progn
    7949                              (if (oddp nother-words)
    7950                                (incf nother-words))
    7951                              (incf nother-words 2))))
    7952           (:single-float (incf nfpr-args)
    7953                          (if (<= nfpr-args 8)
    7954                            (incf nsingle-floats)
    7955                            (progn
    7956                              (if (oddp nother-words)
    7957                                (incf nother-words))
    7958                              (incf nother-words 2))))
    7959           ((:unsigned-doubleword :signed-doubleword)
    7960            (setq ngpr-args (logior 1 ngpr-args))
    7961            (incf ngpr-args 2)
    7962            (when (> ngpr-args 9)
    7963              (if (oddp nother-words)
    7964                (incf nother-words))
    7965              (incf nother-words 2)))
    7966           (t (incf ngpr-args)
    7967              (if (> ngpr-args 8)
    7968                (incf nother-words)))))
    7969       (let* ((single-words (+ 8 nother-words nsingle-floats))
    7970              (total-words (if (zerop ndouble-floats)
    7971                             single-words
    7972                             (+ (the fixnum (+ ndouble-floats ndouble-floats))
    7973                                (the fixnum (logand (lognot 1) (the fixnum (1+ single-words))))))))
    7974            
    7975         (! alloc-eabi-c-frame total-words))
    7976       (setq single-float-offset (+ other-offset nother-words))
    7977       (setq double-float-offset
    7978             (logand (lognot 1)
    7979                     (the fixnum (1+ (the fixnum (+ single-float-offset nsingle-floats))))))
    7980       (setq ngpr-args 0 nfpr-args 0)
     7953          ((:double-float :unsigned-doubleword :signed-doubleword)
     7954           (when (oddp next-arg-word)
     7955             (incf next-arg-word))
     7956           (incf next-arg-word 2))
     7957          (t (incf next-arg-word))))
     7958      (! alloc-eabi-c-frame next-arg-word)
    79817959      (arm2-open-undo $undo-arm-c-frame)
    79827960      (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg address arm::arg_z))
     
    79857963      ;; Remember type and arg offset of any FP args, since FP regs
    79867964      ;; will have to be loaded later.
     7965      (setq next-arg-word 0)
    79877966      (do* ((specs argspecs (cdr specs))
    79887967            (vals argvals (cdr vals)))
     
    79957974            (:double-float
    79967975             (let* ((df ($ arm::d0 :class :fpr :mode :double-float)))
    7997                (incf nfpr-args)
    7998                (arm2-one-targeted-reg-form seg valform df )
    7999                (cond ((<= nfpr-args 8)
    8000                       (! set-double-eabi-c-arg df double-float-offset)
    8001                       (push (cons :double-float double-float-offset) fp-loads)
    8002                       (incf double-float-offset 2))
    8003                      (t
    8004                       (setq other-offset (logand (lognot 1) (the fixnum (1+ other-offset))))
    8005                       (! set-double-eabi-c-arg df other-offset)
    8006                       (incf other-offset 2)))))
     7976               (when (oddp next-arg-word)
     7977                 (incf next-arg-word))
     7978               (! set-double-eabi-c-arg df next-arg-word)
     7979               (incf next-arg-word 2)))
    80077980            (:single-float
    80087981             (let* ((sf ($ arm::s0 :class :fpr :mode :single-float)))
    8009                (incf nfpr-args)
    8010                (arm2-one-targeted-reg-form
    8011                 seg valform sf)
    8012                (cond ((<= nfpr-args 8)
    8013                       (! set-single-eabi-c-arg sf single-float-offset)
    8014                       (push (cons :single-float single-float-offset) fp-loads)
    8015                       (incf single-float-offset))
    8016                      (t
    8017                       (setq other-offset (logand (lognot 1) (the fixnum (1+ other-offset))))
    8018                       (! set-double-eabi-c-arg sf other-offset)
    8019                       (incf other-offset 2)))))
     7982               (arm2-one-targeted-reg-form seg valform sf)
     7983               (! set-single-eabi-c-arg sf next-arg-word)
     7984               (incf next-arg-word)))
    80207985            ((:signed-doubleword :unsigned-doubleword)
    80217986             (arm2-one-targeted-reg-form seg valform ($ arm::arg_z))
     
    80237988               (! gets64)
    80247989               (! getu64))
    8025              (if (oddp ngpr-args)
    8026                (incf ngpr-args))
    8027              (incf ngpr-args 2)
    8028              (if (oddp gpr-offset)
    8029                (incf gpr-offset))
    8030              (cond ((<= ngpr-args 8)
    8031                     (! set-eabi-c-arg ($ arm::imm0) gpr-offset)
    8032                     (incf gpr-offset)
    8033                     (! set-eabi-c-arg ($ arm::imm1) gpr-offset)
    8034                     (incf gpr-offset))
    8035                    (t
    8036                     (if (oddp other-offset)
    8037                       (incf other-offset))
    8038                     (! set-eabi-c-arg ($ arm::imm0) other-offset)
    8039                     (incf other-offset)
    8040                     (! set-eabi-c-arg ($ arm::imm1) other-offset)
    8041                     (incf other-offset))))
     7990             (when (oddp next-arg-word)
     7991               (incf next-arg-word))
     7992             (! set-eabi-c-arg ($ arm::imm0) next-arg-word)
     7993             (incf next-arg-word)
     7994             (! set-eabi-c-arg ($ arm::imm1) next-arg-word)
     7995             (incf next-arg-word))
    80427996            (:address
    80437997             (with-imm-target () (ptr :address)
     
    80457999                 (arm2-lri seg ptr absptr)
    80468000                 (arm2-form seg ptr nil valform))
    8047                (incf ngpr-args)
    8048                (cond ((<= ngpr-args 8)
    8049                       (! set-eabi-c-arg ptr gpr-offset)
    8050                       (incf gpr-offset))
    8051                      (t
    8052                       (! set-eabi-c-arg ptr other-offset)
    8053                       (incf other-offset)))))
     8001               (! set-eabi-c-arg ptr next-arg-word)
     8002               (incf next-arg-word)))
    80548003            (t
    80558004             (with-imm-target () (valreg :natural)
    80568005                (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec)))
    8057                   (incf ngpr-args)
    8058                   (cond ((<= ngpr-args 8)
    8059                          (! set-eabi-c-arg reg gpr-offset)
    8060                          (incf gpr-offset))
    8061                         (t
    8062                          (! set-eabi-c-arg reg other-offset)
    8063                          (incf other-offset)))))))))
     8006                  (! set-eabi-c-arg reg next-arg-word)
     8007                  (incf next-arg-word)))))))
    80648008      #+hard-float
    80658009      (do* ((fpreg arm::fp1 (1+ fpreg))
     
    80798023        (cond ((eq resultspec :void) (<- nil))
    80808024              ((eq resultspec :double-float)
     8025               (! gpr-pair-to-double-float arm::d0 arm::imm0 arm::imm1)
    80818026               (<- ($  arm::d0 :class :fpr :mode :double-float)))
    80828027              ((eq resultspec :single-float)
     8028               (! gpr-to-single-float arm::s0 arm::imm0)
    80838029               (<- ($ arm::s0 :class :fpr :mode :single-float)))
    80848030              ((eq resultspec :unsigned-doubleword)
  • branches/arm/level-0/ARM/arm-bignum.lisp

    r13837 r13889  
    182182
    183183;; multiply i'th digit of x by y and add to result starting at digit i
    184 #+notyet
     184
    185185(defarmlapfunction %multiply-and-add-harder-loop-2
    186186    ((x-ptr 4) (y-ptr 0) (resptr arg_x)(residx arg_y) (count arg_z)) 
    187   (let ((tem imm0)
     187  (let ((x imm0)
    188188        (y imm1)
    189189        (prod-h imm2)
    190         (prod-l imm3)
    191         (x imm4)
     190        (prod-l rcontext)
    192191        (xptr temp2)
    193192        (yidx temp1)
    194193        (yptr temp0))
    195     (ldr xptr vsp (:$ x-ptr))
    196     (add tem residx (:$ arm::misc-data-offset))
    197     (ldr x (:@ xptr tem))
    198     (ldr yptr vsp (:$ y-ptr))
    199     (li yidx 0) ; init yidx 0
    200     (addc prod-h rzero rzero) ; init carry 0, mumble 0
    201     @loop
    202     (subi count count '1)
    203     (cmpwi count 0)
    204     (add tem yidx (:$ arm::misc-data-offset))   ; get yidx
    205     (ldr y (:@ yptr tem))
    206     (mullw prod-l x y)
    207     (addc prod-l prod-l prod-h)
    208     (mulhwu prod-h x y)
    209     (addze prod-h prod-h)
    210     (add tem residx (:$ arm::misc-data-offset))
    211     (ldr y (:@ resptr tem))   
    212     (addc prod-l prod-l y)
    213     (addze prod-h prod-h)
    214     (str prod-l (:@ resptr tem))   
    215     (addi residx residx '1)
    216     (addi yidx yidx '1)
     194    (ldr xptr (:@ vsp (:$ x-ptr)))
     195    (mov residx (:lsl residx (:$ 2)))
     196    (add residx residx (:$ (ash arm::misc-data-offset 2)))
     197    (ldr x (:@ xptr (:asr residx (:$ 2))))
     198    (ldr yptr (:@ vsp (:$ y-ptr)))
     199    (vpush1 rcontext)
     200    (mov yidx (:$ (ash arm::misc-data-offset 2))) ; init yidx 0
     201    (movs prod-h (:$ 0)) ; init carry 0, mumble 0
     202    @loop
     203    (ldr y (:@ yptr (:asr yidx (:$ 2))))
     204    (mul prod-l x y)
     205    (adds prod-l prod-l prod-h)
     206    (umull x prod-h x y)
     207    (adc prod-h prod-h (:$ 0))
     208    (ldr y (:@ resptr (:asr residx (:$ 2))))
     209    (adds prod-l prod-l y)
     210    (adc prod-h prod-h (:$ 0))
     211    (subs count count '1)
     212    (str prod-l (:@ resptr (:asr residx (:$ 2))))   
     213    (add residx residx '4)              ;sic
     214    (add yidx yidx '4)                  ;even sicer
    217215    (bgt @loop)
    218     (add tem residx (:$ arm::misc-data-offset))
    219     (str prod-h (:@ resptr tem))
     216    (str prod-h (:@ resptr (:asr residx (:$ 2))))
     217    (vpop1 rcontext)
    220218    (add vsp vsp (:$ 8))     
    221219    (bx lr)))
     
    228226;;; CARRY[0].
    229227
    230 #+notyet
    231228(defarmlapfunction %multiply-and-add ((r 4) (carry 0) (x arg_y) (i arg_x) (y arg_z))
    232229  (unbox-fixnum imm0 arg_z)
    233230  (add imm1 i (:$ arm::misc-data-offset))
    234231  (ldr imm1 (:@ x imm1))
    235   (mulhwu imm2 imm0 imm1)
    236   (mullw imm1 imm0 imm1)
    237   (ldr temp0 vsp (:$ carry))
    238   (ldr imm0 temp0 (:$ arm::misc-data-offset))
    239   (addc imm1 imm1 imm0)
    240   (addze imm2 imm2)
    241   (str imm2 temp0  (:$ arm::misc-data-offset))
    242   (ldr arg_z vsp (:$ r))
     232  (umull imm1 imm2 imm0 imm1)
     233  (ldr temp0 (:@ vsp (:$ carry)))
     234  (ldr imm0 (:@ temp0 (:$ arm::misc-data-offset)))
     235  (adds imm1 imm1 imm0)
     236  (adc imm2 imm2 (:$ 0))
     237  (str imm2 (:@ temp0  (:$ arm::misc-data-offset)))
     238  (ldr arg_z (:@ vsp (:$ r)))
    243239  (add vsp vsp (:$ 8))   
    244   (str imm1 arg_z  (:$ arm::misc-data-offset))
     240  (str imm1 (:@ arg_z  (:$ arm::misc-data-offset)))
    245241  (bx lr))
    246242 
     
    747743    (str imm0 (:@ dest scaled-index))
    748744    (bx lr)))
     745
     746(defarmlapfunction macptr->fixnum ((ptr arg_z))
     747  (macptr-ptr arg_z ptr)
     748  (bx lr))
    749749
    750750; if dest not nil store unboxed result in dest(0), else return boxed result
     
    11551155   
    11561156   
    1157 
     1157(defarmlapfunction bignum-negate-loop-really ((big arg_x) (len arg_y) (result arg_z))
     1158  (let ((idx imm0)
     1159        (x imm1)
     1160        (carry imm2))
     1161    (mov idx (:$ arm::misc-data-offset))
     1162    ;; initialize carry 1
     1163    (mov carry (:$ 1))
     1164    @loop       
     1165    (ldr x (:@ big idx))
     1166    (mvn x x)
     1167    (adds x x carry)
     1168    (str x (:@ result idx))
     1169    (movcc carry (:$ 0))
     1170    (movcs carry (:$ 1))
     1171    (subs len len '1)
     1172    (add idx idx '1)
     1173    (bgt @loop)
     1174    ; return carry
     1175    (box-fixnum arg_z carry)
     1176    (bx lr)))
     1177
     1178(defarmlapfunction bignum-shift-left-loop ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (j arg_z))
     1179  (let ((y imm0)
     1180        (x imm1)
     1181        (shift imm2)       
     1182        (i temp0)
     1183        (resptr temp2))
     1184    (vpop1 resptr)
     1185    (mov i (:$ (ash arm::misc-data-offset 2)))
     1186    (vpop1 shift)
     1187    (ldr x (:@ bignum (:$ arm::misc-data-offset)))
     1188    (unbox-fixnum shift shift)
     1189    (mov x (:lsl x shift))
     1190    (add y j (:$ (+ arm::misc-data-offset -4)))
     1191    (str x (:@ resptr y))
     1192    (cmp len j)
     1193    (beq @done)
     1194    @loop
     1195    (ldr x (:@ bignum (:asr i (:$ 2))))
     1196    (rsb shift shift (:$ 32))
     1197    (mov x (:asr x shift))
     1198    (add i i '4)                    ;sic
     1199    (ldr y (:@ bignum (:asr i (:$ 2))))
     1200    (rsb shift shift (:$ 32))
     1201    (orr y x (:lsl y shift))
     1202    (add x j (:$ arm::misc-data-offset))
     1203    (str y (:@ resptr x))
     1204    (add j j '1)   
     1205    (cmp j len)
     1206    (add i i '4)
     1207    (blt @loop)   
     1208    @done
     1209    ; do first - lo order
     1210       
     1211    ; do last - hi order   
     1212    ;(dbg t)
     1213    (ldr y (:@ bignum (:asr i (:$ 2))))
     1214    (mov y (:asr y shift))
     1215    (add x len (:$ arm::misc-data-offset))
     1216    (str y (:@ resptr x))   
     1217    (bx lr)))
    11581218
    11591219; End of arm-bignum.lisp
  • branches/arm/level-0/ARM/arm-float.lisp

    r13846 r13889  
    293293  (bx lr))
    294294
     295(defarmlapfunction %ffi-exception-status ()
     296  (mov arg_z (:$ 0))                    ;for now
     297  (bx lr))
     298
     299(defun %sf-check-exception-1 (operation op0 fp-status)
     300  (declare (ignore operation op0 fp-status)))
     301
    295302
    296303
     
    334341
    335342
    336 (defarmlapfunction %ffi-exception-status ()
    337   (ldr imm0  arm::tcr.ffi-exception arm::rcontext)
    338   (mtcrf #xfc imm0)
    339   (mcrfs :cr6 :cr6)
    340   (mcrfs :cr7 :cr7)
    341   (crand ppc::fpscr-fex-bit ppc::fpscr-oe-bit ppc::fpscr-ox-bit)
    342   (bt ppc::fpscr-fex-bit @set)
    343   (crand ppc::fpscr-fex-bit ppc::fpscr-ve-bit ppc::fpscr-vx-bit)
    344   (bt ppc::fpscr-fex-bit @set)
    345   (crand ppc::fpscr-fex-bit ppc::fpscr-ue-bit ppc::fpscr-ux-bit)
    346   (bt ppc::fpscr-fex-bit @set)
    347   (crand ppc::fpscr-fex-bit ppc::fpscr-ze-bit ppc::fpscr-zx-bit)
    348   (bt ppc::fpscr-fex-bit @set)
    349   (crand ppc::fpscr-fex-bit ppc::fpscr-xe-bit ppc::fpscr-xx-bit)
    350   (bf ppc::fpscr-fex-bit @ret)
    351   @set
    352   (oris imm0 imm0 #xc000)
    353   @ret
    354   (srwi arg_z imm0 (- 8 arm::fixnumshift))
    355   (bx lr))
     343
    356344 
    357345
  • branches/arm/level-0/ARM/arm-misc.lisp

    r13838 r13889  
    396396;;; (It's incremented if it's currently negative, incremented otherwise.)
    397397;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
    398 #+notyet                                ;Needs ARM subprim ?
    399398(defarmlapfunction %unlock-gc-lock ()
    400 ;;  (sync)
    401   (li imm0 (+ (target-nil-value) (arm::kernel-global gc-inhibit-count)))
    402   @again
    403   (lrarx arg_y rzero imm0)
    404   (cmpri cr1 arg_y -1)
    405   (subi arg_z arg_y '1)
    406   (bgt cr1 @store)
    407   (addi arg_z arg_y '1)
    408   @store
    409   (strcx. arg_z rzero imm0)
     399  (mov imm0 (:$ (- arm::nil-value arm::fulltag-nil)))
     400  (add imm1 imm0 (:$ (arm::kernel-global gc-inhibit-count)))
     401  @again
     402  (mov arg_x ($ 0))
     403  (ldrex arg_y (:@ imm1))
     404  (cmp arg_y (:$ -1))
     405  (moveq arg_x arg_y)
     406  (cmp arg_y (:$ 0))
     407  (sub arg_z arg_y (:$ 1))
     408  (addlt arg_z arg_y '1)
     409  (strex imm0 arg_z (:@ imm1))
     410  (cmp imm0 ($ 0))
    410411  (bne @again)
    411   (bnelr cr1)
    412   ;; The GC tried to run while it was inhibited.  Unless something else
    413   ;; has just inhibited it, it should be possible to GC now.
    414   (li imm0 arch::gc-trap-function-immediate-gc)
    415   (trlgei allocptr 0)
     412  (cmp arg_x (:$ 0))
     413  (bxeq lr)
     414  (mov imm0 (:$ arch::gc-trap-function-immediate-gc))
     415  (uuo-gc-trap (:? al))
    416416  (bx lr))
    417417
     
    702702  (bx lr))
    703703
     704(defun get-saved-register-values ()
     705  (values))
    704706
    705707(defarmlapfunction %current-db-link ()
  • branches/arm/level-0/ARM/arm-numbers.lisp

    r13857 r13889  
    140140;;; maybe this could be smarter but frankly scarlett I dont give a damn
    141141;;; ticket:666 describes one reason to give a damn.
    142 #+notyet
    143142(defarmlapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
    144143  (let ((unboxed-quotient imm0)
    145         (unboxed-dividend imm1)
    146         (unboxed-divisor imm2)
    147         (unboxed-product imm3)
    148         (product temp0)
    149         (boxed-quotient temp1)
    150         (remainder temp2))
    151     (cmpwi divisor '-1)   
     144        (unboxed-dividend imm0)
     145        (unboxed-divisor imm1)
     146        (unboxed-remainder imm1)
     147        (quotient arg_y)
     148        (remainder arg_z))
     149    (build-lisp-frame)
     150    (cmp divisor '-1)   
    152151    (unbox-fixnum unboxed-dividend dividend)
    153152    (unbox-fixnum unboxed-divisor divisor)
    154153    (beq @neg)
    155     (divwo. unboxed-quotient unboxed-dividend unboxed-divisor)          ; set OV if divisor = 0
    156     (box-fixnum boxed-quotient unboxed-quotient)
    157     (mullw unboxed-product unboxed-quotient unboxed-divisor)
    158     (bns+ @ok)
    159     (mtxer rzero)
    160     (save-lisp-context)
    161     (set-nargs 3)
    162     (load-constant arg_x truncate)
    163     (call-symbol divide-by-zero-error)
    164     @not-0
    165     @ok
    166     (subf imm0 unboxed-product unboxed-dividend)
    167     (vpush boxed-quotient)
    168     (box-fixnum remainder imm0)
    169     (vpush remainder)
     154    (bl .SPsdiv32)
     155    (box-fixnum quotient unboxed-quotient)
     156    (box-fixnum remainder unboxed-remainder)
     157    (stmdb (:! vsp) (quotient remainder))
    170158    (set-nargs 2)
    171     (la temp0 8 vsp)
    172     (ba .SPvalues)
     159    (ba .SPnvalret)
    173160    @neg
    174     (nego. dividend dividend)
    175     (lwz arg_z '*least-positive-bignum* nfn)
    176     (bns @ret)
    177     (mtxer rzero)
    178     (lwz dividend arm32::symbol.vcell arg_z)
     161    (ldr arg_z (:@ fn '*least-positive-bignum*))
     162    (rsbs dividend dividend (:$ 0))
     163    (ldrvs dividend (:@ arg_z (:$ arm::symbol.vcell)))
    179164    @ret
    180     (mr temp0 vsp)
    181     (vpush dividend)
    182     (vpush rzero)
     165    (mov temp0 (:$ 0))
     166    (vpush1 dividend)
     167    (vpush1 temp0)
    183168    (set-nargs 2)
    184     (ba .SPvalues)))
     169    (ba .SPnvalret)))
    185170
    186171
  • branches/arm/level-0/ARM/arm-pred.lisp

    r13858 r13889  
    172172  (bgt @same)
    173173  (ldr fname (:@ nfn 'eql))
    174   (ldr nfn (:@ fname (:$ arm::symbol.vcell)))
     174  (ldr nfn (:@ fname (:$ arm::symbol.fcell)))
    175175  (ldr pc (:@ nfn (:$ arm::function.entrypoint)))
    176176  @same
  • branches/arm/level-0/l0-bignum32.lisp

    r13067 r13889  
    690690               (if (and (>= len-a 16)
    691691                        (>= len-b 16)
    692                         #+x8632-target
     692                        #+(or x8632-target arm-target)
    693693                        nil)
    694694                 (let* ((ubytes (* len-a 4))
  • branches/arm/level-1/arm-callback-support.lisp

    r13777 r13889  
    1616
    1717(in-package "CCL")
     18
     19(defun make-callback-trampoline (index &optional info)
     20  (declare (ignore info))
     21  (let* ((p (%allocate-callback-pointer 12)))
     22    (macrolet ((arm-lap-word (instruction-form)
     23                 (uvref (uvref (compile nil `(lambda (&lap 0) (arm-lap-function () ((?? 0)) ,instruction-form))) 1) 0)))
     24      (setf (%get-unsigned-long p 0)
     25            (dpb (ldb (byte 8 0) index)
     26                 (byte 8 0)
     27                 (arm-lap-word (mov r12 (:$ 0))))
     28            (%get-unsigned-byte p 4)
     29            (dpb (ldb (byte 8 8) index)
     30                 (byte 8 0)
     31                 (arm-lap-word (orr r12 r12 (:$ #xff00))))
     32            (%get-unsigned-long p 8)
     33            (arm-lap-word (ba .SPeabi-callback)))
     34            (ff-call (%kernel-import #.arm::kernel-import-makedataexecutable)
     35               :address p
     36               :unsigned-fullword 12
     37               :void)
     38      p)))
     39                   
  • branches/arm/level-1/arm-error-signal.lisp

    r13777 r13889  
    1616
    1717(in-package "CCL")
     18
     19(defcallback %xerr-disp ()
     20  )
  • branches/arm/level-1/arm-threads-utils.lisp

    r13777 r13889  
    1616
    1717(in-package "CCL")
     18
     19(defun %frame-backlink (p &optional context)
     20  (cond ((fake-stack-frame-p p)
     21         (%fake-stack-frame.next-sp p))
     22        ((fixnump p)
     23         (let ((backlink (%%frame-backlink p))
     24               (fake-frame
     25                (if context (bt.fake-frames context) *fake-stack-frames*)))
     26           (loop
     27             (when (null fake-frame) (return backlink))
     28             (when (eq backlink (%fake-stack-frame.sp fake-frame))
     29               (return fake-frame))
     30             (setq fake-frame (%fake-stack-frame.link fake-frame)))))
     31        (t (error "~s is not a valid stack frame" p))))
     32
     33
     34
     35
     36(defun catch-frame-sp (catch)
     37  (declare (ignorable catch))
     38  )
     39
     40(defun bottom-of-stack-p (p context)
     41  (and (fixnump p)
     42       (locally (declare (fixnum p))
     43         (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
     44                (cs-area (%fixnum-ref tcr target::tcr.cs-area)))
     45           (not (%ptr-in-area-p p cs-area))))))
     46
     47(defun lisp-frame-p (p context)
     48  (or (fake-stack-frame-p p)
     49      (locally (declare (fixnum p))
     50        (let ((next-frame (%frame-backlink p context)))
     51          (when (fake-stack-frame-p next-frame)
     52            (setq next-frame (%fake-stack-frame.sp next-frame)))
     53          (locally (declare (fixnum next-frame))
     54            (if (bottom-of-stack-p next-frame context)
     55              (values nil t)
     56              (and
     57               (eql (ash target::lisp-frame.size (- target::fixnum-shift))
     58                    (the fixnum (- next-frame p)))
     59               ;; EABI C functions keep their saved LRs where we save FN or 0
     60               ;; The saved LR of such a function would be fixnum-tagged and never 0.
     61               (let* ((fn (%fixnum-ref p target::lisp-frame.savefn)))
     62                 (or (eql fn 0) (typep fn 'function))))))))))
     63
     64
     65
     66
     67
     68(defun valid-subtag-p (subtag)
     69  (declare (fixnum subtag))
     70  (let* ((tagval (ldb (byte (- arm::num-subtag-bits arm::ntagbits) arm::ntagbits) subtag)))
     71    (declare (fixnum tagval))
     72    (case (logand subtag arm::fulltagmask)
     73      (#. arm::fulltag-immheader (not (eq (%svref *immheader-types* tagval) 'bogus)))
     74      (#. arm::fulltag-nodeheader (not (eq (%svref *nodeheader-types* tagval) 'bogus)))
     75      (t nil))))
     76
     77
     78
     79(defun valid-header-p (thing)
     80  (let* ((fulltag (fulltag thing)))
     81    (declare (fixnum fulltag))
     82    (case fulltag
     83      (#.arm::fulltag-misc (valid-subtag-p (typecode thing)))
     84      ((#.arm::fulltag-immheader #.arm::fulltag-nodeheader) nil)
     85      (t t))))
     86
     87
     88
     89
     90
     91
     92(defun bogus-thing-p (x)
     93  (when x
     94    #+cross-compiling (return-from bogus-thing-p nil)
     95    (or (not (valid-header-p x))
     96        (let ((tag (lisptag x)))
     97          (unless (or (eql tag arm::tag-fixnum)
     98                      (eql tag arm::tag-imm)
     99                      (in-any-consing-area-p x))
     100            ;; This is terribly complicated, should probably write some LAP
     101            (let ((typecode (typecode x)))
     102                  (not (or (case typecode
     103                             (#.arm::tag-list
     104                              (temporary-cons-p x))
     105                             ((#.arm::subtag-symbol #.arm::subtag-code-vector)
     106                              t)              ; no stack-consed symbols or code vectors
     107                             (#.arm::subtag-value-cell
     108                              (on-any-vstack x))
     109                             (t
     110                              (on-any-tsp-stack x)))
     111                           (%heap-ivector-p x)))))))))
     112
     113
     114
     115
     116
  • branches/arm/level-1/arm-trap-support.lisp

    r13777 r13889  
    1616
    1717(in-package "CCL")
     18
     19(defcallback xcmain ()
     20  )
  • branches/arm/level-1/l1-clos-boot.lisp

    r13865 r13889  
    36283628
    36293629(defmethod no-applicable-method (gf &rest args)
    3630   #+arm-target (dbg (cons gf args))
    36313630  (cerror "Try calling it again"
    36323631          "There is no applicable method for the generic function:~%  ~s~%when called with arguments:~%  ~s" gf args)
  • branches/arm/level-1/l1-lisp-threads.lisp

    r13081 r13889  
    196196  (let* ((cs-area (%fixnum-ref tcr target::tcr.cs-area))
    197197         (vs-area (%fixnum-ref tcr target::tcr.vs-area))
     198         #-arm-target
    198199         (ts-area (%fixnum-ref tcr target::tcr.ts-area)))
    199200    (when (or (zerop cs-area)
    200201              (zerop vs-area)
     202              #-arm-target
    201203              (zerop ts-area))
    202204      (error "Can't allocate new thread"))
     
    207209          (%stack-area-usable-size vs-area)
    208210          (lisp-thread.ts-size thread)
     211          #+arm-target 0
     212          #-arm-target
    209213          (%stack-area-usable-size ts-area)
    210214          (lisp-thread.startup-function thread)
  • branches/arm/level-1/l1-streams.lisp

    r13499 r13889  
    243243                         (ash 1 x8664::fulltag-immheader-1)
    244244                         (ash 1 x8664::fulltag-immheader-2)))
     245        #+arm-target
     246        (= (logand subtag arm::fulltagmask)
     247           arm::fulltag-immheader)
    245248      (error "~s is not an ivector subtype." element-type))
    246249    (let* ((size-in-octets (ccl::subtag-bytes subtag element-count)))
  • branches/arm/lisp-kernel/arm-macros.s

    r13844 r13889  
    316316        new_macro_labels()
    317317        __(build_lisp_frame(imm0))
    318         __(movc16(imm0,make_header(catch_frame.element_count,subtag_u32_vector)))
     318        __(movc16(imm0,make_header(catch_frame.element_count,subtag_catch_frame)))
    319319        __(movs temp2,fn)
    320320        __(ldrne temp2,[temp2,_function.codevector])
  • branches/arm/lisp-kernel/arm-spentry.s

    r13865 r13889  
    576576               
    577577 _spentry(throw)
    578         __(ldr imm1,[rcontext, #tcr.catch_top])
     578        __(ldr temp0,[rcontext, #tcr.catch_top])
    579579        __(mov imm0,#0) /* count intervening catch/unwind-protect frames.  */
    580         __(cmp imm1,#0)
    581         __(ldr temp0,[vsp,nargs])
     580        __(cmp temp0,#0)
     581        __(ldr temp2,[vsp,nargs])
    582582        __(beq local_label(_throw_tag_not_found))
    583583local_label(_throw_loop):
    584         __(ldr temp1,[imm1,#catch_frame.catch_tag])
    585         __(cmp temp0,temp1)
    586         __(mov imm2,imm1)
    587         __(ldr imm1,[imm1,#catch_frame.link])
     584        __(ldr temp1,[temp0,#catch_frame.catch_tag])
     585        __(cmp temp2,temp1)
     586        __(ldrne temp0,[temp0,#catch_frame.link])
    588587        __(beq C(_throw_found))
    589         __(cmp imm1,#0)
     588        __(cmp temp0,#0)
    590589        __(add imm0,imm0,#fixnum_one)
    591590        __(bne local_label(_throw_loop))
    592591local_label(_throw_tag_not_found):
    593         __(uuo_error_no_throw_tag(al,temp0))
    594         __(str temp0,[vsp,nargs])
     592        __(uuo_error_no_throw_tag(al,temp2))
     593        __(str temp2,[vsp,nargs])
    595594        __(b _SPthrow)
    596595
     
    13301329        __(mov imm1,imm1,lsl #num_subtag_bits-fixnumshift)
    13311330        __(orr imm1,imm1,#subtag_u32_vector)
    1332         __(cmp imm1,#stack_alloc_limit)
     1331        __(cmp imm0,#stack_alloc_limit)
    13331332        __(bge 3f)
    13341333        __(stack_allocate_zeroed_ivector(imm1,imm0))
     
    13531352        __(bx lr)
    135413533:
    1355         __(movc16(imm0,make_header(1,subtag_u32_vector)))
    1356         __(mov imm1,#0)
    1357         __(stmdb sp!,{imm0,imm1})
     1354        __(mov arg_z,#stack_alloc_marker)
     1355        __(mov arg_y,sp)
     1356        __(stmdb sp!,{arg_z,arg_y})
    13581357        __(b _SPheap_cons_rest_arg)
    13591358
     
    16801679        __(mov imm1,imm1,lsl #num_subtag_bits)
    16811680        __(orr imm1,imm1,#subtag_u8_vector)
    1682         __(stack_allocate_ivector(imm1,imm0))
     1681        __(stack_allocate_zeroed_ivector(imm1,imm0))
    16831682        __(add temp1,sp,#dnode_size)
    16841683        __(movc16(imm1,make_header(macptr.element_count,subtag_macptr)))
     
    30323031        __(b _SPksignalerr)
    30333032       
    3034 
     3033_spentry(eabi_callback)
     3034        __(uuo_debug_trap(al))
     3035        __(uuo_debug_trap(al))
     3036       
    30353037/*  EOF, basically  */
    30363038       
     
    38403842
    38413843       
    3842 /* imm2: (tstack-consed) target catch frame, imm0: count of intervening  */
     3844/* temp0: (stack-consed) target catch frame, imm0: count of intervening  */
    38433845/* frames. If target isn't a multiple-value receiver, discard extra values */
    38443846/* (less hair, maybe.)  */
    3845 C(_throw_found):
    3846 pushdef(`__',`
    3847         .word 0
    3848         ')       
    3849         __(ldr imm1,[imm2,#catch_frame.mvflag])
    3850         __(cmpri(imm1,0))
    3851         __(cmpri(cr1,nargs,0))
     3847_exportfn(C(_throw_found))
     3848        new_local_labels()
     3849        __(ldr imm1,[temp0,#catch_frame.mvflag])
     3850        __(cmp imm1,#0)
    38523851        __(mov fn,#0)
    38533852        __(add imm1,vsp,nargs)
    3854         __(add imm1,[imm1,#-node_size])
    3855         __(bne local_label(_throw_all_values))
     3853        __(add imm1,imm1,#-node_size)
     3854        __(bne local_label(throw_all_values))
     3855        __(cmp nargs,#0)
     3856        __(moveq imm1,#nil_value)
    38563857        __(set_nargs(1))
    3857         __(beq cr1,local_label(_throw_default_1_val))
     3858        __(streq imm1,[vsp,#-node_size]!)
     3859        __(movne vsp,imm1)
     3860local_label(throw_all_values): 
     3861        __(bl _SPnthrowvalues)
     3862        __(ldr temp0,[rcontext,#tcr.catch_top])
     3863        __(ldr imm1,[rcontext,#tcr.db_link])
     3864        __(ldr imm0,[temp0,#catch_frame.db_link])
     3865        __(cmp imm0,imm1)
     3866        __(blne _SPunbind_to)
     3867        __(ldr temp1,[temp0,#catch_frame.mvflag])
     3868        __(ldr imm0,[temp0,#catch_frame.xframe])       
     3869        __(ldr imm1,[temp0,#catch_frame.last_lisp_frame])
     3870        __(cmp temp1,#0)
     3871        __(str imm0,[rcontext,#tcr.xframe])
     3872        __(str imm1,[rcontext,#tcr.last_lisp_frame])
     3873        __(add imm0,vsp,nargs)
     3874        __(sub sp,temp0,#fulltag_misc)
     3875        __(ldr imm1,[sp,#catch_frame.size+lisp_frame.savevsp])
     3876        __(ldreq arg_z,[imm0,#-node_size])
     3877        __(beq local_label(throw_pushed_values))
     3878        __(movs arg_x,nargs)
     3879        __(b local_label(throw_push_test))
     3880local_label(throw_push_loop):
     3881        __(subs arg_x,arg_x,#fixnumone)
     3882        __(ldr arg_y,[imm0,#-node_size]!)
     3883        __(push1(arg_y,imm1))
     3884local_label(throw_push_test):   
     3885        __(bne local_label(throw_push_loop))
     3886local_label(throw_pushed_values):
    38583887        __(mov vsp,imm1)
    3859         __(b local_label(_throw_all_values))
    3860 local_label(_throw_default_1_val):
    3861         __(mov imm4,#nil_value)
    3862         __(vpush1(imm4))
    3863 local_label(_throw_all_values):
    3864         __(bl _SPnthrowvalues)
    3865         __(ldr imm3,[rcontext,#tcr.catch_top])
    3866         __(ldr imm1,[rcontext,#tcr.db_link])
    3867         __(ldr imm0,[imm3,#catch_frame.db_link])
    3868         __(ldr imm4,[imm3,#catch_frame.mvflag])
    3869         __(cmpr(imm0,imm1))
    3870         __(cmpri(cr1,imm4,0))
    3871         __(add tsp,[imm3,#-((tsp_frame.fixed_overhead+fulltag_misc))])
    3872         __(beq local_label(_throw_dont_unbind))
    3873         __(bl _SPunbind_to)
    3874 local_label(_throw_dont_unbind):
    3875         __(add imm0,vsp,nargs)
    3876         __(cmpri(nargs,0))
    3877         __(ldr imm1,[imm3,#catch_frame.csp])
    3878         __(ldr imm1,[imm1,#lisp_frame.savevsp])
    3879         __(bne cr1,local_label(_throw_multiple))
    3880         /* Catcher expects single value in arg_z  */
    3881         __(ldr arg_z,[imm0,#-node_size])
    3882         __(b local_label(_throw_pushed_values))
    3883 local_label(_throw_multiple):
    3884         __(beq local_label(_throw_pushed_values))
    3885         __(mov imm2,nargs)
    3886 local_label(_throw_mvloop):
    3887         __(sub imm2,imm2,fixnum_one)
    3888         __(cmpri(imm2,0))
    3889         __(ldru(temp0,-node_size(imm0)))
    3890         __(push(temp0,imm1))
    3891         __(bgt local_label(_throw_mvloop))
    3892 local_label(_throw_pushed_values):
    3893         __(mov vsp,imm1)
    3894         __(ldr imm1,[imm3,#catch_frame.xframe])
    3895         __(str(imm1,tcr.xframe(rcontext)))
    3896         __(ldr sp,[imm3,#catch_frame.csp])
    3897         __(ldr fn,[sp,#lisp_frame.savefn])
    3898         __(ldr loc_pc,[sp,#lisp_frame.savelr])
    3899         __(discard_lisp_frame())
    3900         __(mtlr loc_pc)
    3901         __(restore_catch_nvrs(imm3))
    3902         __(ldr imm3,[imm3,#catch_frame.link])
    3903         __(str(imm3,tcr.catch_top(rcontext)))
    3904         __(unlink(tsp))
    3905         __(bx lr)
    3906 popdef(`__')
     3888        __(ldr imm0,[temp0,#catch_frame.link])
     3889        __(str imm0,[rcontext,#tcr.catch_top])
     3890        __(ldr fn,[sp,#catch_frame.size+lisp_frame.savefn])
     3891        __(ldr lr,[sp,#catch_frame.size+lisp_frame.savelr])
     3892        __(add sp,sp,#catch_frame.size+lisp_frame.size)
     3893        __(bx lr)
     3894_endfn(C(_throw_found))       
    39073895
    39083896_exportfn(C(nthrow1v))
Note: See TracChangeset for help on using the changeset viewer.