'<PCODE "1NLIB">

"SUBTITLE Data base definitions" 

<PACKAGE "LIB"> 

<ENTRY DATA-BASE DB-RESET DB-OPEN DB-CLOSE DB-ACCESS DB-HASH-MAP> 

<ENTRY DB-DATA DB-CHAN DB-FLEN DB-CPAGE DB-PAGE0 DB-PAGE1> 

<ENTRY PACKAGE-FIND ENTRY-FIND DEFER-FIND> 

<ENTRY FILNAM LASTUP LASTGC FREEPT HLEN1 HLEN2 HDRLEN> 

<ENTRY BUCKET FCNCHAIN FUNCTION-NAMEBEG PACKAGE-NAMEBEG DB-MIN-ENTRY> 

<ENTRY PACKAGE-CRDATE PACKAGE-ACCESS PACKAGE-ENTLEN> 

<ENTRY LENHACK PTRHACK TYPHACK DEFINF> 

<ENTRY LENGET PTRGET TYPGET CRDATE> 

<ENTRY GET-NAME GET-FILE GET-PACKAGE RPACKAGE?> 

<ENTRY ATOM=? STRING=? MAKE-STRING HASH-NAME> 

<ENTRY DATA-BASES> 

<ENTRY DEF-RP? DEF-PNM DEF-FNM DEF-EL DEF-REL DEF-CRDATE DEF-ACCPTR DEF-ENTLEN 
DEFINF> 

<SETG HDRLEN 6> 

<SETG FILNAM 0> 

<SETG LASTUP 1> 

<SETG LASTGC 2> 

<SETG FREEPT 3> 

<SETG HLEN1 4> 

<SETG HLEN2 5> 

<MANIFEST HDRLEN FILNAM LASTUP LASTGC FREEPT HLEN1 HLEN2> 

<SETG BUCKET 0> 

<SETG FCNCHAIN 1> 

<SETG FUNCTION-NAMEBEG 2> 

<SETG PACKAGE-CRDATE 2> 

<SETG PACKAGE-ACCESS 3> 

<SETG PACKAGE-ENTLEN 4> 

<MANIFEST PACKAGE-CRDATE PACKAGE-ACCESS PACKAGE-ENTLEN> 

<SETG PACKAGE-NAMEBEG 5> 

<MANIFEST BUCKET FCNCHAIN FUNCTION-NAMEBEG PACKAGE-NAMEBEG> 

<SETG PTRGET <BITS 25 0>> 

<SETG LENGET <BITS 10 25>> 

<SETG TYPGET <BITS 1 35>> 

<MANIFEST PTRGET LENGET TYPGET> 

"" 

"SUBTITLE In-core representation of data base" 

<NEWTYPE DATA-BASE VECTOR '<<PRIMTYPE VECTOR> CHANNEL FIX FIX FIX FIX <UVECTOR [
REST FIX]> <PRIMTYPE WORD> FIX>> 

<SETG DB-CHAN 1> 

<SETG DB-BUF 2> 

<SETG DB-PAGE0 3> 

<SETG DB-PAGE1 4> 

<SETG DB-CPAGE 5> 

<SETG DB-DATA 6> 

<SETG DB-BITS 7> 

"Bits for corblk--used in DB-BITS field" 

<SETG DB-FLEN 8> 

"Length of file" 

<MANIFEST DB-CHAN DB-BUF DB-PAGE0 DB-PAGE1 DB-CPAGE DB-DATA DB-BITS DB-FLEN> 

<SETG CBNDR 4096> 

<SETG CBNDW 32768> 

<MANIFEST CBRED CBNDW> 

<SETG PMRD 32768> 

<SETG PMWR 49152> 

<MANIFEST PMRD PMWR> 

<OR <GASSIGNED? DATA-BASES> <SETG DATA-BASES ()>> 

<GDECL (DATA-BASES) LIST> 

"" 

"SUBTITLE What DEFER-FIND returns" 

<PUT DEFINF DECL '<VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>]
[REST FIX]>> 

<SETG DEF-RP? 1> 

<SETG DEF-PNM 2> 

<SETG DEF-FNM 3> 

<SETG DEF-EL 4> 

<SETG DEF-REL 5> 

<SETG DEF-CRDATE 6> 

<SETG DEF-ACCPTR 7> 

<SETG DEF-ENTLEN 8> 

<MANIFEST DEF-RP? DEF-PNM DEF-FNM DEF-EL DEF-REL DEF-CRDATE DEF-ACCPTR 
DEF-ENTLEN> 

"" 

"SUBTITLE Data base primitives" 

"Primitive operations on data base:  open, close, access, reset, print, etc." 

"All known data bases are kept on list DATA-BASES, as pairs:  string,
data base." 

"Print a data base" 

