mirror of
https://github.com/PDP-10/its.git
synced 2026-01-13 15:27:28 +00:00
95 lines
3.9 KiB
Plaintext
95 lines
3.9 KiB
Plaintext
'<PCODE "1LUP">
|
||
|
||
<PACKAGE "LUP">
|
||
|
||
<ENTRY LUP-ACT LUP-DCT LUP-ADD-PACK LUP-ADD-DATUM LUP-DEL LIB-GC LIB-STAT DO-ADD
|
||
>
|
||
|
||
<ENTRY CUR-TYPE CUR-UPD>
|
||
|
||
<USE "LIB">
|
||
|
||
<SETG ZERO %<RSUBR!- '[ %<PCODE!- "1LUP" 0> ZERO #DECL ("VALUE" DATA-BASE
|
||
DATA-BASE FIX FIX) OENDPACKAGE ORENTRY OENTRY ORPACKAGE OPACKAGE MAKE-STRING
|
||
STRING=? HASH-NAME DEFER-FIND PACKAGE-FIND DB-HASH-MAP DB-CLOSE DB-OPEN
|
||
DB-ACCESS T OUTCHAN NM2 %<RGLOC L-LIBRARY-NAME T> (STRING) %<RGLOC MUDDLE T>
|
||
CUR-UPD %<RGLOC DB-DEAD T> "DB already active." "READB" ".LOCK" " LOCK" "PRINTO"
|
||
%<RGLOC CUR-UPD T> %<TYPE-W UPDB VECTOR> " ACTIVATED" "PRINTB" GROW-BUF %<RGLOC
|
||
GROW-BUF T> "<MDLLIB>LIBMUD" "LIBMUD;LIBMUD" DB-IN-BAD-STATE DB-OK?
|
||
"No libraries activated." %<TYPE-W DATA-BASE VECTOR> TO ".LIB" " LIB" %<RGLOC
|
||
DATA-BASES T> "DONE" ">Z" ";_" ":<" BUF %<RGLOC BUF T> "READ" "PRINT" (1) %<
|
||
RGLOC CUR-PACK T> %<RGLOC CUR-ENTRY T> %<RGLOC CUR-RENTRY T> %<RGLOC CUR-TYPE T>
|
||
%<RGLOC NO-ENT 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> UNBALANCED-PACKAGES
|
||
LUP-ADD-PACK ERRET-T-TO-CONTINUE PACKAGE-ALREADY-EXISTS ERRET-T-TO-REDEFINE %<
|
||
RGLOC OPACKAGE T> %<RGLOC ORPACKAGE T> %<RGLOC OENTRY T> %<RGLOC ORENTRY T> %<
|
||
RGLOC OENDPACKAGE T> INITIAL OBLIST "ATOM, " (ANY) ", GOES THROUGH INITIAL"
|
||
PACKAGE ENDPACKAGE DEFINE SETG LIST FLOAD #FALSE ("FLOAD ENCOUNTERED") UVECTOR
|
||
WORD VALUE 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 TWO-PACKAGES-IN-FILE? NENDPACKAGE "GC not necessary."
|
||
" packages, " " buckets used." " packages/bucket; maximum length " " entries, "
|
||
" buckets used. " " entries/bucket; maximum length " " entries/package." %<
|
||
TYPE-C DATA-BASE VECTOR> HUV %<RGLOC HUV T> "Last update: " "Last GC: "
|
||
"Never" "File length: " " words of header and hash tables." " words." " "
|
||
" crossing" " of page boundaries. " " empty hash bucket" "Free chain is "
|
||
" entries long, containing " " word" " lost." " at "]>>
|
||
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ZERO PGLUE ![715827883 -1 -1 -1 -1 -1 -1
|
||
-16777216 0!]>>
|
||
|
||
|
||
<NEWTYPE UPDB VECTOR>
|
||
|
||
<SETG DB-DEAD 0>
|
||
|
||
<SETG LUP-ACT %<RSUBR-ENTRY '[ZERO LUP-ACT #DECL ("VALUE" ANY STRING "OPTIONAL"
|
||
<OR ATOM FALSE>)] 70>>
|
||
|
||
<SETG LUP-DCT %<RSUBR-ENTRY '[ZERO LUP-DCT #DECL ("VALUE" <OR FALSE STRING>
|
||
"OPTIONAL" <OR ATOM FALSE>)] 453>>
|
||
|
||
<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 LUP-ADD-PACK %<RSUBR-ENTRY '[ZERO LUP-ADD-PACK #DECL ("VALUE" <OR FALSE
|
||
VECTOR> STRING "OPTIONAL" <OR ATOM FALSE>)] 943>>
|
||
|
||
<SETG DO-ADD %<RSUBR-ENTRY '[ZERO DO-ADD #DECL ("VALUE" FIX STRING <LIST [REST
|
||
ATOM]> <OR FALSE <LIST [REST ATOM]>> STRING UPDB)] 1336>>
|
||
|
||
<SETG LUP-ADD-DATUM %<RSUBR-ENTRY '[ZERO LUP-ADD-DATUM #DECL ("VALUE" <OR FALSE
|
||
VECTOR> STRING STRING "OPTIONAL" ANY)] 2213>>
|
||
|
||
<SETG LUP-DEL %<RSUBR-ENTRY '[ZERO LUP-DEL #DECL ("VALUE" <OR FALSE FIX> STRING)
|
||
] 2338>>
|
||
|
||
<SETG SBUF <IUVECTOR 12 0>>
|
||
|
||
<SETG NPACKAGE %<RSUBR-ENTRY '[ZERO NPACKAGE #DECL ("VALUE" ATOM STRING "TUPLE"
|
||
TUPLE)] 3430>>
|
||
|
||
<SETG NRPACKAGE %<RSUBR-ENTRY '[ZERO NRPACKAGE #DECL ("VALUE" ATOM STRING
|
||
"TUPLE" TUPLE)] 3484>>
|
||
|
||
<SETG NENTRY %<RSUBR-ENTRY '[ZERO NENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
|
||
REST ATOM]>)] 3544>>
|
||
|
||
<SETG NRENTRY %<RSUBR-ENTRY '[ZERO NRENTRY #DECL ("VALUE" ANY "TUPLE" <TUPLE [
|
||
REST ATOM]>)] 3624>>
|
||
|
||
<SETG NENDPACKAGE %<RSUBR-ENTRY '[ZERO NENDPACKAGE #DECL ("VALUE" ATOM)] 3705>>
|
||
|
||
" "
|
||
|
||
"SUBTITLE Garbage collector"
|
||
|
||
<SETG LIB-GC %<RSUBR-ENTRY '[ZERO LIB-GC #DECL ("VALUE" <OR ATOM FALSE STRING>
|
||
STRING "OPTIONAL" ANY)] 3728>>
|
||
|
||
<SETG LIB-STAT %<RSUBR-ENTRY '[ZERO LIB-STAT #DECL ("VALUE" <OR ATOM FALSE> <OR
|
||
STRING DATA-BASE>)] 5046>>
|
||
|
||
<ENDPACKAGE>
|