source: trunk/source/compiler/nx.lisp @ 11373

Last change on this file since 11373 was 11373, checked in by gz, 11 years ago

Finish source location and pc -> source mapping support, from working-0711 but with some modifications.


Source location are recorded in CCL:SOURCE-NOTE's, which are objects with accessors CCL:SOURCE-NOTE-FILENAME, CCL:SOURCE-NOTE-START-POS, CCL:SOURCE-NOTE-END-POS and CCL:SOURCE-NOTE-TEXT. The start and end positions are file positions (not character positions). The text will be NIL unless text recording was on at read-time. If the original file is still available, you can force missing source text to be read from the file at runtime via CCL:ENSURE-SOURCE-NOTE-TEXT.

Source-note's are associated with definitions (via record-source-file) and also stored in function objects (including anonymous and nested functions). The former can be retrieved via CCL:FIND-DEFINITION-SOURCES, the latter via CCL:FUNCTION-SOURCE-NOTE.

The recording behavior is controlled by the new variable CCL:*SAVE-SOURCE-LOCATIONS*:

If NIL, don't store source-notes in function objects, and store only the filename for definitions (the latter only if *record-source-file* is true).
If T, store source-notes, including a copy of the original source text, for function objects and definitions (the latter only if *record-source-file* is true).
If :NO-TEXT, store source-notes, but without saved text, for function objects and defintions (the latter only if *record-source-file* is true). This is the default.

PC to source mapping is controlled by the new variable CCL:*RECORD-PC-MAPPING*. If true (the default), functions store a compressed table mapping pc offsets to corresponding source locations. This can be retrieved by (CCL:FIND-SOURCE-NOTE-AT-PC function pc) which returns a source-note for the source at offset pc in the function.

Currently the only thing that makes use of any of this is the disassembler. ILISP and current version of Slime still use backward-compatible functions that deal with filenames only. The plan is to make Slime, and our IDE, use this eventually.

