;"MUDDLE PRETTY-PRINT, FRAME-SCANNER, AND OTHER ROUTINES" ;"These atoms are placed in the ROOT oblist to allow general access to their functions" )> FIXUP!-RSUBRS > > >>)> > > >> >> > \ ) > ) ( >) ( >>) ( >>) ( >> FUNCTION> ) FORM>>) (ELSE >)>) (ELSE >>)>) ( ) ( ) ( ) (ELSE

)>>>) (ELSE #FALSE ("NAKED ATOM?"))>> ) "EXTRA" (OUTC )) #DECL ((L) ANY (MARG) (OUTC) CHANNEL) ) ( .MARG> )> ,NULL> )) #DECL ((L) ANY (MARG) (OUTC) CHANNEL) > >)> .MARG> )> ,NULL> ) (EVAL? <>) (PL 58) "AUX" INCH INL OUTCH (QUICKPRINT <>) (REDEFINE T) (KEEP-FIXUPS T) (MUDDLE ,MUDDLE)) #DECL ((OUTF) STRING (EVAL?) (PL LL MUDDLE) FIX (INL) LIST (INCH OUTCH) (QUICKPRINT) (INPUT) (REDEFINE KEEP-FIXUPS) ) >) ( ) (ELSE >)> > > ATOM>> >>) (ELSE )>) (ELSE ) (ELSE )>)>)> > )> > <10 .OUTCH>>>) (T " <9 .OUTCH> <10 .OUTCH>>>)> > )> ;"Reopen OUTCH in PRINTO mode" ;"Appropriate line length" ;"Big page length" (Q QC) ANY (UNIQUE) LIST (ACC-OLD ACC-NOW PPOS-OLD) FIX (NEWPG) ) )> >> >) (ELSE > )> )> ) (> ;"Top-Level comment ?" )> )> .PL> ;"Last item overflowed page ?" .OUTCHAN> ;"Simply end with form-feed" ) (ELSE ;"Last item was simply one too many on page" ;"Flush out stragglers" > ;"YES, go back and clobber in form-feed" ;"Return" .PPOS-OLD 1>> ;"Repair the page position slot" )>) (ELSE > ;"Save current location" > ;"Output clobberable chars" ;"Fixup OUTCHAN slots" 2>> >)>>> > ":<" <10 .OUTCH> ">" <7 .OUTCH> "." <8 .OUTCH>> TO .OUTF>) ( )> "DONE"> > >>>> ) (WID ) "AUX" (SWID )) #DECL ((X) ANY (OUTCHAN) (COL WID SWID) FIX) ,NULL> \ )) #DECL ((HOW-MANY FIRST) FIX (OUTCHAN) (NO-DUMP) ) ) FUNF FRMF X) #DECL ((F FRMF) FRAME (FUNF) ATOM (X) ANY) ) (<==? > TOPLEVEL> ) ( > >> <==? >> EVAL> >> FORM> > <==? .FUNF <1 .X>>>) (ELSE ;"Tab" >)> > > >>> )) #DECL ((HOW-MANY FIRST) FIX (OUTC) CHANNEL) ) AF V FF) #DECL ((F) FRAME (AF) FORM (FF) ATOM) ) (<==? > TOPLEVEL> ) ( <1? >> > FORM> >>>> ATOM> >> > >> > > >> >> )> > > >>> )) #DECL ((F VALUE) FRAME) ) (<==? TOPLEVEL> )> > >>> )) #DECL ((ATM) ATOM (HOW-MANY FIRST) FIX (OUTC) CHANNEL) > "Atom is not bound anywhere.") (ELSE > ) (LAST-LOC ) (FLG ) (NUM 0) NEXT-LOC) #DECL ((F) FRAME (LAST-LOC NEXT-LOC) LOCD (NUM) FIX (FLG) ) ) (<==? TOPLEVEL> ) (> .LAST-LOC .FLG .OUTC> ) (<==? .LAST-LOC >>) (ELSE .LAST-LOC .FLG .OUTC> >)> > >> "Frame----Value")>> (OUTCHAN) ) > ) (ELSE )>> > CHANNEL>> ;"The VALUE fakes the compiler out") (ELSE )> > ;"Ensure LVALs" )> > )> > )> > )> .OUTC>> \ ;"Dispatch to proper printer based on type of LNEW. Actually pass L (the original object) to save comments." ) (M 0) (LNEW .L) "AUX" FITS? R TYP PTYP) #DECL ((L LNEW) ANY (FITS?) (M) FIX (OUTC) (R) (TYP PTYP) ATOM) )> ;"If its a MONAD, just print it." .M>>> ;"If it fits, use ELEMENTS, else COMPONENTS." ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) ( ) (> PPRINT>> ) (>> ;"Not primitive ?" ;"Try again as primitive type" ;"Space after type name" > ;"Try Primtype instead" ) (ELSE )>>> \ ;"Routines to print objects in certain special formats" ) (ELSE )>> ) .OUTC .OM .STOP>) (ELSE ) (M 0)) #DECL ((N) FIX (M) FIX) > > .OUTC .M> >> )> > >)>> ) ) (.QUICKPRINT .OUTC> >> <==? .L .STOP>> > >) (ELSE ) (M 0) COM) #DECL ((N) FIX (M) FIX (COM) ) > > .OUTC .M> > >> <==? .L .STOP>> )> ) (ELSE )>>)>> ) (ELSE ) FLGC (M > .OM) (ELSE 0)>)) #DECL ((LINE) FIX (FLGC) (M) FIX) .OUTC .M> > >> <==? .L .STOP>> )> > )> <==? .LINE > <- .M 1>>> )> >>)>> (VALUE) (OUTC) ) COMMENT>>> .M) (0)>> > >> .R 2>> )> <- .FS1 .R>> 2> .OUTC> T)>> \ ;"Routines to print list structure in certain special formats" (M) FIX (OUTC) CHANNEL) ) (ELSE )>> (OM) FIX (STOP) ANY (OUTC) ) .OUTC .OM .STOP>) (ELSE ) (M 0)) #DECL ((N) FIX (M) FIX) > > .OUTC .M> >> )> > >)>> (OM) FIX (STOP) ANY (OUTC) ) ) (.QUICKPRINT .OUTC> >> <==? .L .STOP>> > >) (ELSE ) (M 0) COM) #DECL ((N) FIX (M) FIX (COM) ) > > .OUTC .M> > >> <==? .L .STOP>> )> ) (ELSE )>>)>> (STRT) FIX (OM) FIX (OUTC) CHANNEL) ) (ELSE ) FLGC (M > .OM) (ELSE 0)>)) #DECL ((LINE) FIX (FLGC) (M) FIX) .OUTC .M> > >> <==? .L .STOP>> )> > )> <==? .LINE > <- .M 1>>> )> >>)>> (CMNT) ANY (R FS1) FIX (M) FIX (MARG) (VALUE) (OUTC) ) COMMENT>>> .M) (0)>> > >> .R 2>> )> <- .FS1 .R>> 2> .OUTC> ) (ELSE )> T)>> \ ;"The following functions define the way to pprint a given data type. They are called from FORMS for the appropriate type FORM is a special case - see next page." > >> > >> 2>)) #DECL ((POS1) FIX) .OUTC .M> >> .OUTC > >> ) >>> <* 9 >>>> .OUTC >) (ELSE >)> >> >>> > > >> (M) FIX) .OUTC> .OUTC .M>> .OUTC .M>>> RSUBR> <2 <1 .RSENT>>) (ELSE <1 .RSENT>)> <2 .RSENT> !] >> .OUTC .M>>> ) (PURE CODE>>)) #DECL ((RSUB) RSUBR (FIXUPS) ANY (PURE) ) >> .NO-DUMP > <=? <5 .OUTCHAN> "TTY">> ;"Named RSUBR ?" >> > .ATM) (ELSE .OB)>> .RSUB>> !))>>) (ELSE >>)>> 0> )> >> FIX> .OUTC>>> 1 .OUTC .M>) FF) #DECL ((L) < [2 ANY]> (M FF) FIX (OUTC) CHANNEL (F) ) > <+ 2 .FF> .OUTC .M>>> ) POS) #DECL ((L) (POS) FIX (OM M) FIX (OUTC) ) > >) ( 2>>> ) (ELSE ) FLGC) #DECL ((FLG) (FLGC) ) LIST> 0 .OUTC .M>> .OUTC>) (ELSE .OUTC <+ .M 1>> )>) (ELSE .OUTC .M>)> > ) (ELSE )> .OUTC .M> > >> )> .FLG > )> >)> > \ ;"Routines for PPRINTing Functions" ) (NEWLINE #FALSE ()) COMFLG) #DECL ((L) (P P1 OM M) FIX (NEWLINE COMFLG) (OUTC) ) ) ( ATOM> -1 .L .OUTC .M> > .OUTC> > >> ) (.COMFLG ) (ELSE )>)> LIST> > .P .OUTC .M>> > >> ) (.COMFLG ) ( )>)> > ) (ELSE > .P .M>> ) (ELSE )> )>>> (L) (OUTC) ) .FUDGE .M) (0)>>>> (PB M) FIX (POS) FIX (OL) LIST (Q) (OUTC) ) > #FALSE ()) (ELSE > -1 .L .OUTC .M>> )> > )) #DECL ((FIRST) (N) FIX) )> )> >) (> )>) ( .OUTC .N .L>)> > >> T)>> ) #FALSE ()) ( STRING> > <1 .BUNCH>) (ELSE > STRING>> ) (ELSE > .T)>>>)>> \ ;"How to print FORM and its special cases. Special cases for FORM are called from FORM-PPRINT." >)) #DECL ((L) (L1) ANY) PROG> <==? REPEAT>> .OUTC .M>) ('<==? LVAL> .OUTC .M>) ('<==? GVAL> .OUTC .M>) ('<==? QUOTE> .OUTC .M>) ('<==? FUNCTION> .OUTC .M>) (' DEFINE> <==? DEFMAC>> .OUTC .M>) (ELSE .OUTC .M>)>>> >) (L1 <1 .L>) COMFLG) #DECL ((L) (PN M) FIX (L1) ANY (COMFLG) (OUTC) ) ) ( .M>> > > ) ( <==? .L1 SETG> <==? .L1 STACKFORM> <==? .L1 MAPF> <==? .L1 MAPR>> 1 '(0) .OUTC .M>> > > >> )>) (ELSE >)> >) (ELSE >)>>) (T )> .OUTC>> )) #DECL ((L) (PPN) FIX) .OUTC .M> .OUTC>)> >>) ( > .OUTC >)>>> (AVSP) FIX) > FORM SEGMENT> >>> > >>> T) (ELSE >)>>> ) (ELSE '.VERTICAL)>> ANY>) (FO) ANY) .AVSP>>) ( > ) (ELSE )>) (> > LIST>> .AVSP>> )> > )> > ATOM> <==? .FO GVAL> <==? .FO QUOTE>>> >) (ELSE >)>) ( >) ( >) (ELSE >)> > ) (F1 .F)) #DECL ((F1) LIST (F2) ANY) >) () (>>) ( )> >> )> >>>> >) POS COMFLG) #DECL ((L) (POS1 POS M) FIX (COMFLG) (OUTC) ) .OUTC> >> > >>) (ELSE ATOM> ) (ELSE )> .OUTC> > >> )>)> LIST> ) (ELSE )> 1 .L .OUTC .M> .OUTC .M>) (ELSE .OUTC .M> )> >> )>)> .POS .M>> ) (ELSE .POS> > )> >>)> .OUTC>> > > > ) >> > .OUTC >) (ELSE .OUTC .M>)>>> 3>) POS COMFLG) #DECL ((L) (POS1 POS) FIX (COMFLG) ) 1>> .OUTC .M>> >>> ) ( .OUTC>) (ELSE )> .OUTC .M>> .OUTC>>> 3>) POS COMFLG) #DECL ((POS POS1) FIX (L) (COMFLG) ) > .OUTC> >> .OUTC .M>> >>> ) ( .OUTC>) (ELSE )> > .OUTC> .OUTC .M>> >>> ) ( .OUTC>) (ELSE )> .OUTC .M>> .OUTC>>> \ > !\ >>>> > !\ >>>> > )) ;"Print tabs and spaces to get to column -n-" #DECL ((N NOW) FIX (OUTC) ) -1>>> .OUTC> >> ;"Can be screwed by MORE interrupt otherwise" > .OUTC>)>)>>