2 <PACKAGE "MIMC-GRDUMP">
4 <ENTRY MIMC-GROUP-DUMP DUMP-CODE>
6 <USE "COMFIL" "COMPDEC" "HASH">
22 <MSETG M$$TYPE-INFO-SIZE 1024>
34 <MSETG BACK-SLASH <ASCII 92>>
37 ; "PRINT's magic finite-state machine for atoms"
39 <SETG M$$FS-NSTATE 9> ; "# states, not counting terminals"
40 <SETG M$$FS-NOSLASH <+ ,M$$FS-NSTATE 1>> ; "No initial \ needed"
41 <SETG M$$FS-SLASH1 <+ ,M$$FS-NSTATE 2>> ; "Initial \ needed"
42 <SETG M$$FS-SLASH2 <+ ,M$$FS-NSTATE 3>> ; "Initial \ needed, done otherwise"
43 <SETG M$$END-STATE 6> ; "Slot in state for end of string"
44 <MANIFEST M$$FS-NSTATE M$$FS-NOSLASH M$$FS-SLASH1 M$$FS-SLASH2 M$$END-STATE>
46 <GDECL (BUFFER) STRING (I$FLOAT-TABLE!-INTERNAL) <VECTOR [REST FLOAT]>
47 (M$$TYPE-INFO!-INTERNAL) <VECTOR [REST <OR TYPE-ENTRY FALSE>]>>
50 <SETG M$$R-MIN-NUM-PART 17>
51 <SETG M$$R-MAX-ATM-BRK 13>
52 <MANIFEST M$$R-MAX-ATM-BRK M$$R-BACKS M$$R-MIN-NUM-PART>
54 <SETG BUFFER <ISTRING ,BUFLNT>>
56 <SETG ROOT-OBL <ROOT>>
58 <DEFINE MIMC-GROUP-DUMP (STR NAM TEMPCH
59 "AUX" OUTCHAN BKS POS TEM
60 (OBL <COND (<EMPTY? .OBLIST> FULL-OBL) (BLOCK)>)
61 (OOBLIST .OBLIST) (GROUP-INDICATOR DEFINE)
62 (IOTUP <TUPLE 0 0 ,BUFFER 0>)
63 IOB MACRO-NAME FUNC TEMP GOODS THIS-FORM)
64 #DECL ((STR) STRING (POS) <PRIMTYPE LIST> (OUTCHAN) <OR FALSE <CHANNEL 'DISK>>
65 (NAM OBL GROUP-INDICATOR) ATOM (GOODS) LIST (THIS-FORM) FORM)
68 <COND (<NOT <SET OUTCHAN <OPEN "PRINT" .STR>>>
70 <SET IOB <GETPROP .NAM .OBL '.OOBLIST>>
71 <PUT .IOTUP ,TUP-CHAN .OUTCHAN>
72 <PUT .IOTUP ,TUP-OBL .IOB>
75 <COND (<EMPTY? .GOODS> <RETURN>)>
78 (<AND <TYPE? <1 .GOODS> FORM>
79 <SET THIS-FORM <1 .GOODS>>
80 <G? <LENGTH .THIS-FORM> 1>
81 <OR <==? DEFINE <1 .THIS-FORM>>
82 <AND <==? DEFMAC <1 .THIS-FORM>>
83 <SET MACRO-NAME <2 .THIS-FORM>>>>
84 <TYPE? <SET FUNC <GETPROP <2 .THIS-FORM> VALUE '<2 .THIS-FORM>>>
86 <COND (<NOT <GASSIGNED? .FUNC>>)
88 <COND (<TYPE? <SET TEM ,.FUNC> FUNCTION>
89 <PUTREST <REST .THIS-FORM> .TEM>
90 <MIMC-PRINT .THIS-FORM .IOTUP>
92 (<AND <TYPE? .TEM MACRO>
94 <TYPE? <1 .TEM> FUNCTION>>
95 <PUTREST <REST .THIS-FORM> <1 .TEM>>
96 <MIMC-PRINT .THIS-FORM .IOTUP>
98 (<TYPE? .TEM INS-LIST ACCESS-LIST>
99 <COND (<TYPE? .TEM ACCESS-LIST>
100 <ACCESS <SET CH <1 .TEM>> <2 .TEM>>
101 <MIMC-PRINT <CHTYPE <4 .TEM> WORD> .IOTUP>
103 <CHANNEL-OP .OUTCHAN WRITE-BUFFER
104 <TUP-BUF .IOTUP> <TUP-BUFL .IOTUP>>
106 <REPEAT ((SIZ <- <3 .TEM> <2 .TEM>>)
107 (BUF <TUP-BUF .IOTUP>))
109 <COND (<G? .SIZ ,BUFLNT>
110 <CHANNEL-OP .CH READ-BUFFER .BUF>
114 <CHANNEL-OP .CH READ-BUFFER .BUF .SIZ>
116 WRITE-BUFFER .BUF .SIZ>
117 <COND (<G? <LENGTH .TEM> 4>
121 <ACCESS <SET CH <1 .TEM>>
125 <SET SIZ <- .SIZ ,BUFLNT>>>)
127 <MIMC-PRINT <CHTYPE <1 .TEM> WORD> .IOTUP>
129 <IDUMP-CODE <REST .TEM> .IOTUP>)>
131 <MIMC-OUTS "<COND (<AND <GASSIGNED? " .IOTUP>
132 <MIMC-PRIN-ATOM .FUNC .IOTUP>
133 <MIMC-OUTS "> <NOT <TYPE? ," .IOTUP>
134 <MIMC-PRIN-ATOM .FUNC .IOTUP>
135 <MIMC-OUTS " MACRO>>> <SETG " .IOTUP>
136 <MIMC-PRIN-ATOM .FUNC .IOTUP>
137 <MIMC-OUTS " <CHTYPE (," .IOTUP>
138 <MIMC-PRIN-ATOM .FUNC .IOTUP>
139 <MIMC-OUTS ") MACRO>>)>" .IOTUP>
140 <MIMC-CRLF .IOTUP>)>)
145 <FORM QUOTE ,.FUNC>>>
146 <MIMC-PRINT .THIS-FORM .IOTUP>
147 <MIMC-CRLF .IOTUP>)>)>)
149 <COND (<MONAD? <1 .GOODS>>
150 <MIMC-PRINT <1 .GOODS> .IOTUP>
153 <MIMC-PRINT <1 .GOODS> .IOTUP>
154 <MIMC-CRLF .IOTUP>)>)>
155 <PUT .IOTUP ,TUP-OBL <SET IOB <GETPROP .GOODS .OBL '.IOB>>>
156 <SET GOODS <REST .GOODS>>>
157 <COND (<N==? <TUP-BUFL .IOTUP> 0>
158 <CHANNEL-OP .OUTCHAN WRITE-BUFFER <TUP-BUF .IOTUP>
160 <CLOSE <TUP-CHAN .IOTUP>>
163 <AND <ASSIGNED? OUTCHAN>
164 <TYPE? .OUTCHAN CHANNEL>
167 <DEFINE MIMC-PRINT (OBJ IOTUP)
169 <MIMC-PRIN1 .OBJ .IOTUP>>
171 <DEFINE MIMC-PRIN1 (DATA IOTUP
172 "AUX" (TYP <CALL TYPE .DATA>)
173 FROB (TYOFF <LSH .TYP -6>)
174 (INFO <NTH ,M$$TYPE-INFO!-INTERNAL <+ .TYOFF 1>>)
175 (PTYPE <M$$PRINT .INFO>) (CHN <TUP-CHAN .IOTUP>) LST)
176 #DECL ((DATA) ANY (BREAK TYP TYSAT TYOFF) FIX (CHAN) CHANNEL
177 (INFO) TYPE-ENTRY (PTYPE) <OR ATOM APPLICABLE FALSE>
178 (LST) <PRIMTYPE LIST> (CHN) <CHANNEL 'DISK>
179 (IOTUP) <TUPLE <CHANNEL 'DISK> LIST STRING FIX>)
181 <NOT <TYPE? .PTYPE ATOM>>
182 <NOT <AND <TYPE? .DATA ATOM> <SET PTYPE ATOM>>>
183 <NOT <AND <TYPE? .DATA FCN-ATOM> <SET PTYPE ATOM>>>>
188 <CHANNEL-OP .CHN BUFOUT>
189 <PUT .IOTUP ,TUP-BUFL 0>
190 <PROG ((OUTCHAN .CHN))
191 #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
193 <CHANNEL-OP .CHN BUFOUT>>)
195 <COND (<AND <TYPE? .DATA FCN-ATOM>
196 <GASSIGNED? CTLZ-PRINT>
198 <MIMC-OUTC <ASCII 26> .IOTUP>)>
199 <MIMC-PRIN-ATOM <CHTYPE .DATA ATOM> .IOTUP>)
200 (<==? .PTYPE FIX> <I$PRIN-FIX .DATA .IOTUP>)
201 (<==? .PTYPE FLOAT> <I$PRIN-FLOAT .DATA .IOTUP>)
203 <MIMC-OUTC !\" .IOTUP>
206 <COND (<OR <==? .CHR !\"> <==? .CHR ,BACK-SLASH>>
207 <MIMC-OUTC ,BACK-SLASH .IOTUP>)>
208 <MIMC-OUTC .CHR .IOTUP>>
209 <CHTYPE .DATA STRING>>
210 <MIMC-OUTC !\" .IOTUP>)
212 <MIMC-OUTS "!{" .IOTUP>
214 <FUNCTION (BP "AUX" (BY <1 .BP>))
216 <I$PRIN-FIX .BY .IOTUP>
217 <COND (<NOT <EMPTY? <REST .BP>>>
218 <MIMC-OUTC <ASCII 32> .IOTUP>)>>
219 <CHTYPE .DATA BYTES>>
220 <MIMC-OUTS "!}" .IOTUP>)
221 (<==? .PTYPE CHARACTER>
222 <COND (<OR <G? <CHTYPE .DATA FIX> *177*>
223 <L? <CHTYPE .DATA FIX> 0>>
224 <MIMC-OUTS "#CHARACTER *" .IOTUP>
225 <MIMC-PRIN-OCT <CHTYPE .DATA FIX> .IOTUP>
226 <MIMC-OUTC !\* .IOTUP>)
228 <MIMC-OUTS "!\\" .IOTUP>
229 <MIMC-OUTC .DATA .IOTUP>)>)
231 <MIMC-PRIN1 <1 <CHTYPE .DATA VECTOR>> .IOTUP>
232 <MIMC-OUTC !\: .IOTUP>
233 <MIMC-PRIN1 <2 <CHTYPE .DATA VECTOR>> .IOTUP>)
234 (<AND <OR <==? .PTYPE FORM> <==? .PTYPE SEGMENT>>
235 <==? <LENGTH <CHTYPE .DATA LIST>> 2>
236 <OR <AND <==? <SET FROB <1 <CHTYPE .DATA LIST>>> LVAL>
238 <AND <==? .FROB GVAL> <SET FROB !\,>>
239 <AND <==? .FROB QUOTE> <SET FROB !\'>>>>
240 <COND (<==? .PTYPE SEGMENT> <MIMC-OUTC !\! .IOTUP>)>
241 <MIMC-OUTC .FROB .IOTUP>
242 <MIMC-PRIN1 <2 <CHTYPE .DATA LIST>> .IOTUP>)
243 (<OR <AND <==? .PTYPE FORM> <MIMC-OUTC !\< .IOTUP>>
244 <AND <==? .PTYPE LIST> <MIMC-OUTC !\( .IOTUP>>
245 <AND <==? .PTYPE SEGMENT> <MIMC-OUTS "!<" .IOTUP>>>
247 <FUNCTION (LP "AUX" (OBJ <1 .LP>))
249 <MIMC-PRIN1 .OBJ .IOTUP>
250 <COND (<NOT <EMPTY? <REST .LP>>>
251 <MIMC-OUTC <ASCII 32> .IOTUP>)>>
253 <COND (<N==? .PTYPE LIST> <MIMC-OUTC !\> .IOTUP>)
254 (ELSE <MIMC-OUTC !\) .IOTUP>)>)
256 <MIMC-OUTS "%<OFFSET " .IOTUP>
257 <I$PRIN-FIX <M$$OFF-FIX <CHTYPE .DATA VECTOR>> .IOTUP>
258 <COND (<TYPE? <SET FROB <M$$OFF-DCL <CHTYPE .DATA VECTOR>>>
260 <MIMC-OUTC <ASCII 32> .IOTUP>
261 <MIMC-PRIN-ATOM .FROB .IOTUP>)
262 (ELSE <MIMC-OUTS " '" .IOTUP> <MIMC-PRIN1 .FROB .IOTUP>)>
263 <COND (<TYPE? <SET FROB <M$$OFF-ELT <CHTYPE .DATA VECTOR>>>
265 <MIMC-OUTC <ASCII 32> .IOTUP>
266 <MIMC-PRIN-ATOM .FROB .IOTUP>)
267 (.FROB <MIMC-OUTS " '" .IOTUP> <MIMC-PRIN1 .FROB .IOTUP>)>
268 <MIMC-OUTC !\> .IOTUP>)
269 (<==? .PTYPE TYPE-C> <I$PRIN-TYPE-W-C .DATA <> .IOTUP>)
270 (<==? .PTYPE TYPE-W> <I$PRIN-TYPE-W-C .DATA T .IOTUP>)
271 (<==? .PTYPE UVECTOR>
272 <MIMC-OUTS "![" .IOTUP>
274 <FUNCTION (NP "AUX" (N <1 .NP>))
276 <I$PRIN-FIX .N .IOTUP>
277 <COND (<NOT <EMPTY? <REST .NP>>>
278 <MIMC-OUTC <ASCII 32> .IOTUP>)>>
279 <CHTYPE .DATA UVECTOR>>
280 <MIMC-OUTS "!]" .IOTUP>)
282 <MIMC-OUTC !\[ .IOTUP>
284 <FUNCTION (NP "AUX" (N <1 .NP>))
286 <MIMC-PRIN1 .N .IOTUP>
287 <COND (<NOT <EMPTY? <REST .NP>>>
288 <MIMC-OUTC <ASCII 32> .IOTUP>)>>
289 <CHTYPE .DATA VECTOR>>
290 <MIMC-OUTC !\] .IOTUP>)
292 <MIMC-OUTS "%<>" .IOTUP>)
294 <MIMC-OUTC !\, .IOTUP>
295 <MIMC-PRIN-ATOM <CHTYPE .DATA ATOM> .IOTUP>)
297 <MIMC-OUTC !\. .IOTUP>
298 <MIMC-PRIN-ATOM <CHTYPE .DATA ATOM> .IOTUP>)
300 <MIMC-OUTS "#WORD *" .IOTUP>
301 <MIMC-PRIN-OCT <CHTYPE .DATA FIX> .IOTUP>
302 <MIMC-OUTC !\* .IOTUP>)
303 (<==? <M$$NTYPE .INFO> <M$$PTYPE .INFO>>
308 <CHANNEL-OP .CHN BUFOUT>
309 <PUT .IOTUP ,TUP-BUFL 0>
310 <PROG ((OUTCHAN .CHN))
311 #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
314 <MIMC-OUTC !\# .IOTUP>
315 <MIMC-PRIN-ATOM <M$$NTYPE .INFO> .IOTUP>
316 <MIMC-OUTC <ASCII 32> .IOTUP>
317 <MIMC-PRIN1 <CHTYPE .DATA <M$$PTYPE .INFO>> .IOTUP>)>>
319 <DEFINE I$PRIN-TYPE-W-C (DATA W-C IOTUP "AUX" ENTRY TYOFF)
320 #DECL ((DATA) ANY (BREAK TYOFF) FIX (CHAN) CHANNEL (RTRN) FRAME
321 (ENTRY) <OR TYPE-ENTRY FALSE>
322 (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
323 <COND (.W-C <SET TYOFF <LSH <CALL TYPEWC .DATA> <- %,M$$TYOFF>>>)
324 (ELSE <SET TYOFF <LSH .DATA %<- ,M$$TYOFF>>>)>
325 <COND (<AND <G=? .TYOFF 0>
326 <L=? .TYOFF ,M$$TYPE-INFO-SIZE>
327 <SET ENTRY <NTH ,M$$TYPE-INFO!-INTERNAL <+ .TYOFF 1>>>>
328 <COND (.W-C <MIMC-OUTS "%<TYPE-W " .IOTUP>)
329 (ELSE <MIMC-OUTS "%<TYPE-C " .IOTUP>)>
330 <MIMC-PRIN-ATOM <M$$NTYPE .ENTRY> .IOTUP>
331 <MIMC-OUTC <ASCII 32> .IOTUP>
332 <MIMC-PRIN-ATOM <M$$PTYPE .ENTRY> .IOTUP>
333 <MIMC-OUTC !\> .IOTUP>)
334 (<ERROR BAD-TYPE-CODE!-ERRORS .TYOFF PRINT>)>>
336 <DEFINE MIMC-PRIN-OCT (NUM IOTUP)
337 #DECL ((NUM) FIX (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
338 <COND (<0? .NUM> <MIMC-OUTC !\0 .IOTUP>)
340 <MIMC-POCT .NUM .IOTUP>)>>
342 <DEFINE MIMC-POCT (X IOTUP)
343 #DECL ((X) FIX (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
345 <MIMC-POCT <LSH .X -3> .IOTUP>
346 <MIMC-OUTC <ASCII <+ <ANDB .X 7> <ASCII !\0>>> .IOTUP>)>>
348 <DEFINE I$PRIN-FIX (NUM IOTUP)
349 #DECL ((NUM) FIX (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
350 <COND (<==? .NUM <CHTYPE <MIN> FIX>>
351 <MIMC-OUTS "%<CHTYPE <MIN> FIX>" .IOTUP>)
352 (<==? .NUM <CHTYPE <MAX> FIX>>
353 <MIMC-OUTS "%<CHTYPE <MAX> FIX>" .IOTUP>)
355 <MIMC-OUTS "-0" .IOTUP>)
357 <MIMC-OUTC !\- .IOTUP>
358 <I$PRIN-INT <- 0 .NUM> .IOTUP>)
359 (<0? .NUM> <MIMC-OUTC !\0 .IOTUP>)
360 (ELSE <I$PRIN-INT .NUM .IOTUP>)>>
362 <DEFINE I$PRIN-INT (NUM IOTUP)
363 #DECL ((NUM) FIX (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
364 <COND (<NOT <0? .NUM>>
365 <I$PRIN-INT </ .NUM 10> .IOTUP>
366 <MIMC-OUTC <ASCII <+ %<ASCII !\0> <MOD .NUM 10>>> .IOTUP>)>>
368 <DEFINE I$PRIN-FLOAT (NUM IOTUP
369 "AUX" (MANT .NUM) (EXP 0) DIG (SIGD 7) (OFFSET 1))
370 #DECL ((NUM MANT) FLOAT (EXP DIG SIGD) FIX
371 (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
372 <COND (<==? .NUM ,MINFL> <MIMC-OUTS "%,MINFL" .IOTUP>)
373 (<==? .NUM ,MAXFL> <MIMC-OUTS "%,MAXFL" .IOTUP>)
376 <MIMC-OUTC !\- .IOTUP>
377 <SET MANT <SET NUM <- 0.0 .NUM>>>)>
378 <COND (<G=? .NUM 10.0>
380 <SET MANT </ .MANT 10.0>>
382 <COND (<L? .MANT 10.0> <RETURN>)>>)
383 (<0? .NUM> <SET EXP -1>)
386 <SET MANT <* .MANT 10.0>>
388 <COND (<G=? .MANT 1.0> <RETURN>)>>)>
389 <COND (<OR <G? .EXP 7> <L? .EXP -2>>
390 <I$PRIN-INT <SET DIG <FIX .MANT>> .IOTUP>
391 <I$PRIN-DEC <- .MANT .DIG> .SIGD .IOTUP .OFFSET>
392 <MIMC-OUTC !\E .IOTUP>
393 <COND (<G? .EXP .SIGD>
394 <MIMC-OUTC !\+ .IOTUP>
395 <I$PRIN-INT .EXP .IOTUP>)
398 <MIMC-OUTC !\- .IOTUP>
399 <I$PRIN-INT <- 0 .EXP> .IOTUP>)>)
401 <COND (<L=? .EXP 7> <SET OFFSET <- 8 .EXP>>)>
402 ; "This may cause rounding to the next integer, so must do
403 addition BEFORE calling FIX"
404 <COND (<G? <FIX <+ <NTH ,I$FLOAT-TABLE!-INTERNAL .OFFSET>
407 <SET NUM <+ <NTH ,I$FLOAT-TABLE!-INTERNAL .OFFSET>
410 <I$PRIN-INT <SET DIG <FIX .NUM>> .IOTUP>
411 <I$PRIN-DEC <- .NUM .DIG> <- .SIGD .EXP> .IOTUP .OFFSET>)
413 <COND (<NOT <0? .NUM>>
414 <SET NUM <+ .NUM <8 ,I$FLOAT-TABLE!-INTERNAL>>>)>
416 <COND (<G=? .NUM 1.0>
417 <MIMC-OUTC !\1 .IOTUP>
418 <SET NUM <- .NUM 1.0>>)
420 <MIMC-OUTC !\0 .IOTUP>)>
421 <I$PRIN-DEC .NUM .SIGD .IOTUP .OFFSET>)>)>>
423 <DEFINE I$PRIN-DEC (NUM MIN IOTUP OFFSET "AUX" (Z-COUNT 0))
424 #DECL ((NUM) FLOAT (MIN OFF Z-COUNT) FIX (BUF) STRING
425 (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
426 <MIMC-OUTC !\. .IOTUP>
428 <MIMC-OUTC !\0 .IOTUP>)
429 (ELSE <SET NUM <+ .NUM <NTH ,I$FLOAT-TABLE!-INTERNAL .OFFSET>>>
430 <REPEAT (DIG) #DECL ((DIG) FIX)
431 <SET DIG <FIX <SET NUM <* .NUM 10.0>>>>
433 <SET Z-COUNT <+ .Z-COUNT 1>>)
434 (ELSE <SET Z-COUNT 0>)>
435 <MIMC-OUTC <ASCII <+ %<ASCII !\0> .DIG>> .IOTUP>
436 <COND (<OR <0? <SET NUM <- .NUM .DIG>>>
437 <L=? <SET MIN <- .MIN 1>> 0>>
441 <DEFINE MIMC-CRLF (IOTUP)
442 <MAPF <> <FUNCTION (CH) <MIMC-OUTC .CH .IOTUP>> ,CRLF-STRING!-INTERNAL>>
444 <DEFINE MIMC-PRIN-ATOM (ATM IOTUP "AUX" (SP <SPNAME .ATM>) (O? <OBLIST? .ATM>)
445 (OB <TUP-OBL .IOTUP>))
446 #DECL ((CHAN) CHANNEL (ATM) ATOM (OB) <LIST [REST OBLIST]>
447 (O?) <OR FALSE OBLIST>
448 (IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
450 <MIMC-PRIN-ATM .SP .IOTUP>
455 <NOT <MEMQ .O? .OB>>>
456 <MIMC-OUTS "!-" .IOTUP>
457 <SET SP <SPNAME <SET ATM <CHTYPE .O? ATOM>>>>
458 <SET O? <OBLIST? .ATM>>
461 <ERROR CANT-PRINT-ATOM!-ERRORS .ATM>)>>>
463 <DEFINE MIMC-PRIN-ATM (STR IOTUP "AUX" (FSM ,I$ATM-FSM!-INTERNAL)
464 (CSTATE <1 .FSM>) CTRANS (TR-TABLE ,I$TRANS-TABLE!-INTERNAL)
466 #DECL ((STR) STRING (TN) FIX (FSM) <VECTOR [REST BYTES]>
467 (CSTATE) BYTES (CTRANS) FIX (TR-TABLE) BYTES)
468 ; "Run FSM to decide if initial backslash needed. If any character
469 that can't be part of number is encountered, exit immediately,
470 don't put backslash in. Other transitions out of states are
471 E, ., 0-9, +/-, *, and end of string. This is basically ripped
472 off from old muddle."
476 #DECL ((CHR) CHARACTER)
477 <COND (<L? <SET CTRANS <NTH .TR-TABLE <+ <ASCII .CHR> 1>>>
479 ; "Not part of number, so done."
481 (<SET TN <+ <- .CTRANS ,M$$R-MIN-NUM-PART> 1>>)>
482 <COND (<L=? <SET TN <NTH .CSTATE .TN>> ,M$$FS-NSTATE>
483 ; "Legal state number, go to it"
484 <SET CSTATE <NTH .FSM .TN>>
486 (<N==? .TN ,M$$FS-NOSLASH>
487 ; "Leading ., so always need backslash"
490 ; "Thing can't be number, so leave"
493 <COND (<OR <G? .TN ,M$$FS-NSTATE>
494 <N==? <M$$END-STATE .CSTATE> ,M$$FS-NOSLASH>>
495 ; "Put in \ if hit terminal state before end of string
496 or if current-state's end-state calls for it."
497 <MIMC-OUTC <ASCII 92> .IOTUP>)>)>
499 <FUNCTION (CHAR) #DECL ((CHAR) CHARACTER)
500 <SET CTRANS <NTH .TR-TABLE <+ <ASCII .CHAR> 1>>>
501 <COND (<OR <L=? .CTRANS ,M$$R-MAX-ATM-BRK>
502 <==? .CTRANS ,M$$R-BACKS>>
503 <MIMC-OUTC <ASCII 92> .IOTUP>)>
504 <MIMC-OUTC .CHAR .IOTUP>>
507 <DEFINE MIMC-OUTC (CHR IOTUP "AUX" LNT)
508 #DECL ((IOTUP) <TUPLE CHANNEL LIST STRING FIX>)
509 <COND (<G? <SET LNT <+ <TUP-BUFL .IOTUP> 1>> ,BUFLNT>
510 <CHANNEL-OP <TUP-CHAN .IOTUP>:<CHANNEL 'DISK>
511 WRITE-BUFFER <TUP-BUF .IOTUP>>
513 <PUT .IOTUP ,TUP-BUFL .LNT>
514 <PUT <TUP-BUF .IOTUP> .LNT .CHR>>
516 <DEFINE MIMC-OUTS (STR IOTUP
517 "AUX" (LNT <TUP-BUFL .IOTUP>) (BUF <TUP-BUF .IOTUP>))
518 #DECL ((IOTUP) <TUPLE CHANNEL LIST STRING FIX> (LNT) FIX
521 <COND (<EMPTY? .STR> <PUT .IOTUP ,TUP-BUFL .LNT> <RETURN>)>
522 <COND (<G? <SET LNT <+ .LNT 1>> ,BUFLNT>
523 <CHANNEL-OP <TUP-CHAN .IOTUP>:<CHANNEL 'DISK>
526 <PUT .BUF .LNT <1 .STR>>
527 <SET STR <REST .STR>>>>
530 <DEFINE IDUMP-CODE (L IOTUP) #DECL ((L) LIST (IOTUP) TUPLE)
533 #DECL ((X) <OR ATOM FORM>)
536 <MIMC-PRIN-ATOM .X .IOTUP>
539 <MIMC-OUTS " " .IOTUP>
540 <MIMC-OUTC !\< .IOTUP>
542 <FUNCTION (YP "AUX" (Y <1 .YP>) O)
543 #DECL ((YP) <LIST ANY>)
544 <COND (<TYPE? .Y ATOM>
545 <MIMC-PRIN-ATOM .Y .IOTUP>)
547 <MIMC-PRIN1 .Y .IOTUP>)>
548 <COND (<NOT <EMPTY? <REST .YP>>>
549 <MIMC-OUTC <ASCII 32>
552 <MIMC-OUTC !\> .IOTUP>
553 <MIMC-CRLF .IOTUP>)>>
556 <DEFINE DUMP-CODE (L CH OBL "AUX" (IOTUP <TUPLE .CH .OBL ,BUFFER 0>))
557 <IDUMP-CODE .L .IOTUP>
558 <CHANNEL-OP <TUP-CHAN .IOTUP>:<CHANNEL 'DISK>
559 WRITE-BUFFER <TUP-BUF .IOTUP> <TUP-BUFL .IOTUP>>