--- /dev/null
+<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>
+\f
+<ENDPACKAGE>
projects / pdp10-muddle.git / blobdiff