[Openmcl-cvs-notifications] r12327 - in /trunk/source: compiler/X86/x862.lisp level-1/l1-init.lisp lib/nfcomp.lisp lib/source-files.lisp lib/xref.lisp
gz at clozure.com
gz at clozure.com
Mon Jun 29 14:28:28 EDT 2009
Author: gz
Date: Mon Jun 29 14:28:27 2009
New Revision: 12327
Log:
Indentation, doc string changes, move *direct-methods-only* from xref to so=
urce-files, which is the only place it's used
Modified:
trunk/source/compiler/X86/x862.lisp
trunk/source/level-1/l1-init.lisp
trunk/source/lib/nfcomp.lisp
trunk/source/lib/source-files.lisp
trunk/source/lib/xref.lisp
Modified: trunk/source/compiler/X86/x862.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x862.lisp (original)
+++ trunk/source/compiler/X86/x862.lisp Mon Jun 29 14:28:27 2009
@@ -8945,43 +8945,43 @@
(eq typespec '*))
(x862-form seg vreg xfer form)
(with-note (form seg)
- (let* ((ok (backend-get-next-label)))
- (if (and (symbolp typespec) (non-nil-symbolp (type-predicate t=
ypespec)))
- ;; Do this so can compile the lisp with typechecking even th=
ough typep
- ;; doesn't get defined til fairly late.
- (progn
- (x862-one-targeted-reg-form seg form ($ *x862-arg-z*))
- (x862-store-immediate seg (type-predicate typespec) ($ *x8=
62-fname*))
- (x862-set-nargs seg 1)
- (x862-vpush-register seg ($ *x862-arg-z*)))
- (progn
- (x862-one-targeted-reg-form seg form ($ *x862-arg-y*))
+ (let* ((ok (backend-get-next-label)))
+ (if (and (symbolp typespec) (non-nil-symbolp (type-predicate=
typespec)))
+ ;; Do this so can compile the lisp with typechecking even =
though typep
+ ;; doesn't get defined til fairly late.
+ (progn
+ (x862-one-targeted-reg-form seg form ($ *x862-arg-z*))
+ (x862-store-immediate seg (type-predicate typespec) ($ *=
x862-fname*))
+ (x862-set-nargs seg 1)
+ (x862-vpush-register seg ($ *x862-arg-z*)))
+ (progn
+ (x862-one-targeted-reg-form seg form ($ *x862-arg-y*))
+ (x862-store-immediate seg typespec ($ *x862-arg-z*))
+ (x862-store-immediate seg 'typep ($ *x862-fname*))
+ (x862-set-nargs seg 2)
+ (x862-vpush-register seg ($ *x862-arg-y*))))
+ (! call-known-symbol ($ *x862-arg-z*))
+ (! compare-to-nil ($ *x862-arg-z*))
+ (x862-vpop-register seg ($ *x862-arg-y*))
+ (! cbranch-false (aref *backend-labels* ok) x86::x86-e-bits)
+ (target-arch-case
+ (:x8632
+ (let* ((*x862-vstack* *x862-vstack*)
+ (*x862-top-vstack-lcell* *x862-top-vstack-lcell*))
+ (! reserve-outgoing-frame)
+ (incf *x862-vstack* (* 2 *x862-target-node-size*))
+ (! vpush-fixnum (ash $XWRONGTYPE *x862-target-fixnum-shi=
ft*))
+ (x862-store-immediate seg typespec ($ *x862-arg-z*))
+ (x862-set-nargs seg 3)
+ (! ksignalerr)))
+ (:x8664
+ (x862-lri seg ($ x8664::arg_x) (ash $XWRONGTYPE *x862-targ=
et-fixnum-shift*))
(x862-store-immediate seg typespec ($ *x862-arg-z*))
- (x862-store-immediate seg 'typep ($ *x862-fname*))
- (x862-set-nargs seg 2)
- (x862-vpush-register seg ($ *x862-arg-y*))))
- (! call-known-symbol ($ *x862-arg-z*))
- (! compare-to-nil ($ *x862-arg-z*))
- (x862-vpop-register seg ($ *x862-arg-y*))
- (! cbranch-false (aref *backend-labels* ok) x86::x86-e-bits)
- (target-arch-case
- (:x8632
- (let* ((*x862-vstack* *x862-vstack*)
- (*x862-top-vstack-lcell* *x862-top-vstack-lcell*))
- (! reserve-outgoing-frame)
- (incf *x862-vstack* (* 2 *x862-target-node-size*))
- (! vpush-fixnum (ash $XWRONGTYPE *x862-target-fixnum-shift*))
- (x862-store-immediate seg typespec ($ *x862-arg-z*))
- (x862-set-nargs seg 3)
- (! ksignalerr)))
- (:x8664
- (x862-lri seg ($ x8664::arg_x) (ash $XWRONGTYPE *x862-target-fixnum=
-shift*))
- (x862-store-immediate seg typespec ($ *x862-arg-z*))
- (x862-set-nargs seg 3)
- (! ksignalerr)))
- (@ ok)
- (<- ($ *x862-arg-y*))
- (^))))))))
+ (x862-set-nargs seg 3)
+ (! ksignalerr)))
+ (@ ok)
+ (<- ($ *x862-arg-y*))
+ (^))))))))
=
=
=
Modified: trunk/source/level-1/l1-init.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-init.lisp (original)
+++ trunk/source/level-1/l1-init.lisp Mon Jun 29 14:28:27 2009
@@ -269,7 +269,9 @@
If T we store as much source location information as we have available.
=
If :NO-TEXT we don't store a copy of the original source text.")
-(defparameter *record-pc-mapping* t)
+
+(defparameter *record-pc-mapping* t "True to record pc -> source mapping (=
but only if
+*save-source-locations* is also true)")
=
(defvar *modules* nil
"This is a list of module names that have been loaded into Lisp so far.
Modified: trunk/source/lib/nfcomp.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/nfcomp.lisp (original)
+++ trunk/source/lib/nfcomp.lisp Mon Jun 29 14:28:27 2009
@@ -195,30 +195,30 @@
output-file (pathname-type
(backend-target-fasl-pathname
*target-backend*))))
- (let* ((*features* (append (if (listp features) features (list featu=
res)) (setup-target-features target-backend *features*)))
- (*fasl-deferred-warnings* nil) ; !!! WITH-COMPILATION-UNIT ...
- (*fasl-save-local-symbols* save-local-symbols)
- (*save-source-locations* save-source-locations)
- (*fasl-save-doc-strings* save-doc-strings)
- (*fasl-save-definitions* save-definitions)
- (*fasl-break-on-program-errors* break-on-program-errors)
- (*fcomp-warnings-header* nil)
- (*compile-file-pathname* orig-src)
- (*compile-file-truename* (truename src))
- (*package* *package*)
- (*readtable* *readtable*)
- (*compile-print* print)
- (*compile-verbose* verbose)
- (*fasl-target* (backend-name target-backend))
- (*fasl-backend* target-backend)
- (*fasl-target-big-endian* (arch::target-big-endian
- (backend-target-arch target-backen=
d)))
- (*target-ftd* (backend-target-foreign-type-data target-backend))
- (defenv (new-definition-environment))
- (lexenv (new-lexical-environment defenv))
- (*fasl-compile-time-env* (new-lexical-environment (new-defini=
tion-environment)))
- (*fcomp-external-format* external-format)
- (forms nil))
+ (let* ((*features* (append (if (listp features) features (list feature=
s)) (setup-target-features target-backend *features*)))
+ (*fasl-deferred-warnings* nil) ; !!! WITH-COMPILATION-UNIT ...
+ (*fasl-save-local-symbols* save-local-symbols)
+ (*save-source-locations* save-source-locations)
+ (*fasl-save-doc-strings* save-doc-strings)
+ (*fasl-save-definitions* save-definitions)
+ (*fasl-break-on-program-errors* break-on-program-errors)
+ (*fcomp-warnings-header* nil)
+ (*compile-file-pathname* orig-src)
+ (*compile-file-truename* (truename src))
+ (*package* *package*)
+ (*readtable* *readtable*)
+ (*compile-print* print)
+ (*compile-verbose* verbose)
+ (*fasl-target* (backend-name target-backend))
+ (*fasl-backend* target-backend)
+ (*fasl-target-big-endian* (arch::target-big-endian
+ (backend-target-arch target-backend)=
))
+ (*target-ftd* (backend-target-foreign-type-data target-backend))
+ (defenv (new-definition-environment))
+ (lexenv (new-lexical-environment defenv))
+ (*fasl-compile-time-env* (new-lexical-environment (new-definiti=
on-environment)))
+ (*fcomp-external-format* external-format)
+ (forms nil))
(let ((current *outstanding-deferred-warnings*) last)
(when (and current
(setq last (deferred-warnings.last-file current))
@@ -965,12 +965,12 @@
(defun fcomp-function-arg (expr env)
(when (consp expr)
(multiple-value-bind (lambda-expr name win)
- (cond ((and (eq (%car expr) 'nfunction)
- (lambda-expression-p (cadr (%cdr expr))))
- (values (%caddr expr) (%cadr expr) t))
- ((and (eq (%car expr) 'function)
- (lambda-expression-p (car (%cdr expr))))
- (values (%cadr expr) nil t)))
+ (cond ((and (eq (%car expr) 'nfunction)
+ (lambda-expression-p (cadr (%cdr expr))))
+ (values (%caddr expr) (%cadr expr) t))
+ ((and (eq (%car expr) 'function)
+ (lambda-expression-p (car (%cdr expr))))
+ (values (%cadr expr) nil t)))
(when win
(fcomp-named-function lambda-expr name env
(or (fcomp-source-note expr)
Modified: trunk/source/lib/source-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/source-files.lisp (original)
+++ trunk/source/lib/source-files.lisp Mon Jun 29 14:28:27 2009
@@ -46,6 +46,12 @@
(defvar %source-files% (make-hash-table :test #'eq
:size 13000
:rehash-threshold .95))
+
+
+(defvar *direct-methods-only* nil
+ "If true, method name source location lookup will find direct methods on=
ly. If false,
+ include all applicable methods")
+
=
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;=
;;;;;;;;;;;;;;;;;;;;
;;
Modified: trunk/source/lib/xref.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/xref.lisp (original)
+++ trunk/source/lib/xref.lisp Mon Jun 29 14:28:27 2009
@@ -257,9 +257,6 @@
,@(xref-entry-method-qualifiers entry)
,(xref-entry-method-specializers entry))
(xref-entry-name entry)))
-
-;; edit-definition-p needs this - what is it for?
-(defvar *direct-methods-only* nil)
=
;; %SOURCE-FILE-FOR-XREF-ENTRY -- internal
;;
More information about the Openmcl-cvs-notifications
mailing list