'<PCODE "1MNEME">

<PACKAGE "MNEME"> 

<BLOAT 45000 0 2000 3000 50> 

<ENTRY MNEME-INIT MNUM-EXIST STORALLOC MNEMECHN SUPERFIND LIST-MNEME-EXIST DHT 
STR-TO-FIX MNEME-LIST MNEME-NTH OWT NREVERSE FINDVAL MNEME-EXIST MNEME-VERBOSE 
STR-TO-NUM UV-ZAP FINDVALS MNEME-COMP MNEME-VERSION SHASH COLON-CHK FINDOBJ 
MNEME-EXIST? MNEME-TO-MUDDLE FIND FINDS FINDUSE MNEME-INSTANCE MNEME-PAGE-OUT 
HASH-ATOM FINDUSES GROUP-PAGE-OUT MNEME-ATOM MNEME-CLOSE FINDOBJS RECLAIM-MIN 
NEW-USES MNEME-TYPE? TRANSCHK TRANSFINDVAL TRANSFINDOBJ MNUM-ATOM MNEME-LENGTH 
IUBKT STOR STORSIZ MNEME-READ STORNXT STORPLUS1 IHT PARTIAL-PAGE-IN-CHK 
HASH-OWT-ATOM HASH-OWT-INST> 

<SETG MNEME-VERSION 770603> 

<USE "PIO"> 

<SETG PIO-HANG-ON-UNMAP? T> 

<SETG PIO-PAGE-LIMIT 100> 

<GDECL (MNEME-PAGE-OUT) APPLICABLE> 

<SETG GC-OB <MOBLIST GC-OB 1>> 

<SETG MNEME-VERBOSE T> 

<NEWTYPE MNEME-INSTANCE LIST '<LIST <LIST ANY> ANY>> 

<EVALTYPE MNEME-INSTANCE LIST> 

<NEWTYPE OWT WORD> 

<SETG MNEME-IPRINT  %<RSUBR!- '[ %<PCODE!- "1MNEME" 0> MNEME-IPRINT #DECL (
"VALUE" ANY MNEME-INSTANCE) READP NAMEP PRINTP LENGTHP OPENP CLOSEP 
PAGE-OUT-EVERYTHING STORALLOC MNEME-TYPE? OUTCHAN %<TYPE-W OWT WORD> %<TYPE-C 
OWT WORD> "Not-printable-yet" O!-GC-OB (<OR OWT FIX>) O2!-GC-OB MNEMECHN 
"MNEME-CHANNEL-CLOSED" "Trying to print unknown or illegal MNEME-type" 
"Zero mneme item" %<RGLOC STORPLUS1 T> CHANNEL T %<RGLOC STRING5 T> "#MNEME (" 
%<RGLOC STOR T> %<RGLOC STORPLUS2 T> %<TYPE-C MNEME-INSTANCE LIST> %<RGLOC IHT T
> PROBABLY ITM!-GC-OB (FIX) DHT "You forgot to MNEME-INIT." #FALSE (
NON-EXISTENT-ITEM) ![!] USE!-GC-OB NEW-USES ![!\A !\S!] 
"Other amount options not implemented yet" ![MNEME-ATOM MNEME-LIST 
MNEME-INSTANCE!] "Illegal mneme-type to MNEME-LENGTH" 
"MNEME-NTH out of bounds--bad arg to SUPERFIND" "Funny item extracted" IN!-GC-OB
 ![#WORD *000000000001* #WORD *000000000002*!] "MNEME-NTH out of bounds" 
"Wrong type to MNEME-NTH" %<RGLOC STORSIZ T> %<RGLOC STORNXT T> %<RGLOC 
TEMP4-UVEC-LEN T> %<RGLOC TEMP4-UVEC T> %<RGLOC TEMP2-UVEC-LEN T> %<RGLOC 
TEMP2-UVEC T> STORALLOC %<RGLOC MNEME-VERBOSE T> "Increasing STOR" %<RGLOC DHT T
> "READ" %<RGLOC MNEMECHN T> %<TYPE-W CHANP VECTOR> "Done" #FALSE (
"File already closed?") TOPLEVEL %<RGLOC GC-OB T> MNEME-PAGE-OUT %<RGLOC 
MNEME-PAGE-OUT T> "MNEME-GARBAGE-COLLECTION" "RECLAIMED-EVERYTHING" 
"Bad type to hash" "DICT;ERB MNEME" ["READ" "PRINT"] "Paging space > 32767" 
"Closing old channel" IHT STOR "File locked in read-only mode" "READP returns " 
%<RGLOC TCHKLST T> "Illegal type to MNEME-TO-MUDDLE" %<RGLOC TEM-STR T> %<RGLOC 
TEM-STR-LEN T> %<RGLOC NSTR T> INITIAL OBLIST %<RGLOC UBKTLEN T> %<RGLOC UBKT T>
 %<RGLOC TEMP-UVEC-LEN T> %<RGLOC TEMP-UVEC T> %<RGLOC STUVCO T>]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,MNEME-IPRINT PGLUE ![715829247 -1 -1 -1 -1 
-1073741824!]>> 


