X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.comp%3E%2Fsubrty.mud.61;fp=%3Cmdl.comp%3E%2Fsubrty.mud.61;h=692d3d8d213309d126fb531ff8d60465de435692;hp=0000000000000000000000000000000000000000;hb=3395a5e4ef72d59cdb6832af7808dc9c2cf2a413;hpb=363cc6ead5cf4df20759797fe46b5dc29b3886e9

diff --git a/<mdl.comp>/subrty.mud.61 b/<mdl.comp>/subrty.mud.61
new file mode 100644
index 0000000..692d3d8
--- /dev/null
+++ b/<mdl.comp>/subrty.mud.61
@@ -0,0 +1,252 @@
+<PACKAGE "SUBRTY">
+
+<ENTRY SUBRS TEMPLATES>
+
+<USE "COMPDEC" "CHKDCL">
+
+
+; "Functions to decide arg dependent types."
+
+<DEFINE FIRST-ARG ("TUPLE" T) <1 .T>>
+
+<DEFINE SECOND-ARG ("TUPLE" T) <2 .T>>
+
+<DEFINE LOC-FCN (STR "OPTIONAL" N
+		     "AUX" (TEM <MEMQ <ISTYPE? .STR>
+				      ![UVECTOR VECTOR ASOC TUPLE STRING LIST!]>))
+	<COND (.TEM <NTH '![LOCL LOCS LOCA LOCAS LOCV LOCU!] <LENGTH .TEM>>)
+	      (ELSE ANY)>>
+
+<DEFINE MAPF-VALUE ("TUPLE" T) ANY>
+
+<DEFINE MEM-VALUE (ITEM STR "AUX" TEM)
+	<COND (<SET TEM <ISTYPE? .STR>> <FORM OR FALSE <TYPEPRIM .TEM>>)
+	      (ELSE STRUCTURED)>>
+
+<DEFINE SPFIRST-ARG ("TUPLE" T "AUX" TEM)
+	<COND (<SET TEM <STRUCTYP <1 .T>>>
+	       <COND (<==? .TEM TUPLE> VECTOR)(ELSE .TEM)>)>>
+	       
+
+<DEFINE PFIRST-ARG ("TUPLE" T "AUX" TEM)
+	<COND (<SET TEM <STRUCTYP <1 .T>>>)
+	      (ELSE ANY)>>
+
+; "Data structure specifying return types and # of args to common subrs."
+
+<SETG SUBR-DATA
+	![(,*!- ANY '<OR FIX FLOAT> () STACK <> |CTIMES)
+	  (,+!- ANY '<OR FIX FLOAT> () STACK <> |CPLUS)
+	  (,/!- ANY '<OR FIX FLOAT> () STACK <> |CDIVID)
+	  (,-!- ANY '<OR FIX FLOAT> () STACK <> |CMINUS)
+	  (,0?!- 1 '<OR ATOM FALSE>)
+	  (,1?!- 1 '<OR ATOM FALSE>)
+	  (,1STEP!- 1 PROCESS)
+	  (,==?!- 2 '<OR ATOM FALSE>)
+	  (,=?!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B) (,AC-C ,AC-D)) T |CIEQUA)
+	  (,ABS!- 1 '<OR FIX FLOAT>)
+	  (,ACCESS!- 2 CHANNEL)
+	  (,ALLTYPES!- 0 '<VECTOR [REST ATOM]>)
+	  (,ANDB!- ANY WORD)
+	  (,APPLY!- ANY ANY)
+	  (,APPLYTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
+	  (,ARGS!- 1 TUPLE () ((,AC-A ,AC-B)) <> |CARGS)
+	  (,ASCII!- 1 '<OR CHARACTER FIX>)
+	  (,ASSIGNED?!- '(1 2) '<OR ATOM FALSE> () ((ATOM ,AC-B)) T |CASSQ)
+	  (,ASSOCIATIONS!- 0 ASOC)
+	  (,AT!- '(1 2) ,LOC-FCN (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIAT)
+	  (,ATAN!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CATAN)
+	  (,ATOM!- 1 ATOM () ((,AC-A ,AC-B)) <> |CATOM)
+	  (,AVALUE!- 1 ANY)
+	  (,BACK!- '(1 2) ,PFIRST-ARG (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIBACK)
+	  (,BITS!- '(1 2) BITS)
+	  (,BLOAT!- '(0 15) FIX)
+	  (,BLOCK!- 1 '<LIST [REST OBLIST]>)
+	  (,BOUND?!- '(1 2) '<OR ATOM FALSE>)
+	  (,BREAK-SEQ!- 2 PROCESS)
+	  (,CHANLIST!- 0 '<LIST [REST CHANNEL]>)
+	  (,CHANNEL!- '(0 6) CHANNEL)
+	  (,CHTYPE!- 2 ANY)
+	  (,CHUTYPE!- 2 UVECTOR () ((UVECTOR ,AC-A) (ATOM ,AC-B)) <> |CCHUTY)
+	  (,CLOSE!- 1 CHANNEL)
+	  (,CONS!- 2 LIST () ((,AC-C ,AC-D) (LIST ,AC-E)) <> |CICONS)
+	  (,COS!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CCOS)
+	  (,CRLF 1 ATOM () ((,AC-A ,AC-B)) <> |CICRLF)
+	  (,DISABLE!- 1 IHEADER)
+	  ;(,DISPLAY!- 2 ANY)
+	  (,ECHOPAIR!- 2 CHANNEL)
+	  (,EMPTY?!- 1 '<OR FALSE ATOM> () ((,AC-A ,AC-B)) T |CEMPTY)
+	  (,ENABLE!- 1 IHEADER)
+	  (,ENDBLOCK!- 0 '<LIST [REST OBLIST]>)
+	  (,EQVB!- ANY WORD)
+	  ;(,ERASE!- '(1 2) ANY)
+	  (,ERRET!- '(0 2) ANY)
+	  (,ERRORS!- 0 OBLIST)
+	  (,EVAL!- '(1 2) ANY)
+	  (,EVALTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
+	  (,EVENT!- '(1 3) IHEADER)
+	  (,EXP!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CEXP)
+	  (,FIX!- 1 FIX () ((,AC-A ,AC-B)) <> |CFIX)
+	  (,FLATSIZE!- 3 '<OR FALSE FIX> () ((,AC-A ,AC-B) (FIX ,AC-D) (FIX ,AC-C))
+	   T |CIFLTZ)
+	  (,FLOAD!- '(0 5) STRING)		;"\"DONE\""
+	  (,FLOAT!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CFLOAT)
+	  (,FORM!- ANY FORM () STACK <> |IIFORM)
+	  (,FRAME!- '(0 1) FRAME (#LOSE 0) ((,AC-A ,AC-B)) <> |CFRAME)
+	  ;(,FREE!- 1 STORAGE)
+	  (,FREE-RUN!- 1 <OR FALSE PROCESS>)
+	  (,FUNCT!- 1 ATOM () ((,AC-A ,AC-B)) <> |CFUNCT)
+	  (,G=?!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CGEQ)
+	  (,G?!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CGQ)
+	  (,GASSIGNED?!- 1 '<OR FALSE ATOM> () ((ATOM ,AC-B)) T |CGASSQ)
+	  (,GC!- '(0 3) FIX)
+	  (,GET!- '(2 3) ANY () ((,AC-A ,AC-B) (,AC-C ,AC-D)) T |CIGET)
+	  (,GETBITS!- 2 WORD)
+	  (,GETL!- '(2 3) LOCAS () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CIGETL)
+	  (,GETPROP!- '(2 3) ANY)
+	  (,GLOC!- '(1 2) LOCD () ((ATOM ,AC-B)) <> |CGLOC)
+	  (,GO!- 1 ANY)
+	  (,MULTI-SECTION!- '(0 1) ANY)
+	  (,GUNASSIGN!- 1 ATOM)
+	  (,GVAL!- 1 ANY)
+	  (,HANDLER!- '(2 3) HANDLER)
+	  (,IFORM!- '(1 2) FORM)
+	  (,ILIST!- '(1 2) LIST)
+	  (,IMAGE!- '(1 2) FIX)
+	  (,IN!- 1 ANY () ((,AC-A ,AC-B)) <> |CIN)
+	  (,INDICATOR!- 1 ANY)
+	  (,INSERT!- 2 ATOM () ((,AC-A ,AC-B) (OBLIST ,AC-C)) <> |CINSER)
+	  (,INT-LEVEL!- '(0 1) FIX)
+	  (,INTERRUPT!- ANY '<OR FALSE ATOM>)
+	  (,INTERRUPTS!- 0 OBLIST)
+	  (,ISTRING!- '(1 2) STRING)
+	  (,ITEM!- 1 ANY)
+	  (,ITUPLE!- '(1 2) TUPLE)
+	  (,IUVECTOR!- '(1 2) UVECTOR)
+	  (,IVECTOR!- '(1 2) VECTOR)
+	  (,L=?!- 2 '<OR FALSE ATOM> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CLEQ)
+	  (,L?!- 2 '<OR FALSE ATOM> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CLQ)
+	  (,LEGAL?!- 1 '<OR FALSE ATOM> () ((,AC-A ,AC-B)) T |CILEGQ)
+	  (,LENGTH!- 1 FIX () ((,AC-A ,AC-B)) <> |CILNT)
+	  (,LENGTH? 2  '<OR FALSE FIX> () ((,AC-A ,AC-B) (FIX ,AC-C)) T |CILNQ)
+	  (,LINK!- '(2 3) ,FIRST-ARG)
+	  (,LIST!- ANY LIST () STACK <> |IILIST)
+	  (,LISTEN!- ANY ANY)
+	  (,LLOC!- '(1 2) LOCD () ((ATOM ,AC-B)) <> |CLLOC)
+	  (,LOAD!- '(1 2) STRING)
+	  (,LOG!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CLOG)
+	  (,LOGOUT!- 0 FALSE)
+	  (,LOOKUP!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B) (OBLIST ,AC-C))
+		T |CLOOKU)
+	  (,LVAL!- '(1 2) ANY)
+	  (,MAIN!- 0 PROCESS)
+	  (,MAPF!- ANY ,MAPF-VALUE)
+	  (,MAPR!- ANY ,MAPF-VALUE)
+	  (,MAX!- ANY '<OR FIX FLOAT> () STACK <> |CMAX)
+	  (,ME!- 0 PROCESS)
+	  (,MEMBER!- 2 ,MEM-VALUE () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CIMEMB)
+	  (,MEMQ!- 2 ,MEM-VALUE () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CIMEMQ)
+	  (,MIN!- ANY '<OR FIX FLOAT> () STACK <> |CMIN)
+	  (,MOBLIST!- '(0 2) OBLIST)
+	  (,MOD!- 2 '<OR FIX FLOAT>)
+	  (,MONAD?!- 1 '<OR ATOM FALSE> () ((,AC-A ,AC-B)) T |CIMON)
+	  (,N==?!- 2 '<OR FALSE ATOM>)
+	  (,N=?!- 2 '<OR FALSE ATOM> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CINEQU)
+	  (,NETACC!- 1 CHANNEL)
+	  (,NETS!- 1 CHANNEL)
+	  (,NETSTATE!- 1 '<UVECTOR [3 FIX]>)
+	  (,NEWTYPE!- '(2 3) ATOM)
+	  (,NEXT!- 1 '<OR ASOC FALSE>)
+	  (,NEXTCHR!- 1 ANY () ((,AC-A ,AC-B)) <> |CNXTC1)
+	  (,NOT!- 1 '<OR ATOM FALSE>)
+	  (,NTH!- '(1 2) ANY (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CINTH)
+	  (,OBLIST?!- 1 '<OR FALSE OBLIST>)
+	  (,OFF!- '(1 2) '<OR HANDLER IHEADER FALSE>)
+	  (,ON!- '(3 5) HANDLER)
+	  (,OPEN!- '(0 6) '<OR CHANNEL FALSE>)
+	  (,ORB!- ANY WORD)
+	  (,PARSE!- '(0 5) ANY)
+	  (,PNAME!- 1 STRING () ((ATOM ,AC-A)) <> |CIPNAM)
+	  (,PRIMTYPE!- 1 ATOM () ((,AC-A DONT-CARE)) <> |CPTYPE)
+	  (,PRINC!- '(1 2) ,FIRST-ARG)
+	  (,PRIN1!- '(1 2) ,FIRST-ARG)
+	  (,PRINT!- '(1 2) ,FIRST-ARG)
+	  (,PRINTB!- 2 UVECTOR)
+	  (,PRINTTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
+	  (,PROCESS!- 1 PROCESS)
+	  (,PUT!- '(2 3) ANY)
+	  (,PUTBITS!- '(2 3) ,FIRST-ARG)
+	  (,PUTPROP!- '(2 3) ANY)
+	  (,PUTREST!- 2 ,FIRST-ARG)
+	  (,QUIT!- 0 FALSE)
+	  (,QUITTER!- 2 ANY)
+	  (,RANDOM!- '(0 2) FIX () () <> |CRAND)
+	  (,READ!- '(0 4) ANY)
+	  (,READB!- '(2 3) FIX)
+	  (,READCHR!- 1 ANY () ((,AC-A ,AC-B)) <> |CREDC1)
+	  (,REMOVE!- '(1 2) '<OR ATOM FALSE> (0) ((,AC-A ,AC-B)(OBLIST ,AC-C))
+		     <> |CIRMV)
+	  (,RENAME!- '(1 9) '<OR ATOM FALSE CHANNEL>)
+	  (,RESET!- 1 '<OR FALSE  CHANNEL>)
+	  (,REST!- '(1 2) ,PFIRST-ARG (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIREST)
+	  (,RESTORE!- '(1 4) ANY)
+	  (,RESUME!- '(1 2) ANY)
+	  (,RESUMER!- '(0 1) '<OR FALSE PROCESS>)
+	  (,RETRY!- '(0 1) ANY)
+	  (,RETURN!- '(1 2) ANY)
+	  (,ROOT!- 0 OBLIST)
+	  (,RSUBR!- 1 RSUBR)
+	  (,SAVE!- '(0 4) STRING)
+	  (,SET!- '(2 3) ,SECOND-ARG)
+	  (,SETG!- 2 ,SECOND-ARG)
+	  (,SETLOC!- 2 ,SECOND-ARG)
+	  (,SIN!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CSIN)
+	  (,SNAME!- '(0 1) STRING)
+	  (,SORT!- ANY ,SECOND-ARG)
+	  (,SPNAME 1 STRING () ((ATOM ,AC-B)) <> |CSPNAM)
+	  (,SQRT!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CSQRT)
+	  (,STATE!- 1 ATOM)
+	  ;(,STORE!- 1 STORAGE)
+	  (,STRCOMP!- 2 FIX () ((,AC-A ,AC-B)(,AC-C ,AC-D)) <> |ISTRCM)
+	  (,STRING!- ANY STRING () STACK <> |CISTNG)
+	  (,STRUCTURED?!- 1 '<OR FALSE ATOM> () ((,AC-A DONT-CARE)) T |CISTRU)
+	  (,SUBSTRUC!- ANY ,SPFIRST-ARG () STACK <> |CSBSTR)
+	  (,SUICIDE!- '(1 2) ANY)
+	  (,TAG!- 1 TAG)
+	  (,TERPRI!- 1 FALSE () ((,AC-A ,AC-B)) <> |CITERP)
+	  (,TIME!- ANY FLOAT)
+	  (,TOP!- 1 ,PFIRST-ARG () ((,AC-A ,AC-B)) <> |CITOP)
+	  (,TTYECHO!- 2 CHANNEL)
+	  (,TUPLE!- ANY TUPLE)
+	  (,TYI!- '(0 1) CHARACTER)
+	  (,TYPE!- 1 ATOM () ((,AC-A DONT-CARE)) <> |CITYPE)
+	  (,TYPE-C '(1 2) TYPE-C (ANY) ((ATOM ,AC-B)(ATOM ,AC-C)) <> |CTYPEC)
+	  (,TYPE-W '(1 3) TYPE-W (ANY 0) ((ATOM ,AC-B)(ATOM ,AC-C)(FIX ,AC-D)) <>
+		|CTYPEW)
+	  (,TYPE?!- ANY '<OR ATOM FALSE> () STACK T |CTYPEQ)
+	  (,TYPEPRIM!- 1 ATOM () ((ATOM ,AC-B)) <> |CTYPEP)
+	  (,UNASSIGN!- '(1 2) ATOM)
+	  (,UNPARSE!- 2 STRING () ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIUPRS)
+	  (,UTYPE!- 1 ATOM () ((UVECTOR ,AC-B)) <> |CUTYPE)
+	  (,UVECTOR!- ANY UVECTOR () STACK <> |CIUVEC)
+	  (,VALID-TYPE? 1 '<OR FALSE TYPE-C> () ((ATOM ,AC-B)) T |CVTYPE)
+	  (,VALRET!- 1 FALSE)
+	  (,VALUE!- 1 ANY)
+	  (,VECTOR!- ANY VECTOR () STACK <> |CIVEC)
+	  (,XORB!- ANY WORD)!]>
+
+<SETG SUBRS <MAPF ,UVECTOR 1 ,SUBR-DATA>>
+
+<SETG TEMPLATES <MAPF ,UVECTOR ,REST ,SUBR-DATA>>
+
+<PROG (I)
+	<SETG TEMPLATES
+		<IUVECTOR <SET I <LENGTH ,TEMPLATES>>
+			  '<PROG ((T <NTH ,TEMPLATES .I>))
+				<SET I <- .I 1>> .T>>>>
+
+<SETG SUBR-DATA ()>
+
+<REMOVE SUBR-DATA>
+
+<ENDPACKAGE>