<SETG DB-PRINT  %<RSUBR!- '[ %<PCODE!- "1NLIB" 0> DB-PRINT #DECL ("VALUE" 
CHARACTER DATA-BASE) OUTCHAN "#DATA-BASE [" "->" "<-" " \"" "--HASH--" 
"--FREE--" "READB" NM2 %<RGLOC L-LIBRARY-NAME T> (STRING) %<RGLOC DATA-BASES T> 
%<TYPE-W DATA-BASE VECTOR> ![!] "PRINTB" "PRINTO" %<RGLOC CBNDR T> 
DATA-BASE-IN-BAD-FORMAT DB-RESET %<TYPE-C DATA-BASE VECTOR> T 
NO-BUFFER-AVAILABLE]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DB-PRINT PGLUE ![1073741823 -4194304!]>> 


<PRINTTYPE DATA-BASE ,DB-PRINT> 

"Put data base with specified name on list if not already there, open
it, map in hash table, etc." 

<SETG DB-OPEN %<RSUBR-ENTRY '[DB-PRINT DB-OPEN #DECL ("VALUE" <OR DATA-BASE 
FALSE> STRING "OPTIONAL" ANY <OR FALSE DATA-BASE>)] 212>> 

"Re-initialize existing data base" 

<SETG DB-RESET %<RSUBR-ENTRY '[DB-PRINT DB-RESET #DECL ("VALUE" <OR DATA-BASE 
FALSE> DATA-BASE)] 331>> 

"Close data base:  close channel, flush buffer" 

<SETG DB-CLOSE %<RSUBR-ENTRY '[DB-PRINT DB-CLOSE #DECL ("VALUE" DATA-BASE 
DATA-BASE)] 391>> 

"Cause hash table to be mapped (by accessing to 0)" 

<SETG DB-HASH-MAP %<RSUBR-ENTRY '[DB-PRINT DB-HASH-MAP #DECL ("VALUE" <UVECTOR [
REST FIX]> DATA-BASE)] 426>> 

"" 

"SUBTITLE Extract data from data base" 

"GET-NAME returns a string pointer to the name field of the supplied entry." 

<SETG GET-NAME %<RSUBR-ENTRY '[DB-PRINT GET-NAME #DECL ("VALUE" STRING UVECTOR)]
443>> 

"GET-FILE returns a string pointer to the file name for a package" 

<SETG GET-FILE %<RSUBR-ENTRY '[DB-PRINT GET-FILE #DECL ("VALUE" STRING UVECTOR)]
474>> 

"GET-PACKAGE returns the address in the file of the package entry for
this function" 

<SETG GET-PACKAGE %<RSUBR-ENTRY '[DB-PRINT GET-PACKAGE #DECL ("VALUE" FIX 
UVECTOR)] 506>> 

"" 

"SUBTITLE Library search routines" 

"PACKAGE-FIND looks up a package in the specified data base." 

<SETG PACKAGE-FIND %<RSUBR-ENTRY '[DB-PRINT PACKAGE-FIND #DECL ("VALUE" <OR 
DATA-BASE FALSE STRING> STRING <OR STRING DATA-BASE> "OPTIONAL" <OR ATOM FALSE>)
] 533>> 

<SETG ENTRY-FIND %<RSUBR-ENTRY '[DB-PRINT ENTRY-FIND #DECL ("VALUE" <OR FALSE <
LIST ANY>> <OR STRING ATOM> STRING)] 665>> 

"DEFER-FIND returns false (if the package doesn't exist) or a list of
all the entries in the package, with the file name." 

<SETG DEFER-FIND %<RSUBR-ENTRY '[DB-PRINT DEFER-FIND #DECL ("VALUE" <OR FALSE <
VECTOR <OR ATOM FALSE> STRING STRING [2 <LIST [REST STRING]>] [REST FIX]>> 
STRING <OR STRING DATA-BASE> "OPTIONAL" <OR ATOM FALSE>)] 858>> 

"" 

"SUBTITLE Data base primitive crufties" 

<SETG DB-ACCESS %<RSUBR-ENTRY '[DB-PRINT DB-ACCESS #DECL ("VALUE" <UVECTOR [REST
FIX]> DATA-BASE FIX)] 1082>> 

"" 

"SUBTITLE Library crufties" 

<SETG ATOM=? %<RSUBR-ENTRY '[DB-PRINT ATOM=? #DECL ("VALUE" <OR ATOM FALSE> 
UVECTOR STRING)] 1163>> 

<SETG MAKE-STRING %<RSUBR-ENTRY '[DB-PRINT MAKE-STRING #DECL ("VALUE" STRING 
UVECTOR FIX)] 1193>> 

"" 

"SUBTITLE Hashing function" 

"HASH-NAME takes a string, a uvector (the hash table, which includes the
db header), and a fix, which is the offset in the uv of the hash table
length.  It returns a fix." 

<SETG HASH-NAME %<RSUBR-ENTRY '[DB-PRINT HASH-NAME #DECL ("VALUE" FIX STRING 
UVECTOR FIX)] 1209>> 

"" 

"SUBTITLE Creation date" 

<SETG CRDATE %<RSUBR-ENTRY '[DB-PRINT CRDATE #DECL ("VALUE" FIX CHANNEL)] 1246>> 

<ENDPACKAGE>