<PRINTTYPE MNEME-INSTANCE ,MNEME-IPRINT> 

<SETG OWTPRINT %<RSUBR-ENTRY '[MNEME-IPRINT OWTPRINT #DECL ("VALUE" ANY <OR OWT 
FIX>)] 80>> 

<PRINTTYPE OWT ,OWTPRINT> 

<SETG COLON-CHK %<RSUBR-ENTRY '[MNEME-IPRINT COLON-CHK #DECL ("VALUE" <OR FALSE 
FIX> ATOM)] 419>> 

<SETG SHASH %<RSUBR-ENTRY '[MNEME-IPRINT SHASH #DECL ("VALUE" FIX <OR LIST 
MNEME-INSTANCE>)] 445>> 

<SETG HASH-OWT-INST %<RSUBR-ENTRY '[MNEME-IPRINT HASH-OWT-INST #DECL ("VALUE" 
FIX OWT FIX OWT)] 483>> 

<SETG HASH-INST-NAME %<RSUBR-ENTRY '[MNEME-IPRINT HASH-INST-NAME #DECL ("VALUE" 
FIX FIX FIX)] 517>> 

<SETG HASH-ATOM %<RSUBR-ENTRY '[MNEME-IPRINT HASH-ATOM #DECL ("VALUE" FIX <OR 
ATOM STRING> FIX)] 549>> 

<SETG HASH-OWT-ATOM %<RSUBR-ENTRY '[MNEME-IPRINT HASH-OWT-ATOM #DECL ("VALUE" 
FIX OWT FIX)] 530>> 

<SETG NREVERSE %<RSUBR-ENTRY '[MNEME-IPRINT NREVERSE #DECL ("VALUE" <PRIMTYPE 
LIST> <PRIMTYPE LIST>)] 610>> 

<SETG UV-ZAP %<RSUBR-ENTRY '[MNEME-IPRINT UV-ZAP #DECL ("VALUE" <PRIMTYPE 
UVECTOR> <PRIMTYPE UVECTOR>)] 628>> 

<SETG STR-TO-NUM %<RSUBR-ENTRY '[MNEME-IPRINT STR-TO-NUM #DECL ("VALUE" <OR 
FALSE FIX> STRING)] 648>> 

<SETG STR-TO-FIX %<RSUBR-ENTRY '[MNEME-IPRINT STR-TO-FIX #DECL ("VALUE" FIX 
STRING)] 668>> 

<SETG PUT-FIX-IN-STRING %<RSUBR-ENTRY '[MNEME-IPRINT PUT-FIX-IN-STRING #DECL (
"VALUE" STRING <PRIMTYPE WORD> STRING)] 680>> 

<SETG PARTIAL-PAGE-IN-CHK %<RSUBR-ENTRY '[MNEME-IPRINT PARTIAL-PAGE-IN-CHK #DECL
("VALUE" FIX <OR OWT FIX>)] 701>> 

<SETG STRING5 "     "> 

<GDECL (STOR STORPLUS1 STORPLUS2 UBKT TEMP2-UVEC TEMP4-UVEC) <UVECTOR [REST FIX]
> (IHT) <UVECTOR [1536 FIX] [REST FIX]> (TEM-STR STRING5) STRING (DHT) <VECTOR 
STRING STRING FIX> (TEMP2-UVEC-LEN TEMP4-UVEC-LEN TEM-STR-LEN UBKTLEN STORSIZ 
STORNXT) FIX (MNEMECHN) CHANP (MNEME-VERBOSE) <OR FALSE ATOM>> 

<SETG MNEME-COMP %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-COMP #DECL ("VALUE" <OR ATOM
FALSE> OWT <OR ATOM STRING>)] 739>> 

<SETG SUPERFIND %<RSUBR-ENTRY '[MNEME-IPRINT SUPERFIND #DECL ("VALUE" <OR FALSE 
FIX LIST OWT> <OR OWT ATOM FALSE FIX STRING> "OPTIONAL" <OR CHARACTER FIX> <OR 
OWT ATOM FALSE FIX STRING> <OR CHARACTER FIX> <OR FIX CHARACTER> <OR FALSE FIX 
CHARACTER>)] 770>> 

<SETG FINDVAL %<RSUBR-ENTRY '[MNEME-IPRINT FINDVAL #DECL ("VALUE" <OR FALSE FIX 
LIST OWT> <OR OWT ATOM STRING> <OR OWT ATOM STRING>)] 1471>> 

