mirror of
https://github.com/PDP-10/its.git
synced 2026-02-10 10:19:50 +00:00
270 lines
10 KiB
Plaintext
270 lines
10 KiB
Plaintext
'<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>
|