" 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." ) TT TEM) #DECL ((NOD) NODE (P) ANY (TEM TT) ) > >)> > .NOD .RTYP>> ,QUOTE-CODE> > ) (>> .TEM) ( > <==? <1 .TEM> ALL>> > <==? <1 .TT> ALL>>> (ALL)) (ELSE 1>> .TT> .TEM)>>> > FIX>) > >)> ) ( )> T> >> " 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)) #DECL ((FCN) (VARTBL) (TMPS BACKTRACK USE-COUNT HTMPS) (LIFE TRUTH UNTRUTH) (WHO PRED WHON) ) > >> >> T>) (OV .VERBOSE)) ()>)> > > > >> )> > > >> > .TEM>> 2 >> > " BIND-AN analyze binding structure for PROGs, FUNCTIONs etc." (COD) FIX) > > ,COMPOSIT-TYPE ANY> > >> .SYM> >>> " ENTROPY ignore call and return." >> ) (>> TUPLE> ) (ELSE >> >>)>> " Analyze AUX and OPTIONAL intializations." ) TEM COD) #DECL ((VARTBL) (SYM) SYMTAB (COD) FIX) <1 >>> "DECL MISMATCH" > <1 >>> > 9> >> >>> )> ) (ELSE >> >>)>> " ARGS-BAN analyze ARGS decl (change to OPTIONAL in some cases)." > ) (ELSE >>)> >>>> ) ( )>> >)>> >> " VECTOR of binding analyzers." " SEQ-AN analyze a sequence of NODES discarding values until the last." )) #DECL ((L) (FTYP) ANY) ) (ELSE > ,QUOTE-CODE> <==? > ATOM> > > >> .FTYP) (ELSE ANY)>>> >> >> ("This object ends a sequence of forms" .N " because it never returns")>)> )> >>)>> " ANALYZE ASSIGNED? usage." ) TT T1 T2) #DECL ((TT NOD) NODE (T1) SYMTAB (TEM) ) ) () (ELSE > ATOM ASSIGNED?> > <==? ,QUOTE-CODE> >> > -1>>> ) (<==? 2> ' PROCESS> ASSIGNED?>) (> ,QUOTE-CODE>> )>)> ) (ELSE )>)> .RTYP>> " ANALYZE LVAL usage. Become either direct reference or PUSHJ" ) T1 T2 T3) #DECL ((NOD) NODE (TEM) (T1) SYMTAB (WHO) LIST (USE-COUNT) FIX) >> ) () ( SYMTAB> >> ATOM LVAL> > <==? > ,QUOTE-CODE> <==? > ATOM> >>>>> > .TT) !.WHO)>) (ELSE T)> > T> > > >>> >> >>) (ELSE T)> > -1>>> 0> >>)> > > > .ITYP) (> > ,QUOTE-CODE>> >)>)> >> > .RTYP>) (.CAREFUL ANY) (ELSE .RTYP)>) ( 2> ' PROCESS> LVAL>> ANY) (ELSE )>> " SET-ANA analyze uses of SET." ) (LN ) T1 T2 T11 (WHON .WHON) (PRED .PRED) OTYP T3 XX) #DECL ((NOD) NODE (TEM) (LN) FIX (T1) SYMTAB (WHON PRED) (WHO) LIST) )> ) ( ) ( SYMTAB> >> ATOM SET> <==? .LN 2> <==? > ,QUOTE-CODE> <==? > ATOM> >>>>> > ) (ELSE T)> > ) (ELSE T)> <1 >>>> .NOD>>> > >> ANY>> -1> .VERBOSE> )>)> > )>) (ELSE <>)>)> -1> ,FSET-CODE) (ELSE ,SET-CODE)>> >> >> > >)> ) ( ANY>> > ,QUOTE-CODE>> >)>)> ) (ELSE ' PROCESS> SET>)> ) (ELSE > .NOD>)>> ) )> >>> > >) >>>> ,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>> ;"Temporary kludge." .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." > ) > > NO-RETURN> STRUCTURED> >>> <==? .TEM .FLSFLG>>>>> .FLSFLG>>)> 0> >)> >> )>>) (ELSE > 0> >)> >> )>>)>> >> >> ) (ELSE .TEM)> <1 >>> <1 >>> " Punt forms with segments in them." ) )) >> > ,SEGMENT-CODE> > >> )> )>> " STACKFORM analyzer." ) TEM STFTYP TT) #DECL ((NOD TT) NODE (K) ) 3 STACKFORM> > ANY> > ANY> ANY>> > > " 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) ;"MAY TRY OTHERS LATER ">> " 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 )>)>> " Analyze SETG usage." ) (LN ) TEM TT T1 TTT) #DECL ((NOD TEM) NODE (K) (LN) FIX (TT) VECTOR) ) (ELSE > ATOM SETG> )> ,QUOTE-CODE> >> > >>> .T1> > ) (ELSE ANY>> )>) (ELSE ANY>> )>)>>> (VALUE) LIST) >) ( -1> > >>)> >>) (ELSE ())>> )) #DECL ((V VL) ) )> ) ( > )> >>> > <1 >>> >)) #DECL ((SYM) SYMTAB) -1> .OTYP>>> >>) (ELSE > )>> (L) ]>) )> .L T>>)> >> .L> ]>) <2 .L> .TO T>>> .FROM> .TO> (L) ]>) )> > ANY>) .V> >> >)>> .L> > > T) !.L)>)> >>)> .L> >]> (NDECL) ) ) (WIN <>)) .SYM> <2 .L>>> > >)>> .TO> <2 .L>> <3 .L>) !.TO)>)>> .FROM> .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) ) > >)> >> >>> >> > >)> ;"This must end the AND/OR" > " its type is: " .TY)>)> )> >> > >>) (ELSE > >>)> >)> > > > >> > ) (.LAST )>> ) (ELSE .SINF)>>)> > ) ( ) (.ORER .TY) (.FNOK ) (ELSE FALSE)>> .L>> >>)>)>> )> .FTY> >> > " COND analyzer." > >> ) (FIRST T) (LAST <>) TT FNOK NFNOK STR SUNT (FIRST1 T) PRAT (DFLG <>) TST-TYP SVWHO) #DECL ((NOD) NODE (L) (RTYP) ANY) (TINF1 TINF L-D L-D1) LIST) ) (ELSE >>>> (WHON) ) ANY CASE>> > >)> ) (PRED .BR) (EC T)) #DECL ((BRN) (BR) NODE (PRED) >) ,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>>> > >) (ELSE > >)> >)> > >>) (.EC >>)>) (.NFNOK )> >) (ELSE >) (ELSE > )>)> ) (ELSE .TT)>> .L>>)>> .TT> >) (<==? .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)>> " PROG/REPEAT analyzer. Hacks bindings and sets up info for GO/RETURN/AGAIN analyzers." ) TT L-D (OPN .PNOD>) PNOD) #DECL ((PNOD) (VARTBL) (OV) SYMTAB (L-D) LIST (PPNOD) NODE) ,BIND> ) (.OPN )> T>)) #DECL ((TMPS HTMPS) ) > > >> > ()>)> > > ,REPEAT> .PRTYP) (ELSE ANY)>>> >> ,REPEAT> >> ,REPEAT> ) ( LIST>>) (ELSE )>> >> ,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> >>>> >)> > ,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 )>> (RAO VALUE) ) ,LVAL-CODE> SYMTAB> >> <==? 1>> ,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) (> ACTIVATION> > ANY) (ELSE )>> " Analyze losing GOs." ) N RT) #DECL ((NOD N) NODE (TEM) ) > > ' GO>> ,QUOTE-CODE> <==? .RT ATOM> > <==? .RT TAG>> .ANALY-OK > >> NO-RETURN) (ELSE )>) (ELSE )>> ) N) #DECL ((PNOD N NOD) NODE (K) ) > > >> > ATOM TAG> ,QUOTE-CODE> <==? ATOM>> TAG) (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>) (ARGACS 4> STACK>>> <4 .TMPL>)>)) #DECL ((NOD) (ARGS) (TYP NRGS1 ARGACS) (TMPL) ) ) TEM (NARGS1 .NRGS1) (N .NOD) (TPL .TMPL) (RGS .ARGS)) #DECL ((T) TUPLE (ARGS RGS TL) FIX (TMPL TPL) (N NOD) NODE (NARGS) ) > ) (ELSE )> > )>) (ELSE >) ( >> .N>> > .N>> >>> > ;"Dont handle funny calls to things like LLOC." > > ;"For funny cases like LLOC." .DEF ()>> <- .RGS <1 .NARGS>>>>> > > ) (ELSE <- > 1>> .TEM>)>)>)> ) (ELSE >)> ;"Short call exists?." STACK> > )> )>> ) ,SEGMENT-CODE> > STRUCTURED SEGMENT> ANY) (ELSE > > > .ARGACS >> >)> .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>> > STRUCTURED 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." FUNCTION> .IND>>>> <==? .FCN .RN>>> ) (ELSE >)>> (ARGS) FIX) >> ,SEGMENT-CODE> > .RT SEGMENT> ) (ELSE > > .ACST> >)> >)>> > >> .RTYP>> " Analyze CHTYPE, in some cases do it at compile time." ) NTN NT OBN OB) #DECL ((NOD OBN NTN) NODE (K) (NT) ATOM) ) (ELSE 2 CHTYPE> > ANY>> > ATOM CHTYPE> ,QUOTE-CODE> > > > >> > ,QUOTE-CODE> .NT>>) (ELSE )> ) (ELSE )> )>)>> " Analyze use of ASCII sometimes do at compile time." ) ITM TYP TEM) #DECL ((NOD ITM) NODE (K) ) ) (ELSE 1 ASCII> > ' ASCII>> ,QUOTE-CODE> >>> > ) (<==? FIX> ) (<==? .TYP CHARACTER> ) (ELSE >)> .RTYP>)>> ) ITYP) #DECL ((NOD) NODE (K) ) ANY UNWIND>> ANY UNWIND> > " Analyze ISTRING/ILIST/IVECTOR/IUVECTOR in cases of known and unknown last arg." ) FM NUM TY (NEL REST) SIZ) #DECL ((N FM NUM) NODE) ,IBYTES> FIX > > ,QUOTE-CODE> >>)> >)> > FIX > > ISTRING> CHARACTER) (<==? IBYTES> FIX) (ELSE ANY)> >> > .N> ) (ELSE )> ,QUOTE-CODE> >)> > ,IBYTES> ) (ELSE )>) (ELSE BYTES)>) (ELSE > [.NEL .TY] ! ()) (ELSE ([REST .TY]))>>)> .R>> ) GD NUM TY (NEL REST) SIZ) #DECL ((N NUM GD) NODE) ,IBYTES> FIX > > ,QUOTE-CODE> >>)> >)> > FIX > > ,ISTRING> CHARACTER) (<==? ,IBYTES> FIX) (ELSE ANY)> >> ,QUOTE-CODE> >)> ,IBYTES> ) (ELSE )>) (ELSE BYTES)>) (ELSE > [.NEL .TY] ! ()) (ELSE ([REST .TY]))>>)> .R>> " 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> > .HTMPS> >) (ELSE >)>> >) (ELSE >)>> 2>>> .HTMPS> > > ) >> > 1> >> >> > >>> >>>> ) > > 2> <==? <1 .OB> LVAL> > ATOM>> <==? <1 .OB> SET> > ATOM>>> >> > )>)> '![FORM LIST UVECTOR VECTOR!]> ,SPECIALIZE .OBJ>)>> >)>