<SETG FINDVALS %<RSUBR-ENTRY '[MNEME-IPRINT FINDVALS #DECL ("VALUE" <OR FALSE 
FIX LIST OWT> <OR OWT ATOM STRING> <OR OWT ATOM STRING>)] 1494>> 

<SETG FINDOBJ %<RSUBR-ENTRY '[MNEME-IPRINT FINDOBJ #DECL ("VALUE" <OR FALSE FIX 
LIST OWT> <OR OWT ATOM STRING> <OR OWT ATOM STRING>)] 1520>> 

<SETG FINDOBJS %<RSUBR-ENTRY '[MNEME-IPRINT FINDOBJS #DECL ("VALUE" <OR FALSE 
FIX LIST OWT> <OR OWT ATOM STRING> <OR OWT ATOM STRING>)] 1543>> 

<SETG FIND %<RSUBR-ENTRY '[MNEME-IPRINT FIND #DECL ("VALUE" <OR FALSE FIX LIST 
OWT> <OR OWT ATOM STRING> <OR OWT ATOM STRING>)] 1569>> 

<SETG FINDS %<RSUBR-ENTRY '[MNEME-IPRINT FINDS #DECL ("VALUE" <OR FALSE FIX LIST
OWT> <OR OWT ATOM STRING> <OR OWT ATOM STRING>)] 1592>> 

<SETG FINDUSE %<RSUBR-ENTRY '[MNEME-IPRINT FINDUSE #DECL ("VALUE" <OR FALSE FIX 
LIST OWT> <OR OWT ATOM STRING>)] 1617>> 

<SETG FINDUSES %<RSUBR-ENTRY '[MNEME-IPRINT FINDUSES #DECL ("VALUE" <OR FALSE 
FIX LIST OWT> <OR OWT ATOM STRING>)] 1630>> 

<SETG MNEME-TYPE? %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-TYPE? #DECL ("VALUE" <OR 
ATOM FALSE> OWT "TUPLE" ANY)] 1654>> 

<SETG MNEME-LENGTH %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-LENGTH #DECL ("VALUE" FIX 
OWT)] 1699>> 

<SETG INT-MNEME-NTH %<RSUBR-ENTRY '[MNEME-IPRINT INT-MNEME-NTH #DECL ("VALUE" <
OR FIX OWT> FIX <OR FIX CHARACTER> FIX)] 1744>> 

<SETG MNEME-NTH %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-NTH #DECL ("VALUE" <OR FIX 
OWT> OWT "OPTIONAL" FIX)] 1809>> 

<SETG PARTIAL-PAGE-IN %<RSUBR-ENTRY '[MNEME-IPRINT PARTIAL-PAGE-IN #DECL (
"VALUE" FIX <OR OWT FIX>)] 1913>> 

<SETG TEMP4-UVEC <IUVECTOR <SETG TEMP4-UVEC-LEN 10> 0>> 

<SETG IUVEC4 %<RSUBR-ENTRY '[MNEME-IPRINT IUVEC4 #DECL ("VALUE" <UVECTOR FIX [
REST FIX]> FIX)] 2040>> 

<SETG TEMP2-UVEC <IUVECTOR <SETG TEMP2-UVEC-LEN 10> 0>> 

<SETG IUVEC2 %<RSUBR-ENTRY '[MNEME-IPRINT IUVEC2 #DECL ("VALUE" <UVECTOR FIX [
REST FIX]> FIX)] 2090>> 

<SETG STORALLOC %<RSUBR-ENTRY '[MNEME-IPRINT STORALLOC #DECL ("VALUE" FIX 
"TUPLE" ANY)] 2140>> 

<SETG STORGRO %<RSUBR-ENTRY '[MNEME-IPRINT STORGRO #DECL ("VALUE" FIX)] 2310>> 

<SETG MNEME-CLOSE %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-CLOSE #DECL ("VALUE" <OR 
STRING <FALSE STRING [REST STRING]>> "OPTIONAL" <OR ATOM FALSE>)] 2346>> 

<SETG PAGE-OUT-EVERYTHING %<RSUBR-ENTRY '[MNEME-IPRINT PAGE-OUT-EVERYTHING #DECL
("VALUE" FIX)] 2419>> 

<SETG GROUP-PAGE-OUT %<RSUBR-ENTRY '[MNEME-IPRINT GROUP-PAGE-OUT #DECL ("VALUE" 
FALSE)] 2639>> 

<SETG FIRSTATOMN %<RSUBR-ENTRY '[MNEME-IPRINT FIRSTATOMN #DECL ("VALUE" FIX ANY)
] 2672>> 

<SETG UVECIFY %<RSUBR-ENTRY '[MNEME-IPRINT UVECIFY #DECL ("VALUE" <UVECTOR FIX> 
ATOM FIX)] 2760>> 

