source: trunk/source/level-1/l1-boot-1.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.

Details:

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.

Sizes:

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: 3.6 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
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. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17;; L1-boot.lisp
18
19(in-package "CCL")
20
21(defparameter *gensym-counter* 0 "counter for generating unique GENSYM symbols")
22
23(defparameter *inhibit-greeting* nil)
24
25;the below 3 variables are expected to be redefined in the user's init file
26(defparameter *short-site-name* nil)
27(defparameter *long-site-name* nil)
28#|
29(defparameter *machine-instance* nil)
30|#
31
32(defun lisp-implementation-type ()
33  #+clozure-common-lisp "Clozure Common Lisp"
34  #-clozure-common-lisp "OpenMCL")
35
36
37(defparameter *platform-os-names*
38  `((,platform-os-vxworks . :vxwork)
39    (,platform-os-linux . :linux)
40    (,platform-os-solaris . :solaris)
41    (,platform-os-darwin . :darwin)
42    (,platform-os-freebsd . :freebsd)
43    (,platform-os-windows . :windows)))
44
45(defparameter *platform-cpu-names*
46  `((,platform-cpu-ppc . :ppc)
47    (,platform-cpu-sparc . :sparc)
48    (,platform-cpu-x86 . :x86)))
49
50(defun host-platform ()
51  (let* ((pf (%get-kernel-global 'host-platform)))
52    (values
53     (or (cdr (assoc (logand pf platform-os-mask)
54                     *platform-os-names*))
55         :unknown)
56     (if (logtest pf platform-word-size-mask)
57       64
58       32)
59     (or (cdr (assoc (logand pf platform-cpu-mask)
60                     *platform-cpu-names*))
61         :unknown))))
62
63
64(defun platform-description ()
65  (multiple-value-bind (os bits cpu) (host-platform)
66    (format nil "~a~a~d" (string-capitalize os) cpu bits)))
67
68(defun lisp-implementation-version ()
69  (%str-cat "Version " (format nil *openmcl-version* (platform-description))))
70
71
72
73
74(defun replace-base-translation (host-dir new-base-dir)
75  (let* ((host (pathname-host host-dir))
76         (device (pathname-device new-base-dir))
77         (host-dir (full-pathname host-dir))
78         (trans (logical-pathname-translations host))
79         (host-wild (merge-pathnames "**/*.*" host-dir)))
80    (setq host-dir (pathname-directory host-dir))
81    (setq new-base-dir (pathname-directory new-base-dir))
82    (setf 
83     (logical-pathname-translations host)
84     (mapcar
85      #'(lambda (pair)
86          (let ((rhs (cadr pair)))
87            (if (and (physical-pathname-p rhs)
88                     (pathname-match-p rhs host-wild))
89              (list (car pair)
90                    (merge-pathnames 
91                     (make-pathname 
92                      :defaults nil
93                      :device device
94                      :directory (append new-base-dir
95                                         (nthcdr (length host-dir) 
96                                                 (pathname-directory rhs))))
97                     rhs))
98              pair)))
99      trans))))
100
101(defun set-ccl-directory (path)
102  (replace-base-translation "ccl:" (translate-logical-pathname path)))
103
104
105
106
107; only do these if exist
108(defun init-logical-directories ()
109  (replace-base-translation "home:"  (user-homedir-pathname))
110  (replace-base-translation "ccl:" (ccl-directory)))
111
112(push #'init-logical-directories *lisp-system-pointer-functions*)
113
114
115(catch :toplevel
116  (setq *loading-file-source-file* nil)  ;Reset from last %fasload...
117  (setq *loading-toplevel-location* nil)
118  (init-logical-directories)
119  )
120
121
122
123
124
125
Note: See TracBrowser for help on using the repository browser.