Compare commits
11 Commits
medley-240
...
medley-241
| Author | SHA1 | Date | |
|---|---|---|---|
|
fe04869cb3 | ||
|
178807afff | ||
|
|
e1989850f3 | ||
|
|
fface7d9de | ||
|
|
b41ae0cbbe | ||
|
|
548d3f1567 | ||
|
|
a85d6287ae | ||
|
|
719b4e744e | ||
|
|
387fecf475 | ||
|
|
3526a61be1 | ||
|
|
115ba43100 |
219
lispusers/READ-BDF
Normal file
219
lispusers/READ-BDF
Normal file
@@ -0,0 +1,219 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" ( USE "XCL" "LISP") ( EXPORT "READ-BDF")) READTABLE
|
||||
"XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED "23-Sep-2024 12:38:25" IL:{LU}READ-BDF.\;2 12260
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:FUNCTIONS READ-BDF READ-GLYPH)
|
||||
|
||||
:PREVIOUS-DATE "22-Aug-2024 20:54:00" IL:{LU}READ-BDF.\;1)
|
||||
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:READ-BDFCOMS)
|
||||
|
||||
(IL:RPAQQ IL:READ-BDFCOMS ((IL:STRUCTURES BDF-FONT GLYPH)
|
||||
(IL:FUNCTIONS READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH)
|
||||
(FILE-ENVIRONMENTS "READ-BDF")))
|
||||
|
||||
(DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-"))
|
||||
(NAME NIL :TYPE STRING)
|
||||
(SIZE NIL :TYPE LIST)
|
||||
(BOUNDINGBOX NIL :TYPE LIST)
|
||||
(METRICSSET 0 :TYPE (INTEGER 0 2))
|
||||
(PROPERTIES NIL :TYPE LIST)
|
||||
SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST))
|
||||
|
||||
(DEFSTRUCT GLYPH
|
||||
(NAME NIL :TYPE STRING)
|
||||
ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP)
|
||||
|
||||
(DEFUN READ-BDF (PATH) (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth")
|
||||
(IL:* IL:\; "Edited 22-Aug-2024 16:43 by mth")
|
||||
(IL:* IL:\; "Edited 17-Jul-2024 14:45 by mth")
|
||||
(IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth")
|
||||
(LET
|
||||
(PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS (NGLYPHS 0)
|
||||
(*PACKAGE* (FIND-PACKAGE "BDF")))
|
||||
(WITH-OPEN-FILE
|
||||
(FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT)
|
||||
(UNLESS (STRING-EQUAL "STARTFONT" (READ FILE-STREAM))
|
||||
(ERROR "Invalid BDF file - must begin with STARTFONT."))
|
||||
|
||||
(IL:* IL:|;;| "ignore the file format version number")
|
||||
|
||||
(READ-LINE FILE-STREAM)
|
||||
(SETQ FONT (MAKE-BDF-FONT))
|
||||
(LOOP
|
||||
:UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
|
||||
(WHEN LINE (IL:* IL:\; "Ignore blank lines")
|
||||
(MULTIPLE-VALUE-SETQ (KEY POS)
|
||||
(READ-FROM-STRING LINE))
|
||||
(UNLESS (MEMBER KEY '(COMMENT CONTENTVERSION))
|
||||
(WHEN (<= POS (LENGTH LINE))
|
||||
(SETQ LINE (SUBSEQ LINE POS)))
|
||||
(SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE))
|
||||
(CASE KEY
|
||||
(FONT (SETF (BF-NAME FONT)
|
||||
LINE))
|
||||
(METRICSSET (IF (AND (INTEGERP (SETQ V (FIRST ITEMS)))
|
||||
(<= 0 V 2))
|
||||
(SETF (BF-METRICSSET FONT)
|
||||
V)
|
||||
(ERROR
|
||||
"Invalid BDF file - METRICSSET (~A) is invalid or out of range."
|
||||
V)))
|
||||
(SIZE (SETF (BF-SIZE FONT)
|
||||
ITEMS))
|
||||
(FONTBOUNDINGBOX (SETF (BF-BOUNDINGBOX FONT)
|
||||
ITEMS))
|
||||
(SWIDTH (SETF (BF-SWIDTH FONT)
|
||||
ITEMS))
|
||||
(DWIDTH (SETF (BF-DWIDTH FONT)
|
||||
ITEMS))
|
||||
(SWIDTH1 (SETF (BF-SWIDTH1 FONT)
|
||||
ITEMS))
|
||||
(DWIDTH1 (SETF (BF-DWIDTH1 FONT)
|
||||
ITEMS))
|
||||
(VVECTOR (SETF (BF-VVECTOR FONT)
|
||||
ITEMS))
|
||||
(STARTPROPERTIES
|
||||
(IF (AND (INTEGERP (SETQ V (FIRST ITEMS)))
|
||||
(PLUSP V))
|
||||
(SETQ PROPS (LOOP :UNTIL PROPS-COMPLETE :APPEND
|
||||
(WITH-INPUT-FROM-STRING
|
||||
(SI (SETQ LINE (READ-LINE FILE-STREAM)))
|
||||
(UNLESS (SETQ PROPS-COMPLETE
|
||||
(STRING-EQUAL "ENDPROPERTIES"
|
||||
(STRING-TRIM '(#\Space #\Tab)
|
||||
LINE)))
|
||||
(SETQ KEY (READ SI))
|
||||
(IF (AND KEY (SYMBOLP KEY)
|
||||
(SETQ VV (READ SI))
|
||||
(OR (STRINGP VV)
|
||||
(INTEGERP VV)))
|
||||
(LIST (INTERN (STRING KEY)
|
||||
"KEYWORD")
|
||||
VV)
|
||||
(ERROR
|
||||
"Invalid BDF file - malformed PROPERTY (~A)."
|
||||
LINE))))))
|
||||
(ERROR
|
||||
"Invalid BDF file - STARTPROPERTIES count (~A) is invalid or missing."
|
||||
V))
|
||||
(IF (EQL V (SETQ VV (/ (LENGTH PROPS)
|
||||
2)))
|
||||
(SETF (BF-PROPERTIES FONT)
|
||||
PROPS)
|
||||
(ERROR
|
||||
"Invalid BDF file - STARTPROPERTIES count (~D) does not match actual (~D)."
|
||||
V VV)))
|
||||
(CHARS
|
||||
(SETQ NGLYPHS (FIRST ITEMS))
|
||||
(UNLESS (AND NGLYPHS (INTEGERP NGLYPHS)
|
||||
(PLUSP NGLYPHS))
|
||||
(ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing."
|
||||
NGLYPHS))
|
||||
(SETF (BF-GLYPHS FONT)
|
||||
(LOOP :REPEAT NGLYPHS :COLLECT (READ-GLYPH FILE-STREAM FONT))))
|
||||
(ENDFONT (SETQ FONT-COMPLETE T))))))
|
||||
FONT)))
|
||||
|
||||
(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\]))
|
||||
(IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")
|
||||
(WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT)))
|
||||
(READ-DELIMITED-LIST DELIMIT SI)))
|
||||
|
||||
(DEFUN READ-GLYPH (FILE-STREAM FONT) (IL:* IL:\; "Edited 23-Sep-2024 12:38 by mth")
|
||||
(IL:* IL:\; "Edited 22-Aug-2024 20:53 by mth")
|
||||
(IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth")
|
||||
(LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
|
||||
:DWIDTH
|
||||
(COPY-LIST (BF-DWIDTH FONT))
|
||||
:SWIDTH1
|
||||
(COPY-LIST (BF-SWIDTH1 FONT))
|
||||
:DWIDTH1
|
||||
(COPY-LIST (BF-DWIDTH1 FONT))
|
||||
:VVECTOR
|
||||
(COPY-LIST (BF-VVECTOR FONT))))
|
||||
CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH)
|
||||
(LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
|
||||
(WHEN LINE (IL:* IL:\; "Ignore blank lines")
|
||||
(MULTIPLE-VALUE-SETQ (KEY POS)
|
||||
(READ-FROM-STRING LINE))
|
||||
(WHEN (<= POS (LENGTH LINE))
|
||||
(SETQ LINE (SUBSEQ LINE POS)))
|
||||
(SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING LINE))
|
||||
(COND
|
||||
((EQ KEY 'STARTCHAR)
|
||||
(WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph."))
|
||||
(SETF STARTED T)
|
||||
(SETF (GLYPH-NAME GLYPH)
|
||||
(STRING LINE)))
|
||||
(T (UNLESS STARTED (ERROR "Invalid BDF file - glyph has ben started."))
|
||||
(CASE KEY
|
||||
(ENCODING (SETF (GLYPH-ENCODING GLYPH)
|
||||
(IF (EQUAL -1 (FIRST ITEMS))
|
||||
ITEMS
|
||||
(FIRST ITEMS))))
|
||||
(SWIDTH (SETF (GLYPH-SWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH (SETF (GLYPH-DWIDTH GLYPH)
|
||||
ITEMS))
|
||||
(SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH)
|
||||
ITEMS))
|
||||
(VVECTOR (SETF (GLYPH-VVECTOR GLYPH)
|
||||
ITEMS))
|
||||
(BBX (SETF (GLYPH-BBW GLYPH)
|
||||
(SETQ BBW (FIRST ITEMS))
|
||||
(GLYPH-BBH GLYPH)
|
||||
(SETQ BBH (SECOND ITEMS))
|
||||
(GLYPH-BBXOFF0 GLYPH)
|
||||
(THIRD ITEMS)
|
||||
(GLYPH-BBYOFF0 GLYPH)
|
||||
(FOURTH ITEMS)))
|
||||
(BITMAP (LET* ((BM (IL:BITMAPCREATE BBW BBH 1))
|
||||
(BM.BASE (IL:|fetch| IL:BITMAPBASE IL:|of| BM))
|
||||
(BM.RASTERWIDTH (IL:|fetch| IL:BITMAPRASTERWIDTH
|
||||
IL:|of| BM))
|
||||
(NBYTES (CEILING BBW 8))
|
||||
(NCHARS (* 2 NBYTES))
|
||||
(NWORDS (CEILING BBW 16))
|
||||
BITS BYTEPOS WORDINDEX)
|
||||
(LOOP :WITH BITROW = 0 :REPEAT BBH :DO
|
||||
(SETQ LINE (STRING-TRIM '(#\Space #\Tab)
|
||||
(READ-LINE FILE-STREAM)))
|
||||
(UNLESS (AND (EQUAL NCHARS (LENGTH LINE))
|
||||
(SETQ BITS
|
||||
(PARSE-INTEGER LINE :RADIX 16
|
||||
:JUNK-ALLOWED T)))
|
||||
(ERROR
|
||||
"Invalid BDF file - bad line in BITMAP: ~A"
|
||||
LINE))
|
||||
(WHEN (ODDP NBYTES)
|
||||
(SETQ BITS (ASH BITS 8)))
|
||||
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
||||
(SETQ BYTEPOS (* 16 (1- NWORDS)))
|
||||
(LOOP :REPEAT NWORDS :DO
|
||||
(IL:\\PUTBASE BM.BASE WORDINDEX
|
||||
(LDB (BYTE 16 BYTEPOS)
|
||||
BITS))
|
||||
(INCF WORDINDEX)
|
||||
(DECF BYTEPOS 16))
|
||||
(INCF BITROW))
|
||||
(SETF (GLYPH-BITMAP GLYPH)
|
||||
BM)))
|
||||
(ENDCHAR (SETQ CHAR-COMPLETE T)))))))
|
||||
GLYPH))
|
||||
|
||||
(DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP")
|
||||
(:EXPORT "READ-BDF"))
|
||||
:READTABLE "XCL"
|
||||
:COMPILER :COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:READ-BDF IL:COPYRIGHT (IL:NONE))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (983 6167 (READ-BDF 983 . 6167)) (6169 6492 (READ-DELIMITED-LIST-FROM-STRING 6169 .
|
||||
6492)) (6494 11972 (READ-GLYPH 6494 . 11972)))))
|
||||
IL:STOP
|
||||
BIN
lispusers/READ-BDF.DFASL
Normal file
BIN
lispusers/READ-BDF.DFASL
Normal file
Binary file not shown.
@@ -32,20 +32,25 @@ main() {
|
||||
exit 1
|
||||
fi
|
||||
|
||||
git_commit_ID "${NOTECARDSDIR}"
|
||||
NOTECARDS_COMMIT_ID="${COMMIT_ID}"
|
||||
export NOTECARDS_COMMIT_ID
|
||||
|
||||
cat >"${cmfile}" <<-"EOF"
|
||||
"
|
||||
|
||||
(PROGN
|
||||
(IL:MEDLEY-INIT-VARS 'IL:GREET)
|
||||
(IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
|
||||
(IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
|
||||
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD)
|
||||
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD)
|
||||
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD)
|
||||
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD)
|
||||
(IL:LOAD
|
||||
(IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM))
|
||||
'IL:SYSLOAD
|
||||
)
|
||||
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM)) 'IL:SYSLOAD)
|
||||
(IL:PRINT (IL:UNIX-GETENV (QUOTE NOTECARDS_COMMIT_ID)))
|
||||
(IL:PUTASSOC (QUOTE IL:MEDLEY) (LIST (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) IL:SYSOUTCOMMITS)
|
||||
(IL:PUTASSOC (QUOTE IL:NOTECARDS) (LIST (IL:UNIX-GETENV (QUOTE NOTECARDS_COMMIT_ID))) IL:SYSOUTCOMMITS)
|
||||
(IL:PRINT IL:SYSOUTCOMMITS)
|
||||
(IL:HARDRESET)
|
||||
)
|
||||
SHH
|
||||
|
||||
@@ -17,10 +17,12 @@ main() {
|
||||
(DRIBBLE (QUOTE {DSK}<TMP>FOOBAR))
|
||||
(IL:MAKE-EXPORTS-ALL (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE exports.all))))
|
||||
(DRIBBLE)
|
||||
(IL:PUTASSOC (QUOTE IL:MEDLEY) (LIST (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) IL:SYSOUTCOMMITS)
|
||||
(IL:MAKE-WHEREIS-HASH
|
||||
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.dribble)))
|
||||
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash-tmp)))
|
||||
(IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash)))
|
||||
NIL NIL
|
||||
)
|
||||
(IL:LOGOUT T)
|
||||
)
|
||||
|
||||
@@ -18,6 +18,7 @@ main() {
|
||||
|
||||
(PROG
|
||||
((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
|
||||
(SETQ IL:SYSOUTCOMMITS (LIST (LIST (QUOTE IL:MEDLEY) (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID)))))
|
||||
(IL:MEDLEY-INIT-VARS)
|
||||
(IL:FILESLOAD MEDLEY-UTILS)
|
||||
(SETQ IL:DIRECTORIES (CONS (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) IL:DIRECTORIES))
|
||||
|
||||
@@ -12,6 +12,7 @@ main() {
|
||||
(PROGN
|
||||
(IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR))(QUOTE /LOADUP-FULL.LCOM)))
|
||||
(IL:LOADUP-FULL (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.dribble))))
|
||||
(IL:PUTASSOC (QUOTE IL:MEDLEY) (LIST (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) IL:SYSOUTCOMMITS)
|
||||
(IL:HARDRESET)
|
||||
)
|
||||
SHH
|
||||
|
||||
@@ -12,6 +12,7 @@ main() {
|
||||
(SETQ MEDLEYDIR NIL)
|
||||
(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
|
||||
(MEDLEY-INIT-VARS)
|
||||
(PUTASSOC (QUOTE MEDLEY) (LIST (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) SYSOUTCOMMITS)
|
||||
(CNDIR (UNIX-GETENV "LOADUP_WORKDIR"))
|
||||
(DRIBBLE "init.dribble")
|
||||
|
||||
@@ -28,15 +29,18 @@ main() {
|
||||
(LOADUP-SOURCE-DIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/"))
|
||||
)
|
||||
(SETQ DIRECTORIES (CONS LOADUP-SOURCE-DIR DIRECTORIES))
|
||||
(PRINT (DATE))
|
||||
(PRINT (SETQ SYSOUTCOMMITS (LIST (LIST (QUOTE MEDLEY) (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))))))
|
||||
(RESETLST (RESETSAVE OK.TO.MODIFY.FNS T)
|
||||
(MAKEINITGREET (CONCAT WORKDIR "init.sysout") (CONCAT WORKDIR "init.dlinit"))
|
||||
)
|
||||
)
|
||||
|
||||
(DRIBBLE)
|
||||
(LOGOUT T)
|
||||
STOP
|
||||
EOF
|
||||
|
||||
|
||||
run_medley "${LOADUP_SOURCEDIR}/starter.sysout"
|
||||
|
||||
loadup_finish "init.dlinit" "init.*" "RDSYS*" "I-NEW*"
|
||||
|
||||
@@ -5,7 +5,7 @@ main() {
|
||||
. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
|
||||
|
||||
loadup_start
|
||||
|
||||
|
||||
cat >"${cmfile}" <<-"EOF"
|
||||
"
|
||||
|
||||
@@ -14,6 +14,7 @@ main() {
|
||||
(MEDLEY-INIT-VARS)
|
||||
(LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM)))
|
||||
(LOADUP-LISP (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /lisp.dribble)))
|
||||
(PUTASSOC (QUOTE MEDLEY) (LIST (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) SYSOUTCOMMITS)
|
||||
(HARDRESET)
|
||||
)
|
||||
SHH
|
||||
|
||||
@@ -50,8 +50,20 @@ then
|
||||
fi
|
||||
fi
|
||||
|
||||
HAS_GIT= [ -f $(which git) ] && [ -x $(which git) ]
|
||||
export HAS_GIT
|
||||
|
||||
git_commit_ID () {
|
||||
if ${HAS_GIT};
|
||||
then
|
||||
# This does NOT indicate if there are any modified files!
|
||||
COMMIT_ID=$(git -C "$1" rev-parse --short HEAD)
|
||||
fi
|
||||
}
|
||||
|
||||
git_commit_ID "${LOADUP_SOURCEDIR}"
|
||||
LOADUP_COMMIT_ID="${COMMIT_ID}"
|
||||
export LOADUP_COMMIT_ID
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
geometry=1024x768
|
||||
|
||||
@@ -1489,10 +1489,10 @@ then
|
||||
#
|
||||
# Make sure prequisites for vnc support are in place
|
||||
#
|
||||
if [ -z "$(which Xvnc)" ] || [ "$(Xvnc -version 2>&1 | grep -iq tigervnc; echo $?)" -eq 1 ]
|
||||
if [ -z "$(which Xtigervnc)" ]
|
||||
then
|
||||
echo "Error: The -v or --vnc flag was set."
|
||||
echo "But it appears that that TigerVNC server \(Xvnc\) has not been installed."
|
||||
echo "But it appears that the TigerVNC server (Xtigervnc) has not been installed."
|
||||
echo "Please install the TigerVNC server and try again. On Debian and Ubuntu, use:"
|
||||
echo "\"sudo apt install tigervnc-standalone-server\". On most other Linux distros, use the"
|
||||
echo "distro's package manager to install the \"tigervnc-server\" package."
|
||||
@@ -1501,10 +1501,10 @@ then
|
||||
fi
|
||||
if [ "${linux}" = "true" ]
|
||||
then
|
||||
if [ -z "$(which vncviewer)" ] || [ "$(vncviewer -v 2>&1 | head -2 | grep -iq tigervnc; echo $?)" -eq 1 ]
|
||||
if [ -z "$(which xtigervncviewer)" ]
|
||||
then
|
||||
echo "Error: The -v or --vnc flag was set."
|
||||
echo "But it appears that that the TigerVNC viewer \(vncviewer\) is not installed on your system."
|
||||
echo "But it appears that that the TigerVNC viewer (xtigervncviewer) is not installed on your system."
|
||||
echo "Please install the TigerVNC viewer and try again. On Debian and Ubuntu, use:"
|
||||
echo "\"sudo apt install tigervnc-viewer\". On most other Linux distros, use the"
|
||||
echo "the distro's package manager to install the \"tigervnc-viewer\" (or sometimes just \"tigervnc\")"
|
||||
@@ -1512,7 +1512,7 @@ then
|
||||
echo "Exiting."
|
||||
exit 5
|
||||
else
|
||||
vncviewer="$(which vncviewer)"
|
||||
vncviewer="$(which xtigervncviewer)"
|
||||
fi
|
||||
elif [ "${wsl}" = "true" ]
|
||||
then
|
||||
@@ -1537,7 +1537,7 @@ then
|
||||
if [ -z "${resp}" ]; then resp=n; fi
|
||||
case "${resp}" in
|
||||
n* | N* )
|
||||
echo "Ok. You can download the Tiger VNC viewer \(v1.12.0\) .exe yourself and "
|
||||
echo "Ok. You can download the Tiger VNC viewer (v1.12.0) .exe yourself and "
|
||||
echo "place it in ${vnc_dir}/${vnc_exe}. Then retry."
|
||||
echo "Exiting."
|
||||
exit 5
|
||||
|
||||
@@ -67,10 +67,10 @@
|
||||
#
|
||||
# Make sure prequisites for vnc support are in place
|
||||
#
|
||||
if [ -z "$(which Xvnc)" ] || [ "$(Xvnc -version 2>&1 | grep -iq tigervnc; echo $?)" -eq 1 ]
|
||||
if [ -z "$(which Xtigervnc)" ]
|
||||
then
|
||||
echo "Error: The -v or --vnc flag was set."
|
||||
echo "But it appears that that TigerVNC server \(Xvnc\) has not been installed."
|
||||
echo "But it appears that the TigerVNC server (Xtigervnc) has not been installed."
|
||||
echo "Please install the TigerVNC server and try again. On Debian and Ubuntu, use:"
|
||||
echo "\"sudo apt install tigervnc-standalone-server\". On most other Linux distros, use the"
|
||||
echo "distro's package manager to install the \"tigervnc-server\" package."
|
||||
@@ -79,10 +79,10 @@
|
||||
fi
|
||||
if [ "${linux}" = "true" ]
|
||||
then
|
||||
if [ -z "$(which vncviewer)" ] || [ "$(vncviewer -v 2>&1 | head -2 | grep -iq tigervnc; echo $?)" -eq 1 ]
|
||||
if [ -z "$(which xtigervncviewer)" ]
|
||||
then
|
||||
echo "Error: The -v or --vnc flag was set."
|
||||
echo "But it appears that that the TigerVNC viewer \(vncviewer\) is not installed on your system."
|
||||
echo "But it appears that that the TigerVNC viewer (xtigervncviewer) is not installed on your system."
|
||||
echo "Please install the TigerVNC viewer and try again. On Debian and Ubuntu, use:"
|
||||
echo "\"sudo apt install tigervnc-viewer\". On most other Linux distros, use the"
|
||||
echo "the distro's package manager to install the \"tigervnc-viewer\" (or sometimes just \"tigervnc\")"
|
||||
@@ -90,7 +90,7 @@
|
||||
echo "Exiting."
|
||||
exit 5
|
||||
else
|
||||
vncviewer="$(which vncviewer)"
|
||||
vncviewer="$(which xtigervncviewer)"
|
||||
fi
|
||||
elif [ "${wsl}" = "true" ]
|
||||
then
|
||||
@@ -115,7 +115,7 @@
|
||||
if [ -z "${resp}" ]; then resp=n; fi
|
||||
case "${resp}" in
|
||||
n* | N* )
|
||||
echo "Ok. You can download the Tiger VNC viewer \(v1.12.0\) .exe yourself and "
|
||||
echo "Ok. You can download the Tiger VNC viewer (v1.12.0) .exe yourself and "
|
||||
echo "place it in ${vnc_dir}/${vnc_exe}. Then retry."
|
||||
echo "Exiting."
|
||||
exit 5
|
||||
|
||||
@@ -1,17 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2022 23:31:31"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CMLREAD.;15 12803
|
||||
(FILECREATED "23-Sep-2024 11:55:33" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;4 12882
|
||||
|
||||
:CHANGES-TO (FNS CL:PEEK-CHAR)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:PREVIOUS-DATE "16-Aug-2021 23:42:49"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CMLREAD.;14)
|
||||
:CHANGES-TO (FNS CL:READ-FROM-STRING)
|
||||
|
||||
:PREVIOUS-DATE "16-Sep-2024 12:26:09" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;3)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CMLREADCOMS)
|
||||
|
||||
@@ -188,16 +184,19 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(CL:READ-FROM-STRING
|
||||
[CL:LAMBDA (STRING &OPTIONAL EOF-ERROR-P EOF-VALUE &KEY START END PRESERVE-WHITESPACE)
|
||||
(* ; "Edited 23-Sep-2024 11:47 by mth")
|
||||
(* ; "Edited 16-Sep-2024 12:22 by mth")
|
||||
(* ; "Edited 8-Jun-90 14:15 by ymasuda")
|
||||
(LET [(STREAM (OPENSTRINGSTREAM (COND
|
||||
[END (SUBSTRING STRING 1 (IMIN END (NCHARS STRING]
|
||||
(T (MKSTRING STRING]
|
||||
(COND
|
||||
(START (SETFILEPTR STREAM START)))
|
||||
[COND
|
||||
(START (SETFILEPTR STREAM (UNFOLD START 2]
|
||||
(CL:VALUES (CL:IF PRESERVE-WHITESPACE
|
||||
(CL:READ-PRESERVING-WHITESPACE STREAM EOF-ERROR-P EOF-VALUE)
|
||||
(CL:READ STREAM EOF-ERROR-P EOF-VALUE))
|
||||
(\GETFILEPTR STREAM])
|
||||
(FOLDLO (\GETFILEPTR STREAM)
|
||||
2])
|
||||
|
||||
(CL:READ-BYTE
|
||||
[CL:LAMBDA (BINARY-INPUT-STREAM &OPTIONAL (EOF-ERRORP T)
|
||||
@@ -287,11 +286,10 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR
|
||||
CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
|
||||
)
|
||||
(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2525 3510 (CL:COPY-READTABLE 2535 . 3508)) (3511 10454 (CL:READ-LINE 3521 . 4393) (
|
||||
CL:READ-CHAR 4395 . 4945) (CL:UNREAD-CHAR 4947 . 5408) (CL:PEEK-CHAR 5410 . 7704) (CL:LISTEN 7706 .
|
||||
7971) (CL:READ-CHAR-NO-HANG 7973 . 8745) (CL:CLEAR-INPUT 8747 . 8984) (CL:READ-FROM-STRING 8986 . 9741
|
||||
) (CL:READ-BYTE 9743 . 10196) (CL:WRITE-BYTE 10198 . 10452)) (11448 11921 (WITH-READER-ENVIRONMENT
|
||||
11448 . 11921)))))
|
||||
(FILEMAP (NIL (2433 3418 (CL:COPY-READTABLE 2443 . 3416)) (3419 10627 (CL:READ-LINE 3429 . 4301) (
|
||||
CL:READ-CHAR 4303 . 4853) (CL:UNREAD-CHAR 4855 . 5316) (CL:PEEK-CHAR 5318 . 7612) (CL:LISTEN 7614 .
|
||||
7879) (CL:READ-CHAR-NO-HANG 7881 . 8653) (CL:CLEAR-INPUT 8655 . 8892) (CL:READ-FROM-STRING 8894 . 9914
|
||||
) (CL:READ-BYTE 9916 . 10369) (CL:WRITE-BYTE 10371 . 10625)) (11621 12094 (WITH-READER-ENVIRONMENT
|
||||
11621 . 12094)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,28 +1,35 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "16-May-90 15:31:19" {DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;2 1000
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS DEFPACKAGE-IMPORTCOMS)
|
||||
(FILECREATED " 5-Sep-2024 22:33:36" {DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2 1161
|
||||
|
||||
previous date%: "12-Dec-86 13:26:35" {DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;1
|
||||
)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (VARS DEFPACKAGE-IMPORTCOMS)
|
||||
|
||||
:PREVIOUS-DATE "16-May-90 15:31:19"
|
||||
{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
|
||||
|
||||
(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"INTERLISP"))
|
||||
(PROP MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
|
||||
"INTERLISP")
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"LISP")
|
||||
(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP")
|
||||
"LISP"))
|
||||
(PROP MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
|
||||
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"INTERLISP")
|
||||
|
||||
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"
|
||||
))
|
||||
(PUTPROPS DEFPACKAGE-IMPORT COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"LISP")
|
||||
|
||||
(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP")
|
||||
"LISP")
|
||||
|
||||
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -1 +1,17 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jan-98 12:25:04" ("compiled on " {DSK}<lispcore>sources>DEFPACKAGE-IMPORT.;1)
"30-Mar-95 20:33:04" bcompl'd in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 15:31:19" {DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;2 1000
changes to%: (VARS DEFPACKAGE-IMPORTCOMS) previous date%: "12-Dec-86 13:26:35"
{DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;1)
(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")) (PROP
MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS DEFPACKAGE-IMPORT COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
NIL
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Sep-2024 22:35:06" ("compiled on "
|
||||
{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2) "31-Jul-2024 02:24:35" tcompl'd in
|
||||
"FULL 31-Jul-2024 ..." dated "31-Jul-2024 02:24:38")
|
||||
(FILECREATED " 5-Sep-2024 22:33:36" {DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2 1161
|
||||
:EDIT-BY "mth" :CHANGES-TO (VARS DEFPACKAGE-IMPORTCOMS) :PREVIOUS-DATE "16-May-90 15:31:19"
|
||||
{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;1)
|
||||
(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
|
||||
(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP") (IMPORT (CL:INTERN
|
||||
"DEFPACKAGE" "XCL") "LISP") (EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP") "LISP")) (PROP
|
||||
MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "LISP")
|
||||
(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP") "LISP")
|
||||
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
NIL
|
||||
|
||||
@@ -1,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED "24-Oct-2021 10:20:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;4| 82444
|
||||
(IL:FILECREATED " 5-Sep-2024 17:42:20" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;3| 87515
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL IL:FIND-SYMBOL*)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
IL:|previous| IL:|date:| "22-Sep-92 11:47:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;1|
|
||||
:CHANGES-TO (IL:FNS XCL:DEFPACKAGE)
|
||||
|
||||
:PREVIOUS-DATE " 4-Sep-2024 13:17:23" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;2|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1986-1987, 1990-1992 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:LLPACKAGECOMS)
|
||||
|
||||
(IL:RPAQQ IL:LLPACKAGECOMS
|
||||
@@ -83,9 +83,9 @@
|
||||
|
||||
(IL:FUNCTIONS IL:\\INDEXATOMPNAME)
|
||||
(IL:* IL:\;
|
||||
"Defined in EXPORTS.ALL and used by the DO-SYMBOLS macro")
|
||||
"Defined in EXPORTS.ALL and used by the DO-SYMBOLS macro")
|
||||
(IL:DECLARE\: IL:EVAL@COMPILE (IL:* IL:\;
|
||||
"These are used in expanding the DO-SYMBOLS macro, which is used in this file.")
|
||||
"These are used in expanding the DO-SYMBOLS macro, which is used in this file.")
|
||||
(IL:FUNCTIONS IL:MAKE-DO-SYMBOLS-VARS IL:MAKE-DO-SYMBOLS-CODE))
|
||||
(IL:FUNCTIONS DO-EXTERNAL-SYMBOLS XCL:DO-LOCAL-SYMBOLS XCL:DO-INTERNAL-SYMBOLS DO-SYMBOLS
|
||||
DO-ALL-SYMBOLS)
|
||||
@@ -96,7 +96,7 @@
|
||||
(IL:FUNCTIONS IL:BRIEFLY-DESCRIBE-SYMBOL APROPOS APROPOS-LIST)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Reader and printer's interface to packages (plus *PACKAGE-FROM-INDEX* above)")
|
||||
"Reader and printer's interface to packages (plus *PACKAGE-FROM-INDEX* above)")
|
||||
|
||||
(IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL)
|
||||
(IL:FUNCTIONS IL:FIND-EXACT-SYMBOL IL:PACKAGE-NAME-AS-SYMBOL IL:\\FIND.PACKAGE.INTERNAL)
|
||||
@@ -175,10 +175,10 @@
|
||||
)
|
||||
|
||||
(DEFMACRO IL:\\FATCHARSEENP (IL:BASE IL:OFFSET IL:LEN IL:FATP)
|
||||
`(AND ,IL:FATP (NOT (NULL (IL:FOR IL:I IL:FROM ,IL:OFFSET
|
||||
IL:TO (IL:SUB1 (IL:IPLUS ,IL:OFFSET ,IL:LEN))
|
||||
`(AND ,IL:FATP (NOT (NULL (IL:FOR IL:I IL:FROM ,IL:OFFSET IL:TO (IL:SUB1 (IL:IPLUS ,IL:OFFSET
|
||||
,IL:LEN))
|
||||
IL:SUCHTHAT (IL:IGREATERP (IL:\\GETBASEFAT ,IL:BASE IL:I)
|
||||
IL:\\MAXTHINCHAR))))))
|
||||
IL:\\MAXTHINCHAR))))))
|
||||
|
||||
(DEFMACRO IL:\\PACKAGIFY (IL:OBJ)
|
||||
"If OBJ isn't already a package, turn the symbol or string into the package of that name."
|
||||
@@ -220,9 +220,8 @@
|
||||
|
||||
(DEFUN IL:\\UPCASEBASE (IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
|
||||
(IL:|for| IL:I IL:|from| IL:OFFSET IL:|to| (IL:IPLUS IL:OFFSET IL:LENGTH)
|
||||
IL:|do| (IL:\\PUTBASECHAR IL:FATP IL:BASE IL:I (IL:NUMERIC-UPCASE (IL:\\GETBASECHAR
|
||||
IL:FATP IL:BASE IL:I
|
||||
)))))
|
||||
IL:|do| (IL:\\PUTBASECHAR IL:FATP IL:BASE IL:I (IL:NUMERIC-UPCASE (IL:\\GETBASECHAR IL:FATP
|
||||
IL:BASE IL:I)))))
|
||||
|
||||
(DEFUN IL:APROPOS-SEARCH (SYMBOL IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
|
||||
"The symbol to substring comparison macro for APROPOS and APROPOS-LIST. The string is assumed to already be uppercase."
|
||||
@@ -240,13 +239,13 @@
|
||||
T)
|
||||
(UNLESS (EQL (IL:\\GETBASECHAR IL:FATP IL:BASE IL:JNDEX)
|
||||
(IL:NUMERIC-UPCASE (IL:\\GETBASECHAR IL:SYMBOL-FATP IL:SYMBOL-BASE
|
||||
(IL:ADD1 IL:KNDEX))))
|
||||
(IL:ADD1 IL:KNDEX))))
|
||||
(RETURN NIL)))
|
||||
(RETURN T))))
|
||||
|
||||
(DEFSTRUCT (PACKAGE-HASHTABLE (:CONSTRUCTOR %MAKE-PACKAGE-HASHTABLE)
|
||||
(:COPIER NIL)
|
||||
(:PRINT-FUNCTION PRINT-PACKAGE-HASHTABLE))
|
||||
(:COPIER NIL)
|
||||
(:PRINT-FUNCTION PRINT-PACKAGE-HASHTABLE))
|
||||
"Packages are implemented using a special kind of hashtable (this one). It is an open hashtable with a parallel 8-bit I-vector of hash-codes. The primary purpose of the hash for each entry is to reduce paging by allowing collisions and misses to be detected without paging in the symbol and pname for an entry. If the hash for an entry doesn't match that for the symbol that we are looking for, then we can go on without touching the symbol, pname, or even hastable vector. It turns out that, contrary to my expectations, paging is a very important consideration the design of the package representation. Using a similar scheme without the entry hash, the fasloader was spending more than half its time paging in INTERN. The hash code also indicates the status of an entry. If it zero, the the entry is unused. If it is one, then it is deleted. Double-hashing is used for collision resolution."
|
||||
TABLE
|
||||
HASH
|
||||
@@ -255,9 +254,9 @@
|
||||
DELETED)
|
||||
|
||||
(DEFSTRUCT (PACKAGE (:CONC-NAME %PACKAGE-)
|
||||
(:CONSTRUCTOR %MAKE-PACKAGE)
|
||||
(:PREDICATE PACKAGEP)
|
||||
(:PRINT-FUNCTION PRINT-PACKAGE))
|
||||
(:CONSTRUCTOR %MAKE-PACKAGE)
|
||||
(:PREDICATE PACKAGEP)
|
||||
(:PRINT-FUNCTION PRINT-PACKAGE))
|
||||
INDEX
|
||||
(TABLES (LIST NIL))
|
||||
NAME NAMESYMBOL NICKNAMES (USE-LIST NIL)
|
||||
@@ -321,7 +320,7 @@
|
||||
"The current package, in which read symbols are intern'ed.")
|
||||
|
||||
(DEFVAR XCL::*UNSAFE-TO-DELETE-PACKAGE-NAMES* '("LISP" "INTERLISP" "XEROX-COMMON-LISP")
|
||||
"Packages whose deletion requires confirmation.")
|
||||
"Packages whose deletion requires confirmation.")
|
||||
|
||||
(XCL:DEFGLOBALVAR IL:*LISP-PACKAGE* NIL
|
||||
"Global for internal references to the lisp package.")
|
||||
@@ -357,8 +356,8 @@
|
||||
(IL:LEN (IL:|ffetch| (IL:STRINGP IL:LENGTH) IL:|of| IL:PRINT-NAME))
|
||||
(IL:OFFST (IL:|ffetch| (IL:STRINGP IL:OFFST) IL:|of| IL:PRINT-NAME)))
|
||||
(IL:UNINTERRUPTABLY
|
||||
(IL:\\CREATE.SYMBOL IL:BASE IL:OFFST IL:LEN IL:FATP (IL:\\FATCHARSEENP IL:BASE
|
||||
IL:OFFST IL:LEN IL:FATP)))))
|
||||
(IL:\\CREATE.SYMBOL IL:BASE IL:OFFST IL:LEN IL:FATP (IL:\\FATCHARSEENP IL:BASE IL:OFFST
|
||||
IL:LEN IL:FATP)))))
|
||||
|
||||
|
||||
|
||||
@@ -367,12 +366,11 @@
|
||||
)
|
||||
|
||||
|
||||
(XCL:DEFGLOBALVAR IL:*PACKAGE-FROM-NAME* (IL:HASHARRAY 255 'IL:ERROR 'IL:STRINGHASHBITS
|
||||
'IL:STREQUAL)
|
||||
"An equal hashtable from package names to packages.")
|
||||
(XCL:DEFGLOBALVAR IL:*PACKAGE-FROM-NAME* (IL:HASHARRAY 255 'IL:ERROR 'IL:STRINGHASHBITS 'IL:STREQUAL)
|
||||
"An equal hashtable from package names to packages.")
|
||||
|
||||
(XCL:DEFGLOBALVAR IL:*PACKAGE-FROM-INDEX* (MAKE-ARRAY 256 ':INITIAL-ELEMENT NIL)
|
||||
"Index to package converter.")
|
||||
"Index to package converter.")
|
||||
|
||||
(DEFCONSTANT XCL:*TOTAL-PACKAGES-LIMIT* 255
|
||||
"The total number of packages that the system may have (excluding the 'uninterned' package).")
|
||||
@@ -499,9 +497,9 @@
|
||||
(RETURN IL:X)))))
|
||||
|
||||
(DEFUN MAKE-PACKAGE (NAME &KEY (USE '("LISP"))
|
||||
NICKNAMES PREFIX-NAME (EXTERNAL-ONLY NIL)
|
||||
(INTERNAL-SYMBOLS 10)
|
||||
(EXTERNAL-SYMBOLS 10))
|
||||
NICKNAMES PREFIX-NAME (EXTERNAL-ONLY NIL)
|
||||
(INTERNAL-SYMBOLS 10)
|
||||
(EXTERNAL-SYMBOLS 10))
|
||||
"Check for package name conflicts in name and nicknames, then make the package. Do a use-package for each thing in the use list so that checking for conflicting exports among used packages is done."
|
||||
(DECLARE (SPECIAL IL:*PACKAGE-FROM-INDEX* IL:*PACKAGE-FROM-NAME*))
|
||||
(WHEN (FIND-PACKAGE NAME)
|
||||
@@ -518,14 +516,143 @@
|
||||
:INDEX %PACKAGE-INDEX)))
|
||||
(USE-PACKAGE USE PACKAGE)
|
||||
(IL:ENTER-NEW-NICKNAMES PACKAGE (IF (IL:STREQUAL NAME (SYMBOL-NAME PREFIX-NAME))
|
||||
NICKNAMES
|
||||
(CONS PREFIX-NAME NICKNAMES)))
|
||||
NICKNAMES
|
||||
(CONS PREFIX-NAME NICKNAMES)))
|
||||
(IL:PUTHASH NAME PACKAGE IL:*PACKAGE-FROM-NAME*)
|
||||
(SETF (AREF IL:*PACKAGE-FROM-INDEX* %PACKAGE-INDEX)
|
||||
PACKAGE)))
|
||||
(IL:DEFINEQ
|
||||
|
||||
(xcl:defpackage
|
||||
(XCL:DEFPACKAGE
|
||||
(IL:NLAMBDA IL:ARGS (IL:* IL:\; "Edited 4-Sep-2024 13:17 by mth")
|
||||
(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:IF (SYMBOL-PACKAGE IL:SYMBOL)
|
||||
IL:THEN IL:SYMBOL
|
||||
IL:ELSE (INTERN (SYMBOL-NAME
|
||||
IL:SYMBOL)
|
||||
PACKAGE))
|
||||
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 '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:IF (SYMBOL-PACKAGE IL:SYMBOL)
|
||||
IL:THEN IL:SYMBOL
|
||||
IL:ELSE (INTERN (SYMBOL-NAME
|
||||
IL:SYMBOL)
|
||||
PACKAGE))
|
||||
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))))
|
||||
)
|
||||
|
||||
|
||||
@@ -569,16 +696,15 @@
|
||||
(NOT (IL:FMEMB IL:SYM IL:SHADOWING-SYMBOLS)))
|
||||
(PUSHNEW IL:SYM IL:CSET :TEST 'EQ))))
|
||||
(DOLIST (IL:P IL:USE-LIST)
|
||||
(PUSHNEW IL:SYM IL:CSET :TEST 'EQ))))
|
||||
(DOLIST (IL:P IL:USE-LIST)
|
||||
(DO-EXTERNAL-SYMBOLS
|
||||
(IL:SYM IL:P)
|
||||
(MULTIPLE-VALUE-BIND (IL:S IL:W)
|
||||
(IL:FIND-EXTERNAL-SYMBOL (SYMBOL-NAME IL:SYM)
|
||||
IL:PKG)
|
||||
(WHEN (AND IL:W (NOT (EQ IL:S IL:SYM))
|
||||
(NOT (IL:FMEMB (INTERN (SYMBOL-NAME IL:SYM)
|
||||
PACKAGE)
|
||||
(DO-EXTERNAL-SYMBOLS (IL:SYM IL:P)
|
||||
(MULTIPLE-VALUE-BIND (IL:S IL:W)
|
||||
(IL:FIND-EXTERNAL-SYMBOL (SYMBOL-NAME IL:SYM)
|
||||
IL:PKG)
|
||||
(WHEN (AND IL:W (NOT (EQ IL:S IL:SYM))
|
||||
(NOT (IL:FMEMB (INTERN (SYMBOL-NAME IL:SYM)
|
||||
PACKAGE)
|
||||
IL:SHADOWING-SYMBOLS)))
|
||||
(PUSHNEW IL:SYM IL:CSET :TEST 'EQ))))))
|
||||
(T (DO-EXTERNAL-SYMBOLS (IL:SYM IL:PKG)
|
||||
(MULTIPLE-VALUE-BIND (IL:S IL:W)
|
||||
(FIND-SYMBOL (SYMBOL-NAME IL:SYM)
|
||||
@@ -800,7 +926,7 @@
|
||||
(UNLESS (AND IL:W (EQ IL:S IL:SYM))
|
||||
(WHEN (OR (EQ IL:W :INTERNAL)
|
||||
(EQ IL:W :EXTERNAL)) (IL:* IL:\;
|
||||
(WHEN (OR (EQ IL:W :INTERNAL)
|
||||
" If it was shadowed, we don't want Unintern to fail")
|
||||
(SETF (%PACKAGE-SHADOWING-SYMBOLS PACKAGE)
|
||||
(DELETE IL:S (%PACKAGE-SHADOWING-SYMBOLS PACKAGE)))
|
||||
(UNINTERN IL:S PACKAGE))
|
||||
@@ -873,7 +999,7 @@
|
||||
(SXHASH (IL:SYMBOL-HASH IL:SYMBOL-BASE 1 IL:SYMBOL-LENGTH IL:SYMBOL-FATP))
|
||||
(IL:H2 (IL:REHASH-FACTOR SXHASH IL:LEN)))
|
||||
(DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32))
|
||||
(IL:H2 (IL:REHASH-FACTOR SXHASH IL:LEN)))
|
||||
IL:VEC)
|
||||
(TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8))
|
||||
IL:HASH))
|
||||
(COND
|
||||
@@ -886,7 +1012,7 @@
|
||||
((>= IL:SIZE IL:HASHTABLE-SIZE-LIMIT)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"We've spilled over into needing the list-of-tables feature, so add to the list.")
|
||||
|
||||
(IL:SETQ IL:VEC (IL:NCONC1 IL:VEC (MAKE-ARRAY IL:LEN :ELEMENT-TYPE
|
||||
'(UNSIGNED-BYTE 32))))
|
||||
@@ -898,7 +1024,7 @@
|
||||
(IL:ADD-SYMBOL IL:TABLE SYMBOL))
|
||||
(T
|
||||
(IL:* IL:|;;|
|
||||
(T
|
||||
"The initial table is still smaller than the limit. Increase its size.")
|
||||
|
||||
(LET ((IL:SIZE (PACKAGE-HASHTABLE-SIZE IL:TABLE))
|
||||
(IL:VEC1 (CAR IL:VEC))
|
||||
@@ -909,8 +1035,7 @@
|
||||
(DOTIMES (IL:I IL:LEN)
|
||||
(WHEN (IL:IGREATERP (AREF IL:HASH1 IL:I)
|
||||
1)
|
||||
(WHEN (IL:IGREATERP (AREF IL:HASH1 IL:I)
|
||||
1)
|
||||
(IL:ADD-SYMBOL IL:TABLE (IL:\\INDEXATOMPNAME (AREF IL:VEC1 IL:I))))))
|
||||
)))
|
||||
(T (LET ((IL:THIS-HASH (CAR (IL:FLAST IL:HASH)))
|
||||
(IL:THIS-VEC (CAR (IL:FLAST IL:VEC))))
|
||||
@@ -926,10 +1051,9 @@
|
||||
(SETF (AREF IL:THIS-HASH IL:I)
|
||||
(IL:ENTRY-HASH IL:SYMBOL-LENGTH SXHASH)))))))))
|
||||
|
||||
(IL:ENTRY-HASH IL:SYMBOL-LENGTH SXHASH)))))))))
|
||||
|
||||
(DEFMACRO IL:WITH-SYMBOL ((IL:INDEX-VAR IL:SYMBOL-VAR IL:TABLE IL:BASE IL:OFFSET IL:LENGTH
|
||||
IL:FATP SXHASH IL:ENTRY-HASH IL:HASH-TABLE-TABLE
|
||||
(DEFMACRO IL:WITH-SYMBOL ((IL:INDEX-VAR IL:SYMBOL-VAR IL:TABLE IL:BASE IL:OFFSET IL:LENGTH IL:FATP
|
||||
SXHASH IL:ENTRY-HASH IL:HASH-TABLE-TABLE IL:HASH-TABLE-HASH)
|
||||
&BODY IL:FORMS)
|
||||
"Find where the symbol named String is stored in Table. Index-Var is bound to the index, or NIL if it is not present. Symbol-Var is bound to the symbol. Length and Hash are the length and sxhash of String. Entry-Hash is the entry-hash of the string and length."
|
||||
(LET ((IL:VEC (OR IL:HASH-TABLE-TABLE (IL:GENSYM)))
|
||||
(IL:HASH (OR IL:HASH-TABLE-HASH (IL:GENSYM)))
|
||||
@@ -947,7 +1071,7 @@
|
||||
,IL:HASH
|
||||
,IL:LIMIT)
|
||||
(DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8))
|
||||
,IL:LIMIT)
|
||||
,IL:HASH)
|
||||
(TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32))
|
||||
,IL:VEC))
|
||||
(PROG (,IL:INDEX-VAR ,IL:SYMBOL-VAR ,IL:EHASH)
|
||||
@@ -955,9 +1079,8 @@
|
||||
(IL:* IL:|;;| "Loop thru all the hash tables looking for the symbol.")
|
||||
|
||||
IL:OUTER-LOOP
|
||||
|
||||
IL:OUTER-LOOP
|
||||
(IL:SETQ ,IL:HASH (IL:POP ,IL:HASHS))
|
||||
(IL:SETQ ,IL:HASH (IL:POP ,IL:HASHS)) (IL:* IL:\; "Hashvalues")
|
||||
(IL:SETQ ,IL:VEC (IL:POP ,IL:VECS)) (IL:* IL:\; "The symbol vector")
|
||||
(IL:SETQ ,IL:INDEX-VAR (IL:IREMAINDER ,SXHASH ,IL:LEN))
|
||||
(IL:* IL:\; "Starting probe.")
|
||||
(IL:SETQ ,IL:LIMIT ,IL:LEN)
|
||||
@@ -972,37 +1095,34 @@
|
||||
|
||||
(IL:* IL:|;;| "SIngle-byte hash matches; try the whole name.")
|
||||
|
||||
(IL:* IL:|;;| "SIngle-byte hash matches; try the whole name.")
|
||||
|
||||
(IL:SETQ ,IL:SYMBOL-VAR (IL:\\INDEXATOMPNAME (AREF ,IL:VEC
|
||||
,IL:INDEX-VAR)))
|
||||
(IL:SETQ ,IL:SYMBOL-VAR (IL:\\INDEXATOMPNAME (AREF ,IL:VEC ,IL:INDEX-VAR)))
|
||||
(WHEN (IL:\\SYMBOL-EQUALBASE ,IL:SYMBOL-VAR ,IL:BASE ,IL:OFFSET ,IL:LENGTH
|
||||
,IL:FATP)
|
||||
(GO IL:DOIT)))
|
||||
((EQL 0 ,IL:EHASH) (IL:* IL:\;
|
||||
(GO IL:DOIT)))
|
||||
"Found an empty hash slot, so it's not in this table.")
|
||||
(COND
|
||||
((NULL ,IL:HASHS)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"we've run out of sub-tables to look in. Give the we-couldn't-find-it signal.")
|
||||
|
||||
(IL:SETQ ,IL:INDEX-VAR NIL)
|
||||
(GO IL:DOIT))
|
||||
(T (GO IL:OUTER-LOOP))))
|
||||
((EQL 0 (IL:SETQ ,IL:LIMIT (IL:SUB1 ,IL:LIMIT)))
|
||||
(IL:* IL:\;
|
||||
((EQL 0 (IL:SETQ ,IL:LIMIT (IL:SUB1 ,IL:LIMIT)))
|
||||
"We.ve been thru the whole table, so it's not in this table.")
|
||||
(COND
|
||||
((NULL ,IL:HASHS)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"we've run out of sub-tables to look in. Give the we-couldn't-find-it signal.")
|
||||
|
||||
(IL:SETQ ,IL:INDEX-VAR NIL)
|
||||
(GO IL:DOIT))
|
||||
(T (GO IL:OUTER-LOOP)))))
|
||||
(GO IL:DOIT))
|
||||
(T (GO IL:OUTER-LOOP)))))
|
||||
(IL:SETQ ,IL:INDEX-VAR (IL:SYMBOL-HASH-REPROBE ,IL:INDEX-VAR ,IL:H2 ,IL:LEN))
|
||||
(GO LOOP)
|
||||
IL:DOIT
|
||||
(RETURN (PROGN ,@IL:FORMS))))))
|
||||
@@ -1051,12 +1171,12 @@
|
||||
(IL:SETQ IL:WHERE :INTERNAL)
|
||||
(IL:SETQ IL:DONE T))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
|
||||
(IL:SETQ IL:DONE T))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL
|
||||
NIL)
|
||||
(WHEN IL:FOUND
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"Was (cl:return-from find-symbol* (cl:values cl:symbol :internal))")
|
||||
|
||||
(IL:SETQ IL:WHERE :INTERNAL)
|
||||
(IL:SETQ IL:DONE T)))))
|
||||
@@ -1071,12 +1191,12 @@
|
||||
(IL:SETQ IL:WHERE :EXTERNAL)
|
||||
(IL:SETQ IL:DONE T))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
|
||||
(IL:SETQ IL:DONE T))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL
|
||||
NIL)
|
||||
(WHEN IL:FOUND
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"Was (cl:return-from find-symbol* (cl:values cl:symbol :external))")
|
||||
|
||||
(IL:SETQ IL:SYM SYMBOL)
|
||||
(IL:SETQ IL:WHERE :EXTERNAL)
|
||||
@@ -1101,13 +1221,13 @@
|
||||
IL:TABLE))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"Was (cl:return-from find-symbol* (cl:values cl:symbol :inherited))")
|
||||
|
||||
(IL:SETQ IL:WHERE :INHERITED)
|
||||
(IL:SETQ IL:DONE T))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (CAR IL:TABLE)
|
||||
(IL:SETQ IL:DONE T))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (CAR IL:TABLE)
|
||||
IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH
|
||||
IL:EHASH NIL NIL)
|
||||
(WHEN IL:FOUND
|
||||
(UNLESS (EQ IL:PREV IL:HEAD)
|
||||
(SHIFTF (CDR IL:PREV)
|
||||
@@ -1116,7 +1236,7 @@
|
||||
IL:TABLE))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
|
||||
"Was (cl:return-from find-symbol* (cl:values cl:symbol :inherited))")
|
||||
|
||||
(IL:SETQ IL:SYM SYMBOL)
|
||||
(IL:SETQ IL:WHERE :INHERITED)
|
||||
@@ -1134,17 +1254,17 @@
|
||||
(T (IL:ERROR "Not a string " IL:NAME))))
|
||||
(COND
|
||||
((NULL PACKAGE) (IL:* IL:\;
|
||||
(COND
|
||||
"XCL extension, makes uninterned symbols")
|
||||
(MAKE-SYMBOL IL:NAME))
|
||||
(T (IL:* IL:\;
|
||||
(MAKE-SYMBOL IL:NAME))
|
||||
"Package is at least non-null")
|
||||
(IL:SETQ PACKAGE (IL:\\PACKAGIFY PACKAGE))
|
||||
(LET ((IL:BASE (IL:|ffetch| (IL:STRINGP IL:BASE) IL:|of| IL:NAME))
|
||||
(IL:OFFSET (IL:|ffetch| (IL:STRINGP IL:OFFST) IL:|of| IL:NAME))
|
||||
(IL:LENGTH (IL:|ffetch| (IL:STRINGP IL:LENGTH) IL:|of| IL:NAME))
|
||||
(IL:FATP (IL:|ffetch| (IL:STRINGP IL:FATSTRINGP) IL:|of| IL:NAME)))
|
||||
(IL:LENGTH (IL:|ffetch| (IL:STRINGP IL:LENGTH) IL:|of| IL:NAME))
|
||||
(IL:FATP (IL:|ffetch| (IL:STRINGP IL:FATSTRINGP) IL:|of| IL:NAME)))
|
||||
(IL:INTERN* IL:BASE IL:OFFSET IL:LENGTH IL:FATP (IL:\\FATCHARSEENP IL:BASE IL:OFFSET
|
||||
IL:LENGTH IL:FATP)
|
||||
PACKAGE NIL)))))
|
||||
|
||||
(DEFUN FIND-SYMBOL (IL:NAME &OPTIONAL (PACKAGE *PACKAGE*))
|
||||
@@ -1173,7 +1293,7 @@
|
||||
(IL:HASH (IL:SYMBOL-HASH IL:BASE IL:OFFSET IL:LENGTH IL:FATP))
|
||||
(IL:EHASH (IL:ENTRY-HASH IL:LENGTH IL:HASH)))
|
||||
(IL:WITH-SYMBOL (IL:INDEX SYMBOL IL:TABLE IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH
|
||||
(IL:EHASH (IL:ENTRY-HASH IL:LENGTH IL:HASH)))
|
||||
IL:EHASH NIL IL:TABLE-HASH)
|
||||
(SETF (AREF IL:TABLE-HASH IL:INDEX)
|
||||
1)
|
||||
(INCF (PACKAGE-HASHTABLE-DELETED IL:TABLE)))))
|
||||
@@ -1196,7 +1316,7 @@
|
||||
(IL:FIND-EXTERNAL-SYMBOL IL:NAME IL:P)
|
||||
(WHEN IL:W (PUSHNEW IL:S IL:CSET))))
|
||||
(WHEN (CDR IL:CSET) (IL:* IL:\;
|
||||
(WHEN IL:W (PUSHNEW IL:S IL:CSET))))
|
||||
"If there is more than one, handle the conflict")
|
||||
(IL:RESOLVE-UNINTERN-CONFLICT SYMBOL IL:CSET PACKAGE)))
|
||||
(SETF (%PACKAGE-SHADOWING-SYMBOLS PACKAGE)
|
||||
(DELETE SYMBOL IL:SHADOWING-SYMBOLS :TEST #'EQ)))
|
||||
@@ -1207,8 +1327,8 @@
|
||||
(OR (EQ IL:W :INTERNAL)
|
||||
(EQ IL:W :EXTERNAL)))
|
||||
(IL:NUKE-SYMBOL (IF (EQ IL:W :INTERNAL)
|
||||
(EQ IL:W :EXTERNAL)))
|
||||
(IL:NUKE-SYMBOL (IF (EQ IL:W :INTERNAL)
|
||||
(%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
|
||||
(%PACKAGE-EXTERNAL-SYMBOLS PACKAGE))
|
||||
IL:NAME)
|
||||
(IF (EQ (SYMBOL-PACKAGE SYMBOL)
|
||||
PACKAGE)
|
||||
@@ -1291,9 +1411,9 @@
|
||||
)
|
||||
|
||||
(DEFMACRO DO-EXTERNAL-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
|
||||
(DEFMACRO DO-EXTERNAL-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
IL:RESULT-FORM)
|
||||
IL:RESULT-FORM)
|
||||
&BODY
|
||||
(IL:CODE IL:DECLS))
|
||||
"Do-External-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms once for each external symbol in the given Package with Var bound to the current symbol."
|
||||
(LET ((IL:VARS (IL:MAKE-DO-SYMBOLS-VARS)))
|
||||
`(PROG (,IL:VAR ,@IL:VARS)
|
||||
@@ -1304,9 +1424,9 @@
|
||||
IL:CODE))))
|
||||
|
||||
(DEFMACRO XCL:DO-LOCAL-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
|
||||
(DEFMACRO XCL:DO-LOCAL-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
IL:RESULT-FORM)
|
||||
IL:RESULT-FORM)
|
||||
&BODY
|
||||
(IL:CODE IL:DECLS))
|
||||
"Do-Local-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms at least once for each symbol actually in the given Package with Var bound to the current symbol."
|
||||
(LET* ((IL:DONE-INTERNAL (IL:GENSYM))
|
||||
(IL:DONE-EXTERNAL (IL:GENSYM))
|
||||
@@ -1318,13 +1438,11 @@
|
||||
,@IL:DECLS
|
||||
(WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
|
||||
(GO ,IL:DONE-INTERNAL))
|
||||
(WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
|
||||
(GO ,IL:DONE-INTERNAL))
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS ,PACKAGE)
|
||||
`(GO ,IL:DONE-INTERNAL)
|
||||
IL:CODE)
|
||||
,IL:DONE-INTERNAL
|
||||
IL:CODE)
|
||||
,IL:DONE-INTERNAL
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-EXTERNAL-SYMBOLS ,PACKAGE)
|
||||
`(GO ,IL:DONE-EXTERNAL)
|
||||
IL:CODE)
|
||||
,IL:DONE-EXTERNAL
|
||||
@@ -1332,9 +1450,9 @@
|
||||
(RETURN ,IL:RESULT-FORM))))
|
||||
|
||||
(DEFMACRO XCL:DO-INTERNAL-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
|
||||
(DEFMACRO XCL:DO-INTERNAL-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
IL:RESULT-FORM)
|
||||
IL:RESULT-FORM)
|
||||
&BODY
|
||||
(IL:CODE IL:DECLS))
|
||||
"Do-Internal-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms at least once for each symbol actually in the given Package and not exported with Var bound to the current symbol."
|
||||
(LET* ((IL:DONE-INTERNAL (IL:GENSYM))
|
||||
(IL:VARS (IL:MAKE-DO-SYMBOLS-VARS))
|
||||
@@ -1345,8 +1463,7 @@
|
||||
,@IL:DECLS
|
||||
(WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
|
||||
(GO ,IL:DONE-INTERNAL))
|
||||
(WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
|
||||
(GO ,IL:DONE-INTERNAL))
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS ,PACKAGE)
|
||||
`(GO ,IL:DONE-INTERNAL)
|
||||
IL:CODE)
|
||||
,IL:DONE-INTERNAL
|
||||
@@ -1354,9 +1471,9 @@
|
||||
(RETURN ,IL:RESULT-FORM))))
|
||||
|
||||
(DEFMACRO DO-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
|
||||
(DEFMACRO DO-SYMBOLS ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
|
||||
IL:RESULT-FORM)
|
||||
IL:RESULT-FORM)
|
||||
&BODY
|
||||
(IL:CODE IL:DECLS))
|
||||
"Do-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms at least once for each symbol accessible in the given Package with Var bound to the current symbol."
|
||||
(LET* ((IL:DONE-INTERNAL (IL:GENSYM))
|
||||
(IL:DONE-EXTERNAL (IL:GENSYM))
|
||||
@@ -1375,13 +1492,11 @@
|
||||
,@IL:DECLS
|
||||
(WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
|
||||
(GO ,IL:DONE-INTERNAL))
|
||||
(WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
|
||||
(GO ,IL:DONE-INTERNAL))
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS ,PACKAGE)
|
||||
`(GO ,IL:DONE-INTERNAL)
|
||||
IL:CODE)
|
||||
,IL:DONE-INTERNAL
|
||||
IL:CODE)
|
||||
,IL:DONE-INTERNAL
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-EXTERNAL-SYMBOLS ,PACKAGE)
|
||||
`(GO ,IL:DONE-EXTERNAL)
|
||||
IL:CODE)
|
||||
,IL:DONE-EXTERNAL
|
||||
@@ -1390,29 +1505,29 @@
|
||||
(IL:SETQ ,IL:VAR NIL)
|
||||
(RETURN ,IL:RESULT-FORM))
|
||||
(IL:SETQ ,IL:THIS-INHERIT (CAR ,IL:INHERITS))
|
||||
(RETURN ,IL:RESULT-FORM))
|
||||
(IL:SETQ ,IL:THIS-INHERIT (CAR ,IL:INHERITS))
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE
|
||||
IL:VARS IL:VAR IL:THIS-INHERIT `(PROGN (IL:SETQ ,IL:INHERITS (CDR ,IL:INHERITS))
|
||||
(GO ,IL:NEXT-INHERIT))
|
||||
`((WHEN (OR (NOT ,IL:SHADOWED)
|
||||
(EQ (FIND-SYMBOL (SYMBOL-NAME ,IL:VAR)
|
||||
,IL:N-PACKAGE)
|
||||
,@(IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR IL:THIS-INHERIT
|
||||
`(PROGN (IL:SETQ ,IL:INHERITS (CDR ,IL:INHERITS))
|
||||
(GO ,IL:NEXT-INHERIT))
|
||||
`((WHEN (OR (NOT ,IL:SHADOWED)
|
||||
(EQ (FIND-SYMBOL (SYMBOL-NAME ,IL:VAR)
|
||||
,IL:N-PACKAGE)
|
||||
,IL:VAR))
|
||||
,@IL:CODE))))))
|
||||
|
||||
(DEFMACRO DO-ALL-SYMBOLS ((IL:VAR &OPTIONAL IL:RESULT-FORM)
|
||||
|
||||
(DEFMACRO DO-ALL-SYMBOLS ((IL:VAR &OPTIONAL IL:RESULT-FORM)
|
||||
&BODY
|
||||
(IL:CODE IL:DECLS))
|
||||
"Do-All-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms once for each symbol in each package with Var bound to the current symbol."
|
||||
(LET* ((IL:PACKAGE-LOOP (IL:GENSYM))
|
||||
(IL:TAG (IL:GENSYM))
|
||||
(IL:PACKAGE-LIST (IL:GENSYM))
|
||||
(IL:VARS (IL:MAKE-DO-SYMBOLS-VARS))
|
||||
(IL:PACKAGE-LIST (IL:GENSYM))
|
||||
(IL:VARS (IL:MAKE-DO-SYMBOLS-VARS))
|
||||
(IL:INTERNAL-CODE (IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS
|
||||
(CAR ,IL:PACKAGE-LIST))
|
||||
`(GO ,IL:TAG)
|
||||
IL:CODE))
|
||||
`(GO ,IL:TAG)
|
||||
IL:CODE))
|
||||
(IL:EXTERNAL-CODE (IL:MAKE-DO-SYMBOLS-CODE IL:VARS IL:VAR `(%PACKAGE-EXTERNAL-SYMBOLS
|
||||
(CAR ,IL:PACKAGE-LIST))
|
||||
`(PROGN (IL:SETQ ,IL:PACKAGE-LIST (CDR ,IL:PACKAGE-LIST))
|
||||
(GO ,IL:PACKAGE-LOOP))
|
||||
IL:CODE)))
|
||||
@@ -1494,12 +1609,10 @@
|
||||
(LET ((PACKAGE (IL:\\PACKAGIFY PACKAGE)))
|
||||
(IF IL:EXTERNAL-ONLY
|
||||
(DO-EXTERNAL-SYMBOLS (SYMBOL PACKAGE)
|
||||
(IF IL:EXTERNAL-ONLY
|
||||
(DO-EXTERNAL-SYMBOLS (SYMBOL PACKAGE)
|
||||
(IF (IL:APROPOS-SEARCH SYMBOL IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
|
||||
(PUSH SYMBOL LIST)))
|
||||
(DO-SYMBOLS (SYMBOL PACKAGE)
|
||||
(PUSH SYMBOL LIST)))
|
||||
(DO-SYMBOLS (SYMBOL PACKAGE)
|
||||
(IF (IL:APROPOS-SEARCH SYMBOL IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
|
||||
(PUSH SYMBOL LIST)))))))
|
||||
LIST))
|
||||
|
||||
@@ -1510,7 +1623,7 @@
|
||||
|
||||
(DEFUN IL:FIND-EXTERNAL-SYMBOL (STRING PACKAGE)
|
||||
(IL:SETQ STRING (IL:MKSTRING STRING)) (IL:* IL:\;
|
||||
(DEFUN IL:FIND-EXTERNAL-SYMBOL (STRING PACKAGE)
|
||||
"Convert symbols to strings (for the reader)")
|
||||
(LET* ((IL:BASE (IL:|ffetch| (IL:STRINGP IL:BASE) IL:|of| STRING))
|
||||
(IL:OFFSET (IL:|ffetch| (IL:STRINGP IL:OFFST) IL:|of| STRING))
|
||||
(IL:LENGTH (IL:|ffetch| (IL:STRINGP IL:LENGTH) IL:|of| STRING))
|
||||
@@ -1526,8 +1639,7 @@
|
||||
IL:RESULT))
|
||||
(VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1))))
|
||||
(IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
|
||||
(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 NIL)
|
||||
(VALUES SYMBOL IL:FOUND)))))
|
||||
|
||||
(DEFUN IL:FIND-EXACT-SYMBOL (SYMBOL PACKAGE)
|
||||
@@ -1562,32 +1674,40 @@
|
||||
|
||||
(IL:ADDTOVAR IL:LAMA )
|
||||
)
|
||||
(IL:ADDTOVAR IL:LAMA )
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:PUTPROPS IL:LLPACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(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
|
||||
(IL:FILEMAP (NIL (5304 5829 (IL:PACKAGE-LISTIFY 5304 . 5829)) (5831 6219 (IL:\\SIMPLE-STRINGIFY 5831
|
||||
. 6219)) (6221 6713 (IL:SYMBOL-LISTIFY 6221 . 6713)) (6715 6777 (IL:COPY-STRING 6715 . 6777)) (6779
|
||||
7517 (IL:\\SYMBOL-EQUALBASE 6779 . 7517)) (7521 7957 (IL:\\FATCHARSEENP 7521 . 7957)) (7959 8487 (
|
||||
IL:\\PACKAGIFY 7959 . 8487)) (8489 9526 (IL:\\STRING-EQUALBASE 8489 . 9526)) (9528 9752 (
|
||||
IL:NUMERIC-UPCASE 9528 . 9752)) (9754 10111 (IL:\\UPCASEBASE 9754 . 10111)) (10113 11230 (
|
||||
IL:APROPOS-SEARCH 10113 . 11230)) (12750 12832 (PACKAGE-NAME 12750 . 12832)) (12834 12926 (
|
||||
PACKAGE-NICKNAMES 12834 . 12926)) (12928 13036 (PACKAGE-SHADOWING-SYMBOLS 12928 . 13036)) (13038 13128
|
||||
(PACKAGE-USE-LIST 13038 . 13128)) (13130 13228 (PACKAGE-USED-BY-LIST 13130 . 13228)) (13230 14385 (
|
||||
IL:MAKE-PACKAGE-HASHTABLE 13230 . 14385)) (14387 14549 (PRINT-PACKAGE 14387 . 14549)) (14551 14942 (
|
||||
PRINT-PACKAGE-HASHTABLE 14551 . 14942)) (16006 16787 (MAKE-SYMBOL 16006 . 16787)) (17838 18248 (
|
||||
IL:\\PKG-FIND-FREE-PACKAGE-INDEX 17838 . 18248)) (18305 18451 (IL:SETF-SYMBOL-PACKAGE 18305 . 18451))
|
||||
(18453 18545 (SYMBOL-PACKAGE 18453 . 18545)) (18587 20224 (IL:SYMBOL-HASH 18587 . 20224)) (20226 20358
|
||||
(IL:REHASH-FACTOR 20226 . 20358)) (20360 20526 (IL:SYMBOL-HASH-REPROBE 20360 . 20526)) (20528 20919 (
|
||||
IL:ENTRY-HASH 20528 . 20919)) (20968 21314 (IL:COUNT-PACKAGE-HASHTABLE 20968 . 21314)) (21316 21488 (
|
||||
IL:INTERNAL-SYMBOL-COUNT 21316 . 21488)) (21490 21608 (IL:EXTERNAL-SYMBOL-COUNT 21490 . 21608)) (21610
|
||||
22766 (IL:ENTER-NEW-NICKNAMES 21610 . 22766)) (22768 23194 (IL:MAKE-PRIME-HASHTABLE-SIZE 22768 .
|
||||
23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 34317 (XCL:DEFPACKAGE 24859 . 34315)) (34366
|
||||
34588 (FIND-PACKAGE 34366 . 34588)) (34590 37951 (USE-PACKAGE 34590 . 37951)) (37953 38433 (
|
||||
IN-PACKAGE 37953 . 38433)) (38435 38709 (XCL:PKG-GOTO 38435 . 38709)) (38711 39811 (RENAME-PACKAGE
|
||||
38711 . 39811)) (39813 41264 (XCL:DELETE-PACKAGE 39813 . 41264)) (41266 44212 (EXPORT 41266 . 44212))
|
||||
(44214 45457 (UNEXPORT 44214 . 45457)) (45459 47103 (IMPORT 45459 . 47103)) (47105 48385 (
|
||||
SHADOWING-IMPORT 47105 . 48385)) (48387 49441 (SHADOW 48387 . 49441)) (49443 50098 (UNUSE-PACKAGE
|
||||
49443 . 50098)) (50162 50468 (LIST-ALL-PACKAGES 50162 . 50468)) (50525 54208 (IL:ADD-SYMBOL 50525 .
|
||||
54208)) (54210 58263 (IL:WITH-SYMBOL 54210 . 58263)) (58265 59568 (IL:INTERN* 58265 . 59568)) (59570
|
||||
65402 (IL:FIND-SYMBOL* 59570 . 65402)) (65404 66855 (INTERN 65404 . 66855)) (66857 67435 (FIND-SYMBOL
|
||||
66857 . 67435)) (67493 68389 (IL:NUKE-SYMBOL 67493 . 68389)) (68391 70505 (UNINTERN 68391 . 70505)) (
|
||||
70507 71650 (IL:MOBY-UNINTERN 70507 . 71650)) (71709 71781 (IL:\\INDEXATOMPNAME 71709 . 71781)) (71893
|
||||
72040 (IL:MAKE-DO-SYMBOLS-VARS 71893 . 72040)) (72042 73497 (IL:MAKE-DO-SYMBOLS-CODE 72042 . 73497))
|
||||
(73501 74279 (DO-EXTERNAL-SYMBOLS 73501 . 74279)) (74281 75627 (XCL:DO-LOCAL-SYMBOLS 74281 . 75627)) (
|
||||
75629 76745 (XCL:DO-INTERNAL-SYMBOLS 75629 . 76745)) (76747 79045 (DO-SYMBOLS 76747 . 79045)) (79047
|
||||
80729 (DO-ALL-SYMBOLS 79047 . 80729)) (80797 81322 (FIND-ALL-SYMBOLS 80797 . 81322)) (81324 81603 (
|
||||
IL:BRIEFLY-DESCRIBE-SYMBOL 81324 . 81603)) (81605 83119 (APROPOS 81605 . 83119)) (83121 84688 (
|
||||
APROPOS-LIST 83121 . 84688)) (84792 86319 (IL:FIND-EXTERNAL-SYMBOL 84792 . 86319)) (86321 86841 (
|
||||
IL:FIND-EXACT-SYMBOL 86321 . 86841)) (86843 86923 (IL:PACKAGE-NAME-AS-SYMBOL 86843 . 86923)) (86925
|
||||
87074 (IL:\\FIND.PACKAGE.INTERNAL 86925 . 87074)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2023 08:57:43" {WMEDLEY}<sources>MEDLEYDIR.;22 10362
|
||||
(FILECREATED "26-Aug-2024 22:11:48" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;4 11113
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYDIR)
|
||||
:CHANGES-TO (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS)
|
||||
(FNS SET-SYSOUT-COMMIT)
|
||||
|
||||
:PREVIOUS-DATE "17-Jul-2023 16:13:10" {WMEDLEY}<sources>MEDLEYDIR.;21)
|
||||
:PREVIOUS-DATE " 8-Jul-2024 22:49:43" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -15,16 +16,19 @@
|
||||
[
|
||||
(* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)")
|
||||
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR)
|
||||
(INITVARS (MEDLEYDIR)
|
||||
(\SAVE.MEDLEYDIR))
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR SET-SYSOUT-COMMIT)
|
||||
[INITVARS (MEDLEYDIR)
|
||||
(\SAVE.MEDLEYDIR)
|
||||
(SYSOUTCOMMITS (OR (AND (BOUNDP 'SYSOUTCOMMITS)
|
||||
SYSOUTCOMMITS)
|
||||
(LIST (LIST 'MEDLEY NIL]
|
||||
(ADDVARS (AROUNDEXITFNS MEDLEY-INIT-VARS))
|
||||
|
||||
(* ;; "**WARNING** The EVALed expressions get run early in the lodup.")
|
||||
|
||||
(VARS MEDLEY-INIT-VARS)
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS
|
||||
\SAVE.MEDLEYDIR DIRECTORIES])
|
||||
\SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS])
|
||||
|
||||
|
||||
|
||||
@@ -158,12 +162,21 @@
|
||||
(EQ 1 (STRPOS OLD (U-CASE (MKSTRING BODY]
|
||||
THEN [PACK* NEW (SUBSTRING BODY (ADD1 (NCHARS OLD]
|
||||
ELSE BODY])
|
||||
|
||||
(SET-SYSOUT-COMMIT
|
||||
[LAMBDA (REPO COMMIT-ID-ENV-VAR) (* ; "Edited 8-Jul-2024 23:31 by mth")
|
||||
(PUTASSOC REPO (LIST (UNIX-GETENV COMMIT-ID-ENV-VAR))
|
||||
SYSOUTCOMMITS])
|
||||
)
|
||||
|
||||
(RPAQ? MEDLEYDIR )
|
||||
|
||||
(RPAQ? \SAVE.MEDLEYDIR )
|
||||
|
||||
(RPAQ? SYSOUTCOMMITS (OR (AND (BOUNDP 'SYSOUTCOMMITS)
|
||||
SYSOUTCOMMITS)
|
||||
(LIST (LIST 'MEDLEY NIL))))
|
||||
|
||||
(ADDTOVAR AROUNDEXITFNS MEDLEY-INIT-VARS)
|
||||
|
||||
|
||||
@@ -172,7 +185,9 @@
|
||||
|
||||
|
||||
(RPAQQ MEDLEY-INIT-VARS
|
||||
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
|
||||
((ShellBrowser)
|
||||
(ShellOpener)
|
||||
[LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
|
||||
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
|
||||
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
|
||||
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
|
||||
@@ -203,9 +218,9 @@
|
||||
NIL NIL T))))
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1432 8288 (MEDLEY-INIT-VARS 1442 . 4920) (MEDLEYDIR 4922 . 7306) (MEDLEYSUBSTDIR 7308
|
||||
. 8286)))))
|
||||
(FILEMAP (NIL (1749 8823 (MEDLEY-INIT-VARS 1759 . 5237) (MEDLEYDIR 5239 . 7623) (MEDLEYSUBSTDIR 7625
|
||||
. 8603) (SET-SYSOUT-COMMIT 8605 . 8821)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user