<SETG MNEME-INIT %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-INIT #DECL ("VALUE" <VECTOR 
STRING STRING FIX> "OPTIONAL" STRING STRING FIX <OR FIX FALSE>)] 2803>> 

'<SETG UV0 ![0!]> 

'<GDECL (UV0) <UVECTOR FIX>> 

<SETG MNEME-READ %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-READ #DECL ("VALUE" <OR FIX 
UVECTOR> <OR <UVECTOR FIX> FIX FALSE WORD> <OR FIX OWT WORD>)] 3032>> 

<SETG TRANSFINDVAL %<RSUBR-ENTRY '[MNEME-IPRINT TRANSFINDVAL #DECL ("VALUE" <OR 
FALSE FIX OWT> <OR FALSE FIX OWT> OWT OWT)] 3090>> 

<SETG TRANSFINDOBJ %<RSUBR-ENTRY '[MNEME-IPRINT TRANSFINDOBJ #DECL ("VALUE" <OR 
FALSE FIX OWT> <OR FALSE FIX OWT> OWT OWT)] 3188>> 

<SETG TCHKLST (() () ())> 

<GDECL (TCHKLST) <LIST [3 ANY]>> 

<SETG TRANSCHK %<RSUBR-ENTRY '[MNEME-IPRINT TRANSCHK #DECL ("VALUE" <OR ATOM 
FALSE OWT> OWT OWT OWT)] 3286>> 

<SETG MNEME-TO-MUDDLE %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-TO-MUDDLE #DECL (
"VALUE" <OR FIX STRING <LIST [REST <PRIMTYPE WORD>]>> OWT "OPTIONAL" <OR STRING 
FIX <LIST [REST <OR FIX OWT>]>>)] 3397>> 

<SETG TEM-STR ""> 

<SETG TEM-STR-LEN 0> 

<SETG ISTRI %<RSUBR-ENTRY '[MNEME-IPRINT ISTRI #DECL ("VALUE" STRING FIX)] 3636>
> 

<SETG NSTR <PUT "*000000000000*" 1 <ASCII 26>>> 

<GDECL (NSTR) STRING> 

<SETG MNUM-ATOM %<RSUBR-ENTRY '[MNEME-IPRINT MNUM-ATOM #DECL ("VALUE" <OR ATOM 
STRING> FIX "OPTIONAL" <OR FALSE 'T>)] 3715>> 

<SETG MNUM-EXIST %<RSUBR-ENTRY '[MNEME-IPRINT MNUM-EXIST #DECL ("VALUE" <OR 
FALSE OWT> FIX)] 3841>> 

<SETG MNEME-EXIST %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-EXIST #DECL ("VALUE" <OR 
FALSE OWT> <OR ATOM STRING>)] 3859>> 

<SETG LIST-MNEME-EXIST %<RSUBR-ENTRY '[MNEME-IPRINT LIST-MNEME-EXIST #DECL (
"VALUE" <OR FALSE OWT> LIST)] 4072>> 

<SETG COMPARE-MNEME %<RSUBR-ENTRY '[MNEME-IPRINT COMPARE-MNEME #DECL ("VALUE" <
OR ATOM FALSE> FIX LIST)] 4232>> 

<SETG MNEME-EXIST? %<RSUBR-ENTRY '[MNEME-IPRINT MNEME-EXIST? #DECL ("VALUE" <OR 
FALSE OWT> <OR ATOM LIST STRING FIX>)] 4362>> 

<SETG UBKT <IUVECTOR <SETG UBKTLEN 32> 0>> 

<SETG IUBKT %<RSUBR-ENTRY '[MNEME-IPRINT IUBKT #DECL ("VALUE" <UVECTOR FIX [REST
FIX]> FIX)] 4390>> 

<GDECL (TEMP-UVEC-LEN) FIX (TEMP-UVEC) UVECTOR> 

<SETG TEMP-UVEC <IUVECTOR <SETG TEMP-UVEC-LEN 10> 0>> 

<SETG IUVEC %<RSUBR-ENTRY '[MNEME-IPRINT IUVEC #DECL ("VALUE" <UVECTOR FIX> FIX)
] 4440>> 

<SETG STUVCO [<ISTRING 40 !\ > <ISTRING 36 !\ > <ISTRING 37 !\ > <ISTRING 38 !\ 
> <ISTRING 39 !\ >]> 

<MAPR <> <FUNCTION (X) <PUT .X 1 <REST <1 .X> <LENGTH <1 .X>>>>> ,STUVCO> 

<GDECL (STUVCO) <VECTOR [5 STRING]>> 

<SETG STR-UV-COMP %<RSUBR-ENTRY '[MNEME-IPRINT STR-UV-COMP #DECL ("VALUE" <OR 
ATOM FALSE> STRING UVECTOR "OPTIONAL" <OR ATOM FALSE>)] 4490>> 

<ENDPACKAGE>