1 TITLE PRINTER ROUTINE FOR MUDDLE
7 .GLOBAL IPNAME,MTYO,RLOOKU,RADX,INAME,INTFCN,LINLN,DOIOTO,BFCLS1,ATOSQ,IGVAL
8 .GLOBAL BYTPNT,OPNCHN,CHRWRD,IDVAL,CHARGS,CHFRM,CHLOCI,PRNTYP,PRTYPE,IBLOCK,WXCT
9 .GLOBAL VECBOT,VAL,ITEM,INDIC,IOINS,DIRECT,TYPVEC,CHRPOS,LINPOS,ACCESS,PAGLN,ROOT,PROCID
10 .GLOBAL BADCHN,WRONGD,CHNCLS,IGET,FNFFL,ILLCHO,BUFSTR,BYTDOP,6TOCHS,PURVEC,STBL,RXCT
11 .GLOBAL TMPLNT,TD.LNT,BADTPL,MPOPJ,SSPEC1,GLOTOP,GTLPOS,SPSTOR,PVSTOR
12 .GLOBAL CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR
13 .GLOBAL CIFLTZ,CITERP,CIUPRS,CPCH,CPCH1,CICRLF,NONSPC
15 BUFLNT==100 ; BUFFER LENGTH IN WORDS
17 FLAGS==0 ;REGISTER USED TO STORE FLAGS
18 CARRET==15 ;CARRIAGE RETURN CHARACTER
19 ESCHAR=="\ ;ESCAPE CHARACTER
20 SPACE==40 ;SPACE CHARACTER
21 ATMBIT==200000 ;BIT SWITCH FOR ATOM-NAME PRINT
22 NOQBIT==020000 ;SWITCH FOR NO ESCAPING OF OUTPUT (PRINC)
23 SEGBIT==010000 ;SWITCH TO INDICATE PRINTING A SEGMENT
24 SPCBIT==004000 ;SWITCH TO INDICATE "PRINT" CALL (PUT A SPACE AFTER)
25 FLTBIT==002000 ;SWITCH TO INDICATE "FLATSIZE" CALL
26 HSHBIT==001000 ;SWITCH TO INDICATE "PHASH" CALL
27 TERBIT==000400 ;SWITCH TO INDICATE "TERPRI" CALL
28 UNPRSE==000200 ;SWITCH TO INDICATE "UNPARSE" CALL
29 ASCBIT==000100 ;SWITCH TO INDICATE USING A "PRINT" CHANNEL
30 BINBIT==000040 ;SWITCH TO INDICATE USING A "PRINTB" CHANNEL
31 CNTLPC==000020 ;SWITCH TO INDICATE USING ^P CODE IOT
40 \fMFUNCTION FLATSIZE,SUBR
45 ;FLATSIZE TAKES TWO OR THREE ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
46 ;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS FALSE
47 ;THE THIRD (OPTIONAL) ARGUMENT IS A RADIX
49 CAMG AB,[-2,,0] ;CHECK NUMBER OF ARGS
56 JRST WTYP2 ;SECOND ARG NOT FIX THEN LOSE
57 \r CAMG AB,[-4,,0] ;SEE IF THERE IS A RADIX ARGUMENT
58 JRST .+3 ; RADIX SUPPLIED
59 PUSHJ P,GTRADX ; GET THE RADIX FROM OUTCHAN
61 GETYP A,4(AB) ;CHECK TO SEE THAT RADIX IS FIX
63 JRST WTYP ;ERROR THIRD ARGUMENT WRONG TYPE
65 PUSHJ P,GETARG ; GET ARGS INTO A AND B
66 FLTGO: POP P,D ; RESTORE FLATSIZE MAXIMUM
73 MFUNCTION UNPARSE,SUBR
80 MOVE E,TP ;SAVE TP POINTER
84 ;TURN ON FLTBIT TO AVOID PRINTING LOSSAGE
85 ;TURN ON UNPRSE TO CAUSE CHARS TO BE STASHED
86 CAMG AB,[-2,,0] ;SKIP IF RADIX SUPPLIED
88 PUSHJ P,GTRADX ;GET THE RADIX FROM OUTCHAN
90 CAMGE AB,[-5,,0] ;CHECK FOR TOO MANY
93 CAIE 0,TFIX ;SEE IF RADIX IS FIXED
95 MOVE C,3(AB) ;GET RADIX
\r
96 PUSHJ P,GETARG ;GET ARGS INTO A AND B
97 UNPRGO: PUSHJ P,CIUPRS
102 GTRADX: MOVE B,IMQUOTE OUTCHAN
104 PUSHJ P,IDVAL ;GET VALUE FOR OUTCHAN
106 GETYP A,A ;CHECK TYPE OF CHANNEL
108 JRST FUNCH1-1 ;IT IS A TP-POINTER
109 MOVE C,RADX(B) ;GET RADIX FROM OUTCHAN
111 MOVE C,(B)+6 ;GET RADIX FROM STACK
113 FUNCH1: CAIG C,1 ;CHECK FOR STRANGE RADIX
114 MOVEI C,10. ;DEFAULT IF THIS IS THE CASE
120 IMFUNCTION PRINT,SUBR
122 PUSHJ P,AGET ; GET ARGS
128 PUSHJ P,AGET ; GET ARGS
145 MFUNCTION TERPRI,SUBR
155 MOVSI 0,TERBIT+SPCBIT ; SET UP FLAGS
157 PUSHJ P,TESTR ; TEST FOR GOOD CHANNEL
158 MOVEI A,CARRET ; MOVE IN CARRIAGE-RETURN
159 PUSHJ P,PITYO ; PRINT IT OUT
160 MOVEI A,12 ; LINE-FEED
164 MOVSI A,TFALSE ; RETURN A FALSE
173 CAIN E,TCHAN ; CHANNEL?
178 IOR 0,A ; RESTORE FLAGS
181 TESTR1: HRRZ E,-2(B) ; GET IN FLAGS FROM CHANNEL
184 TRNN E,C.OPN ; SKIP IF OPEN
186 TRC E,C.PRIN+C.OPN ; CHECK TO SEE THAT CHANNEL IS GOOD
188 JRST BADCHN ; ITS A LOSER
190 JRST PSHNDL ; DON'T HANDLE BINARY
191 TLO ASCBIT ; ITS ASCII
192 POPJ P, ; ITS A WINNER
194 PSHNDL: PUSH TP,C ; SAVE ARGS
196 PUSH TP,A ; PUSH CHANNEL ONTO STACK
198 PUSHJ P,BPRINT ; CHECK BUFFER
206 \f;CIUPRS NEEDS A RADIX IN C AND A TYPE-OBJECT PAIR IN A,B
208 CIUPRS: SUBM M,(P) ; MODIFY M-POINTER
209 MOVE E,TP ; SAVE TP-POINTER
210 PUSH TP,[0] ; SLOT FOR FIRST STRING COPY
212 PUSH TP,[0] ; AND SECOND STRING
214 PUSH TP,A ; SAVE OBJECTS
216 PUSH TP,$TTP ; SAVE TP POINTER
219 MOVE D,[377777,,-1] ; MOVE IN MAXIMUM NUMBER FOR FLATSIZE
220 PUSHJ P,CIFLTZ ; FIND LENGTH OF STRING
221 FATAL UNPARSE BLEW IT
225 PUSHJ P,IBLOCK ; GET A BLOCK
230 POP TP,E ; RESTORE TP-POINTER
231 SUB TP,[1,,1] ;GET RID OF TYPE WORD
232 MOVEM A,1(E) ; SAVE RESULTS
236 POP TP,B ; RESTORE THE WORLD
239 MOVSI 0,FLTBIT+UNPRSE ; SET UP FLAGS
245 ; FOR CIFLTZ C CONTAINS THE RADIX, D THE MAXIMUM NUMBER OF CHARACTERS,
246 ; A,B THE TYPE-OBJECT PAIR
249 MOVE E,TP ; SAVE POINTER
250 PUSH TP,$TFIX ; PUSH ON FLATSIZE COUNT
252 PUSH TP,$TFIX ; PUSH ON FLATSIZE MAXIMUM
254 MOVSI 0,FLTBIT ; MOVE ON FLATSIZE FLAG
255 PUSHJ P,CUSET ; CONTINUE
257 SOS (P) ; SKIP RETURN
260 ; CUSET IS THE ROUTINE USED BY FLATSIZE AND UNPARSE TO DO THE PUSHING,POPING AND CALLING
261 ; NEEDED TO GET A RESULT.
263 CUSET: PUSH TP,$TFIX ; PUSH ON RADIX
266 PUSH TP,P ; PUSH ON RETURN POINTER IN CASE FLATSIZE GETS A FALSE
267 PUSH TP,A ; SAVE OBJECTS
269 MOVSI C,TTP ; CONSTRUCT TP-POINTER
270 HLR C,FLAGS ; SAVE FLAGS IN TP-POINTER
272 PUSH TP,C ; PUSH ON CHANNEL
274 PUSHJ P,IPRINT ; GO TO INTERNAL PRINTER
275 POP TP,B ; GET IN TP POINTER
276 MOVE TP,B ; RESTORE POINTER
277 TLNN FLAGS,UNPRSE ; SEE IF UNPARSE CALL
278 JRST FLTGEN ; ITS A FLATSIZE
279 MOVE A,UPB+3 ; RETURN STRING
282 FLTGEN: MOVE A,FLTSIZ-1 ; GET IN COUNT
288 ; CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR ALL ASSUME
289 ; THAT C,D CONTAIN THE OBJECT AND A AND B CONTAIN THE CHANNEL
292 MOVSI 0,SPCBIT ; SET UP FLAGS
293 PUSHJ P,TPRT ; PRINT INITIALIZATION
298 MOVEI FLAGS,0 ; SET UP FLAGS
299 PUSHJ P,TPR1 ; INITIALIZATION
300 PUSHJ P,IPRINT ; PRINT IT OUT
304 MOVSI FLAGS,NOQBIT ; SET UP FLAGS
305 PUSHJ P,TPR1 ; INITIALIZATION
309 ; INITIALIZATION FOR PRINT ROUTINES
311 TPRT: PUSHJ P,TESTR ; SEE IF CHANNEL IS OK
312 PUSH TP,C ; SAVE ARGUMENTS
314 PUSH TP,A ; SAVE CHANNEL
316 MOVEI A,CARRET ; PRINT CARRIAGE RETURN
320 MOVE A,-3(TP) ; MOVE IN ARGS
324 ; EXIT FOR PRINT ROUTINES
326 TPRTE: POP TP,B ; RESTORE CHANNEL
327 MOVEI A,SPACE ; PRINT TRAILING SPACE
329 SUB TP,[1,,1] ; GET RID OF CHANNEL TYPE-WORD
330 POP TP,B ; RETURN WHAT WAS PASSED
334 ; INITIALIZATION FOR PRIN1 AND PRINC ROUTINES
336 TPR1: PUSHJ P,TESTR ; SEE IF CHANNEL IS OK
337 PUSH TP,C ; SAVE ARGS
339 PUSH TP,A ; SAVE CHANNEL
341 MOVE A,-3(TP) ; GET ARGS
345 ; EXIT FOR PRIN1 AND PRINC ROUTINES
347 TPR1E: SUB TP,[2,,2] ; REMOVE CHANNEL
348 POP TP,B ; RETURN ARGUMENTS THAT WERE GIVEN
355 MOVSI C,TATOM ; GET TYPE FOR BINARY
356 MOVEI 0,SPCBIT ; SET UP FLAGS
357 PUSHJ P,TPRT ; PRINT INITIALIZATION
358 PUSHJ P,CPATOM ; PRINT IT OUT
363 MOVEI FLAGS,0 ; SET UP FLAGS
364 PUSHJ P,TPR1 ; INITIALIZATION
365 PUSHJ P,CPATOM ; PRINT IT OUT
370 MOVSI FLAGS,NOQBIT ; SET UP FLAGS
371 PUSHJ P,TPR1 ; INITIALIZATION
372 PUSHJ P,CPATOM ; PRINT IT OUT
376 ; THIS ROUTINE IS USD TO PRINT ONE CHARACTER. THE CHANNEL IS IN A AND B THE
384 PUSHJ P,TESTR ; SEE IF CHANNEL IS GOOD
385 EXCH D,(P) ; CHAR TO STACK, IND TO D
386 MOVE A,(P) ; MOVE IN CHARACTER FOR PITYO
391 MOVE A,$TCHRST ; RETURN THE CHARACTER
400 MOVSI 0,SPCBIT ; SET UP FLAGS
401 PUSHJ P,TPRT ; PRINT INITIALIZATION
402 PUSHJ P,CPCHST ; PRINT IT OUT
407 MOVEI FLAGS,0 ; SET UP FLAGS
408 PUSHJ P,TPR1 ; INITIALIZATION
409 PUSHJ P,CPCHST ; PRINT IT OUT
414 MOVSI FLAGS,NOQBIT ; SET UP FLAGS
415 PUSHJ P,TPR1 ; INITIALIZATION
416 PUSHJ P,CPCHST ; PRINT IT OUT
420 CPATOM: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE
\r
422 PUSH P,0 ; ATOM CALLER ROUTINE
426 CPCHST: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE
\r
428 PUSH P,0 ; STRING CALLER ROUTINE
435 SKIPL E,AB ; COPY ARG POINTER
436 JRST TFA ;NO ARGS IS AN ERROR
437 ADD E,[2,,2] ;POINT AT POSSIBLE CHANNEL
439 AGET1: MOVE E,AB ; GET COPY OF AB
442 COMPT: PUSH TP,$TFIX ;LEAVE ROOM ON STACK FOR ONE CHANNEL
444 JUMPGE E,DEFCHN ;IF NO CHANNEL ARGUMENT, USE CURRENT BINDING
445 CAMG E,[-2,,0] ;IF MORE ARGS THEN ERROR
447 MOVE A,(E) ;GET CHANNEL
451 DEFCHN: MOVE B,IMQUOTE OUTCHAN
453 PUSH P,FLAGS ;SAVE FLAGS
454 PUSHJ P,IDVAL ;GET VALUE OF OUTCHAN
457 NEWCHN: TLNE FLAGS,TERBIT ; SEE IF TERPRI
459 MOVE C,(AB) ; GET ARGS
463 ; HERE IF USING A PRINTB CHANNEL
465 BPRINT: TLO FLAGS,BINBIT
466 SKIPE BUFSTR(B) ; ANY OUTPUT BUFFER?
469 ; HERE TO GENERATE A STRING BUFFER
472 MOVEI A,BUFLNT ; GET BUFFER LENGTH
473 PUSHJ P,IBLOCK ; MAKE A BUFFER
474 MOVSI 0,TWORD+.VECT. ; CLOBBER U TYPE
476 SETOM (B) ; -1 THE BUFFER
483 MOVEM B,BUFSTR(C) ; STOR BYTE POINTER
484 MOVE 0,[TCHSTR,,BUFLNT*5]
491 IPRINT: PUSH P,C ; SAVE C
492 PUSH P,FLAGS ;SAVE PREVIOUS FLAGS
493 PUSH TP,A ;SAVE ARGUMENT ON TP-STACK
496 INTGO ;ALLOW INTERRUPTS HERE
498 GETYP A,-1(TP) ;GET THE TYPE CODE OF THE ITEM
499 SKIPE C,PRNTYP+1 ; USER TYPE TABLE?
501 NORMAL: CAILE A,NUMPRI ;PRIMITIVE?
502 JRST PUNK ;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
503 HRRO A,PRTYPE(A) ;YES-DISPATCH
506 ; HERE FOR USER PRINT DISPATCH
508 PRDISP: ADDI C,(A) ; POINT TO SLOT
510 SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP
511 JRST PRDIS1 ; APPLY EVALUATOR
512 SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP
516 PRDIS1: SUB C,PRNTYP+1
518 PUSH TP,[TATOM,,-1] ; PUSH ON OUTCHAN FOR SPECBIND
519 PUSH TP,IMQUOTE OUTCHAN
526 ADD C,PRNTYP+1 ; RESTORE C
527 PUSH TP,(C) ; PUSH ARGS FOR APPLY
531 MCALL 2,APPLY ; APPLY HACKER TO OBJECT
533 PUSHJ P,SSPEC1 ;UNBIND OUTCHAN
534 SUB TP,[6,,6] ; POP OFF STACK
537 ; PRINT DISPATCH TABLE
539 IF2,PUNKS==400000,,PUNK
541 DISTBL PRTYPE,PUNKS,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
542 [TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
543 [TARGS,PARGS],[TUVEC,PUVEC],[TDEFER,PDEFER],[TINTH,PINTH],[THAND,PHAND]
544 [TILLEG,ILLCH],[TRSUBR,PRSUBR],[TENTER,PENTRY],[TPCODE,PPCODE],[TTYPEW,PTYPEW]
545 [TTYPEC,PTYPEC],[TTMPLT,TMPRNT],[TLOCD,LOCPT1],[TLOCR,LOCRPT],[TQRSUB,PRSUBR]
546 [TQENT,PENTRY],[TSATC,PSATC],[TBYTE,PBYTE]
549 PUNK: MOVE C,TYPVEC+1 ; GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
550 GETYP B,-1(TP) ; GET THE TYPE CODE INTO REG B
551 LSH B,1 ; MULTIPLY BY TWO
552 HRL B,B ; DUPLICATE IT IN THE LEFT HALF
553 ADD C,B ; INCREMENT THE AOBJN-POINTER
554 JUMPGE C,PRERR ; IF POSITIVE, INDEX > VECTOR SIZE
556 MOVE B,-2(TP) ; MOVE IN CHANNEL
557 PUSH TP,$TVEC ; SAVE ALLTYPES VECTOR
559 PUSHJ P,RETIF1 ; START NEW LINE IF NO ROOM
560 MOVEI A,"# ; INDICATE TYPE-NAME FOLLOWS
564 MOVE A,(C) ; GET TYPE-ATOM
566 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
568 PUSHJ P,IPRINT ; PRINT ATOM-NAME
569 SUB TP,[2,,2] ; POP STACK
570 MOVE B,-2(TP) ; MOVE IN CHANNEL
571 PUSHJ P,SPACEQ ; MAYBE SPACE
572 MOVE B,(B) ; RESET THE REAL ARGUMENT POINTER
573 HRRZ A,(C) ; GET THE STORAGE-TYPE
575 CAILE A,NUMSAT ; SKIP IF TEMPLATE
576 JRST TMPRNT ; PRINT TEMPLATED DATA STRUCTURE
577 HRRO A,UKTBL(A) ; USE DISPATCH TABLE ON STORAGE TYPE
580 DISTBS UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC],[SATOM,PATOM]
581 [SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP],[SLOCID,LOCPT],[SLOCA,LOCP]
582 [SLOCV,LOCP],[SLOCU,LOCP],[SLOCS,LOCP],[SLOCL,LOCP],[SLOCN,LOCP],[SASOC,ASSPNT]
583 [SLOCT,LOCP],[SLOCB,LOCP],[SBYTE,PBYTE],[SOFFS,POFFSE]]
586 ILLCH: MOVEI B,-1(TP)
589 \f; PRINT INTERRUPT HANDLER
591 PHAND: MOVE B,-2(TP) ; MOVE CHANNEL INTO B
594 PUSHJ P,PITYO ; SAY "FUNNY TYPE"
596 MOVE B,MQUOTE HANDLER
597 PUSH TP,-3(TP) ; PUSH CHANNEL ON FOR IPRINT
599 PUSHJ P,IPRINT ; PRINT THE TYPE NAME
600 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
601 MOVE B,-2(TP) ; GET CHANNEL
602 PUSHJ P,SPACEQ ; SPACE MAYBE
603 SKIPN B,(TP) ; GET ARG BACK
605 MOVE A,INTFCN(B) ; PRINT FUNCTION FOR NOW
607 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
609 PUSHJ P,IPRINT ; PRINT THE INT FUNCTION
610 SUB TP,[2,,2] ; POP CHANNEL OFF
615 PINTH: MOVE B,-2(TP) ; GET CHANNEL INTO B
619 MOVSI A,TATOM ; AND NAME
620 MOVE B,MQUOTE IHEADER
621 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
624 MOVE B,-4(TP) ; GET CHANNEL INTO B
625 PUSHJ P,SPACEQ ; MAYBE SPACE
626 SKIPN B,-2(TP) ; INT HEADER BACK
628 MOVE A,INAME(B) ; GET NAME
631 PINTH1: SUB TP,[2,,2] ; CLEAN OFF STACK
635 ; PRINT ASSOCIATION BLOCK
637 ASSPNT: MOVEI A,"( ; MAKE IT BE (ITEN INDIC VAL)
638 MOVE B,-2(TP) ; GET CHANNEL INTO B
639 PUSHJ P,PRETIF ; MAKE ROOM AND PRINT
640 SKIPA C,[-3,,0] ; # OF FIELDS
641 ASSLP: PUSHJ P,SPACEQ
642 MOVE D,(TP) ; RESTORE GOODIE
643 ADD D,ASSOFF(C) ; POINT TO FIELD
646 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
648 PUSHJ P,IPRINT ; AND PRINT IT
649 SUB TP,[2,,2] ; POP OFF CHANNEL
650 MOVE B,-2(TP) ; GET CHANNEL
654 MOVE B,-2(TP) ; GET CHANNEL INTO B
655 PUSHJ P,PRETIF ; CLOSE IT
661 \f; PRINT TYPE-C AND TYPE-W
663 PTYPEW: HRRZ A,(TP) ; POSSIBLE RH
677 MOVE B,-4(TP) ; GET CHANNEL INTO B
678 PUSHJ P,RETIF ; ROOM TO START?
685 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
687 PUSHJ P,IPRINT ; AND PRINT IT AS 1ST ELEMENT
688 SUB TP,[2,,2] ; POP OFF CHANNEL
689 MOVE B,-2(TP) ; GET CHANNEL INTO B
690 PUSHJ P,SPACEQ ; MAYBE SPACE
691 MOVE A,-1(P) ; TYPE CODE
693 HRLI A,(A) ; MAKE SURE WINS
695 JUMPL A,PTYPX1 ; JUMP FOR A WINNER
696 ERRUUO EQUOTE BAD-TYPE-CODE
698 PTYPX1: MOVE B,1(A) ; GET TYPE NAME
701 MOVEM A,-1(P) ; AND SAVE IT
703 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
705 PUSHJ P,IPRINT ; OUT IT GOES
706 SUB TP,[2,,2] ; POP OFF CHANNEL
707 MOVE B,-2(TP) ; GET CHANNEL INTO B
708 PUSHJ P,SPACEQ ; MAYBE SPACE
709 MOVE A,-1(P) ; GET SAT BACK
710 MOVE B,IMQUOTE TEMPLATE
713 MOVSI A,TATOM ; AND PRINT IT
714 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
717 SUB TP,[2,,2] ; POP OFF STACK
718 SKIPN B,(P) ; ANY EXTRA CRAP?
721 MOVE B,-2(TP) ; GET CHANNEL INTO B
725 PUSH TP,-3(TP) ; PUSH CHANNELS FOR IPRINT
727 PUSHJ P,IPRINT ; PRINT EXTRA
728 SUB TP,[2,,2] ; POP OFF CHANNEL
731 MOVE B,-2(TP) ; GET CHANNEL INTO B
733 SUB P,[2,,2] ; FLUSH CRUFT
738 ; PRINT PURE CODE POINTER
741 MOVE B,-2(TP) ; GET CHANNEL INTO B
747 MOVSI A,TATOM ; PRINT SUBR CALL
748 MOVE B,MQUOTE PRIMTYPE-C
749 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
752 MOVE B,-4(TP) ; GET CHANNEL INTO B
753 PUSHJ P,SPACEQ ; MAYBE SPACE?
761 TMPPTY: MOVE B,TYPVEC+1
769 ERRUUO EQUOTE BAD-PRIMTYPEC
772 PSATC1: MOVSI A,TATOM
776 MOVE B,-2(TP) ; GET CHANNEL INTO B
777 PUSHJ P,PRETIF ; CLOSE THE FORM
782 MOVE B,-2(TP) ; GET CHANNEL INTO B
788 MOVSI A,TATOM ; PRINT SUBR CALL
790 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
793 MOVE B,-4(TP) ; GET CHANNEL INTO B
794 PUSHJ P,SPACEQ ; MAYBE SPACE?
795 HLRZ A,-2(TP) ; OFFSET TO VECTOR
796 ADD A,PURVEC+1 ; SLOT TO A
797 MOVE A,(A) ; SIXBIT NAME
799 PUSHJ P,6TOCHS ; TO A STRING
802 MOVE B,-4(TP) ; GET CHANNEL INTO B
804 HRRZ B,-2(TP) ; GET OFFSET
807 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
809 MOVE B,-2(TP) ; GET CHANNEL INTO B
810 PUSHJ P,PRETIF ; CLOSE THE FORM
814 \f; PRINT SUB-ENTRY TO RSUBR
816 PENTRY: MOVE B,(TP) ; GET BLOCK
817 GETYP A,(B) ; TYPE OF 1ST ELEMENT
818 CAIE A,TRSUBR ; RSUBR, OK
820 PENT2: MOVEI A,2 ; CHECK ROOM
821 MOVE B,-2(TP) ; GET CHANNEL INTO B
823 MOVEI A,"% ; SETUP READ TIME MACRO
828 MOVE B,IMQUOTE RSUBR-ENTRY
829 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
833 PUSHJ P,SPACEQ ; MAYBE SPACE
834 MOVEI A,"' ; QUOTE TO AVOID EVALING IT
836 MOVEI A,"[ ; OPEN SQUARE BRAKET
845 MOVE B,-4(TP) ; MOVE IN CHANNEL
849 MOVSI A,TATOM ; FOOL EVERYBODY AND SEND OUT ATOM
851 MOVE B,-4(TP) ; PRINT SPACE
852 PENT4: PUSHJ P,SPACEQ
853 MOVE B,-2(TP) ; GET PTR BACK TO VECTOR
854 MOVE A,2(B) ; THE NAME OF THE ENTRY
856 PUSHJ P,IPRINT ; OUT IT GOES
857 CAMLE B,[-4,,-1] ; SEE IF DONE
859 MOVE B,-4(TP) ; PRINT SPACE
861 MOVE B,-2(TP) ; GET POINTER
865 MOVE B,-4(TP) ; GET CHANNEL INTO B
866 EXPEN: MOVEI A,"] ; CLOSE SQUARE BRAKET
868 MOVE B,-4(TP) ; GET CHANNEL INTO B
875 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
876 MOVE B,-2(TP) ; GET CHANNEL INTO B
882 ERRUUO EQUOTE BAD-ENTRY-BLOCK
884 \f; HERE TO PRINT TEMPLATED DATA STRUCTURE
886 TMPRNT: PUSH P,FLAGS ; SAVE FLAGS
887 MOVE A,(TP) ; GET POINTER
888 GETYP A,(A) ; GET SAT
889 PUSH P,A ; AND SAVE IT
890 MOVEI A,"{ ; OPEN SQUIGGLE
891 MOVE B,-2(TP) ; GET CHANNEL INTO B
892 PUSHJ P,PRETIF ; PRINT WITH CHECKING
893 HLRZ A,(TP) ; GET AMOUNT RESTED OFF
895 PUSH P,A ; AND SAVE IT
896 MOVE A,-1(P) ; GET SAT
897 SUBI A,NUMSAT+1 ; FIXIT UP
899 ADD A,TD.LNT+1 ; CHECK FOR WINNAGE
900 JUMPGE A,BADTPL ; COMPLAIN
901 HRRZS C,(TP) ; GET LENGTH
903 SUB B,(P) ; FUDGE FOR RESTS
904 MOVEI B,-1(B) ; FUDGE IT
905 PUSH P,B ; AND SAVE IT
907 TMPRN1: AOS C,-1(P) ; GET ELEMENT OF INTEREST
908 SOSGE (P) ; CHECK FOR ANY LEFT
909 JRST TMPRN2 ; ALL DONE
911 MOVE B,(TP) ; POINTER
913 PUSHJ P,TMPLNT ; GET THE ITEM
914 MOVE FLAGS,-3(P) ; RESTORE FLAGS
915 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
917 PUSHJ P,IPRINT ; PRINT THIS ELEMENT
918 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
919 MOVE B,-2(TP) ; GET CHANNEL INTO B
920 SKIPE (P) ; IF NOT LAST ONE THEN
921 PUSHJ P,SPACEQ ; SEPARATE WITH A SPACE
926 MOVEI A,"} ; CLOSE THIS GUY
931 \f; RSUBR PRINTING ROUTINES. ON PRINTB CHANNELS, WRITES OUT
932 ; COMPACT BINARY. ON PRINT CHANNELS ALL IS ASCII
934 PRSUBR: MOVE A,(TP) ; GET RSUBR IN QUESTION
935 GETYP A,(A) ; CHECK FOR PURE RSUBR
937 JRST PRSBRP ; PRINT IT SPECIAL WAY
939 TLNN FLAGS,BINBIT ; SKIP IF BINARY OUTPUT
943 MOVSI A,TRSUBR ; FIND FIXUPS
945 HLRE D,1(B) ; -LENGTH OF CODE VEC
949 PUSHJ P,IGET ; GO GET THEM
950 JUMPE B,RCANT ; NO FIXUPS, BINARY LOSES
951 PUSH TP,A ; SAVE FIXUP LIST
954 MOVNI A,1 ; USE ^C AS MARKER FOR RSUBR
955 MOVE FLAGS,-1(P) ; RESTORE FLAGS
956 MOVE B,-4(TP) ; GET CHANNEL FOR PITYO
957 PUSHJ P,PITYO ; OUT IT GOES
959 PRSBR1: MOVE B,-4(TP)
960 PUSHJ P,BFCLS1 ; FLUSH OUT CURRENT BUFFER
962 MOVE B,-4(TP) ; CHANNEL BACK
963 MOVN E,(P) ; LENGTH OF CODE
965 HRROI A,(P) ; POINT TO SAME
966 PUSHJ P,DOIOTO ; OUT GOES COUNT
969 MOVEM C,ASTO(PVP) ; FOR IOT INTERRUPTS
970 MOVE A,-2(TP) ; GET POINTER TO CODE
972 PUSHJ P,DOIOTO ; IOT IT OUT
974 ADDI E,1 ; UPDATE ACCESS
977 SETZM ASTO(PVP) ; UNSCREW A
979 ; NOW PRINT OUT NORMAL RSUBR VECTOR
981 MOVE FLAGS,-1(P) ; RESTORE FLAGS
983 MOVE B,-2(TP) ; GET RSUBR VECTOR
984 PUSHJ P,PRBODY ; PRINT ITS BODY
986 ; HERE TO PRINT BINARY FIXUPS
988 MOVEI E,0 ; 1ST COMPUTE LENGTH OF FIXUPS
989 SKIPN A,(TP) ; LIST TO A
990 JRST PRSBR5 ; EMPTY, DONE
991 JUMPL A,UFIXES ; JUMP IF FIXUPS IN UVECTOR FORM
994 PRSBR6: HRRZ A,(A) ; NEXT?
997 CAIE B,TDEFER ; POSSIBLE STRING
998 JRST PRSBR7 ; COULD BE ATOM
999 MOVE B,1(A) ; POSSIBLE STRINGER
1001 CAIE C,TCHSTR ; YES!!!
1002 JRST BADFXU ; LOSING FIXUPS
1003 HRRZ C,(B) ; # OF CHARS TO C
1004 ADDI C,5+5 ; ROUND AND ADD FOR COUNT
1005 IDIVI C,5 ; TO WORDS
1007 JRST FIXLST ; COUNT FOR USE LIST ETC.
1009 PRSBR7: GETYP B,(A) ; GET TYPE
1014 FIXLST: HRRZ A,(A) ; REST IT TO OLD VAL
1020 HRRZ A,(A) ; TO USE LIST
1025 MOVE C,1(A) ; GET LIST
1027 PRSBR8: JUMPE C,PRSBR9
1028 GETYP B,(C) ; TYPE OK?
1032 AOJA D,PRSBR8 ; LOOP
1034 PRSBR9: ADDI D,2 ; ROUND UP
1035 ASH D,-1 ; DIV BY 2 FOR TWO GOODIES PER HWORD
1039 PRSBR5: PUSH P,E ; SAVE LENGTH OF FIXUPS
1040 PUSH TP,$TUVEC ; SLOT FOR BUFFER POINTER
1043 PFIXU1: MOVE B,-6(TP) ; START LOOPING THROUGH CHANNELS
1044 PUSHJ P,BFCLS1 ; FLUSH BUFFER
1045 MOVE B,-6(TP) ; CHANNEL BACK
1046 MOVEI C,BUFSTR-1(B) ; SETUP BUFFER
1047 PUSHJ P,BYTDOP ; FIND D.W.
1051 MOVE E,(P) ; LENGTH OF FIXUPS
1052 SETZB C,D ; FOR EOUT
1054 MOVE C,-2(TP) ; FIXUP LIST
1055 MOVE E,1(C) ; HAVE VERS
1056 PUSHJ P,EOUT ; OUT IT GOES
1058 PFIXU2: HRRZ C,(C) ; FIRST THING
1059 JUMPE C,PFIXU3 ; DONE?
1060 GETYP A,(C) ; STRING OR ATOM
1061 CAIN A,TATOM ; MUST BE STRING
1063 MOVE A,1(C) ; POINT TO POINTER
1066 PUSH P,E ; SAVE REMAINDER
1073 PFXU1A: MOVE A,1(C) ; RESTORE POINTER
1074 HRRZ A,1(A) ; BYTE POINTER
1081 MOVE D,-1(P) ; LAST WORD
1086 MOVE E,(A) ; LAST WORD OF CHARS
1098 PFIXU4: HRRZ E,(C) ; GET CURRENT VAL
1100 PUSHJ P,ATOSQ ; GET SQUOZE
1102 TLO E,400000 ; USE TO DIFFERENTIATE BETWEEN STRING
1105 ; HERE TO WRITE OUT LISTS
1107 PFIXU5: HRRZ C,(C) ; POINT TO CURRENT VALUE
1109 HRRZ C,(C) ; POINT TO USES LIST
1110 HRRZ D,1(C) ; GET IT
1112 PFIXU6: TLCE D,400000 ; SKIP FOR RH
1113 HRLZ E,1(D) ; SETUP LH
1116 PUSHJ P,EOUT ; WRITE IT OUT
1118 TRNE D,-1 ; SKIP IF DONE
1121 TRNE E,-1 ; SKIP IF ZERO BYTE EXISTS
1124 JRST PFIXU2 ; DO NEXT
1126 PFIXU3: HLRE C,(TP) ; -AMNT LEFT IN BUFFER
1127 MOVN D,C ; PLUS SAME
1128 ADDI C,BUFLNT ; WORDS USED TO C
1129 JUMPE C,PFIXU7 ; NONE USED, LEAVE
1130 MOVSS C ; START SETTING UP BTB
1131 MOVN A,C ; ALSO FINAL IOT POINTER
1132 HRR C,(TP) ; PDL POINTER PART OF BTB
1134 HRLI D,400000+C ; CONTINUE SETTING UP BTB (400000 IS FOR MULTI
1136 POP C,@D ; MOVE 'EM DOWN
1139 HRRI A,@D ; OUTPUT POINTER
1145 PUSHJ P,DOIOTO ; WRITE IT OUT
1149 PFIXU7: SUB TP,[4,,4]
1153 ; ROUTINE TO OUTPUT CONTENTS OF E
1155 EOUT: MOVE B,-6(TP) ; CHANNEL
1157 MOVE A,(TP) ; BUFFER POINTER
1159 AOBJP A,.+3 ; COUNT AND GO
1163 SUBI A,BUFLNT ; SET UP IOT POINTER
1165 MOVEM A,(TP) ; RESET SAVED POINTER
1172 PUSHJ P,DOIOTO ; OUT IT GOES
1179 ; HERE IF UVECOR FORM OF FIXUPS
1181 UFIXES: PUSH TP,$TUVEC
1184 UFIX1: MOVE B,-6(TP) ; GET SAME
1185 PUSHJ P,BFCLS1 ; FLUSH OUT BUFFER
1186 HLRE C,(TP) ; GET LENGTH
1189 HRROI A,(P) ; READY TO ZAP IT OUT
1190 PUSHJ P,DOIOTO ; ZAP!
1192 HLRE C,(TP) ; LENGTH BACK
1195 ADDM C,ACCESS(B) ; UPDATE ACCESS
1196 MOVE A,(TP) ; NOW THE UVECTOR
1207 RCANT: ERRUUO EQUOTE RSUBR-LACKS-FIXUPS
1210 BADFXU: ERRUUO EQUOTE BAD-FIXUPS
1212 PRBODY: TDZA C,C ; FLAG SAYING FLUSH CODE
1213 PRBOD1: MOVEI C,1 ; PRINT CODE ALSO
1218 MOVEI A,"[ ; START VECTOR TEXT
1219 MOVE B,-6(TP) ; GET CHANNEL FOR PITYO
1222 MOVE B,(TP) ; RSUBR BACK
1223 JUMPN C,PRSON ; GO START PRINTING
1224 MOVEI A,"0 ; PLACE SAVER FOR CODE VEC
1225 MOVE B,-6(TP) ; GET CHANNEL FOR PITYO
1228 PRSBR2: MOVE B,[2,,2] ; BUMP VECTOR
1230 JUMPGE B,PRSBR3 ; NO SPACE IF LAST
1231 MOVE B,-6(TP) ; GET CHANNEL FOR SPACEQ
1233 SKIPA B,(TP) ; GET BACK POINTER
1234 PRSON: JUMPGE B,PRSBR3
1235 GETYP 0,(B) ; SEE IF RSUBR POINTED TO
1238 JRST .+5 ; JUMP IF RSUBR ENTRY
1241 CAIE 0,TRSUBR ; YES!
1242 JRST PRSB10 ; COULD BE SUBR/FSUBR
1243 MOVE C,1(B) ; GET RSUBR
1244 PUSH P,0 ; SAVE TYPE FOUND
1245 GETYP 0,2(C) ; SEE IF ATOM
1248 MOVE B,3(C) ; GET ATOM NAME
1249 PUSHJ P,IGVAL ; GO LOOK
1250 MOVE C,(TP) ; ORIG RSUBR BACK
1252 POP P,0 ; DESIRED TYPE
1253 CAIE 0,(A) ; SAME TYPE
1256 MOVE 0,3(D) ; NAME OF RSUBR IN QUESTION
1265 PRSBR4: MOVE FLAGS,(P) ; RESTORE FLAGS
1268 MOVE B,1(B) ; PRINT IT
1269 PRS101: PUSH TP,-7(TP) ; PUSH CHANNEL FOR IPRINT
1272 SUB TP,[2,,2] ; POP OFF CHANNEL
1273 MOVE B,-2(TP) ; MOVE IN CHANNEL
1276 PRSB10: CAIE 0,TSUBR ; SUBR?
1280 MOVE C,1(B) ; GET LOCN OF SUBR OR FSUBR
1281 MOVE B,@-1(C) ; NAME OF IT
1282 MOVSI A,TATOM ; AND TYPE
1287 PUSHJ P,PRETIF ; CLOSE IT UP
1288 SUB TP,[2,,2] ; FLUSH CRAP
1293 \f; HERE TO PRINT PURE RSUBRS
1295 PRSBRP: MOVEI A,2 ; WILL "%<" FIT?
1296 MOVE B,-2(TP) ; GET CHANNEL FOR RETIF
1303 MOVE B,IMQUOTE RSUBR
1304 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1306 PUSHJ P,IPRINT ; PRINT IT OUT
1307 SUB TP,[2,,2] ; POP OFF CHANNEL
1309 PUSHJ P,SPACEQ ; MAYBE SPACE
1310 MOVEI A,"' ; QUOTE THE VECCTOR
1312 MOVE B,(TP) ; GET RSUBR BODY BACK
1313 PUSH TP,$TFIX ; STUFF THE STACK
1315 PUSHJ P,PRBOD1 ; PRINT AND UNLINK
1316 SUB TP,[2,,2] ; GET JUNK OFF STACK
1317 MOVE B,-2(TP) ; GET CHANNEL FOR RETIF
1322 ; HERE TO PRINT ASCII RSUBRS
1324 ARSUBR: PUSH P,FLAGS ; SAVE FROM GET
1328 MOVE D,IMQUOTE RSUBR
1329 PUSHJ P,IGET ; TRY TO GET FIXUPS
1331 JUMPE B,PUNK ; NO FIXUPS LOSE
1333 CAIE A,TLIST ; ARE FIXUPS A LIST?
1334 JRST PUNK ; NO, AGAIN LOSE
1336 PUSH TP,B ; SAVE FIXUPS
1340 PUSH P,[440700,,[ASCIZ /%<FIXUP!-RSUBRS!-/]]
1342 AL1: ILDB A,(P) ; GET CHAR
1351 PUSHJ P,PRETIF ; QUOTE TO AVOID ADDITIONAL EVAL
1352 MOVE B,-2(TP) ; PRINT ACTUAL KLUDGE
1354 MOVE B,-4(TP) ; GET CHANNEL FOR SPACEQ
1356 MOVEI A,"' ; DONT EVAL FIXUPS EITHER
1360 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1363 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
1364 MOVE B,-2(TP) ; GET CHANNEL INTO B
1369 ; HERE TO DO OFFSETS: %<OFFSET N '<VECTOR FIX FLOAT>>
1379 MOVE B,MQUOTE OFFSET
1384 MOVE B,-2(TP) ; RESTORE CHANNEL
1387 HRRE B,(TP) ; PICK UPTHE FIX
1392 MOVE B,-2(TP) ; RESTORE CHANNEL
1397 CAIE B,TFORM ; FORMS HAVE TO BE QUOTED
1405 POFFPT: PUSH TP,-3(TP)
1409 MOVE B,-2(TP) ; RESTORE CHANNEL
1414 POFFS2: MOVSI A,TATOM
1418 \f; HERE TO DO LOCATIVES (PRINT CONTENTS THEREOF)
1420 LOCP: PUSH TP,-1(TP)
1423 MCALL 1,IN ; GET ITS CONTENTS FROM "IN"
1425 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1427 PUSHJ P,IPRINT ; PRINT IT
1428 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
1430 \f;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
1432 ;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
1433 PITYO: TLNN FLAGS,FLTBIT
1435 PITYO1: PUSH TP,[TTP,,0] ; PUSH ON TP POINTER
1437 TLNE FLAGS,UNPRSE ;SKIPS UNPRSE NOT SET
1439 AOS FLTSIZ ;FLATSIZE DOESN'T PRINT
1440 ;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
1441 SOSGE FLTMAX ;UNLESS THE MAXIMUM IS EXCEEDED
1443 POP TP,B ; GET CHANNEL BACK
1446 MOVEI E,(B) ; GET POINTER FOR UNBINDING
1448 MOVE P,UPB+8 ; RESTORE P
1449 POP TP,B ; GET BACK TP POINTER
1450 PUSH P,0 ; SAVE FLAGS
1451 MOVE TP,B ; RESTORE TP
1452 MOVEI C,(TB) ; SEE IF TB IS CORRECT
1453 CAIG C,1(TP) ; SKIP IF NEEDS UNWINDING
1455 PITYO3: MOVEI C,(TB)
1458 MOVEI A,PITYO4 ; SET UP PARAMETERS TO BE RESTORED BY FINIS
1464 MOVE TB,D ; SET TB TO ONE FRAME AHEAD
1466 PITYO4: POP P,0 ; RESTORE FLAGS
1467 MOVSI A,TFALSE ;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
1471 PITYO2: MOVE D,TB ; SAVE ONE FRAME AHEAD
1472 HRR TB,OTBSAV(TB) ; RESTORE TB
1477 ;NOTE THAT THE FOLLOWING CODE HAS BUGS IF IT IS PRINTING OUT LONG
1479 ; (NOTE THAT THE ABOVE COMMENT, IF TRUE, SHOULD NOT BE ADMITTED.)
1480 ITYO: PUSH TP,$TCHAN
1482 PUSH P,FLAGS ;SAVE STUFF
1484 PUSH P,A ;SAVE OUTPUT CHARACTER
1487 TLNE FLAGS,UNPRSE ;SKIPS UNPRSE NOT SET
1488 JRST UNPROUT ;IF FROM UNPRSE, STASH IN STRING
1494 CAIE A,^L ;SKIP IF THIS IS A FORM-FEED
1496 SETZM LINPOS(B) ;ZERO THE LINE NUMBER
1499 NOTFF: CAIE A,15 ;SKIP IF IT IS A CR
1501 SETZM CHRPOS(B) ;ZERO THE CHARACTER POSITION
1502 PUSHJ P,AOSACC ; BUMP COUNT
1505 NOTCR: CAIN A,^I ;SKIP IF NOT TAB
1507 CAIE A,10 ; BACK SPACE
1509 SOS CHRPOS(B) ; BACK UP ONE
1511 CAIE A,^J ;SKIP IF LINE FEED
1513 AOS C,LINPOS(B) ;ADD ONE TO THE LINE NUMBER
1514 CAMLE C,PAGLN(B) ;SKIP IF THIS DOESN'T TAKES US PAST PAGE END
1519 INTCHK: HRRZ 0,-2(B) ; GET CHANNELS FLAGS
1520 TRNN 0,C.INTL ; LOSER INTERESTED IN LFS?
1521 POPJ P, ; LEAVE IF NOTHING TO DO
1523 PUSH TP,B ; SAVE CHANNEL
1526 PUSHJ P,GTLPOS ; READ SYSTEMS VERSION OF LINE #
1528 PUSH TP,MQUOTE CHAR,CHAR,INTRUP
1534 POP P,E ; RESTORE POSSIBLE COUNTS
1536 POP TP,B ; RESTORE CHANNEL
1542 AOS CHRPOS(B) ; FOR CONTROL CHARS THAT NEED 2 SPACES
1543 AOS CHRPOS(B) ;ADD TO CHARACTER NUMBER
1545 ITYXT: PUSHJ P,AOSACC ; BUMP ACCESS
1546 ITYXT1: POP P,A ;RESTORE THE ORIGINAL CHARACTER
1548 ITYRET: POP P,C ;RESTORE REGS & RETURN
1550 POP TP,B ; GET CHANNEL BACK
1556 ADDI C,8. ;INCREMENT COUNT BY EIGHT (MOD EIGHT)
1559 MOVEM C,CHRPOS(B) ;REPLACE COUNT
1563 UNPROUT: POP P,A ;GET BACK THE ORIG CHAR
1564 IDPB A,UPB+2 ;DEPOSIT USING BYTE POINTER I PUSHED LONG AGO
1568 AOSACC: TLNN FLAGS,BINBIT
1570 AOS C,ACCESS-1(B) ; COUNT CHARS IN WORD
1577 NRMACC: AOS ACCESS(B)
1581 TLNE FLAGS,FLTBIT+BINBIT
1582 JRST PITYO ; JUST OUTPUT THE SPACE
1583 PUSH P,[1] ; PRINT SPACE IF NOT END OF LINE
1590 TLNE FLAGS,FLTBIT+BINBIT
1591 JRST SPOPJ ; IF WE ARE IN FLATSIZE THEN ESCAPE
1592 RETIF2: PUSH P,FLAGS
1595 RETCH1: ADD A,CHRPOS(B) ;ADD THE CHARACTER POSITION
1596 SKIPN CHRPOS(B) ; IF JUST RESET, DONT DO IT AGAIN
1598 CAMG A,LINLN(B) ;SKIP IF GREATER THAN LINE LENGTH
1601 MOVEI A,^M ;FORCE A CARRIAGE RETURN
1604 PUSHJ P,AOSACC ; BUMP CHAR COUNT
1605 MOVEI A,^J ;AND FORCE A LINE FEED
1606 PUSHJ P,INTCHK ; CHECK FOR ^J INTERRUPTS
1608 PUSHJ P,AOSACC ; BUMP CHAR COUNT
1610 CAMG A,PAGLN(B) ;AT THE END OF THE PAGE ?
1612 ; MOVEI A,^L ;IF SO FORCE A FORM FEED
1614 ; PUSHJ P,AOSACC ; BUMP CHAR COUNT
1623 PRETIF: PUSH P,A ;SAVE CHAR
1628 RETIF3: TLNE FLAGS,FLTBIT ; NOTHING ON FLATSIZE
1632 HRRI FLAGS,2 ; PRETEND ONLY 1 CHANNEL
1636 RETXT1: SKIPN -2(P) ; SKIP IF SPACE HACK
1646 \f;THIS IS CODE TO HANDLE UNKNOWN DATA TYPES.
1647 ;IT PRINTS "*XXXXXX*XXXXXXXXXXXX*", WHERE THE FIRST NUMBER IS THE
1648 ;TYPE CODE IN OCTAL, THE SECOND IS THE VALUE FIELD IN OCTAL.
1649 PRERR: MOVEI A,21. ;CHECK FOR 21. SPACES LEFT ON PRINT LINE
1650 MOVE B,-2(TP) ; GET CHANNEL INTO B
1651 PUSHJ P,RETIF ;INSERT CARRIAGE RETURN IF NOT ENOUGH
1652 MOVEI A,"* ;JUNK TO INDICATE ERROR PRINTOUT IN OCTAL
1653 PUSHJ P,PITYO ;TYPE IT
1655 MOVE E,[000300,,-2(TP)] ;GET POINTER INDEXED OFF TP SO THAT
1656 ;TYPE CODE MAY BE OBTAINED FOR PRINTING.
1657 MOVEI D,6 ;# OF OCTAL DIGITS IN HALF WORD
1658 OCTLP1: ILDB A,E ;GET NEXT 3-BIT BYTE OF TYPE CODE
1659 IORI A,60 ;OR-IN 60 FOR ASCII DIGIT
1660 PUSHJ P,PITYO ;PRINT IT
1661 SOJG D,OCTLP1 ;REPEAT FOR SIX CHARACTERS
1663 PRE01: MOVEI A,"* ;DELIMIT TYPE CODE FROM VALUE FIELD
1666 HRLZI E,(410300,,(TP)) ;BYTE POINTER TO SECOND WORD
1668 MOVEI D,12. ;# OF OCTAL DIGITS IN A WORD
1669 OCTLP2: LDB A,E ;GET 3 BITS
1670 IORI A,60 ;CONVERT TO ASCII
1671 PUSHJ P,PITYO ;PRINT IT
1672 IBP E ;INCREMENT POINTER TO NEXT BYTE
1673 SOJG D,OCTLP2 ;REPEAT FOR 12. CHARS
1675 MOVEI A,"* ;DELIMIT END OF ERROR TYPEOUT
1676 PUSHJ P,PITYO ;REPRINT IT
1678 JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
1680 POCTAL: MOVEI A,14. ;RETURN TO NEW LINE IF 14. SPACES NOT LEFT
1681 MOVE B,-2(TP) ; GET CHANNEL INTO B
1683 JRST PRE01 ;PRINT VALUE AS "*XXXXXXXXXXXX*"
1685 \f;PRINT BINARY INTEGERS IN DECIMAL.
1687 PFIX: MOVM E,(TP) ; GET # (MAFNITUDE)
1688 JUMPL E,POCTAL ; IF ABS VAL IS NEG, MUST BE SETZ
1691 PFIX1: MOVE B,-2(TP) ; GET CHANNEL INTO B
1692 PFIX2: MOVE D,UPB+6 ; IF UNPARSE, THIS IS RADIX
1693 TLNE FLAGS,UNPRSE+FLTBIT ;SKIPS IF NOT FROM UNPARSE OR FLATSIZE
1695 MOVE D,RADX(B) ; GET OUTPUT RADIX
1696 PFIXU: CAIG D,1 ; DONT ALLOW FUNNY RADIX
1697 MOVEI D,10. ; IF IN DOUBT USE 10.
1699 MOVEI A,1 ; START A COUNTER
1700 SKIPGE B,(TP) ; CHECK SIGN
1701 MOVEI A,2 ; NEG, NEED CHAR FOR SIGN
1703 IDIV B,D ; START COUNTING
1707 MOVE B,-2(TP) ; CHANNEL TO B
1708 TLNN FLAGS,FLTBIT+BINBIT
1709 PUSHJ P,RETIF3 ; CHECK FOR C.R.
1710 MOVE B,-2(TP) ; RESTORE CHANNEL
1711 MOVEI A,"- ; GET SIGN
1712 SKIPGE (TP) ; SKIP IF NOT NEEDED
1714 MOVM C,(TP) ; GET MAGNITUDE OF #
1715 MOVE B,-2(TP) ; RESTORE CHANNEL
1716 POP P,E ; RESTORE RADIX
1717 PUSHJ P,FIXTYO ; WRITE OUT THE #
1719 SUB P,[1,,1] ; FLUSH P STUFF
1723 PUSH P,D ; SAVE REMAINDER
1726 POP P,A ; START GETTING #'S BACK
1728 MOVE B,-2(TP) ; CHANNEL BACK
1731 \f;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
1733 PFLOAT: SKIPN A,(TP) ; SKIP IF NUMBER IS NON-ZERO
1734 ; SPECIAL HACK FOR ZERO)
1735 JRST PFLT0 ; HACK THAT ZERO
1736 MOVM E,A ; CHECK FOR NORMALIZED
1737 TLNN E,400 ; NORMALIZED
1739 MOVE E,[SETZ FLOATB] ;ADDRESS OF FLOATING POINT CONVERSION ROUTINE
1740 MOVE D,[6,,6] ;# WORDS TO GET FROM STACK
1742 PNUMB: HRLI A,1(P) ; LH(A) TO CONTAIN ADDRESS OF RETURN AREA
1744 HRR A,TP ; RH(A) TO CONTAIN ADDRESS OF DATA ITEM
1745 HLRZ B,A ; SAVE RETURN AREA ADDRESS IN REG B
1746 ADD P,D ; ADD # WORDS OF RETURN AREA TO BOTH HALVES OF
1748 JUMPGE P,PDLERR ; PLUS OR ZERO STACK POINTER IS OVERFLOW
1749 PDLWIN: PUSHJ P,(E) ; CALL ROUTINE WHOSE ADDRESS IS IN REG E
1751 MOVE C,(B) ; GET COUNT 0F # CHARS RETURNED
1753 HRR B,P ; GET PSTACK POINTER AND PRODUCE RELATAVIZED
1755 HRLS A ; ADD TO AOBJN
1756 ADD A,P ; PRODUCE PDL POINTER
1757 MOVE B,-2(TP) ; GET CHANNEL INTO B
1758 PUSH TP,$TPDL ; PUSH PDL POINTER
1760 MOVE A,C ; MAKE SURE THAT # WILL FIT ON PRINT LINE
1761 PUSH P,D ; WATCH THAT MCALL
1762 PUSHJ P,RETIF ; START NEW LINE IF IT WON'T
1764 POP TP,B ; RESTORE B
1765 SUB TP,[1,,1] ; CLEAN OFF STACK
1767 HRLI B,000700 ;MAKE REG B INTO BYTE POINTER TO FIRST CHAR
1769 PNUM01: ILDB A,B ; GET NEXT BYTE
1771 MOVE B,-2(TP) ; GET CHANNEL INTO B
1772 PUSHJ P,PITYO ; PRINT IT
1774 SOJG C,PNUM01 ; DECREMENT CHAR COUNT: LOOP IF NON-ZERO
1776 SUB P,D ;SUBTRACT # WORDS USED ON STACK FOR RETURN
1777 JRST PNEXT ;STORE REGS & POP UP ONE LEVEL TO CALLER
1780 PFLT0: MOVEI A,9. ; WIDTH OF 0.0000000
1781 MOVEI C,9. ; SEE ABOVE
1782 MOVEI D,0 ; WE'RE GONNA TEST D SOON...SO WILL DO RIGHT THING
1783 MOVEI B,[ASCII /0.0000000/]
1784 SOJA B,PFLT1 ; PT TO 1 BELOW CONST, THEN REJOIN CODE
1789 PDLERR: SUB P,D ;REST STACK POINTER
1793 ; FLOATING POINT PRINTER STOLEN FROM DDT
1811 MOVSI 0,440700 ; BUILD BYTEPNTR
1812 HLRZ J,A ; POINT TO BUFFER
1815 MOVE A,(A) ; GET NUMBER
1817 SETZM (J) ; Clear counter
1830 ; at this point we enter code abstracted from DDT.
1847 FP3: SETZB C,TEM1 ; CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
1864 POPJ P, ; ONE return from OFLT here
1883 FP7: SKIPE A ; AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
1900 CHRO: AOS (J) ; COUNT CHAR
1901 IDPB A,0 ; STUFF CHAR
1921 FCP: CAMLE A, FT0(C)
1931 ;PRINT SHORT (ONE WORD) CHARACTER STRINGS
1933 PCHRS: MOVEI A,3 ;MAX # CHARS PLUS 2 (LESS ESCAPES)
1934 MOVE B,-2(TP) ; GET CHANNEL INTO B
1935 TLNE FLAGS,NOQBIT ;SKIP IF QUOTES WILL BE USED
1936 MOVEI A,1 ;ELSE, JUST ONE CHARACTER POSSIBLE
1937 PUSHJ P,RETIF ;NEW LINE IF INSUFFICIENT SPACE
1938 TLNE FLAGS,NOQBIT ;DON'T QUOTE IF IN PRINC MODE
1940 MOVEI A,"! ;TYPE A EXCL
1942 MOVEI A,"\ ;AND A BACK SLASH
1945 PCASIS: MOVE A,(TP) ;GET NEXT BYTE FROM WORD
1946 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
1947 JRST PCPRNT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
1948 CAIE A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
1949 JRST PCPRNT ;ESCAPE THE ESCAPE CHARACTER
1951 ESCPRT: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
1953 PCPRNT: MOVE A,(TP) ;GET THE CHARACTER AGAIN
1954 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
1955 TLO FLAGS,CNTLPC ;SWITCH ON ^P MODE TEMPORARY
1956 PUSHJ P,PITYO ;PRINT IT
1957 TLZ FLAGS,CNTLPC ;SWITCH OFF ^P MODE
1961 \f;PRINT DEFERED (INVISIBLE) ITEMS. (PRINTED AS THE THING POINTED TO)
1963 PDEFER: MOVE A,(B) ;GET FIRST WORD OF ITEM
1964 MOVE B,1(B) ;GET SECOND
1965 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1967 PUSHJ P,IPRINT ;PRINT IT
1968 SUB TP,[2,,2] ; POP OFF CHANNEL
1972 ; Print an ATOM. TRAILERS are added if the atom is not in the current
1973 ; lexical path. Also escaping of charactets is performed to allow READ
1976 PATOM: PUSH P,[440700,,D] ; PUSH BYE POINTER TO FINAL STRING
1977 SETZB D,E ; SET CHARCOUNT AD DESTINATION TO 0
1978 HLLZS -1(TP) ; RH OF TATOM,, WILL COUNT ATOMS IN PATH
1980 PATOM0: PUSH TP,$TPDL ; SAVE CURRENT STAKC FOR \ LOGIC
1982 LDB A,[301400,,(P)] ; GET BYTE PTR POSITION
1983 DPB A,[301400,,E] ; SAVE IN E
1984 MOVE C,-2(TP) ; GET ATOM POINTER
1985 ADD C,[3,,3] ; POINT TO PNAME
1986 JUMPGE C,BADPNM ; NO PNAME, ERROR
1987 HLRE A,C ; -# WORDS TO A
1988 PUSH P,A ; PUSH THAT FOR "AOSE"
1989 MOVEI A,177 ; PUT RUBOUT WHERE \ MIGHT GO
1991 HRLI C,440700 ; BUILD BYTE POINTER
1992 ILDB A,C ; GET FIRST BYTE
1993 JUMPE A,BADPNM ; NULL PNAME, ERROR
1995 PATOM1: ILDB A,C ; GET A CHAR
1996 JUMPE A,PATDON ; END OF PNAME?
1997 TLNN C,760000 ; SKIP IF NOT WORD BOUNDARY
1998 AOS (P) ; COUNT WORD
1999 JRST PENTCH ; ENTER THE CHAR INTO OUTPUT
2001 PATDON: LDB A,[220600,,E] ; GET "STATE"
2002 LDB A,STABYT+NONSPC+1 ; SIMULATE "END" CHARACTER
2003 DPB A,[220600,,E] ; AND STORE
2004 MOVE B,E ; SETUP BYTE POINTER TO 1ST CHAR
2007 SUB TP,[2,,2] ; FLUSH SAVED PDL
2008 MOVE C,-1(P) ; GET BYE POINTER
2009 SUB P,[2,,2] ; FLUSH
2013 AOS -1(TP) ; COUNT ATOMS
2014 TLNE FLAGS,NOQBIT ; SKIP IF NOT "PRINC"
2015 JRST NOLEX4 ; NEEDS NO LEXICAL TRAILERS
2016 MOVEI A,"\ ; GET QUOTER
2017 TLNN E,2 ; SKIP IF NEEDED
2019 SOS -1(TP) ; DONT COUNT BECAUSE OF SLASH
2021 PATDO1: MOVEI E,(E) ; CLEAR LH(E)
2022 PUSH P,C ; SAVE BYTER
2023 PUSH P,E ; ALSO CHAR COUNT
2025 MOVE B,IMQUOTE OBLIST
2027 PUSHJ P,IDVAL ; GET LOCAL/GLOBAL VALUE
2028 POP P,FLAGS ; AND RESTORES FLAGS
2029 MOVE C,(TP) ; GET ATOM BACK
2030 HRRZ C,2(C) ; GET ITS OBLIST
2032 AOJA A,NOOBL1 ; NONE, USE FALSE
2033 CAMG C,VECBOT ; JUMP IF REAL OBLIST
2036 CAME A,$TLIST ; SKIP IF A LIST
2037 CAMN A,$TOBLS ; SKIP IF UNREASONABLE VALUE
2038 JRST CHOBL ; WINS, NOW LOCATE IT
2040 CHROOT: CAME C,ROOT+1 ; IS THIS ROOT?
2041 JRST FNDOBL ; MUST FIND THE PATH NAME
2042 POP P,E ; RESTORE CHAR COUNT
2043 MOVE D,(P) ; AND PARTIAL WORD
2044 EXCH D,-1(P) ; STORE BYTE POINTER AND GET PARTIAL WORD
2045 MOVEI A,"! ; PUT OUT MAGIC
2046 JSP B,DOIDPB ; INTO BUFFER
2052 NOLEX0: SUB P,[2,,2] ; REMOVE COUNTER AND BYTE POINTER
2053 PUSH P,D ; PUSH NEXT WORD IF ANY
2056 NOLEX: MOVE E,(P) ; GET COUNT
2058 NOLEX4: MOVEI E,(E) ; CLOBBER LH(E)
2059 MOVE A,E ; COUNT TO A
2060 SKIPN (P) ; FLUSH 0 WORD
2062 HRRZ C,-1(TP) ; GET # OF ATOMS
2063 SUBI A,(C) ; FIX COUNT
2064 MOVE B,-2(TP) ; GET CHANNEL INTO B
2065 PUSHJ P,RETIF ; MAY NEED C.R.
2066 MOVEI C,-1(E) ; COMPUTE WORDS-1
2067 IDIVI C,5 ; WORDS-1 TO C
2070 SUB D,C ; POINTS TO 1ST WORD OF CHARS
2071 MOVSI C,440700+D ; BYTEPOINTER TO STRING
2072 PUSH TP,$TPDL ; SAVE FROM GC
2075 PATOUT: ILDB A,C ; READ A CHAR
2076 SKIPE A ; IGNORE NULS
2077 PUSHJ P,PITYO ; PRINT IT
2078 MOVE D,(TP) ; RESTORE POINTER
2081 NOLEXD: SUB TP,[2,,2] ; FLUSH TP JUNK
2082 MOVE P,D ; RESTORE P
2087 PENTCH: TLNE FLAGS,NOQBIT ; "PRINC"?
2088 JRST PENTC1 ; YES, AVOID SLASHING
2089 IDIVI A,CHRWD ; GET CHARS TYPE
2091 CAILE B,NONSPC ; SKIP IF NOT SPECIAL
2092 JRST PENTC2 ; SLASH IMMEDIATE
2093 LDB A,[220600,,E] ; GET "STATE"
2094 LDB A,STABYT-1(B) ; GET NEW STATE
2095 DPB A,[220600,,E] ; AND SAVE IT
2096 PENTC3: LDB A,C ; RESTORE CHARACTER
2097 PENTC1: JSP B,DOIDPB
2098 SKIPGE (P) ; SKIP IF DONE
2099 JRST PATOM1 ; CONTINUE
2102 PENTC2: MOVEI A,"\ ; GET CHAR QUOTER
2103 JSP B,DOIDPB ; NEEDED, DO IT
2104 MOVEI A,4 ; PATCH FOR ATOMS ALREADY BACKSLASHED
2107 ; ROUTINE TO PUT ONE CHAR ON STACK BUFFER
2109 DOIDPB: IDPB A,-1(P) ; DEPOSIT
2110 TRNN D,377 ; SKIP IF D FULL
2112 PUSH P,(P) ; MOVE TOP OF STACK UP
2113 MOVEM D,-2(P) ; SAVE WORDS
2119 ; CHECK FOR UNIQUENESS LOOKING INTO PATH
2121 CHOBL: CAME A,$TOBLS ; SINGLE OBLIST?
2122 JRST LSTOBL ; NO, AL LIST THEREOF
2123 CAME B,C ; THE RIGTH ONE?
2124 JRST CHROOT ; NO, CHECK ROOT
2125 JRST NOLEX ; WINNER, NO TRAILERS!
2127 LSTOBL: PUSH TP,A ; SCAN A LIST OF OBLISTS
2134 NXTOB2: INTGO ; LIST LOOP, PREVENT LOSSAGE
2135 SKIPN C,-2(TP) ; SKIP IF NOT DONE
2136 JRST CHROO1 ; EMPTY, CHECK ROOT
2137 MOVE B,1(C) ; GET ONE
2138 CAME B,(TP) ; WINNER?
2139 JRST NXTOBL ; NO KEEP LOOKING
2140 CAMN C,-4(TP) ; SKIP IF NOT FIRST ON LIST
2142 MOVE A,-6(TP) ; GET ATOM BACK
2144 ADD A,[3,,3] ; POINT TO PNAME
2145 PUSH P,0 ; SAVE FROM RLOOKU
2148 AOBJN A,.-2 ; PUSH THE PNAME
2149 PUSH P,D ; AND CHAR COUNT
2150 MOVSI A,TLIST ; TELL RLOOKU WE WIN
2151 MOVE B,-4(TP) ; GET BACK OBLIST LIST
2152 SUB TP,[6,,6] ; FLUSH CRAP
2153 PUSHJ P,RLOOKU ; FIND IT
2155 CAMN B,(TP) ; SKIP IF NON UNIQUE
2156 JRST NOLEX ; UNIQUE , NO TRAILER!!
2157 JRST CHROO2 ; CHECK ROOT
2159 NXTOBL: HRRZ B,@-2(TP) ; STEP THE LIST
2164 FNDOBL: MOVE C,(TP) ; GET ATOM
2171 MOVE D,IMQUOTE OBLIST
2175 NOOBL1: POP P,E ; RESTORE CHAR COUNT
2176 MOVE D,(P) ; GET PARTIAL WORD
2177 EXCH D,-1(P) ; AND BYTE POINTER
2178 CAME A,$TATOM ; IF NOT ATOM, USE FALSE
2180 MOVEM B,(TP) ; STORE IN ATOM SLOT
2182 JSP B,DOIDPB ; WRITE IT OUT
2186 JRST PATOM0 ; AND LOOP
2188 NOOBL: MOVE C,[440700,,[ASCIZ /!-#FALSE ()/]]
2195 NOLEX1: SUB TP,[6,,6] ; FLUSH STUFF
2198 CHROO1: SUB TP,[6,,6]
2199 CHROO2: MOVE C,(TP) ; GET ATOM
2200 HRRZ C,2(C) ; AND ITS OBLIST
2205 BADPNM: ERRUUO EQUOTE BAD-PNAME
2208 \f; STATE TABLES FOR \ OF FIRST CHAR
2209 ; Each word is a state and each 4 bit byte tells where to go based on the input
2210 ; type. The types are defined in READER >. The input type selects a byte pointer
2211 ; into the table which is indexed by the current state.
2215 STATS: 431192440 ; INITIAL STATE (0)
2216 434444444 ; HERE ON INIT +- (1)
2217 222222242 ; HERE ON INIT . (2)
2218 434445642 ; HERE ON INIT DIGIT (3)
2219 444444444 ; HERE IF NO \ NEEDE (4)
2220 454444642 ; HERE ON DDDD. (5)
2221 487744444 ; HERE ON E (6)
2222 484444444 ; HERE ON E+- (7)
2223 484444442 ; HERE ON E+-DDD (8)
2224 494444444+<1_28.> ; HERE ON * (HACK IS TO GET A 10 IN THERE) (9)
2225 494494444+<1_28.>+<2_16.> ; HERE ON *DDDDD (10)
2230 STABYT: 400400,,STATS(A) ; LETTERS
2231 340400,,STATS(A) ; NUMBERS
2232 300400,,STATS(A) ; PLUS SIGN +
2233 240400,,STATS(A) ; MINUS SIGN -
2234 200400,,STATS(A) ; asterick *
2235 140400,,STATS(A) ; PERIOD .
2236 100400,,STATS(A) ; LETTER E
2237 040400,,STATS(A) ; extra
2238 000400,,STATS(A) ; HERE ON RAP UP
2240 \f;PRINT LONG CHARACTER STRINGS.
2243 TLZ FLAGS,ATMBIT ;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
2244 MOVE D,[AOS E] ;GET INSTRUCTION TO COUNT CHARACTERS
2249 PUSH TP,-3(TP) ;GIVE PCHRST SOME GOODIES TO PLAY WITH
2250 PUSHJ P,PCHRST ;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
2251 SUB TP,[4,,4] ;FLUSH MUNGED GOODIES
2252 MOVE A,E ;PUT COUNT RETURNED IN REG A
2253 TLNN FLAGS,NOQBIT ;SKIP (NO QUOTES) IF IN PRINC (BIT ON)
2254 ADDI A,2 ;PLUS TWO FOR QUOTES
2255 MOVE B,-2(TP) ; GET CHANNEL INTO B
2256 PUSHJ P,RETIF ;START NEW LINE IF NO SPACE
2257 TLNE FLAGS,NOQBIT ;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
2258 JRST PCHS01 ;OTHERWISE, DON'T QUOTE
2259 MOVEI A,"" ;PRINT A DOUBLE QUOTE
2263 PCHS01: MOVE D,[PUSHJ P,PITYO] ;OUTPUT INSTRUCTION
2264 PUSHJ P,PCHRST ;TYPE STRING
2266 TLNE FLAGS,NOQBIT ;AGAIN, SKIP IF DOUBLE-QUOTING TO BE DONE
2267 JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
2268 MOVEI A,"" ;PRINT A DOUBLE QUOTE
2269 MOVE B,-2(TP) ; GET CHANNEL INTO B
2274 ;INTERNAL ROUTINE USED TO COUNT OR OUTPUT CHARACTER STRINGS.
2275 ;THE APPROPRIATE ESCAPING CONVENTIONS ARE USED AS DETERMINED BY THE FLAG BITS.
2276 PCHRST: PUSH P,A ;SAVE REGS
2281 PCHR02: INTGO ; IN CASE VERY LONG STRING
2282 HRRZ C,-1(TP) ;GET COUNT
2283 SOJL C,PCSOUT ; DONE?
2285 ILDB A,(TP) ; GET CHAR
2287 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
2288 JRST PCSPRT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
2289 CAIN A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
2290 JRST ESCPRN ;ESCAPE THE ESCAPE CHARACTER
2291 CAIN A,"" ;SKIP IF NOT A DOUBLE QUOTE
2292 JRST ESCPRN ;OTHERWISE, ESCAPE THE """
2293 IDIVI A,CHRWD ;CODE HERE FINDS CHARACTER TYPE
2295 CAIG B,NONSPC ;SKIP IF NOT A NUMBER/LETTER
2296 JRST PCSPRT ;OTHERWISE, PRINT IT
2297 TLNN FLAGS,ATMBIT ;SKIP IF PRINTING AN ATOM-NAME (UNQUOTED)
2298 JRST PCSPRT ;OTHERWISE, NO OTHER CHARS TO ESCAPE
2300 ESCPRN: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
2302 MOVE B,-2(TP) ; GET CHANNEL INTO B
2306 PCSPRT: LDB A,(TP) ;GET THE CHARACTER AGAIN
2308 MOVE B,-2(TP) ; GET CHANNEL INTO B
2309 TLNE FLAGS,NOQBIT ; SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
2310 TLO FLAGS,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
2312 TLZ FLAGS,CNTLPC ; SWITCH OFF ^P MODE
2314 JRST PCHR02 ;LOOP THROUGH STRING
2317 POP P,C ;RESTORE REGS & RETURN
2324 ; PRINT AN ARBITRARY BYTE STRING
2326 PBYTE: PUSH TP,-3(TP)
2331 LDB B,[300600,,-2(TP)]
2339 HRRZ A,-3(TP) ; CHAR COUNT
2343 ILDB B,-2(TP) ; GET A BYTE
2359 ;PRINT AN ARGUMENT LIST
2360 ;CHECK FOR TIME ERRORS
2362 PARGS: MOVEI B,-1(TP) ;POINT TO ARGS POINTER
2363 PUSHJ P,CHARGS ;AND CHECK THEM
2364 JRST PVEC ; CHEAT TEMPORARILY
2369 PFRAME: MOVEI B,-1(TP) ;POINT TO FRAME POINTER
2371 HRRZ B,(TP) ;POINT TO FRAME ITSELF
2372 HRRZ B,FSAV(B) ;GET POINTER TO SUBROUTINE
2374 SKIPA B,@-1(B) ; SUBRS AND FSUBRS
2375 MOVE B,3(B) ; FOR RSUBRS
2377 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2379 PUSHJ P,IPRINT ;PRINT FUNCTION NAME
2380 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2383 PPVP: MOVE B,(TP) ; PROCESS TO B
2387 MOVE B,PROCID+1(B) ;GET ID
2388 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2391 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2394 ; HERE TO PRINT LOCATIVES
2396 LOCPT1: HRRZ A,-1(TP)
2398 LOCPT: MOVEI B,-1(TP) ; VALIDITY CHECK
2405 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2408 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2412 MOVE B,-2(TP) ; GET CHANNEL
2424 MOVE B,-2(TP) ; MOVE IN CHANNEL
2433 MOVE B,-2(TP) ; MOVE IN CHANNEL
2441 MOVE B,-2(TP) ; MOVE IN CHANNEL
2447 MOVE B,-2(TP) ; GET CHANNEL
2459 MOVE B,-2(TP) ; MOVE IN CHANNEL
2463 ADD B,GLOTOP+1 ; GET TO REAL ATOM
2469 MOVE B,-2(TP) ; MOVE IN CHANNEL
2477 MOVE B,-2(TP) ; MOVE IN CHANNEL
2482 \f;PRINT UNIFORM VECTORS.
2484 PUVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
2485 MOVEI A,2 ; ROOM FOR ! AND SQ BRACK?
2487 MOVEI A,"! ;TYPE AN ! AND OPEN SQUARE BRACKET
2492 MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
2493 TLNN C,777777 ;SKIP ONLY IF COUNT IS NOT ZERO
2494 JRST NULVEC ;ELSE, VECTOR IS EMPTY
2496 HLRE A,C ;GET NEG COUNT
2497 MOVEI D,(C) ;COPY POINTER
2498 SUB D,A ;POINT TO DOPE WORD
2499 HLLZ A,(D) ;GET TYPE
2500 PUSH P,A ;AND SAVE IT
2502 PUVE02: MOVE A,(P) ;PUT TYPE CODE IN REG A
2503 MOVE B,(C) ;PUT DATUM INTO REG B
2504 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2506 PUSHJ P,IPRINT ;TYPE IT
2507 SUB TP,[2,,2] ; POP CHANNEL OF STACK
2508 MOVE C,(TP) ;GET AOBJN POINTER
2509 AOBJP C,NULVE1 ;JUMP IF COUNT IS ZERO
2510 MOVEM C,(TP) ;PUT POINTER BACK ONTO STACK
2512 MOVE B,-2(TP) ; GET CHANNEL INTO B
2515 JRST PUVE02 ;LOOP THROUGH VECTOR
2517 NULVE1: SUB P,[1,,1] ;REMOVE STACK CRAP
2518 NULVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
2519 MOVEI A,"! ;TYPE CLOSE BRACKET
2525 \f;PRINT A GENERALIZED VECTOR
2527 PVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
2528 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR [
2529 MOVEI A,"[ ;PRINT A LEFT-BRACKET
2532 MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
2533 TLNN C,777777 ;SKIP IF POINTER-COUNT IS NON-ZERO
2534 JRST PVCEND ;ELSE, FINISHED WITH VECTOR
2535 PVCR01: MOVE A,(C) ;PUT FIRST WORD OF NEXT ELEMENT INTO REG A
2536 MOVE B,1(C) ;SECOND WORD OF LIST INTO REG B
2537 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2539 PUSHJ P,IPRINT ;PRINT THAT ELEMENT
2540 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2542 MOVE C,(TP) ;GET AOBJN POINTER FROM TP-STACK
2543 AOBJP C,PVCEND ;POSITIVE HERE SERIOUS ERROR! (THOUGH NOT PDL)
2544 AOBJN C,.+2 ;SKIP AND CONTINUE LOOP IF COUNT NOT ZERO
2545 JRST PVCEND ;ELSE, FINISHED WITH VECTOR
2546 MOVEM C,(TP) ;PUT INCREMENTED POINTER BACK ON TP-STACK
2548 MOVE B,-2(TP) ; GET CHANNEL INTO B
2550 MOVE C,(TP) ; RESTORE REGISTER C
2551 JRST PVCR01 ;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR
2553 PVCEND: MOVE B,-2(TP) ; GET CHANNEL INTO B
2554 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR ]
2555 MOVEI A,"] ; PRINT A RIGHT-BRACKET
2561 PLIST: MOVE B,-2(TP) ; GET CHANNEL INTO B
2562 PUSHJ P,RETIF1 ;NEW LINE IF NO SPACE LEFT FOR "("
2563 MOVEI A,"( ;TYPE AN OPEN PAREN
2565 PUSHJ P,LSTPRT ;PRINT THE INSIDES
2566 MOVE B,-2(TP) ; RESTORE CHANNEL TO B
2567 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
2568 MOVEI A,") ;TYPE A CLOSE PAREN
2572 PSEG: TLOA FLAGS,SEGBIT ;PRINT A SEGMENT (& SKIP)
2574 PFORM: TLZ FLAGS,SEGBIT ;PRINT AN ELEMENT
2577 JUMPE C,PLMNT1 ;IF THE CALL IS EMPTY GO AWAY
2584 CAMN B,IMQUOTE QUOTE
2586 JUMPE D,PLMNT1 ;NEITHER, LEAVE
2590 JUMPE C,PLMNT1 ;NIL BODY?
2592 ;ITS VALUE OF AN ATOM
2596 JUMPN C,PLMNT1 ;IF TERE ARE EXTRA ARGS GO AWAY
2598 PUSH P,D ;PUSH THE CHAR
2601 TLNN FLAGS,SEGBIT ;SKIP (CONTINUE) IF THIS IS A SEGMENT
2602 JRST PLMNT4 ;ELSE DON'T PRINT THE "."
2605 MOVE B,-4(TP) ; GET CHANNEL INTO B
2606 MOVEI A,2 ; ROOM FOR ! AND . OR ,
2611 PLMNT4: MOVE B,-4(TP) ; GET CHANNEL INTO B
2613 POP P,A ;RESTORE CHAR
2617 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2620 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2624 PLMNT1: TLNN FLAGS,SEGBIT ;SKIP IF THIS IS A SEGMENT
2625 JRST PLMNT5 ;ELSE DON'T TYPE THE "!"
2628 MOVE B,-2(TP) ; GET CHANNEL INTO B
2629 MOVEI A,2 ; ROOM FOR ! AND <
2634 PLMNT5: MOVE B,-2(TP) ; GET CHANNEL FOR B
2640 MOVE B,-2(TP) ; GET CHANNEL INTO B
2641 TLNE FLAGS,SEGBIT ;SKIP IF NOT SEGEMNT
2649 LSTPRT: SKIPN C,(TP)
2651 HLLZ A,(C) ;GET NEXT ELEMENT
2653 HRRZ C,(C) ;CHOP THE LIST
2655 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2657 PUSHJ P,IPRINT ;PRINT THE LAST ELEMENT
2658 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2661 PLIST1: MOVEM C,(TP)
2662 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2664 PUSHJ P,IPRINT ;PRINT THE NEXT ELEMENT
2665 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2666 MOVE B,-2(TP) ; GET CHANNEL INTO B
2670 PNEXT: POP P,FLAGS ;RESTORE PREVIOUS FLAG BITS
2671 SUB TP,[2,,2] ;REMOVE INPUT ELEMENT FROM TP-STACK
2672 POP P,C ;RESTORE REG C
2686 JUMPGE B,FNFFL ;ERROR IF IT CANNOT BE OPENED