mirror of
https://github.com/PDP-10/its.git
synced 2026-01-11 23:53:12 +00:00
162 lines
6.7 KiB
Plaintext
162 lines
6.7 KiB
Plaintext
'<PCODE "NLUP">
|
|
|
|
<PACKAGE "LUP">
|
|
|
|
<ENTRY LUP-ACT LUP-DCT LUP-ADD-PACK LUP-ADD-DATUM LUP-DEL LIB-GC LIB-STAT DO-ADD
|
|
FLUSH-CURRENT-PACKAGE>
|
|
|
|
<ENTRY CUR-TYPE CUR-UPD>
|
|
|
|
<USE "LIB">
|
|
|
|
<SETG ZERO %<RSUBR!- '[ %<PCODE!- "NLUP" 0> ZERO #DECL ("VALUE" DATA-BASE
|
|
DATA-BASE FIX FIX) GET-FILE L-UNUSE OUSE-DEFER OUSE OENDPACKAGE ORENTRY OENTRY
|
|
ORPACKAGE OPACKAGE MANIFEST? MAKE-STRING GET-NAME HASH-NAME ENDPACKAGE
|
|
DEFER-FIND PACKAGE-FIND LOAD-PACKAGE CRDATE TELL DB-HASH-MAP DB-CLOSE DB-OPEN
|
|
DB-ACCESS %<RGLOC MUDDLE T> T OUTCHAN SNM (STRING) NM2 %<RGLOC L-LIBRARY-NAME T>
|
|
CUR-UPD %<RGLOC DB-DEAD T> "DB already active." "READB" "READ" ".LOCK" " LOCK"
|
|
"PRINTB" "ZDATA.TMP" "_DATA TMP" "PRINTO" "PRINT" %<RGLOC CUR-UPD T> %<TYPE-W
|
|
UPDB VECTOR> " ACTIVATED" "Creating new library " GROW-BUF %<RGLOC GROW-BUF T>
|
|
"<MDLLIB>LIBMUD" "LIBMUD;LIBMUD" %<RGLOC L-DATFILE-NAME T> DB-IN-BAD-STATE
|
|
DB-OK? "No libraries activated." %<TYPE-W DATA-BASE VECTOR> TO %<RGLOC
|
|
DATA-BASES T> "DONE" ">Z" ";_" ":<" BUF %<RGLOC BUF T> (1) %<RGLOC NO-ENT T>
|
|
UNBALANCED-PACKAGES LUP-ADD-PACK ERRET-T-TO-CONTINUE %<RGLOC CUR-PACK T> %<RGLOC
|
|
CUR-ENTRY T> %<RGLOC CUR-RENTRY T> PACKAGE-ALREADY-EXISTS ERRET-T-TO-REDEFINE %<
|
|
RGLOC CUR-USES T> %<RGLOC CUR-USE-DEFERS T> #FALSE ("NO ENTRIES IN PACKAGE") #
|
|
FALSE ("FILE DID NOT DEFINE A PACKAGE") LOAD-ACT (ACTIVATION) %<RGLOC
|
|
LOAD-CHANNEL T> %<RGLOC ALL-USES T> %<RGLOC CUR-TYPE T> %<RGLOC NPACKAGE T> %<
|
|
RGLOC PACKAGE T> %<RGLOC NRPACKAGE T> %<RGLOC RPACKAGE T> %<RGLOC NENTRY T> %<
|
|
RGLOC ENTRY T> %<RGLOC NRENTRY T> %<RGLOC RENTRY T> %<RGLOC NENDPACKAGE T> %<
|
|
RGLOC ENDPACKAGE T> %<RGLOC NUSE T> %<RGLOC USE T> %<RGLOC EXTERNAL T> %<RGLOC
|
|
NUSE-DEFER T> %<RGLOC USE-DEFER T> %<RGLOC OPACKAGE T> %<RGLOC ORPACKAGE T> %<
|
|
RGLOC OENTRY T> %<RGLOC ORENTRY T> %<RGLOC OENDPACKAGE T> %<RGLOC OUSE T> %<
|
|
RGLOC OUSE-DEFER T> FILE-SYSTEM-ERROR!-ERRORS CONTROL-G?!-ERRORS
|
|
UNASSIGNED-VARIABLE!-ERRORS GVAL UNBOUND-VARIABLE!-ERRORS VALUE CALLER USE-DEFER
|
|
CUR-PACK "Flushing load of package " ": error during loading."
|
|
"Flushing load of current package:" INITIAL OBLIST "ATOM, " (ANY)
|
|
", GOES THROUGH INITIAL" PACKAGE ENDPACKAGE DEFINE SETG LIST FLOAD #FALSE (
|
|
"FLOAD ENCOUNTERED") UVECTOR WORD ENTRY BAD-FIRST-ARG-TO-DEFINE-OR-SETG!-ERRORS
|
|
DATUM-ALREADY-EXISTS LUP-ADD-DATUM #FALSE ("PACKAGE NOT FOUND")
|
|
PACKAGE-NOT-FOUND DO-DEL %<RGLOC SBUF T> DATA-BASE-MUNGED (<LIST [REST OBLIST]>)
|
|
" " PACKAGE-HAS-NO-OBLIST? WRITE-PACKAGE "Package "
|
|
" can't have datfile entry." "RPACKAGE " "PACKAGE " RENTRY USE "<NEWTYPE " " "
|
|
DECL "<PUT " " DECL " "<SETG " " %<RSUBR-ENTRY '[\\ \\ F!- " "] 0>>" ">"
|
|
MANIFEST GDECL "<ENDPACKAGE>" "WARNING: two packages defined in file " "Only "
|
|
" will be added to the library." "The second package is " TWO-PACKAGES-IN-FILE?
|
|
NENDPACKAGE %<RGLOC SACRED-PACKAGES T> RPACKAGE "GC not necessary." %<RGLOC
|
|
SAVED-ENTRIES T> " getting new entry." " being flushed." " being flushed: "
|
|
"--" %<RGLOC CUV T> LOAD-FAILED GC-NEW-PACKAGE HUV %<RGLOC HUV T>
|
|
"Last update: " "Last GC: " "Never" "Library file length: "
|
|
" words of header and hash tables." " packages, " " words." " " " crossing"
|
|
" of page boundaries. " " empty hash bucket" " entries, " "Free chain is "
|
|
" entries long, containing " " word" " lost." "The data file is empty."
|
|
"The data file is " " words long; " " words in use."
|
|
" packages with data file entries." " at "]>>
|
|
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ZERO PGLUE ![715827882 -22906142721 -1 -1 -1
|
|
-1 -1 -1 -1 -1 -1 -4194304 0!]>>
|
|
|
|
<NEWTYPE UPDB VECTOR '<<PRIMTYPE VECTOR> DATA-BASE <OR FALSE DATA-BASE> CHANNEL
|
|
<OR CHANNEL FALSE> CHANNEL STRING STRING>>
|
|
|
|
<SETG UPDB-BASE 1>
|
|
|
|
<SETG UPDB-NEW 2>
|
|
|
|
<SETG UPDB-DATFILE 3>
|
|
|
|
<SETG UPDB-NEWDAT 4>
|
|
|
|
<SETG UPDB-LOCK 5>
|
|
|
|
<SETG UPDB-ONAME 6>
|
|
|
|
<SETG UPDB-NNAME 7>
|
|
|
|
<MANIFEST UPDB-BASE UPDB-NEW UPDB-DATFILE UPDB-NEWDAT UPDB-LOCK UPDB-ONAME
|
|
UPDB-NNAME>
|
|
|
|
<SETG DB-MIN-ENTRY <+ ,FUNCTION-NAMEBEG 1 1>>
|
|
|
|
<MANIFEST DB-MIN-ENTRY>
|
|
|
|
<SETG DB-DEAD 0>
|
|
|
|
<SETG LOAD-CHANNEL <>>
|
|
|
|
<GDECL (DB-DEAD) FIX (NO-ENT) FIX (LOAD-CHANNEL) <OR CHANNEL FALSE>>
|
|
|
|
<SETG LUP-ACT %<RSUBR-ENTRY '[ZERO LUP-ACT #DECL ("VALUE" ANY STRING "OPTIONAL"
|
|
<OR ATOM FALSE> <OR ATOM FALSE>)] 150>>
|
|
|
|
<SETG LUP-DCT %<RSUBR-ENTRY '[ZERO LUP-DCT #DECL ("VALUE" <OR FALSE STRING>
|
|
"OPTIONAL" <OR ATOM FALSE>)] 634>>
|
|
|
|
<COND (<OR <NOT <GASSIGNED? NPACKAGE>> <N==? ,PACKAGE ,NPACKAGE>> <SETG OPACKAGE
|
|
,PACKAGE> <SETG ORPACKAGE ,RPACKAGE> <SETG OENTRY ,ENTRY> <AND <GASSIGNED?
|
|
RENTRY> <SETG ORENTRY ,RENTRY>> <SETG OENDPACKAGE ,ENDPACKAGE> <SETG OUSE ,USE>
|
|
<SETG OUSE-DEFER ,USE-DEFER>)>
|
|
|
|
<SETG LUP-ADD-PACK %<RSUBR-ENTRY '[ZERO LUP-ADD-PACK #DECL ("VALUE" <OR ATOM
|
|
FALSE <VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>] [REST FIX]>
|
|
> STRING "OPTIONAL" <OR ATOM FALSE> <OR ATOM FALSE>)] 1162>>
|
|
|
|
<SETG LOAD-PACKAGE %<RSUBR-ENTRY '[ZERO LOAD-PACKAGE #DECL ("VALUE" ANY CHANNEL)
|
|
] 1388>>
|
|
|
|
<SETG LUP-ERROR-HANDLER %<RSUBR-ENTRY '[ZERO LUP-ERROR-HANDLER #DECL ("VALUE"
|
|
ANY FRAME "TUPLE" TUPLE)] 1672>>
|
|
|
|
<ON "ERROR" ,LUP-ERROR-HANDLER 100>
|
|
|
|
<SETG DO-ADD %<RSUBR-ENTRY '[ZERO DO-ADD #DECL ("VALUE" FIX STRING <LIST [REST
|
|
ATOM]> <OR FALSE <LIST [REST ATOM]>> <LIST [REST STRING]> <LIST [REST STRING]>
|
|
FIX STRING UPDB <OR ATOM FALSE>)] 1926>>
|
|
|
|
<SETG LUP-ADD-DATUM %<RSUBR-ENTRY '[ZERO LUP-ADD-DATUM #DECL ("VALUE" <OR FALSE
|
|
<VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>] [REST FIX]>>
|
|
STRING STRING "OPTIONAL" ANY)] 2865>>
|
|
|
|
<SETG LUP-DEL %<RSUBR-ENTRY '[ZERO LUP-DEL #DECL ("VALUE" <OR FALSE FIX> STRING)
|
|
] 3001>>
|
|
|
|
<SETG SBUF <IUVECTOR 12 0>>
|
|
|
|
<SETG NPACKAGE %<RSUBR-ENTRY '[ZERO NPACKAGE #DECL ("VALUE" ATOM STRING "TUPLE"
|
|
TUPLE)] 4922>>
|
|
|
|
<SETG NRPACKAGE %<RSUBR-ENTRY '[ZERO NRPACKAGE #DECL ("VALUE" ATOM STRING
|
|
"TUPLE" TUPLE)] 4973>>
|
|
|
|
<SETG NENTRY %<RSUBR-ENTRY '[ZERO NENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
|
|
REST ATOM]>)] 5129>>
|
|
|
|
<SETG NRENTRY %<RSUBR-ENTRY '[ZERO NRENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
|
|
REST ATOM]>)] 5209>>
|
|
|
|
<SETG NENDPACKAGE %<RSUBR-ENTRY '[ZERO NENDPACKAGE #DECL ("VALUE" ATOM)] 5289>>
|
|
|
|
<SETG NUSE %<RSUBR-ENTRY '[ZERO NUSE #DECL ("VALUE" ATOM "TUPLE" ANY)] 5312>>
|
|
|
|
<SETG NUSE-DEFER %<RSUBR-ENTRY '[ZERO NUSE-DEFER #DECL ("VALUE" ATOM "TUPLE" ANY
|
|
)] 5364>>
|
|
|
|
<SETG FLUSH-CURRENT-PACKAGE %<RSUBR-ENTRY '[ZERO FLUSH-CURRENT-PACKAGE #DECL (
|
|
"VALUE" <OR ATOM FALSE STRING>)] 5416>>
|
|
|
|
<SETG SACRED-PACKAGES ("PP" "PCK" "FIXUP" "HELPLD" "EDIT" "FR&" "GRLOAD" "PAGES"
|
|
"LIB" "LUP" "NLIB" "NLUP")>
|
|
|
|
<SETG LIB-GC %<RSUBR-ENTRY '[ZERO LIB-GC #DECL ("VALUE" <OR ATOM FALSE STRING>
|
|
STRING "OPTIONAL" ANY ANY <OR ATOM FALSE>)] 5671>>
|
|
|
|
<SETG SAVED-ENTRIES <IUVECTOR 1022 ()>>
|
|
|
|
<SETG CUV <IUVECTOR 30>>
|
|
|
|
<SETG TELL %<RSUBR-ENTRY '[ZERO TELL #DECL ("VALUE" ATOM "TUPLE" ANY)] 7119>>
|
|
|
|
<SETG LIB-STAT %<RSUBR-ENTRY '[ZERO LIB-STAT #DECL ("VALUE" <OR ATOM FALSE>
|
|
STRING)] 7438>>
|
|
|
|
<ENDPACKAGE>
|