Changeset 11701


Ignore:
Timestamp:
Feb 9, 2009, 6:42:14 PM (11 years ago)
Author:
gz
Message:

Merge back some of the source location changes made in the trunk (in
particular this fixes the bug where source locations weren't actually
getting attached to inner functions, plus it makes the current source
note available in *nx-current-note*). Use *nx-curent-note* to record
the source note in compiler warnings.

Location:
branches/working-0711/ccl
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r11670 r11701  
    13271327    n))
    13281328
    1329 (defun x862-form (seg vreg xfer form &aux (note (acode-source-note form)))
     1329(defun x862-form (seg vreg xfer form &aux (note (acode-note form)))
    13301330  (flet ((main (seg vreg xfer form)
    13311331           (if (nx-null form)
  • branches/working-0711/ccl/compiler/lambda-list.lisp

    r8646 r11701  
    4242  (getf (%lfun-info fn) 'text))
    4343
    44 (defun show-function-constants (f)
    45   (dotimes (i (- (uvsize (function-to-function-vector f))
    46                  (%function-code-words f)))
    47     (format t "~&~d: ~s" i (nth-immediate f (1+ i)))))
    4844
    49 (defun show-uvector-contents (uvector)
    50   (dotimes (i (uvsize uvector))
    51     (format t "~&~D: ~S" i (uvref uvector i))))
     45(defun find-source-at-pc (function pc)
     46  (let* ((function-source-note (getf (%lfun-info function) 'function-source-note))
     47         (pc-source-map (getf (%lfun-info function) 'pc-source-map)))
     48    (when pc-source-map
     49      (let* ((best-guess nil)
     50             (best-length nil)
     51             (len (length pc-source-map)))
     52        (declare (fixnum len))
     53        (do* ((q 0 (+ q 4))
     54              (r 1 (+ r 4)))
     55             ((= q len))
     56          (declare (fixnum q r))
     57          (let* ((pc-start (aref pc-source-map q))
     58                 (pc-end (aref pc-source-map r)))
     59            (declare (fixnum pc-start pc-end))
     60            (when (and (<= pc-start pc pc-end)
     61                        (or (null best-guess)
     62                            (< (- pc-end pc-start) best-length)))
     63               (setf best-guess q
     64                     best-length (- pc-end pc-start)))))
     65        (when best-guess
     66          (list :pc-range (cons (aref pc-source-map best-guess)
     67                                (aref pc-source-map (+ best-guess 1)))
     68                :source-text-range (cons (aref pc-source-map (+ best-guess 2))
     69                                         (aref pc-source-map (+ best-guess 3)))
     70                :file-name (getf function-source-note :file-name)
     71                :text (getf function-source-note :text)))))))
    5272
    5373;;; Lambda-list utilities
     74
     75
    5476
    5577
  • branches/working-0711/ccl/compiler/nx-basic.lisp

    r11164 r11701  
    4040(defvar *nx-proclaimed-types* nil)
    4141(defvar *nx-method-warning-name* nil)
     42
     43(defvar *nx-current-code-note*)
     44
     45;; In lieu of a slot in acode.  Don't reference this variable elsewhere because I'm
     46;; hoping to make it go away.
     47(defparameter *nx-acode-note-map* nil)
     48
     49(defun acode-note (acode &aux (hash *nx-acode-note-map*))
     50  (and hash (gethash acode hash)))
     51
     52(defun (setf acode-note) (note acode)
     53  (when note
     54    (assert *nx-acode-note-map*)
     55    (setf (gethash acode *nx-acode-note-map*) note)))
     56
     57
     58(defun nx-source-note (form &aux (source-notes *nx-source-note-map*))
     59  (when source-notes
     60    (when (or (consp form) (vectorp form) (pathnamep form))
     61      (let ((note (gethash form source-notes)))
     62        (unless (listp note) note)))))
     63
     64
     65(defun note-contained-in-p (note parent)
     66  (loop for n = note then (code-note-source n) while (code-note-p n) thereis (eq n parent)))
     67
     68(defun nx-find-code-note (form)
     69  ;; Try to find a source note for this form.  The act of matching up a source note with
     70  ;; forms that might come from macroexpansion is heuristic at best.  In general, err in
     71  ;; favor of not matching, because that leads to fewer false positives in code coverage
     72  ;; reporting.
     73  (when (or (consp form) (stringp form) (pathnamep form))
     74    (let ((note (gethash form *nx-source-note-map*)))
     75      (unless (listp note)
     76        note))))
     77
     78(defun nx-ensure-code-note (form original parent-note)
     79  ;; Try to find a source note for this form; if can't, just make a new record for it.
     80  (let* ((source-note (or (and original (nx-find-code-note original))
     81                          (nx-find-code-note form)))
     82         (note (if (and source-note
     83                        ;; Look out for a case like a lambda macro that turns (lambda ...)
     84                        ;; into (FUNCTION (lambda ...)) which then has (lambda ...)
     85                        ;; as a child.  Create a fresh note for the child, to avoid ambiguity.
     86                        ;; Another case is forms wrapping THE around themselves.
     87                        (neq source-note parent-note)
     88                        ;; Don't use source notes from a different toplevel form, which could
     89                        ;; happen due to inlining etc.  The result then is that the source note
     90                        ;; appears in multiple places, and shows partial coverage (from the
     91                        ;; other reference) in code that's never executed.
     92                        (loop for p = parent-note then (code-note-parent-note p)
     93                              when (null p) return t
     94                              when (source-note-p p)
     95                              return (let ((n source-note))
     96                                       (loop as s = (code-note-source p)
     97                                             while (source-note-p s) do (setq p s))
     98                                       (loop as s = (code-note-source n)
     99                                             while (source-note-p s) do (setq n s))
     100                                       (eq n p))))
     101                 source-note
     102                 (make-code-note :form (or original form) :source parent-note))))
     103    (register-code-note-parent note parent-note)
     104    note))
     105
     106(defun nx-note-source-transformation (original new &aux (source-notes *nx-source-note-map*) sn)
     107  (when (and source-notes
     108             (setq sn (gethash original source-notes))
     109             (not (gethash new source-notes)))
     110    (setf (gethash new source-notes) sn))
     111  (record-form-source-equivalent original new))
     112
     113
    42114
    43115(defvar *nx1-alphatizers* (make-hash-table :size 180 :test #'eq))
     
    517589    (:result-ignored . "Function result ignored in call to ~s")
    518590    (:duplicate-definition . report-compile-time-duplicate-definition)
    519     (:program-error . "~a")))
     591    (:program-error . "~a")
     592    (:unsure . "Nonspecific warning")))
    520593
    521594(defun report-compile-time-duplicate-definition (condition stream)
  • branches/working-0711/ccl/compiler/nx.lisp

    r11279 r11701  
    152152(defparameter *load-time-eval-token* nil)
    153153
    154 (defparameter *nx-source-note-map* nil)
    155 
    156 (defun nx-source-note (form &aux (source-notes *nx-source-note-map*))
    157   (when source-notes (gethash form source-notes)))
    158  
    159 (defun nx-note-source-transformation (original new &aux (source-notes *nx-source-note-map*) sn)
    160   (when (and source-notes
    161              (setq sn (gethash original source-notes))
    162              (not (gethash new source-notes)))
    163     (setf (gethash new source-notes) sn))
    164   (record-form-source-equivalent original new))
    165 
    166154(defparameter *nx-discard-xref-info-hook* nil)
    167155
    168 ;; In lieu of a slot in acode.  Don't reference this variable elsewhere because I'm
    169 ;; hoping to make it go away.
    170 (defparameter *nx-acode-source-map* nil)
    171 
    172 (defun acode-source-note (acode &aux (hash *nx-acode-source-map*))
    173   (and hash (gethash acode hash)))
    174 
    175 (defun (setf acode-source) (form acode)
    176   ;; Could save the form, but right now only really care about the source note,
    177   ;; and this way don't have to keep looking it up in pass 2.
    178   (let ((note (nx-source-note form)))
    179     (when note
    180       (assert *nx-acode-source-map*)
    181       (setf (gethash acode *nx-acode-source-map*) note))))
    182 
    183 (defun note-contained-in-p (note parent)
    184   (loop for n = note then (code-note-source n) while (code-note-p n) thereis (eq n parent)))
    185 
    186 (defun nx-find-code-note (form)
    187   ;; Try to find a source note for this form.  The act of matching up a source note with
    188   ;; forms that might come from macroexpansion is heuristic at best.  In general, err in
    189   ;; favor of not matching, because that leads to fewer false positives in code coverage
    190   ;; reporting.
    191   (when (or (consp form) (stringp form) (pathnamep form))
    192     (let ((note (gethash form *nx-source-note-map*)))
    193       (unless (listp note)
    194         note))))
    195 
    196 (defun nx-ensure-code-note (form original parent-note)
    197   ;; Try to find a source note for this form; if can't, just make a new record for it.
    198   (let* ((source-note (or (and original (nx-find-code-note original))
    199                           (nx-find-code-note form)))
    200          (note (if (and source-note
    201                         ;; Look out for a case like a lambda macro that turns (lambda ...)
    202                         ;; into (FUNCTION (lambda ...)) which then has (lambda ...)
    203                         ;; as a child.  Create a fresh note for the child, to avoid ambiguity.
    204                         ;; Another case is forms wrapping THE around themselves.
    205                         (neq source-note parent-note)
    206                         ;; Don't use source notes from a different toplevel form, which could
    207                         ;; happen due to inlining etc.  The result then is that the source note
    208                         ;; appears in multiple places, and shows partial coverage (from the
    209                         ;; other reference) in code that's never executed.
    210                         (loop for p = parent-note then (code-note-parent-note p)
    211                               when (null p) return t
    212                               when (source-note-p p)
    213                               return (let ((n source-note))
    214                                        (loop as s = (code-note-source p)
    215                                              while (source-note-p s) do (setq p s))
    216                                        (loop as s = (code-note-source n)
    217                                              while (source-note-p s) do (setq n s))
    218                                        (eq n p))))
    219                  source-note
    220                  (make-code-note :form (or original form) :source parent-note))))
    221     (register-code-note-parent note parent-note)
    222     note))
    223 
    224156(defun compile-named-function (def &key name env policy load-time-eval-token target
    225                                 function-note keep-lambda keep-symbols source-notes)
     157                                function-note keep-lambda keep-symbols source-notes
     158                                (record-pc-mapping *record-pc-mapping*)
     159                                (compile-code-coverage *compile-code-coverage*))
    226160  ;; SOURCE-NOTES, if not nil, is a hash table mapping source forms to locations,
    227161  ;;   is used to produce and attach a pc/source map to the lfun, also to attach
     
    235169   (let* ((*load-time-eval-token* load-time-eval-token)
    236170          (*nx-source-note-map* source-notes)
    237           (*nx-acode-source-map* (and source-notes (make-hash-table :test #'eq :shared nil)))
    238           (*nx-current-code-note* (and source-notes
    239                                        *compile-code-coverage*
    240                                        (nx-ensure-code-note def nil function-note)))
    241           (env (new-lexical-environment env)))
     171          (*nx-current-note* function-note)
     172          (*record-pc-mapping* (and source-notes record-pc-mapping))
     173          (*compile-code-coverage* (and source-notes compile-code-coverage))
     174          (*nx-acode-note-map* (and (or *record-pc-mapping* *compile-code-coverage*)
     175                                    (make-hash-table :test #'eq :shared nil)))
     176          (*nx-current-code-note* (and *compile-code-coverage*
     177                                       (nx-ensure-code-note def nil function-note)))
     178          (env (new-lexical-environment env)))
    242179     (setf (lexenv.variables env) 'barrier)
    243180     (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
     
    249186                    env
    250187                    (or policy *default-compiler-policy*)
    251                     *load-time-eval-token*
    252                     function-note)))
     188                    *load-time-eval-token*)))
    253189       (if (afunc-lfun afunc)
    254190         afunc
  • branches/working-0711/ccl/compiler/nx0.lisp

    r11279 r11701  
    3434  v)
    3535
     36(defvar *compile-code-coverage* nil "True to instrument for code coverage")
     37
    3638(defvar *nx-blocks* nil)
    3739(defvar *nx-tags* nil)
     
    4244(defvar *nx-inner-functions* nil)
    4345(defvar *nx-cur-func-name* nil)
     46(defvar *nx-current-note* nil)
     47(defparameter *nx-source-note-map* nil) ;; there might be external refs, from macros.
    4448(defvar *nx-form-type* t)
    4549;(defvar *nx-proclaimed-inline* nil)
     
    5761(defvar *nx1-operators* (make-hash-table :size 300 :test #'eq))
    5862
    59                                          
    6063
    6164; The compiler can (generally) use temporary vectors for VARs.
    6265(defun nx-cons-var (name &optional (bits 0))
    63   (%istruct 'var name bits nil nil nil nil))
     66  (%istruct 'var name bits nil nil nil nil 0 nil))
    6467
    6568
     
    7881(defvar *nx-operators* ())
    7982(defvar *nx-warnings* nil)
    80 (defvar *nx-current-code-note* nil)
    8183
    8284(defvar *nx1-compiler-special-forms* nil "Real special forms")
     
    98100(defvar *cross-compiling* nil "bootstrapping")
    99101
    100 
    101 (defvar *compile-code-coverage* nil "True to instrument for code coverage")
    102 (defvar *record-pc-mapping* nil "True to record pc -> source mapping")
    103102
    104103(defparameter *nx-operator-result-types*
     
    12841283                                 (%ilsl $vbitpuntable 1)
    12851284                                 (%i- varbits varcount)))
    1286               (nx-set-var-bits
    1287                boundto
    1288                  (%i+ (%i- boundtobits boundtocount)
    1289                       (%ilogand $vrefmask
    1290                                 (%i+ (%i- boundtocount 1) varcount)))))))))
    1291 
    1292 ;; Home-baked handler-case replacement.  About 10 times as fast as full handler-case.
    1293 ;;(LET ((S 0)) (DOTIMES (I 1000000) (INCF S))) took 45,678 microseconds
    1294 ;;(LET ((S 0)) (DOTIMES (I 1000000) (BLOCK X (ERROR (CATCH 'X (RETURN-FROM X (INCF S))))))) took 57,485
    1295 ;;(LET ((S 0)) (DOTIMES (I 1000000) (HANDLER-CASE (INCF S) (ERROR (C) C)))) took 168,947
     1285          (nx-set-var-bits
     1286           boundto
     1287           (%i+ (%i- boundtobits boundtocount)
     1288                (%ilogand $vrefmask
     1289                          (%i+ (%i- boundtocount 1) varcount)))))))))
     1290
     1291;;; Home-baked handler-case replacement.  About 10 times as fast as full handler-case.
     1292;;;(LET ((S 0)) (DOTIMES (I 1000000) (INCF S))) took 45,678 microseconds
     1293;;;(LET ((S 0)) (DOTIMES (I 1000000) (BLOCK X (ERROR (CATCH 'X (RETURN-FROM X (INCF S))))))) took 57,485
     1294;;;(LET ((S 0)) (DOTIMES (I 1000000) (HANDLER-CASE (INCF S) (ERROR (C) C)))) took 168,947
    12961295(defmacro with-program-error-handler (handler &body body)
    12971296  (let ((tag (gensym)))
     
    13071306                                 parent-env
    13081307                                 (policy *default-compiler-policy*)
    1309                                  load-time-eval-token
    1310                                  function-note)
     1308                                 load-time-eval-token)
    13111309
    13121310  (if q
     
    13311329            name)))
    13321330
    1333   (when (or function-note
    1334             (setq function-note (nx-source-note lambda-form))
    1335             (setq function-note (and q (getf (afunc-lfun-info q) 'function-source-note))))
    1336     (setf (afunc-lfun-info p)
    1337           (list* 'function-source-note function-note (afunc-lfun-info p))))
    1338 
    13391331  (unless (lambda-expression-p lambda-form)
    13401332    (nx-error "~S is not a valid lambda expression." lambda-form))
     1333
    13411334  (let* ((*nx-current-function* p)
    13421335         (*nx-parent-function* q)
     1336         (*nx-current-note* (or *nx-current-note* (nx-source-note lambda-form)))
    13431337         (*nx-lexical-environment* (new-lexical-environment parent-env))
    13441338         (*nx-load-time-eval-token* load-time-eval-token)
     
    13641358
    13651359    (setf (afunc-lambdaform p) lambda-form)
     1360
     1361    (when *nx-current-note*
     1362      (setf (afunc-lfun-info p)
     1363            (list* 'function-source-note *nx-current-note* (afunc-lfun-info p))))
     1364
    13661365    (with-program-error-handler
    13671366        (lambda (c)
     
    13831382            (with-program-error-handler (lambda (c) (runtime-program-error-form c))
    13841383              (parse-body (%cddr lambda-form) *nx-lexical-environment* t))
    1385           (setf (afunc-acode p) (nx1-lambda (%cadr lambda-form) body decls)))))
     1384          (setf (afunc-acode p) (nx1-lambda (%cadr lambda-form) body decls)))))
    13861385
    13871386    (nx1-transitively-punt-bindings *nx-punted-vars*)
     
    14581457                   (%ilsl $fbitnextmethp 1)
    14591458                   (afunc-bits *nx-current-function*)))))
    1460         (make-acode
    1461          (%nx1-operator lambda-list)
    1462          req
    1463          opt
    1464          (if lexpr (list rest) rest)
    1465          keys
    1466          auxen
    1467          body
    1468          *nx-new-p2decls*
    1469          *nx-current-code-note*)))))
     1459        (let ((acode (make-acode
     1460                      (%nx1-operator lambda-list)
     1461                      req
     1462                      opt
     1463                      (if lexpr (list rest) rest)
     1464                      keys
     1465                      auxen
     1466                      body
     1467                      *nx-new-p2decls*
     1468                      *nx-current-code-note*)))
     1469          (when *nx-current-code-note*
     1470            (setf (acode-note acode) *nx-current-code-note*))
     1471          acode)))))
    14701472
    14711473(defun nx-parse-simple-lambda-list (pending ll &aux
     
    16541656    (list (%nx1-operator lambda-list) whole req opt rest keys auxen)))
    16551657
    1656 (defun find-source-at-pc (function pc)
    1657   (let* ((function-source-note (getf (%lfun-info function) 'function-source-note))
    1658          (pc-source-map (getf (%lfun-info function) 'pc-source-map)))
    1659     (when pc-source-map
    1660       (let* ((best-guess nil)
    1661              (best-length nil)
    1662              (len (length pc-source-map)))
    1663         (declare (fixnum len))
    1664         (do* ((q 0 (+ q 4))
    1665               (r 1 (+ r 4)))
    1666              ((= q len))
    1667           (declare (fixnum q r))
    1668           (let* ((pc-start (aref pc-source-map q))
    1669                  (pc-end (aref pc-source-map r)))
    1670             (declare (fixnum pc-start pc-end))
    1671             (when (and (<= pc-start pc pc-end)
    1672                         (or (null best-guess)
    1673                             (< (- pc-end pc-start) best-length)))
    1674                (setf best-guess q
    1675                      best-length (- pc-end pc-start)))))
    1676         (when best-guess
    1677           (list :pc-range (cons (aref pc-source-map best-guess)
    1678                                 (aref pc-source-map (+ best-guess 1)))
    1679                 :source-text-range (cons (aref pc-source-map (+ best-guess 2))
    1680                                          (aref pc-source-map (+ best-guess 3)))
    1681                 :file-name (getf function-source-note :file-name)
    1682                 :text (getf function-source-note :text)))))))
    1683 
    16841658(defun nx1-form (form &optional (*nx-lexical-environment* *nx-lexical-environment*))
    16851659  (let* ((*nx-form-type* (if (and (consp form) (eq (car form) 'the))
     
    16971671
    16981672(defun nx1-transformed-form (form env &optional original)
    1699   (if *nx-current-code-note*
    1700     ;; It is possible for the form to be a source form when the original is not: macros
    1701     ;; often insert wrappings, e.g. (when (foo) (bar)) becomes (IF (foo) (PROGN (bar))),
    1702     ;; and (PROGN (bar)) transforms into (bar), which is a source form.
    1703     (let* ((new-note (nx-ensure-code-note form original *nx-current-code-note*))
    1704            (*nx-current-code-note* new-note))
    1705       (unless new-note
    1706         (compiler-bug "No source note for ~s -> ~s" original form))
     1673  (let* ((*nx-current-note* (or (nx-source-note form) *nx-current-note*))
     1674         (*nx-current-code-note*  (and *nx-current-code-note*
     1675                                       (or (nx-ensure-code-note form original *nx-current-code-note*)
     1676                                           (compiler-bug "No source note for ~s -> ~s" original form))))
     1677         (acode (if (consp form)
     1678                  (nx1-combination form env)
     1679                  (let* ((symbolp (non-nil-symbol-p form))
     1680                         (constant-value (unless symbolp form))
     1681                         (constant-symbol-p nil))
     1682                    (if symbolp
     1683                      (multiple-value-setq (constant-value constant-symbol-p)
     1684                        (nx-transform-defined-constant form env)))
     1685                    (if (and symbolp (not constant-symbol-p))
     1686                      (nx1-symbol form env)
     1687                      (nx1-immediate (nx-unquote constant-value)))))))
     1688    (when *record-pc-mapping*
     1689      (setf (acode-note acode) (nx-source-note form)))
     1690    (if *nx-current-code-note*
    17071691      (make-acode (%nx1-operator with-code-note)
    1708                   new-note
    1709                   (nx1-transformed-form-aux form env)))
    1710     (nx1-transformed-form-aux form env)))
    1711 
    1712 (defun nx1-transformed-form-aux (form env)
    1713   (flet ((main (form env)
    1714            (if (consp form)
    1715              (nx1-combination form env)
    1716              (let* ((symbolp (non-nil-symbol-p form))
    1717                     (constant-value (unless symbolp form))
    1718                     (constant-symbol-p nil))
    1719                (if symbolp
    1720                  (multiple-value-setq (constant-value constant-symbol-p)
    1721                    (nx-transform-defined-constant form env)))
    1722                (if (and symbolp (not constant-symbol-p))
    1723                  (nx1-symbol form env)
    1724                  (nx1-immediate (nx-unquote constant-value)))))))
    1725     (if *nx-source-note-map*
    1726       (let ((acode (main form env)))
    1727         (setf (acode-source acode) form)
    1728         acode)
    1729       (main form env))))
     1692                  *nx-current-code-note*
     1693                  acode)
     1694      acode)))
    17301695
    17311696(defun nx1-prefer-areg (form env)
     
    18531818
    18541819(defun nx1-whine (about &rest forms)
     1820  (if #-BOOTSTRAPPED (fboundp 'compiler-warning-source-note) #+BOOTSTRAPPED T
     1821    (push (make-condition (or (cdr (assq about *compiler-whining-conditions*)) 'compiler-warning)
     1822                          :function-name (list *nx-cur-func-name*)
     1823                          :source-note *nx-current-note*
     1824                          :warning-type about
     1825                          :args (or forms (list nil)))
     1826          *nx-warnings*)
     1827   
    18551828    (push (make-condition (or (cdr (assq about *compiler-whining-conditions*)) 'compiler-warning)
    18561829                          :function-name (list *nx-cur-func-name*)
    18571830                          :warning-type about
    18581831                          :args (or forms (list nil)))
    1859           *nx-warnings*)
     1832          *nx-warnings*))
    18601833  nil)
    18611834
  • branches/working-0711/ccl/compiler/nx1.lisp

    r11652 r11701  
    13551355      (:linuxppc32 (%nx1-operator eabi-ff-call))
    13561356      ((:darwinppc32 :linuxppc64 :darwinppc64) (%nx1-operator poweropen-ff-call))
    1357       ((:darwinx8632 :linuxx8632 :win32 :solarisx8632) (%nx1-operator i386-ff-call))
     1357      ((:darwinx8632 :linuxx8632 :win32 :solarisx8632 :freebsdx8632) (%nx1-operator i386-ff-call))
    13581358      ((:linuxx8664 :freebsdx8664 :darwinx8664 :solarisx8664 :win64) (%nx1-operator ff-call)))))
    13591359
     
    13831383         (vals ())
    13841384         (register-spec-seen nil)
    1385         (monitor (eq (car arg-specs-and-result-spec) :monitor-exception-ports))
     1385        (monitor (eq (car arg-specs-and-result-spec) :monitor-exception-ports))
    13861386         (arg-specs (butlast arg-specs-and-result-spec))
    13871387         (result-spec (car (last arg-specs-and-result-spec))))
     
    16571657                      (afunc-environment func) env)
    16581658                (push (list* funcname expansion def)
    1659                       bodies)))))
     1659                      bodies)))))
    16601660        (nx1-dynamic-extent-functions vars env)
    16611661        (dolist (def bodies)
  • branches/working-0711/ccl/compiler/nxenv.lisp

    r11164 r11701  
    165165     (struct-ref . 0)
    166166     (struct-set . 0)
    167      (%aref1 . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
     167     (%aref1 . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask))
    168168     (embedded-nlexit . 0)
    169169     (embedded-conditional . 0)
     
    304304     (builtin-call . 0)
    305305     (%setf-double-float . 0)
    306      (%double-float+-2 . 0)
    307      (%double-float--2 . 0)
    308      (%double-float*-2 . 0)
    309      (%double-float/-2 . 0)
     306     (%double-float+-2 . #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     307     (%double-float--2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     308     (%double-float*-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     309     (%double-float/-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    310310     (%double-float+-2! . 0)
    311311     (%double-float--2! . 0)
     
    316316     (%%ineg . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    317317     (%setf-short-float . 0)
    318      (%short-float+-2 . 0)
    319      (%short-float--2 . 0)
    320      (%short-float*-2 . 0)
    321      (%short-float/-2 . 0)
     318     (%short-float+-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     319     (%short-float--2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     320     (%short-float*-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     321     (%short-float/-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    322322     (short-float-compare . 0)
    323323     (eabi-ff-call . 0)
     
    565565    (if (%i> new 255) (setq new 255))
    566566    (setq bits (nx-set-var-bits var (%ilogior (%ilogand (%ilognot $vsetqmask) bits) (%ilsl 8 new))))
    567 ; If a variable is setq'ed from a catch nested within the construct that
    568 ; bound it, it can't be allocated to a register. *
    569 ; * unless it can be proved that the variable isn't referenced
    570 ;   after that catch construct has been exited. **
    571 ; ** or unless the saved value of the register in the catch frame
    572 ;    is also updated.
     567    ;; If a variable is setq'ed from a catch nested within the construct that
     568    ;; bound it, it can't be allocated to a register. *
     569    ;; * unless it can be proved that the variable isn't referenced
     570    ;;   after that catch construct has been exited. **
     571    ;; ** or unless the saved value of the register in the catch frame
     572    ;;    is also updated.
    573573    (when catchp
    574574      (nx-set-var-bits var (%ilogior2 bits (%ilsl $vbitnoreg 1))))
  • branches/working-0711/ccl/level-1/l1-error-system.lisp

    r11680 r11701  
    6666   (stream-position :initform nil :accessor compiler-warning-stream-position)
    6767   (function-name :initarg :function-name :initform nil :accessor compiler-warning-function-name)
     68   (source-note :initarg :source-note :initform nil :accessor compiler-warning-source-note)
    6869   (warning-type :initarg :warning-type :reader compiler-warning-warning-type)
    6970   (args :initarg :args :reader compiler-warning-args)
  • branches/working-0711/ccl/level-1/l1-init.lisp

    r11279 r11701  
    260260(defparameter *save-definitions* nil)
    261261(defparameter *save-local-symbols* t)
    262 (defvar *save-source-locations* nil
     262(defparameter *save-source-locations* nil
    263263  "Controls whether complete source locations is stored, both for definitions (names) and
    264264in function objects.
     
    269269
    270270If :NO-TEXT we don't store a copy of the original source text.")
     271(defparameter *record-pc-mapping* nil "True to record pc -> source mapping")
    271272
    272273(defvar *modules* nil
Note: See TracChangeset for help on using the changeset viewer.