X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=mim%2Fdevelopment%2Fmim%2Fmimc%2Fpass1.mud;fp=mim%2Fdevelopment%2Fmim%2Fmimc%2Fpass1.mud;h=87f7ce4ab4e198c8075ae4b07f32dca8e3a4799e;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hp=0000000000000000000000000000000000000000;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07;p=pdp10-muddle.git diff --git a/mim/development/mim/mimc/pass1.mud b/mim/development/mim/mimc/pass1.mud new file mode 100644 index 0000000..87f7ce4 --- /dev/null +++ b/mim/development/mim/mimc/pass1.mud @@ -0,0 +1,1784 @@ + + + + + + + + + +" This file contains the first pass of the MUDDLE compiler. +The functions therein take a MUDDLE function and build a more detailed +model of it. Each entity in the function is represented by an object +of type NODE. The entire function is represented by the functions node +and it points to the rest of the nodes for the function." + +" Nodes vary in complexity and size depending on what they represent. +A function or prog/repeat node is contains more information than a node +for a quoted object. All nodes have some fields in common to allow +general programs to traverse the model." + +" The model built by PASS1 is used by the analyzer (SYMANA), the +variable allocator (VARANA) and the code generator (CODGEN). In some +cases the analyzers and generators for certain classes of SUBRs are +together in their own files (e.g. CARITH, STRUCT, ISTRUC)." + +" This the top level program for PASS1. It takes a function as +input and returns the data structure representing the model." + + )> + + + + + + )> + +) (TT ()) (FCN .FUNC) TEM (RQRG 0) (TRG 0)) + #DECL ((FUNC) FUNCTION (VARTBL) (FNAME) + (FCN) (ARGL TT) LIST (RESULT) + (RQRG TRG) ) + )> + ATOM ADECL> + > + >)> + )> + > + > + > DECL>> + > + >)> + )> + .FNAME () + () () .HATOM .VARTBL 0 0>> + + + !)> + > .FCN>> + > + + > + .RESULT> + +"Vector of legal strings in decl list." + + + +)) + + >)) + + + >> + ,TOT-MODES> + 1>> + + >> + '[ACODE-INIT ACODE-INIT1 ACODE-ERR ACODE-NORM]>> + +"Amount to rest off decl vector after each encounter." + + + +" This function (and others on this page) take an arg list and +decls and parses them. + + 1) An RSUBR decl list. + + 2) A machine readable binding specification. + +Atoms are also entered into the symbol table." + +) T T1 SVT (IX ,ACODE-INIT)) + #DECL ((BNDL_BOT RES_BOT) (BNDL_TOP RES_TOP) LIST + (ARGN) (VIX) + (MODE) > (IX) + (ARGL) LIST (SVTBL SVT) SYMTAB (DCL) >) + )> + > ATOM FORM LIST ADECL> + > + ) + ( + )> + + >> + )> + + >>>> + >> + "OPT"> "OPTIONAL") + (ELSE <1 .ARGL>)>)>)>) + (ELSE + )> + >> + )> + ) + ) + (> + >)> + > + + + <==? 2> + SPECIAL> + <==? <1 .DC1> UNSPECIAL>>> + >)> + + + >> + <>>)>> + LIST>> + >> + + + + .SVTBL> + + + ) + (ELSE >)>>)> + > 0> > + > + ,FUNCTION-CODE> + ,TOTARGS .TRG> + ,RSUBR-DECLS + >)> + > + +"RUN-ARGER dispatches to different arg handlers" + +) + (,ACODE-CALL ) + (,ACODE-OPT ) + (,ACODE-OPTIONAL ) + (,ACODE-ARGS ) + (,ACODE-TUPLE ) + (,ACODE-AUX ) + (,ACODE-EXTRA ) + (,ACODE-ACT ) + (,ACODE-NAME ) + (,ACODE-INIT ) + (,ACODE-INIT1 ) + (,ACODE-NORM ) + (,ACODE-DECL ) + (,ACODE-VALUE ) + (,ACODE-ERR )>> + +) + >)> + > )> + >>> + +"This function used for normal args when \"BIND\" and \"CALL\" still possible." + +) + > + > + +"This function for normal args when \"CALL\" still possible." + +) + > + + > + +"Handle a normal argument or quoted normal argument." + + + )> + + + .DC) + (ELSE )> + T>)>) + ( + 2> + )> + <2 .OBJ>>) + (> + + 2> + )> + > + >)> + + .DC) + ( .DC1) + (ELSE )> + T>)>)> + > + > + >)>> + +"Handle \"BIND\" decl." + + + 2> + )> + > + >)> + > + )> + + .DC) (ELSE )> + T>> + + > + +"Handle \"CALL\" decl." + +> + + 2> + )> + > + >)> + > + )> + + .DC) + (ELSE )> + T>>)> + + > + > + +"Flush on extra atoms after \"CALL\", \"ARGS\" etc." + +> + +"Handle \"OPTIONAL\" decl." + + + 2> + )> + > + >)> + + + .DC) + (ELSE )> + <>>)>) + ( + > + + 2> + )> + > + >)> + + .DC) + (ELSE )> + <>>)>) + (> ATOM ADECL> + + 2> + )> + > + >)> + > + .DC) + (ELSE )> + ,ARGL-IOPT>)>) + ( + > + + 2> + )> + > + >)> + > + .DC) + (ELSE )> + ,ARGL-QIOPT>)>) + (ELSE )> + >> + +"Handle \"ARGS\" decl." + +) + + 2> + )> + > + >)> + > + )> + + .DC) + (ELSE )> + <>>>)> + + + >> + +"Handle \"TUPLE\" decl." + + + 2> + )> + > + >)> + > + )> + + .DC) + (ELSE )> + <>>>)> + + > + +"Handle \"AUX\" decl." + + + 2> + )> + > + >)> + + + .DC) + (ELSE )> + <>>) + ( > ADECL ATOM>> + + 2> + )> + > + >)> + + .DC) (ELSE )> + ,ARGL-IAUX>) + (ELSE )>> + +"Handle \"NAME\" and \"ACT\" decl." + + + 2> + )> + > + >)> + > + )> + + .DC) (ELSE )> + <>>> + > + +"Fixup activation atoms after node generated." + +)) + #DECL ((N) NODE (L) ) + )> + >> ,ARGL-ACT> + + >> + )> + >>> + + + >> + T -1 0 T <2 .ARG> <> <>>)>) + (ELSE + )>> + + + > + + (RESTS) > + +"Check for quoted arguments." + +) + 2> + <==? <1 .OB> QUOTE> + ATOM ADECL>> + <2 .OB>) + (ELSE T)>> + +"Chech for (arg init) or ('arg init)." + + 2> + ATOM ADECL> + FORM> >>>> + <1 .OB>) + (ELSE T)>> + +"Add a decl to RSUBR decls and update AC call spec." + + >> + T> + +"Add code to set up a certain kind of argument." + + + + <==? 2> + SPECIAL>> + <==? <1 .DC1> UNSPECIAL>>> + >) + (ELSE )> + .VAL>> + >> + .DC> + +"Find decl associated with a variable, if none, use ANY." + + (ATM) ATOM) + >>> + )> + LIST>> + )> + LIST>> >)> + >>> + +"Add an AUX variable spec to structure." + + + +> + + + > + > STACK> + <==? 2> + > FORM> + > + ,OBJ-BUILDERS>> + >> + + <==? 3> + > FORM> + <==? 2> + <==? <1 .OBJ2> STACK> + > FORM> + > + ,OBJ-BUILDERS>> + > + ) + FORM>>>> + STACK () STACK>> + )>) + (<==? .AP TUPLE> + > + > + >>) + (<==? .AP ITUPLE> + ) + >>) + ( + + > + > + )>>>) + (ELSE >)> + >> + +"Main dispatch function during pass1." + + (VALUE) NODE) + + PTHIS-TYPE> + ,PDEFAULT> + .OBJ>> + +"Build a node for <> or #FALSE ()." + + ()>> + + PTHIS-OBJECT ,FALSE-QT>)> + +"Build a node for ()." + +> + + )> + +"Build a node for a LIST, VECTOR or UVECTOR." + + + + () + <>>)) + #DECL ((VALUE) NODE (TT) NODE) + > .OBJ>>> + + + + + )> + +"Build a node for unknown things." + + .OBJ ()>> + +"Further analyze a FORM and build appropriate node." + + (VALUE) NODE) + )) + #DECL ((APPLICATION) (APPLY) ) + + ,PSUBR-C> + PAPPLY-TYPE> + ,PAPDEF> + .OBJ + .APPLY>>> + + )> + +"Build a SEGMENT node." + + <> ()>)) + #DECL ((TT VALUE PARENT) NODE) + ) + >)>>> + + )> + +"Analyze a form or the form " + +) + #DECL ((AP) ATOM (VALUE) NODE) + ) + (.REASONABLE + > + ) + (>> + ) + (T + <2 .L <+ <2 .L>:FIX 1>>)> + ) + (ELSE + + )>> + + )> + +"Expand MACRO and process result." + + + +>> ;"Turn On new Error" + ) + + + >> + ;"Turn OFF new Error" + + ) + (ELSE )>> + + )> + +> <==? <1 .T> CONTROL-G!-ERRORS>> + + + + + ) + ( > + ,MACACT>) + (ELSE + + )>> + +"Build a node for a form whose 1st element is a form (could be NTH)." + + 2> >> + .OBJ () .AP>> + > .OBJ>>) + (ELSE )>> + + )> + +"Build a node for strange forms." + + + + .OBJ () .AP>> + +"For objects that require EVAL, make sure all atoms used are special." + +) + + > + > 2> + <==? <1 .OB> LVAL> + > ATOM>> + + <==? <1 .OB> SET> + > ATOM>>> + >> + > + + )>)> + '[FORM LIST UVECTOR VECTOR]> + ,SPECIALIZE .OBJ>)>> + +"Build a MSUBR call node." + + + <2 .AP>) + (ELSE <1 .OBJ>)> + () + .AP>)) + #DECL ((TT) NODE (VALUE) NODE (OBJ) FORM) + > >>> + + LVAL () ,LVAL>)) + #DECL ((TT VALUE) NODE) + .TT>)>> + + GVAL () ,GVAL>)) + #DECL ((TT VALUE) NODE) + .TT>)>> + + + + )> + +)) + #DECL ((TT VALUE) NODE (OBJ) FORM) + <==? .LN 3>>> + )> + + INTH) (ELSE IPUT)> + () + ,NTH) (ELSE ,PUT)>>> + .TT> + + ! ()) (ELSE ( .TT>))>)>> + + + + )> + +"PROG/REPEAT node." + +) TT (DCL #DECL ()) (HATOM <>) ARGL + (VARTBL .VARTBL) + (IN-IFSYS .IN-IFSYS)>)) + #DECL ((OBJ) (TT) NODE (VALUE) NODE (DCL) DECL + (ARGL) LIST (VARTBL) (IN-IFSYS) ) + >> + )> + ATOM ADECL> + > + >)> + > + > + > DECL>> + > + >)> + )> + + .NAME + () + .AP + () + .HATOM + .VARTBL>> + > STRING>> + .ARGL) + (ELSE ("AUX" !.ARGL))> + .DCL + .HATOM + .TT> + > + > .OBJ>> + .TT> + + + + + )> + +"Unwind compiler." + + <1 .OBJ> () .AP>)) + #DECL ((PARENT VALUE TT) NODE (OBJ) FORM) + 3> + .TT> .TT>)>) + (ELSE )>> + + > + )> + +"Build a node for a COND." + + COND ()>)) + #DECL ((PARENT) (OBJ)
(VALUE) NODE) + <> ()>)) + #DECL ((TT) NODE) + >> + .TT>> + > + >>) + (ELSE + )>> + >>> + + + + + )> + +"Build a node for '<-object>-." + + () ()>)) + #DECL ((TT VALUE) NODE (OBJ) FORM) + >> + #FALSE()> + BOOL-FALSE) + (ELSE >)>> + >)>> + + )> + +"Build a node for a call to an RSUBR." + + <1 .OBJ> () .AP>)) + #DECL ((OBJ) FORM (AP) MSUBR (PARENT) + (VALUE) NODE) + 2> DECL LIST>> + .OBJ <3 .AP>>> + >>) + (ELSE )>> + + )> + +) (TUPF <>)) + "VALUE"> >)> + <=? .EL "ARGS">> ) + ( <=? .EL "OPTIONAL">> + + ) + (<=? .EL "TUPLE"> )> + > + .DCL>> + +"Predicate: any segments in this object?" + +) + >)> + SEGMENT> )> + >>> + +"Analyze a call to an MSUBR with decls checking number of args and types wherever + possible." + +) (SGD '<>) (SGP '(1)) SGN + (IX 0) DC (RM ,RMODES) (ARG-NUMBER 0) (KDS (())) + (TKDS .KDS) RMT (OB ) (ST <>) (ODC "FOO")) + #DECL ((TKDS KDS) (OB) LIST (OBJ) > + (RM) > (ARG-NUMBER) FIX + (RDCL) > (DOIT SEGSW) (IX) FIX + (RSB NAME) (SGD) FORM (SGP) (SGN) NODE) + > + > > >)> + + )> + >> + )> + + >>> + .ST .DC .ODC>> + + ;"TUPLE seen." + ALL>>)>) + ( + 4> >> + ) + (.SEGSW + > + + + .SGD>> + >) + (ELSE >>)>) + ( SEGMENT> + >>)>>> + > + + <1 .OB>>> + >) + (ELSE )>) + (ELSE + > + + ,SEGMENT-CODE> + >> + [REST .DC]>>> + )>) + (ELSE + .DC>> + )> + > + )>)>)> + .TT> + >> + >)> + > LIST>>> + > + ) + ()>>> + > + > + >)>)>) + ( >) + (.SEGSW + .SGD>) + (ELSE .SGD)>> + >) + ( + > >)> T> + .OB> + >>)>>> + >) + (ELSE )>>> + + + +"Flush one possible decl away." + +) + )> + > + T> + +"Handle Normal arg when \"VALUE\" still possible." + +) + > + + > + +"Handle Normal arg when \"CALL\" still possible." + +) + > + + > + +"Handle normal arg." + + .PARENT>>> + .DC>> + >)> + > )> + .TT> + +"Handle \"QUOTE\" arg." + +> + <1 .OB> + ()>>> + .DC>> + >)> + + .TT> + +"Handle \"CALL\" decl." + +>> + .DC>> + >)> + + .RSB>> + +"Handle \"ARGS\" decl." + +>> + .DC>> + >)> + + .RSB>> + +"Handle \"TUPLE\" decl." + + .PARENT>>> + .DC>> + >)> + > )> + .TT> + +"Handle stuff with segments in arguments." + +>> + '>> + )> + .TT> + + [REST .DC]>>> + )>> + +"Handle \"VALUE\" chop decl and do the rest." + + (PARENT) NODE) + + > + + STRING>> + > + .F> + +> + + + + + + )> + + (RDOIT SDOIT) VECTOR> + +"Create a node for a call to a function." + + (VALUE) NODE) + ATOM> + .FNAME> <1 .OB> .OB>) + ( RSUB-DEC>> + .OB>) + (.REASONABLE ) + (ELSE + > + >)>) + ( FUNCTION> + >>> + > + )>> + +"Call compiler recursively to compile anonymous function." + +) T GROUP-NAME) + #DECL ((EXTRA-CODE) (VALUE) NODE) + + + > + 1>>> + + + .PARENT>> + +"#FUNCTION (....) compiler -- call ANONF." + +>>)) + > + + + + )> + +" compiler -- call ANONF." + +>>)) + #DECL ((OB) ) + FUNCTION>>> + + )> + +"Handle RSUBR that is really a function." + + .NAME () .BODY>)) + #DECL ((PARENT) (VALUE) NODE) + >>>>> + >> + +"Handle an RSUBR that is already an RSUBR." + + .NAME () .BODY>)) + #DECL ((BODY) (PARENT) (VALUE) NODE) + >> + >>> + + .NAME () FOO>)) + #DECL ((PARENT) (VALUE) NODE) + > + >> + +;"ILIST, ISTRING, IVECTOR AND IUVECTOR" + +> + +> + +> + +> + +> + +> + + + + + )> + + + )> + +) + (LN ) N EV SIZ) + #DECL ((VALUE N EV TT) NODE (LN) FIX (OBJ) ) + ) + (ELSE + + >) + ( >)> + .TT>> + + .PARENT>> + ,QUOTE-CODE> + .TT>> + )>) + (ELSE )> + + ) + (ELSE )>)>> + +"READ, READCHR, READSTRING, NEXTCHR, READB, GET, GETL, GETPROP, GETPL" + +>> + +> )> + +>> + + + >>)> + +>> + +>> + +>> + +>> + +) N (TEM 0)) + #DECL ((VALUE) NODE (TT) NODE (N) (LN) FIX (TEM ARGN) FIX + (OBJ) ) + .ARGN>> ) + (ELSE + > + )) + #DECL ((EV) NODE) + > .ARGN> + ,QUOTE-CODE> + .TT>> + )> + + <> + (.EV)>>)> + .EV> + >> + )>> + +>> + +'>> + +) TT) + #DECL ((OBJ) FORM (LN) FIX (TT VALUE TEM T2 EV) NODE) + > > + ) + (ELSE + > + .TT>> + .TT>> + + + ) + (ELSE + .TT>> + ,QUOTE-CODE> + .TT>> + )> + )> + .TT)>> + + FIX>) + > >)> + + ) + ( + )> + T> + +" " + +) TT ITRF OBJ (RQRG 0) + (LN >>) FINALF TAPL (APL ()) + (DCL #DECL ()) (ARGL ()) (HATOM <>) (NN 0) TEM L2 L3 + (TRG 0)) + #DECL ((OBJ OB) (LN NN) FIX (DCL) DECL (ARGL APL) LIST + (ITRF FINALF TT) NODE (TRG RQRG) ) + )> + .NAME () .AP>> + .TT>> + > FUNCTION> + + >>> + > ATOM> + + <==? ,.TEM ,FUNCTION> + >>> + >> + )> + ATOM ADECL> + > + >)> + LIST>>> + )> + > + > + > DECL>> + > + >)> + + )> + ) + ANY> + <> + () + <> + () + .HATOM + .VARTBL>> + + > + > + ) (LL .L) (L1 .L) SYM) + #DECL ((L L1 LL) ) + > + >> 1> + !.L2)> + ) + + >) + (ELSE >)> + !.L3)> + >) + (ELSE >)>)> + >>>> + !.APL>)>)> + > .APL>>>) + ( <==? .LN 3>> + + <==? >> 2> + > ATOM> + + <==? ,.TEM ,GVAL> + > ATOM>> + + >>> + + > + <==? .TEM .FNAME>>>>>> + + .TT>) + (ELSE + ) + (ELSE + > + .IND)>>>> .TT>)>> + + + ,MARGS-CODE> + >>>> + > + <> (.ITRF) <>>>) + (ELSE >)> + > >)> + .TT>> + +\ + + <> () <>>> + + + + )> + + ADECL () <>>) + OBJ1) + #DECL ((TT VALUE) NODE (OBJ) ADECL) + 2> + > SEGMENT> + + > + + <2 .OBJ>] ADECL>>)>) + (ELSE + > + .TT>)>)>) + (ELSE + )>> + + )> + +) P TEM X) + #DECL ((PARENT) (OBJ) (VALUE) NODE) + 3> + >> GVAL> + <==? > ==?>> + > FORM> + <==? 2> + <==? <1 .X> GVAL> + <==? > ==?> + ;> '[==? TYPE? PRIMTYPE?]>>>) + (ELSE >)> + 1> + + > ) + (> > >) + ( >> + >> + > >>) + (ELSE >)>) + (> SEGMENT> + <==? 2> + <==? <1 .TEM> QUOTE> + >>>> + + >> >) + (ELSE + + > + >>) + (ELSE >)>)>> + .TEM>) + (ELSE >)>) + (ELSE >)> + T> + > + > + '[WORD FIX]> + <==? .P ==?>> + <==? .TYP ATOM>>>>> + >)> + CASE ()>> + .PARENT> + .PARENT> + ! (TT) NODE) + )> + > + <> ()>> + ,PREDIC + > SEGMENT> + >>) + ( + >) + (ELSE )> + .TT>> + > + >> + > + .TT) + (ELSE )>> + >)>) + (ELSE )>) + (ELSE )>> + + + <==? WORD> + <==? FIX>> .TEM> + GVAL> + >> + ,.TEM> + + <==? 2> + QUOTE> <2 .TEM>> + GVAL> > ,<2 .TEM>> + ASCII> + CHARACTER FIX> + >>> + + <==? 3> + <==? <1 .TEM> CHTYPE> + ATOM> + FORM LIST VECTOR UVECTOR SEGMENT>> + > + + > + > ATOM> + + + >>>> + + + + >>> + +) TEM) + + ) + + + >> + FUNNY> + + ) + (ELSE .TEM)>> + + > + )> + + + CALL + () + .AP>)) + #DECL ((TT) NODE (VALUE) NODE (OBJ) FORM) + >> + > ATOM>> + + >) + (<==? .CALLED ENDIF> + >)>)> + > >>> + +>> + > SEGMENT>> + 2> + > GVAL> <==? .TEM LVAL>>> + + + !) FORM>>) + (ELSE + > .ITM)) + > + ) + SEGMENT> + !) FORM>> + .PARENT> .PAP>)>) + (ELSE FORM>>)> + APPLY () .AP>> + > .OBJ>>> + + )> + + CRLF> 1) + (ELSE 2)>)) + #DECL ((OBJ) FORM (LEN) FIX) + .LEN> + + '.OUTCHAN) FORM>>) + (ELSE <2 .OBJ> '.OUTCHAN) + FORM>>)>)> + > + + + + + + )> + + MULTI-SET + () ,MULTI-SET>) L) + 2> + )> + > LIST>> + + + + + ATOM>>>> + )> + <>> + .L>> + )> + .TT> + !> + >)>> + + > + )> + +) + .IN-IFSYS> + >> + + >) + ( + BIND>)>>)> + > LIST>> + + > STRING ATOM>>> + IFSYS>) + (ELSE + >)> + + + + <=? .IN-IFSYS "MAC">>> + + <=? .SYS "MAC">> + <=? .IN-IFSYS "UNIX">>> + ; "Allow for UNIX/VAX/MAC..." + !.STUFF)>)>)>>) + (ELSE + ) FORM> + .AP>)>> + + > + )> + + )> + > LIST>> + + STRING ATOM>>> + IFSYS>) + (T + ATOM> + <1 .L >>)> + > ! + > !.STUFF)>)> + >> + > + +