Skip to content
Closed
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
357 changes: 115 additions & 242 deletions sources/LLDISPLAY

Large diffs are not rendered by default.

520 changes: 258 additions & 262 deletions sources/LLDISPLAY.LCOM

Large diffs are not rendered by default.

78 changes: 52 additions & 26 deletions sources/LLPACKAGE
Original file line number Diff line number Diff line change
@@ -1,13 +1,14 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
(IL:FILECREATED "22-Sep-92 11:47:31" "{Pele:mv:envos}<LispCore>Sources>LLPACKAGE.;25" 82127
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)

IL:|changes| IL:|to:| (IL:FUNCTIONS IL:ADD-SYMBOL)
(IL:FILECREATED "24-Oct-2021 10:20:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;4| 82444

IL:|previous| IL:|date:| "20-May-91 13:07:32" "{Pele:mv:envos}<LispCore>Sources>LLPACKAGE.;24"
IL:|changes| IL:|to:| (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL IL:FIND-SYMBOL*)

IL:|previous| IL:|date:| "22-Sep-92 11:47:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;1|
)


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

(IL:PRETTYCOMPRINT IL:LLPACKAGECOMS)

Expand Down Expand Up @@ -524,9 +525,7 @@
PACKAGE)))
(IL:DEFINEQ

(xcl:defpackage
(il:nlambda il:args (il:* il:\; "Edited 2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package)))
)
(xcl:defpackage(il:nlambda il:args (il:* il:\; "Edited 2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package))))
)


Expand Down Expand Up @@ -1033,7 +1032,7 @@
(VALUES SYMBOL NIL)))))

(DEFUN IL:FIND-SYMBOL* (IL:BASE IL:OFFSET IL:LENGTH IL:FATP PACKAGE)
"Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list."
(IL:* IL:\; "Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list.")

(IL:* IL:|;;| "Find a symbol in the package given, if it eexists.")

Expand All @@ -1042,10 +1041,11 @@
(IL:RESULT (IL:\\CREATECELL IL:\\FIXP))
IL:SYM IL:WHERE (IL:DONE))
(UNLESS (%PACKAGE-EXTERNAL-ONLY PACKAGE)
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
IL:BASE IL:OFFSET IL:LENGTH IL:FATP
(%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
IL:RESULT))
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
IL:LENGTH IL:FATP (
%PACKAGE-INTERNAL-SYMBOLS
PACKAGE)
IL:RESULT))
(COND
((NOT (IL:IEQP IL:RESULT -1))
(IL:SETQ IL:WHERE :INTERNAL)
Expand All @@ -1061,10 +1061,11 @@
(IL:SETQ IL:WHERE :INTERNAL)
(IL:SETQ IL:DONE T)))))
(UNLESS IL:DONE
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
IL:BASE IL:OFFSET IL:LENGTH IL:FATP
(%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
IL:RESULT))
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
IL:LENGTH IL:FATP (
%PACKAGE-EXTERNAL-SYMBOLS
PACKAGE)
IL:RESULT))
(COND
((NOT (IL:IEQP IL:RESULT -1))
(IL:SETQ IL:WHERE :EXTERNAL)
Expand All @@ -1087,10 +1088,10 @@
(CDR IL:TABLE)))
((OR IL:DONE (NULL IL:TABLE))
(VALUES NIL NIL))
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
IL:BASE IL:OFFSET IL:LENGTH IL:FATP
(CAR IL:TABLE)
IL:RESULT))
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE
IL:OFFSET IL:LENGTH IL:FATP
(CAR IL:TABLE)
IL:RESULT))
(COND
((NOT (IL:IEQP IL:RESULT -1))
(UNLESS (EQ IL:PREV IL:HEAD)
Expand Down Expand Up @@ -1518,11 +1519,11 @@
(IL:EHASH (IL:ENTRY-HASH IL:LENGTH IL:HASH))
(IL:RESULT (IL:\\CREATECELL IL:\\FIXP))
IL:SYM)
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
IL:BASE IL:OFFSET IL:LENGTH IL:FATP (
(IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
IL:LENGTH IL:FATP (
%PACKAGE-EXTERNAL-SYMBOLS
PACKAGE)
IL:RESULT))
PACKAGE)
IL:RESULT))
(VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1))))
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL
Expand Down Expand Up @@ -1563,5 +1564,30 @@
)
(IL:PUTPROPS IL:LLPACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (25052 28345 (XCL:DEFPACKAGE 25065 . 28343)))))
(IL:FILEMAP (NIL (9779 10219 (IL:\\UPCASEBASE 9779 . 10219)) (10221 11342 (IL:APROPOS-SEARCH 10221 .
11342)) (12882 12964 (PACKAGE-NAME 12882 . 12964)) (12966 13058 (PACKAGE-NICKNAMES 12966 . 13058)) (
13060 13168 (PACKAGE-SHADOWING-SYMBOLS 13060 . 13168)) (13170 13260 (PACKAGE-USE-LIST 13170 . 13260))
(13262 13360 (PACKAGE-USED-BY-LIST 13262 . 13360)) (13362 14517 (IL:MAKE-PACKAGE-HASHTABLE 13362 .
14517)) (14519 14681 (PRINT-PACKAGE 14519 . 14681)) (14683 15074 (PRINT-PACKAGE-HASHTABLE 14683 .
15074)) (16142 16923 (MAKE-SYMBOL 16142 . 16923)) (18034 18444 (IL:\\PKG-FIND-FREE-PACKAGE-INDEX 18034
. 18444)) (18501 18647 (IL:SETF-SYMBOL-PACKAGE 18501 . 18647)) (18649 18741 (SYMBOL-PACKAGE 18649 .
18741)) (21512 21684 (IL:INTERNAL-SYMBOL-COUNT 21512 . 21684)) (21686 21804 (IL:EXTERNAL-SYMBOL-COUNT
21686 . 21804)) (21806 22962 (IL:ENTER-NEW-NICKNAMES 21806 . 22962)) (22964 23390 (
IL:MAKE-PRIME-HASHTABLE-SIZE 22964 . 23390)) (23392 25061 (MAKE-PACKAGE 23392 . 25061)) (25062 28355 (
XCL:DEFPACKAGE 25075 . 28353)) (28404 28626 (FIND-PACKAGE 28404 . 28626)) (28628 31966 (USE-PACKAGE
28628 . 31966)) (31968 32448 (IN-PACKAGE 31968 . 32448)) (32450 32724 (XCL:PKG-GOTO 32450 . 32724)) (
32726 33826 (RENAME-PACKAGE 32726 . 33826)) (33828 35279 (XCL:DELETE-PACKAGE 33828 . 35279)) (35281
38227 (EXPORT 35281 . 38227)) (38229 39472 (UNEXPORT 38229 . 39472)) (39474 41118 (IMPORT 39474 .
41118)) (41120 42398 (SHADOWING-IMPORT 41120 . 42398)) (42400 43454 (SHADOW 42400 . 43454)) (43456
44111 (UNUSE-PACKAGE 43456 . 44111)) (44175 44481 (LIST-ALL-PACKAGES 44175 . 44481)) (44538 48313 (
IL:ADD-SYMBOL 44538 . 48313)) (52637 53940 (IL:INTERN* 52637 . 53940)) (53942 59790 (IL:FIND-SYMBOL*
53942 . 59790)) (59792 61243 (INTERN 59792 . 61243)) (61245 61823 (FIND-SYMBOL 61245 . 61823)) (61881
62781 (IL:NUKE-SYMBOL 61881 . 62781)) (62783 64903 (UNINTERN 62783 . 64903)) (64905 66048 (
IL:MOBY-UNINTERN 64905 . 66048)) (66107 66179 (IL:\\INDEXATOMPNAME 66107 . 66179)) (66291 66438 (
IL:MAKE-DO-SYMBOLS-VARS 66291 . 66438)) (66440 67895 (IL:MAKE-DO-SYMBOLS-CODE 66440 . 67895)) (75495
76020 (FIND-ALL-SYMBOLS 75495 . 76020)) (76022 76301 (IL:BRIEFLY-DESCRIBE-SYMBOL 76022 . 76301)) (
76303 77817 (APROPOS 76303 . 77817)) (77819 79476 (APROPOS-LIST 77819 . 79476)) (79580 81153 (
IL:FIND-EXTERNAL-SYMBOL 79580 . 81153)) (81155 81675 (IL:FIND-EXACT-SYMBOL 81155 . 81675)) (81677
81757 (IL:PACKAGE-NAME-AS-SYMBOL 81677 . 81757)) (81759 81908 (IL:\\FIND.PACKAGE.INTERNAL 81759 .
81908)))))
IL:STOP
Expand Down
Binary file modified sources/LLPACKAGE.LCOM
Binary file not shown.
Loading