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
427 SKIPE (C) ; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH
433 CPCHST: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE
\r
435 PUSH P,C ; STRING CALLER ROUTINE
440 SKIPE (C) ; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH
449 SKIPL E,AB ; COPY ARG POINTER
450 JRST TFA ;NO ARGS IS AN ERROR
451 ADD E,[2,,2] ;POINT AT POSSIBLE CHANNEL
453 AGET1: MOVE E,AB ; GET COPY OF AB
456 COMPT: PUSH TP,$TFIX ;LEAVE ROOM ON STACK FOR ONE CHANNEL
458 JUMPGE E,DEFCHN ;IF NO CHANNEL ARGUMENT, USE CURRENT BINDING
459 CAMG E,[-2,,0] ;IF MORE ARGS THEN ERROR
461 MOVE A,(E) ;GET CHANNEL
465 DEFCHN: MOVE B,IMQUOTE OUTCHAN
467 PUSH P,FLAGS ;SAVE FLAGS
468 PUSHJ P,IDVAL ;GET VALUE OF OUTCHAN
471 NEWCHN: TLNE FLAGS,TERBIT ; SEE IF TERPRI
473 MOVE C,(AB) ; GET ARGS
477 ; HERE IF USING A PRINTB CHANNEL
479 BPRINT: TLO FLAGS,BINBIT
480 SKIPE BUFSTR(B) ; ANY OUTPUT BUFFER?
483 ; HERE TO GENERATE A STRING BUFFER
486 MOVEI A,BUFLNT ; GET BUFFER LENGTH
487 PUSHJ P,IBLOCK ; MAKE A BUFFER
488 MOVSI 0,TWORD+.VECT. ; CLOBBER U TYPE
490 SETOM (B) ; -1 THE BUFFER
497 MOVEM B,BUFSTR(C) ; STOR BYTE POINTER
498 MOVE 0,[TCHSTR,,BUFLNT*5]
505 IPRINT: PUSH P,C ; SAVE C
506 PUSH P,FLAGS ;SAVE PREVIOUS FLAGS
507 PUSH TP,A ;SAVE ARGUMENT ON TP-STACK
510 INTGO ;ALLOW INTERRUPTS HERE
512 GETYP A,-1(TP) ;GET THE TYPE CODE OF THE ITEM
513 SKIPE C,PRNTYP+1 ; USER TYPE TABLE?
515 NORMAL: CAILE A,NUMPRI ;PRIMITIVE?
516 JRST PUNK ;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
517 HRRO A,PRTYPE(A) ;YES-DISPATCH
520 ; HERE FOR USER PRINT DISPATCH
522 PRDISP: ADDI C,(A) ; POINT TO SLOT
524 SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP
525 JRST PRDIS1 ; APPLY EVALUATOR
526 SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP
530 PRDIS1: SUB C,PRNTYP+1
532 PUSH TP,[TATOM,,-1] ; PUSH ON OUTCHAN FOR SPECBIND
533 PUSH TP,IMQUOTE OUTCHAN
540 ADD C,PRNTYP+1 ; RESTORE C
541 PUSH TP,(C) ; PUSH ARGS FOR APPLY
545 MCALL 2,APPLY ; APPLY HACKER TO OBJECT
547 PUSHJ P,SSPEC1 ;UNBIND OUTCHAN
548 SUB TP,[6,,6] ; POP OFF STACK
551 ; PRINT DISPATCH TABLE
553 IF2,PUNKS==400000,,PUNK
555 DISTBL PRTYPE,PUNKS,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
556 [TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
557 [TARGS,PARGS],[TUVEC,PUVEC],[TDEFER,PDEFER],[TINTH,PINTH],[THAND,PHAND]
558 [TILLEG,ILLCH],[TRSUBR,PRSUBR],[TENTER,PENTRY],[TPCODE,PPCODE],[TTYPEW,PTYPEW]
559 [TTYPEC,PTYPEC],[TTMPLT,TMPRNT],[TLOCD,LOCPT1],[TLOCR,LOCRPT],[TQRSUB,PRSUBR]
560 [TQENT,PENTRY],[TSATC,PSATC],[TBYTE,PBYTE]
563 PUNK: MOVE C,TYPVEC+1 ; GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
564 GETYP B,-1(TP) ; GET THE TYPE CODE INTO REG B
565 LSH B,1 ; MULTIPLY BY TWO
566 HRL B,B ; DUPLICATE IT IN THE LEFT HALF
567 ADD C,B ; INCREMENT THE AOBJN-POINTER
568 JUMPGE C,PRERR ; IF POSITIVE, INDEX > VECTOR SIZE
570 MOVE B,-2(TP) ; MOVE IN CHANNEL
571 PUSH TP,$TVEC ; SAVE ALLTYPES VECTOR
573 PUSHJ P,RETIF1 ; START NEW LINE IF NO ROOM
574 MOVEI A,"# ; INDICATE TYPE-NAME FOLLOWS
578 MOVE A,(C) ; GET TYPE-ATOM
580 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
582 PUSHJ P,IPRINT ; PRINT ATOM-NAME
583 SUB TP,[2,,2] ; POP STACK
584 MOVE B,-2(TP) ; MOVE IN CHANNEL
585 PUSHJ P,SPACEQ ; MAYBE SPACE
586 MOVE B,(B) ; RESET THE REAL ARGUMENT POINTER
587 HRRZ A,(C) ; GET THE STORAGE-TYPE
589 CAILE A,NUMSAT ; SKIP IF TEMPLATE
590 JRST TMPRNT ; PRINT TEMPLATED DATA STRUCTURE
591 HRRO A,UKTBL(A) ; USE DISPATCH TABLE ON STORAGE TYPE
594 DISTBS UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC],[SATOM,PATOM]
595 [SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP],[SLOCID,LOCPT],[SLOCA,LOCP]
596 [SLOCV,LOCP],[SLOCU,LOCP],[SLOCS,LOCP],[SLOCL,LOCP],[SLOCN,LOCP],[SASOC,ASSPNT]
597 [SLOCT,LOCP],[SLOCB,LOCP],[SBYTE,PBYTE],[SOFFS,POFFSE]]
600 ILLCH: MOVEI B,-1(TP)
603 \f; PRINT INTERRUPT HANDLER
605 PHAND: MOVE B,-2(TP) ; MOVE CHANNEL INTO B
608 PUSHJ P,PITYO ; SAY "FUNNY TYPE"
610 MOVE B,MQUOTE HANDLER
611 PUSH TP,-3(TP) ; PUSH CHANNEL ON FOR IPRINT
613 PUSHJ P,IPRINT ; PRINT THE TYPE NAME
614 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
615 MOVE B,-2(TP) ; GET CHANNEL
616 PUSHJ P,SPACEQ ; SPACE MAYBE
617 SKIPN B,(TP) ; GET ARG BACK
619 MOVE A,INTFCN(B) ; PRINT FUNCTION FOR NOW
621 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
623 PUSHJ P,IPRINT ; PRINT THE INT FUNCTION
624 SUB TP,[2,,2] ; POP CHANNEL OFF
629 PINTH: MOVE B,-2(TP) ; GET CHANNEL INTO B
633 MOVSI A,TATOM ; AND NAME
634 MOVE B,MQUOTE IHEADER
635 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
638 MOVE B,-4(TP) ; GET CHANNEL INTO B
639 PUSHJ P,SPACEQ ; MAYBE SPACE
640 SKIPN B,-2(TP) ; INT HEADER BACK
642 MOVE A,INAME(B) ; GET NAME
645 PINTH1: SUB TP,[2,,2] ; CLEAN OFF STACK
649 ; PRINT ASSOCIATION BLOCK
651 ASSPNT: MOVEI A,"( ; MAKE IT BE (ITEN INDIC VAL)
652 MOVE B,-2(TP) ; GET CHANNEL INTO B
653 PUSHJ P,PRETIF ; MAKE ROOM AND PRINT
654 SKIPA C,[-3,,0] ; # OF FIELDS
655 ASSLP: PUSHJ P,SPACEQ
656 MOVE D,(TP) ; RESTORE GOODIE
657 ADD D,ASSOFF(C) ; POINT TO FIELD
660 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
662 PUSHJ P,IPRINT ; AND PRINT IT
663 SUB TP,[2,,2] ; POP OFF CHANNEL
664 MOVE B,-2(TP) ; GET CHANNEL
668 MOVE B,-2(TP) ; GET CHANNEL INTO B
669 PUSHJ P,PRETIF ; CLOSE IT
675 \f; PRINT TYPE-C AND TYPE-W
677 PTYPEW: HRRZ A,(TP) ; POSSIBLE RH
691 MOVE B,-4(TP) ; GET CHANNEL INTO B
692 PUSHJ P,RETIF ; ROOM TO START?
699 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
701 PUSHJ P,IPRINT ; AND PRINT IT AS 1ST ELEMENT
702 SUB TP,[2,,2] ; POP OFF CHANNEL
703 MOVE B,-2(TP) ; GET CHANNEL INTO B
704 PUSHJ P,SPACEQ ; MAYBE SPACE
705 MOVE A,-1(P) ; TYPE CODE
707 HRLI A,(A) ; MAKE SURE WINS
709 JUMPL A,PTYPX1 ; JUMP FOR A WINNER
710 ERRUUO EQUOTE BAD-TYPE-CODE
712 PTYPX1: MOVE B,1(A) ; GET TYPE NAME
715 MOVEM A,-1(P) ; AND SAVE IT
717 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
719 PUSHJ P,IPRINT ; OUT IT GOES
720 SUB TP,[2,,2] ; POP OFF CHANNEL
721 MOVE B,-2(TP) ; GET CHANNEL INTO B
722 PUSHJ P,SPACEQ ; MAYBE SPACE
723 MOVE A,-1(P) ; GET SAT BACK
724 MOVE B,IMQUOTE TEMPLATE
727 MOVSI A,TATOM ; AND PRINT IT
728 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
731 SUB TP,[2,,2] ; POP OFF STACK
732 SKIPN B,(P) ; ANY EXTRA CRAP?
735 MOVE B,-2(TP) ; GET CHANNEL INTO B
739 PUSH TP,-3(TP) ; PUSH CHANNELS FOR IPRINT
741 PUSHJ P,IPRINT ; PRINT EXTRA
742 SUB TP,[2,,2] ; POP OFF CHANNEL
745 MOVE B,-2(TP) ; GET CHANNEL INTO B
747 SUB P,[2,,2] ; FLUSH CRUFT
752 ; PRINT PURE CODE POINTER
755 MOVE B,-2(TP) ; GET CHANNEL INTO B
761 MOVSI A,TATOM ; PRINT SUBR CALL
762 MOVE B,MQUOTE PRIMTYPE-C
763 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
766 MOVE B,-4(TP) ; GET CHANNEL INTO B
767 PUSHJ P,SPACEQ ; MAYBE SPACE?
775 TMPPTY: MOVE B,TYPVEC+1
783 ERRUUO EQUOTE BAD-PRIMTYPEC
786 PSATC1: MOVSI A,TATOM
790 MOVE B,-2(TP) ; GET CHANNEL INTO B
791 PUSHJ P,PRETIF ; CLOSE THE FORM
796 MOVE B,-2(TP) ; GET CHANNEL INTO B
802 MOVSI A,TATOM ; PRINT SUBR CALL
804 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
807 MOVE B,-4(TP) ; GET CHANNEL INTO B
808 PUSHJ P,SPACEQ ; MAYBE SPACE?
809 HLRZ A,-2(TP) ; OFFSET TO VECTOR
810 ADD A,PURVEC+1 ; SLOT TO A
811 MOVE A,(A) ; SIXBIT NAME
813 PUSHJ P,6TOCHS ; TO A STRING
816 MOVE B,-4(TP) ; GET CHANNEL INTO B
818 HRRZ B,-2(TP) ; GET OFFSET
821 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
823 MOVE B,-2(TP) ; GET CHANNEL INTO B
824 PUSHJ P,PRETIF ; CLOSE THE FORM
828 \f; PRINT SUB-ENTRY TO RSUBR
830 PENTRY: MOVE B,(TP) ; GET BLOCK
831 GETYP A,(B) ; TYPE OF 1ST ELEMENT
832 CAIE A,TRSUBR ; RSUBR, OK
834 PENT2: MOVEI A,2 ; CHECK ROOM
835 MOVE B,-2(TP) ; GET CHANNEL INTO B
837 MOVEI A,"% ; SETUP READ TIME MACRO
842 MOVE B,IMQUOTE RSUBR-ENTRY
843 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
847 PUSHJ P,SPACEQ ; MAYBE SPACE
848 MOVEI A,"' ; QUOTE TO AVOID EVALING IT
850 MOVEI A,"[ ; OPEN SQUARE BRAKET
859 MOVE B,-4(TP) ; MOVE IN CHANNEL
863 MOVSI A,TATOM ; FOOL EVERYBODY AND SEND OUT ATOM
865 MOVE B,-4(TP) ; PRINT SPACE
866 PENT4: PUSHJ P,SPACEQ
867 MOVE B,-2(TP) ; GET PTR BACK TO VECTOR
868 MOVE A,2(B) ; THE NAME OF THE ENTRY
870 PUSHJ P,IPRINT ; OUT IT GOES
872 CAIL B,-4 ; SEE IF DONE
874 MOVE B,-4(TP) ; PRINT SPACE
876 MOVE B,-2(TP) ; GET POINTER
880 EXPEN: MOVE B,-4(TP) ; GET CHANNEL INTO B
881 MOVEI A,"] ; CLOSE SQUARE BRAKET
883 MOVE B,-4(TP) ; GET CHANNEL INTO B
890 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
891 MOVE B,-2(TP) ; GET CHANNEL INTO B
897 ERRUUO EQUOTE BAD-ENTRY-BLOCK
899 \f; HERE TO PRINT TEMPLATED DATA STRUCTURE
901 TMPRNT: PUSH P,FLAGS ; SAVE FLAGS
902 MOVE A,(TP) ; GET POINTER
903 GETYP A,(A) ; GET SAT
904 PUSH P,A ; AND SAVE IT
905 MOVEI A,"{ ; OPEN SQUIGGLE
906 MOVE B,-2(TP) ; GET CHANNEL INTO B
907 PUSHJ P,PRETIF ; PRINT WITH CHECKING
908 HLRZ A,(TP) ; GET AMOUNT RESTED OFF
910 PUSH P,A ; AND SAVE IT
911 MOVE A,-1(P) ; GET SAT
912 SUBI A,NUMSAT+1 ; FIXIT UP
914 ADD A,TD.LNT+1 ; CHECK FOR WINNAGE
915 JUMPGE A,BADTPL ; COMPLAIN
916 HRRZS C,(TP) ; GET LENGTH
918 SUB B,(P) ; FUDGE FOR RESTS
919 MOVEI B,-1(B) ; FUDGE IT
920 PUSH P,B ; AND SAVE IT
922 TMPRN1: AOS C,-1(P) ; GET ELEMENT OF INTEREST
923 SOSGE (P) ; CHECK FOR ANY LEFT
924 JRST TMPRN2 ; ALL DONE
926 MOVE B,(TP) ; POINTER
928 PUSHJ P,TMPLNT ; GET THE ITEM
929 MOVE FLAGS,-3(P) ; RESTORE FLAGS
930 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
932 PUSHJ P,IPRINT ; PRINT THIS ELEMENT
933 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
934 MOVE B,-2(TP) ; GET CHANNEL INTO B
935 SKIPE (P) ; IF NOT LAST ONE THEN
936 PUSHJ P,SPACEQ ; SEPARATE WITH A SPACE
941 MOVEI A,"} ; CLOSE THIS GUY
946 \f; RSUBR PRINTING ROUTINES. ON PRINTB CHANNELS, WRITES OUT
947 ; COMPACT BINARY. ON PRINT CHANNELS ALL IS ASCII
949 PRSUBR: MOVE A,(TP) ; GET RSUBR IN QUESTION
950 GETYP A,(A) ; CHECK FOR PURE RSUBR
952 JRST PRSBRP ; PRINT IT SPECIAL WAY
954 TLNN FLAGS,BINBIT ; SKIP IF BINARY OUTPUT
958 MOVSI A,TRSUBR ; FIND FIXUPS
960 HLRE D,1(B) ; -LENGTH OF CODE VEC
964 PUSHJ P,IGET ; GO GET THEM
965 JUMPE B,RCANT ; NO FIXUPS, BINARY LOSES
966 PUSH TP,A ; SAVE FIXUP LIST
969 MOVNI A,1 ; USE ^C AS MARKER FOR RSUBR
970 MOVE FLAGS,-1(P) ; RESTORE FLAGS
971 MOVE B,-4(TP) ; GET CHANNEL FOR PITYO
972 PUSHJ P,PITYO ; OUT IT GOES
974 PRSBR1: MOVE B,-4(TP)
975 PUSHJ P,BFCLS1 ; FLUSH OUT CURRENT BUFFER
977 MOVE B,-4(TP) ; CHANNEL BACK
978 MOVN E,(P) ; LENGTH OF CODE
980 HRROI A,(P) ; POINT TO SAME
981 PUSHJ P,DOIOTO ; OUT GOES COUNT
984 MOVEM C,ASTO(PVP) ; FOR IOT INTERRUPTS
985 MOVE A,-2(TP) ; GET POINTER TO CODE
987 PUSHJ P,DOIOTO ; IOT IT OUT
989 ADDI E,1 ; UPDATE ACCESS
992 SETZM ASTO(PVP) ; UNSCREW A
994 ; NOW PRINT OUT NORMAL RSUBR VECTOR
996 MOVE FLAGS,-1(P) ; RESTORE FLAGS
998 MOVE B,-2(TP) ; GET RSUBR VECTOR
999 PUSHJ P,PRBODY ; PRINT ITS BODY
1001 ; HERE TO PRINT BINARY FIXUPS
1003 MOVEI E,0 ; 1ST COMPUTE LENGTH OF FIXUPS
1004 SKIPN A,(TP) ; LIST TO A
1005 JRST PRSBR5 ; EMPTY, DONE
1006 JUMPL A,UFIXES ; JUMP IF FIXUPS IN UVECTOR FORM
1009 PRSBR6: HRRZ A,(A) ; NEXT?
1012 CAIE B,TDEFER ; POSSIBLE STRING
1013 JRST PRSBR7 ; COULD BE ATOM
1014 MOVE B,1(A) ; POSSIBLE STRINGER
1016 CAIE C,TCHSTR ; YES!!!
1017 JRST BADFXU ; LOSING FIXUPS
1018 HRRZ C,(B) ; # OF CHARS TO C
1019 ADDI C,5+5 ; ROUND AND ADD FOR COUNT
1020 IDIVI C,5 ; TO WORDS
1022 JRST FIXLST ; COUNT FOR USE LIST ETC.
1024 PRSBR7: GETYP B,(A) ; GET TYPE
1029 FIXLST: HRRZ A,(A) ; REST IT TO OLD VAL
1035 HRRZ A,(A) ; TO USE LIST
1040 MOVE C,1(A) ; GET LIST
1042 PRSBR8: JUMPE C,PRSBR9
1043 GETYP B,(C) ; TYPE OK?
1047 AOJA D,PRSBR8 ; LOOP
1049 PRSBR9: ADDI D,2 ; ROUND UP
1050 ASH D,-1 ; DIV BY 2 FOR TWO GOODIES PER HWORD
1054 PRSBR5: PUSH P,E ; SAVE LENGTH OF FIXUPS
1055 PUSH TP,$TUVEC ; SLOT FOR BUFFER POINTER
1058 PFIXU1: MOVE B,-6(TP) ; START LOOPING THROUGH CHANNELS
1059 PUSHJ P,BFCLS1 ; FLUSH BUFFER
1060 MOVE B,-6(TP) ; CHANNEL BACK
1061 MOVEI C,BUFSTR-1(B) ; SETUP BUFFER
1062 PUSHJ P,BYTDOP ; FIND D.W.
1066 MOVE E,(P) ; LENGTH OF FIXUPS
1067 SETZB C,D ; FOR EOUT
1069 MOVE C,-2(TP) ; FIXUP LIST
1070 MOVE E,1(C) ; HAVE VERS
1071 PUSHJ P,EOUT ; OUT IT GOES
1073 PFIXU2: HRRZ C,(C) ; FIRST THING
1074 JUMPE C,PFIXU3 ; DONE?
1075 GETYP A,(C) ; STRING OR ATOM
1076 CAIN A,TATOM ; MUST BE STRING
1078 MOVE A,1(C) ; POINT TO POINTER
1081 PUSH P,E ; SAVE REMAINDER
1088 PFXU1A: MOVE A,1(C) ; RESTORE POINTER
1089 HRRZ A,1(A) ; BYTE POINTER
1096 MOVE D,-1(P) ; LAST WORD
1101 MOVE E,(A) ; LAST WORD OF CHARS
1113 PFIXU4: HRRZ E,(C) ; GET CURRENT VAL
1116 PUSHJ P,ATOSQ ; GET SQUOZE
1118 TLO E,400000 ; USE TO DIFFERENTIATE BETWEEN STRING
1122 ; HERE TO WRITE OUT LISTS
1124 PFIXU5: HRRZ C,(C) ; POINT TO CURRENT VALUE
1126 HRRZ C,(C) ; POINT TO USES LIST
1127 HRRZ D,1(C) ; GET IT
1130 PFIXU6: TLCE D,400000 ; SKIP FOR RH
1131 HRLZ E,1(D) ; SETUP LH
1134 PUSHJ P,EOUT ; WRITE IT OUT
1136 TRNE D,-1 ; SKIP IF DONE
1139 TRNE E,-1 ; SKIP IF ZERO BYTE EXISTS
1143 JRST PFIXU2 ; DO NEXT
1145 PFIXU3: HLRE C,(TP) ; -AMNT LEFT IN BUFFER
1146 MOVN D,C ; PLUS SAME
1147 ADDI C,BUFLNT ; WORDS USED TO C
1148 JUMPE C,PFIXU7 ; NONE USED, LEAVE
1149 MOVSS C ; START SETTING UP BTB
1150 MOVN A,C ; ALSO FINAL IOT POINTER
1151 HRR C,(TP) ; PDL POINTER PART OF BTB
1153 HRLI D,400000+C ; CONTINUE SETTING UP BTB (400000 IS FOR MULTI
1155 POP C,@D ; MOVE 'EM DOWN
1158 HRRI A,@D ; OUTPUT POINTER
1164 PUSHJ P,DOIOTO ; WRITE IT OUT
1168 PFIXU7: SUB TP,[4,,4]
1172 ; ROUTINE TO OUTPUT CONTENTS OF E
1174 EOUT: MOVE B,-6(TP) ; CHANNEL
1176 MOVE A,(TP) ; BUFFER POINTER
1178 AOBJP A,.+3 ; COUNT AND GO
1182 SUBI A,BUFLNT ; SET UP IOT POINTER
1184 MOVEM A,(TP) ; RESET SAVED POINTER
1191 PUSHJ P,DOIOTO ; OUT IT GOES
1198 ; HERE IF UVECOR FORM OF FIXUPS
1200 UFIXES: PUSH TP,$TUVEC
1203 UFIX1: MOVE B,-6(TP) ; GET SAME
1204 PUSHJ P,BFCLS1 ; FLUSH OUT BUFFER
1205 HLRE C,(TP) ; GET LENGTH
1208 HRROI A,(P) ; READY TO ZAP IT OUT
1209 PUSHJ P,DOIOTO ; ZAP!
1211 HLRE C,(TP) ; LENGTH BACK
1214 ADDM C,ACCESS(B) ; UPDATE ACCESS
1215 MOVE A,(TP) ; NOW THE UVECTOR
1226 RCANT: ERRUUO EQUOTE RSUBR-LACKS-FIXUPS
1229 BADFXU: ERRUUO EQUOTE BAD-FIXUPS
1231 PRBODY: TDZA C,C ; FLAG SAYING FLUSH CODE
1232 PRBOD1: MOVEI C,1 ; PRINT CODE ALSO
1237 MOVEI A,"[ ; START VECTOR TEXT
1238 MOVE B,-6(TP) ; GET CHANNEL FOR PITYO
1241 MOVE B,(TP) ; RSUBR BACK
1242 JUMPN C,PRSON ; GO START PRINTING
1243 MOVEI A,"0 ; PLACE SAVER FOR CODE VEC
1244 MOVE B,-6(TP) ; GET CHANNEL FOR PITYO
1247 PRSBR2: MOVE B,[2,,2] ; BUMP VECTOR
1249 JUMPGE B,PRSBR3 ; NO SPACE IF LAST
1250 MOVE B,-6(TP) ; GET CHANNEL FOR SPACEQ
1252 SKIPA B,(TP) ; GET BACK POINTER
1253 PRSON: JUMPGE B,PRSBR3
1254 GETYP 0,(B) ; SEE IF RSUBR POINTED TO
1257 JRST .+5 ; JUMP IF RSUBR ENTRY
1260 CAIE 0,TRSUBR ; YES!
1261 JRST PRSB10 ; COULD BE SUBR/FSUBR
1262 MOVE C,1(B) ; GET RSUBR
1263 PUSH P,0 ; SAVE TYPE FOUND
1264 GETYP 0,2(C) ; SEE IF ATOM
1267 MOVE B,3(C) ; GET ATOM NAME
1268 PUSHJ P,IGVAL ; GO LOOK
1269 MOVE C,(TP) ; ORIG RSUBR BACK
1271 POP P,0 ; DESIRED TYPE
1272 CAIE 0,(A) ; SAME TYPE
1275 MOVE 0,3(D) ; NAME OF RSUBR IN QUESTION
1284 PRSBR4: MOVE FLAGS,(P) ; RESTORE FLAGS
1287 MOVE B,1(B) ; PRINT IT
1288 PRS101: PUSH TP,-7(TP) ; PUSH CHANNEL FOR IPRINT
1291 SUB TP,[2,,2] ; POP OFF CHANNEL
1292 MOVE B,-2(TP) ; MOVE IN CHANNEL
1295 PRSB10: CAIE 0,TSUBR ; SUBR?
1299 MOVE C,1(B) ; GET LOCN OF SUBR OR FSUBR
1300 MOVE B,@-1(C) ; NAME OF IT
1301 MOVSI A,TATOM ; AND TYPE
1306 PUSHJ P,PRETIF ; CLOSE IT UP
1307 SUB TP,[2,,2] ; FLUSH CRAP
1312 \f; HERE TO PRINT PURE RSUBRS
1314 PRSBRP: MOVEI A,2 ; WILL "%<" FIT?
1315 MOVE B,-2(TP) ; GET CHANNEL FOR RETIF
1322 MOVE B,IMQUOTE RSUBR
1323 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1325 PUSHJ P,IPRINT ; PRINT IT OUT
1326 SUB TP,[2,,2] ; POP OFF CHANNEL
1328 PUSHJ P,SPACEQ ; MAYBE SPACE
1329 MOVEI A,"' ; QUOTE THE VECCTOR
1331 MOVE B,(TP) ; GET RSUBR BODY BACK
1332 PUSH TP,$TFIX ; STUFF THE STACK
1334 PUSHJ P,PRBOD1 ; PRINT AND UNLINK
1335 SUB TP,[2,,2] ; GET JUNK OFF STACK
1336 MOVE B,-2(TP) ; GET CHANNEL FOR RETIF
1341 ; HERE TO PRINT ASCII RSUBRS
1343 ARSUBR: PUSH P,FLAGS ; SAVE FROM GET
1347 MOVE D,IMQUOTE RSUBR
1348 PUSHJ P,IGET ; TRY TO GET FIXUPS
1350 JUMPE B,PUNK ; NO FIXUPS LOSE
1352 CAIE A,TLIST ; ARE FIXUPS A LIST?
1353 JRST PUNK ; NO, AGAIN LOSE
1355 PUSH TP,B ; SAVE FIXUPS
1359 PUSH P,[440700,,[ASCIZ /%<FIXUP!-RSUBRS!-/]]
1361 AL1: ILDB A,(P) ; GET CHAR
1370 PUSHJ P,PRETIF ; QUOTE TO AVOID ADDITIONAL EVAL
1371 MOVE B,-2(TP) ; PRINT ACTUAL KLUDGE
1373 MOVE B,-4(TP) ; GET CHANNEL FOR SPACEQ
1375 MOVEI A,"' ; DONT EVAL FIXUPS EITHER
1379 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1382 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
1383 MOVE B,-2(TP) ; GET CHANNEL INTO B
1388 ; HERE TO DO OFFSETS: %<OFFSET N '<VECTOR FIX FLOAT>>
1398 MOVE B,MQUOTE OFFSET
1403 MOVE B,-2(TP) ; RESTORE CHANNEL
1406 HRRE B,(TP) ; PICK UPTHE FIX
1411 MOVE B,-2(TP) ; RESTORE CHANNEL
1416 CAIE B,TFORM ; FORMS HAVE TO BE QUOTED
1424 POFFPT: PUSH TP,-3(TP)
1428 MOVE B,-2(TP) ; RESTORE CHANNEL
1433 POFFS2: MOVSI A,TATOM
1437 \f; HERE TO DO LOCATIVES (PRINT CONTENTS THEREOF)
1439 LOCP: PUSH TP,-1(TP)
1442 MCALL 1,IN ; GET ITS CONTENTS FROM "IN"
1444 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1446 PUSHJ P,IPRINT ; PRINT IT
1447 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
1449 \f;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
1451 ;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
1452 PITYO: TLNN FLAGS,FLTBIT
1454 PITYO1: PUSH TP,[TTP,,0] ; PUSH ON TP POINTER
1456 TLNE FLAGS,UNPRSE ;SKIPS UNPRSE NOT SET
1458 AOS FLTSIZ ;FLATSIZE DOESN'T PRINT
1459 ;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
1460 SOSGE FLTMAX ;UNLESS THE MAXIMUM IS EXCEEDED
1462 POP TP,B ; GET CHANNEL BACK
1465 MOVEI E,(B) ; GET POINTER FOR UNBINDING
1467 MOVE P,UPB+8 ; RESTORE P
1468 POP TP,B ; GET BACK TP POINTER
1469 PUSH P,0 ; SAVE FLAGS
1470 MOVE TP,B ; RESTORE TP
1471 MOVEI C,(TB) ; SEE IF TB IS CORRECT
1472 CAIG C,1(TP) ; SKIP IF NEEDS UNWINDING
1474 PITYO3: MOVEI C,(TB)
1477 MOVEI A,PITYO4 ; SET UP PARAMETERS TO BE RESTORED BY FINIS
1483 MOVE TB,D ; SET TB TO ONE FRAME AHEAD
1485 PITYO4: POP P,0 ; RESTORE FLAGS
1486 MOVSI A,TFALSE ;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
1490 PITYO2: MOVE D,TB ; SAVE ONE FRAME AHEAD
1491 HRR TB,OTBSAV(TB) ; RESTORE TB
1496 ;NOTE THAT THE FOLLOWING CODE HAS BUGS IF IT IS PRINTING OUT LONG
1498 ; (NOTE THAT THE ABOVE COMMENT, IF TRUE, SHOULD NOT BE ADMITTED.)
1499 ITYO: PUSH TP,$TCHAN
1501 PUSH P,FLAGS ;SAVE STUFF
1503 PUSH P,A ;SAVE OUTPUT CHARACTER
1506 TLNE FLAGS,UNPRSE ;SKIPS UNPRSE NOT SET
1507 JRST UNPROUT ;IF FROM UNPRSE, STASH IN STRING
1513 CAIE A,^L ;SKIP IF THIS IS A FORM-FEED
1515 SETZM LINPOS(B) ;ZERO THE LINE NUMBER
1518 NOTFF: CAIE A,15 ;SKIP IF IT IS A CR
1520 SETZM CHRPOS(B) ;ZERO THE CHARACTER POSITION
1521 PUSHJ P,AOSACC ; BUMP COUNT
1524 NOTCR: CAIN A,^I ;SKIP IF NOT TAB
1526 CAIE A,10 ; BACK SPACE
1528 SOS CHRPOS(B) ; BACK UP ONE
1530 CAIE A,^J ;SKIP IF LINE FEED
1532 AOS C,LINPOS(B) ;ADD ONE TO THE LINE NUMBER
1533 CAMLE C,PAGLN(B) ;SKIP IF THIS DOESN'T TAKES US PAST PAGE END
1538 INTCHK: HRRZ 0,-2(B) ; GET CHANNELS FLAGS
1539 TRNN 0,C.INTL ; LOSER INTERESTED IN LFS?
1540 POPJ P, ; LEAVE IF NOTHING TO DO
1542 PUSH TP,B ; SAVE CHANNEL
1545 PUSHJ P,GTLPOS ; READ SYSTEMS VERSION OF LINE #
1547 PUSH TP,MQUOTE CHAR,CHAR,INTRUP
1553 POP P,E ; RESTORE POSSIBLE COUNTS
1555 POP TP,B ; RESTORE CHANNEL
1561 AOS CHRPOS(B) ; FOR CONTROL CHARS THAT NEED 2 SPACES
1562 AOS CHRPOS(B) ;ADD TO CHARACTER NUMBER
1564 ITYXT: PUSHJ P,AOSACC ; BUMP ACCESS
1565 ITYXT1: POP P,A ;RESTORE THE ORIGINAL CHARACTER
1567 ITYRET: POP P,C ;RESTORE REGS & RETURN
1569 POP TP,B ; GET CHANNEL BACK
1575 ADDI C,8. ;INCREMENT COUNT BY EIGHT (MOD EIGHT)
1578 MOVEM C,CHRPOS(B) ;REPLACE COUNT
1582 UNPROUT: POP P,A ;GET BACK THE ORIG CHAR
1583 IDPB A,UPB+2 ;DEPOSIT USING BYTE POINTER I PUSHED LONG AGO
1587 AOSACC: TLNN FLAGS,BINBIT
1589 AOS C,ACCESS-1(B) ; COUNT CHARS IN WORD
1596 NRMACC: AOS ACCESS(B)
1600 TLNE FLAGS,FLTBIT+BINBIT
1601 JRST PITYO ; JUST OUTPUT THE SPACE
1602 PUSH P,[1] ; PRINT SPACE IF NOT END OF LINE
1609 TLNE FLAGS,FLTBIT+BINBIT
1610 JRST SPOPJ ; IF WE ARE IN FLATSIZE THEN ESCAPE
1611 RETIF2: PUSH P,FLAGS
1614 RETCH1: ADD A,CHRPOS(B) ;ADD THE CHARACTER POSITION
1615 SKIPN CHRPOS(B) ; IF JUST RESET, DONT DO IT AGAIN
1617 CAMG A,LINLN(B) ;SKIP IF GREATER THAN LINE LENGTH
1620 MOVEI A,^M ;FORCE A CARRIAGE RETURN
1623 PUSHJ P,AOSACC ; BUMP CHAR COUNT
1624 MOVEI A,^J ;AND FORCE A LINE FEED
1625 PUSHJ P,INTCHK ; CHECK FOR ^J INTERRUPTS
1627 PUSHJ P,AOSACC ; BUMP CHAR COUNT
1629 CAMG A,PAGLN(B) ;AT THE END OF THE PAGE ?
1631 ; MOVEI A,^L ;IF SO FORCE A FORM FEED
1633 ; PUSHJ P,AOSACC ; BUMP CHAR COUNT
1642 PRETIF: PUSH P,A ;SAVE CHAR
1647 RETIF3: TLNE FLAGS,FLTBIT ; NOTHING ON FLATSIZE
1651 HRRI FLAGS,2 ; PRETEND ONLY 1 CHANNEL
1655 RETXT1: SKIPN -2(P) ; SKIP IF SPACE HACK
1665 \f;THIS IS CODE TO HANDLE UNKNOWN DATA TYPES.
1666 ;IT PRINTS "*XXXXXX*XXXXXXXXXXXX*", WHERE THE FIRST NUMBER IS THE
1667 ;TYPE CODE IN OCTAL, THE SECOND IS THE VALUE FIELD IN OCTAL.
1668 PRERR: MOVEI A,21. ;CHECK FOR 21. SPACES LEFT ON PRINT LINE
1669 MOVE B,-2(TP) ; GET CHANNEL INTO B
1670 PUSHJ P,RETIF ;INSERT CARRIAGE RETURN IF NOT ENOUGH
1671 MOVEI A,"* ;JUNK TO INDICATE ERROR PRINTOUT IN OCTAL
1672 PUSHJ P,PITYO ;TYPE IT
1674 MOVE E,[000300,,-2(TP)] ;GET POINTER INDEXED OFF TP SO THAT
1675 ;TYPE CODE MAY BE OBTAINED FOR PRINTING.
1676 MOVEI D,6 ;# OF OCTAL DIGITS IN HALF WORD
1677 OCTLP1: ILDB A,E ;GET NEXT 3-BIT BYTE OF TYPE CODE
1678 IORI A,60 ;OR-IN 60 FOR ASCII DIGIT
1679 PUSHJ P,PITYO ;PRINT IT
1680 SOJG D,OCTLP1 ;REPEAT FOR SIX CHARACTERS
1682 PRE01: MOVEI A,"* ;DELIMIT TYPE CODE FROM VALUE FIELD
1685 HRLZI E,(410300,,(TP)) ;BYTE POINTER TO SECOND WORD
1687 MOVEI D,12. ;# OF OCTAL DIGITS IN A WORD
1688 OCTLP2: LDB A,E ;GET 3 BITS
1689 IORI A,60 ;CONVERT TO ASCII
1690 PUSHJ P,PITYO ;PRINT IT
1691 IBP E ;INCREMENT POINTER TO NEXT BYTE
1692 SOJG D,OCTLP2 ;REPEAT FOR 12. CHARS
1694 MOVEI A,"* ;DELIMIT END OF ERROR TYPEOUT
1695 PUSHJ P,PITYO ;REPRINT IT
1697 JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
1699 POCTAL: MOVEI A,14. ;RETURN TO NEW LINE IF 14. SPACES NOT LEFT
1700 MOVE B,-2(TP) ; GET CHANNEL INTO B
1702 JRST PRE01 ;PRINT VALUE AS "*XXXXXXXXXXXX*"
1704 \f;PRINT BINARY INTEGERS IN DECIMAL.
1706 PFIX: MOVM E,(TP) ; GET # (MAFNITUDE)
1707 JUMPL E,POCTAL ; IF ABS VAL IS NEG, MUST BE SETZ
1710 PFIX1: MOVE B,-2(TP) ; GET CHANNEL INTO B
1711 PFIX2: MOVE D,UPB+6 ; IF UNPARSE, THIS IS RADIX
1712 TLNE FLAGS,UNPRSE+FLTBIT ;SKIPS IF NOT FROM UNPARSE OR FLATSIZE
1714 MOVE D,RADX(B) ; GET OUTPUT RADIX
1715 PFIXU: CAIG D,1 ; DONT ALLOW FUNNY RADIX
1716 MOVEI D,10. ; IF IN DOUBT USE 10.
1718 MOVEI A,1 ; START A COUNTER
1719 SKIPGE B,(TP) ; CHECK SIGN
1720 MOVEI A,2 ; NEG, NEED CHAR FOR SIGN
1722 IDIV B,D ; START COUNTING
1726 MOVE B,-2(TP) ; CHANNEL TO B
1727 TLNN FLAGS,FLTBIT+BINBIT
1728 PUSHJ P,RETIF3 ; CHECK FOR C.R.
1729 MOVE B,-2(TP) ; RESTORE CHANNEL
1730 MOVEI A,"- ; GET SIGN
1731 SKIPGE (TP) ; SKIP IF NOT NEEDED
1733 MOVM C,(TP) ; GET MAGNITUDE OF #
1734 MOVE B,-2(TP) ; RESTORE CHANNEL
1735 POP P,E ; RESTORE RADIX
1736 PUSHJ P,FIXTYO ; WRITE OUT THE #
1738 SUB P,[1,,1] ; FLUSH P STUFF
1742 PUSH P,D ; SAVE REMAINDER
1745 POP P,A ; START GETTING #'S BACK
1747 MOVE B,-2(TP) ; CHANNEL BACK
1750 \f;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
1752 PFLOAT: SKIPN A,(TP) ; SKIP IF NUMBER IS NON-ZERO
1753 ; SPECIAL HACK FOR ZERO)
1754 JRST PFLT0 ; HACK THAT ZERO
1755 MOVM E,A ; CHECK FOR NORMALIZED
1756 TLNN E,400 ; NORMALIZED
1758 MOVE E,[SETZ FLOATB] ;ADDRESS OF FLOATING POINT CONVERSION ROUTINE
1759 MOVE D,[6,,6] ;# WORDS TO GET FROM STACK
1761 PNUMB: HRLI A,1(P) ; LH(A) TO CONTAIN ADDRESS OF RETURN AREA
1763 HRR A,TP ; RH(A) TO CONTAIN ADDRESS OF DATA ITEM
1764 HLRZ B,A ; SAVE RETURN AREA ADDRESS IN REG B
1765 ADD P,D ; ADD # WORDS OF RETURN AREA TO BOTH HALVES OF
1767 JUMPGE P,PDLERR ; PLUS OR ZERO STACK POINTER IS OVERFLOW
1768 PDLWIN: PUSHJ P,(E) ; CALL ROUTINE WHOSE ADDRESS IS IN REG E
1770 MOVE C,(B) ; GET COUNT 0F # CHARS RETURNED
1772 HRR B,P ; GET PSTACK POINTER AND PRODUCE RELATAVIZED
1774 HRLS A ; ADD TO AOBJN
1775 ADD A,P ; PRODUCE PDL POINTER
1776 MOVE B,-2(TP) ; GET CHANNEL INTO B
1777 PUSH TP,$TPDL ; PUSH PDL POINTER
1779 MOVE A,C ; MAKE SURE THAT # WILL FIT ON PRINT LINE
1780 PUSH P,D ; WATCH THAT MCALL
1781 PUSHJ P,RETIF ; START NEW LINE IF IT WON'T
1783 POP TP,B ; RESTORE B
1784 SUB TP,[1,,1] ; CLEAN OFF STACK
1786 HRLI B,000700 ;MAKE REG B INTO BYTE POINTER TO FIRST CHAR
1788 PNUM01: ILDB A,B ; GET NEXT BYTE
1790 MOVE B,-2(TP) ; GET CHANNEL INTO B
1791 PUSHJ P,PITYO ; PRINT IT
1793 SOJG C,PNUM01 ; DECREMENT CHAR COUNT: LOOP IF NON-ZERO
1795 SUB P,D ;SUBTRACT # WORDS USED ON STACK FOR RETURN
1796 JRST PNEXT ;STORE REGS & POP UP ONE LEVEL TO CALLER
1799 PFLT0: MOVEI A,9. ; WIDTH OF 0.0000000
1800 MOVEI C,9. ; SEE ABOVE
1801 MOVEI D,0 ; WE'RE GONNA TEST D SOON...SO WILL DO RIGHT THING
1802 MOVEI B,[ASCII /0.0000000/]
1803 SOJA B,PFLT1 ; PT TO 1 BELOW CONST, THEN REJOIN CODE
1808 PDLERR: SUB P,D ;REST STACK POINTER
1812 ; FLOATING POINT PRINTER STOLEN FROM DDT
1830 MOVSI 0,440700 ; BUILD BYTEPNTR
1831 HLRZ J,A ; POINT TO BUFFER
1834 MOVE A,(A) ; GET NUMBER
1836 SETZM (J) ; Clear counter
1849 ; at this point we enter code abstracted from DDT.
1866 FP3: SETZB C,TEM1 ; CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
1883 POPJ P, ; ONE return from OFLT here
1902 FP7: SKIPE A ; AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
1919 CHRO: AOS (J) ; COUNT CHAR
1920 IDPB A,0 ; STUFF CHAR
1940 FCP: CAMLE A, FT0(C)
1950 ;PRINT SHORT (ONE WORD) CHARACTER STRINGS
1952 PCHRS: MOVEI A,3 ;MAX # CHARS PLUS 2 (LESS ESCAPES)
1953 MOVE B,-2(TP) ; GET CHANNEL INTO B
1954 TLNE FLAGS,NOQBIT ;SKIP IF QUOTES WILL BE USED
1955 MOVEI A,1 ;ELSE, JUST ONE CHARACTER POSSIBLE
1956 PUSHJ P,RETIF ;NEW LINE IF INSUFFICIENT SPACE
1957 TLNE FLAGS,NOQBIT ;DON'T QUOTE IF IN PRINC MODE
1959 MOVEI A,"! ;TYPE A EXCL
1961 MOVEI A,"\ ;AND A BACK SLASH
1964 PCASIS: MOVE A,(TP) ;GET NEXT BYTE FROM WORD
1965 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
1966 JRST PCPRNT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
1967 CAIE A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
1968 JRST PCPRNT ;ESCAPE THE ESCAPE CHARACTER
1970 ESCPRT: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
1972 PCPRNT: MOVE A,(TP) ;GET THE CHARACTER AGAIN
1973 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
1974 TLO FLAGS,CNTLPC ;SWITCH ON ^P MODE TEMPORARY
1975 PUSHJ P,PITYO ;PRINT IT
1976 TLZ FLAGS,CNTLPC ;SWITCH OFF ^P MODE
1980 \f;PRINT DEFERED (INVISIBLE) ITEMS. (PRINTED AS THE THING POINTED TO)
1982 PDEFER: MOVE A,(B) ;GET FIRST WORD OF ITEM
1983 MOVE B,1(B) ;GET SECOND
1984 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
1986 PUSHJ P,IPRINT ;PRINT IT
1987 SUB TP,[2,,2] ; POP OFF CHANNEL
1991 ; Print an ATOM. TRAILERS are added if the atom is not in the current
1992 ; lexical path. Also escaping of charactets is performed to allow READ
1995 PATOM: PUSH P,[440700,,D] ; PUSH BYE POINTER TO FINAL STRING
1996 SETZB D,E ; SET CHARCOUNT AD DESTINATION TO 0
1997 HLLZS -1(TP) ; RH OF TATOM,, WILL COUNT ATOMS IN PATH
1999 PATOM0: PUSH TP,$TPDL ; SAVE CURRENT STAKC FOR \ LOGIC
2001 LDB A,[301400,,(P)] ; GET BYTE PTR POSITION
2002 DPB A,[301400,,E] ; SAVE IN E
2003 MOVE C,-2(TP) ; GET ATOM POINTER
2004 ADD C,[3,,3] ; POINT TO PNAME
2005 JUMPGE C,BADPNM ; NO PNAME, ERROR
2006 HLRE A,C ; -# WORDS TO A
2007 PUSH P,A ; PUSH THAT FOR "AOSE"
2008 MOVEI A,177 ; PUT RUBOUT WHERE \ MIGHT GO
2010 HRLI C,440700 ; BUILD BYTE POINTER
2011 ILDB A,C ; GET FIRST BYTE
2012 JUMPE A,BADPNM ; NULL PNAME, ERROR
2014 PATOM1: ILDB A,C ; GET A CHAR
2015 JUMPE A,PATDON ; END OF PNAME?
2016 TLNN C,760000 ; SKIP IF NOT WORD BOUNDARY
2017 AOS (P) ; COUNT WORD
2018 JRST PENTCH ; ENTER THE CHAR INTO OUTPUT
2020 PATDON: LDB A,[220600,,E] ; GET "STATE"
2021 LDB A,STABYT+NONSPC+1 ; SIMULATE "END" CHARACTER
2022 DPB A,[220600,,E] ; AND STORE
2023 MOVE B,E ; SETUP BYTE POINTER TO 1ST CHAR
2026 SUB TP,[2,,2] ; FLUSH SAVED PDL
2027 MOVE C,-1(P) ; GET BYE POINTER
2028 SUB P,[2,,2] ; FLUSH
2032 AOS -1(TP) ; COUNT ATOMS
2033 TLNE FLAGS,NOQBIT ; SKIP IF NOT "PRINC"
2034 JRST NOLEX4 ; NEEDS NO LEXICAL TRAILERS
2035 MOVEI A,"\ ; GET QUOTER
2036 TLNN E,2 ; SKIP IF NEEDED
2038 SOS -1(TP) ; DONT COUNT BECAUSE OF SLASH
2040 PATDO1: MOVEI E,(E) ; CLEAR LH(E)
2041 PUSH P,C ; SAVE BYTER
2042 PUSH P,E ; ALSO CHAR COUNT
2044 MOVE B,IMQUOTE OBLIST
2046 PUSHJ P,IDVAL ; GET LOCAL/GLOBAL VALUE
2047 POP P,FLAGS ; AND RESTORES FLAGS
2048 MOVE C,(TP) ; GET ATOM BACK
2049 HRRZ C,2(C) ; GET ITS OBLIST
2051 AOJA A,NOOBL1 ; NONE, USE FALSE
2052 CAMG C,VECBOT ; JUMP IF REAL OBLIST
2055 CAME A,$TLIST ; SKIP IF A LIST
2056 CAMN A,$TOBLS ; SKIP IF UNREASONABLE VALUE
2057 JRST CHOBL ; WINS, NOW LOCATE IT
2059 CHROOT: CAME C,ROOT+1 ; IS THIS ROOT?
2060 JRST FNDOBL ; MUST FIND THE PATH NAME
2061 POP P,E ; RESTORE CHAR COUNT
2062 MOVE D,(P) ; AND PARTIAL WORD
2063 EXCH D,-1(P) ; STORE BYTE POINTER AND GET PARTIAL WORD
2064 MOVEI A,"! ; PUT OUT MAGIC
2065 JSP B,DOIDPB ; INTO BUFFER
2071 NOLEX0: SUB P,[2,,2] ; REMOVE COUNTER AND BYTE POINTER
2072 PUSH P,D ; PUSH NEXT WORD IF ANY
2075 NOLEX: MOVE E,(P) ; GET COUNT
2077 NOLEX4: MOVEI E,(E) ; CLOBBER LH(E)
2078 MOVE A,E ; COUNT TO A
2079 SKIPN (P) ; FLUSH 0 WORD
2081 HRRZ C,-1(TP) ; GET # OF ATOMS
2082 SUBI A,(C) ; FIX COUNT
2083 MOVE B,-2(TP) ; GET CHANNEL INTO B
2084 PUSHJ P,RETIF ; MAY NEED C.R.
2085 MOVEI C,-1(E) ; COMPUTE WORDS-1
2086 IDIVI C,5 ; WORDS-1 TO C
2089 SUB D,C ; POINTS TO 1ST WORD OF CHARS
2090 MOVSI C,440700+D ; BYTEPOINTER TO STRING
2091 PUSH TP,$TPDL ; SAVE FROM GC
2094 PATOUT: ILDB A,C ; READ A CHAR
2095 SKIPE A ; IGNORE NULS
2096 PUSHJ P,PITYO ; PRINT IT
2097 MOVE D,(TP) ; RESTORE POINTER
2100 NOLEXD: SUB TP,[2,,2] ; FLUSH TP JUNK
2101 MOVE P,D ; RESTORE P
2106 PENTCH: TLNE FLAGS,NOQBIT ; "PRINC"?
2107 JRST PENTC1 ; YES, AVOID SLASHING
2108 IDIVI A,CHRWD ; GET CHARS TYPE
2110 CAILE B,NONSPC ; SKIP IF NOT SPECIAL
2111 JRST PENTC2 ; SLASH IMMEDIATE
2112 LDB A,[220600,,E] ; GET "STATE"
2113 LDB A,STABYT-1(B) ; GET NEW STATE
2114 DPB A,[220600,,E] ; AND SAVE IT
2115 PENTC3: LDB A,C ; RESTORE CHARACTER
2116 PENTC1: JSP B,DOIDPB
2117 SKIPGE (P) ; SKIP IF DONE
2118 JRST PATOM1 ; CONTINUE
2121 PENTC2: MOVEI A,"\ ; GET CHAR QUOTER
2122 JSP B,DOIDPB ; NEEDED, DO IT
2123 MOVEI A,4 ; PATCH FOR ATOMS ALREADY BACKSLASHED
2126 ; ROUTINE TO PUT ONE CHAR ON STACK BUFFER
2128 DOIDPB: IDPB A,-1(P) ; DEPOSIT
2129 TRNN D,377 ; SKIP IF D FULL
2131 PUSH P,(P) ; MOVE TOP OF STACK UP
2132 MOVEM D,-2(P) ; SAVE WORDS
2138 ; CHECK FOR UNIQUENESS LOOKING INTO PATH
2140 CHOBL: CAME A,$TOBLS ; SINGLE OBLIST?
2141 JRST LSTOBL ; NO, AL LIST THEREOF
2142 CAME B,C ; THE RIGTH ONE?
2143 JRST CHROOT ; NO, CHECK ROOT
2144 JRST NOLEX ; WINNER, NO TRAILERS!
2146 LSTOBL: PUSH TP,A ; SCAN A LIST OF OBLISTS
2153 NXTOB2: INTGO ; LIST LOOP, PREVENT LOSSAGE
2154 SKIPN C,-2(TP) ; SKIP IF NOT DONE
2155 JRST CHROO1 ; EMPTY, CHECK ROOT
2156 MOVE B,1(C) ; GET ONE
2157 CAME B,(TP) ; WINNER?
2158 JRST NXTOBL ; NO KEEP LOOKING
2159 CAMN C,-4(TP) ; SKIP IF NOT FIRST ON LIST
2161 MOVE A,-6(TP) ; GET ATOM BACK
2163 ADD A,[3,,3] ; POINT TO PNAME
2164 PUSH P,0 ; SAVE FROM RLOOKU
2167 AOBJN A,.-2 ; PUSH THE PNAME
2168 PUSH P,D ; AND CHAR COUNT
2169 MOVSI A,TLIST ; TELL RLOOKU WE WIN
2170 MOVE B,-4(TP) ; GET BACK OBLIST LIST
2171 SUB TP,[6,,6] ; FLUSH CRAP
2172 PUSHJ P,RLOOKU ; FIND IT
2174 CAMN B,(TP) ; SKIP IF NON UNIQUE
2175 JRST NOLEX ; UNIQUE , NO TRAILER!!
2176 JRST CHROO2 ; CHECK ROOT
2178 NXTOBL: HRRZ B,@-2(TP) ; STEP THE LIST
2183 FNDOBL: MOVE C,(TP) ; GET ATOM
2190 MOVE D,IMQUOTE OBLIST
2194 NOOBL1: POP P,E ; RESTORE CHAR COUNT
2195 MOVE D,(P) ; GET PARTIAL WORD
2196 EXCH D,-1(P) ; AND BYTE POINTER
2197 CAME A,$TATOM ; IF NOT ATOM, USE FALSE
2199 MOVEM B,(TP) ; STORE IN ATOM SLOT
2201 JSP B,DOIDPB ; WRITE IT OUT
2205 JRST PATOM0 ; AND LOOP
2207 NOOBL: MOVE C,[440700,,[ASCIZ /!-#FALSE ()/]]
2214 NOLEX1: SUB TP,[6,,6] ; FLUSH STUFF
2217 CHROO1: SUB TP,[6,,6]
2218 CHROO2: MOVE C,(TP) ; GET ATOM
2219 HRRZ C,2(C) ; AND ITS OBLIST
2224 BADPNM: ERRUUO EQUOTE BAD-PNAME
2227 \f; STATE TABLES FOR \ OF FIRST CHAR
2228 ; Each word is a state and each 4 bit byte tells where to go based on the input
2229 ; type. The types are defined in READER >. The input type selects a byte pointer
2230 ; into the table which is indexed by the current state.
2234 STATS: 431192440 ; INITIAL STATE (0)
2235 434444444 ; HERE ON INIT +- (1)
2236 222222242 ; HERE ON INIT . (2)
2237 434445642 ; HERE ON INIT DIGIT (3)
2238 444444444 ; HERE IF NO \ NEEDE (4)
2239 454444642 ; HERE ON DDDD. (5)
2240 487744444 ; HERE ON E (6)
2241 484444444 ; HERE ON E+- (7)
2242 484444442 ; HERE ON E+-DDD (8)
2243 494444444+<1_28.> ; HERE ON * (HACK IS TO GET A 10 IN THERE) (9)
2244 494494444+<1_28.>+<2_16.> ; HERE ON *DDDDD (10)
2249 STABYT: 400400,,STATS(A) ; LETTERS
2250 340400,,STATS(A) ; NUMBERS
2251 300400,,STATS(A) ; PLUS SIGN +
2252 240400,,STATS(A) ; MINUS SIGN -
2253 200400,,STATS(A) ; asterick *
2254 140400,,STATS(A) ; PERIOD .
2255 100400,,STATS(A) ; LETTER E
2256 040400,,STATS(A) ; extra
2257 000400,,STATS(A) ; HERE ON RAP UP
2259 \f;PRINT LONG CHARACTER STRINGS.
2262 TLZ FLAGS,ATMBIT ;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
2263 MOVE D,[AOS E] ;GET INSTRUCTION TO COUNT CHARACTERS
2268 PUSH TP,-3(TP) ;GIVE PCHRST SOME GOODIES TO PLAY WITH
2269 PUSHJ P,PCHRST ;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
2270 SUB TP,[4,,4] ;FLUSH MUNGED GOODIES
2271 MOVE A,E ;PUT COUNT RETURNED IN REG A
2272 TLNN FLAGS,NOQBIT ;SKIP (NO QUOTES) IF IN PRINC (BIT ON)
2273 ADDI A,2 ;PLUS TWO FOR QUOTES
2274 MOVE B,-2(TP) ; GET CHANNEL INTO B
2275 PUSHJ P,RETIF ;START NEW LINE IF NO SPACE
2276 TLNE FLAGS,NOQBIT ;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
2277 JRST PCHS01 ;OTHERWISE, DON'T QUOTE
2278 MOVEI A,"" ;PRINT A DOUBLE QUOTE
2282 PCHS01: MOVE D,[PUSHJ P,PITYO] ;OUTPUT INSTRUCTION
2283 PUSHJ P,PCHRST ;TYPE STRING
2285 TLNE FLAGS,NOQBIT ;AGAIN, SKIP IF DOUBLE-QUOTING TO BE DONE
2286 JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
2287 MOVEI A,"" ;PRINT A DOUBLE QUOTE
2288 MOVE B,-2(TP) ; GET CHANNEL INTO B
2293 ;INTERNAL ROUTINE USED TO COUNT OR OUTPUT CHARACTER STRINGS.
2294 ;THE APPROPRIATE ESCAPING CONVENTIONS ARE USED AS DETERMINED BY THE FLAG BITS.
2295 PCHRST: PUSH P,A ;SAVE REGS
2300 PCHR02: INTGO ; IN CASE VERY LONG STRING
2301 HRRZ C,-1(TP) ;GET COUNT
2302 SOJL C,PCSOUT ; DONE?
2304 ILDB A,(TP) ; GET CHAR
2306 TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
2307 JRST PCSPRT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
2308 CAIN A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
2309 JRST ESCPRN ;ESCAPE THE ESCAPE CHARACTER
2310 CAIN A,"" ;SKIP IF NOT A DOUBLE QUOTE
2311 JRST ESCPRN ;OTHERWISE, ESCAPE THE """
2312 IDIVI A,CHRWD ;CODE HERE FINDS CHARACTER TYPE
2314 CAIG B,NONSPC ;SKIP IF NOT A NUMBER/LETTER
2315 JRST PCSPRT ;OTHERWISE, PRINT IT
2316 TLNN FLAGS,ATMBIT ;SKIP IF PRINTING AN ATOM-NAME (UNQUOTED)
2317 JRST PCSPRT ;OTHERWISE, NO OTHER CHARS TO ESCAPE
2319 ESCPRN: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
2321 MOVE B,-2(TP) ; GET CHANNEL INTO B
2325 PCSPRT: LDB A,(TP) ;GET THE CHARACTER AGAIN
2327 MOVE B,-2(TP) ; GET CHANNEL INTO B
2328 TLNE FLAGS,NOQBIT ; SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
2329 TLO FLAGS,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
2331 TLZ FLAGS,CNTLPC ; SWITCH OFF ^P MODE
2333 JRST PCHR02 ;LOOP THROUGH STRING
2336 POP P,C ;RESTORE REGS & RETURN
2343 ; PRINT AN ARBITRARY BYTE STRING
2345 PBYTE: PUSH TP,-3(TP)
2350 LDB B,[300600,,-2(TP)]
2358 HRRZ A,-3(TP) ; CHAR COUNT
2362 ILDB B,-2(TP) ; GET A BYTE
2378 ;PRINT AN ARGUMENT LIST
2379 ;CHECK FOR TIME ERRORS
2381 PARGS: MOVEI B,-1(TP) ;POINT TO ARGS POINTER
2382 PUSHJ P,CHARGS ;AND CHECK THEM
2383 JRST PVEC ; CHEAT TEMPORARILY
2388 PFRAME: MOVEI B,-1(TP) ;POINT TO FRAME POINTER
2390 HRRZ B,(TP) ;POINT TO FRAME ITSELF
2391 HRRZ B,FSAV(B) ;GET POINTER TO SUBROUTINE
2393 SKIPA B,@-1(B) ; SUBRS AND FSUBRS
2394 MOVE B,3(B) ; FOR RSUBRS
2396 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2398 PUSHJ P,IPRINT ;PRINT FUNCTION NAME
2399 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2402 PPVP: MOVE B,(TP) ; PROCESS TO B
2406 MOVE B,PROCID+1(B) ;GET ID
2407 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2410 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2413 ; HERE TO PRINT LOCATIVES
2415 LOCPT1: HRRZ A,-1(TP)
2417 LOCPT: MOVEI B,-1(TP) ; VALIDITY CHECK
2424 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2427 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2431 MOVE B,-2(TP) ; GET CHANNEL
2443 MOVE B,-2(TP) ; MOVE IN CHANNEL
2452 MOVE B,-2(TP) ; MOVE IN CHANNEL
2460 MOVE B,-2(TP) ; MOVE IN CHANNEL
2466 MOVE B,-2(TP) ; GET CHANNEL
2478 MOVE B,-2(TP) ; MOVE IN CHANNEL
2482 ADD B,GLOTOP+1 ; GET TO REAL ATOM
2488 MOVE B,-2(TP) ; MOVE IN CHANNEL
2496 MOVE B,-2(TP) ; MOVE IN CHANNEL
2501 \f;PRINT UNIFORM VECTORS.
2503 PUVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
2504 MOVEI A,2 ; ROOM FOR ! AND SQ BRACK?
2506 MOVEI A,"! ;TYPE AN ! AND OPEN SQUARE BRACKET
2511 MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
2512 TLNN C,777777 ;SKIP ONLY IF COUNT IS NOT ZERO
2513 JRST NULVEC ;ELSE, VECTOR IS EMPTY
2515 HLRE A,C ;GET NEG COUNT
2516 MOVEI D,(C) ;COPY POINTER
2517 SUB D,A ;POINT TO DOPE WORD
2518 HLLZ A,(D) ;GET TYPE
2519 PUSH P,A ;AND SAVE IT
2521 PUVE02: MOVE A,(P) ;PUT TYPE CODE IN REG A
2522 MOVE B,(C) ;PUT DATUM INTO REG B
2523 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2525 PUSHJ P,IPRINT ;TYPE IT
2526 SUB TP,[2,,2] ; POP CHANNEL OF STACK
2527 MOVE C,(TP) ;GET AOBJN POINTER
2528 AOBJP C,NULVE1 ;JUMP IF COUNT IS ZERO
2529 MOVEM C,(TP) ;PUT POINTER BACK ONTO STACK
2531 MOVE B,-2(TP) ; GET CHANNEL INTO B
2534 JRST PUVE02 ;LOOP THROUGH VECTOR
2536 NULVE1: SUB P,[1,,1] ;REMOVE STACK CRAP
2537 NULVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
2538 MOVEI A,"! ;TYPE CLOSE BRACKET
2544 \f;PRINT A GENERALIZED VECTOR
2546 PVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
2547 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR [
2548 MOVEI A,"[ ;PRINT A LEFT-BRACKET
2551 MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
2552 TLNN C,777777 ;SKIP IF POINTER-COUNT IS NON-ZERO
2553 JRST PVCEND ;ELSE, FINISHED WITH VECTOR
2554 PVCR01: MOVE A,(C) ;PUT FIRST WORD OF NEXT ELEMENT INTO REG A
2555 MOVE B,1(C) ;SECOND WORD OF LIST INTO REG B
2556 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2558 PUSHJ P,IPRINT ;PRINT THAT ELEMENT
2559 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2561 MOVE C,(TP) ;GET AOBJN POINTER FROM TP-STACK
2562 AOBJP C,PVCEND ;POSITIVE HERE SERIOUS ERROR! (THOUGH NOT PDL)
2563 AOBJN C,.+2 ;SKIP AND CONTINUE LOOP IF COUNT NOT ZERO
2564 JRST PVCEND ;ELSE, FINISHED WITH VECTOR
2565 MOVEM C,(TP) ;PUT INCREMENTED POINTER BACK ON TP-STACK
2567 MOVE B,-2(TP) ; GET CHANNEL INTO B
2569 MOVE C,(TP) ; RESTORE REGISTER C
2570 JRST PVCR01 ;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR
2572 PVCEND: MOVE B,-2(TP) ; GET CHANNEL INTO B
2573 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR ]
2574 MOVEI A,"] ; PRINT A RIGHT-BRACKET
2580 PLIST: MOVE B,-2(TP) ; GET CHANNEL INTO B
2581 PUSHJ P,RETIF1 ;NEW LINE IF NO SPACE LEFT FOR "("
2582 MOVEI A,"( ;TYPE AN OPEN PAREN
2584 PUSHJ P,LSTPRT ;PRINT THE INSIDES
2585 MOVE B,-2(TP) ; RESTORE CHANNEL TO B
2586 PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
2587 MOVEI A,") ;TYPE A CLOSE PAREN
2591 PSEG: TLOA FLAGS,SEGBIT ;PRINT A SEGMENT (& SKIP)
2593 PFORM: TLZ FLAGS,SEGBIT ;PRINT AN ELEMENT
2596 JUMPE C,PLMNT1 ;IF THE CALL IS EMPTY GO AWAY
2603 CAMN B,IMQUOTE QUOTE
2605 JUMPE D,PLMNT1 ;NEITHER, LEAVE
2609 JUMPE C,PLMNT1 ;NIL BODY?
2611 ;ITS VALUE OF AN ATOM
2615 JUMPN C,PLMNT1 ;IF TERE ARE EXTRA ARGS GO AWAY
2617 PUSH P,D ;PUSH THE CHAR
2620 TLNN FLAGS,SEGBIT ;SKIP (CONTINUE) IF THIS IS A SEGMENT
2621 JRST PLMNT4 ;ELSE DON'T PRINT THE "."
2624 MOVE B,-4(TP) ; GET CHANNEL INTO B
2625 MOVEI A,2 ; ROOM FOR ! AND . OR ,
2630 PLMNT4: MOVE B,-4(TP) ; GET CHANNEL INTO B
2632 POP P,A ;RESTORE CHAR
2636 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2639 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2643 PLMNT1: TLNN FLAGS,SEGBIT ;SKIP IF THIS IS A SEGMENT
2644 JRST PLMNT5 ;ELSE DON'T TYPE THE "!"
2647 MOVE B,-2(TP) ; GET CHANNEL INTO B
2648 MOVEI A,2 ; ROOM FOR ! AND <
2653 PLMNT5: MOVE B,-2(TP) ; GET CHANNEL FOR B
2659 MOVE B,-2(TP) ; GET CHANNEL INTO B
2660 TLNE FLAGS,SEGBIT ;SKIP IF NOT SEGEMNT
2668 LSTPRT: SKIPN C,(TP)
2670 HLLZ A,(C) ;GET NEXT ELEMENT
2672 HRRZ C,(C) ;CHOP THE LIST
2674 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2676 PUSHJ P,IPRINT ;PRINT THE LAST ELEMENT
2677 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2680 PLIST1: MOVEM C,(TP)
2681 PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
2683 PUSHJ P,IPRINT ;PRINT THE NEXT ELEMENT
2684 SUB TP,[2,,2] ; POP CHANNEL OFF STACK
2685 MOVE B,-2(TP) ; GET CHANNEL INTO B
2689 PNEXT: POP P,FLAGS ;RESTORE PREVIOUS FLAG BITS
2690 SUB TP,[2,,2] ;REMOVE INPUT ELEMENT FROM TP-STACK
2691 POP P,C ;RESTORE REG C
2705 JUMPGE B,FNFFL ;ERROR IF IT CANNOT BE OPENED