X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.comp%3E%2Fcomfil.mud.3;fp=%3Cmdl.comp%3E%2Fcomfil.mud.3;h=53262798706448a5f6ed5d60de1149ce3bff3c31;hp=0000000000000000000000000000000000000000;hb=3395a5e4ef72d59cdb6832af7808dc9c2cf2a413;hpb=363cc6ead5cf4df20759797fe46b5dc29b3886e9 diff --git a//comfil.mud.3 b//comfil.mud.3 new file mode 100644 index 0000000..5326279 --- /dev/null +++ b//comfil.mud.3 @@ -0,0 +1,650 @@ + + + + + + + + + ) + ()> + + + + + )> + + + + + + + + +) VAL) +;"Called by PLANs & PCOMPs to do File Compile. + Tastefully Closes & Resets Channel during Compilation. + Calling sequence is " + #DECL ((CH) CHANNEL (TUP) TUPLE (ACC) FIX) + ;"Flush PLAN Channel" + >> ;"Do It" + )> + > + ;"Restore PLAN Channel to Former Glory" + ;"Reset the Various Compiler Flags" + .VAL> + +) OUTCH TEMPCH + (STARCPU 0.5>>) (GFLG T) + (PREV ()) (STARR ) R (TW? ) + (SRC-CHAN #FALSE ()) (IC <>) ATOM-LIST OC SOURCE-STR + FILE-DATA GC-HANDLER OREDEFINE REDONE LOSS ATL + (GCTIME 0.0000000) (OUTCHAN .OUTCHAN) VERS) + #DECL ((FCEX) (SOURCE-STR INFILE OUTFILE VERS) STRING + (TW?) + (OUTCHAN) (INCH OC IC) + (TEMPCH SRC-CHAN) > (PREV) LIST + (OUTCH) (STARCPU STARR ATNUM) + (ATOM-LIST ATL) ]>> + (FILE-DATA) ATOM> (REDONE) + (GCTIME) ) + )> + + >>> + >>>>>)> + + ) + (ELSE + !\> <7 .INCH> + ".NBIN." .VERS>) + ( !\; <7 .INCH> " NBIN">)>>>)>> + + ) + ("SOURCE")>> + + + .SOURCE-STR + "DSK" )(ELSE "HUDINI")>>>> + > + > + > + + )>)> + + )> + )> + > )> + + + )> + > + ")>>>)> + + + "RECORD" + DISOWN + .INCH + .OUTCH + .SRC-CHAN>> + > + + >> )> + > + + + ,CRET ,CRET>)>)> + + > + + > + + >) + (ELSE )> + )> + + + )) + #DECL ((ATM) ATOM (L) ) + >)> + + (.ATM ,.ATM)) (ELSE )>> + .REDO>> + >> .TEMPCH> + + > + + '![PACKAGE ENDPACKAGE ENTRY USE USE-DEFER + USE-TOTAL BLOCK ENDBLOCK!]> + SETG> + <==? 3> + RSUBR RSUBR-ENTRY> + > FORM> + 2> + RSUBR> + <==? <1 .V> RSUBR-ENTRY> + QUOTE> + + RSUBR + RSUBR-ENTRY>>>>>> + AND> + <==? 4> + <=? <2 .F> '> + <=? <3 .F> '.GLUE>>>> + > + + <==? 3> + ATOM> + <==? <2 .F> <2 .V>>> + + + <3 .V>]>>)>)>> + + + + ) <2 .L>>> + .REDONE> + + + ) + (ELSE )>) + (> + )> + + + + + + > + FUNCTION>>> + .ATM) + (ELSE + > + ]>>)> + )>> + <1 .FILE-DATA>>> + + + + ) + (ELSE >>)> + + + > + + )>> + .REDO> + >> + > + ) + + > <2 .OBLIST>>> + >) + (> + > + .SURVIVORS>>)> + > + > + ) + (AL2 ) (AL4 .AL) AL5) + #DECL ((AL AL1 AL2 AL4 AL5) ) + + > + > + ) + ( .ATL> >>) + (ELSE + >> + > + + >)>> + + > + .ATL> + .SURVIVORS) + (ELSE .ATOM-LIST)> + .GROUP-MODE + .SRC-CHAN + T + .CAREFUL + .SPECIAL + .REASONABLE + .GLUE + .TEMPCH + .HAIRY-ANALYSIS + .DEBUG-COMPILE>> + + + + + > + + + .SRC-CHAN> + + ) + ()> + + + ) IT) + #DECL ((OBP) ) + + 2> + DEFINE> <==? <1 .OBJ> DEFMAC>>> + > + )>> + > + > + VALUE '<2 .OBJ>>> + .SURVIVORS> + > + + >) + (ELSE >>)>> + >)> + > + .<2 .FILE-DATA>>)>) + (ELSE + >> + + #FUNCTION ((AL) + #DECL ((AL) > (TEMPCH) ) + <1 .AL>) (ELSE .AL)>>)> + + + .SRC-CHAN> + > + + + #FUNCTION ((AT "AUX" ACC ACC2) + #DECL ((AT) ATOM (LN ACC ACC2) FIX) + + > + + + .TEMPCH> + + '.GLUE +
+ >) + ()> + GLUE + >> + .TEMPCH>> + + + > + > + + + + + > + + + ]>>)>) + (.AL)) (ELSE .AL)>>) + .ATOM-LIST>)> + ) + <8 .TEMPCH> <9 .TEMPCH> <10 .TEMPCH>>>)> + )> + >> + ,PRINT>> + > + )> + + + >)> + + + + > + + .DISOWN> + + "So you re-owned me, eh? I'm done anyway.") + (ELSE "Compilation completed. Your patience is godlike.")>> + +> + ) + (> FORM> + 2> + '![DEFINE SETG DEFMAC]> + VALUE '<2 .OBJ>>>> + RSUBR> + + > + > RSUBR> + >> + > + >> + > FORM> + <==? 4> + <==? <1 .NXT> AND> + <=? <2 .NXT> '> + <=? <3 .NXT> '.GLUE> + <=? <2 <2 <4 .NXT>>> .OBJ>>) + (ELSE + )>>)> + .OBJ> + > 1 + '.GLUE + >) + (ELSE )> GLUE + >>>) + (ELSE >)>)> + >>> + +) (WIN <>) + (PO >)) + > + + > >> + .PO> + >) (ELSE .ATM)>> + +) (LL )) + #DECL ((L LL) LIST) + >) + ( LIST> + > + 1>>> + >>) + (ELSE >>)>>> + +> )>> + + +>) + INTS ENTO INTO) + + + > + )> + > + )> + >)> + >> + >)> + )> + )> + )> + )>> + + + + >> ; "LINKS?" + + > .L>> .OB>> + + +>> .STARCPU>) + (TSTARR <- .STARR>)) + #DECL((STARCPU STARR TSTARCPU TSTARR) FIX) + ;"Went over midnight." + >>)> + + + + "garbage collector CPU time,"> + + + >> + "%." ,CRET + "Number of garbage collects = " ,GC-COUNT ,CRET>> + +> + > " hours "> + >>)> + + " min. "> + >)> + > + + + .GROUP-MODE > + " long."> + ) + ( > + > + >>> + + + " to go."> + ) + ( > + > + + ) + (> + + ) + (ELSE + )>) + (ELSE )>> + +> + >>> + + + + + + + + + + ;"Char Tab"> + + + +> + .A>>> + +> + (<1 > .GRP)> + +> + ) + ( FORM> + >>>> + DEFINE> + DEFMAC>>> + + ()>>) + (ELSE + <2 .TT> <>>>)> + VALUE '<2 .TT>>> + > + >)>)> + >>> + +) + > <==? <1 .TUP> CONTROL-G?!-ERRORS>> + + ;"HAVE TO NEST TO TURN HANDLER ON AND OFF" + + + ) + (ELSE + ,PRINT .TUP> + + + )>> + + + +>> + + ,CRET>> + + + + ":<" <10 .CHAN> !\> <7 .CHAN> !\. <8 .CHAN>>) + ( !\: <10 .CHAN> !\; <7 .CHAN> !\ <8 .CHAN>>)>> + + ..ATM> ;"Do it?" + + ;"Output channel already open." + > >>> + ;"But is it good?" + > + ) + (ELSE )>) + ( ;"Name of output file given." + >) ;"So try opening it." + (ELSE ;"Bad name." + > + )>) + ( .STR2 "DSK" <10 .INCH>>>) + (ELSE > + )> + + .NEW-CHAN)>> + +) B) + > + COMMENT> + COMMENT>)> + >>> + +) + T] + '(54 FINIS!-MUDDLE 230942 (8 5))>> + +