Changeset 6147


Ignore:
Timestamp:
Apr 7, 2007, 12:36:48 PM (12 years ago)
Author:
gb
Message:

Try to inline some coercions to single/double float.
(long-standing) bug in handling of lambda-bind: handling of stack-consed
list for &rest needs to record the right vstack value when opening the
undo record (args are popped off of vstack by subprim.)

Location:
branches/objc-gf/ccl/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/compiler/PPC/ppc2.lisp

    r6134 r6147  
    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
     
    89528952      (<- (set-regspec-mode dreg hard-reg-class-fpr-mode-single))
    89538953      (^))))
    8954        
     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))))))))
    89559014
    89569015;------
  • branches/objc-gf/ccl/compiler/X86/x862.lisp

    r5971 r6147  
    46514651         target
    46524652         (exit-vstack current-vstack))
    4653     (declare (ignore-if-unused target))
     4653    (declare (ignorable target))
    46544654    (when (neq 0 diff)
    46554655      (setq exit-vstack (x862-nlexit seg xfer diff))
     
    80598059              (setq restloc (%i+ restloc *x862-target-node-size*))))
    80608060          (x862-set-nargs seg (length rest-arg))
     8061          (x862-set-vstack restloc)
    80618062          (if (%ilogbitp $vbitdynamicextent (nx-var-bits rest))
    80628063            (progn
     
    80648065              (x862-open-undo $undostkblk))
    80658066            (! list))
    8066           (x862-vpush-register seg x8664::arg_z)
    8067           (x862-set-vstack (%i+ restloc *x862-target-node-size*)))
     8067          (x862-vpush-register seg x8664::arg_z))
    80688068        (when rest (x862-bind-var seg rest restloc))
    80698069        (destructuring-bind (vars inits) auxen
     
    88948894      (^))))
    88958895
     8896(defx862 x862-%double-float %double-float (seg vreg xfer arg)
     8897  (let* ((real (or (acode-fixnum-form-p arg)
     8898                   (let* ((form (acode-unwrapped-form arg)))
     8899                     (if (and (acode-p form)
     8900                              (eq (acode-operator form)
     8901                                  (%nx1-operator immediate))
     8902                              (typep (cadr form) 'real))
     8903                       (cadr form))))))
     8904    (if real
     8905      (x862-immediate seg vreg xfer (float real 0.0d0))
     8906      (if (x862-form-typep arg 'single-float)
     8907        (x862-use-operator (%nx1-operator %single-to-double)
     8908                           seg
     8909                           vreg
     8910                           xfer
     8911                           arg)
     8912        (if (x862-form-typep arg 'fixnum)
     8913          (x862-use-operator (%nx1-operator %fixnum-to-double)
     8914                             seg
     8915                             vreg
     8916                             xfer
     8917                             arg)
     8918          (x862-use-operator (%nx1-operator call)
     8919                             seg
     8920                             vreg
     8921                             xfer
     8922                             (make-acode (%nx1-operator immediate)
     8923                                         '%double-float)
     8924                             (list nil (list arg))))))))
     8925
     8926(defx862 x862-%single-float %single-float (seg vreg xfer arg)
     8927  (let* ((real (or (acode-fixnum-form-p arg)
     8928                   (let* ((form (acode-unwrapped-form arg)))
     8929                     (if (and (acode-p form)
     8930                              (eq (acode-operator form)
     8931                                  (%nx1-operator immediate))
     8932                              (typep (cadr form) 'real))
     8933                       (cadr form))))))
     8934    (if real
     8935      (x862-immediate seg vreg xfer (float real 0.0f0))
     8936      (if (x862-form-typep arg 'double-float)
     8937        (x862-use-operator (%nx1-operator %double-to-single)
     8938                           seg
     8939                           vreg
     8940                           xfer
     8941                           arg)
     8942        (if (x862-form-typep arg 'fixnum)
     8943          (x862-use-operator (%nx1-operator %fixnum-to-single)
     8944                             seg
     8945                             vreg
     8946                             xfer
     8947                             arg)
     8948          (x862-use-operator (%nx1-operator call)
     8949                             seg
     8950                             vreg
     8951                             xfer
     8952                             (make-acode (%nx1-operator immediate)
     8953                                         '%short-float)
     8954                             (list nil (list arg))))))))
     8955   
     8956
    88968957;------
    88978958
Note: See TracChangeset for help on using the changeset viewer.