mirror of
https://github.com/PDP-10/its.git
synced 2026-01-11 23:53:12 +00:00
239 lines
5.7 KiB
Plaintext
239 lines
5.7 KiB
Plaintext
'<PCODE "NPCK">
|
|
|
|
<BLOCK <ROOT>>
|
|
|
|
PACKAGE
|
|
|
|
RPACKAGE
|
|
|
|
ENTRY
|
|
|
|
RENTRY
|
|
|
|
EXTERNAL
|
|
|
|
USE
|
|
|
|
USE-TOTAL
|
|
|
|
DROP
|
|
|
|
NULL-OBLIST
|
|
|
|
ENDPACKAGE
|
|
|
|
FILSTR
|
|
|
|
FILPRS
|
|
|
|
L-SEARCH-PATH
|
|
|
|
L-SECOND-NAMES
|
|
|
|
L-LOAD
|
|
|
|
L-LOADER
|
|
|
|
L-DOITEM
|
|
|
|
L-LIBRARY-NAME
|
|
|
|
L-DATUM
|
|
|
|
USE-DATUM
|
|
|
|
L-NO-FILES
|
|
|
|
L-NO-MAGIC
|
|
|
|
L-ALWAYS-INQUIRE
|
|
|
|
L-HANDLER
|
|
|
|
L-UNUSE
|
|
|
|
USE-DEFER
|
|
|
|
L-GASSIGNED?
|
|
|
|
L-NO-DEFER
|
|
|
|
L-NOISY
|
|
|
|
L-TRANSLATIONS
|
|
|
|
TRANSLATE
|
|
|
|
UNTRANSLATE
|
|
|
|
TRANSLATIONS
|
|
|
|
<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
|
|
|
|
<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" "<LIBMUD>LIBMUD" [] [
|
|
"MDLLIB"])) ('("LIBMUD" "LIBMUD;LIBMUD" [] ["MBPROG"] ["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>]>>
|
|
|
|
<SETG L-LIBRARY-NAME "LIB">
|
|
|
|
<SETG L-NO-FILES <>>
|
|
|
|
<SETG L-NOISY T>
|
|
|
|
<SETG L-TRANSLATIONS ()>
|
|
|
|
<SETG FILSTR %<RSUBR!- '[ %<PCODE!- "NPCK" 0> FILSTR #DECL ("VALUE" STRING
|
|
"TUPLE" <TUPLE [REST STRING]>) USE DROP ENTRY-FIND PACKAGE-FIND "READ" %<RGLOC
|
|
MUDDLE T> ":<" %<RGLOC L-SEARCH-PATH T> OUTCHAN %<RGLOC OUTCHAN T> (CHANNEL)
|
|
OBLIST "" %<RGLOC PKG-OB T> %<RGLOC L-NOISY T> "/" "<>" L-LOADER %<RGLOC
|
|
L-LOADER T> T IN-COLLECTION %<RGLOC L-NO-FILES T> PACKAGE-FIND %<RGLOC
|
|
L-SECOND-NAMES T> "DSK" IOBLIST %<RGLOC COL-OB T> USE-DEFER ENTRY
|
|
NOT-IN-PACKAGE-OR-COLLECTION!-ERRORS ALREADY-USED-ELSEWHERE!-ERRORS 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 (ANY)
|
|
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 ,FILSTR PGLUE ![717225983 -1 -1 -4 0!]>>
|
|
|
|
|
|
<SETG FILPRS %<RSUBR-ENTRY '[FILSTR FILPRS #DECL ("VALUE" <LIST [4 STRING] [REST
|
|
STRING]> STRING)] 84>>
|
|
|
|
<SETG FIND/LOAD %<RSUBR-ENTRY '[FILSTR FIND/LOAD #DECL ("VALUE" <OR ATOM CHANNEL
|
|
FALSE> STRING "OPTIONAL" <OR LIST STRING>)] 122>>
|
|
|
|
<SETG SEARCH %<RSUBR-ENTRY '[FILSTR SEARCH #DECL ("VALUE" <OR CHANNEL FALSE> ANY
|
|
<LIST [REST <OR STRING VECTOR>]>)] 359>>
|
|
|
|
<SETG PACKAGE %<RSUBR-ENTRY '[FILSTR PACKAGE #DECL ("VALUE" ATOM STRING
|
|
"OPTIONAL" STRING FIX FIX)] 481>>
|
|
|
|
<SETG RPACKAGE %<RSUBR-ENTRY '[FILSTR RPACKAGE #DECL ("VALUE" ATOM STRING
|
|
"OPTIONAL" STRING FIX)] 644>>
|
|
|
|
<SETG RENTRY %<RSUBR-ENTRY '[FILSTR RENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
|
|
REST ATOM]>)] 791>>
|
|
|
|
<SETG ENTRY %<RSUBR-ENTRY '[FILSTR ENTRY #DECL ("VALUE" ATOM "TUPLE" <TUPLE [
|
|
REST ATOM]>)] 821>>
|
|
|
|
<SETG DO-ENTRY %<RSUBR-ENTRY '[FILSTR DO-ENTRY #DECL ("VALUE" ATOM <TUPLE [REST
|
|
ATOM]> OBLIST)] 855>>
|
|
|
|
<SETG USE %<RSUBR-ENTRY '[FILSTR USE #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
|
|
STRING]>)] 965>>
|
|
|
|
<SETG USE-TOTAL %<RSUBR-ENTRY '[FILSTR USE-TOTAL #DECL ("VALUE" ATOM "TUPLE" <
|
|
TUPLE [REST STRING]>)] 1117>>
|
|
|
|
<SETG L-NO-DEFER <>>
|
|
|
|
<SETG L-GASSIGNED? %<RSUBR-ENTRY '[FILSTR L-GASSIGNED? #DECL ("VALUE" <OR ATOM
|
|
FALSE> ANY)] 1393>>
|
|
|
|
<SETG EXTERNAL ,USE>
|
|
|
|
<SETG DROP %<RSUBR-ENTRY '[FILSTR DROP #DECL ("VALUE" ATOM "TUPLE" <TUPLE [REST
|
|
STRING]>)] 1487>>
|
|
|
|
<SETG NULL-OBLIST <MOBLIST NULL 1>>
|
|
|
|
<SETG ENDPACKAGE %<RSUBR-ENTRY '[FILSTR ENDPACKAGE #DECL ("VALUE" ATOM)] 1696>>
|
|
|
|
<SETG L-UNUSE %<RSUBR-ENTRY '[FILSTR L-UNUSE #DECL ("VALUE" <OR ATOM STRING !<
|
|
FALSE STRING!>> <OR STRING FALSE>)] 1844>>
|
|
|
|
<SETG TRANSLATE? %<RSUBR-ENTRY '[FILSTR TRANSLATE? #DECL ("VALUE" <OR FALSE
|
|
STRING> STRING)] 1963>>
|
|
|
|
<SETG USE-DEFER %<RSUBR-ENTRY '[FILSTR USE-DEFER #DECL ("VALUE" ATOM "TUPLE" <
|
|
TUPLE [REST STRING]>)] 2005>>
|
|
|
|
<SETG L-DATUM %<RSUBR-ENTRY '[FILSTR L-DATUM #DECL ("VALUE" ANY ANY "OPTIONAL"
|
|
ANY)] 2368>>
|
|
|
|
<SETG UDOB <MOBLIST USE-DATUM 17>>
|
|
|
|
<SETG USE-DATUM %<RSUBR-ENTRY '[FILSTR USE-DATUM #DECL ("VALUE" ANY ANY)] 2429>>
|
|
|
|
<SETG TRANSLATE %<RSUBR-ENTRY '[FILSTR TRANSLATE #DECL ("VALUE" <OR FALSE STRING
|
|
> STRING <OR FALSE STRING>)] 2482>>
|
|
|
|
<SETG UNTRANSLATE %<RSUBR-ENTRY '[FILSTR UNTRANSLATE #DECL ("VALUE" <OR STRING
|
|
!<FALSE STRING!>> STRING)] 2543>>
|
|
|
|
<SETG TRANSLATIONS %<RSUBR-ENTRY '[FILSTR TRANSLATIONS #DECL ("VALUE" ATOM)]
|
|
2608>>
|
|
|
|
<SETG GDCHN %<RSUBR-ENTRY '[FILSTR GDCHN #DECL ("VALUE" ANY STRING <OR LIST
|
|
STRING> "OPTIONAL" ANY)] 2685>>
|
|
|
|
<SETG L-LOAD %<RSUBR-ENTRY '[FILSTR L-LOAD #DECL ("VALUE" <OR CHANNEL FALSE
|
|
STRING> ANY "OPTIONAL" ANY)] 2764>>
|
|
|
|
<SETG L-NO-MAGIC <>>
|
|
|
|
<SETG L-ALWAYS-INQUIRE <>>
|
|
|
|
<SETG IOB <GET <LOOKUP "INITIAL" <ROOT>> OBLIST>>
|
|
|
|
<SETG L-HANDLER %<RSUBR-ENTRY '[FILSTR L-HANDLER #DECL ("VALUE" ANY FRAME
|
|
"TUPLE" TUPLE)] 2817>>
|
|
|
|
<SETG DISP-CHOICE %<RSUBR-ENTRY '[FILSTR DISP-CHOICE #DECL ("VALUE" <OR FALSE <
|
|
LIST [REST <OR ATOM FALSE STRING>]>> <LIST [REST STRING STRING <OR ATOM FALSE> <
|
|
OR ATOM FALSE>]> ANY)] 3177>>
|
|
|
|
"Load library hackers"
|
|
|
|
<USE "LIB">
|
|
|
|
<ENDBLOCK>
|
|
|
|
<ENDBLOCK>
|
|
|
|
<SET OBLIST ,OBLIST>
|
|
|
|
<ON "ERROR" ,L-HANDLER 100>
|