Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 24 additions & 22 deletions sources/LLSYMBOL
Original file line number Diff line number Diff line change
@@ -1,13 +1,11 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
(IL:FILECREATED "11-Jun-90 17:56:50" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>LLSYMBOL.;5| 9443
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)

IL:|changes| IL:|to:| (IL:VARS IL:LLSYMBOLCOMS)
(IL:FILECREATED "31-Oct-2023 16:16:39" IL:|{WMEDLEY}<sources>LLSYMBOL.;2| 9255

IL:|previous| IL:|date:| " 4-Jun-90 15:10:38" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>LLSYMBOL.;4|
)
:EDIT-BY IL:|rmk|

:PREVIOUS-DATE "11-Jun-90 17:56:50" IL:|{WMEDLEY}<sources>LLSYMBOL.;1|)

; Copyright (c) 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.

(IL:PRETTYCOMPRINT IL:LLSYMBOLCOMS)

Expand Down Expand Up @@ -86,7 +84,7 @@

(IL:* IL:|;;| "Look on the property list of SYMBOL for the specified INDICATOR. If this is found, return the associated value, else return DEFAULT.")

(GETF (IL:GETPROPLIST SYMBOL)
(GETF (IL:GETPROPLIST SYMBOL)
INDICATOR DEFAULT))

(DEFUN GETF (PLACE INDICATOR &OPTIONAL (DEFAULT NIL))
Expand Down Expand Up @@ -129,7 +127,7 @@

(IL:* IL:|;;| "Has lots of special knowledge of prop list names")

(SETF (SYMBOL-FUNCTION SYMBOL)
(SETF (SYMBOL-FUNCTION SYMBOL)
NIL)
(SETF (MACRO-FUNCTION SYMBOL)
NIL)
Expand All @@ -145,10 +143,10 @@
(COND
(DEF) (IL:* IL:\; "GETD returned non-NIL")
((SETQ DEF (MACRO-FUNCTION SYMBOL)) (IL:* IL:\;
 "Return something representing the macro's implementation.")
 "Return something representing the macro's implementation.")
(CONS ':MACRO DEF))
((SETQ DEF (SPECIAL-FORM-P SYMBOL)) (IL:* IL:\;
 "Return something representing the special-form's implementation.")
 "Return something representing the special-form's implementation.")
(CONS ':SPECIAL-FORM DEF))
(T (ERROR 'XCL:UNDEFINED-FUNCTION :NAME SYMBOL))))

Expand All @@ -167,7 +165,7 @@
(CASE (CAR DEFINITION)
(:MACRO (SETF (MACRO-FUNCTION SYMBOL)
(CDR DEFINITION)))
(:SPECIAL-FORM (SETF (GET SYMBOL 'IL:SPECIAL-FORM)
(:SPECIAL-FORM (SETF (GET SYMBOL 'IL:SPECIAL-FORM)
(CDR DEFINITION)))
(T (IL:PUTD SYMBOL DEFINITION T))))

Expand Down Expand Up @@ -211,35 +209,35 @@
(SETQ *GENSYM-COUNTER* (1+ *GENSYM-COUNTER*))))

(DEFUN GENTEMP (&OPTIONAL (PREFIX "T")
(PACKAGE *PACKAGE*))
(PACKAGE *PACKAGE*))

(IL:* IL:|;;| "*gentemp-counter* holds a good guess for the suffix ")

(LET ((COUNTER *GENTEMP-COUNTER*)
NAMESTRING) (IL:* IL:\;
 "Use IL:MKSTRING rather than princ-to-string, since princ-to-string occurs late in the loadup")
 "Use IL:MKSTRING rather than princ-to-string, since princ-to-string occurs late in the loadup")
(LOOP (SETQ NAMESTRING (CONCATENATE 'STRING PREFIX (IL:MKSTRING COUNTER)))
(WHEN (NULL (FIND-SYMBOL NAMESTRING PACKAGE))
(SETQ *GENTEMP-COUNTER* (1+ COUNTER))
(RETURN (INTERN NAMESTRING PACKAGE)))
(SETQ COUNTER (1+ COUNTER)))))

(DEFUN COPY-SYMBOL (SYM &OPTIONAL COPY-PROPS)
(LET ((NEW-SYM (MAKE-SYMBOL (SYMBOL-NAME SYM))))
(LET ((NEW-SYM (MAKE-SYMBOL (SYMBOL-NAME SYM))))
(WHEN COPY-PROPS
(IF (BOUNDP SYM)
(SETF (SYMBOL-VALUE NEW-SYM)
(SYMBOL-VALUE SYM)))
(IF (FBOUNDP SYM)
(SETF (SYMBOL-FUNCTION NEW-SYM)
(SYMBOL-FUNCTION SYM)))
(SETF (SYMBOL-VALUE NEW-SYM)
(SYMBOL-VALUE SYM)))
(IF (FBOUNDP SYM)
(SETF (SYMBOL-FUNCTION NEW-SYM)
(SYMBOL-FUNCTION SYM)))
(SETF (SYMBOL-PLIST NEW-SYM)
(COPY-LIST (SYMBOL-PLIST SYM))))
NEW-SYM))

(DEFUN IL:MAKE-KEYWORD (SYMBOL)
(DECLARE (SPECIAL IL:*KEYWORD-PACKAGE*))
(VALUES (INTERN (SYMBOL-NAME SYMBOL)
(VALUES (INTERN (SYMBOL-NAME SYMBOL)
IL:*KEYWORD-PACKAGE*)))

(DEFUN KEYWORDP (OBJECT)
Expand All @@ -250,7 +248,11 @@
(IL:PUTPROPS IL:LLSYMBOL IL:FILETYPE COMPILE-FILE)

(IL:PUTPROPS IL:LLSYMBOL IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP"))
(IL:PUTPROPS IL:LLSYMBOL IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL)))
(IL:FILEMAP (NIL (1606 1904 (MAKUNBOUND 1606 . 1904)) (1906 2423 (SYMBOL-NAME 1906 . 2423)) (2425 2741
(SYMBOL-VALUE 2425 . 2741)) (2743 3025 (GET 2743 . 3025)) (3027 3534 (GETF 3027 . 3534)) (3536 3958 (
GET-PROPERTIES 3536 . 3958)) (4065 4214 (FBOUNDP 4065 . 4214)) (4216 4527 (FMAKUNBOUND 4216 . 4527)) (
4529 5514 (SYMBOL-FUNCTION 4529 . 5514)) (5516 7128 (IL:SETF-SYMBOL-FUNCTION 5516 . 7128)) (7268 7582
(GENSYM 7268 . 7582)) (7584 8271 (GENTEMP 7584 . 8271)) (8273 8774 (COPY-SYMBOL 8273 . 8774)) (8776
8945 (IL:MAKE-KEYWORD 8776 . 8945)) (8947 9072 (KEYWORDP 8947 . 9072)))))
IL:STOP
Binary file modified sources/LLSYMBOL.LCOM
Binary file not shown.