> ;"DISABLE FUNNY COND./BOOL FEATURE" " This file contains the major general codde generators. These include variable access functions (LVAL, SETG etc.), FSUBRs (COND, AND, REPEAT) and a few assorted others." " All generators are called with a node and a destination for the result. The destinations are either DATUMs (lists of ACs or types) or the special atoms DONT-CARE or FLUSHED. Generators for SUBRs that can be predicates may have additional arguments when they are being invoked for their branching effect." " The atom STK always points to a list that specifies the model of the TP stack." " Main generator, dispatches to specific code generators. " >> > ,.TEM) (ELSE )>>> ) > .NOD .WHERE>> > .TEMP> " Generate a sequence of nodes flushing all values except the ladt." ) (SINPROG <>) (INCODE-GEN <>)) #DECL ((L) (WHERE) ) )) #DECL ((N) (ND) NODE) ,QUOTE-CODE> <==? ATOM> >> >>> T>> > ) (ELSE .WHERE)>>>)>) (> > ) (ELSE .WHERE)>>>) (ELSE >)>> .L> > )> .WHERE> " The main code generation entry (called from CDRIVE). Sets up initial stack model, calls to generate code for the bindings and generates code for the function's body." >)) (IDT 0) XX (STB (0)) (STK (0 !.STB)) (PRE <>) (FRMID 1) BTP (FRMS (1 .STK .BASEF 0 .NTSLOTS)) (BSTB .STB) (SPECD <>) (TMPS (2)) (ELSE (0))>) START:TAG (AC-HACK ) (K ) (CD <>) (DEST ) (ELSE >)>) (ATAG ) (RTAG ) (SPEC-LIST ()) (RET <>) (NO-KILL ()) (KILL-LIST ())) #DECL ((TOT-SPEC IDT) (BASEF) (SPEC-LIST KILL-LIST STK BSTB NTSLOTS) (PRE SPECD) (FRMID TMPS) (START:TAG) (AC-HACK) > (FRMS NO-KILL) (K) (BTP) LIST (CD) ) > )> )> >)> ) (ELSE .DEST)> <> <> T>> ,NO-DATUM> ) (ELSE >)> .CD > AC>> .CD>)> >)> AC> .DEST .CD>> AC> .DEST .CD>>)> )>> >> ,ALLACS> >>> .XX> " Update ACs with respect to their datums." ANY-AC> >)> ANY-AC> >)>)> T> " Generate code for setting up and binding agruments." ) "AUX" (BST ) B (NPRUNE T) (NSLOTS ) (TSLOTS ) (LARG <>) INAME GOOD-OPTS (SFLG >) (STB )) #DECL ((NOD) NODE (BST B) (NPRUNE) (NSLOTS) (TSLOTS) ATOM (INAME) (FRMS) (TOT-SPEC) FIX (BASEF) NODE) > >> >> 0>> -1>> > >>> > ,POTLV <>> >) (.SFLG > <- > .INAME>> >> > ) (TRG ) (OPS 0) (OSTK .STK)) #DECL ((TG) ATOM (OPS TRG) FIX (STK OSTK) LIST) .TRG>> > > > ) (ELSE >)> > 7> <==? 8> <==? 9>> T>)> > >>> `(FRM) >>) (> ! 3> `(TP) >>)> .T1> > >> >) (> 7> ) (ELSE >>)>) (ELSE ) (ELSE >>)>)> >) (ELSE )> >> >> >> FIX> 2>> > > >>> ) (ELSE )>> ) (.FLG > >)> T) (ELSE T)>> > )> > >)> >> > )> >>> > >> > >)> )> <0? > T) (ELSE T)>> > )> .SYM> > >> .TOT-SPEC> ) NOD S) #DECL ((B) (N NUM RQ) FIX (LBLS) (NOD BASEF) NODE (S) SYMTAB) > > > 0> )> 6> <==? 7>> NODE>> ,SNODES>>> >) (ELSE T)>> .B>> > > > .RQ>> 6> <==? 7>> >> ,LVAL-CODE> SYMTAB>>> 2>> `(TP) >> >) (ELSE >)>) (ELSE >)> > 0> )> >>)>> " Generate \"BIND\" binding code." >> " Do code generation for normal arguments." ) >> <>>) ( DATUM>) (ELSE >>)>> " Initialized optional argument binder." > >> " Uninitialized optional argument binder." > " Create a binding either by pushing or moving if slots PRE created." FIX> .TOT-SPEC>> ) (ELSE .SRC > > >)>) (ELSE )> > " Push or store a non special argument." FIX> .TOT-SPEC>> ) (ELSE )>> " Create a binding for either intitialized or unitialized optional." ) (DEF ) DV (LPRE .PRE)) #DECL ((SYM) SYMTAB (BASEF DVAL) NODE (GIVE DEF) ATOM (DV) DATUM (TOT-SPEC) FIX) >>)> .DEF> > >) (ELSE > ATOM>
>) (ELSE 0)>)>>)>) (ELSE >>)> ) (ELSE DONT-CARE)>>) (ELSE )>> >> > ) (ELSE >> )>> > >)> > " Do a binding for a named activation." >>> " Bind an \"AUX\" variable." > > > > DONT-CARE>>> >> > ) ( TEMPV> >>>>> <* -2>) (ELSE 0)> !.TMPS) TEMPV>> >> .TEM>) (ELSE ANY-AC)> ANY-AC>>> > AC>> ,ACRESIDUE (.SYM !)> > AC> )>)> ) (ELSE DONT-CARE>>)>> " Do a binding for an uninitialized \"AUX\" " > > TEMPV> >>>> >> )> <* -2>) (ELSE 0)> !.TMPS) TEMPV>>) (>>> > >> '[0]>> >) (ELSE >)>> ) "AUX" (NS .NSLOTS) (TS .TOT-SPEC)) #DECL ((TUP) (NS TS) FIX) ITUPLE> <==? TUPLE>>> ,ISTRUC-CODE> >> > >)> >)>)>>> ) NT (WD 0)) #DECL ((NT) FIX (TUP) NODE (K) ) ,ISTRUC-CODE>> ,ITUPLE> > ,QUOTE-CODE> >> ,QUOTE-CODE> <==? .NT ,FLVAL-CODE> <==? .NT ,FGVAL-CODE> <==? .NT ,GVAL-CODE> <==? .NT ,LVAL-CODE>> <* > 2>>) (ELSE ,SEGMENT-CODE> >) (ELSE >)>> .K>)>>> " Do a \"TUPLE\" binding." > > > > >)>> 1>>)) #DECL ((SYM) SYMTAB (SK) FIX) > ]>>> > >> >> " Generate the code to actually build a TUPLE." ) (ETAG )) #DECL ((NUM) FIX (STAG ETAG) ATOM) > >> > > " Dispatch table for binding generation code." )> " Appliacation of a form could still be an NTH." ) TY) #DECL ((NOD) NODE) >>> FIX> > ,ALL-REST-CODE> <==? ,NTH-CODE>> <1 .K>)>)> ) (.TY ) (ELSE .NOD>)>> " Generate a call to EVAL for uncompilable FORM." (TEM) DATUM (STK) (SSTK) LIST) >>> > > " Generate code for LIST/VECTOR etc. evaluation." > ) (UNK <>) (TYP >) (INAME UVECTOR>>>)) #DECL ((GT) (NOD) NODE (WHERE) (ARGS) (I) FIX (VALUE RES) DATUM) ) > > ,SEGMENT-CODE> >> >> LIST> >> > >) (ELSE 2> .UNK> >> )>) (ELSE DONT-CARE>>> >)> >> > > `D ) (ELSE `A )>>>>) (ELSE `D* ) (ELSE `A* )> <+ .I .I>) (ELSE .I)>>>)> > >)> >) (ELSE >)>)>> > >) (ELSE > )>)> > "Generate code for a call to a SUBR." (NOD) NODE) .WHERE>> " Compile call to a SUBR that doesn't compile or PUSHJ." ) (OS .STK) (STK (0 !.STK))) #DECL ((STA I) FIX (OBJ) (UNK) (STK) (OS) LIST (RES) DATUM) ,SEGMENT-CODE> > >> .UNK> > ) (ELSE >> >)>> .OBJ> > ) (ELSE )> > )) #DECL ((VALUE) (LS) ) >) (ELSE '(ANY ANY))>> " Generate calls to SUBRs using the internal PUSHJ feature." ) (BRANCH <>) (DIR <>) "AUX" (TMPL >) W (SDIR .DIR) B2 (OS .STK) (STK (0 !.STK)) W2 (TP <4 .TMPL>)) #DECL ((NOD) NODE (WHERE W2) (W) DATUM (TMPL) (UNK) (STA ARGS) FIX (STK) (OS) LIST) >> INTH> > <1 >)>)> ) (> )> >> > > ) (ELSE )>) (ELSE >>) ( <==? 2> ANY-AC> <==? ,AC-A>> ANY-AC> <==? ,AC-B>>>>>> > >>)> ) (ELSE )> .WHERE>> )> .WHERE)>) (.BRANCH >> .BRANCH) (ELSE >)> .DIR > ) (ELSE )> .WHERE>> )> .W2) (<5 .TMPL> .WHERE>) (ELSE .WHERE>)>> ) (ARGS 0) (STA ) N (K )) #DECL ((NOD N) NODE (ARGS STA) FIX (K) ) > >> ,SEGMENT-CODE> > >> .UNK> > ) (ELSE >> >)> >> >) (.PASN >)> .ARGS)>> " Get a bunch of goodies into ACs for a PUSHJ call." (NOD) NODE (ACTMP) LIST) >) () (W <1 .WL>) (SD >) (RT >)) #DECL ((N) NODE (W) (RT) ) ,QUOTE-CODE> DONT-CARE) (.SD >) (ELSE ANY-AC)> ANY-AC>) (ELSE )>>> >> )> .W> .ACTMP>> >> .WHS .ACTMP>> ,RET-TMP-AC .WHS> T)>> ) ,QUOTE-CODE> <>) ( ,ISUBR-CODE> >> )>> .L>> " Generate code for a call to an RSUBR (maybe PUSHJ)." ) ACST RN KNWN (OS .STK) (STK (0 !.STK))) #DECL ((N RN) NODE (W) (STK) (OS) LIST) <==? ,SEGMENT-CODE> .ARG>>> > FUNCTION> >>> <==? .FCN .RN>>> <=? .ACST '(FUNNY-STACK)>> >> .KNWN <>>) (ELSE > UVECTOR>>>>)> .W>) (ELSE )>> " Generate a call to an internal compiled goodies using a PUSHJ." ) (AN <2 .N>) (OS .STK) (STK (0 !.STK))) #DECL ((NOD) NODE (WHERE) (STK) (OS) LIST (N) > (AN) ) >> '![!] .KNWN > .WHERE>> " Get the arguemnts to a FUNCTION into the ACs." ) (INAME ) (N 1) (ACST ) TG1 TG2 TG) #DECL ((N RQRG) FIX (INAME) (ACST) LIST (NOD) NODE) > >> > > >> >> >) (ELSE > >>>> >> >> > ]>> > > > > >>> >) (ELSE > >>)> > > > >> >> >>)>)>) (ELSE > >>> > >> >> >)>> " Push the args supplied in ACs onto the stack." > >> .ACST> .N> ) TT OFFS) #DECL ((OFFS NARG) FIX (ACS) LIST (TT) ADDRESS:C) > >)> >>> > > >>> .ACS> ]>>> " Generate PUSHJ in stack arg case (may go different places)" (KNWN) (INT) ) ;"TUPLE?" >)> >>) (ELSE >)>>) (ELSE > >)> >>) (ELSE >)>>) (ELSE > > >)> 2>)) #DECL ((I) FIX) '>> T>>>) (ELSE >>>)>>>>> `(A) >>)>) (ELSE >>) (ELSE >>)>>)>)>> " Generate code for a stackform." ) TT T1 T2 TTT (PRE T) (OS .STK) (STK (0 !.STK)) (SUBRC >> ,FGVAL-CODE> <==? >>> ,QUOTE-CODE> >> .TTT>)) #DECL ((NOD TT) NODE (K) (PRE) (WHERE) (STK) (OS) LIST) DONT-CARE>>>)> > >> > <3 .K> <>> DONT-CARE>>> > .WHERE>> " Generate code for a COND." ) (BRANCH <>) (DIR <>) "AUX" SACS NWHERE (ALLSTATES ()) (SSTATE #SAVED-STATE ()) (RW .WHERE) LOCN (COND ) W2 (KK ) (SDIR .DIR) (SACS-OK T) (SNUMSYM ())) #DECL ((NOD) NODE (WHERE RW) (COND) ATOM (W2) DATUM (KK) (ALLSTATES) (SSTATE) SAVED-STATE (LOCN) DATUM) >> ) (ELSE > >)> > > FALSE> <==? > FALSE>>> >>)> >) (BR <1 .BRN>) NEXT (K ) (PR ) (NO-SEQ <>) (LEAVE <>) (W ) (ELSE .WHERE)>) FLG (BRNCHED <>)) #DECL ((PR BR) NODE (BRN) (K) ) >> <==? .LOCN ,NO-DATUM>>> FALSE>>> .LAST> >> FLUSHED) (ELSE .W)>>> )>) ( FLUSHED) (ELSE .W)> .NOTF>>) (ELSE FLUSHED) (ELSE .W)>>> >)> > >) (> !.ALLSTATES)>)> ) (<==? > FALSE> ) (<==? .RW FLUSHED> .BRANCH) (ELSE .COND)> .PR T FLUSHED .NOTF>) (ELSE >) (ELSE >> .W) (ELSE .W)> .NOTF>>)>)> > FLUSHED> > >) (ELSE > > FALSE> > > ) (ELSE >> >) (ELSE >)> >)> !.ALLSTATES)>> ) (> .BRANCH> .W .NOTF>>) ( FLUSHED>>) (>> .W>>) (ELSE FLUSHED>)> NO-RETURN>> !.ALLSTATES)>>) (<==? NO-RETURN> >>> >)>) (ELSE >)>)> > > >>> FALSE>>> '>>> ) (ELSE > .W>>)>) ( > FLUSHED) (ELSE .W)>>>)> >) (ELSE FLUSHED) (ELSE .W)> .BRANCH .SDIR .NOTF>>)>> >) ( FLUSHED) (ELSE .W)> .BRANCH .SDIR .NOTF>>)> > !.ALLSTATES)>>) (ELSE >>> > )> > > >)> )> > >> .KK> > NO-RETURN>> > AC> >> .LOCN>> AC> .W2 .LOCN>> AC> .W2 .LOCN>>)> NO-RETURN> ,NO-DATUM) (ELSE )>> > > > .NWHERE> ) > .D .W .N>) (ELSE .W>)>>)> FLUSHED>> >>> > ,RETURN-CODE>> )) >> .NRES>)> >> ,ALLACS>) (ELSE > .ALLSTATES>)>> " Fixup where its going better or something?" ) DONT-CARE) (>> ) (<==? .WHERE DONT-CARE> ) (ELSE .WHERE)>> " Generate code for OR use BOOL-GEN to do work." ) (BR <>) (DIR T)) #DECL ((NOD) NODE) T .WHERE .NF .BR .DIR>> " Generate code for AND use BOOL-GEN to do work." ) (BR <>) (DIR <>)) #DECL ((NOD) NODE) <> .WHERE .NF .BR .DIR>> ) (FLUSH <==? .RW FLUSHED>) (FLS .FLUSH>) RTF SRES (LOCN ) FIN (SACS-OK T)) #DECL ((PREDS) (SSTATE) (SS) SAVED-STATE (NOTF DIR FLUSH FLS RTF) ANY (BOOL) ATOM (BRANCH) (WHERE RW) (NOD) NODE (LOCN) ANY (SRES RESULT) ANY) >) (ELSE > >)> >> <==? .SRES .DIR> FALSE>>> >> > .WHERE>>) (ELSE ) (LAST >) (RT ) (W > > >>) ( .LAST> > ) (<==? .RW FLUSHED> FLUSHED) (ELSE .WHERE)>) (RTFL <>)) #DECL ((BRN) (BR) NODE (W) ) > FALSE>>>> >> .NOTF>>) (ELSE .BR .SRES .NOTF>>)> > > !.SSTATE)>) (<==? .RT NO-RETURN> > )>) (.LAST > > > !.SSTATE)>) (<==? .RT NO-RETURN> > )> .LOCN) (ELSE > > > !.SSTATE)>) (<==? .RT NO-RETURN> > )> )>) (>) (ELSE .RTFL)>> .LAST> >> .W) (ELSE FLUSHED)>>> T> >) (ELSE >)> ) (ELSE >)> >> .PREDS>)> > > >> > AC> .LOCN>> AC> .WHERE .LOCN>> AC> .WHERE .LOCN>>)> > > NO-RETURN> ,NO-DATUM) (ELSE > )>> > .FIN> " Get the best set of acs around for this guy." DONT-CARE) ( > >>) ( AC> ) (ELSE ANY-AC)> AC> ) (ELSE ANY-AC)>>) (ELSE >) (ELSE ANY-AC)> ANY-AC>)>> " Generate code for ASSIGNED?" ) (BR <>) (DIR <>) "AUX" (A >) (SDIR .DIR) (FLS <==? .W FLUSHED>) B2) #DECL ((A) DATUM (N) NODE) >> > ) (ELSE .DIR)>> >> `O* '>> FLUSHED) (.BR >> .W>> .W) (ELSE >> )>> )) #DECL ((N) NODE (B2 B) ATOM (W) ) > .W> > .W> > " Generate code for LVAL." ) (TAC <>) (VAC <>) TT ADDR (LIVE >> 2> <2 .TT>) (ELSE T)>)) #DECL ((NOD) NODE (SYM) SYMTAB (ADDR) (TAC VAC) (NO-KILL) LIST) > >> AC> > ,ACLINK (.ADDR !)>> AC> > ,ACLINK (.ADDR !)>> >) (ELSE <>> .WHERE>> > AC> > > AC> > DONT-CARE> > > >)>)>)> .SYM> >> .NO-KILL>>> >>>> <>> .SYM>>> .SYM>>>)> .ADDR> >]> (SYM) SYMTAB) > )> >> >> >>>> > > AC> .SYM>>> > AC> .SYM>>> >)>)> >>> ]> (S) SYMBOL) <>) (ELSE ]>) .S> >>> .L)>>) (ELSE > )>)> >>> >>)>> " Generate LVAL for free variable." > SYMTAB> > >>>) (ELSE > >>>)> .WHERE>> > SYMTAB> > DONT-CARE>> >>) (ELSE > DONT-CARE>> >>)> >> >>> > " Generate code for an internal SET." ) (TY >>) TEM (TYAC ANY-AC) (STORE-SET <>) (VAC ANY-AC) DAT1 (TT <>)) #DECL ((NOD) NODE (ADDR TEM) DATUM (SYM) SYMTAB (STORE-SET) ) DONT-CARE> > DONT-CARE> > AC> >> AC> >>)> > >> > ) (ELSE )>)> > >> LIST>> ) (ELSE )>)> FUDGE> >> > >>>>> '> <==? .TYAC ANY-AC> <==? .VAC ANY-AC> >>> > AC> >>>> >)> > ) (ELSE > )>>> (AC) AC) ) ( AC> >>> )>> > )>>)> >> > AC> .TEM> .SYM>>)> AC> .TEM> .SYM>>)>)> AC> >)> > >>> > " Update the stack model with a FIX or an ATOM." ) .THING>>) ( <==? .THING PSTACK>> ) ( !.STK)>) (ELSE )>> " Return the current distance between two stack places." ) > PSTACK> >> > ) (ELSE >)>)> > >>> " Compute the address of a local variable using the stack model." )) #DECL ((NOD) NODE (S) SYMTAB) .STYP>> > >> AC> ,ACLINK (.T2 !>)>)> AC> ,ACLINK (.T2 !>)>)> .T2) (ELSE LIST> <1 >> 1 <>>)> TEMPV> <==? <1 .FRMS> >> >>) >> `(TP) >>) (> `(FRM) ) (ELSE `(TB) )> 1) (ELSE 0)>>>)> ) ( DATUM> >) ( FIX TEMPV> <==? <1 .FRMS> >> ) ( ! ATOM> > .NTSLOTS>) (ELSE (0))>)> `(TP) >> ) (<==? <1 .FRMS> > ! FIX> 1>>) (ELSE '(-2))>) (>> .NTSLOTS) (ELSE > .NTSLOTS>)>)>) () (OFFS (0 ())) (CURR <>)) #DECL ((FRMS NNTSLTSJ) LIST (OFFS) ]>) FUZZ>> 1> .T3> VECTOR (>)>> ) (ELSE 1> > VECTOR (>)>> )>) (ELSE >>)> >> > <1 .FRMS>> FIX> (<+ <- <1 .OFFS>>>)) (ELSE ) LIST>>>)> (>))> > .T3> VECTOR (!<2 .OFFS> ! ATOM> > .NNTSLTS>) (ELSE 1>>)>)>> ) (ELSE ! ATOM> > .NNTSLTS>) ( FIX> 6> 9> > '(STACK)>> 1>>) (ELSE '(0))> !<2 .OFFS>)>)>>>>)>) (ELSE )>)>> > > >>>> >) ( .STYP >> >) (ELSE .TEM)>> (FRM) LIST) >) (ELSE )>> .FRM> (<+ <1 .OFF> .NF> (!.NX !<2 .OFF>))> " Generate obscure stuff." > .WHERE>> " Do GVAL using direct locative reference." >>>) (RT >)) #DECL ((N) NODE) > .GD> .W>> " Do SETG using direct locative reference." >) (FA ) (RT >) (D DONT-CARE) ( > AC>> )> .DD) (> ) (ELSE DONT-CARE)>>)) #DECL ((N NN) NODE (D) DATUM (FA) FIX) >>>> VECTOR>> > T> ATOM> >> AC>> AC>> ) (ELSE )>> )> RGLOC > >> AC>> |GLOTOP 1 >> .GL> .GL) (ELSE >)>> " Generate GVAL calls." > >> .WHERE>> " Generate a SETG call." > DONT-CARE>> > >> >>> ,ACPROT T> >> ,ACPROT <>> > >) (N <1 >) TEM (ITYP >) ( ,SNODES> DONT-CARE) (ELSE ANY-AC)>)) #DECL ((NOD N) NODE (TEM) DATUM (WHERE) ) > ) (ELSE >> .TEM> AC>> >> )>) ( 2> AC>> >>>> ) (ELSE >>> )>) (ELSE >> .TEM> AC>> >> )>> " Generate do-nothing piece of code." > .W>> ) (NOUNWIND ) W1) #DECL ((N) NODE (STK) (OSTK) LIST (W1) DATUM) > > > > > >>> > > > FLUSHED> > AC> .W1>> AC> .W1>> > " Generate call to READ etc. with eof condition." '![READCHR NEXTCHR!]>)) #DECL ((N) NODE (STK) (OSTK) LIST (I) FIX (SPOB) NODE) ,EOF-CODE> ) (ELSE >>)>) (ELSE ,EOF-CODE> ) (ELSE >>)> >)>> > READCHR> |CREADC ) (ELSE |CNXTCH )>>> > >>) (ELSE .I> >)> .W) (ELSE )>>> .W>> > >> ) PITEM PINDIC (BR ) (INDX ,GETTERS> UVECTOR>>) (LN )) #DECL ((N) NODE (K) (PITEM PINDIC) DATUM (INDX LN) FIX) >> >> >> >> >> >) (ELSE > DONT-CARE>>> ) (ELSE >>)> )> .W>> ) "AUX" (FUNNY '![STRING BYTES FRAME TUPLE LOCD!]>) (TRY1 .TRY)) #DECL ((TYP) ATOM) >> AC> > >>> ) (ELSE .TYP)> >) (.FUNNY ) (ELSE )>) (ELSE >) (ELSE ANY-AC)>>)>> > )>