2 <DEFINE PRINT-ANA (N R "AUX" (K <KIDS .N>) (LN <LENGTH .K>) RT)
3 #DECL ((N) NODE (LN) FIX (K) <LIST [REST NODE]>)
4 <COND (<SEGFLUSH .N .R>)
6 <ARGCHK .LN '(1 2) <NODE-NAME .N>>
7 <SET RT <EANA <1 .K> ANY <NODE-NAME .N>>>
9 <PUTREST .K (<NODEFM ,SUBR-CODE .N ANY LVAL () ,LVAL>)>
12 (<NODE1 ,QUOTE-CODE <2 .K> ATOM OUTCHAN ()>)>)>
13 <EANA <2 .K> CHANNEL <NODE-NAME .N>>
14 <PUT .N ,NODE-TYPE ,PRINT-CODE>
17 <DEFINE FLATSIZE-ANA (N R "AUX" (K <KIDS .N>) (LN <LENGTH .K>))
18 #DECL ((N) NODE (K) <LIST [REST NODE]> (LN) FIX)
19 <COND (<SEGFLUSH .N .R>)
21 <ARGCHK .LN '(2 3) FLATSIZE>
22 <EANA <1 .K> ANY FLATSIZE>
23 <EANA <2 .K> FIX FLATSIZE>
25 <PUTREST <REST .K> (<NODE1 ,QUOTE-CODE .N FIX 10 ()>)>)>
26 <EANA <3 .K> FIX FLATSIZE>
27 <PUT .N ,NODE-TYPE ,ISUBR-CODE>
28 <TYPE-OK? '<OR FIX FALSE> .R>)>>
30 <DEFINE UNPARSE-ANA (N R "AUX" (K <KIDS .N>) (LN <LENGTH .K>))
31 #DECL ((N) NODE (K) <LIST [REST NODE]>)
32 <COND (<SEGFLUSH .N .R>)
34 <ARGCHK .LN '(1 2) UNPARSE>
35 <EANA <1 .K> ANY UNPARSE>
36 <COND (<1? .LN> <PUTREST .K (<NODE1 ,QUOTE-CODE .N FIX 10 ()>)>)>
37 <EANA <2 .K> FIX UNPARSE>
38 <PUT .N ,NODE-TYPE ,ISUBR-CODE>
39 <TYPE-OK? STRING .R>)>>
41 <DEFINE TERPRI-ANA (N R "AUX" (K <KIDS .N>) (LN <LENGTH .K>))
42 #DECL ((N) NODE (K) <LIST [REST NODE]> (LN) FIX)
43 <COND (<SEGFLUSH .N .R>)
45 <ARGCHK .LN '(0 1) TERPRI>
49 <SET K (<NODEFM ,SUBR-CODE .N ANY LVAL () ,LVAL>)>>
52 (<NODE1 ,QUOTE-CODE <1 .K> ATOM OUTCHAN ()>)>)>
53 <EANA <1 .K> CHANNEL TERPRI>
54 <PUT .N ,NODE-TYPE ,ISUBR-CODE>
55 <TYPE-OK? <COND (<==? <NODE-SUBR .N> ,CRLF> ATOM) (ELSE FALSE)> .R>)>>
57 <DEFINE READCHR-ANA (N R "AUX" (K <KIDS .N>) (LN <LENGTH .K>))
58 #DECL ((N) NODE (LN) FIX)
59 <COND (<SEGFLUSH .N .R>)
61 <ARGCHK .LN '(0 1) <NODE-NAME .N>>
65 <SET K (<NODEFM ,SUBR-CODE .N ANY LVAL () ,LVAL>)>>
68 (<NODE1 ,QUOTE-CODE <1 .K> ATOM INCHAN ()>)>)>
69 <EANA <1 .K> CHANNEL <NODE-NAME .N>>
70 <PUT .N ,NODE-TYPE ,ISUBR-CODE>
73 <PUT ,READCHR ANALYSIS ,READCHR-ANA>
75 <PUT ,NEXTCHR ANALYSIS ,READCHR-ANA>
77 <PUT ,PRINC ANALYSIS ,PRINT-ANA>
79 <PUT ,PRIN1 ANALYSIS ,PRINT-ANA>
81 <PUT ,PRINT ANALYSIS ,PRINT-ANA>
83 <PUT ,FLATSIZE ANALYSIS ,FLATSIZE-ANA>
85 <PUT ,UNPARSE ANALYSIS ,UNPARSE-ANA>
87 <PUT ,TERPRI ANALYSIS ,TERPRI-ANA>
89 <PUT ,CRLF ANALYSIS ,TERPRI-ANA>
91 <DEFINE PRINT-GEN (N W
92 "AUX" (K <KIDS .N>) (OB <1 .K>) (CH <2 .K>)
93 (RT <ISTYPE? <RESULT-TYPE .OB>>)
94 (PCOD <LENGTH <MEMQ <NODE-SUBR .N> ,PRINTERS>>) DAT
96 #DECL ((N OB CH) NODE (K) <LIST [REST NODE]> (PCOD) FIX (DAT CDAT) DATUM)
99 <COND (<SIDE-EFFECTS .CH> <DATUM ,AC-C ,AC-D>)
102 <+ <COND (<==? .RT ATOM> 3)
104 (<==? .RT CHARACTER> 9)
107 <COND (<OR <==? <DATTYP .DAT> ,AC-A>
108 <==? <DATVAL .DAT> ,AC-A>
109 <==? <DATTYP .DAT> ,AC-B>
110 <==? <DATVAL .DAT> ,AC-B>>
114 <DATUM <COND (<AND <TYPE? <DATTYP .DAT> ATOM>
115 <ISTYPE? <DATTYP .DAT>>>
119 <SET CDAT <GEN .CH <DATUM ,AC-A ,AC-B>>>
120 <SET DAT <MOVE:ARG .DAT
121 <DATUM <COND (<OR <==? .RT ATOM> <==? .PCOD 12>> .RT)
124 <RET-TMP-AC <MOVE:ARG .CDAT <DATUM ,AC-A ,AC-B>>>
127 <EMIT <INSTRUCTION `PUSHJ `P* <NTH ,IPRINTERS .PCOD>>>
128 <MOVE:ARG <FUNCTION:VALUE T> .W>>
130 <SETG PRINTERS ![,PRINC ,PRIN1 ,PRINT!]>