mirror of
https://github.com/PDP-10/its.git
synced 2026-01-13 15:27:28 +00:00
273 lines
6.0 KiB
Plaintext
273 lines
6.0 KiB
Plaintext
'<PCODE "3NPCK">
|
|
|
|
<BLOCK <ROOT>>
|
|
|
|
\ \ F
|
|
|
|
PACKAGE
|
|
|
|
RPACKAGE
|
|
|
|
ENTRY
|
|
|
|
RENTRY
|
|
|
|
EXTERNAL
|
|
|
|
USE
|
|
|
|
USE-TOTAL
|
|
|
|
USE-DATFILE
|
|
|
|
DROP
|
|
|
|
NULL-OBLIST
|
|
|
|
ENDPACKAGE
|
|
|
|
FILSTR
|
|
|
|
FILPRS
|
|
|
|
L-SEARCH-PATH
|
|
|
|
L-SECOND-NAMES
|
|
|
|
L-LOAD
|
|
|
|
L-LOADER
|
|
|
|
L-DOITEM
|
|
|
|
L-LIBRARY-NAME
|
|
|
|
L-DATFILE-NAME
|
|
|
|
L-DATUM
|
|
|
|
USE-DATUM
|
|
|
|
L-NO-FILES
|
|
|
|
L-NO-MAGIC
|
|
|
|
L-ALWAYS-INQUIRE
|
|
|
|
L-USE-DATFILE
|
|
|
|
L-MUST-DATFILE
|
|
|
|
L-HANDLER
|
|
|
|
L-UNUSE
|
|
|
|
USE-DEFER
|
|
|
|
L-GASSIGNED?
|
|
|
|
L-NO-DEFER
|
|
|
|
L-NOISY
|
|
|
|
L-TRANSLATIONS
|
|
|
|
TRANSLATE
|
|
|
|
UNTRANSLATE
|
|
|
|
TRANSLATIONS
|
|
|
|
IN-COLLECTION
|
|
|
|
<MOBLIST PACKAGE 29>
|
|
|
|
<MOBLIST PKG!-PACKAGE 17>
|
|
|
|
"Set up entries in LIB that we use. This eliminates the necessity
|
|
of previous obscene hacks, and may even make it possible to glue this
|
|
crock."
|
|
|
|
<BLOCK (<MOBLIST LIB!-PACKAGE 17> <ROOT>)>
|
|
|
|
ENTRY-FIND
|
|
|
|
PACKAGE-FIND
|
|
|
|
DEFER-FIND
|
|
|
|
DEFINF
|
|
|
|
DEF-RP?
|
|
|
|
DEF-PNM
|
|
|
|
DEF-FNM
|
|
|
|
DEF-EL
|
|
|
|
DEF-REL
|
|
|
|
DEF-CRDATE
|
|
|
|
DEF-ACCPTR
|
|
|
|
DEF-ENTLEN
|
|
|
|
CRDATE
|
|
|
|
<ENDBLOCK>
|
|
|
|
<SETG OBLIST (<GET INITIAL OBLIST> <ROOT>)>
|
|
|
|
<BLOCK (<MOBLIST IPKG!-PKG!-PACKAGE 23> <GET PKG!-PACKAGE OBLIST> <ROOT> <GET
|
|
LIB!-PACKAGE OBLIST>)>
|
|
|
|
<PARSE "SEARCH!-PKG!-PACKAGE">
|
|
|
|
<SETG PKG!-PACKAGE .OBLIST>
|
|
|
|
<SETG PKG-OB <GET PACKAGE OBLIST>>
|
|
|
|
<SETG COL-OB <MOBLIST RPACKAGE 7>>
|
|
|
|
<SETG L-SEARCH-PATH <COND (<G? ,MUDDLE 100> '("LIBMUD" [] "PS:<MDLLIB>LIBMUD" [
|
|
"PS" "MDLLIB"])) ('("LIBMUD" [] "LIBMUD;LIBMUD" ["DSK" "MBPROG"] ["DSK" "MPROG"
|
|
">"]))>>
|
|
|
|
<SETG L-SECOND-NAMES <COND (<G? ,MUDDLE 100> '["FBIN" "GBIN" "NBIN" "MUD"]) ('[
|
|
"FBIN" "GBIN" "NBIN" ">"])>>
|
|
|
|
<GDECL (L-SECOND-NAMES) VECTOR (L-SEARCH-PATH) <LIST [REST <OR STRING VECTOR>]>
|
|
(MUDDLE) FIX>
|
|
|
|
<SETG L-LIBRARY-NAME "NLIB">
|
|
|
|
<SETG L-DATFILE-NAME "DAT">
|
|
|
|
<SETG L-NO-FILES <>>
|
|
|
|
<SETG L-NOISY T>
|
|
|
|
<OR <GASSIGNED? L-TRANSLATIONS> <SETG L-TRANSLATIONS ()>>
|
|
|
|
<SETG SAVSTR <REST " " 6>>
|
|
|
|
<SETG \ \ F %<RSUBR!- '[ %<PCODE!- "3NPCK" 0> \ \ F #DECL ("TUPLE" ANY)
|
|
ENTRY-FIND DROP USE PACKAGE-FIND DEFER-FIND CRDATE BAD-PURECODE-NAME %<RGLOC
|
|
SAVSTR T> LOAD-FAILED \ \ F "READ" %<RGLOC MUDDLE T> ":<" %<RGLOC L-SEARCH-PATH
|
|
T> OUTCHAN %<RGLOC OUTCHAN T> (CHANNEL) NO-LOAD (ANY) OBLIST "" %<RGLOC PKG-OB T
|
|
> NOT-LOADED %<RGLOC L-NOISY T> "/" "<>" L-LOADER %<RGLOC L-LOADER T> T
|
|
IN-COLLECTION NM2 (STRING) L-ALWAYS-DATFILE %<RGLOC L-ALWAYS-DATFILE T>
|
|
CANT-USE-DATFILE-ENTRY FIND/LOAD %<RGLOC L-DATFILE-NAME T> USE-DEFER
|
|
DATFILE-MISSING CANT-FIND-PACKAGE LOAD-DATFILE %<RGLOC L-NO-FILES T>
|
|
PACKAGE-FIND "DSK" %<RGLOC L-SECOND-NAMES T> IOBLIST %<RGLOC COL-OB T> ENTRY
|
|
NOT-IN-PACKAGE-OR-COLLECTION!-ERRORS ALREADY-USED-ELSEWHERE!-ERRORS
|
|
L-USE-DATFILE %<RGLOC L-USE-DATFILE T> USE PACKAGE NOT-FOUND!-ERRORS
|
|
"PACKAGE DID NOT DEFINE FUNCTION" DROP NOT-PACKAGE-OR-COLLECTION!-ERRORS %<RGLOC
|
|
NULL-OBLIST T> UNMATCHED-ENDPACKAGE-OR-ENDCOLLECTION!-ERRORS "PACKAGE REMOVED"
|
|
%<RGLOC UDOB T> "DATUM REMOVED" #FALSE ("NOT PACKAGE OR DATUM") %<RGLOC
|
|
L-TRANSLATIONS T> %<RGLOC L-NO-DEFER T> %<RGLOC DEFER-FIND T> #FALSE (
|
|
"DATUM NOT FOUND") #FALSE ("NOT TRANSLATED") "No translations" "-->" %<RGLOC
|
|
PACKAGE-FIND T> REDEFINE UNASSIGNED-VARIABLE!-ERRORS GVAL
|
|
UNBOUND-VARIABLE!-ERRORS VALUE CALLER %<RGLOC ERRET T> %<RGLOC L-NO-MAGIC T> %<
|
|
RGLOC IOB T> %<RGLOC L-ALWAYS-INQUIRE T> "
|
|
To get " " dynamically load
|
|
0 none -- generate error
|
|
" " " " from " "# to load? " %<RGLOC INCHAN T>]>>
|
|
<AND <ASSIGNED? GLUE> .GLUE <PUT ,\ \ F PGLUE ![715915263 -1 -1 -1 -1
|
|
-17179869184!]>>
|
|
|
|
|
|
<SETG FILSTR %<RSUBR-ENTRY '[\ \ F FILSTR #DECL ("VALUE" STRING "TUPLE" <TUPLE [
|
|
REST STRING]>)] 101>>
|
|
|
|
<SETG FILPRS %<RSUBR-ENTRY '[\ \ F FILPRS #DECL ("VALUE" <LIST [4 STRING] [REST
|
|
STRING]> STRING)] 182>>
|
|
|
|
<SETG SEARCH %<RSUBR-ENTRY '[\ \ F SEARCH #DECL ("VALUE" <OR CHANNEL FALSE <
|
|
VECTOR <VECTOR <OR ATOM FALSE> [2 STRING] [2 <LIST [REST STRING]>] [REST FIX]>
|
|
STRING>> ANY <LIST [REST <OR STRING VECTOR>]> "OPTIONAL" <OR ATOM FALSE>)] 737>>
|
|
|
|
<SETG PACKAGE %<RSUBR-ENTRY '[\ \ F PACKAGE #DECL ("VALUE" ATOM STRING
|
|
"OPTIONAL" STRING FIX FIX)] 908>>
|
|
|
|
<SETG RPACKAGE %<RSUBR-ENTRY '[\ \ F RPACKAGE #DECL ("VALUE" ATOM STRING
|
|
"OPTIONAL" STRING FIX)] 1086>>
|
|
|
|
<SETG RENTRY %<RSUBR-ENTRY '[\ \ F RENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
|
|
REST ATOM]>)] 1248>>
|
|
|
|
<SETG ENTRY %<RSUBR-ENTRY '[\ \ F ENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
|
|
ATOM]>)] 1278>>
|
|
|
|
<SETG USE-DATFILE %<RSUBR-ENTRY '[\ \ F USE-DATFILE #DECL ("VALUE" ATOM "TUPLE"
|
|
ANY)] 1415>>
|
|
|
|
<SETG USE %<RSUBR-ENTRY '[\ \ F USE #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
|
|
STRING]>)] 1510>>
|
|
|
|
<SETG USE-TOTAL %<RSUBR-ENTRY '[\ \ F USE-TOTAL #DECL ("VALUE" ATOM "TUPLE" <
|
|
TUPLE [REST STRING]>)] 1683>>
|
|
|
|
<SETG L-NO-DEFER <>>
|
|
|
|
<SETG L-GASSIGNED? %<RSUBR-ENTRY '[\ \ F L-GASSIGNED? #DECL ("VALUE" <OR ATOM
|
|
FALSE> ANY)] 1963>>
|
|
|
|
<SETG EXTERNAL ,USE>
|
|
|
|
<SETG DROP %<RSUBR-ENTRY '[\ \ F DROP #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
|
|
STRING]>)] 2054>>
|
|
|
|
<SETG NULL-OBLIST <MOBLIST NULL 1>>
|
|
|
|
<SETG ENDPACKAGE %<RSUBR-ENTRY '[\ \ F ENDPACKAGE #DECL ("VALUE" ATOM "OPTIONAL"
|
|
<OR FALSE ATOM STRING>)] 2263>>
|
|
|
|
<SETG L-UNUSE %<RSUBR-ENTRY '[\ \ F L-UNUSE #DECL ("VALUE" <OR ATOM STRING !<
|
|
FALSE STRING!>> <OR STRING FALSE>)] 2450>>
|
|
|
|
<SETG USE-DEFER %<RSUBR-ENTRY '[\ \ F USE-DEFER #DECL ("VALUE" ATOM "TUPLE" <
|
|
TUPLE [REST STRING]>)] 2608>>
|
|
|
|
<SETG L-DATUM %<RSUBR-ENTRY '[\ \ F L-DATUM #DECL ("VALUE" ANY ANY "OPTIONAL"
|
|
ANY)] 2972>>
|
|
|
|
<SETG UDOB <MOBLIST USE-DATUM 17>>
|
|
|
|
<SETG USE-DATUM %<RSUBR-ENTRY '[\ \ F USE-DATUM #DECL ("VALUE" ANY ANY)] 3035>>
|
|
|
|
<SETG TRANSLATE %<RSUBR-ENTRY '[\ \ F TRANSLATE #DECL ("VALUE" <OR FALSE STRING>
|
|
STRING <OR FALSE STRING>)] 3088>>
|
|
|
|
<SETG UNTRANSLATE %<RSUBR-ENTRY '[\ \ F UNTRANSLATE #DECL ("VALUE" <OR STRING !<
|
|
FALSE STRING!>> STRING)] 3149>>
|
|
|
|
<SETG TRANSLATIONS %<RSUBR-ENTRY '[\ \ F TRANSLATIONS #DECL ("VALUE" ATOM)] 3214
|
|
>>
|
|
|
|
<SETG L-LOAD %<RSUBR-ENTRY '[\ \ F L-LOAD #DECL ("VALUE" <OR CHANNEL FALSE
|
|
STRING> ANY "OPTIONAL" ANY)] 3360>>
|
|
|
|
<SETG L-NO-MAGIC <>>
|
|
|
|
<SETG L-ALWAYS-INQUIRE <>>
|
|
|
|
<SETG IOB <GET <LOOKUP "INITIAL" <ROOT>> OBLIST>>
|
|
|
|
<SETG L-HANDLER %<RSUBR-ENTRY '[\ \ F L-HANDLER #DECL ("VALUE" ANY FRAME "TUPLE"
|
|
TUPLE)] 3413>>
|
|
|
|
"Load library hackers"
|
|
|
|
<USE "LIB">
|
|
|
|
<ENDBLOCK>
|
|
|
|
<ENDBLOCK>
|
|
|
|
<SET OBLIST ,OBLIST>
|
|
|
|
<ON "ERROR" ,L-HANDLER 100>
|