Ignore:
Timestamp:
Jun 30, 2010, 5:41:03 PM (10 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.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.