/[cmucl]/src/bootfiles/18e/boot25.lisp
ViewVC logotype

Contents of /src/bootfiles/18e/boot25.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu May 6 14:36:46 2004 UTC (9 years, 11 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, double-double-array-base, post-merge-intl-branch, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, snapshot-2004-10, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, snapshot-2007-01, snapshot-2007-02, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, GIT-CONVERSION, double-double-init-ppc, release-19c, unicode-utf16-sync-2008-12, release-19c-base, cross-sol-x86-merged, label-2009-03-16, release-19f-base, merge-sse2-packed, merge-with-19f, snapshot-2004-12, snapshot-2004-11, intl-branch-working-2010-02-11-1000, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, RELEASE_20b, snapshot-2008-04, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, cross-sol-x86-2010-12-20, double-double-init-x86, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, snapshot-2005-11, double-double-sparc-checkpoint-1, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, cross-sparc-branch-base, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, HEAD
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, RELEASE-19F-BRANCH, portable-clx-branch, cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.1: +77 -0 lines
Merge in the 19a changes containing Helmut Eller's implementation for
source location for defvar and friends.
1
2 (setf lisp::*enable-package-locked-errors* nil)
3 (in-package :c)
4
5 ;;; Used to record the source-location of definitions.
6 ;;;
7 (define-info-class source-location)
8 (define-info-type source-location defvar (or form-numbers null) nil)
9
10
11 (in-package :lisp)
12 ;;; DEFCONSTANT -- Public
13 ;;;
14 (defmacro defconstant (var val &optional doc)
15 "For defining global constants at top level. The DEFCONSTANT says that the
16 value is constant and may be compiled into code. If the variable already has
17 a value, and this is not equal to the init, an error is signalled. The third
18 argument is an optional documentation string for the variable."
19 `(progn
20 (eval-when (:compile-toplevel)
21 (c::do-defconstant-compile-time ',var ,val ',doc))
22 (eval-when (:load-toplevel :execute)
23 (c::%%defconstant ',var ,val ',doc (c::source-location)))))
24
25 (defun set-defvar-source-location (name source-location)
26 (setf (info :source-location :defvar name) source-location))
27
28 ;;; %Defconstant, %%Defconstant -- Internal
29 ;;;
30 ;;; Like the other %mumbles except that we currently actually do something
31 ;;; interesting at load time, namely checking if the constant is being
32 ;;; redefined.
33 ;;;
34 (defun c::%defconstant (name value doc)
35 (c::%%defconstant name value doc nil))
36 ;;;
37 (defun c::%%defconstant (name value doc source-location)
38 (when doc
39 (setf (documentation name 'variable) doc))
40 (when (boundp name)
41 (unless (equalp (symbol-value name) value)
42 (cerror "Go ahead and change the value."
43 "Constant ~S being redefined." name)))
44 (setf (symbol-value name) value)
45 (setf (info variable kind name) :constant)
46 (clear-info variable constant-value name)
47 (set-defvar-source-location name source-location)
48 name)
49
50
51 (defmacro defvar (var &optional (val nil valp) (doc nil docp))
52 "For defining global variables at top level. Declares the variable
53 SPECIAL and, optionally, initializes it. If the variable already has a
54 value, the old value is not clobbered. The third argument is an optional
55 documentation string for the variable."
56 `(progn
57 (declaim (special ,var))
58 ,@(when valp
59 `((unless (boundp ',var)
60 (setq ,var ,val))))
61 ,@(when docp
62 `((setf (documentation ',var 'variable) ',doc)))
63 (set-defvar-source-location ',var (c::source-location))
64 ',var))
65
66 (defmacro defparameter (var val &optional (doc nil docp))
67 "Defines a parameter that is not normally changed by the program,
68 but that may be changed without causing an error. Declares the
69 variable special and sets its value to VAL. The third argument is
70 an optional documentation string for the parameter."
71 `(progn
72 (declaim (special ,var))
73 (setq ,var ,val)
74 ,@(when docp
75 `((setf (documentation ',var 'variable) ',doc)))
76 (set-defvar-source-location ',var (c::source-location))
77 ',var))

  ViewVC Help
Powered by ViewVC 1.1.5