Ignore:
Timestamp:
Feb 21, 2008, 10:05:23 PM (14 years ago)
Author:
mb
Message:

Merge in mb-coverage-merge branch. No other changes.

File:
1 edited

Legend:

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

    r8514 r8554  
    5555(defvar *nx1-fcells* nil)
    5656
    57 (defvar *nx1-operators* (make-hash-table :size 160 :test #'eq))
     57(defvar *nx1-operators* (make-hash-table :size 300 :test #'eq))
    5858
    5959                                         
     
    7878(defvar *nx-operators* ())
    7979(defvar *nx-warnings* nil)
     80(defvar *nx-current-code-note* nil)
     81
    8082
    8183(defvar *nx1-compiler-special-forms* nil "Real special forms")
     
    9193(defvar *cross-compiling* nil "bootstrapping")
    9294
    93 
     95(defvar *compile-code-coverage* nil "True to instrument for code coverage")
     96(defvar *record-pc-mapping* nil "True to record pc -> source mapping")
    9497
    9598(defparameter *nx-operator-result-types*
     
    12591262                                (%i+ (%i- boundtocount 1) varcount)))))))))
    12601263
    1261 (defvar *compiler-record-source* t
    1262   "When T we record source location for compiled forms.")
    1263 
    12641264(defvar *nx1-source-note-map* nil
    12651265  "Mapping between nx1-forms source locations.")
     
    12701270                                 parent-env
    12711271                                 (policy *default-compiler-policy*)
    1272                                  load-time-eval-token)
     1272                                 load-time-eval-token
     1273                                 code-note)
    12731274  (if q
    12741275     (setf (afunc-parent p) q))
     
    13031304                         (parse-body (%cddr lambda-form) *nx-lexical-environment* t)
    13041305      (setf (afunc-lambdaform p) lambda-form)
    1305       (setf (afunc-acode p) (nx1-lambda (%cadr lambda-form) body decls))
     1306      (setf (afunc-acode p) (nx1-lambda (%cadr lambda-form) body decls code-note))
    13061307      (nx1-transitively-punt-bindings *nx-punted-vars*)
    13071308      (setf (afunc-blocks p) *nx-blocks*)
     
    13241325       (consp (setq form (%cdr form)))       
    13251326       (eq (caar form) '&method)))
    1326          
    1327 
    1328 
    1329 
    1330 
    1331 
    1332 (defun nx1-lambda (ll body decls &aux (l ll) methvar)
    1333   (let ((old-env *nx-lexical-environment*)
    1334         (*nx-bound-vars* *nx-bound-vars*))
     1327
     1328
     1329(defun nx1-lambda (ll body decls &optional code-note &aux (l ll) methvar)
     1330  (when code-note
     1331    (setf (afunc-lfun-info *nx-current-function*)
     1332          (list* 'function-source-note code-note (afunc-lfun-info *nx-current-function*))))
     1333  (let* ((old-env *nx-lexical-environment*)
     1334         (*nx-bound-vars* *nx-bound-vars*)
     1335         (*nx-current-code-note* (and (or *compile-code-coverage* *record-pc-mapping*) code-note)))
     1336
    13351337    (with-nx-declarations (pending)
    13361338      (let* ((*nx-parsing-lambda-decls* t))
     
    13421344              (nx-error "invalid lambda-list  - ~s" l)))
    13431345          (return-from nx1-lambda
    1344                        (list
     1346                       (make-acode
    13451347                        (%nx1-operator lambda-list)
    13461348                        (list (cons '&lap bits))
     
    13901392         body
    13911393         *nx-new-p2decls*)))))
    1392  
     1394
    13931395(defun nx-parse-simple-lambda-list (pending ll &aux
    13941396                                              req
     
    15791581  "The stream we're reading code to be compiled from.")
    15801582
    1581 (defvar *compile-file-original-truename* nil)
    1582 
    1583 (defvar *compile-file-original-buffer-offset* nil)
    1584 
    15851583(defun substream (stream start end)
    15861584  "like subseq, but on streams that support file-position. Leaves stream positioned where it was
     
    16081606
    16091607(defun %fast-compact (string)
     1608  ;; mb: bootstrap
     1609  (when (typep string '(array (unsigned-byte 8)))
     1610    (return-from %fast-compact string))
    16101611  (let ((vec (make-array (length string) :element-type '(unsigned-byte 8))))
    16111612    (loop
     
    16271628
    16281629(defun record-source-location-on-stream-p (stream)
    1629   (and *compiler-record-source*
     1630  (and *fasl-save-source-locations*
    16301631       *fcomp-stream*
    16311632       (eq *fcomp-stream* stream)))
    1632 
    1633 (defstruct (source-note (:constructor %make-source-note))
    1634   file-name
    1635   start
    1636   end
    1637   %text
    1638   form
    1639   children)
    1640 
    1641 (defun make-source-note (&key stream start end %text form children)
    1642   (when (record-source-location-on-stream-p stream)
    1643     (%make-source-note :file-name (or *compile-file-original-truename*
    1644                                       (truename stream))
    1645                        :start (+ start (or *compile-file-original-buffer-offset* 0))
    1646                        :end (+ end (or *compile-file-original-buffer-offset* 0))
    1647                        :%text %text
    1648                        :form form
    1649                        :children children)))
    1650 
    1651 ;;; we don't actually store source-note structs in the fasl since that runs into problems dumping
    1652 ;;; the struct.
    1653 
    1654 (defun source-note-for-%lfun-info (note &key (start t) (end t) (text t) (form t) (children t) (file-name t))
    1655   (append (when start (list :start (source-note-start note)))
    1656           (when end   (list :end  (source-note-end   note)))
    1657           (when text  (list :%text (%fast-compact (source-note-%text  note))))
    1658           (when form  (list :form (source-note-form  note)))
    1659           (when children (list :children (source-note-children note)))
    1660           (when file-name (list :file-name (source-note-file-name note)))))
    16611633
    16621634(defvar *form-source-note-map* nil
     
    16761648                  (when (and note (not (gethash (source-note-form note) map)))
    16771649                    (setf (gethash (source-note-form note) map) note)
    1678                     (walk (source-note-children note))
    1679                     (setf (source-note-children note) '())))
     1650                    (walk (source-note-subform-notes note))
     1651                    (setf (source-note-subform-notes note) '())))
    16801652                 ((null note) '())
    16811653                 (t (error "Don't know how to deal with a source note like ~S."
     
    16841656    map))
    16851657
    1686 (defun compute-children-text (source-note stream source-note-map)
    1687   (when source-note
    1688     (unless (source-note-%text source-note)
    1689       (setf (source-note-%text source-note)
    1690             (substream stream (source-note-start source-note) (source-note-end source-note))))
    1691     (dolist (nested (source-note-children source-note))
    1692       (when nested
    1693         (unless (source-note-%text nested)
    1694           (setf (source-note-%text nested)
    1695                 (make-array (- (source-note-end nested) (source-note-start nested))
    1696                             :displaced-to (source-note-%text source-note)
    1697                             :displaced-index-offset (- (source-note-start nested)
    1698                                                        (source-note-start source-note)))))
    1699         (setf (gethash (source-note-form nested) source-note-map) nested)
    1700         (compute-children-text nested nil source-note-map))))
    1701   source-note)
    1702 
    17031658(defun nx1-source-note (nx1-code)
    17041659  "Return the source-note for the form which generated NX1-CODE."
    1705   (and *compiler-record-source*
     1660  (and *fasl-save-source-locations*
    17061661       *nx1-source-note-map*
    17071662       (gethash nx1-code *nx1-source-note-map*)))
    17081663
    17091664(defun form-source-note (source-form)
    1710   (and *compiler-record-source*
     1665  (and *fasl-save-source-locations*
    17111666       *form-source-note-map*
    17121667       (gethash source-form *form-source-note-map*)))
     
    17421697
    17431698(defun nx1-typed-form (original env)
    1744   (nx1-transformed-form (nx-transform original env) env))
    1745 
    1746 (defun nx1-transformed-form (form &optional (env *nx-lexical-environment*))
     1699  (nx1-transformed-form (nx-transform original env) env original))
     1700
     1701(defun nx1-transformed-form (form env &optional original)
     1702  (if *nx-current-code-note*
     1703    ;; It is possible for the form to be a source form when the original is not: macros
     1704    ;; often insert wrappings, e.g. (when (foo) (bar)) becomes (IF (foo) (PROGN (bar))),
     1705    ;; and (PROGN (bar)) transforms into (bar), which is a source form.
     1706    (let* ((new-note (nx-ensure-code-note form original *nx-current-code-note*))
     1707           (*nx-current-code-note* new-note))
     1708      (unless new-note
     1709        (compiler-bug "No source note for ~s -> ~s" original form))
     1710      (make-acode (%nx1-operator with-code-note)
     1711                  new-note
     1712                  (nx1-transformed-form-aux form env)))
     1713    (nx1-transformed-form-aux form env)))
     1714
     1715(defun nx1-transformed-form-aux (form env)
    17471716  (flet ((main ()
    17481717           (if (consp form)
     
    17571726                     (nx1-symbol form env)
    17581727                     (nx1-immediate (nx-unquote constant-value)))))))
    1759     (if *compiler-record-source*
     1728    (if *fasl-save-source-locations*
    17601729        (destructuring-bind (nx1-form . values)
    17611730            (multiple-value-list (main))
     
    21682137
    21692138(defun record-form-to-nx1-transformation (form nx1)
    2170   (when (and *compiler-record-source* (form-source-note form))
     2139  (when (and *fasl-save-source-locations* (form-source-note form))
    21712140    (setf (gethash nx1 *nx1-source-note-map*) (form-source-note form))))
    21722141
    21732142(defun record-nx1-source-equivalent (original new)
    2174   (when (and *compiler-record-source*
     2143  (when (and *fasl-save-source-locations*
    21752144             (nx1-source-note original)
    21762145             (not (nx1-source-note new)))
     
    21792148
    21802149(defun record-form-source-equivalent (original new)
    2181   (when (and *compiler-record-source*
     2150  (when (and *fasl-save-source-locations*
    21822151             (form-source-note original)
    21832152             (not (form-source-note new)))
     
    21862155
    21872156(defun nx-transform (form &optional (environment *nx-lexical-environment*))
    2188   (let* ((startform form) sym transforms lexdefs changed enabled macro-function compiler-macro)
     2157  (let* (sym transforms lexdefs changed enabled macro-function compiler-macro source)
     2158    (when (or (null *nx-source-note-map*) (gethash form *nx-source-note-map*))
     2159      (setq source t))
    21892160    (tagbody
    21902161       (go START)
    21912162     LOOP
     2163       (unless source (setq source (gethash form *nx-source-note-map*)))
    21922164       (setq changed t)
    21932165       (when (and (consp form)
     
    21992171         (multiple-value-bind (newform win) (nx-transform-symbol form environment)
    22002172           (unless win (go DONE))
    2201            (setq form newform
    2202                  changed (or changed win))
     2173           (setq form newform)
    22032174           (go LOOP)))
    22042175       (when (atom form) (go DONE))
     
    22092180           (if (constantp thing)
    22102181             (progn
    2211                (setq form thing form thing)
     2182               (setq form thing)
    22122183               (go LOOP))
    22132184             (multiple-value-bind (newform win) (nx-transform thing environment)
    22142185               (when win
     2186                 (unless source (setq source (gethash newform *nx-source-note-map*)))
    22152187                 (setq changed t)
    22162188                 (if (and (self-evaluating-p newform)
     
    22332205           (when (and enabled (functionp (fboundp sym)))
    22342206             (multiple-value-setq (form win) (nx-transform-arglist form environment))
    2235              (if win (setq changed t)))))
     2207             (when win
     2208               (unless source (setq source (gethash form *nx-source-note-map*)))
     2209               (setq changed t)))))
    22362210       (when (and enabled
    22372211                  (not (nx-declared-notinline-p sym environment)))
    22382212         (multiple-value-bind (value folded) (nx-constant-fold form environment)
    2239            (when folded (setq form value changed t)  (unless (and (consp form) (eq (car form) sym)) (go START))))
     2213           (when folded
     2214             (setq form value changed t)
     2215             (unless source (setq source (gethash form *nx-source-note-map*)))
     2216             (unless (and (consp form) (eq (car form) sym)) (go START))))
    22402217         (when compiler-macro
    22412218           (multiple-value-bind (newform win) (compiler-macroexpand-1 form environment)
     
    22542231                                      (and #-bccl (boundp '%structure-refs%)
    22552232                                           (gethash sym %structure-refs%))))
    2256              (setq form (defstruct-ref-transform transforms (%cdr form)) changed T)
     2233             (setq form (defstruct-ref-transform transforms (%cdr form)) changed t)
     2234             (unless source (setq source (gethash form *nx-source-note-map*)))
    22572235             (go START))
    22582236           (when (setq transforms (assq sym *nx-synonyms*))
     
    22642242         (nx-record-xref-info :macro-calls (function-name macro-function))
    22652243         (setq form (macroexpand-1 form environment) changed t)
     2244         (unless source (setq source (gethash form *nx-source-note-map*)))
    22662245         (go START))
    22672246     DONE)
    2268     (when (and changed *compiler-record-source*)
    2269       (record-form-source-equivalent startform form))
     2247    (when (and source (neq source t) (not (gethash form *nx-source-note-map*)))
     2248      ;; Neither the initial nor final form has source, but somewhere in the middle we encountered one.
     2249      (setf (gethash form *nx-source-note-map*) source))
    22702250    (values form changed)))
    22712251
Note: See TracChangeset for help on using the changeset viewer.