Known bug: most of this only works through the file compiler. Still need to make it work with loading from source (not hard, just haven't gotten to it yet).

This checkin incidentally includes bits and pieces of support for code coverage, which is still
incomplete and untested. Ignore it.

The PPC version is untested. I need to check it in so I can move to a PPC for testing.


18387152 Nov 16 10:00 lx86cl64.image-no-loc-no-pc
19296464 Nov 16 10:11 lx86cl64.image-loc-no-text-no-pc
20517072 Nov 16 09:58 lx86cl64.image-loc-no-text-with-pc [default]
25514192 Nov 16 09:55 lx86cl64.image-loc-with-text-with-pc

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.3 KB
1;;;-*-Mode: LISP; Package: CCL -*-
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
14;;;   The LLGPL is also available online at
17(in-package "CCL")
19(eval-when (:compile-toplevel)
20  (require 'nxenv)
21  (require 'numbers)
22  (require 'sequences)
23  (require 'optimizers))
25(eval-when (:load-toplevel :execute :compile-toplevel)
26  (require 'numbers) ; just calls 'logcount' and 'integer-length'
27  (require 'sort)    ; just calls '%sort-list-no-keys'
28  (require 'hash))
30(%include "ccl:compiler;nx-basic.lisp")
32(eval-when (:load-toplevel :execute)
33  (require "DEFSTRUCT"))
35(defparameter *nx-start* (cons nil nil))
38(defvar *host-backend*)
39(defvar *target-backend*)
41(defun find-backend (name)
42  (find name *known-backends* :key #'backend-name))
44(eval-when (:load-toplevel :execute :compile-toplevel)
45  (require "DLL-NODE")
46  #+ppc-target
47  (require "PPC32-ARCH")
48  (require "VREG")
49  #+ppc-target
50  (require "PPC-ASM")
51  (require "VINSN")
52  (require "REG")
53  (require "SUBPRIMS")
54  #+ppc-target
55  (require "PPC-LAP")
57(%include "ccl:compiler;nx0.lisp")
58(%include "ccl:compiler;nx1.lisp")
60; put this in nx-basic too
61;(defvar *lisp-compiler-version* 666 "I lost count.")
63; At some point, COMPILE refused to compile things that were defined
64; in a non-null lexical environment (or so I remember.)   That seems
65; to have been broken when the change of 10/11/93 was made.
66; It makes no sense to talk about compiling something that was defined
67; in a lexical environment in which there are symbol or function bindings
68; present;  I'd thought that the old code checked for this, though it
69; may well have botched it.
70(defun compile (spec &optional def &aux (macro-p nil))
71  "Coerce DEFINITION (by default, the function whose name is NAME)
72  to a compiled function, returning (VALUES THING WARNINGS-P FAILURE-P),
73  where if NAME is NIL, THING is the result of compilation, and
74  otherwise THING is NAME. When NAME is not NIL, the compiled function
75  is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
76  (FDEFINITION NAME) otherwise."
77  (unless def
78    (setq def (fboundp spec))
79    (when (and (symbolp spec) (not (lfunp def)))
80      (setq def (setq macro-p (macro-function spec)))))
81  #+have-interpreted-functions
82  (when (typep def 'interpreted-function)
83    (let ((lambda (function-lambda-expression def)))
84      (when lambda (setq def lambda))))
85  (unless def
86    (nx-error "Can't find compilable definition for ~S." spec))
87  (multiple-value-bind (lfun warnings)
88                       (if (functionp def)
89                         def
90                         (compile-named-function def
91                                                 :name spec
92                                                 :keep-lambda *save-definitions*
93                                                 :keep-symbols *save-local-symbols*))
94    (let ((harsh nil) (some nil) (init t))
95      (dolist (w warnings)
96        (multiple-value-setq (harsh some) (signal-compiler-warning w init nil harsh some))
97        (setq init nil))
98      (values
99       (if spec
100         (progn
101           (if macro-p
102             (setf (macro-function spec) lfun)
103             (setf (fdefinition spec) lfun))
104           spec)
105         lfun)
106       some
107       harsh))))
109(defparameter *default-compiler-policy* (new-compiler-policy))
111(defun current-compiler-policy () *default-compiler-policy*)
113(defun set-current-compiler-policy (&optional new-policy)
114  (setq *default-compiler-policy* 
115        (if new-policy (require-type new-policy 'compiler-policy) (new-compiler-policy))))
118(defun xcompile-lambda (target def)
119  (let* ((*ppc2-debug-mask* (ash 1 ppc2-debug-vinsns-bit))
120         (backend (find-backend target))
121         (*target-ftd* (if backend
122                         (backend-target-foreign-type-data backend)
123                         *target-ftd*))
124         (*target-backend* (or backend *target-backend*)))
125    (multiple-value-bind (xlfun warnings)
126        (compile-named-function def :target target)
127      (signal-or-defer-warnings warnings nil)
128      (ppc-xdisassemble xlfun :target target)
129      xlfun)))
131(defun compile-user-function (def name &optional env)
132  (multiple-value-bind (lfun warnings)
133                       (compile-named-function def
134                                               :name name
135                                               :env env
136                                               :keep-lambda *save-definitions*
137                                               :keep-symbols *save-local-symbols*)
138    (signal-or-defer-warnings warnings env)
139    lfun))
141(defun signal-or-defer-warnings (warnings env)
142  (let* ((defenv (definition-environment env))
143         (init t)
144         (defer (and defenv (cdr (defenv.type defenv)) *outstanding-deferred-warnings*)))
145    (dolist (w warnings)
146      (if (and defer (typep w 'undefined-function-reference))
147        (push w (deferred-warnings.warnings defer))
148        (progn
149          (signal-compiler-warning w init nil nil nil)
150          (setq init nil))))))
152(defparameter *load-time-eval-token* nil)
154(defparameter *nx-discard-xref-info-hook* nil)
156(defun compile-named-function (def &key name env policy load-time-eval-token target
157                                function-note keep-lambda keep-symbols source-notes
158                                (record-pc-mapping *record-pc-mapping*)
159                                (compile-code-coverage *compile-code-coverage*))
160  ;; SOURCE-NOTES, if not nil, is a hash table mapping source forms to locations,
161  ;;   is used to produce and attach a pc/source map to the lfun, also to attach
162  ;;   source locations and pc/source maps to inner lfuns.
163  ;; FUNCTION-NOTE, if not nil, is a note to attach to the function as the lfun
164  ;;   source location in preference to whatever the source-notes table assigns to it.
165  (when (and name *nx-discard-xref-info-hook*)
166    (funcall *nx-discard-xref-info-hook* name))
167  (setq 
168   def
169   (let* ((*load-time-eval-token* load-time-eval-token)
170          (*nx-source-note-map* source-notes)
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                                       (make-code-note :form def :source-note function-note)))
178          (env (new-lexical-environment env)))
179     (setf (lexenv.variables env) 'barrier)
180     (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
181            (afunc (nx1-compile-lambda 
182                    name 
183                    def
184                    (make-afunc) 
185                    nil 
186                    env 
187                    (or policy *default-compiler-policy*)
188                    *load-time-eval-token*)))
189       (if (afunc-lfun afunc)
190         afunc
191         (funcall (backend-p2-compile *target-backend*)
192                  afunc
193                  ;; will also bind *nx-lexical-environment*
194                  (if keep-lambda (if (lambda-expression-p keep-lambda) keep-lambda def))
195                  keep-symbols)))))
196  (values (afunc-lfun def) (afunc-warnings def)))
198(defparameter *compiler-whining-conditions*
199  '((:undefined-function . undefined-function-reference)
200    (:global-mismatch . invalid-arguments-global)
201    (:lexical-mismatch . invalid-arguments)
202    (:environment-mismatch . invalid-arguments)
203    (:ignore . style-warning)
204    (:result-ignored . style-warning)
205    (:lambda . style-warning)
206    (:unused . style-warning)))
210(defun compiler-bug (format &rest args)
211  (error (make-condition 'compiler-bug
212                         :format-control format
213                         :format-arguments args)))
216(defparameter *nx-end* (cons nil nil))
217(provide 'nx)
Note: See TracBrowser for help on using the repository browser.