Changeset 6171


Ignore:
Timestamp:
Apr 8, 2007, 2:48:25 AM (13 years ago)
Author:
gb
Message:

Fix a long-standing bug involving LAMBDA-BIND operator, dynamic-extent
&REST, and stack memoization.
Handle DarwinPPC64 ABI conventions, where SINGLE-FLOATs may be passed
in the same doubleword as GPRs.
%DOUBLE-FLOAT, %SINGLE-FLOAT stuff: do inlining late, catch some other
cases.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/compiler/PPC/ppc2.lisp

    r6000 r6171  
    78697869              (setq restloc (%i+ restloc *ppc2-target-node-size*))))
    78707870          (ppc2-set-nargs seg (length rest-arg))
     7871          (ppc2-set-vstack restloc)
    78717872          (if (%ilogbitp $vbitdynamicextent (nx-var-bits rest))
    78727873            (progn
     
    78747875              (ppc2-open-undo $undostkblk))
    78757876            (! list))
    7876           (ppc2-vpush-register seg ppc::arg_z)
    7877           (ppc2-set-vstack (%i+ restloc *ppc2-target-node-size*)))
     7877          (ppc2-vpush-register seg ppc::arg_z))
    78787878        (when rest (ppc2-bind-var seg rest restloc))
    78797879        (destructuring-bind (vars inits) auxen
     
    82328232             (setq return-registers t)
    82338233             (ppc2-push-register seg (ppc2-one-untargeted-reg-form seg valform ppc::arg_z)))
    8234             ((:signed-doubleword :unsigned-doubleword)
     8234            ((:signed-doubleword :unsigned-doubleword :hybrid-int-float :hybrid-float-float :hybrid-float-int)
     8235                                 
    82358236             (ppc2-one-targeted-reg-form seg valform ($ ppc::arg_z))
    82368237             (if (eq spec :signed-doubleword)
     
    82428243               (incf nextarg)
    82438244               (! set-c-arg ($ ppc::imm1) nextarg))
    8244               (:ppc64)))
     8245              (:ppc64
     8246               (case spec
     8247                 (:hybrid-int-float (push (cons :single-float nextarg) fp-loads))
     8248                 (:hybrid-float-int (push (cons :single-float-high nextarg) fp-loads))
     8249                 (:hybrid-float-float
     8250                  (push (cons :single-float-high nextarg) fp-loads)
     8251                  (push (cons :single-float nextarg) fp-loads))))))
    82458252            (:double-float
    82468253             (let* ((df ($ ppc::fp1 :class :fpr :mode :double-float)))
     
    82958302          (if (eq size :double-float)
    82968303            (! reload-double-c-arg fpreg from)
    8297             (! reload-single-c-arg fpreg from))))
     8304            (if (eq size :single-float-high)
     8305              (! reload-single-c-arg-high fpreg from)
     8306              (! reload-single-c-arg fpreg from)))))
    82988307      return-registers)))
    82998308
     
    89438952      (<- (set-regspec-mode dreg hard-reg-class-fpr-mode-single))
    89448953      (^))))
    8945        
     8954
     8955(defppc2 ppc2-%double-float %double-float (seg vreg xfer arg)
     8956  (let* ((real (or (acode-fixnum-form-p arg)
     8957                   (let* ((form (acode-unwrapped-form arg)))
     8958                     (if (and (acode-p form)
     8959                              (eq (acode-operator form)
     8960                                  (%nx1-operator immediate))
     8961                              (typep (cadr form) 'real))
     8962                       (cadr form))))))
     8963    (if real
     8964      (ppc2-immediate seg vreg xfer (float real 0.0d0))
     8965      (if (ppc2-form-typep arg 'single-float)
     8966        (ppc2-use-operator (%nx1-operator %single-to-double)
     8967                           seg
     8968                           vreg
     8969                           xfer
     8970                           arg)
     8971        (if (ppc2-form-typep arg 'fixnum)
     8972          (ppc2-use-operator (%nx1-operator %fixnum-to-double)
     8973                             seg
     8974                             vreg
     8975                             xfer
     8976                             arg)
     8977          (ppc2-use-operator (%nx1-operator call)
     8978                             seg
     8979                             vreg
     8980                             xfer
     8981                             (make-acode (%nx1-operator immediate)
     8982                                         '%double-float)
     8983                             (list nil (list arg))))))))
     8984
     8985(defppc2 ppc2-%single-float %single-float (seg vreg xfer arg)
     8986  (let* ((real (or (acode-fixnum-form-p arg)
     8987                   (let* ((form (acode-unwrapped-form arg)))
     8988                     (if (and (acode-p form)
     8989                              (eq (acode-operator form)
     8990                                  (%nx1-operator immediate))
     8991                              (typep (cadr form) 'real))
     8992                       (cadr form))))))
     8993    (if real
     8994      (ppc2-immediate seg vreg xfer (float real 0.0f0))
     8995      (if (ppc2-form-typep arg 'double-float)
     8996        (ppc2-use-operator (%nx1-operator %double-to-single)
     8997                           seg
     8998                           vreg
     8999                           xfer
     9000                           arg)
     9001        (if (ppc2-form-typep arg 'fixnum)
     9002          (ppc2-use-operator (%nx1-operator %fixnum-to-single)
     9003                             seg
     9004                             vreg
     9005                             xfer
     9006                             arg)
     9007          (ppc2-use-operator (%nx1-operator call)
     9008                             seg
     9009                             vreg
     9010                             xfer
     9011                             (make-acode (%nx1-operator immediate)
     9012                                         '%short-float)
     9013                             (list nil (list arg))))))))
    89469014
    89479015;------
Note: See TracChangeset for help on using the changeset viewer.