Changeset 16611


Ignore:
Timestamp:
Oct 7, 2015, 4:33:17 AM (6 years ago)
Author:
gb
Message:

handle LOAD-TIME-VALUE differently.
In the COMPILE (EVAL) case, wrap the literal (immediate) in new acode.
make ACODE-CONSTANT-P recognize the COMPILE-FILE case, and return NIl,NIL
Fixes ticket:1317 in the trunk

Location:
trunk/source/compiler
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm2.lisp

    r16589 r16611  
    63186318  (^))
    63196319
     6320(defarm2 arm2-load-time-value load-time-value (seg vreg xfer val)
     6321  (arm2-form seg vreg xfer val))
    63206322
    63216323(defarm2 arm2-local-go local-go (seg vreg xfer tag)
  • trunk/source/compiler/X86/x862.lisp

    r16610 r16611  
    81508150
    81518151
     8152(defx862 x862-load-time-value load-time-value (seg vreg xfer val)
     8153  (x862-form seg vreg xfer val))
     8154
    81528155(defx862 x862-local-go local-go (seg vreg xfer tag)
    81538156  (declare (ignorable xfer))
  • trunk/source/compiler/acode-rewrite.lisp

    r16571 r16611  
    563563
    564564
     565(def-acode-rewrite acode-rewrite-load-time-value (load-time-value) asserted-type (val)
     566  (rewrite-acode-form val))
     567
    565568(def-acode-rewrite acode-rewrite-cxr (%car %cdr car cdr) asserted-type (&whole w cell)
    566569  (rewrite-acode-form cell)
    567570  (multiple-value-bind (val constantp) (acode-constant-p cell)
    568     (when (and constantp (typep val 'list) (not (and *load-time-eval-token* (eq (car val) *load-time-eval-token*))))
     571    (when (and constantp (typep val 'list) )
    569572      (let* ((op (acode-operator w)))
    570573        (acode-rewrite-as-constant-ref w (if (or (eql op (%nx1-operator car))
  • trunk/source/compiler/nx1.lisp

    r16604 r16611  
    11591159  (if (and read-only-p (neq read-only-p t)) (require-type read-only-p '(member t nil)))
    11601160  ;; Then ignore it.
    1161   (if *nx-load-time-eval-token*
    11621161    (multiple-value-bind (function warnings)
    11631162                         (compile-named-function
     
    11681167                          :target (backend-name *target-backend*))
    11691168      (setq *nx-warnings* (append *nx-warnings* warnings))
    1170       (nx1-immediate context (list *nx-load-time-eval-token* `(funcall ,function))))
    1171     (nx1-immediate context (eval form))))
     1169      (if *nx-load-time-eval-token*
     1170        (nx1-immediate context (list *nx-load-time-eval-token* `(funcall ,function)))
     1171   
     1172      (make-acode (%nx1-operator load-time-value)
     1173              (make-acode (%nx1-operator immediate)
     1174                          (funcall function))))))
    11721175
    11731176(defun nx1-catch-body (context body)
  • trunk/source/compiler/nx2.lisp

    r16111 r16611  
    362362
    363363
     364
    364365(defun acode-constant-p (form)
    365366  ;; This returns (values constant-value constantp); some code
     
    371372          ((eql op (%nx1-operator t))
    372373           (values t t))
    373           ((or (eql op (%nx1-operator fixnum))
    374                (eql op (%nx1-operator immediate)))
     374          ((eql op (%nx1-operator fixnum))
    375375           (values (car (acode-operands form)) t))
     376          ((eql op (%nx1-operator immediate))
     377           ;; recognize the acode produced for LOAD-TIME-VALUE by
     378           ;; COMPILE-FILE as something non-constant.
     379           (if (and
     380                (consp (car (acode-operands form)))
     381                *load-time-eval-token*
     382                (eq (car (car (acode-operands form))) *load-time-eval-token*))
     383             (values nil nil)
     384                             
     385                   
     386             (values (car (acode-operands form)) t)))
    376387          (t (values nil nil)))))
    377388
  • trunk/source/compiler/nxenv.lisp

    r16563 r16611  
    333333     (%double-float*-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) double-float)
    334334     (%double-float/-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) double-float)
    335      ()
     335     (load-time-value  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) t)
    336336     ()
    337337     ()
Note: See TracChangeset for help on using the changeset viewer.