Changeset 15339


Ignore:
Timestamp:
Apr 21, 2012, 11:07:02 AM (8 years ago)
Author:
gb
Message:

ARM-HARD-FLOAT-P.

Make #'%FF-CALL handle hard-float ABI.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/ARM/arm-def.lisp

    r15093 r15339  
    328328           (nargs (ash (the fixnum (1- len)) -1)))
    329329      (declare (fixnum nargs))
     330      (if (and (arm-hard-float-p)
     331               (or (eq result-spec :double-float)
     332                   (eq result-spec :single-float)
     333                   (let* ((specs specs-and-vals))
     334                     (dotimes (i nargs)
     335                       (let* ((spec (car specs)))
     336                         (when (or (eq spec :double-float)
     337                                   (eq spec :single-float))
     338                           (return t)))))))
     339        (%ff-call-hard-float entry specs-and-vals)
     340               
     341        (ecase result-spec
     342          ((:address :unsigned-doubleword :signed-doubleword
     343                     :single-float :double-float
     344                     :signed-fullword :unsigned-fullword
     345                     :signed-halfword :unsigned-halfword
     346                     :signed-byte :unsigned-byte
     347                     :void)
     348           (do* ((i 0 (1+ i))
     349                 (specs specs-and-vals (cddr specs))
     350                 (spec (car specs) (car specs)))
     351                ((= i nargs))
     352             (declare (fixnum i))
     353             (case spec
     354               ((:address :single-float
     355                          :signed-fullword :unsigned-fullword
     356                          :signed-halfword :unsigned-halfword
     357                          :signed-byte :unsigned-byte)
     358                (incf total-words))
     359               ((:double-float :unsigned-doubleword :signed-doubleword)
     360                #-darwin-target
     361                (setq total-words (+ total-words (logand total-words 1)))
     362                (incf total-words 2))
     363
     364               (t (if (typep spec 'unsigned-byte)
     365                    (incf total-words spec)
     366                    (error "unknown arg spec ~s" spec)))))
     367           ;; It's necessary to ensure that the C frame is the youngest thing on
     368           ;; the foreign stack here.
     369           (let* ((tag (cons nil nil)))
     370             (declare (dynamic-extent tag))
     371             (%stack-block ((result 8))
     372               (catch tag
     373                 (with-macptrs ((argptr))
     374                   (with-variable-c-frame
     375                       total-words frame
     376                       (%setf-macptr-to-object argptr frame)
     377                       (let* ((arg-offset 8))
     378                         (declare (fixnum arg-offset))
     379                         (do* ((i 0 (1+ i))
     380                               (specs specs-and-vals (cddr specs))
     381                               (spec (car specs) (car specs))
     382                               (val (cadr specs) (cadr specs)))
     383                              ((= i nargs))
     384                           (declare (fixnum i))
     385                           (case spec
     386                             (:address
     387                              (setf (%get-ptr argptr arg-offset) val)
     388                              (incf arg-offset 4))
     389                             (:signed-doubleword
     390                              #-darwin-target
     391                              (when (logtest 7 arg-offset)
     392                                (incf arg-offset 4))
     393                              (setf (%%get-signed-longlong argptr arg-offset) val)
     394                              (incf arg-offset 8))
     395                             ((:signed-fullword :signed-halfword :signed-byte)
     396                              (setf (%get-signed-long argptr arg-offset) val)
     397                              (incf arg-offset 4))
     398                             (:unsigned-doubleword
     399                              #-darwin-target
     400                              (when (logtest 7 arg-offset)
     401                                (incf arg-offset 4))
     402                              (setf (%%get-unsigned-longlong argptr arg-offset) val)
     403                              (incf arg-offset 8))
     404                             ((:unsigned-fullword :unsigned-halfword :unsigned-byte)
     405                              (setf (%get-unsigned-long argptr arg-offset) val)
     406                              (incf arg-offset 4))
     407                             (:double-float
     408                              #-darwin-target
     409                              (when (logtest 7 arg-offset)
     410                                (incf arg-offset 4))
     411                              (setf (%get-double-float argptr arg-offset) val)
     412                              (incf arg-offset 8))
     413                             (:single-float
     414                              (setf (%get-single-float argptr arg-offset) val)
     415                              (incf arg-offset 4))
     416                             (t
     417                              (let* ((p 0))
     418                                (declare (fixnum p))
     419                                (dotimes (i (the fixnum spec))
     420                                  (setf (%get-ptr argptr arg-offset) (%get-ptr val p))
     421                                  (incf p 4)
     422                                  (incf arg-offset 4)))))))
     423                       (%do-ff-call tag result entry))))
     424               (ecase result-spec
     425                 (:void nil)
     426                 (:address (%get-ptr result 0))
     427                 (:unsigned-byte (%get-unsigned-byte result 0))
     428                 (:signed-byte (%get-signed-byte result 0))
     429                 (:unsigned-halfword (%get-unsigned-word result 0))
     430                 (:signed-halfword (%get-signed-word result 0))
     431                 (:unsigned-fullword (%get-unsigned-long result 0))
     432                 (:signed-fullword (%get-signed-long result 0))
     433                 (:unsigned-doubleword (%%get-unsigned-longlong result 0))
     434                 (:signed-doubleword (%%get-signed-longlong result 0))
     435                 (:single-float (%get-single-float result 0))
     436                 (:double-float (%get-double-float result 0)))))))))))
     437
     438
     439(defarmlapfunction %do-ff-call-hard-float ((tag arg_x) (result arg_y) (entry arg_z))
     440  (stmdb (:! vsp) (tag result))
     441  (sploadlr .SPeabi-ff-callhf)
     442  (blx lr)
     443  (ldmia (:! vsp) (tag result))
     444  (macptr-ptr imm2 result)
     445  (str imm0 (:@ imm2 (:$ 0)))
     446  (str imm1 (:@ imm2 (:$ 4)))
     447  (fstd d0 (:@ imm2 (:$ 8)))
     448  (vpush1 tag)
     449  (mov arg_z 'nil)
     450  (vpush1 arg_z)
     451  (set-nargs 1)
     452  (sploadlr .SPthrow)
     453  (blx lr))
     454
     455(defun %ff-call-hard-float (entry specs-and-vals)
     456  (let* ((len (length specs-and-vals))
     457         (total-words 0)
     458         (fp-words 16))
     459    (declare (fixnum len total-words fp-words))
     460    (let* ((result-spec (or (car (last specs-and-vals)) :void))
     461           (nargs (ash (the fixnum (1- len)) -1)))
     462      (declare (fixnum nargs))
    330463      (ecase result-spec
    331464        ((:address :unsigned-doubleword :signed-doubleword
     
    341474           (declare (fixnum i))
    342475           (case spec
    343              ((:address :single-float
    344                         :signed-fullword :unsigned-fullword
     476             ((:address :signed-fullword :unsigned-fullword
    345477                        :signed-halfword :unsigned-halfword
    346478                        :signed-byte :unsigned-byte)
    347479              (incf total-words))
    348              ((:double-float :unsigned-doubleword :signed-doubleword)
    349               #-darwin-target
     480             (:single-float
     481              (if (> fp-words 0)
     482                (decf fp-words)
     483                (incf total-words)))
     484             (:double-float
     485              (if (>= fp-words 2)
     486                (if (oddp fp-words)
     487                  (decf fp-words 3)
     488                  (decf fp-words 2))
     489                (if (oddp total-words)
     490                  (incf total-words 3)
     491                  (incf total-words 2))))
     492             ((:unsigned-doubleword :signed-doubleword)
    350493              (setq total-words (+ total-words (logand total-words 1)))
    351494              (incf total-words 2))
     
    358501         (let* ((tag (cons nil nil)))
    359502           (declare (dynamic-extent tag))
    360            (%stack-block ((result 8))
     503           (%stack-block ((result 16))
    361504             (catch tag
    362505               (with-macptrs ((argptr))
    363506                 (with-variable-c-frame
    364                      total-words frame
     507                     (+ total-words 16) frame
    365508                     (%setf-macptr-to-object argptr frame)
    366                      (let* ((arg-offset 8))
    367                        (declare (fixnum arg-offset))
     509                     (let* ((fp-arg-offset 8)
     510                            (arg-offset 72))
     511                       (declare (fixnum arg-offset fp-arg-offset))
    368512                       (do* ((i 0 (1+ i))
    369513                             (specs specs-and-vals (cddr specs))
     
    377521                            (incf arg-offset 4))
    378522                           (:signed-doubleword
    379                             #-darwin-target
    380523                            (when (logtest 7 arg-offset)
    381524                              (incf arg-offset 4))
     
    386529                            (incf arg-offset 4))
    387530                           (:unsigned-doubleword
    388                             #-darwin-target
    389531                             (when (logtest 7 arg-offset)
    390532                               (incf arg-offset 4))
     
    395537                            (incf arg-offset 4))
    396538                           (:double-float
    397                             #-darwin-target
    398                             (when (logtest 7 arg-offset)
    399                               (incf arg-offset 4))
    400                             (setf (%get-double-float argptr arg-offset) val)
    401                             (incf arg-offset 8))
     539                            (cond ((<= fp-arg-offset 64)
     540                                   (when (logtest 7 fp-arg-offset)
     541                                     (incf fp-arg-offset 4))
     542                                   (setf (%get-double-float argptr fp-arg-offset) val)
     543                                   (incf fp-arg-offset 8))
     544                                  (t
     545                                   (when (logtest 7 arg-offset)
     546                                     (incf arg-offset 4))
     547                                   (setf (%get-double-float argptr arg-offset) val)
     548                                   (incf arg-offset 8))))
    402549                           (:single-float
    403                             (setf (%get-single-float argptr arg-offset) val)
    404                             (incf arg-offset 4))
     550                            (cond ((< fp-arg-offset 72)
     551                                   (incf fp-arg-offset 4)
     552                                   (setf (%get-single-float argptr fp-arg-offset) val)
     553                                   (incf fp-arg-offset 4))
     554                                  (t
     555                                   (setf (%get-single-float argptr arg-offset) val)
     556                                   (incf arg-offset 4))))
    405557                           (t
    406558                              (let* ((p 0))
     
    410562                                  (incf p 4)
    411563                                  (incf arg-offset 4)))))))
    412                          (%do-ff-call tag result entry))))
     564                         (%do-ff-call-hard-float tag result entry))))
    413565             (ecase result-spec
    414566               (:void nil)
     
    422574               (:unsigned-doubleword (%%get-unsigned-longlong result 0))
    423575               (:signed-doubleword (%%get-signed-longlong result 0))
    424                (:single-float (%get-single-float result 0))
    425                (:double-float (%get-double-float result 0))))))))))
     576               (:single-float (%get-single-float result 8))
     577               (:double-float (%get-double-float result 8))))))))))
    426578
    427579
     
    583735  (bx lr))
    584736
     737(defarmlapfunction arm-hard-float-p ()
     738  (check-nargs 0)
     739  (ref-global arg_z arm::float-abi)
     740  (tst arg_z arg_z)
     741  (mov arg_z 'nil)
     742  (addne arg_z arg_z (:$ arm::t-offset))
     743  (bx lr))
     744 
    585745;;; end of arm-def.lisp
Note: See TracChangeset for help on using the changeset viewer.