X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=mim%2Fdevelopment%2Fmim%2Fmimc%2Fsymana.mud;fp=mim%2Fdevelopment%2Fmim%2Fmimc%2Fsymana.mud;h=fb8b82f0611bf97a1212d93cc0819fae04ac32a4;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hp=0000000000000000000000000000000000000000;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07;p=pdp10-muddle.git diff --git a/mim/development/mim/mimc/symana.mud b/mim/development/mim/mimc/symana.mud new file mode 100644 index 0000000..fb8b82f --- /dev/null +++ b/mim/development/mim/mimc/symana.mud @@ -0,0 +1,2348 @@ + + + + + + + +" This is the main file associated with the type analysis phase of +the compilation. It is called by calling FUNC-ANA with the main data structure +pointer. ANA is the FUNCTION that dispatches to the various special handlers +and the SUBR call analyzer further dispatches for specific functions." + +" Many analyzers for specific SUBRs appear in their own files +(CARITH, STRUCT etc.). Currently no special hacks are done for TYPE?, EMPTY? +etc. in COND, ANDS and ORS." + +" All analysis functions are called with 2 args, a NODE and a desired +type specification. These args are usually called NOD and RTYP or +N and R." + +" ANA is the main analysis dispatcher (see ANALYZERS at the end of + this file for its dispatch table." + + + +)) + #DECL ((NOD) NODE (P) ANY (TEM TT) ) + > + >)> + > + + > + +) + ,QUOTE-CODE> + > + > >)> + FIX>> + )> + >>> + ) + (>> .TEM) + ( > + > + + >> .IT) + (ELSE )>> + .TT>> + .TEM) + (ELSE + 1>> .TEM> + .TT)>) + (ELSE + + >> .IT) + (ELSE )>> + .TEM>> + .TT) + (ELSE + 1>> .TT> + .TEM)>)>) + ( > (!.TEM !.TT)) + (ELSE (!.TT !.TEM))>>)>> + + FIX> (NOD) NODE) + > >)> + + ) + ( + )> + T> + +) + (ELSE )>> + +" FUNC-ANA main entry to analysis phase. Analyzes bindings then body." + + .ANALY-OK) + (ELSE T)>) (OV .VERBOSE)) + #DECL ((ANA-ACT) (ANALY-OK) ) + ()>)> + > + +) (TMPS 0) (HTMPS 0) (TRUTH ()) + (UNTRUTH ()) (WHO ()) (WHON <>) (PRED <>) TEM (LIFE ()) + (USE-COUNT 0) (BACKTRACK 0) NRTYP) + #DECL ((FCN) (VARTBL) + (TMPS BACKTRACK USE-COUNT HTMPS) + (LIFE TRUTH UNTRUTH) (WHO PRED WHON) ) + + > + >>> + + ". Declared type is " + + ", required type is " + .RTYP>)> + T>) (OV .VERBOSE)) + ()>)> + > + + + > + > + >> + )> + .ACT?> + + + >>>> + + T>> + >>> + )>> + + + + )> + .TEM>> + 2 >> + > + +" BIND-AN analyze binding structure for PROGs, FUNCTIONs etc." + + (COD) FIX) + )> + > ,COMPOSIT-TYPE ANY> + > + + >>> + +" ENTROPY ignore call and return." + + + + + > + ) + (> TUPLE> + + ) + (ELSE + > + >)>> + +" Analyze AUX and OPTIONAL intializations." + +) TEM COD (N )) + #DECL ((VARTBL) (SYM) SYMTAB (COD) FIX (N) NODE) + >>> + + ". Init value of: " + .N + " whose type is " + + " violates decl of " + >)> + > ,ARGL-OPT> + >> + ,QUOTE-CODE> + <>> ) + (<==? T> )>)> + + ) + (ELSE + > + >)>> + +" ARGS-BAN analyze ARGS decl (change to OPTIONAL in some cases)." + +> + + ) + (ELSE >)> + >>) + ( )>> + +)>> + >> + +"BIND-DISPATCH go to various binding analyzers analyzers." + +)) + ) + (,ARGL-IAUX ) + (,ARGL-AUX ) + (,ARGL-TUPLE ) + (,ARGL-ARGS ) + (,ARGL-QIOPT ) + (,ARGL-IOPT ) + (,ARGL-QOPT ) + (,ARGL-OPT ) + (,ARGL-CALL ) + (,ARGL-BIND ) + (,ARGL-QUOTE ) + (,ARGL-ARG )>> + +" SEQ-AN analyze a sequence of NODES discarding values until the last." + +) "AUX" (SOA <>) VAL) + #DECL ((L) ) + ) + (ELSE + ) ENDIF-FLAG + (RET-OR-AGAIN <>)) + #DECL ((X) NODE (Y) (RET-OR-AGAIN) ) + > + > + >> >> + > + "ENDIF"> + >> + > + )) #DECL ((PRED) ) + >>) + (ELSE + >)> + + > + >)> + >) + ( + > + >) + (ELSE + > + FIX>> + >> + + >> + + ("This object has no side-effects and its value is ignored" + .N)>)>) + (ELSE )>)>)> + >)> + + >> + + ("This object ends a sequence of forms" + .N + " because it never returns")>)> + + )> + )>>> + )> + .VAL)>> + +) + ,CALL-CODE> + >> 1> + >> ATOM> + <=? .STR>>> + +" ANALYZE ASSIGNED? usage." + +) TT T1 T2 (TY ')) + #DECL ((TT NOD) NODE (T1) SYMTAB (TEM) ) + ) + () + (ELSE + > ATOM ASSIGNED?> + > + <==? ,QUOTE-CODE> + >> + > -1>>> + + + + + 1>> + + NO-RETURN> BOOL-FALSE) + (ELSE BOOLEAN)>>) + (<==? 2> + ' PROCESS> ASSIGNED?>) + (> + ,QUOTE-CODE>> + )>)> + + ) + (ELSE )>)> + > + + + )> + +" ANALYZE LVAL usage. Become either direct reference or PUSHJ" + +) T1 T2 T3 (P ) NT) + #DECL ((NOD) NODE (TEM) (T1) SYMTAB (WHO) LIST) + >> + ) + () + ( SYMTAB> + >> + ATOM LVAL> + > + <==? > ,QUOTE-CODE> + <==? > ATOM> + >>>>> + .TT) !.WHO)>) (ELSE T)> + > + T> + + > + >>> + >> + >>) + ( + > + > ,SET-CODE> + + + ,SET> + ,NOT>>>>> + > + >> + T) + (ELSE T)> + > -1>>> + + + > + + 1>> + + > + )> + .ITYP) + (> + > ,QUOTE-CODE>> + >)>)> + + >> + .RTYP>) (ELSE .RTYP)>) + ( 2> + ' PROCESS> LVAL>> + ANY) + (ELSE )>> + + )> + +" SET-ANA analyze uses of SET." + +) (LN ) T1 (T2 ATOM) T11 + (NM <2 MSUBR>>) (WHON .WHON) + (PRED .PRED) OTYP T3 XX N) + #DECL ((N NOD) NODE (TEM) (LN) FIX (T1) SYMTAB + (WHON PRED) (WHO) LIST) + )> + ) + ( > + <==? .LN 0>>> + ) + ( SYMTAB> >> + ATOM .NM> + <==? .LN 2>> + <==? .LN 1>>> + <==? > ,QUOTE-CODE> + >>>>> + > + + ) + (ELSE T)> + > ) (ELSE T)> + + + > + >>>> + .NOD>) + (ELSE T)>> + > + > + 1>> + ANY>> + -1> .VERBOSE> + )>)> + .T2>>)> + + <>)>) + (> )>) + (ELSE <>)>)> + -1> ,FSET-CODE) (ELSE ,SET-CODE)>> + + + <==? ,QUOTE-CODE>> + <>> ) + (<==? T> )>)> + .T2)(ELSE NO-RETURN)>> + + + + >> + >> + > + >)> + ) + (ELSE + )>) + ( > + ANY>> + + > ,QUOTE-CODE>> + >)>)> + ) + (ELSE ' PROCESS> SET>)> + ) + ( > + + > ,QUOTE-CODE>> + >)>)> + ) + (ELSE ' PROCESS> SET>)>) + (ELSE )>> + +) (LN 0) (WHON .WHON) (PRED .PRED) + (SEG? <>) (N <1 .K>) (L-OF-A ) + L-OF-SY TY TY1 TTY FTY) + #DECL ((N NOD) NODE (TEM) (LN) FIX (T1) SYMTAB + (WHON PRED) (WHO) LIST (L-OF-A L-OF-SY) LIST) + )> + <1 .AL>) (N:NODE <1 .NL>) + (NT:FIX ) SY) + <==? .NT ,SEG-CODE>> + >) + (ELSE + > >>> + ) + (>> >> + )> + + + > )>) + ( + >> + > + ) + (ELSE + > + >)>) + ( + > + >)> + + > + >> + + )> + > + >> + )> + >>> + >>> + + .NOD>)> + > + 1>> + ,QUOTE-CODE> + <>> + ) + (<==? T> + )>)> + + + + >> + >> + > + >)>) + (ELSE >)> + + <==? -1> + >> + >> + )> + (.ATM .TY1))>> + .L-OF-A + >> + + + >> .RTYP>> + + + "AUX" (MIN-LN:FIX 0) (MAX-LN:FIX 0) + (LN:FIX ) (COMPOSIT-DECL NO-RETURN) + (COMPOSIT-TYPE NO-RETURN) L-OF-SY:LIST) + "AUX" SY (TY ANY)) + + > )>) + ( + >> + > + ) + (ELSE + > + >)>) + ( + > + >)> + + .TY>>> + + .NOD>)> + > + > + 1>> + )> + (.ATM .TY)> + .AL>> + + ) TY ET) + <==? .NT ,SEGMENT-CODE>> + >> ' MULTI-SET>> + + + .COMPOSIT-DECL>>> + )>) + (ELSE >)> + > + > ,MAX-LENGTH>> + >>) + (ELSE + .COMPOSIT-TYPE>> + ,MAX-LENGTH>> + >)>> + .NL> + + > SYMTAB> + >>)>> + .L-OF-SY> + ) + ( )> + .L-OF-SY> + + + + )> + +) + )> + + >>> + + + > + + + >) + >>>> + ,DEATH-LIST <2 .LL>>)>> + .L>> + +)) + #DECL ((L) ]> (V) ) + + ) + )> + >>> + >>>> + )> + >>)> + (S) SYMTAB) + )> + >> + ) ( )> + ,SET-CODE> + ) + (ELSE .N)>> + >> + >>> + >>>>>> + .DL>) (ELSE .DL)>>)> + >>> + +) + ) + >)> + >>> + > LIST>>>> + >>)> + >>> + + (L) LIST) + ) DL S TEM) + #DECL ((L LP LR TEM) LIST (S) SYMTAB (DL) ) + + > + >) + ( >) + (>>> + >>>> + >> .V> + > .DL>> + + >>) + (ELSE + 2 .TEM> + >>)>) + (ELSE + > + )>) + (<==? .V <1 <1 .LP>>> >>)> + >>> + +) + > + ,SET-CODE> + >>> + )> + .N> + .L1>> + > + <==? ,SET-CODE> + > + )> + .N> + .L2>> + .L2) + (ELSE 1>> .L2> .L1)>> + +> + + (V) ) + )> + > + -1> + > + )> + >>> + +)) + #DECL ((LS) ]> (LI) ) + + .LI> + + 2 T>> + <2 .LL>>) + (.FLG ,DEATH-LIST <2 .LL>>)>> + .LS>> + +)) + #DECL ((L) (SYM) SYMTAB (NOD) NODE) + > -1>> + ) + (ELSE + + 2 T>> + .L>)> + + <>)>)>> + +" Ananlyze a FORM that could really be an NTH." + +) (OBJ ) TYP) + #DECL ((NOD) NODE (K) ) + APPLICABLE>>> FIX> + <1 .K> !)> + 2> + >) + (ELSE >)> + > + + + + .RTYP) + (ELSE + > + + + + .RTYP>)>> + +" Further analyze a FORM." + + ANALYSIS> + > TANALYSIS> + + + + .R>>> + .NOD + .RTYP>> + +"Determine if an ATOM is mainfest." + + >>> + +" Search for a decl associated with a local value." + +) + >)> + > )> + >>> + +" Here to flush decls of specials for an external function call." + +>> + +" Here to flush decls when a PUT, PUTREST or external call happens." + +> + +) + >> + > + + + + + '> + + >>> + <==? .TEM .FLSFLG>>>>> + .FLSFLG>>)> + >> )>>) + (ELSE + >> )>>)>> + +>> + >> + ) + (ELSE .TEM)> + >> + >> + +" Punt forms with segments in them." + +) + )) + >> + > ,SEGMENT-CODE> > + >> + )> + )>> + +" Determine if the arg to STACKFORM is a SUBR." + +) ATM TT) + #DECL ((ATM) ATOM (NOD TT) NODE (NT) FIX) + + >>> + ,QUOTE-CODE> + >> + > + ) + (ELSE ANY)>) + (ELSE ANY)>> + +" Return type returned by a SUBR." + +>> + .TMP) (ELSE ANY)>> + +" Access the SUBR data base for return type." + +)) + #DECL ((VALUE) ) + >) (ELSE '(ANY ANY))>> + +" GVAL analyzer." + +) (LN ) TEM TT TEM1) + #DECL ((NOD TEM) NODE (TT) (LN) FIX) + ) + (ELSE + + + ATOM GVAL> + >> ,QUOTE-CODE> + <==? ATOM>> + + >> + + + + .RTYP>) + ( + + >>) + (ELSE >>)>> + ) + (ELSE )>) + (ELSE )>)>> + + )> + +) (LN ) + (NM )) + #DECL ((NOD) NODE (K) (LN) FIX) + ) + (ELSE + + + ATOM .NM>)> + .RTYP>> + + + )> + + > + )> + +" Analyze SETG usage." + +) (LN ) TEM TT T1 TTT) + #DECL ((NOD TEM) NODE (K) (LN) FIX (TT) VECTOR) + ) + (ELSE + + + > ATOM SETG> + )> + ,QUOTE-CODE> + >> + )> + + + + >>) + (ELSE >>)>> + .T1>> + )> + >) + (ELSE + ANY>> + >)>) + (ELSE ANY>> >)> + ANY SETG>)> + .TTT)>> + + )> + + (VALUE) LIST) + >) + ( -1> + > + > + >>)>)> + >>) + (ELSE ())>> + +)) + #DECL ((V VL) ) + )> + ) + ( + > + )> + + >>> + +>) (ELSE )>> + +)) + #DECL ((SYM) SYMTAB) + -1>> + > + >>) + (ELSE + > + )>> + + (L) ]>) + )> + > > + .L T>>)> + >> + .L> + +]>) + + <2 .L> .TO T>>> + .FROM> + .TO> + + (L) ]>) + )> + > + + ANY>) + .V> + >> + + >)>> + .L> + > + T) !.L)>)> + >>)> + .L> + +>)) + #DECL ((TO FROM) + >]> + (TOTUP) < + [REST + > + FALSE>]> + (NDECL) + ) + + ) (WIN <>)) + + )) + .SYM>> + <2 .L>>> + + > + > + >)>> + .TOTUP> + + <2 .L>> + <3 .L>) + !.TO)>)>> + .FROM> + + ) + > + <2 .LL>>>)>> + .TOTUP> + .TO> + +]>) + <2 .LL>>> .L>> + +) (OD )) + #DECL ((SYM) SYMTAB (INF) LIST (NTH-REST) + (NDECL) (MUNG) ) + > + + ) + .SYM> + ) + (ELSE >)>> + + + >)>> + .INF> + + > + )>)> + .INF> + +) + )> + NTH> + -1>>> + ()) + (<1? .NUM> (ANY)) + (ELSE ([.NUM ANY]))> + .NDECL>> + + >) + (.FIRST >>) + (ELSE >>)> + >>> + +" AND/OR analyzer. Called from AND-ANA and OR-ANA." + +) FTYP FTY + (RTY + .RTYP) + (ELSE
)>) + (FLG <==? .PRED >) (SINF ()) STR SUNT + (FIRST T) FNOK NFNOK PASS) + #DECL ((NOD) NODE (L) (ORER RTYP) ANY (FTYP) FORM + (STR SINF SUNT) LIST) + (PRED) (L-D) LIST) + >) + (ELSE + >) TY) + #DECL ((N) ) + > >)> + >> + ; "FNOK seems to mean that this clause of the boolean can't + return false; NFNOK means it always returns false" + >>> + >> + ; "Therefore, PASS means this clause's result doesn't need to be + tested, because we'll always go to the next clause." + > + + + >)> + + ; "If OR, and FNOK, this will terminate the whole thing, etc..." + > + + ! '(" it never returns ")) + (ELSE (" its type is: " .TY))>)>)> + )> + > + ; "This clause actually returns an interesting condition..." + > + + >>> + + >>> + + >>) + (ELSE + > + >> + >) + (ELSE + > + >>)> + + >>)> + >) + ( + >) + (ELSE >)> + >) + (T + + >>> + + >>> + + >> + >)> + > + > + > + + + >)> + > + + ) + (.LAST > ) + ( ) + (.ORER .TY) + (.FNOK ) + (ELSE FALSE)>> + .L>> + >>)>)>> + )> + .FTY> + +) + (<1 .LL> <2 .LL> <3 .LL>)> + .L>> + + + >> + + )> + + + > + + )> + +" COND analyzer." + +> + +>> + + +) (FIRST T) (LAST <>) TT FNOK NFNOK STR + SUNT (FIRST1 T) PRAT (DFLG <>) TST-TYP SVWHO + (PRED-FLG <==? .PRED >)) + #DECL ((NOD) NODE (L) (RTYP) ANY) + (TINF1 TINF L-D L-D1) LIST + (PRED) >) + ) + (ELSE + >>>> + (WHON) ) + ANY CASE>> + > + >)> + ) (EC T) STR1 SUNT1) + #DECL ((BRN) (BR) NODE) + ,QUOTE-CODE> + >)> + + ,QUOTE-CODE> > + )> + > + )> + > + >> + >> > ANY) + (.LAST .RTYP) + (ELSE )>> + NODE>> + .PRAT + .TST-TYP + .TT + .DFLG + .BR + .SVWHO>) + (ELSE .TT>)>> + >> + >>> + FALSE>> + + !> ()) + (ELSE (" and non-reachable code in clause."))>)>)> + > + + " type of value: " + .TT)>)>)> + + >>> + + >>>)> + .NFNOK>>> + > + >>) + (ELSE + >>)> + )> + >)> + + + .RTYP .PRED-FLG>>>> + + + ) + (ELSE + > + >)>) + (.FIRST1 + >> + >) + (ELSE + >> + >>)>)> + > + >) + (ELSE + > + >)> + >)> + > + >>) + (.EC >>)>) + (.NFNOK )> + + .TT> + + >) + (ELSE + + >) + (ELSE + > + )>)> + ) + (.TT .TT) + + (ELSE )>> + .L>>)>> + + )> + .TT> + +" PROG/REPEAT analyzer. Hacks bindings and sets up info for GO/RETURN/AGAIN + analyzers." + +) TT L-D + (OPN .PNOD>) PNOD PRTYP) + #DECL ((PNOD) (VARTBL) (OV) SYMTAB + (L-D) LIST (PPNOD) NODE) + ,BIND> ) + (.OPN )> + T>)) + #DECL ((TMPS HTMPS) ) + > + > + + >>> + >)> + + ()>)> + + + > + + + + + + > + + + ,REPEAT> .PRTYP) + (ELSE ANY)>>> + )> + ,REPEAT> > + + ,REPEAT> + > + ) + ( + LIST>>) + (ELSE )>>> + )>) + ( T>>> + > + )>> + ,REPEAT> + + .VARTBL>>) + (ELSE >)>)> + + .LIFE> + + )> + <==? ,REPEAT>>> + .VARTBL>> + NO-RETURN> + >>)>) + ( NO-RETURN> + >)> + > + > + .PRTYP) + (<==? ,REPEAT> ) + (ELSE >)>>> + > + +" Determine if assumptions made for this loop are still valid." + +]>) + + ) (TT <>)) + #DECL ((L) >) + ANY> + + .SYM>> + <2 .LL>> + NO-RETURN> + >>>> + > + "ANA" + .BACKTRACK>)>)> + > + + ,DEBUGSW + > + + > + + > + >)> + <2 .L>>> + >> + .TY>)>> + .AS> + )>)> + .OK?> + + <==? 2> <==? <1 .D> NOT>> + <2 .D>) + (ELSE )>> + +" Analyze RETURN from a PROG/REPEAT. Check with PROGs final type." + +) N (LN ) TEM) + #DECL ((NOD) NODE (TT) (LN) FIX (N) ) + + ) + ( >>> + >>> + > + + )>>> + RETURN>> + NO-RETURN> + >> + >) + (ELSE + >> + .VARTBL>>)> + >> + + NO-RETURN) + (ELSE )>> + + )> + +) N (LN ) TEM + (SEG <>) (TYPS ) + (TP )) + #DECL ((NOD) NODE (TT) (LN) FIX (N) ) + ) + (ELSE + >> ,QUOTE-CODE> + <==? <>>> + >) + (>) + (ELSE ' MULTI-RETURN>)> + + ) TY) + #DECL ((NN) NODE) + ,SEGMENT-CODE> + > + ' + MULTI-RETURN>> + + > + ANY>> + + >> + ) + (> + > + ])>) + ( + >)>) + (ELSE )>) + (ELSE + > + + >)>)>> + > + NO-RETURN>> + >> + >) + (.N + >> + .VARTBL>>)> + >>)> + + NO-RETURN)>> + + > + )> + +)) + #DECL ((N N1) NODE (SYM) (RAO VALUE) + (NT) FIX) + + SYMTAB> + >> + <==? 1>> + <==? .NT ,SUBR-CODE>> + <==? ,LVAL> + <==? > 1> + <==? >>> ,QUOTE-CODE> + ATOM> + >> + + <==? 1>>> + >> + + ,RET-AGAIN-ONLY .RAO>)> + .RAO)>> + +" AGAIN analyzer." + +) N) + #DECL ((NOD) NODE (TEM) (N) ) + + >> + > >>>> + + > + + .VARTBL>>) + (ELSE >)> + > >) + (ELSE >)>> + NO-RETURN) + (> + FRAME>> + )> + ANY) + (ELSE )>> + + )> + +" If not in PROG/REPEAT complain about NAME." + +> + )> + .PNOD> + +" Dispatch to special handlers for SUBRs. Or use standard." + + ANALYSIS ',SUBR-C-AN> .NOD .RTYP>> + +" Hairy SUBR call analyzer. Also looks for internal calls." + +>) + (NRGS1 <1 .TMPL>)) + #DECL ((NOD) (ARGS) (TYP NRGS1) + (TMPL) ) + + (N NOD) NODE (NARGS) ) + > + + + + ) (ELSE )>) + (ELSE + + .NOD>) + ( + >> + + .N>)> + > + + .N>)>)> + ) + (ELSE >)> + )>> + ) + ,SEGMENT-CODE> + > ' SEGMENT> + + ANY) + (ELSE > > .TYP)>> + > + + > + +> + +" Analyze VECTOR, UVECTOR and LIST builders." + +>) + (K ) N (LWIN <==? .RT LIST>) NN COD) + #DECL ((NOD N) NODE (ARGS) FIX (K) ) + > + ) (FRM ) + (FRME ) (GOTDC <>)) + #DECL ((FRM) FORM (FRME) ) + + + > <1 .FRM>) + (ELSE .FRM)>>>)> + ) + (.STY ) + (.PTY ])>)> + >) + (>>> ,SEGMENT-CODE> + <==? .COD ,SEG-CODE>> + > + ' SEGMENT> ALL>> + + >)> + + >>> + '[LIST VECTOR UVECTOR TUPLE]>>) + (ELSE >)>) + (ELSE > >)> + + + >> )>>) + ( > + > + > .STY> > + > + >>>) + (ELSE >)>)>)> + >>)> + >>)> + + .LWIN> + + ,SEGMENT-CODE> + )>> + > + >> 1> + <==? > ,SEG-CODE> + <==? >>>>> + LIST>> + >> + + )) + #DECL ((N) NODE (L) ) + + + )>> + NODE>>>)> + NODE>> + >) + (ELSE )>) + (ELSE + + ,SEG-CODE> + )>> + > + )> + > + +" Analyze quoted objects, for structures hack type specs." + +> .RTYP>> + +>> + + >> + + .RTYP>) + (ELSE )>> + + )> + +" Analyze a call to an RSUBR." + +]> ) + (SEGF <>) (MUST-EMPTY T) FRST (TUPF <>) (OPTF <>) + (K: ) + (NM:ATOM ) (RT <>)) + #DECL ((NOD) NODE (ARGS) FIX) + + > + >>> OPTIONAL> + ) + (<==? .FRST TUPLE> )> + > + >) + ( >>)> + ,SEGMENT-CODE> + + > ANY>> ALL>> + .ET>) + (.RT )>) + ( .TUPF .OPTF> 0>> + + ) + ( ) + (ELSE + )> + ) + (ELSE + > + >) + (ELSE .RT)> .NM>)>> + .K> + <==? .NM PRINT> <==? .NM PRIN1>> + + >>>)> + + + + .RTYP>> + +" Analyze CHTYPE, in some cases do it at compile time." + +) NTN NT OBN OB TARG S1 S2 + TDECL) + #DECL ((NOD OBN NTN) NODE (K) (NT) ATOM) + ) + (ELSE + 2 CHTYPE .NOD> + > ANY>> + > ATOM CHTYPE> + ,QUOTE-CODE> + >>> + )> + >>> + )> + ,QUOTE-CODE> + + + .NT>>) + ( + + ) + (> + > !) + >> + > + )> + ) + (ELSE )> + + ) + ( ,RSUBR-CODE> <==? TYPE>> + > + >>>>> + >> + ) + (ELSE + + + )>) + (ELSE + )> + )>)>> + + )> + +" Analyze use of ASCII sometimes do at compile time." + +) ITM TYP TEM) + #DECL ((NOD ITM) NODE (K) ) + ) + (ELSE + 1 ASCII .NOD> + > ' ASCII>> + ,QUOTE-CODE> + + >>> + > + ) + (<==? FIX> + + ) + (<==? .TYP CHARACTER> + + ) + (ELSE >)> + .RTYP>)>> + + )> + +) ITYP) + #DECL ((NOD) NODE (K) ) + ANY UNWIND .NOD>> + ANY UNWIND> + + > + +" Analyze READ type SUBRS in two cases (print uncertain usage message maybe?)" + + + ,EOF-CODE> + + + > ANY .N>> + > + .N>) + (ELSE )>) + (ELSE >)>> + > + + + > + + + ,EOF-CODE> + > ANY .N>) + (ELSE >)>> + > + + + > + +) (NAM )) + #DECL ((N) NODE (K) ) + ANY .NAM> + ANY .NAM> + ANY .NAM .N>> + > + + + ) + (ELSE )> + > + +) (NAM ) (LN )) + #DECL ((N) NODE (K) (LN) FIX) + ANY .NAM> + ANY .NAM> + ANY .NAM .N>)> + > + +> + > + > + .R> + +) + >> + > 1> + + >> + >> + > + >>> + + >>>> + +) + + > + > 2> + <==? <1 .OB> LVAL> + > ATOM>> + + <==? <1 .OB> SET> + > ATOM>>> + >> + > + + )>)> + '[FORM LIST UVECTOR VECTOR]> + ,SPECIALIZE .OBJ>)>> + +) (N <1 >) TY) + + >> + ) + (>> + + " ADECL type is " + .TY>)> + + .RT> + +) INS TYP NN) + #DECL ((N INS) NODE (K) (NN) ) + ) + (>> ,QUOTE-CODE> + ATOM> + >> + )> + `RTUPLE> + FIX RTUPLE> + <>>> + NO-RETURN> + >> + >) + (ELSE + >> + .VARTBL>>)> + >>) + (ELSE FRAME RTUPLE>)>) + (ELSE + + ,SEGMENT-CODE> + > ' CALL>) + (ELSE )>> + >)> + ) + (ELSE )>> + +) MIMOP) + #DECL ((FCN N) NODE (ATM) ATOM) + ,MIM-OBL>> + + "ACTIVATION"> + )> + ) (ELSE ANY)>)>> + +)) + #DECL ((N) NODE (K) ) + ) + (ELSE + )> + + ,SEGMENT-CODE> + > + ' CALL>) + (ELSE )>> + .K> + + )>> + + )> + + + (,QUOTE-CODE ) + (,FUNCTION-CODE ) + (,SEGMENT-CODE ) + (,FORM-CODE ) + (,PROG-CODE ) + (,SUBR-CODE ) + (,COND-CODE ) + (,COPY-CODE ) + (,RSUBR-CODE ) + (,ISTRUC-CODE ) + (,ISTRUC2-CODE ) + (,READ-EOF-CODE ) + (,READ-EOF2-CODE ) + (,GET-CODE ) + (,GET2-CODE ) + (,MAP-CODE ) + (,MARGS-CODE ) + (,ARITH-CODE ) + (,TEST-CODE ) + (,0-TST-CODE ) + (,1?-CODE ) + (,MIN-MAX-CODE ) + (,ABS-CODE ) + (,FIX-CODE ) + (,FLOAT-CODE ) + (,MOD-CODE ) + (,LNTH-CODE ) + (,MT-CODE ) + (,NTH-CODE ) + (,REST-CODE ) + (,PUT-CODE ) + (,PUTR-CODE ) + (,UNWIND-CODE ) + (,FORM-F-CODE ) + (,IRSUBR-CODE ) + (,ROT-CODE ) + (,LSH-CODE ) + (,BIT-TEST-CODE ) + (,CASE-CODE ) + (,COPY-LIST-CODE ) + (,ADECL-CODE ) + (,CALL-CODE ) + (,APPLY-CODE ) + (,FGETBITS-CODE ) + (,FPUTBITS-CODE ) + (,STACK-CODE ) + (,BACK-CODE ) + (,TOP-CODE ) + (,CHANNEL-OP-CODE ) + (,ATOM-PART-CODE ) + (,OFFSET-PART-CODE ) + (,PUT-GET-DECL-CODE ) + (,SUBSTRUC-CODE ) + (,MULTI-SET-CODE ) + DEFAULT + ()>> + + + >) + (<==? .PRED-NAME TYPE?> ) + (ELSE + > + .CONST>)>) + (ELSE + ) + (<==? .PRED-NAME TYPE?> .CONST) + (ELSE )>)>> + >> .TEM) + (ELSE + + + .OTYPE>>> + ) + ( >) + (ELSE )> + + ) (SYM <2 .L>)) + #DECL ((L) SYMTAB> (SYM) SYMTAB) + >> + + + .UNTRUTH + .FLG + >>>> + .WHO> + >> + .TEM)>> + +) FM NUM TY (NEL REST) SIZ) + #DECL ((N FM NUM) NODE) + > FIX > + > + ISTRING> CHARACTER) + (<==? IBYTES> FIX) + (<==? UVECTOR> FIX) + (ELSE ANY)> + >> + > + .N> + + )> + ,QUOTE-CODE> >)> + )> + > + ! ([.NEL .TY])) (ELSE ())> + ! ()) (ELSE ([REST .TY]))>> + .R>> + +) GD NUM TY (NEL REST) SIZ) + #DECL ((N NUM GD) NODE) + > FIX > + ISTRING> CHARACTER) + ( IBYTES> + <==? IUVECTOR>> + FIX) + (ELSE ANY)>> + 2> + > .TY >>)> + ,QUOTE-CODE> >)> + <==? .TY ANY>> + >) + (ELSE + > + ! ([.NEL .TY])) + (ELSE ())> + ! ()) + (ELSE ([REST .TY]))>>)> + .R>> + +> .R STACK>> + +) TY) + #DECL ((N) NODE (K) ) + ) + (ELSE + )> + 2> 2 CHANNEL-OP .N>)> + CHANNEL CHANNEL-OP>> + ATOM CHANNEL-OP> + + > + > + + <==? 2> + > FORM> + <==? 2> + <==? <1 .TY> QUOTE> + ATOM>> + + >)> + )>> + + > + )> + +