Changeset 8576


Ignore:
Timestamp:
Feb 25, 2008, 12:02:15 AM (12 years ago)
Author:
gz
Message:

In try harder to make with-code-note not defeat optimizations, so as not to hit
bugs in the normally-unused non-optimized versions of operations.

Also, a better instruction sequence for setting the code coverage flag.

Location:
branches/working-0711/ccl/compiler
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/PPC/ppc2.lisp

    r8554 r8576  
    4141  (if (eq (acode-operator x) (%nx1-operator immediate))
    4242    (cadr x)
    43     (compiler-bug "~&Bug: not an immediate: ~s" x)))
     43    (if (eq (acode-operator x) (%nx1-operator with-code-note))
     44      (ppc2-immediate-operand (caddr x))
     45      (compiler-bug "~&Bug: not an immediate: ~s" x))))
    4446
    4547(defmacro with-ppc-p2-declarations (declsform &body body)
     
    12501252
    12511253(defun ppc2-single-valued-form-p (form)
    1252   (setq form (acode-unwrapped-form form))
     1254  (setq form (acode-unwrapped-form-value form))
    12531255  (or (nx-null form)
    12541256      (nx-t form)
     
    21612163  (when *compile-code-coverage*
    21622164    (with-ppc-local-vinsn-macros (seg)
    2163       (ppc2-store-immediate seg note ($ ppc::arg_x))
    2164       (! misc-set-c-node ($ ppc::rzero) ($ ppc::arg_x) 1)))
     2165      (ppc2-store-immediate seg note ($ ppc::temp0))
     2166      (! misc-set-c-node ($ ppc::rzero) ($ ppc::temp0) 1)))
    21652167  (setq val (ppc2-form seg vreg xfer form))
    21662168  (when *record-pc-mapping*
    21672169    (append-dll-node (setf (code-note-end-pc note) (make-vinsn-label nil)) seg))
    21682170  val)
     2171
     2172
     2173 (defun ppc2-with-dynamic-extent-code-note (seg curstack note form &aux val)
     2174   ;; This assumes ppc2-dynamic-extent-form will actually generate code.  The caller
     2175   ;; must check for that.
     2176   (when *record-pc-mapping*     
     2177     (append-dll-node (setf (code-note-start-pc note) (make-vinsn-label nil)) seg))
     2178   (when *compile-code-coverage*
     2179     (with-ppc-local-vinsn-macros (seg)
     2180       (ppc2-store-immediate seg note ($ ppc::temp0))
     2181       (! misc-set-c-node ($ ppc::rzero) ($ ppc::temp0) 1)))
     2182   (setq val (ppc2-dynamic-extent-form seg curstack form))
     2183   #+debug 0 (assert (not (eq val form)))
     2184   (when *record-pc-mapping*
     2185     (append-dll-node (setf (code-note-end-pc note) (make-vinsn-label nil)) seg))
     2186   val)
     2187
    21692188
    21702189(defun ppc2-digest-code-notes ()
     
    22522271                (return nil))
    22532272              (flet ((independent-of-all-values (form)       
    2254                        (setq form (acode-unwrapped-form form))
     2273                       (setq form (acode-unwrapped-form-value form))
    22552274                       (or (ppc-constant-form-p form)
    22562275                           (let* ((lexref (ppc2-lexical-reference-p form)))
     
    22882307      (destructuring-bind (stack-args reg-args) arglist
    22892308        (when (and (null (cdr reg-args))
    2290                    (nx-null (acode-unwrapped-form (car reg-args))))
     2309                   (nx-null (acode-unwrapped-form-value (car reg-args))))
    22912310          (setq spread-p nil)
    22922311          (let* ((nargs (length stack-args)))
     
    23762395(defun ppc2-invoke-fn (seg fn nargs spread-p xfer)
    23772396  (with-ppc-local-vinsn-macros (seg)
    2378     (let* ((f-op (acode-unwrapped-form fn))
     2397    (let* ((f-op (acode-unwrapped-form-value fn))
    23792398           (immp (and (consp f-op)
    23802399                      (eq (%car f-op) (%nx1-operator immediate))))
     
    26202639
    26212640(defun ppc2-immediate-function-p (f)
    2622   (setq f (acode-unwrapped-form f))
     2641  (setq f (acode-unwrapped-form-value f))
    26232642  (and (acode-p f)
    26242643       (or (eq (%car f) (%nx1-operator immediate))
     
    26382657 
    26392658(defun ppc2-long-constant-p (form)
    2640   (setq form (acode-unwrapped-form form))
     2659  (setq form (acode-unwrapped-form-value form))
    26412660  (or (acode-fixnum-form-p form)
    26422661      (and (acode-p form)
     
    26482667
    26492668(defun ppc-side-effect-free-form-p (form)
    2650   (when (consp (setq form (acode-unwrapped-form form)))
     2669  (when (consp (setq form (acode-unwrapped-form-value form)))
    26512670    (or (ppc-constant-form-p form)
    26522671        ;(eq (acode-operator form) (%nx1-operator bound-special-ref))
     
    33343353
    33353354(defun ppc2-lexical-reference-ea (form &optional (no-closed-p t))
    3336   (when (acode-p (setq form (acode-unwrapped-form form)))
     3355  (when (acode-p (setq form (acode-unwrapped-form-value form)))
    33373356    (if (eq (acode-operator form) (%nx1-operator lexical-reference))
    33383357      (let* ((addr (var-ea (%cadr form))))
     
    36573676    (ppc2-seq-bind-var seg var (pop initforms))))
    36583677
     3678(defun ppc2-dynamic-extent-form-p (val)
     3679  ;; Returns true if ppc2-dynamic-extent-form will succeed.
     3680  (and (acode-p val)
     3681       (let ((op (acode-operator val)))
     3682         (or (eq op (%nx1-operator list))
     3683             (eq op (%nx1-operator list*))
     3684             (eq op (%nx1-operator multiple-value-list))
     3685             (eq op (%nx1-operator cons))
     3686             (eq op (%nx1-operator %consmacptr%))
     3687             (eq op (%nx1-operator %new-ptr))
     3688     (eq op (%nx1-operator make-list))
     3689             (eq op (%nx1-operator vector))
     3690             (eq op (%nx1-operator %gvector))
     3691             (eq op (%nx1-operator closed-function))
     3692             (eq op (%nx1-operator %make-uvector))
     3693             (and (eq op (%nx1-operator with-code-note))
     3694                  (ppc2-dynamic-extent-form-p (%caddr val)))
     3695             (and (eq op (%nx1-operator progn))
     3696                  (ppc2-dynamic-extent-form-p (%car (last (%cadr val)))))))))
     3697
    36593698(defun ppc2-dynamic-extent-form (seg curstack val)
    36603699  (when (acode-p val)
     
    36993738                   (setq val node))))
    37003739              ((eq op (%nx1-operator %new-ptr))
    3701                (let ((clear-form (caddr val)))
    3702                  (if (nx-constant-form-p clear-form)
     3740               (let* ((clear-form (caddr val))
     3741                      (cval (nx-constant-form-p clear-form)))
     3742                 (if cval
    37033743                   (progn
    37043744                     (ppc2-one-targeted-reg-form seg (%cadr val) ($ ppc::arg_z))
    3705                      (if (nx-null clear-form)
     3745                     (if (nx-null cval)
    37063746                       (! make-stack-block)
    37073747                       (! make-stack-block0)))
     
    37263766               (! make-stack-list)
    37273767               (setq val ppc::arg_z))       
    3728               ((eq (%car val) (%nx1-operator vector))
     3768              ((eq op (%nx1-operator vector))
    37293769               (let* ((*ppc2-vstack* *ppc2-vstack*)
    37303770                      (*ppc2-top-vstack-lcell* *ppc2-top-vstack-lcell*))
     
    37533793                     (! stack-misc-alloc)))
    37543794                 (ppc2-open-undo $undostkblk)
    3755                  (setq val ($ ppc::arg_z))))))))
     3795                 (setq val ($ ppc::arg_z))))
     3796              ((and (eq op (%nx1-operator with-code-note))
     3797                    (ppc2-dynamic-extent-form-p (%caddr val)))
     3798               (destructuring-bind (note form) (%cdr val)
     3799                 (setq val (ppc2-with-dynamic-extent-code-note seg curstack note form))))
     3800              ((and (eq op (%nx1-operator progn)) (ppc2-dynamic-extent-form-p val))
     3801               (let ((formlist (%cadr val)))
     3802                 (while (%cdr formlist)
     3803                   (ppc2-form seg nil nil (pop formlist)))
     3804                 (setq val (ppc2-dynamic-extent-form seg curstack (%car formlist)))))))))
    37563805  val)
    37573806
     
    43614410(defun ppc2-lexical-reference-p (form)
    43624411  (when (acode-p form)
    4363     (let ((op (acode-operator (setq form (acode-unwrapped-form form)))))
     4412    (let ((op (acode-operator (setq form (acode-unwrapped-form-value form)))))
    43644413      (when (or (eq op (%nx1-operator lexical-reference))
    43654414                (eq op (%nx1-operator inherited-arg)))
     
    45174566  (if (ppc2-form-typep valform 'fixnum)
    45184567    nil
    4519     (let* ((val (acode-unwrapped-form valform)))
     4568    (let* ((val (acode-unwrapped-form-value valform)))
    45204569      (if (or (eq val *nx-t*)
    45214570              (eq val *nx-nil*)
     
    45904639;;; "XFER" is a compound destination.
    45914640(defun ppc2-conditional-form (seg xfer form)
    4592   (let* ((uwf (acode-unwrapped-form form)))
     4641  (let* ((uwf (acode-unwrapped-form-value form)))
    45934642    (if (nx-null uwf)
    45944643      (ppc2-branch seg (ppc2-cd-false xfer) nil)
     
    46834732
    46844733(defun ppc2-long-constant-p (form)
    4685   (setq form (acode-unwrapped-form form))
     4734  (setq form (acode-unwrapped-form-value form))
    46864735  (or (acode-fixnum-form-p form)
    46874736      (and (acode-p form)
     
    62026251     
    62036252
    6204 (defppc2 ppc2-if if (seg vreg xfer testform true false)
    6205   (if (nx-constant-form-p (acode-unwrapped-form testform))
    6206     (ppc2-form seg vreg xfer (if (nx-null (acode-unwrapped-form testform)) false true))
     6253(defppc2 ppc2-if if (seg vreg xfer testform true false &aux test-val)
     6254  (if (setq test-val (nx-constant-form-p (acode-unwrapped-form-value testform)))
     6255    (ppc2-form seg vreg xfer (if (nx-null test-val) false true))
    62076256    (let* ((cstack *ppc2-cstack*)
    62086257           (vstack *ppc2-vstack*)
     
    90569105(defppc2 ppc2-%double-float %double-float (seg vreg xfer arg)
    90579106  (let* ((real (or (acode-fixnum-form-p arg)
    9058                    (let* ((form (acode-unwrapped-form arg)))
     9107                   (let* ((form (acode-unwrapped-form-value arg)))
    90599108                     (if (and (acode-p form)
    90609109                              (eq (acode-operator form)
     
    90869135(defppc2 ppc2-%single-float %single-float (seg vreg xfer arg)
    90879136  (let* ((real (or (acode-fixnum-form-p arg)
    9088                    (let* ((form (acode-unwrapped-form arg)))
     9137                   (let* ((form (acode-unwrapped-form-value arg)))
    90899138                     (if (and (acode-p form)
    90909139                              (eq (acode-operator form)
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r8560 r8576  
    4848  (if (eq (acode-operator x) (%nx1-operator immediate))
    4949    (cadr x)
    50     (compiler-bug "not an immediate: ~s" x)))
     50    (if (eq (acode-operator x) (%nx1-operator with-code-note))
     51      (x862-immediate-operand (caddr x))
     52      (compiler-bug "not an immediate: ~s" x))))
    5153
    5254(defmacro with-x86-p2-declarations (declsform &body body)
     
    14511453
    14521454(defun x862-single-valued-form-p (form)
    1453   (setq form (acode-unwrapped-form form))
     1455  (setq form (acode-unwrapped-form-value form))
    14541456  (or (nx-null form)
    14551457      (nx-t form)
     
    23742376     (setf (afunc-bits afunc) (%ilogior (afunc-bits afunc) (ash 1 $fbitccoverage)))
    23752377     (with-x86-local-vinsn-macros (seg)
    2376        (let* ((ccreg ($ x8664::arg_x))
    2377               (valreg ($ x8664::arg_z)))
     2378       (let* ((ccreg ($ x8664::arg_x)))
    23782379         (! vpush-register ccreg)
    2379          (! vpush-register valreg)
    23802380         (! ref-constant ccreg (x86-immediate-label note))
    2381          (! load-t valreg)
    2382          (! misc-set-c-node valreg ccreg 1)
    2383          (! vpop-register valreg)
     2381         (! misc-set-immediate-c-node 0 ccreg 1)
    23842382         (! vpop-register ccreg))))))
    23852383
     
    23892387  (when *compile-code-coverage*
    23902388    (with-x86-local-vinsn-macros (seg)
    2391       (x862-store-immediate seg note x8664::arg_x)
    2392       (! load-t x8664::arg_y)
    2393       (! misc-set-c-node x8664::arg_y x8664::arg_x 1)))
     2389      (x862-store-immediate seg note x8664::temp0)
     2390      (! misc-set-immediate-c-node 0 x8664::temp0 1)))
    23942391  (setq val (x862-form seg vreg xfer form))
     2392  (when *record-pc-mapping*
     2393    (append-dll-node (setf (code-note-end-pc note) (make-vinsn-label nil)) seg))
     2394  val)
     2395
     2396(defun x862-with-dynamic-extent-code-note (seg curstack note form &aux val)
     2397  ;; This assumes x862-dynamic-extent-form will actually generate code.  The caller
     2398  ;; must check for that.
     2399  (when *record-pc-mapping*
     2400    (append-dll-node (setf (code-note-start-pc note) (make-vinsn-label nil)) seg))
     2401  (when *compile-code-coverage*
     2402    (with-x86-local-vinsn-macros (seg)
     2403      (x862-store-immediate seg note x8664::temp0)
     2404      (! misc-set-immediate-c-node 0 x8664::temp0 1)))
     2405  (setq val (x862-dynamic-extent-form seg curstack form))
     2406  #+debug 0 (assert (not (eq val form)))
    23952407  (when *record-pc-mapping*
    23962408    (append-dll-node (setf (code-note-end-pc note) (make-vinsn-label nil)) seg))
     
    24922504                (return nil))
    24932505              (flet ((independent-of-all-values (form)       
    2494                        (setq form (acode-unwrapped-form form))
     2506                       (setq form (acode-unwrapped-form-value form))
    24952507                       (or (x86-constant-form-p form)
    24962508                           (let* ((lexref (x862-lexical-reference-p form)))
     
    25282540      (destructuring-bind (stack-args reg-args) arglist
    25292541        (when (and (null (cdr reg-args))
    2530                    (nx-null (acode-unwrapped-form (car reg-args))))
     2542                   (nx-null (acode-unwrapped-form-value (car reg-args))))
    25312543          (setq spread-p nil)
    25322544          (let* ((nargs (length stack-args)))
     
    26112623(defun x862-invoke-fn (seg fn nargs spread-p xfer &optional mvpass-label)
    26122624  (with-x86-local-vinsn-macros (seg)
    2613     (let* ((f-op (acode-unwrapped-form fn))
     2625    (let* ((f-op (acode-unwrapped-form-value fn))
    26142626           (immp (and (consp f-op)
    26152627                      (eq (%car f-op) (%nx1-operator immediate))))
     
    28382850
    28392851(defun x862-immediate-function-p (f)
    2840   (setq f (acode-unwrapped-form f))
     2852  (setq f (acode-unwrapped-form-value f))
    28412853  (and (acode-p f)
    28422854       (or (eq (%car f) (%nx1-operator immediate))
     
    28562868 
    28572869(defun x862-long-constant-p (form)
    2858   (setq form (acode-unwrapped-form form))
     2870  (setq form (acode-unwrapped-form-value form))
    28592871  (or (acode-fixnum-form-p form)
    28602872      (and (acode-p form)
     
    28662878
    28672879(defun x86-side-effect-free-form-p (form)
    2868   (when (consp (setq form (acode-unwrapped-form form)))
     2880  (when (consp (setq form (acode-unwrapped-form-value form)))
    28692881    (or (x86-constant-form-p form)
    28702882        ;(eq (acode-operator form) (%nx1-operator bound-special-ref))
     
    33803392
    33813393(defun x862-acode-operator-supports-u8 (form)
    3382   (setq form (acode-unwrapped-form form))
     3394  (setq form (acode-unwrapped-form-value form))
    33833395  (when (acode-p form)
    33843396    (let* ((operator (acode-operator form)))
     
    33873399
    33883400(defun x862-acode-operator-supports-push (form)
    3389   (setq form (acode-unwrapped-form form))
     3401  (setq form (acode-unwrapped-form-value form))
    33903402  (when (acode-p form)
    33913403    (if (or (eq form *nx-t*)
     
    36413653
    36423654(defun x862-lexical-reference-ea (form &optional (no-closed-p t))
    3643   (when (acode-p (setq form (acode-unwrapped-form form)))
     3655  (when (acode-p (setq form (acode-unwrapped-form-value form)))
    36443656    (if (eq (acode-operator form) (%nx1-operator lexical-reference))
    36453657      (let* ((addr (var-ea (%cadr form))))
     
    39273939            (= masked x8664::fulltag-nodeheader-1)))))))
    39283940
     3941(defun x862-dynamic-extent-form-p (val)
     3942  ;; Returns true if x862-dynamic-extent-form will succeed.
     3943  (and (acode-p val)
     3944       (let ((op (acode-operator val)))
     3945         (or (eq op (%nx1-operator list))
     3946             (eq op (%nx1-operator list*))
     3947             (eq op (%nx1-operator multiple-value-list))
     3948             (eq op (%nx1-operator cons))
     3949             (eq op (%nx1-operator %consmacptr%))
     3950             (eq op (%nx1-operator %new-ptr))
     3951             (eq op (%nx1-operator make-list))
     3952             (eq op (%nx1-operator vector))
     3953             (eq op (%nx1-operator %gvector))
     3954             (eq op (%nx1-operator closed-function))
     3955             (and (eq op (%nx1-operator %make-uvector))
     3956                  (let ((fix-subtag (acode-fixnum-form-p (%caddr val))))
     3957                    (or (x862-target-is-node-subtag fix-subtag)
     3958                        (x862-target-is-imm-subtag fix-subtag))))
     3959             (and (eq op (%nx1-operator with-code-note))
     3960                  (x862-dynamic-extent-form-p (%caddr val)))
     3961             (and (eq op (%nx1-operator progn))
     3962                  (x862-dynamic-extent-form-p (%car (last (%cadr val)))))))))
     3963
    39293964(defun x862-dynamic-extent-form (seg curstack val)
    39303965  (when (acode-p val)
     
    39694004                   (setq val node))))
    39704005              ((eq op (%nx1-operator %new-ptr))
    3971                (let ((clear-form (caddr val)))
    3972                  (if (nx-constant-form-p clear-form)
    3973                    (progn
    3974                      (x862-one-targeted-reg-form seg (%cadr val) ($ x8664::arg_z))
    3975                      (if (nx-null clear-form)
    3976                        (! make-stack-block)
    3977                        (! make-stack-block0)))
    3978                    (with-crf-target () crf
    3979                                     (let ((stack-block-0-label (backend-get-next-label))
    3980                                           (done-label (backend-get-next-label))
    3981                                           (rval ($ x8664::arg_z))
    3982                                           (rclear ($ x8664::arg_y)))
    3983                                       (x862-two-targeted-reg-forms seg (%cadr val) rval clear-form rclear)
    3984                                       (! compare-to-nil crf rclear)
    3985                                       (! cbranch-false (aref *backend-labels* stack-block-0-label) crf x86::x86-e-bits)
    3986                                       (! make-stack-block)
    3987                                       (-> done-label)
    3988                                       (@ stack-block-0-label)
    3989                                       (! make-stack-block0)
    3990                                       (@ done-label)))))
     4006               (let* ((clear-form (caddr val))
     4007                      (cval (nx-constant-form-p clear-form)))
     4008                 (if cval
     4009                     (progn
     4010                       (x862-one-targeted-reg-form seg (%cadr val) ($ x8664::arg_z))
     4011                       (if (nx-null cval)
     4012                           (! make-stack-block)
     4013                           (! make-stack-block0)))
     4014                     (with-crf-target () crf
     4015                       (let ((stack-block-0-label (backend-get-next-label))
     4016                             (done-label (backend-get-next-label))
     4017                             (rval ($ x8664::arg_z))
     4018                             (rclear ($ x8664::arg_y)))
     4019                         (x862-two-targeted-reg-forms seg (%cadr val) rval clear-form rclear)
     4020                         (! compare-to-nil crf rclear)
     4021                         (! cbranch-false (aref *backend-labels* stack-block-0-label) crf x86::x86-e-bits)
     4022                         (! make-stack-block)
     4023                         (-> done-label)
     4024                         (@ stack-block-0-label)
     4025                         (! make-stack-block0)
     4026                         (@ done-label)))))
    39914027               (x862-open-undo $undo-x86-c-frame)
    39924028               (setq val ($ x8664::arg_z)))
     
    39964032               (! make-stack-list)
    39974033               (setq val x8664::arg_z))       
    3998               ((eq (%car val) (%nx1-operator vector))
     4034              ((eq op (%nx1-operator vector))
    39994035               (let* ((*x862-vstack* *x862-vstack*)
    40004036                      (*x862-top-vstack-lcell* *x862-top-vstack-lcell*))
     
    40294065                       (x862-open-undo $undostkblk)
    40304066                       (x862-open-undo $undo-x86-c-frame))
    4031                      (setq val ($ x8664::arg_z))))))))))
     4067                     (setq val ($ x8664::arg_z))))))
     4068              ((and (eq op (%nx1-operator with-code-note))
     4069                    (x862-dynamic-extent-form-p (%caddr val)))
     4070               (destructuring-bind (note form) (%cdr val)
     4071                 (setq val (x862-with-dynamic-extent-code-note seg curstack note form))))
     4072              ((and (eq op (%nx1-operator progn)) (x862-dynamic-extent-form-p val))
     4073               (let ((formlist (%cadr val)))
     4074                 (while (%cdr formlist)
     4075                   (x862-form seg nil nil (pop formlist)))
     4076                 (setq val (x862-dynamic-extent-form seg curstack (%car formlist)))))))))
    40324077  val)
    40334078
     
    44884533(defun x862-lexical-reference-p (form)
    44894534  (when (acode-p form)
    4490     (let ((op (acode-operator (setq form (acode-unwrapped-form form)))))
     4535    (let ((op (acode-operator (setq form (acode-unwrapped-form-value form)))))
    44914536      (when (or (eq op (%nx1-operator lexical-reference))
    44924537                (eq op (%nx1-operator inherited-arg)))
     
    46314676  (if (x862-form-typep valform 'fixnum)
    46324677    nil
    4633     (let* ((val (acode-unwrapped-form valform)))
     4678    (let* ((val (acode-unwrapped-form-value valform)))
    46344679      (if (or (eq val *nx-t*)
    46354680              (eq val *nx-nil*)
     
    47044749;;; "XFER" is a compound destination.
    47054750(defun x862-conditional-form (seg xfer form)
    4706   (let* ((uwf (acode-unwrapped-form form)))
     4751  (let* ((uwf (acode-unwrapped-form-value form)))
    47074752    (if (nx-null uwf)
    47084753      (x862-branch seg (x862-cd-false xfer))
     
    48004845
    48014846(defun x862-long-constant-p (form)
    4802   (setq form (acode-unwrapped-form form))
     4847  (setq form (acode-unwrapped-form-value form))
    48034848  (or (acode-fixnum-form-p form)
    48044849      (and (acode-p form)
     
    65656610     
    65666611
    6567 (defx862 x862-if if (seg vreg xfer testform true false)
    6568   (if (nx-constant-form-p (acode-unwrapped-form testform))
    6569     (x862-form seg vreg xfer (if (nx-null (acode-unwrapped-form testform)) false true))
     6612(defx862 x862-if if (seg vreg xfer testform true false &aux test-val)
     6613  (if (setq test-val (nx-constant-form-p (acode-unwrapped-form-value testform)))
     6614    (x862-form seg vreg xfer (if (nx-null test-val) false true))
    65706615    (let* ((cstack *x862-cstack*)
    65716616           (vstack *x862-vstack*)
     
    91759220(defx862 x862-%double-float %double-float (seg vreg xfer arg)
    91769221  (let* ((real (or (acode-fixnum-form-p arg)
    9177                    (let* ((form (acode-unwrapped-form arg)))
     9222                   (let* ((form (acode-unwrapped-form-value arg)))
    91789223                     (if (and (acode-p form)
    91799224                              (eq (acode-operator form)
     
    92059250(defx862 x862-%single-float %single-float (seg vreg xfer arg)
    92069251  (let* ((real (or (acode-fixnum-form-p arg)
    9207                    (let* ((form (acode-unwrapped-form arg)))
     9252                   (let* ((form (acode-unwrapped-form-value arg)))
    92089253                     (if (and (acode-p form)
    92099254                              (eq (acode-operator form)
  • branches/working-0711/ccl/compiler/acode-rewrite.lisp

    r7768 r8576  
    6565
    6666(defun acode-constant-p (form)
    67   (let* ((form (acode-unwrapped-form form)))
     67  (let* ((form (acode-unwrapped-form-value form)))
    6868    (or (eq form *nx-nil*)
    6969        (eq form *nx-t*)
     
    7474(defun acode-post-form-typep (form type)
    7575  (let* ((ctype (specifier-type type))
    76          (form (acode-unwrapped-form form)))
     76         (form (acode-unwrapped-form-value form)))
    7777    (cond ((eq form *nx-nil*) (ctypep nil ctype))
    7878          ((eq form *nx-t*) (ctypep t ctype))
     
    256256  (destructuring-bind (test true &optional (false *nx-nil*)) w
    257257    (if (acode-constant-p test)
    258       (if (eq *nx-nil* (acode-unwrapped-form test))
     258      (if (eq *nx-nil* (acode-unwrapped-form-value test))
    259259        false
    260260        true))))
     
    268268    (let* ((form (car forms)))
    269269      (when (and (acode-constant-p form)
    270                  (not (eq *nx-nil* (acode-unwrapped-form form))))
     270                 (not (eq *nx-nil* (acode-unwrapped-form-value form))))
    271271        (progn
    272272          (rplacd forms nil)
  • branches/working-0711/ccl/compiler/nx0.lisp

    r8560 r8576  
    534534  form)
    535535
     536;; Use this only to reason about the value of a form at compile time.   To actually
     537;; generate code, use acode-unwrapped-form, because we want to include the code note code.
     538(defun acode-unwrapped-form-value (form)
     539  (setq form (acode-unwrapped-form form))
     540  (when (and (acode-p form)
     541             (eq (acode-operator form) (%nx1-operator with-code-note)))
     542    (setq form (acode-unwrapped-form-value (caddr form))))
     543  form)
     544
    536545(defun acode-fixnum-form-p (x)
    537   (setq x (acode-unwrapped-form x))
     546  (setq x (acode-unwrapped-form-value x))
    538547  (if (acode-p x)
    539548    (if (eq (acode-operator x) (%nx1-operator fixnum))
     
    17571766(defun nx-constant-form-p (form)
    17581767  (setq form (nx-untyped-form form))
    1759   (if form
    1760     (or (nx-null form)
    1761         (nx-t form)
    1762         (and (consp form)
    1763              (or (eq (acode-operator form) (%nx1-operator immediate))
    1764                  (eq (acode-operator form) (%nx1-operator fixnum))
    1765                  (eq (acode-operator form) (%nx1-operator simple-function)))))))
     1768  (and (or (nx-null form)
     1769           (nx-t form)
     1770           (and (acode-p form)
     1771                (or (eq (acode-operator form) (%nx1-operator immediate))
     1772                    (eq (acode-operator form) (%nx1-operator fixnum))
     1773                    (eq (acode-operator form) (%nx1-operator simple-function))
     1774                    (and (eq (acode-operator form) (%nx1-operator with-code-note))
     1775                         (setq form (nx-constant-form-p (%caddr form)))))))
     1776       form))
    17661777
    17671778(defun nx-natural-constant-p (form)
Note: See TracChangeset for help on using the changeset viewer.