1 TITLE PRINTER ROUTINE FOR MUDDLE
4 .GLOBAL IPNAME,TYO,FIXB,FLOATB
5 .GLOBAL BYTPNT,OPNCHN,CHRWRD,IDVAL,CHARGS,CHFRM,NONSPC
7 FLAGS==0 ;REGISTER USED TO STORE FLAGS
8 CARRET==15 ;CARRIAGE RETURN CHARACTER
9 ESCHAR=="\ ;ESCAPE CHARACTER
10 SPACE==40 ;SPACE CHARACTER
11 ATMBIT=200000 ;BIT SWITCH FOR ATOM-NAME PRINT
12 NOQBIT=020000 ;SWITCH FOR NO ESCAPING OF OUTPUT (PRINC)
13 SEGBIT=010000 ;SWITCH TO INDICATE PRINTING A SEGMENT
14 SPCBIT=004000 ;SWITCH TO INDICATE "PRINT" CALL (PUT A SPACE AFTER)
15 FLTBIT=002000 ;SWITCH TO INDICATE "FLATSIZE" CALL
16 HSHBIT=001000 ;SWITCH TO INDICATE "PHASH" CALL
17 TERBIT=000400 ;SWITCH TO INDICATE "TERPRI" CALL
23 .VALUE [ASCIZ
\1c\17.=P.STUF!
\eQîP.STUF/
\eQ!:VP
\1c]
32 \fMFUNCTION FLATSIZE,SUBR
37 ;FLATSIZE TAKES TWO ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
38 ;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS FALSE
43 ;IF THE SECOND ARGUMENT IS NOT FIXED POINT LOSE
45 PUSH TP,MQUOTE WRONG-TYPE
49 PUSH TP,[0] ;THE VALUE IS ACCUMULATED IN FLTSIZ
52 MOVE A,(AB) ;IPRINT TAKES ITS ARGUMENT A AND B
64 ;PHASH TAKES TWO ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
65 ;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS THE HASH NUMBER
70 ;IF THE SECOND ARGUMENT IS NOT FIXED POINT LOSE
72 PUSH TP,MQUOTE WRONG-TYPE
76 PUSH TP,[0] ;THE VALUE IS ACCUMULATED IN HASHNUM
79 MOVE A,(AB) ;IPRINT TAKES ITS ARGUMENT A AND B
86 \fMFUNCTION PRINT,SUBR
88 PUSH P,FLAGS ;SAVE THE FLAGS REGISTER
89 MOVSI FLAGS,SPCBIT ;INDICATE PRINTING OF SPACE WHEN DONE
90 JRST PRIN01 ;CALL IPRINT AFTER SAVING STUFF
94 PUSH P,FLAGS ;SAVE THE FLAGS REGISTER
95 MOVSI FLAGS,NOQBIT ;INDICATE PRINC (NO QUOTES OR ESCAPES)
96 JRST PRIN01 ;CALL IPRINT AFTER SAVING STUFF
100 PUSH P,FLAGS ;SAVE FLAGS REGISTER
101 MOVEI FLAGS,0 ;ZERO (TURN OFF) ALL FLAGS
102 JRST PRIN01 ;CALL IPRINT AFTER SAVING STUFF
105 MFUNCTION TERPRI,SUBR
107 MOVSI FLAGS,TERBIT+SPCBIT
108 JUMPGE AB,DEFCHN ;IF NO ARG GO GET CURRENT OUT-CHANNEL BINDING
111 PUSH TP,$TFIX ;SAVE ROOM ON STACK FOR ONE CHANNEL
117 \fPRIN01: PUSH P,C ;SAVE REGISTERS C,D, AND E
120 PUSH TP,$TFIX ;LEAVE ROOM ON STACK FOR ONE CHANNEL
123 HLRZ C,AB ;GET THE AOBJN COUNT FROM AB
124 CAIN C,-2 ;SKIP IF NOT JUST ONE ARGUMENT GIVEN
125 JRST DEFCHN ;ELSE USE EXISTING BINDING OF "OUTCHAN"
126 CAIE C,-4 ;ELSE, THERE MUST BE ONLY TWO ARGUMENTS
127 JRST ARGERR ;MORE ARGUMENTS IS AN ERROR
132 SKIPN C,(AB)3 ;EMPTY LIST ?
133 JRST FINIS ;IF SO, NO NEED TO CONTINUE
134 LISTCK: HRRZ C,(C) ;REST OF LIST
135 JUMPE C,BINDPT ;FINISHED ?
136 PUSH TP,$TFIX ;LEAVE ROOM ON STACK FOR THIS ADDITIONAL CHANNEL
140 BINDPT: PUSH TP,[TATOM,,-1]
141 PUSH TP,MQUOTE OUTCHAN
142 PUSH TP,A ;PUSH NEW OUT-CHANNEL
146 PUSH P,FLAGS ;THESE WILL GET CLOBBERED BY SPECBIND
150 DEFCHN: MOVE B,MQUOTE OUTCHAN
152 PUSHJ P,IDVAL ;GET VALUE OF CHANNEL
153 SETZ E, ;CLEAR E FOR SINGLE CHANNEL ARGUMENTS
154 CAMN A,$TCHAN ;SKIP IF IT ISN'T A VALID SINGLE CHANNEL
156 CAME A,$TLIST ;SKIP IF IT IS A LIST OF CHANNELS
157 JRST CHNERR ;CAN'T HANDLE ANYTHING ELSE (FOR NOW)
158 SKIPA E,B ;SAVE LIST POINTER IN E
159 LOOPCH: ADDI FLAGS,2 ;INCREMENT NUMBER OF CHANNELS COLLECTED
160 HLLZ A,(E) ;GET TYPE (SHOULD BE CHANNEL)
163 MOVE B,(E)+1 ;GET VALUE
164 HRRZ E,(E) ;UPDATE LIST POINTER
166 SAVECH: HRRZ C,FLAGS ;GET CURRENT CHANNEL COUNT
167 ADDI C,(TB) ;APPROPRIATE STACK LOCATION
168 CAIN C,(TP)+1 ;NEED MORE ROOM ON STACK FOR LIST ELEMENT CHANNELS ?
169 ADD TP,[2,,2] ;IF SO, GET MORE STACK ROOM
170 MOVEM A,(C) ;SAVE CHANNEL POINTER ON STACK
172 SKIPN IOINS(B) ;SKIP IF I/O INSTRUCTION IS NON-ZERO
173 PUSHJ P,OPNCHN ;ELSE TRY TO OPEN THE CHANNEL
174 JUMPE B,CHNERR ;ERROR IF IT CANNOT BE OPENED
175 MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION
178 CAME B,[ASCII /PRINT/] ;IS IT PRINT
179 JRST CHNERR ;ELSE IT IS AN ERROR
180 JUMPN E,LOOPCH ;IF MORE CHANNELS ON LIST, GO CONSIDER THEM
181 ADDI FLAGS,2 ;MAKE FINAL UPDATE OF COUNT
182 \f MOVEI A,CARRET ;GET A CARRIAGE RETURN
183 TLNE FLAGS,SPCBIT ;TYPE IT ONLY IF BIT IS ONE (PRINT)
185 TLNE FLAGS,TERBIT ;IF A CALL TO "TERPRI" YOU ARE THROUGH
188 MOVE A,(AB) ;FIRST WORD OF ARGUMENT GOES INTO REG A
189 MOVE B,1(AB) ;SECOND WORD INTO REG B
190 PUSHJ P,IPRINT ;CALL INTERNAL ROUTINE TO PRINT IT
193 TLNE FLAGS,SPCBIT ;SKIP (PRINT A TRAILING SPACE) IF SPCBIT IS ON
196 MOVE A,(AB) ;GET FIRST ARGUMENT TO RETURN AS PRINT'S VALUE
199 POP P,E ;RESTORE REGISTERS C,D, AND E
202 POP P,FLAGS ;RESTORE THE FLAGS REGISTER
210 RFALSE: MOVSI A,TFALSE
213 \fIPRINT: PUSH P,C ;SAVE REGISTER C ON THE P-STACK
214 PUSH P,FLAGS ;SAVE PREVIOUS FLAGS
215 PUSH TP,A ;SAVE ARGUMENT ON TP-STACK
218 INTGO ;ALLOW INTERRUPTS HERE
220 HLRZ A,-1(TP) ;GET THE TYPE CODE OF THE ITEM
222 CAILE A,NUMPRI ;SKIP IF TYPE NOT OUTSIDE OF VALID RANGE
223 JRST PUNK ;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
224 JRST @PTBL(A) ;USE IT AS INDEX TO TRANSFER TABLE TO PRINT ITEM
226 DISTBL PTBL,PUNK,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
227 [TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
228 [TARGS,PARGS],[TFRAME,PFRAME],[TUVEC,PUVEC],[TDEFER,PDEFER]
231 PUNK: MOVE C,TYPVEC+1(TVP) ;GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
232 HLRZ B,-1(TP) ;GET THE TYPE CODE INTO REG B
233 LSH B,1 ;MULTIPLY BY TWO
234 HRL B,B ;DUPLICATE IT IN THE LEFT HALF
235 ADD C,B ;INCREMENT THE AOBJN-POINTER
236 JUMPGE C,PRERR ;IF POSITIVE, INDEX > VECTOR SIZE
238 PUSHJ P,RETIF1 ;START NEW LINE IF NO ROOM
239 MOVEI A,"# ;INDICATE TYPE-NAME FOLLOWS
241 MOVE A,(C) ;GET TYPE-ATOM
243 PUSHJ P,IPRINT ;PRINT ATOM-NAME
244 MOVE B,(TP) ;RESET THE REAL ARGUMENT POINTER
245 MOVEI A,SPACE ;PRINT A SEPARATING SPACE
248 HRRZ A,(C) ;GET THE STORAGE-TYPE
249 JRST @UKTBL(A) ;USE DISPATCH TABLE ON STORAGE TYPE
251 DISTBS UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC]
252 [SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP]]
256 \f;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
258 ;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
259 PITYO: TLNN FLAGS,FLTBIT
261 AOS FLTSIZE+1 ;FLATSIZE DOESN'T PRINT
262 ;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
263 SOSL FLTMAX+1 ;UNLESS THE MAXIMUM IS EXCEEDED
265 MOVSI A,TFALSE ;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
269 PITYO1: TLNN FLAGS,HSHBIT
282 ;NOTE THAT THE FOLLOWING CODE HAS BUGS IF IT IS PRINTING OUT LONG
284 ; (NOTE THAT THE ABOVE COMMENT, IF TRUE, SHOULD NOT BE ADMITTED.)
285 ITYO: PUSH P,FLAGS ;SAVE STUFF
288 ITYOCH: PUSH P,A ;SAVE OUTPUT CHARACTER
290 HRRZ B,FLAGS ;GET CURRENT CHANNEL COUNT
292 MOVE B,(B) ;GET THE CHANNEL POINTER
294 CAIE A,^L ;SKIP IF THIS IS A FORM-FEED
296 SETZM LINPOS(B) ;ZERO THE LINE NUMBER
297 SETZM CHRPOS(B) ; AND CHARACTER NUMBER.
298 XCT IOINS(B) ;FIRST DO A CARRIAGE RETURN-LINE FEED
302 NOTFF: CAIE A,^M ;SKIP IF IT IS A CARRIAGE RETURN
304 SETZM CHRPOS(B) ;ZERO THE CHARACTER POSITION
305 XCT IOINS(B) ;OUTPUT THE C-R
306 MOVEI A,^J ;FOLLOW WITTH A LINE-FEED
307 AOS C,LINPOS(B) ;ADD ONE TO THE LINE NUMBER
308 CAMG C,PAGLN(B) ;SKIP IF THIS TAKES US PAST PAGE END
311 SETZM LINPOS(B) ;ZERO THE LINE POSITION
312 XCT IOINS(B) ;OUTPUT THE LINE FEED
313 MOVEI A,^L ;GET A FORM FEED
316 NOTCR: CAIN A,^I ;SKIP IF NOT TAB
318 CAIN A,^J ;SKIP IF NOT LINE FEED
319 JRST ITYXT ;ELSE, DON'T COUNT (JUST OUTPUT IT)
320 AOS CHRPOS(B) ;ADD TO CHARACTER NUMBER
322 ITYXT: XCT IOINS(B) ;OUTPUT THE CHARACTER
323 POP P,A ;RESTORE THE ORIGINAL CHARACTER
324 SUBI FLAGS,2 ;DECREMENT CHANNEL COUNT
325 TRNE FLAGS,-1 ;ANY MORE CHANNELS ?
326 JRST ITYOCH ;IF SO GO OUTPUT TO THEM
328 POP P,C ;RESTORE REGS & RETURN
335 ADDI C,8. ;INCREMENT COUNT BY EIGHT (MOD EIGHT)
338 MOVEM C,CHRPOS(B) ;REPLACE COUNT
344 RETIF: TLNE FLAGS,FLTBIT
345 POPJ P, ;IF WE ARE IN FLATSIZE THEN ESCAPE
346 TLNE FLAGS,HSHBIT ;ALSO ESCAPE IF IN HASH
352 HRRZ B,FLAGS ;GET THE CURRENT CHANNEL COUNT
353 ADDI B,(TB)-1 ;CORRECT PLACE ON STACK
354 MOVE B,(B) ;GET THE CHANNEL POINTER
355 ADD A,CHRPOS(B) ;ADD THE CHARACTER POSITION
356 CAMG A,LINLN(B) ;SKIP IF GREATER THAN LINE LENGTH
359 MOVEI A,^M ;FORCE A CARRIAGE RETURN
362 MOVEI A,^J ;AND FORCE A LINE FEED
365 CAMG A,PAGLN(B) ;AT THE END OF THE PAGE ?
367 MOVEI A,^L ;IF SO FORCE A FORM FEED
372 SUBI FLAGS,2 ;DECREMENT CHANNEL COUNT
373 TRNE FLAGS,-1 ;ANY MORE CHANNELS ?
374 JRST RETCH ;IF SO GO CONSIDER THEM
380 PRETIF: PUSH P,A ;SAVE CHAR
385 \f;THIS IS CODE TO HANDLE UNKNOWN DATA TYPES.
386 ;IT PRINTS "*XXXXXX*XXXXXXXXXXXX*", WHERE THE FIRST NUMBER IS THE
387 ;TYPE CODE IN OCTAL, THE SECOND IS THE VALUE FIELD IN OCTAL.
388 PRERR: MOVEI A,21. ;CHECK FOR 21. SPACES LEFT ON PRINT LINE
389 PUSHJ P,RETIF ;INSERT CARRIAGE RETURN IF NOT ENOUGH
390 MOVEI A,"* ;JUNK TO INDICATE ERROR PRINTOUT IN OCTAL
391 PUSHJ P,PITYO ;TYPE IT
393 MOVE E,[000300,,-2(TP)] ;GET POINTER INDEXED OFF TP SO THAT
394 ;TYPE CODE MAY BE OBTAINED FOR PRINTING.
395 MOVEI D,6 ;# OF OCTAL DIGITS IN HALF WORD
396 OCTLP1: ILDB A,E ;GET NEXT 3-BIT BYTE OF TYPE CODE
397 IORI A,60 ;OR-IN 60 FOR ASCII DIGIT
398 PUSHJ P,PITYO ;PRINT IT
399 SOJG D,OCTLP1 ;REPEAT FOR SIX CHARACTERS
401 PRE01: MOVEI A,"* ;DELIMIT TYPE CODE FROM VALUE FIELD
404 HRLZI E,(410300,,(TP)) ;BYTE POINTER TO SECOND WORD
406 MOVEI D,12. ;# OF OCTAL DIGITS IN A WORD
407 OCTLP2: LDB A,E ;GET 3 BITS
408 IORI A,60 ;CONVERT TO ASCII
409 PUSHJ P,PITYO ;PRINT IT
410 IBP E ;INCREMENT POINTER TO NEXT BYTE
411 SOJG D,OCTLP2 ;REPEAT FOR 12. CHARS
413 MOVEI A,"* ;DELIMIT END OF ERROR TYPEOUT
414 PUSHJ P,PITYO ;REPRINT IT
416 JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
418 POCTAL: MOVEI A,14. ;RETURN TO NEW LINE IF 14. SPACES NOT LEFT
420 JRST PRE01 ;PRINT VALUE AS "*XXXXXXXXXXXX*"
422 \f;PRINT BINARY INTEGERS IN DECIMAL.
424 PFIX: MOVEI E,FIXB ;GET ADDRESS OF FIXED POINT CONVERSION ROUTINE
425 MOVE D,[4,,4] ;PUT # WORDS RESERVED ON STACK INTO REG F
426 JRST PNUMB ;PRINT THE NUMBER
428 ;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
430 PFLOAT: MOVEI E,FLOATB ;ADDRESS OF FLOATING POINT CONVERSION ROUTINE
431 MOVE D,[6,,6] ;# WORDS TO GET FROM STACK
433 PNUMB: HRLI A,1(P) ;LH(A) TO CONTAIN ADDRESS OF RETURN AREA ON STACK
434 HRR A,TP ;RH(A) TO CONTAIN ADDRESS OF DATA ITEM
435 HLRZ B,A ;SAVE RETURN AREA ADDRESS IN REG B
436 ADD P,D ;ADD # WORDS OF RETURN AREA TO BOTH HALVES OF SP
437 JUMPGE P,PDLERR ;PLUS OR ZERO STACK POINTER IS OVERFLOW
438 PUSHJ P,(E) ;CALL ROUTINE WHOSE ADDRESS IS IN REG E
440 MOVE C,(B) ;GET COUNT 0F # CHARS RETURNED
441 MOVE A,C ;MAKE SURE THAT # WILL FIT ON PRINT LINE
442 PUSHJ P,RETIF ;START NEW LINE IF IT WON'T
444 HRLI B,000700 ;MAKE REG B INTO BYTE POINTER TO FIRST CHAR LESS ONE
445 PNUM01: ILDB A,B ;GET NEXT BYTE
446 PUSHJ P,PITYO ;PRINT IT
447 SOJG C,PNUM01 ;DECREMENT CHAR COUNT: LOOP IF NON-ZERO
449 SUB P,D ;SUBTRACT # WORDS USED ON STACK FOR RETURN
450 JRST PNEXT ;STORE REGS & POP UP ONE LEVEL TO CALLER
452 \f;PRINT SHORT (ONE WORD) CHARACTER STRINGS.
454 PCHRS: MOVEI A,3 ;MAX # CHARS PLUS 2 (LESS ESCAPES)
455 TLNE FLAGS,NOQBIT ;SKIP IF QUOTES WILL BE USED
456 MOVEI A,1 ;ELSE, JUST ONE CHARACTER POSSIBLE
457 PUSHJ P,RETIF ;NEW LINE IF INSUFFICIENT SPACE
458 TLNE FLAGS,NOQBIT ;DON'T QUOTE IF IN PRINC MODE
460 MOVEI A,"! ;TYPE A EXCL
462 MOVEI A,"" ;AND A DOUBLE QUOTE
465 PCASIS: LDB A,[350700,,(TP)] ;GET NEXT BYTE FROM WORD
466 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
467 JRST PCPRNT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
468 CAIE A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
469 JRST PCPRNT ;ESCAPE THE ESCAPE CHARACTER
471 ESCPRT: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
474 PCPRNT: LDB A,[350700,,(TP)] ;GET THE CHARACTER AGAIN
475 PUSHJ P,PITYO ;PRINT IT
479 \f;PRINT DEFERED (INVISIBLE) ITEMS. (PRINTED AS THE THING POINTED TO)
481 PDEFER: MOVE A,(B) ;GET FIRST WORD OF ITEM
482 MOVE B,1(B) ;GET SECOND
483 PUSHJ P,IPRINT ;PRINT IT
488 PATOM: TLO FLAGS,ATMBIT ;INDICATE ATOM-NAME PRINT OUT
489 HRRZ B,(TP) ;GET ADDRESS OF ATOM
490 ADDI B,2 ;POINT TO FIRST P-NAME WORD
491 HRLI B,350700 ;MAKE INTO A BYTE POINTER
492 HLRE A,(TP) ;GET LENGTH
493 MOVMS A ;ABSOLUTE VALUE
494 ADDI A,-1(B) ;POINT TO LAST WORD
495 HRLI A,TCHSTR ;CHANGE TYPE
496 PUSH TP,A ;PUT STRING ON STACK
499 MOVE D,[AOS E] ;GET COUNTING INSTRUCTION
501 PUSHJ P,PCHRST ;COUNT CHARACTERS & ESCAPES
502 MOVE A,E ;GET RETURNED COUNT
503 PUSHJ P,RETIF ;DO A CARRIAGE RETURN IF NOT ENOUGH ROOM ON THIS LINE
505 MOVEM B,(TP) ;RESET BYTE POINTER
506 MOVE D,[PUSHJ P,PITYO] ;GET OUTPUT INSTRUCTION
507 PUSHJ P,PCHRST ;PRINT STRING
509 SUB TP,[2,,2] ;REMOVE CHARACTER STRING ITEM
512 \f;PRINT LONG CHARACTER STRINGS.
514 PCHSTR: TLZ FLAGS,ATMBIT ;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
516 MOVE D,[AOS E] ;GET INSTRUCTION TO COUNT CHARACTERS
518 PUSHJ P,PCHRST ;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
519 MOVE A,E ;PUT COUNT RETURNED IN REG A
520 TLNN FLAGS,NOQBIT ;SKIP (NO QUOTES) IF IN PRINC (BIT ON)
521 ADDI A,2 ;PLUS TWO FOR QUOTES
522 PUSHJ P,RETIF ;START NEW LINE IF NO SPACE
524 TLNE FLAGS,NOQBIT ;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
525 JRST PCHS01 ;OTHERWISE, DON'T QUOTE
526 MOVEI A,"" ;PRINT A DOUBLE QUOTE
529 PCHS01: MOVE D,[PUSHJ P,PITYO] ;OUTPUT INSTRUCTION
530 MOVEM B,(TP) ;RESET BYTE POINTER
531 PUSHJ P,PCHRST ;TYPE STRING
533 TLNE FLAGS,NOQBIT ;AGAIN, SKIP IF DOUBLE-QUOTING TO BE DONE
534 JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
535 MOVEI A,"" ;PRINT A DOUBLE QUOTE
540 \f;INTERNAL ROUTINE USED TO COUNT OR OUTPUT CHARACTER STRINGS.
542 ;THE APPROPRIATE ESCAPING CONVENTIONS ARE USED AS DETERMINED BY THE FLAG BITS.
544 PCHRST: PUSH P,A ;SAVE REGS
547 LDB A,(TP) ;GET FIRST BYTE
550 PCHR02: ILDB A,(TP) ;GET THE NEXT CHARACTER
551 JUMPE A,PCSOUT ;ZERO BYTE TERMINATES
552 HRRZ C,-1(TP) ;GET ADDRESS OF DOPE WORD
553 HRRZ B,(TP) ;GET WORD ADDRESS OF LAST BYTE
554 CAIL B,-1(C) ;SKIP IF IT IS AT LEAST TWO BEFORE DOPE WORD
555 JRST PCSOUT ;ELSE, STRING IS FINISHED
557 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
558 JRST PCSPRT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
559 CAIN A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
560 JRST ESCPRN ;ESCAPE THE ESCAPE CHARACTER
561 CAIN A,"" ;SKIP IF NOT A DOUBLE QUOTE
562 JRST ESCPRN ;OTHERWISE, ESCAPE THE """
563 IDIVI A,CHRWD ;CODE HERE FINDS CHARACTER TYPE
565 CAIG B,NONSPC ;SKIP IF ATOM-BREAKER
566 JRST PCSPRT ;OTHERWISE, PRINT IT
567 TLNN FLAGS,ATMBIT ;SKIP IF PRINTING AN ATOM-NAME (UNQUOTED)
568 JRST PCSPRT ;OTHERWISE, NO OTHER CHARS TO ESCAPE
570 ESCPRN: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
573 PCSPRT: LDB A,(TP) ;GET THE CHARACTER AGAIN
575 JRST PCHR02 ;LOOP THROUGH STRING
577 PCSOUT: POP P,C ;RESTORE REGS & RETURN
583 \f;PRINT AN ARGUMENT LIST
584 ;CHECK FOR TIME ERRORS
586 PARGS: MOVEI B,-1(TP) ;POINT TO ARGS POINTER
587 PUSHJ P,CHARGS ;AND CHECK THEM
588 JRST PVEC ; CHEAT TEMPORARILY
593 PFRAME: MOVEI B,-1(TP) ;POINT TO FRAME POINTER
595 HRRZ B,(TP) ;POINT TO FRAME ITSELF
596 HRRZ B,FSAV(B) ;GET POINTER TO SUBROUTINE
597 MOVE B,@-1(B) ;PICKUP ATOM
601 MOVE B,MQUOTE -STACK-FRAME-FOR-
602 PUSHJ P,IPRINT ;PRINT IT
605 PUSHJ P,IPRINT ;PRINT FUNCTION NAME
608 PPVP: MOVE B,MQUOTE -PROCESS-
613 MOVE B,PROCID+1(B) ;GET ID
616 \f;PRINT UNIFORM VECTORS.
618 PUVEC: MOVEI A,"! ;TYPE AN ! AND OPEN SQUARE BRACKET
623 MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
624 TLNN C,777777 ;SKIP ONLY IF COUNT IS NOT ZERO
625 JRST NULVEC ;ELSE, VECTOR IS EMPTY
627 HLRE A,C ;GET NEG COUNT
628 MOVEI D,(C) ;COPY POINTER
629 SUB D,A ;POINT TO DOPE WORD
631 PUSH P,A ;AND SAVE IT
633 PUVE02: MOVE A,(P) ;PUT TYPE CODE IN REG A
634 MOVE B,(C) ;PUT DATUM INTO REG B
635 PUSHJ P,IPRINT ;TYPE IT
637 MOVE C,(TP) ;GET AOBJN POINTER
638 AOBJP C,NULVE1 ;JUMP IF COUNT IS ZERO
639 MOVEM C,(TP) ;PUT POINTER BACK ONTO STACK
641 MOVEI A,SPACE ;TYPE A BLANK
643 JRST PUVE02 ;LOOP THROUGH VECTOR
645 NULVE1: SUB P,[1,,1] ;REMOVE STACK CRAP
646 NULVEC: MOVEI A,"! ;TYPE CLOSE BRACKET
652 \f;PRINT A GENERALIZED VECTOR.
654 PVEC: PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR [
655 MOVEI A,"[ ;PRINT A LEFT-BRACKET
658 MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
659 TLNN C,777777 ;SKIP IF POINTER-COUNT IS NON-ZERO
660 JRST PVCEND ;ELSE, FINISHED WITH VECTOR
661 PVCR01: MOVE A,(C) ;PUT FIRST WORD OF NEXT ELEMENT INTO REG A
662 MOVE B,1(C) ;SECOND WORD OF LIST INTO REG B
663 PUSHJ P,IPRINT ;PRINT THAT ELEMENT
665 MOVE C,(TP) ;GET AOBJN POINTER FROM TP-STACK
666 AOBJP C,PDLERR ;POSITIVE HERE SERIOUS ERROR! (THOUGH NOT PDL)
667 AOBJN C,.+2 ;SKIP AND CONTINUE LOOP IF COUNT NOT ZERO
668 JRST PVCEND ;ELSE, FINISHED WITH VECTOR
669 MOVEM C,(TP) ;PUT INCREMENTED POINTER BACK ON TP-STACK
671 MOVEI A," ;PRINT A SPACE
673 JRST PVCR01 ;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR
675 PVCEND: PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR ]
676 MOVEI A,"] ;PRINT A RIGHT-BRACKET
682 PLIST: PUSHJ P,RETIF1 ;NEW LINE IF NO SPACE LEFT FOR "("
683 MOVEI A,"( ;TYPE AN OPEN PAREN
685 PUSHJ P,LSTPRT ;PRINT THE INSIDES
686 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
687 MOVEI A,") ;TYPE A CLOSE PAREN
695 PUNAS: PUSHJ P,RETIF1
698 JRST PLIST
\fPSEG: TLOA FLAGS,SEGBIT ;PRINT A SEGMENT (& SKIP)
700 PFORM: TLZ FLAGS,SEGBIT ;PRINT AN ELEMENT
703 JUMPE C,PLMNT1 ;IF THE CALL IS EMPTY GO AWAY
716 JUMPE D,PLMNT1 ;NEITHER, LEAVE
720 JUMPE C,PLMNT1 ;NIL BODY?
722 ;ITS VALUE OF AN ATOM
726 JUMPN C,PLMNT1 ;IF TERE ARE EXTRA ARGS GO AWAY
728 PUSH P,D ;PUSH THE CHAR
731 TLNN FLAGS,SEGBIT ;SKIP (CONTINUE) IF THIS IS A SEGMENT
732 JRST PLMNT4 ;ELSE DON'T PRINT THE "."
739 PLMNT4: PUSHJ P,RETIF1
740 POP P,A ;RESTORE CHAR
748 PLMNT1: TLNN FLAGS,SEGBIT ;SKIP IF THIS IS A SEGMENT
749 JRST PLMNT5 ;ELSE DON'T TYPE THE "!"
755 \rPLMNT5: PUSHJ P,RETIF1
760 TLNE FLAGS,SEGBIT ;SKIP IF NOT SEGEMNT
766 \fLSTPRT: INTGO ;WATCH OUT FOR GARBAGE COLLECTION!
769 HLLZ A,(C) ;GET NEXT ELEMENT
771 HRRZ C,(C) ;CHOP THE LIST
773 PUSHJ P,IPRINT ;PRINT THE LAST ELEMENT
777 PUSHJ P, IPRINT ;PRINT THE NEXT ELEMENT
780 PUSHJ P,PITYO ;PRINT THE SPACE AFTER THE NEXT ELEMENT
783 PNEXT: POP P,FLAGS ;RESTORE PREVIOUS FLAG BITS
784 SUB TP,[2,,2] ;REMOVE INPUT ELEMENT FROM TP-STACK
785 POP P,C ;RESTORE REG C
788 PDLERR: .VALUE 0 ;P-STACK OVERFLOW, VERY SERIOUS, MUDDLE DIES!
790 CHNERR: PUSH TP,$TATOM
791 PUSH TP,MQUOTE BAD-CHANNEL
794 ARGERR: PUSH TP,$TATOM ;TYPE WRONG # ARGUMENTS
795 PUSH TP,MQUOTE WRONG-NUMBER-OF-ARGUMENTS