--- /dev/null
+TITLE PRINTER ROUTINE FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT DSK:MUDDLE >
+
+.GLOBAL IPNAME,MTYO,RLOOKU,RADX,INAME,INTFCN,LINLN,DOIOTO,BFCLS1,ATOSQ,IGVAL
+.GLOBAL BYTPNT,OPNCHN,CHRWRD,IDVAL,CHARGS,CHFRM,CHLOCI,PRNTYP,PRTYPE,IBLOCK,WXCT
+.GLOBAL VECBOT,VAL,ITEM,INDIC,IOINS,DIRECT,TYPVEC,CHRPOS,LINPOS,ACCESS,PAGLN,ROOT,PROCID
+.GLOBAL BADCHN,WRONGD,CHNCLS,IGET,FNFFL,ILLCHO,BUFSTR,BYTDOP,6TOCHS,PURVEC,STBL,RXCT
+.GLOBAL TMPLNT,TD.LNT,BADTPL,MPOPJ,SSPEC1,GLOTOP,GTLPOS,SPSTOR,PVSTOR
+.GLOBAL CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR
+.GLOBAL CIFLTZ,CITERP,CIUPRS,CPCH,CPCH1,CICRLF,NONSPC
+
+BUFLNT==100 ; BUFFER LENGTH IN WORDS
+
+FLAGS==0 ;REGISTER USED TO STORE FLAGS
+CARRET==15 ;CARRIAGE RETURN CHARACTER
+ESCHAR=="\ ;ESCAPE CHARACTER
+SPACE==40 ;SPACE CHARACTER
+ATMBIT==200000 ;BIT SWITCH FOR ATOM-NAME PRINT
+NOQBIT==020000 ;SWITCH FOR NO ESCAPING OF OUTPUT (PRINC)
+SEGBIT==010000 ;SWITCH TO INDICATE PRINTING A SEGMENT
+SPCBIT==004000 ;SWITCH TO INDICATE "PRINT" CALL (PUT A SPACE AFTER)
+FLTBIT==002000 ;SWITCH TO INDICATE "FLATSIZE" CALL
+HSHBIT==001000 ;SWITCH TO INDICATE "PHASH" CALL
+TERBIT==000400 ;SWITCH TO INDICATE "TERPRI" CALL
+UNPRSE==000200 ;SWITCH TO INDICATE "UNPARSE" CALL
+ASCBIT==000100 ;SWITCH TO INDICATE USING A "PRINT" CHANNEL
+BINBIT==000040 ;SWITCH TO INDICATE USING A "PRINTB" CHANNEL
+CNTLPC==000020 ;SWITCH TO INDICATE USING ^P CODE IOT
+PJBIT==400000
+C.BUF==1
+C.PRIN==2
+C.BIN==4
+C.OPN==10
+C.READ==40
+
+
+\fMFUNCTION FLATSIZE,SUBR
+ DEFINE FLTMAX
+ 4(B) TERMIN
+ DEFINE FLTSIZ
+ 2(B)TERMIN
+;FLATSIZE TAKES TWO OR THREE ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
+;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS FALSE
+;THE THIRD (OPTIONAL) ARGUMENT IS A RADIX
+ ENTRY
+ CAMG AB,[-2,,0] ;CHECK NUMBER OF ARGS
+ CAMG AB,[-6,,0]
+ JRST WNA
+ PUSH P,3(AB)
+
+ GETYP A,2(AB)
+ CAIE A,TFIX
+ JRST WTYP2 ;SECOND ARG NOT FIX THEN LOSE
+\r CAMG AB,[-4,,0] ;SEE IF THERE IS A RADIX ARGUMENT
+ JRST .+3 ; RADIX SUPPLIED
+ PUSHJ P,GTRADX ; GET THE RADIX FROM OUTCHAN
+ JRST FLTGO
+ GETYP A,4(AB) ;CHECK TO SEE THAT RADIX IS FIX
+ CAIE A,TFIX
+ JRST WTYP ;ERROR THIRD ARGUMENT WRONG TYPE
+ MOVE C,5(AB)
+ PUSHJ P,GETARG ; GET ARGS INTO A AND B
+FLTGO: POP P,D ; RESTORE FLATSIZE MAXIMUM
+ PUSHJ P,CIFLTZ
+ JFCL
+ JRST FINIS
+
+
+
+MFUNCTION UNPARSE,SUBR
+ DEFINE UPB
+ 0(B) TERMIN
+
+ ENTRY
+
+ JUMPGE AB,TFA
+ MOVE E,TP ;SAVE TP POINTER
+
+
+
+;TURN ON FLTBIT TO AVOID PRINTING LOSSAGE
+;TURN ON UNPRSE TO CAUSE CHARS TO BE STASHED
+ CAMG AB,[-2,,0] ;SKIP IF RADIX SUPPLIED
+ JRST .+3
+ PUSHJ P,GTRADX ;GET THE RADIX FROM OUTCHAN
+ JRST UNPRGO
+ CAMGE AB,[-5,,0] ;CHECK FOR TOO MANY
+ JRST TMA
+ GETYP 0,2(AB)
+ CAIE 0,TFIX ;SEE IF RADIX IS FIXED
+ JRST WTYP2
+ MOVE C,3(AB) ;GET RADIX\r
+ PUSHJ P,GETARG ;GET ARGS INTO A AND B
+UNPRGO: PUSHJ P,CIUPRS
+ JRST FINIS
+ JRST FINIS
+
+
+GTRADX: MOVE B,IMQUOTE OUTCHAN
+ PUSH P,0 ;SAVE FLAGS
+ PUSHJ P,IDVAL ;GET VALUE FOR OUTCHAN
+ POP P,0
+ GETYP A,A ;CHECK TYPE OF CHANNEL
+ CAIE A,TCHAN
+ JRST FUNCH1-1 ;IT IS A TP-POINTER
+ MOVE C,RADX(B) ;GET RADIX FROM OUTCHAN
+ JRST FUNCH1
+ MOVE C,(B)+6 ;GET RADIX FROM STACK
+
+FUNCH1: CAIG C,1 ;CHECK FOR STRANGE RADIX
+ MOVEI C,10. ;DEFAULT IF THIS IS THE CASE
+GETARG: MOVE A,(AB)
+ MOVE B,1(AB)
+ POPJ P,
+
+
+IMFUNCTION PRINT,SUBR
+ ENTRY
+ PUSHJ P,AGET ; GET ARGS
+ PUSHJ P,CIPRIN
+ JRST FINIS
+
+MFUNCTION PRINC,SUBR
+ ENTRY
+ PUSHJ P,AGET ; GET ARGS
+ PUSHJ P,CIPRNC
+ JRST FINIS
+
+MFUNCTION PRIN1,SUBR
+ ENTRY
+ PUSHJ P,AGET
+ PUSHJ P,CIPRN1
+ JRST FINIS
+
+
+MFUNCTION CRLF,SUBR
+ ENTRY
+ PUSHJ P,AGET1
+ PUSHJ P,CICRLF
+ JRST FINIS
+
+MFUNCTION TERPRI,SUBR
+ ENTRY
+ PUSHJ P,AGET1
+ PUSHJ P,CITERP
+ JRST FINIS
+
+\f
+CICRLF: SKIPA E,.
+CITERP: MOVEI E,0
+ SUBM M,(P)
+ MOVSI 0,TERBIT+SPCBIT ; SET UP FLAGS
+ PUSH P,E
+ PUSHJ P,TESTR ; TEST FOR GOOD CHANNEL
+ MOVEI A,CARRET ; MOVE IN CARRIAGE-RETURN
+ PUSHJ P,PITYO ; PRINT IT OUT
+ MOVEI A,12 ; LINE-FEED
+ PUSHJ P,PITYO
+ POP P,0
+ JUMPN 0,.+4
+ MOVSI A,TFALSE ; RETURN A FALSE
+ MOVEI B,0
+ JRST MPOPJ ; RETURN
+
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST MPOPJ
+
+TESTR: GETYP E,A
+ CAIN E,TCHAN ; CHANNEL?
+ JRST TESTR1 ; OK?
+ CAIE E,TTP
+ JRST BADCHN
+ HLRZS 0
+ IOR 0,A ; RESTORE FLAGS
+ HRLZS 0
+ POPJ P,
+TESTR1: HRRZ E,-2(B) ; GET IN FLAGS FROM CHANNEL
+ SKIPN IOINS(B)
+ PUSHJ P,OPENIT
+ TRNN E,C.OPN ; SKIP IF OPEN
+ JRST CHNCLS
+ TRC E,C.PRIN+C.OPN ; CHECK TO SEE THAT CHANNEL IS GOOD
+ TRNE E,C.PRIN+C.OPN
+ JRST BADCHN ; ITS A LOSER
+ TRNE E,C.BIN
+ JRST PSHNDL ; DON'T HANDLE BINARY
+ TLO ASCBIT ; ITS ASCII
+ POPJ P, ; ITS A WINNER
+
+PSHNDL: PUSH TP,C ; SAVE ARGS
+ PUSH TP,D
+ PUSH TP,A ; PUSH CHANNEL ONTO STACK
+ PUSH TP,B
+ PUSHJ P,BPRINT ; CHECK BUFFER
+ POP TP,B
+ POP TP,A
+ POP TP,D
+ POP TP,C
+ POPJ P,
+
+
+\f;CIUPRS NEEDS A RADIX IN C AND A TYPE-OBJECT PAIR IN A,B
+
+CIUPRS: SUBM M,(P) ; MODIFY M-POINTER
+ MOVE E,TP ; SAVE TP-POINTER
+ PUSH TP,[0] ; SLOT FOR FIRST STRING COPY
+ PUSH TP,[0]
+ PUSH TP,[0] ; AND SECOND STRING
+ PUSH TP,[0]
+ PUSH TP,A ; SAVE OBJECTS
+ PUSH TP,B
+ PUSH TP,$TTP ; SAVE TP POINTER
+ PUSH TP,E
+ PUSH P,C
+ MOVE D,[377777,,-1] ; MOVE IN MAXIMUM NUMBER FOR FLATSIZE
+ PUSHJ P,CIFLTZ ; FIND LENGTH OF STRING
+ FATAL UNPARSE BLEW IT
+ MOVEI A,4(B)
+ PUSH P,B
+ IDIVI A,5
+ PUSHJ P,IBLOCK ; GET A BLOCK
+ POP P,A
+ HRLI A,TCHSTR
+ HRLI B,010700
+ SUBI B,1
+ POP TP,E ; RESTORE TP-POINTER
+ SUB TP,[1,,1] ;GET RID OF TYPE WORD
+ MOVEM A,1(E) ; SAVE RESULTS
+ MOVEM A,3(E)
+ MOVEM B,2(E)
+ MOVEM B,4(E)
+ POP TP,B ; RESTORE THE WORLD
+ POP TP,A
+ POP P,C
+ MOVSI 0,FLTBIT+UNPRSE ; SET UP FLAGS
+ PUSHJ P,CUSET
+ JRST MPOPJ ; RETURN
+
+
+
+; FOR CIFLTZ C CONTAINS THE RADIX, D THE MAXIMUM NUMBER OF CHARACTERS,
+; A,B THE TYPE-OBJECT PAIR
+
+CIFLTZ: SUBM M,(P)
+ MOVE E,TP ; SAVE POINTER
+ PUSH TP,$TFIX ; PUSH ON FLATSIZE COUNT
+ PUSH TP,[0]
+ PUSH TP,$TFIX ; PUSH ON FLATSIZE MAXIMUM
+ PUSH TP,D
+ MOVSI 0,FLTBIT ; MOVE ON FLATSIZE FLAG
+ PUSHJ P,CUSET ; CONTINUE
+ JRST MPOPJ
+ SOS (P) ; SKIP RETURN
+ JRST MPOPJ ; RETURN
+
+; CUSET IS THE ROUTINE USED BY FLATSIZE AND UNPARSE TO DO THE PUSHING,POPING AND CALLING
+; NEEDED TO GET A RESULT.
+
+CUSET: PUSH TP,$TFIX ; PUSH ON RADIX
+ PUSH TP,C
+ PUSH TP,$TPDL
+ PUSH TP,P ; PUSH ON RETURN POINTER IN CASE FLATSIZE GETS A FALSE
+ PUSH TP,A ; SAVE OBJECTS
+ PUSH TP,B
+ MOVSI C,TTP ; CONSTRUCT TP-POINTER
+ HLR C,FLAGS ; SAVE FLAGS IN TP-POINTER
+ MOVE D,E
+ PUSH TP,C ; PUSH ON CHANNEL
+ PUSH TP,D
+ PUSHJ P,IPRINT ; GO TO INTERNAL PRINTER
+ POP TP,B ; GET IN TP POINTER
+ MOVE TP,B ; RESTORE POINTER
+ TLNN FLAGS,UNPRSE ; SEE IF UNPARSE CALL
+ JRST FLTGEN ; ITS A FLATSIZE
+ MOVE A,UPB+3 ; RETURN STRING
+ MOVE B,UPB+4
+ POPJ P, ; DONE
+FLTGEN: MOVE A,FLTSIZ-1 ; GET IN COUNT
+ MOVE B,FLTSIZ
+ AOS (P)
+ POPJ P, ; EXIT
+
+\f
+; CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR ALL ASSUME
+; THAT C,D CONTAIN THE OBJECT AND A AND B CONTAIN THE CHANNEL
+
+CIPRIN: SUBM M,(P)
+ MOVSI 0,SPCBIT ; SET UP FLAGS
+ PUSHJ P,TPRT ; PRINT INITIALIZATION
+ PUSHJ P,IPRINT
+ JRST TPRTE ; EXIT
+
+CIPRN1: SUBM M,(P)
+ MOVEI FLAGS,0 ; SET UP FLAGS
+ PUSHJ P,TPR1 ; INITIALIZATION
+ PUSHJ P,IPRINT ; PRINT IT OUT
+ JRST TPR1E ; EXIT
+
+CIPRNC: SUBM M,(P)
+ MOVSI FLAGS,NOQBIT ; SET UP FLAGS
+ PUSHJ P,TPR1 ; INITIALIZATION
+ PUSHJ P,IPRINT
+ JRST TPR1E ; EXIT
+\f
+; INITIALIZATION FOR PRINT ROUTINES
+
+TPRT: PUSHJ P,TESTR ; SEE IF CHANNEL IS OK
+ PUSH TP,C ; SAVE ARGUMENTS
+ PUSH TP,D
+ PUSH TP,A ; SAVE CHANNEL
+ PUSH TP,B
+ MOVEI A,CARRET ; PRINT CARRIAGE RETURN
+ PUSHJ P,PITYO
+ MOVEI A,12 ; AND LF
+ PUSHJ P,PITYO
+ MOVE A,-3(TP) ; MOVE IN ARGS
+ MOVE B,-2(TP)
+ POPJ P,
+
+; EXIT FOR PRINT ROUTINES
+
+TPRTE: POP TP,B ; RESTORE CHANNEL
+ MOVEI A,SPACE ; PRINT TRAILING SPACE
+ PUSHJ P,PITYO
+ SUB TP,[1,,1] ; GET RID OF CHANNEL TYPE-WORD
+ POP TP,B ; RETURN WHAT WAS PASSED
+ POP TP,A
+ JRST MPOPJ ; EXIT
+
+; INITIALIZATION FOR PRIN1 AND PRINC ROUTINES
+
+TPR1: PUSHJ P,TESTR ; SEE IF CHANNEL IS OK
+ PUSH TP,C ; SAVE ARGS
+ PUSH TP,D
+ PUSH TP,A ; SAVE CHANNEL
+ PUSH TP,B
+ MOVE A,-3(TP) ; GET ARGS
+ MOVE B,-2(TP)
+ POPJ P,
+
+; EXIT FOR PRIN1 AND PRINC ROUTINES
+
+TPR1E: SUB TP,[2,,2] ; REMOVE CHANNEL
+ POP TP,B ; RETURN ARGUMENTS THAT WERE GIVEN
+ POP TP,A
+ JRST MPOPJ ; EXIT
+
+
+\f
+CPATM: SUBM M,(P)
+ MOVSI C,TATOM ; GET TYPE FOR BINARY
+ MOVEI 0,SPCBIT ; SET UP FLAGS
+ PUSHJ P,TPRT ; PRINT INITIALIZATION
+ PUSHJ P,CPATOM ; PRINT IT OUT
+ JRST TPRTE ; EXIT
+
+CP1ATM: SUBM M,(P)
+ MOVE C,$TATOM
+ MOVEI FLAGS,0 ; SET UP FLAGS
+ PUSHJ P,TPR1 ; INITIALIZATION
+ PUSHJ P,CPATOM ; PRINT IT OUT
+ JRST TPR1E ; EXIT
+
+CPCATM: SUBM M,(P)
+ MOVE C,$TATOM
+ MOVSI FLAGS,NOQBIT ; SET UP FLAGS
+ PUSHJ P,TPR1 ; INITIALIZATION
+ PUSHJ P,CPATOM ; PRINT IT OUT
+ JRST TPR1E ; EXIT
+
+
+; THIS ROUTINE IS USD TO PRINT ONE CHARACTER. THE CHANNEL IS IN A AND B THE
+; CHARACTER IS IN C.
+CPCH1: TDZA 0,0
+CPCH: MOVEI 0,1
+ SUBM M,(P)
+ PUSH P,0
+ MOVSI FLAGS,NOQBIT
+ MOVE C,$TCHRS
+ PUSHJ P,TESTR ; SEE IF CHANNEL IS GOOD
+ EXCH D,(P) ; CHAR TO STACK, IND TO D
+ MOVE A,(P) ; MOVE IN CHARACTER FOR PITYO
+ JUMPE D,.+3
+ PUSHJ P,PRETIF
+ JRST .+2
+ PUSHJ P,PITYO
+ MOVE A,$TCHRST ; RETURN THE CHARACTER
+ POP P,B
+ JRST MPOPJ
+
+
+
+
+CPSTR: SUBM M,(P)
+ HRLI C,TCHSTR
+ MOVSI 0,SPCBIT ; SET UP FLAGS
+ PUSHJ P,TPRT ; PRINT INITIALIZATION
+ PUSHJ P,CPCHST ; PRINT IT OUT
+ JRST TPRTE ; EXIT
+
+CP1STR: SUBM M,(P)
+ HRLI C,TCHSTR
+ MOVEI FLAGS,0 ; SET UP FLAGS
+ PUSHJ P,TPR1 ; INITIALIZATION
+ PUSHJ P,CPCHST ; PRINT IT OUT
+ JRST TPR1E ; EXIT
+
+CPCSTR: SUBM M,(P)
+ HRLI C,TCHSTR
+ MOVSI FLAGS,NOQBIT ; SET UP FLAGS
+ PUSHJ P,TPR1 ; INITIALIZATION
+ PUSHJ P,CPCHST ; PRINT IT OUT
+ JRST TPR1E ; EXIT
+
+
+CPATOM: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE\r
+ PUSH TP,B
+ PUSH P,0 ; ATOM CALLER ROUTINE
+ PUSH P,C
+ JRST PATOM
+
+CPCHST: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE\r
+ PUSH TP,B
+ PUSH P,0 ; STRING CALLER ROUTINE
+ PUSH P,C
+ JRST PCHSTR
+
+
+\f\r
+AGET: MOVEI FLAGS,0
+ SKIPL E,AB ; COPY ARG POINTER
+ JRST TFA ;NO ARGS IS AN ERROR
+ ADD E,[2,,2] ;POINT AT POSSIBLE CHANNEL
+ JRST COMPT
+AGET1: MOVE E,AB ; GET COPY OF AB
+ MOVSI FLAGS,TERBIT
+
+COMPT: PUSH TP,$TFIX ;LEAVE ROOM ON STACK FOR ONE CHANNEL
+ PUSH TP,[0]
+ JUMPGE E,DEFCHN ;IF NO CHANNEL ARGUMENT, USE CURRENT BINDING
+ CAMG E,[-2,,0] ;IF MORE ARGS THEN ERROR
+ JRST TMA
+ MOVE A,(E) ;GET CHANNEL
+ MOVE B,(E)+1
+ JRST NEWCHN
+
+DEFCHN: MOVE B,IMQUOTE OUTCHAN
+ MOVSI A,TATOM
+ PUSH P,FLAGS ;SAVE FLAGS
+ PUSHJ P,IDVAL ;GET VALUE OF OUTCHAN
+ POP P,0
+
+NEWCHN: TLNE FLAGS,TERBIT ; SEE IF TERPRI
+ POPJ P,
+ MOVE C,(AB) ; GET ARGS
+ MOVE D,1(AB)
+ POPJ P,
+
+; HERE IF USING A PRINTB CHANNEL
+
+BPRINT: TLO FLAGS,BINBIT
+ SKIPE BUFSTR(B) ; ANY OUTPUT BUFFER?
+ POPJ P,
+
+; HERE TO GENERATE A STRING BUFFER
+
+ PUSH P,FLAGS
+ MOVEI A,BUFLNT ; GET BUFFER LENGTH
+ PUSHJ P,IBLOCK ; MAKE A BUFFER
+ MOVSI 0,TWORD+.VECT. ; CLOBBER U TYPE
+ MOVEM 0,BUFLNT(B)
+ SETOM (B) ; -1 THE BUFFER
+ MOVEI C,1(B)
+ HRLI C,(B)
+ BLT C,BUFLNT-1(B)
+ HRLI B,010700
+ SUBI B,1
+ MOVE C,(TP)
+ MOVEM B,BUFSTR(C) ; STOR BYTE POINTER
+ MOVE 0,[TCHSTR,,BUFLNT*5]
+ MOVEM 0,BUFSTR-1(C)
+ POP P,FLAGS
+ MOVE B,(TP)
+ POPJ P,
+\f
+
+IPRINT: PUSH P,C ; SAVE C
+ PUSH P,FLAGS ;SAVE PREVIOUS FLAGS
+ PUSH TP,A ;SAVE ARGUMENT ON TP-STACK
+ PUSH TP,B
+
+ INTGO ;ALLOW INTERRUPTS HERE
+
+ GETYP A,-1(TP) ;GET THE TYPE CODE OF THE ITEM
+ SKIPE C,PRNTYP+1 ; USER TYPE TABLE?
+ JRST PRDISP
+NORMAL: CAILE A,NUMPRI ;PRIMITIVE?
+ JRST PUNK ;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
+ HRRO A,PRTYPE(A) ;YES-DISPATCH
+ JRST (A)
+
+; HERE FOR USER PRINT DISPATCH
+
+PRDISP: ADDI C,(A) ; POINT TO SLOT
+ ADDI C,(A)
+ SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP
+ JRST PRDIS1 ; APPLY EVALUATOR
+ SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP
+ JRST NORMAL
+ JRST (C)
+
+PRDIS1: SUB C,PRNTYP+1
+ PUSH P,C
+ PUSH TP,[TATOM,,-1] ; PUSH ON OUTCHAN FOR SPECBIND
+ PUSH TP,IMQUOTE OUTCHAN
+ PUSH TP,-5(TP)
+ PUSH TP,-5(TP)
+ PUSH TP,[0]
+ PUSH TP,[0]
+ PUSHJ P,SPECBIND
+ POP P,C ; RESTORE C
+ ADD C,PRNTYP+1 ; RESTORE C
+ PUSH TP,(C) ; PUSH ARGS FOR APPLY
+ PUSH TP,1(C)
+ PUSH TP,-9(TP)
+ PUSH TP,-9(TP)
+ MCALL 2,APPLY ; APPLY HACKER TO OBJECT
+ MOVEI E,-8(TP)
+ PUSHJ P,SSPEC1 ;UNBIND OUTCHAN
+ SUB TP,[6,,6] ; POP OFF STACK
+ JRST PNEXT
+
+; PRINT DISPATCH TABLE
+
+IF2,PUNKS==400000,,PUNK
+
+DISTBL PRTYPE,PUNKS,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
+[TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
+[TARGS,PARGS],[TUVEC,PUVEC],[TDEFER,PDEFER],[TINTH,PINTH],[THAND,PHAND]
+[TILLEG,ILLCH],[TRSUBR,PRSUBR],[TENTER,PENTRY],[TPCODE,PPCODE],[TTYPEW,PTYPEW]
+[TTYPEC,PTYPEC],[TTMPLT,TMPRNT],[TLOCD,LOCPT1],[TLOCR,LOCRPT],[TQRSUB,PRSUBR]
+[TQENT,PENTRY],[TSATC,PSATC],[TBYTE,PBYTE]
+[TOFFS,POFFSE]]
+
+PUNK: MOVE C,TYPVEC+1 ; GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
+ GETYP B,-1(TP) ; GET THE TYPE CODE INTO REG B
+ LSH B,1 ; MULTIPLY BY TWO
+ HRL B,B ; DUPLICATE IT IN THE LEFT HALF
+ ADD C,B ; INCREMENT THE AOBJN-POINTER
+ JUMPGE C,PRERR ; IF POSITIVE, INDEX > VECTOR SIZE
+
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ PUSH TP,$TVEC ; SAVE ALLTYPES VECTOR
+ PUSH TP,C
+ PUSHJ P,RETIF1 ; START NEW LINE IF NO ROOM
+ MOVEI A,"# ; INDICATE TYPE-NAME FOLLOWS
+ PUSHJ P,PITYO
+ POP TP,C
+ SUB TP,[1,,1]
+ MOVE A,(C) ; GET TYPE-ATOM
+ MOVE B,1(C)
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT ATOM-NAME
+ SUB TP,[2,,2] ; POP STACK
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ PUSHJ P,SPACEQ ; MAYBE SPACE
+ MOVE B,(B) ; RESET THE REAL ARGUMENT POINTER
+ HRRZ A,(C) ; GET THE STORAGE-TYPE
+ ANDI A,SATMSK
+ CAILE A,NUMSAT ; SKIP IF TEMPLATE
+ JRST TMPRNT ; PRINT TEMPLATED DATA STRUCTURE
+ HRRO A,UKTBL(A) ; USE DISPATCH TABLE ON STORAGE TYPE
+ JRST (A)
+
+DISTBS UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC],[SATOM,PATOM]
+[SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP],[SLOCID,LOCPT],[SLOCA,LOCP]
+[SLOCV,LOCP],[SLOCU,LOCP],[SLOCS,LOCP],[SLOCL,LOCP],[SLOCN,LOCP],[SASOC,ASSPNT]
+[SLOCT,LOCP],[SLOCB,LOCP],[SBYTE,PBYTE],[SOFFS,POFFSE]]
+ ; SELECK AN ILLEGAL
+
+ILLCH: MOVEI B,-1(TP)
+ JRST ILLCHO
+
+\f; PRINT INTERRUPT HANDLER
+
+PHAND: MOVE B,-2(TP) ; MOVE CHANNEL INTO B
+ PUSHJ P,RETIF1
+ MOVEI A,"#
+ PUSHJ P,PITYO ; SAY "FUNNY TYPE"
+ MOVSI A,TATOM
+ MOVE B,MQUOTE HANDLER
+ PUSH TP,-3(TP) ; PUSH CHANNEL ON FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT THE TYPE NAME
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ MOVE B,-2(TP) ; GET CHANNEL
+ PUSHJ P,SPACEQ ; SPACE MAYBE
+ SKIPN B,(TP) ; GET ARG BACK
+ JRST PNEXT
+ MOVE A,INTFCN(B) ; PRINT FUNCTION FOR NOW
+ MOVE B,INTFCN+1(B)
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT THE INT FUNCTION
+ SUB TP,[2,,2] ; POP CHANNEL OFF
+ JRST PNEXT
+
+; PRINT INT HEADER
+
+PINTH: MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF1
+ MOVEI A,"#
+ PUSHJ P,PITYO
+ MOVSI A,TATOM ; AND NAME
+ MOVE B,MQUOTE IHEADER
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ ; MAYBE SPACE
+ SKIPN B,-2(TP) ; INT HEADER BACK
+ JRST PINTH1
+ MOVE A,INAME(B) ; GET NAME
+ MOVE B,INAME+1(B)
+ PUSHJ P,IPRINT
+PINTH1: SUB TP,[2,,2] ; CLEAN OFF STACK
+ JRST PNEXT
+
+
+; PRINT ASSOCIATION BLOCK
+
+ASSPNT: MOVEI A,"( ; MAKE IT BE (ITEN INDIC VAL)
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF ; MAKE ROOM AND PRINT
+ SKIPA C,[-3,,0] ; # OF FIELDS
+ASSLP: PUSHJ P,SPACEQ
+ MOVE D,(TP) ; RESTORE GOODIE
+ ADD D,ASSOFF(C) ; POINT TO FIELD
+ MOVE A,(D) ; GET IT
+ MOVE B,1(D)
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; AND PRINT IT
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+ MOVE B,-2(TP) ; GET CHANNEL
+ AOBJN C,ASSLP
+
+ MOVEI A,")
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF ; CLOSE IT
+ JRST PNEXT
+
+ASSOFF: ITEM
+ INDIC
+ VAL
+\f; PRINT TYPE-C AND TYPE-W
+
+PTYPEW: HRRZ A,(TP) ; POSSIBLE RH
+ HLRZ B,(TP)
+ MOVE C,MQUOTE TYPE-W
+ JRST PTYPEX
+
+PTYPEC: HRRZ B,(TP)
+ MOVEI A,0
+ MOVE C,MQUOTE TYPE-C
+
+PTYPEX: PUSH P,B
+ PUSH P,A
+ PUSH TP,$TATOM
+ PUSH TP,C
+ MOVEI A,2
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF ; ROOM TO START?
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ POP TP,B ; GET NAME
+ POP TP,A
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; AND PRINT IT AS 1ST ELEMENT
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ ; MAYBE SPACE
+ MOVE A,-1(P) ; TYPE CODE
+ ASH A,1
+ HRLI A,(A) ; MAKE SURE WINS
+ ADD A,TYPVEC+1
+ JUMPL A,PTYPX1 ; JUMP FOR A WINNER
+ ERRUUO EQUOTE BAD-TYPE-CODE
+
+PTYPX1: MOVE B,1(A) ; GET TYPE NAME
+ HRRZ A,(A) ; AND SAT
+ ANDI A,SATMSK
+ MOVEM A,-1(P) ; AND SAVE IT
+ MOVSI A,TATOM
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; OUT IT GOES
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ ; MAYBE SPACE
+ MOVE A,-1(P) ; GET SAT BACK
+ MOVE B,IMQUOTE TEMPLATE
+ CAIGE A,NUMSAT
+ MOVE B,@STBL(A)
+ MOVSI A,TATOM ; AND PRINT IT
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP OFF STACK
+ SKIPN B,(P) ; ANY EXTRA CRAP?
+ JRST PTYPX2
+
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ
+ MOVE B,(P)
+ MOVSI A,TFIX
+ PUSH TP,-3(TP) ; PUSH CHANNELS FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT EXTRA
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+
+PTYPX2: MOVEI A,">
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF
+ SUB P,[2,,2] ; FLUSH CRUFT
+ JRST PNEXT
+
+\f; PRIMTYPE CODE
+
+; PRINT PURE CODE POINTER
+
+PSATC: MOVEI A,2
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM ; PRINT SUBR CALL
+ MOVE B,MQUOTE PRIMTYPE-C
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ ; MAYBE SPACE?
+ MOVE A,-2(TP)
+ CAILE A,NUMSAT
+ JRST TMPPTY
+
+ MOVE B,@STBL(A)
+ JRST PSATC1
+
+TMPPTY: MOVE B,TYPVEC+1
+PSATC3: HRRZ C,(B)
+ ANDI C,SATMSK
+ CAIN A,(C)
+ JRST PSATC2
+ ADD B,[2,,2]
+ JUMPL B,PSATC3
+
+ ERRUUO EQUOTE BAD-PRIMTYPEC
+
+PSATC2: MOVE B,1(B)
+PSATC1: MOVSI A,TATOM
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVEI A,">
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF ; CLOSE THE FORM
+ JRST PNEXT
+
+
+PPCODE: MOVEI A,2
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM ; PRINT SUBR CALL
+ MOVE B,MQUOTE PCODE
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ ; MAYBE SPACE?
+ HLRZ A,-2(TP) ; OFFSET TO VECTOR
+ ADD A,PURVEC+1 ; SLOT TO A
+ MOVE A,(A) ; SIXBIT NAME
+ PUSH P,FLAGS
+ PUSHJ P,6TOCHS ; TO A STRING
+ POP P,FLAGS
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ
+ HRRZ B,-2(TP) ; GET OFFSET
+ MOVSI A,TFIX\r
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ MOVEI A,">
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF ; CLOSE THE FORM
+ JRST PNEXT
+
+
+\f; PRINT SUB-ENTRY TO RSUBR
+
+PENTRY: MOVE B,(TP) ; GET BLOCK
+ GETYP A,(B) ; TYPE OF 1ST ELEMENT
+ CAIE A,TRSUBR ; RSUBR, OK
+ JRST PENT1
+PENT2: MOVEI A,2 ; CHECK ROOM
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF
+ MOVEI A,"% ; SETUP READ TIME MACRO
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE RSUBR-ENTRY
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP)
+ PUSHJ P,SPACEQ ; MAYBE SPACE
+ MOVEI A,"' ; QUOTE TO AVOID EVALING IT
+ PUSHJ P,PRETIF
+ MOVEI A,"[ ; OPEN SQUARE BRAKET
+ PUSHJ P,PRETIF
+ MOVE B,-2(TP)
+ GETYP A,(B)
+ CAIN A,TRSUBR
+ JRST PENT3
+ MOVE A,(B)
+ MOVE B,1(B)
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; MOVE IN CHANNEL
+ JRST PENT4
+PENT3: MOVE A,1(B)
+ MOVE B,3(A)
+ MOVSI A,TATOM ; FOOL EVERYBODY AND SEND OUT ATOM
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; PRINT SPACE
+PENT4: PUSHJ P,SPACEQ
+ MOVE B,-2(TP) ; GET PTR BACK TO VECTOR
+ MOVE A,2(B) ; THE NAME OF THE ENTRY
+ MOVE B,3(B)
+ PUSHJ P,IPRINT ; OUT IT GOES
+ CAMLE B,[-4,,-1] ; SEE IF DONE
+ JRST EXPEN
+ MOVE B,-4(TP) ; PRINT SPACE
+ PUSHJ P,SPACEQ
+ MOVE B,-2(TP) ; GET POINTER
+ MOVE A,4(B) ; DECL
+ MOVE B,5(B)
+ PUSHJ P,IPRINT
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+EXPEN: MOVEI A,"] ; CLOSE SQUARE BRAKET
+ PUSHJ P,PRETIF
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ
+ MOVE B,-2(TP)
+ HRRZ B,2(B)
+ MOVSI A,TFIX
+ PUSHJ P,IPRINT
+ MOVEI A,">
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+PENT1: CAIN A,TATOM
+ JRST PENT2
+ ERRUUO EQUOTE BAD-ENTRY-BLOCK
+
+\f; HERE TO PRINT TEMPLATED DATA STRUCTURE
+
+TMPRNT: PUSH P,FLAGS ; SAVE FLAGS
+ MOVE A,(TP) ; GET POINTER
+ GETYP A,(A) ; GET SAT
+ PUSH P,A ; AND SAVE IT
+ MOVEI A,"{ ; OPEN SQUIGGLE
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PRETIF ; PRINT WITH CHECKING
+ HLRZ A,(TP) ; GET AMOUNT RESTED OFF
+ SUBI A,1
+ PUSH P,A ; AND SAVE IT
+ MOVE A,-1(P) ; GET SAT
+ SUBI A,NUMSAT+1 ; FIXIT UP
+ HRLI A,(A)
+ ADD A,TD.LNT+1 ; CHECK FOR WINNAGE
+ JUMPGE A,BADTPL ; COMPLAIN
+ HRRZS C,(TP) ; GET LENGTH
+ XCT (A) ; INTO B
+ SUB B,(P) ; FUDGE FOR RESTS
+ MOVEI B,-1(B) ; FUDGE IT
+ PUSH P,B ; AND SAVE IT
+
+TMPRN1: AOS C,-1(P) ; GET ELEMENT OF INTEREST
+ SOSGE (P) ; CHECK FOR ANY LEFT
+ JRST TMPRN2 ; ALL DONE
+
+ MOVE B,(TP) ; POINTER
+ HRRZ 0,-2(P) ; SAT
+ PUSHJ P,TMPLNT ; GET THE ITEM
+ MOVE FLAGS,-3(P) ; RESTORE FLAGS
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT THIS ELEMENT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ SKIPE (P) ; IF NOT LAST ONE THEN
+ PUSHJ P,SPACEQ ; SEPARATE WITH A SPACE
+ JRST TMPRN1
+
+TMPRN2: SUB P,[4,,4]
+ MOVE B,-2(TP)
+ MOVEI A,"} ; CLOSE THIS GUY
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+
+\f; RSUBR PRINTING ROUTINES. ON PRINTB CHANNELS, WRITES OUT
+; COMPACT BINARY. ON PRINT CHANNELS ALL IS ASCII
+
+PRSUBR: MOVE A,(TP) ; GET RSUBR IN QUESTION
+ GETYP A,(A) ; CHECK FOR PURE RSUBR
+ CAIN A,TPCODE
+ JRST PRSBRP ; PRINT IT SPECIAL WAY
+
+ TLNN FLAGS,BINBIT ; SKIP IF BINARY OUTPUT
+ JRST ARSUBR
+
+ PUSH P,FLAGS
+ MOVSI A,TRSUBR ; FIND FIXUPS
+ MOVE B,(TP)
+ HLRE D,1(B) ; -LENGTH OF CODE VEC
+ PUSH P,D ; SAVE SAME
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE RSUBR
+ PUSHJ P,IGET ; GO GET THEM
+ JUMPE B,RCANT ; NO FIXUPS, BINARY LOSES
+ PUSH TP,A ; SAVE FIXUP LIST
+ PUSH TP,B
+
+ MOVNI A,1 ; USE ^C AS MARKER FOR RSUBR
+ MOVE FLAGS,-1(P) ; RESTORE FLAGS
+ MOVE B,-4(TP) ; GET CHANNEL FOR PITYO
+ PUSHJ P,PITYO ; OUT IT GOES
+
+PRSBR1: MOVE B,-4(TP)
+ PUSHJ P,BFCLS1 ; FLUSH OUT CURRENT BUFFER
+
+ MOVE B,-4(TP) ; CHANNEL BACK
+ MOVN E,(P) ; LENGTH OF CODE
+ PUSH P,E
+ HRROI A,(P) ; POINT TO SAME
+ PUSHJ P,DOIOTO ; OUT GOES COUNT
+ MOVSI C,TCODE
+ MOVE PVP,PVSTOR+1
+ MOVEM C,ASTO(PVP) ; FOR IOT INTERRUPTS
+ MOVE A,-2(TP) ; GET POINTER TO CODE
+ MOVE A,1(A)
+ PUSHJ P,DOIOTO ; IOT IT OUT
+ POP P,E
+ ADDI E,1 ; UPDATE ACCESS
+ ADDM E,ACCESS(B)
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP) ; UNSCREW A
+
+; NOW PRINT OUT NORMAL RSUBR VECTOR
+
+ MOVE FLAGS,-1(P) ; RESTORE FLAGS
+ SUB P,[1,,1]
+ MOVE B,-2(TP) ; GET RSUBR VECTOR
+ PUSHJ P,PRBODY ; PRINT ITS BODY
+
+; HERE TO PRINT BINARY FIXUPS
+
+ MOVEI E,0 ; 1ST COMPUTE LENGTH OF FIXUPS
+ SKIPN A,(TP) ; LIST TO A
+ JRST PRSBR5 ; EMPTY, DONE
+ JUMPL A,UFIXES ; JUMP IF FIXUPS IN UVECTOR FORM
+ ADDI E,1 ; FOR VERS
+
+PRSBR6: HRRZ A,(A) ; NEXT?
+ JUMPE A,PRSBR5
+ GETYP B,(A)
+ CAIE B,TDEFER ; POSSIBLE STRING
+ JRST PRSBR7 ; COULD BE ATOM
+ MOVE B,1(A) ; POSSIBLE STRINGER
+ GETYP C,(B)
+ CAIE C,TCHSTR ; YES!!!
+ JRST BADFXU ; LOSING FIXUPS
+ HRRZ C,(B) ; # OF CHARS TO C
+ ADDI C,5+5 ; ROUND AND ADD FOR COUNT
+ IDIVI C,5 ; TO WORDS
+ ADDI E,(C)
+ JRST FIXLST ; COUNT FOR USE LIST ETC.
+
+PRSBR7: GETYP B,(A) ; GET TYPE
+ CAIE B,TATOM
+ JRST BADFXU
+ ADDI E,1
+
+FIXLST: HRRZ A,(A) ; REST IT TO OLD VAL
+ JUMPE A,BADFXU
+ GETYP B,(A) ; FIX?
+ CAIE B,TFIX
+ JRST BADFXU
+ MOVEI D,1
+ HRRZ A,(A) ; TO USE LIST
+ JUMPE A,BADFXU
+ GETYP B,(A)
+ CAIE B,TLIST
+ JRST BADFXU ; LOSER
+ MOVE C,1(A) ; GET LIST
+
+PRSBR8: JUMPE C,PRSBR9
+ GETYP B,(C) ; TYPE OK?
+ CAIE B,TFIX
+ JRST BADFXU
+ HRRZ C,(C)
+ AOJA D,PRSBR8 ; LOOP
+
+PRSBR9: ADDI D,2 ; ROUND UP
+ ASH D,-1 ; DIV BY 2 FOR TWO GOODIES PER HWORD
+ ADDI E,(D)
+ JRST PRSBR6
+
+PRSBR5: PUSH P,E ; SAVE LENGTH OF FIXUPS
+ PUSH TP,$TUVEC ; SLOT FOR BUFFER POINTER
+ PUSH TP,[0]
+
+PFIXU1: MOVE B,-6(TP) ; START LOOPING THROUGH CHANNELS
+ PUSHJ P,BFCLS1 ; FLUSH BUFFER
+ MOVE B,-6(TP) ; CHANNEL BACK
+ MOVEI C,BUFSTR-1(B) ; SETUP BUFFER
+ PUSHJ P,BYTDOP ; FIND D.W.
+ SUBI A,BUFLNT+1
+ HRLI A,-BUFLNT
+ MOVEM A,(TP)
+ MOVE E,(P) ; LENGTH OF FIXUPS
+ SETZB C,D ; FOR EOUT
+ PUSHJ P,EOUT
+ MOVE C,-2(TP) ; FIXUP LIST
+ MOVE E,1(C) ; HAVE VERS
+ PUSHJ P,EOUT ; OUT IT GOES
+
+PFIXU2: HRRZ C,(C) ; FIRST THING
+ JUMPE C,PFIXU3 ; DONE?
+ GETYP A,(C) ; STRING OR ATOM
+ CAIN A,TATOM ; MUST BE STRING
+ JRST PFIXU4
+ MOVE A,1(C) ; POINT TO POINTER
+ HRRZ D,(A) ; LENGTH
+ IDIVI D,5
+ PUSH P,E ; SAVE REMAINDER
+ MOVEI E,1(D)
+ MOVNI D,(D)
+ MOVSI D,(D)
+ PUSH P,D
+ PUSHJ P,EOUT
+ MOVEI D,0
+PFXU1A: MOVE A,1(C) ; RESTORE POINTER
+ HRRZ A,1(A) ; BYTE POINTER
+ ADD A,(P)
+ MOVE E,(A)
+ PUSHJ P,EOUT
+ MOVE A,[1,,1]
+ ADDB A,(P)
+ JUMPL A,PFXU1A
+ MOVE D,-1(P) ; LAST WORD
+ MOVE A,1(C)
+ HRRZ A,1(A)
+ ADD A,(P)
+ SKIPE E,D
+ MOVE E,(A) ; LAST WORD OF CHARS
+ IOR E,PADS(D)
+ PUSHJ P,EOUT ; OUT
+ SUB P,[1,,1]
+ JRST PFIXU5
+
+PADS: ASCII /#####/
+ ASCII /####/
+ ASCII /\ 2###/
+ ASCII /\ 2##/
+ ASCII /\ 2\ 2#/
+
+PFIXU4: HRRZ E,(C) ; GET CURRENT VAL
+ MOVE E,1(E)
+ PUSHJ P,ATOSQ ; GET SQUOZE
+ JRST BADFXU
+ TLO E,400000 ; USE TO DIFFERENTIATE BETWEEN STRING
+ PUSHJ P,EOUT
+
+; HERE TO WRITE OUT LISTS
+
+PFIXU5: HRRZ C,(C) ; POINT TO CURRENT VALUE
+ HRLZ E,1(C)
+ HRRZ C,(C) ; POINT TO USES LIST
+ HRRZ D,1(C) ; GET IT
+
+PFIXU6: TLCE D,400000 ; SKIP FOR RH
+ HRLZ E,1(D) ; SETUP LH
+ JUMPG D,.+3
+ HRR E,1(D)
+ PUSHJ P,EOUT ; WRITE IT OUT
+ HRR D,(D)
+ TRNE D,-1 ; SKIP IF DONE
+ JRST PFIXU6
+
+ TRNE E,-1 ; SKIP IF ZERO BYTE EXISTS
+ MOVEI E,0
+ PUSHJ P,EOUT
+ JRST PFIXU2 ; DO NEXT
+
+PFIXU3: HLRE C,(TP) ; -AMNT LEFT IN BUFFER
+ MOVN D,C ; PLUS SAME
+ ADDI C,BUFLNT ; WORDS USED TO C
+ JUMPE C,PFIXU7 ; NONE USED, LEAVE
+ MOVSS C ; START SETTING UP BTB
+ MOVN A,C ; ALSO FINAL IOT POINTER
+ HRR C,(TP) ; PDL POINTER PART OF BTB
+ SUBI C,1
+ HRLI D,400000+C ; CONTINUE SETTING UP BTB (400000 IS FOR MULTI
+ ; SEGS
+ POP C,@D ; MOVE 'EM DOWN
+ TLNE C,-1
+ JRST .-2
+ HRRI A,@D ; OUTPUT POINTER
+ ADDI A,1
+ MOVSI B,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM B,ASTO(PVP)
+ MOVE B,-6(TP)
+ PUSHJ P,DOIOTO ; WRITE IT OUT
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+
+PFIXU7: SUB TP,[4,,4]
+ SUB P,[2,,2]
+ JRST PNEXT
+
+; ROUTINE TO OUTPUT CONTENTS OF E
+
+EOUT: MOVE B,-6(TP) ; CHANNEL
+ AOS ACCESS(B)
+ MOVE A,(TP) ; BUFFER POINTER
+ MOVEM E,(A)
+ AOBJP A,.+3 ; COUNT AND GO
+ MOVEM A,(TP)
+ POPJ P,
+
+ SUBI A,BUFLNT ; SET UP IOT POINTER
+ HRLI A,-BUFLNT
+ MOVEM A,(TP) ; RESET SAVED POINTER
+ MOVSI 0,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM 0,ASTO(PVP)
+ MOVSI 0,TLIST
+ MOVEM 0,DSTO(PVP)
+ MOVEM 0,CSTO(PVP)
+ PUSHJ P,DOIOTO ; OUT IT GOES
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+ SETZM CSTO(PVP)
+ SETZM DSTO(PVP)
+ POPJ P,
+
+; HERE IF UVECOR FORM OF FIXUPS
+
+UFIXES: PUSH TP,$TUVEC
+ PUSH TP,A ; SAVE IT
+
+UFIX1: MOVE B,-6(TP) ; GET SAME
+ PUSHJ P,BFCLS1 ; FLUSH OUT BUFFER
+ HLRE C,(TP) ; GET LENGTH
+ MOVMS C
+ PUSH P,C
+ HRROI A,(P) ; READY TO ZAP IT OUT
+ PUSHJ P,DOIOTO ; ZAP!
+ SUB P,[1,,1]
+ HLRE C,(TP) ; LENGTH BACK
+ MOVMS C
+ ADDI C,1
+ ADDM C,ACCESS(B) ; UPDATE ACCESS
+ MOVE A,(TP) ; NOW THE UVECTOR
+ MOVSI C,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM C,ASTO(PVP)
+ PUSHJ P,DOIOTO ; GO
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+ SUB P,[1,,1]
+ SUB TP,[4,,4]
+ JRST PNEXT
+
+RCANT: ERRUUO EQUOTE RSUBR-LACKS-FIXUPS
+
+
+BADFXU: ERRUUO EQUOTE BAD-FIXUPS
+
+PRBODY: TDZA C,C ; FLAG SAYING FLUSH CODE
+PRBOD1: MOVEI C,1 ; PRINT CODE ALSO
+ PUSH P,FLAGS
+ PUSH TP,$TRSUBR
+ PUSH TP,B
+ PUSH P,C
+ MOVEI A,"[ ; START VECTOR TEXT
+ MOVE B,-6(TP) ; GET CHANNEL FOR PITYO
+ PUSHJ P,PITYO
+ POP P,C
+ MOVE B,(TP) ; RSUBR BACK
+ JUMPN C,PRSON ; GO START PRINTING
+ MOVEI A,"0 ; PLACE SAVER FOR CODE VEC
+ MOVE B,-6(TP) ; GET CHANNEL FOR PITYO
+ PUSHJ P,PITYO
+
+PRSBR2: MOVE B,[2,,2] ; BUMP VECTOR
+ ADDB B,(TP)
+ JUMPGE B,PRSBR3 ; NO SPACE IF LAST
+ MOVE B,-6(TP) ; GET CHANNEL FOR SPACEQ
+ PUSHJ P,SPACEQ
+ SKIPA B,(TP) ; GET BACK POINTER
+PRSON: JUMPGE B,PRSBR3
+ GETYP 0,(B) ; SEE IF RSUBR POINTED TO
+ CAIE 0,TQENT
+ CAIN 0,TENTER
+ JRST .+5 ; JUMP IF RSUBR ENTRY
+ CAIN 0,TQRSUB
+ JRST .+3
+ CAIE 0,TRSUBR ; YES!
+ JRST PRSB10 ; COULD BE SUBR/FSUBR
+ MOVE C,1(B) ; GET RSUBR
+ PUSH P,0 ; SAVE TYPE FOUND
+ GETYP 0,2(C) ; SEE IF ATOM
+ CAIE 0,TATOM
+ JRST PRSBR4
+ MOVE B,3(C) ; GET ATOM NAME
+ PUSHJ P,IGVAL ; GO LOOK
+ MOVE C,(TP) ; ORIG RSUBR BACK
+ GETYP A,A
+ POP P,0 ; DESIRED TYPE
+ CAIE 0,(A) ; SAME TYPE
+ JRST PRSBR4
+ MOVE D,1(C)
+ MOVE 0,3(D) ; NAME OF RSUBR IN QUESTION
+ CAME 0,3(B) ; WIN?
+ JRST PRSBR4
+ HRRZ E,C
+ MOVSI A,TATOM
+ MOVE B,0 ; GET ATOM
+ MOVE FLAGS,(P)
+ JRST PRS101
+
+PRSBR4: MOVE FLAGS,(P) ; RESTORE FLAGS
+ MOVE B,(TP)
+ MOVE A,(B)
+ MOVE B,1(B) ; PRINT IT
+PRS101: PUSH TP,-7(TP) ; PUSH CHANNEL FOR IPRINT
+ PUSH TP,-7(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ JRST PRSBR2
+
+PRSB10: CAIE 0,TSUBR ; SUBR?
+ CAIN 0,TFSUBR
+ JRST .+2
+ JRST PRSBR4
+ MOVE C,1(B) ; GET LOCN OF SUBR OR FSUBR
+ MOVE B,@-1(C) ; NAME OF IT
+ MOVSI A,TATOM ; AND TYPE
+ JRST PRS101
+
+PRSBR3: MOVEI A,"]
+ MOVE B,-6(TP)
+ PUSHJ P,PRETIF ; CLOSE IT UP
+ SUB TP,[2,,2] ; FLUSH CRAP
+ POP P,FLAGS
+ POPJ P,
+
+
+\f; HERE TO PRINT PURE RSUBRS
+
+PRSBRP: MOVEI A,2 ; WILL "%<" FIT?
+ MOVE B,-2(TP) ; GET CHANNEL FOR RETIF
+ PUSHJ P,RETIF
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE RSUBR
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT IT OUT
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+ MOVE B,-2(TP)
+ PUSHJ P,SPACEQ ; MAYBE SPACE
+ MOVEI A,"' ; QUOTE THE VECCTOR
+ PUSHJ P,PRETIF
+ MOVE B,(TP) ; GET RSUBR BODY BACK
+ PUSH TP,$TFIX ; STUFF THE STACK
+ PUSH TP,[0]
+ PUSHJ P,PRBOD1 ; PRINT AND UNLINK
+ SUB TP,[2,,2] ; GET JUNK OFF STACK
+ MOVE B,-2(TP) ; GET CHANNEL FOR RETIF
+ MOVEI A,">
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+; HERE TO PRINT ASCII RSUBRS
+
+ARSUBR: PUSH P,FLAGS ; SAVE FROM GET
+ MOVSI A,TRSUBR
+ MOVE B,(TP)
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE RSUBR
+ PUSHJ P,IGET ; TRY TO GET FIXUPS
+ POP P,FLAGS
+ JUMPE B,PUNK ; NO FIXUPS LOSE
+ GETYP A,A
+ CAIE A,TLIST ; ARE FIXUPS A LIST?
+ JRST PUNK ; NO, AGAIN LOSE
+ PUSH TP,$TLIST
+ PUSH TP,B ; SAVE FIXUPS
+ MOVEI A,17.
+ MOVE B,-4(TP)
+ PUSHJ P,RETIF
+ PUSH P,[440700,,[ASCIZ /%<FIXUP!-RSUBRS!-/]]
+
+AL1: ILDB A,(P) ; GET CHAR
+ JUMPE A,.+3
+ PUSHJ P,PITYO
+ JRST AL1
+
+ SUB P,[1,,1]
+ PUSHJ P,SPACEQ
+
+ MOVEI A,"'
+ PUSHJ P,PRETIF ; QUOTE TO AVOID ADDITIONAL EVAL
+ MOVE B,-2(TP) ; PRINT ACTUAL KLUDGE
+ PUSHJ P,PRBOD1
+ MOVE B,-4(TP) ; GET CHANNEL FOR SPACEQ
+ PUSHJ P,SPACEQ
+ MOVEI A,"' ; DONT EVAL FIXUPS EITHER
+ PUSHJ P,PRETIF
+ POP TP,B
+ POP TP,A
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ MOVEI A,">
+ PUSHJ P,PRETIF
+ JRST PNEXT
+\f
+; HERE TO DO OFFSETS: %<OFFSET N '<VECTOR FIX FLOAT>>
+
+POFFSE: MOVEI A,2
+ MOVE B,-2(TP)
+ PUSHJ P,RETIF
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM
+ MOVE B,MQUOTE OFFSET
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; RESTORE CHANNEL
+ PUSHJ P,SPACEQ
+ MOVSI A,TFIX
+ HRRE B,(TP) ; PICK UPTHE FIX
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; RESTORE CHANNEL
+ PUSHJ P,SPACEQ
+ HLRZ A,(TP)
+ JUMPE A,POFFS2
+ GETYP B,(A)
+ CAIE B,TFORM ; FORMS HAVE TO BE QUOTED
+ JRST POFFS1
+ MOVEI A,"'
+ MOVE B,-2(TP)
+ PUSHJ P,PRETIF
+POFFS1: HLRZ B,(TP)
+ MOVE A,(B)
+ MOVE B,1(B)
+POFFPT: PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; RESTORE CHANNEL
+ MOVEI A,">
+ PUSHJ P,PRETIF
+ JRST PNEXT
+; PRINT 'ANY' IF 0
+POFFS2: MOVSI A,TATOM
+ MOVE B,IMQUOTE ANY
+ JRST POFFPT
+
+\f; HERE TO DO LOCATIVES (PRINT CONTENTS THEREOF)
+
+LOCP: PUSH TP,-1(TP)
+ PUSH TP,-1(TP)
+ PUSH P,0
+ MCALL 1,IN ; GET ITS CONTENTS FROM "IN"
+ POP P,0
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ; PRINT IT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ JRST PNEXT
+\f;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
+;B CONTAINS CHANNEL
+;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
+PITYO: TLNN FLAGS,FLTBIT
+ JRST ITYO
+PITYO1: PUSH TP,[TTP,,0] ; PUSH ON TP POINTER
+ PUSH TP,B
+ TLNE FLAGS,UNPRSE ;SKIPS UNPRSE NOT SET
+ JRST ITYO+2
+ AOS FLTSIZ ;FLATSIZE DOESN'T PRINT
+ ;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
+ SOSGE FLTMAX ;UNLESS THE MAXIMUM IS EXCEEDED
+ JRST .+4
+ POP TP,B ; GET CHANNEL BACK
+ SUB TP,[1,,1]
+ POPJ P,
+ MOVEI E,(B) ; GET POINTER FOR UNBINDING
+ PUSHJ P,SSPEC1
+ MOVE P,UPB+8 ; RESTORE P
+ POP TP,B ; GET BACK TP POINTER
+ PUSH P,0 ; SAVE FLAGS
+ MOVE TP,B ; RESTORE TP
+ MOVEI C,(TB) ; SEE IF TB IS CORRECT
+ CAIG C,1(TP) ; SKIP IF NEEDS UNWINDING
+ JRST PITYO4
+PITYO3: MOVEI C,(TB)
+ CAILE C,1(TP)
+ JRST PITYO2
+ MOVEI A,PITYO4 ; SET UP PARAMETERS TO BE RESTORED BY FINIS
+ HRRM A,PCSAV(C)
+ MOVEM TP,TPSAV(C)
+ MOVE SP,SPSTOR+1
+ MOVEM SP,SPSAV(C)
+ MOVEM P,PSAV(C)
+ MOVE TB,D ; SET TB TO ONE FRAME AHEAD
+ JRST FINIS
+PITYO4: POP P,0 ; RESTORE FLAGS
+ MOVSI A,TFALSE ;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
+ MOVEI B,0
+ POPJ P,
+
+PITYO2: MOVE D,TB ; SAVE ONE FRAME AHEAD
+ HRR TB,OTBSAV(TB) ; RESTORE TB
+ JRST PITYO3
+
+
+\f;THE REAL THING
+;NOTE THAT THE FOLLOWING CODE HAS BUGS IF IT IS PRINTING OUT LONG
+;CHARACTER STRINGS
+; (NOTE THAT THE ABOVE COMMENT, IF TRUE, SHOULD NOT BE ADMITTED.)
+ITYO: PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,FLAGS ;SAVE STUFF
+ PUSH P,C
+ PUSH P,A ;SAVE OUTPUT CHARACTER
+
+
+ TLNE FLAGS,UNPRSE ;SKIPS UNPRSE NOT SET
+ JRST UNPROUT ;IF FROM UNPRSE, STASH IN STRING
+ CAIN A,^J
+ PUSHJ P,INTCHK
+ PUSH P,A
+ PUSHJ P,WXCT
+ POP P,A
+ CAIE A,^L ;SKIP IF THIS IS A FORM-FEED
+ JRST NOTFF
+ SETZM LINPOS(B) ;ZERO THE LINE NUMBER
+ JRST ITYXT
+
+NOTFF: CAIE A,15 ;SKIP IF IT IS A CR
+ JRST NOTCR
+ SETZM CHRPOS(B) ;ZERO THE CHARACTER POSITION
+ PUSHJ P,AOSACC ; BUMP COUNT
+ JRST ITYXT1
+
+NOTCR: CAIN A,^I ;SKIP IF NOT TAB
+ JRST TABCNT
+ CAIE A,10 ; BACK SPACE
+ JRST .+3
+ SOS CHRPOS(B) ; BACK UP ONE
+ JRST ITYXT
+ CAIE A,^J ;SKIP IF LINE FEED
+ JRST NOTLF
+ AOS C,LINPOS(B) ;ADD ONE TO THE LINE NUMBER
+ CAMLE C,PAGLN(B) ;SKIP IF THIS DOESN'T TAKES US PAST PAGE END
+ SETZM LINPOS(B)
+ MOVE FLAGS,-2(P)
+ JRST ITYXT
+
+INTCHK: HRRZ 0,-2(B) ; GET CHANNELS FLAGS
+ TRNN 0,C.INTL ; LOSER INTERESTED IN LFS?
+ POPJ P, ; LEAVE IF NOTHING TO DO
+ PUSH TP,$TCHAN
+ PUSH TP,B ; SAVE CHANNEL
+ PUSH P,C
+ PUSH P,E
+ PUSHJ P,GTLPOS ; READ SYSTEMS VERSION OF LINE #
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHAR,CHAR,INTRUP
+ PUSH TP,$TFIX
+ PUSH TP,A
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 3,INTERRUPT
+ POP P,E ; RESTORE POSSIBLE COUNTS
+ POP P,C
+ POP TP,B ; RESTORE CHANNEL
+ SUB TP,[1,,1]
+ MOVEI A,^J
+ POPJ P,
+
+NOTLF: CAIGE A,40
+ AOS CHRPOS(B) ; FOR CONTROL CHARS THAT NEED 2 SPACES
+ AOS CHRPOS(B) ;ADD TO CHARACTER NUMBER
+
+ITYXT: PUSHJ P,AOSACC ; BUMP ACCESS
+ITYXT1: POP P,A ;RESTORE THE ORIGINAL CHARACTER
+
+ITYRET: POP P,C ;RESTORE REGS & RETURN
+ POP P,FLAGS
+ POP TP,B ; GET CHANNEL BACK
+ SUB TP,[1,,1]
+ POPJ P,
+
+TABCNT: PUSH P,D
+ MOVE C,CHRPOS(B)
+ ADDI C,8. ;INCREMENT COUNT BY EIGHT (MOD EIGHT)
+ IDIVI C,8.
+ IMULI C,8.
+ MOVEM C,CHRPOS(B) ;REPLACE COUNT
+ POP P,D
+ JRST ITYXT
+
+UNPROUT: POP P,A ;GET BACK THE ORIG CHAR
+ IDPB A,UPB+2 ;DEPOSIT USING BYTE POINTER I PUSHED LONG AGO
+ SOS UPB+1
+ JRST ITYRET ;RETURN
+
+AOSACC: TLNN FLAGS,BINBIT
+ JRST NRMACC
+ AOS C,ACCESS-1(B) ; COUNT CHARS IN WORD
+ CAMN C,[TFIX,,1]
+ AOS ACCESS(B)
+ CAMN C,[TFIX,,5]
+ HLLZS ACCESS-1(B)
+ POPJ P,
+
+NRMACC: AOS ACCESS(B)
+ POPJ P,
+
+SPACEQ: MOVEI A,40
+ TLNE FLAGS,FLTBIT+BINBIT
+ JRST PITYO ; JUST OUTPUT THE SPACE
+ PUSH P,[1] ; PRINT SPACE IF NOT END OF LINE
+ MOVEI A,1
+ JRST RETIF2
+
+RETIF1: MOVEI A,1
+
+RETIF: PUSH P,[0]
+ TLNE FLAGS,FLTBIT+BINBIT
+ JRST SPOPJ ; IF WE ARE IN FLATSIZE THEN ESCAPE
+RETIF2: PUSH P,FLAGS
+RETCH: PUSH P,A
+
+RETCH1: ADD A,CHRPOS(B) ;ADD THE CHARACTER POSITION
+ SKIPN CHRPOS(B) ; IF JUST RESET, DONT DO IT AGAIN
+ JRST RETXT
+ CAMG A,LINLN(B) ;SKIP IF GREATER THAN LINE LENGTH
+ JRST RETXT1
+
+ MOVEI A,^M ;FORCE A CARRIAGE RETURN
+ SETZM CHRPOS(B)
+ PUSHJ P,WXCT
+ PUSHJ P,AOSACC ; BUMP CHAR COUNT
+ MOVEI A,^J ;AND FORCE A LINE FEED
+ PUSHJ P,INTCHK ; CHECK FOR ^J INTERRUPTS
+ PUSHJ P,WXCT
+ PUSHJ P,AOSACC ; BUMP CHAR COUNT
+ AOS A,LINPOS(B)
+ CAMG A,PAGLN(B) ;AT THE END OF THE PAGE ?
+ JRST RETXT
+; MOVEI A,^L ;IF SO FORCE A FORM FEED
+; PUSHJ P,WXCT
+; PUSHJ P,AOSACC ; BUMP CHAR COUNT
+ SETZM LINPOS(B)
+
+RETXT: POP P,A
+
+ POP P,FLAGS
+SPOPJ: SUB P,[1,,1]
+ POPJ P, ;RETURN
+
+PRETIF: PUSH P,A ;SAVE CHAR
+ PUSHJ P,RETIF1
+ POP P,A
+ JRST PITYO
+
+RETIF3: TLNE FLAGS,FLTBIT ; NOTHING ON FLATSIZE
+ POPJ P,
+ PUSH P,[0]
+ PUSH P,FLAGS
+ HRRI FLAGS,2 ; PRETEND ONLY 1 CHANNEL
+ PUSH P,A
+ JRST RETCH1
+
+RETXT1: SKIPN -2(P) ; SKIP IF SPACE HACK
+ JRST RETXT
+ MOVEI A,40
+ PUSHJ P,WXCT
+ AOS CHRPOS(B)
+ PUSH P,C
+ PUSHJ P,AOSACC
+ POP P,C
+ JRST RETXT
+
+\f;THIS IS CODE TO HANDLE UNKNOWN DATA TYPES.
+;IT PRINTS "*XXXXXX*XXXXXXXXXXXX*", WHERE THE FIRST NUMBER IS THE
+;TYPE CODE IN OCTAL, THE SECOND IS THE VALUE FIELD IN OCTAL.
+PRERR: MOVEI A,21. ;CHECK FOR 21. SPACES LEFT ON PRINT LINE
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF ;INSERT CARRIAGE RETURN IF NOT ENOUGH
+ MOVEI A,"* ;JUNK TO INDICATE ERROR PRINTOUT IN OCTAL
+ PUSHJ P,PITYO ;TYPE IT
+
+ MOVE E,[000300,,-2(TP)] ;GET POINTER INDEXED OFF TP SO THAT
+ ;TYPE CODE MAY BE OBTAINED FOR PRINTING.
+ MOVEI D,6 ;# OF OCTAL DIGITS IN HALF WORD
+OCTLP1: ILDB A,E ;GET NEXT 3-BIT BYTE OF TYPE CODE
+ IORI A,60 ;OR-IN 60 FOR ASCII DIGIT
+ PUSHJ P,PITYO ;PRINT IT
+ SOJG D,OCTLP1 ;REPEAT FOR SIX CHARACTERS
+
+PRE01: MOVEI A,"* ;DELIMIT TYPE CODE FROM VALUE FIELD
+ PUSHJ P,PITYO
+
+ HRLZI E,(410300,,(TP)) ;BYTE POINTER TO SECOND WORD
+ ;INDEXED OFF TP
+ MOVEI D,12. ;# OF OCTAL DIGITS IN A WORD
+OCTLP2: LDB A,E ;GET 3 BITS
+ IORI A,60 ;CONVERT TO ASCII
+ PUSHJ P,PITYO ;PRINT IT
+ IBP E ;INCREMENT POINTER TO NEXT BYTE
+ SOJG D,OCTLP2 ;REPEAT FOR 12. CHARS
+
+ MOVEI A,"* ;DELIMIT END OF ERROR TYPEOUT
+ PUSHJ P,PITYO ;REPRINT IT
+
+ JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
+
+POCTAL: MOVEI A,14. ;RETURN TO NEW LINE IF 14. SPACES NOT LEFT
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF
+ JRST PRE01 ;PRINT VALUE AS "*XXXXXXXXXXXX*"
+
+\f;PRINT BINARY INTEGERS IN DECIMAL.
+;
+PFIX: MOVM E,(TP) ; GET # (MAFNITUDE)
+ JUMPL E,POCTAL ; IF ABS VAL IS NEG, MUST BE SETZ
+ PUSH P,FLAGS
+
+PFIX1: MOVE B,-2(TP) ; GET CHANNEL INTO B
+PFIX2: MOVE D,UPB+6 ; IF UNPARSE, THIS IS RADIX
+ TLNE FLAGS,UNPRSE+FLTBIT ;SKIPS IF NOT FROM UNPARSE OR FLATSIZE
+ JRST PFIXU
+ MOVE D,RADX(B) ; GET OUTPUT RADIX
+PFIXU: CAIG D,1 ; DONT ALLOW FUNNY RADIX
+ MOVEI D,10. ; IF IN DOUBT USE 10.
+ PUSH P,D
+ MOVEI A,1 ; START A COUNTER
+ SKIPGE B,(TP) ; CHECK SIGN
+ MOVEI A,2 ; NEG, NEED CHAR FOR SIGN
+
+ IDIV B,D ; START COUNTING
+ JUMPE B,.+2
+ AOJA A,.-2
+
+ MOVE B,-2(TP) ; CHANNEL TO B
+ TLNN FLAGS,FLTBIT+BINBIT
+ PUSHJ P,RETIF3 ; CHECK FOR C.R.
+ MOVE B,-2(TP) ; RESTORE CHANNEL
+ MOVEI A,"- ; GET SIGN
+ SKIPGE (TP) ; SKIP IF NOT NEEDED
+ PUSHJ P,PITYO
+ MOVM C,(TP) ; GET MAGNITUDE OF #
+ MOVE B,-2(TP) ; RESTORE CHANNEL
+ POP P,E ; RESTORE RADIX
+ PUSHJ P,FIXTYO ; WRITE OUT THE #
+ MOVE FLAGS,-1(P)
+ SUB P,[1,,1] ; FLUSH P STUFF
+ JRST PNEXT
+
+FIXTYO: IDIV C,E
+ PUSH P,D ; SAVE REMAINDER
+ SKIPE C
+ PUSHJ P,FIXTYO
+ POP P,A ; START GETTING #'S BACK
+ ADDI A,60
+ MOVE B,-2(TP) ; CHANNEL BACK
+ JRST PITYO
+
+\f;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
+;
+PFLOAT: SKIPN A,(TP) ; SKIP IF NUMBER IS NON-ZERO
+ ; SPECIAL HACK FOR ZERO)
+ JRST PFLT0 ; HACK THAT ZERO
+ MOVM E,A ; CHECK FOR NORMALIZED
+ TLNN E,400 ; NORMALIZED
+ JRST PUNK
+ MOVE E,[SETZ FLOATB] ;ADDRESS OF FLOATING POINT CONVERSION ROUTINE
+ MOVE D,[6,,6] ;# WORDS TO GET FROM STACK
+
+PNUMB: HRLI A,1(P) ; LH(A) TO CONTAIN ADDRESS OF RETURN AREA
+ ; ON STACK
+ HRR A,TP ; RH(A) TO CONTAIN ADDRESS OF DATA ITEM
+ HLRZ B,A ; SAVE RETURN AREA ADDRESS IN REG B
+ ADD P,D ; ADD # WORDS OF RETURN AREA TO BOTH HALVES OF
+ ; SP
+ JUMPGE P,PDLERR ; PLUS OR ZERO STACK POINTER IS OVERFLOW
+PDLWIN: PUSHJ P,(E) ; CALL ROUTINE WHOSE ADDRESS IS IN REG E
+
+ MOVE C,(B) ; GET COUNT 0F # CHARS RETURNED
+PFLT1: MOVE A,B
+ HRR B,P ; GET PSTACK POINTER AND PRODUCE RELATAVIZED
+ SUB A,B
+ HRLS A ; ADD TO AOBJN
+ ADD A,P ; PRODUCE PDL POINTER
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSH TP,$TPDL ; PUSH PDL POINTER
+ PUSH TP,A
+ MOVE A,C ; MAKE SURE THAT # WILL FIT ON PRINT LINE
+ PUSH P,D ; WATCH THAT MCALL
+ PUSHJ P,RETIF ; START NEW LINE IF IT WON'T
+ POP P,D
+ POP TP,B ; RESTORE B
+ SUB TP,[1,,1] ; CLEAN OFF STACK
+
+ HRLI B,000700 ;MAKE REG B INTO BYTE POINTER TO FIRST CHAR
+ ; LESS ONE
+PNUM01: ILDB A,B ; GET NEXT BYTE
+ PUSH P,B ; SAVE B
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PITYO ; PRINT IT
+ POP P,B ; RESTORE B
+ SOJG C,PNUM01 ; DECREMENT CHAR COUNT: LOOP IF NON-ZERO
+
+ SUB P,D ;SUBTRACT # WORDS USED ON STACK FOR RETURN
+ JRST PNEXT ;STORE REGS & POP UP ONE LEVEL TO CALLER
+
+
+PFLT0: MOVEI A,9. ; WIDTH OF 0.0000000
+ MOVEI C,9. ; SEE ABOVE
+ MOVEI D,0 ; WE'RE GONNA TEST D SOON...SO WILL DO RIGHT THING
+ MOVEI B,[ASCII /0.0000000/]
+ SOJA B,PFLT1 ; PT TO 1 BELOW CONST, THEN REJOIN CODE
+
+
+
+
+PDLERR: SUB P,D ;REST STACK POINTER
+REPEAT 6,PUSH P,[0]
+ JRST PDLWIN
+\f
+; FLOATING POINT PRINTER STOLEN FROM DDT
+
+F==E+1
+G==F+1
+H==G+1
+I==H+1
+J==I+1
+TEM1==I
+
+FLOATB: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,F
+ PUSH P,G
+ PUSH P,H
+ PUSH P,I
+ PUSH P,0
+ PUSH P,J
+ MOVSI 0,440700 ; BUILD BYTEPNTR
+ HLRZ J,A ; POINT TO BUFFER
+ HRRI 0,1(J)
+ ANDI A,-1
+ MOVE A,(A) ; GET NUMBER
+ MOVE D,A
+ SETZM (J) ; Clear counter
+ PUSHJ P,NFLOT
+ POP P,J
+ POP P,0
+ POP P,I
+ POP P,H
+ POP P,G
+ POP P,F
+ POP P,D
+ POP P,C
+ POP P,B
+ POPJ P,
+
+; at this point we enter code abstracted from DDT.
+NFLOT: JUMPG A,TFL1
+ JUMPE A,FP1A
+ MOVNS A
+ PUSH P,A
+ MOVEI A,"-
+ PUSHJ P,CHRO
+ POP P,A
+ TLZE A,400000
+ JRST FP1A
+
+TFL1: MOVEI B,0
+TFLX: CAMGE A,FT01
+ JRST FP4
+ CAML A,FT8
+ AOJA B,FP4
+FP1A:
+FP3: SETZB C,TEM1 ; CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
+ MULI A,400
+ ASHC B,-243(A)
+ MOVE A,B
+ PUSHJ P,FP7
+ PUSH P,A
+ MOVEI A,".
+ PUSHJ P,CHRO
+ POP P,A
+ MOVNI A,10
+ ADD A,TEM1
+ MOVE E,C
+FP3A: MOVE D,E
+ MULI D,12
+ PUSHJ P,FP7B
+ SKIPE E
+ AOJL A,FP3A
+ POPJ P, ; ONE return from OFLT here
+
+FP4: MOVNI C,6
+ MOVEI F,0
+FP4A: ADDI F,1(F)
+ XCT FCP(B)
+ SOSA F
+ FMPR A,@FXP+1(B)
+ AOJN C,FP4A
+ PUSH P,EXPSGN(B)
+ PUSHJ P,FP3
+ PUSH P,A
+ MOVEI A,"E
+ PUSHJ P,CHRO
+ POP P,A
+ POP P,D
+ PUSHJ P,FDIGIT
+ MOVE A,F
+
+FP7: SKIPE A ; AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
+ AOS TEM1
+ IDIVI A,12
+ PUSH P,B
+ JUMPE A,FP7A1
+ PUSHJ P,FP7
+
+FP7A1: POP P,D
+FP7B: ADDI D,"0
+
+; type digit
+FDIGIT: PUSH P,A
+ MOVE A,D
+ PUSHJ P,CHRO
+ POP P,A
+ POPJ P,
+
+CHRO: AOS (J) ; COUNT CHAR
+ IDPB A,0 ; STUFF CHAR
+ POPJ P,
+
+; constants
+ 1.0^32.
+ 1.0^16.
+FT8: 1.0^8
+ 1.0^4
+ 1.0^2
+ 1.0^1
+FT: 1.0^0
+ 1.0^-32.
+ 1.0^-16.
+ 1.0^-8
+ 1.0^-4
+ 1.0^-2
+FT01: 1.0^-1
+FT0=FT01+1
+
+; instructions
+FCP: CAMLE A, FT0(C)
+ CAMGE A, FT(C)
+ 0, FT0(C)
+FXP: SETZ FT0(C)
+ SETZ FT(C)
+ SETZ FT0(C)
+EXPSGN: "-
+ "+
+
+\f
+;PRINT SHORT (ONE WORD) CHARACTER STRINGS
+
+PCHRS: MOVEI A,3 ;MAX # CHARS PLUS 2 (LESS ESCAPES)
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ TLNE FLAGS,NOQBIT ;SKIP IF QUOTES WILL BE USED
+ MOVEI A,1 ;ELSE, JUST ONE CHARACTER POSSIBLE
+ PUSHJ P,RETIF ;NEW LINE IF INSUFFICIENT SPACE
+ TLNE FLAGS,NOQBIT ;DON'T QUOTE IF IN PRINC MODE
+ JRST PCASIS
+ MOVEI A,"! ;TYPE A EXCL
+ PUSHJ P,PITYO
+ MOVEI A,"\ ;AND A BACK SLASH
+ PUSHJ P,PITYO
+
+PCASIS: MOVE A,(TP) ;GET NEXT BYTE FROM WORD
+ TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
+ JRST PCPRNT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
+ CAIE A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
+ JRST PCPRNT ;ESCAPE THE ESCAPE CHARACTER
+
+ESCPRT: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
+ PUSHJ P,PITYO
+PCPRNT: MOVE A,(TP) ;GET THE CHARACTER AGAIN
+ TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
+ TLO FLAGS,CNTLPC ;SWITCH ON ^P MODE TEMPORARY
+ PUSHJ P,PITYO ;PRINT IT
+ TLZ FLAGS,CNTLPC ;SWITCH OFF ^P MODE
+ JRST PNEXT
+
+
+\f;PRINT DEFERED (INVISIBLE) ITEMS. (PRINTED AS THE THING POINTED TO)
+;
+PDEFER: MOVE A,(B) ;GET FIRST WORD OF ITEM
+ MOVE B,1(B) ;GET SECOND
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ;PRINT IT
+ SUB TP,[2,,2] ; POP OFF CHANNEL
+ JRST PNEXT ;GO EXIT
+
+
+; Print an ATOM. TRAILERS are added if the atom is not in the current
+; lexical path. Also escaping of charactets is performed to allow READ
+; to win.
+
+PATOM: PUSH P,[440700,,D] ; PUSH BYE POINTER TO FINAL STRING
+ SETZB D,E ; SET CHARCOUNT AD DESTINATION TO 0
+ HLLZS -1(TP) ; RH OF TATOM,, WILL COUNT ATOMS IN PATH
+
+PATOM0: PUSH TP,$TPDL ; SAVE CURRENT STAKC FOR \ LOGIC
+ PUSH TP,P
+ LDB A,[301400,,(P)] ; GET BYTE PTR POSITION
+ DPB A,[301400,,E] ; SAVE IN E
+ MOVE C,-2(TP) ; GET ATOM POINTER
+ ADD C,[3,,3] ; POINT TO PNAME
+ JUMPGE C,BADPNM ; NO PNAME, ERROR
+ HLRE A,C ; -# WORDS TO A
+ PUSH P,A ; PUSH THAT FOR "AOSE"
+ MOVEI A,177 ; PUT RUBOUT WHERE \ MIGHT GO
+ JSP B,DOIDPB
+ HRLI C,440700 ; BUILD BYTE POINTER
+ ILDB A,C ; GET FIRST BYTE
+ JUMPE A,BADPNM ; NULL PNAME, ERROR
+ SKIPA
+PATOM1: ILDB A,C ; GET A CHAR
+ JUMPE A,PATDON ; END OF PNAME?
+ TLNN C,760000 ; SKIP IF NOT WORD BOUNDARY
+ AOS (P) ; COUNT WORD
+ JRST PENTCH ; ENTER THE CHAR INTO OUTPUT
+
+PATDON: LDB A,[220600,,E] ; GET "STATE"
+ LDB A,STABYT+NONSPC+1 ; SIMULATE "END" CHARACTER
+ DPB A,[220600,,E] ; AND STORE
+ MOVE B,E ; SETUP BYTE POINTER TO 1ST CHAR
+ TLZ B,77
+ HRR B,(TP) ; POINT
+ SUB TP,[2,,2] ; FLUSH SAVED PDL
+ MOVE C,-1(P) ; GET BYE POINTER
+ SUB P,[2,,2] ; FLUSH
+ PUSH P,D
+ MOVEI A,0
+ IDPB A,B
+ AOS -1(TP) ; COUNT ATOMS
+ TLNE FLAGS,NOQBIT ; SKIP IF NOT "PRINC"
+ JRST NOLEX4 ; NEEDS NO LEXICAL TRAILERS
+ MOVEI A,"\ ; GET QUOTER
+ TLNN E,2 ; SKIP IF NEEDED
+ JRST PATDO1
+ SOS -1(TP) ; DONT COUNT BECAUSE OF SLASH
+ DPB A,B ; CLOBBER
+PATDO1: MOVEI E,(E) ; CLEAR LH(E)
+ PUSH P,C ; SAVE BYTER
+ PUSH P,E ; ALSO CHAR COUNT
+
+ MOVE B,IMQUOTE OBLIST
+ PUSH P,FLAGS
+ PUSHJ P,IDVAL ; GET LOCAL/GLOBAL VALUE
+ POP P,FLAGS ; AND RESTORES FLAGS
+ MOVE C,(TP) ; GET ATOM BACK
+ HRRZ C,2(C) ; GET ITS OBLIST
+ SKIPN C
+ AOJA A,NOOBL1 ; NONE, USE FALSE
+ CAMG C,VECBOT ; JUMP IF REAL OBLIST
+ MOVE C,(C)
+ HRROS C
+ CAME A,$TLIST ; SKIP IF A LIST
+ CAMN A,$TOBLS ; SKIP IF UNREASONABLE VALUE
+ JRST CHOBL ; WINS, NOW LOCATE IT
+
+CHROOT: CAME C,ROOT+1 ; IS THIS ROOT?
+ JRST FNDOBL ; MUST FIND THE PATH NAME
+ POP P,E ; RESTORE CHAR COUNT
+ MOVE D,(P) ; AND PARTIAL WORD
+ EXCH D,-1(P) ; STORE BYTE POINTER AND GET PARTIAL WORD
+ MOVEI A,"! ; PUT OUT MAGIC
+ JSP B,DOIDPB ; INTO BUFFER
+ MOVEI A,"-
+ JSP B,DOIDPB
+ MOVEI A,40
+ JSP B,DOIDPB
+
+NOLEX0: SUB P,[2,,2] ; REMOVE COUNTER AND BYTE POINTER
+ PUSH P,D ; PUSH NEXT WORD IF ANY
+ JRST NOLEX4
+
+NOLEX: MOVE E,(P) ; GET COUNT
+ SUB P,[2,,2]
+NOLEX4: MOVEI E,(E) ; CLOBBER LH(E)
+ MOVE A,E ; COUNT TO A
+ SKIPN (P) ; FLUSH 0 WORD
+ SUB P,[1,,1]
+ HRRZ C,-1(TP) ; GET # OF ATOMS
+ SUBI A,(C) ; FIX COUNT
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF ; MAY NEED C.R.
+ MOVEI C,-1(E) ; COMPUTE WORDS-1
+ IDIVI C,5 ; WORDS-1 TO C
+ HRLI C,(C)
+ MOVE D,P
+ SUB D,C ; POINTS TO 1ST WORD OF CHARS
+ MOVSI C,440700+D ; BYTEPOINTER TO STRING
+ PUSH TP,$TPDL ; SAVE FROM GC
+ PUSH TP,D
+
+PATOUT: ILDB A,C ; READ A CHAR
+ SKIPE A ; IGNORE NULS
+ PUSHJ P,PITYO ; PRINT IT
+ MOVE D,(TP) ; RESTORE POINTER
+ SOJG E,PATOUT
+
+NOLEXD: SUB TP,[2,,2] ; FLUSH TP JUNK
+ MOVE P,D ; RESTORE P
+ SUB P,[1,,1]
+ JRST PNEXT
+
+
+PENTCH: TLNE FLAGS,NOQBIT ; "PRINC"?
+ JRST PENTC1 ; YES, AVOID SLASHING
+ IDIVI A,CHRWD ; GET CHARS TYPE
+ LDB B,BYTPNT(B)
+ CAILE B,NONSPC ; SKIP IF NOT SPECIAL
+ JRST PENTC2 ; SLASH IMMEDIATE
+ LDB A,[220600,,E] ; GET "STATE"
+ LDB A,STABYT-1(B) ; GET NEW STATE
+ DPB A,[220600,,E] ; AND SAVE IT
+PENTC3: LDB A,C ; RESTORE CHARACTER
+PENTC1: JSP B,DOIDPB
+ SKIPGE (P) ; SKIP IF DONE
+ JRST PATOM1 ; CONTINUE
+ JRST PATDON
+
+PENTC2: MOVEI A,"\ ; GET CHAR QUOTER
+ JSP B,DOIDPB ; NEEDED, DO IT
+ MOVEI A,4 ; PATCH FOR ATOMS ALREADY BACKSLASHED
+ JRST PENTC3-1
+
+; ROUTINE TO PUT ONE CHAR ON STACK BUFFER
+
+DOIDPB: IDPB A,-1(P) ; DEPOSIT
+ TRNN D,377 ; SKIP IF D FULL
+ AOJA E,(B)
+ PUSH P,(P) ; MOVE TOP OF STACK UP
+ MOVEM D,-2(P) ; SAVE WORDS
+ MOVE D,[440700,,D]
+ MOVEM D,-1(P)
+ MOVEI D,0
+ AOJA E,(B)
+
+; CHECK FOR UNIQUENESS LOOKING INTO PATH
+
+CHOBL: CAME A,$TOBLS ; SINGLE OBLIST?
+ JRST LSTOBL ; NO, AL LIST THEREOF
+ CAME B,C ; THE RIGTH ONE?
+ JRST CHROOT ; NO, CHECK ROOT
+ JRST NOLEX ; WINNER, NO TRAILERS!
+
+LSTOBL: PUSH TP,A ; SCAN A LIST OF OBLISTS
+ PUSH TP,B
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TOBLS
+ PUSH TP,C
+
+NXTOB2: INTGO ; LIST LOOP, PREVENT LOSSAGE
+ SKIPN C,-2(TP) ; SKIP IF NOT DONE
+ JRST CHROO1 ; EMPTY, CHECK ROOT
+ MOVE B,1(C) ; GET ONE
+ CAME B,(TP) ; WINNER?
+ JRST NXTOBL ; NO KEEP LOOKING
+ CAMN C,-4(TP) ; SKIP IF NOT FIRST ON LIST
+ JRST NOLEX1
+ MOVE A,-6(TP) ; GET ATOM BACK
+ MOVEI D,0
+ ADD A,[3,,3] ; POINT TO PNAME
+ PUSH P,0 ; SAVE FROM RLOOKU
+ PUSH P,(A)
+ ADDI D,5
+ AOBJN A,.-2 ; PUSH THE PNAME
+ PUSH P,D ; AND CHAR COUNT
+ MOVSI A,TLIST ; TELL RLOOKU WE WIN
+ MOVE B,-4(TP) ; GET BACK OBLIST LIST
+ SUB TP,[6,,6] ; FLUSH CRAP
+ PUSHJ P,RLOOKU ; FIND IT
+ POP P,0
+ CAMN B,(TP) ; SKIP IF NON UNIQUE
+ JRST NOLEX ; UNIQUE , NO TRAILER!!
+ JRST CHROO2 ; CHECK ROOT
+
+NXTOBL: HRRZ B,@-2(TP) ; STEP THE LIST
+ MOVEM B,-2(TP)
+ JRST NXTOB2
+
+
+FNDOBL: MOVE C,(TP) ; GET ATOM
+ MOVSI A,TOBLS
+ HRRZ B,2(C)
+ CAMG B,VECBOT
+ MOVE B,(B)
+ HRLI B,-1
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE OBLIST
+ PUSH P,0
+ PUSHJ P,IGET
+ POP P,0
+NOOBL1: POP P,E ; RESTORE CHAR COUNT
+ MOVE D,(P) ; GET PARTIAL WORD
+ EXCH D,-1(P) ; AND BYTE POINTER
+ CAME A,$TATOM ; IF NOT ATOM, USE FALSE
+ JRST NOOBL
+ MOVEM B,(TP) ; STORE IN ATOM SLOT
+ MOVEI A,"!
+ JSP B,DOIDPB ; WRITE IT OUT
+ MOVEI A,"-
+ JSP B,DOIDPB
+ SUB P,[1,,1]
+ JRST PATOM0 ; AND LOOP
+
+NOOBL: MOVE C,[440700,,[ASCIZ /!-#FALSE ()/]]
+ ILDB A,C
+ JUMPE A,NOLEX0
+ JSP B,DOIDPB
+ JRST .-3
+
+
+NOLEX1: SUB TP,[6,,6] ; FLUSH STUFF
+ JRST NOLEX
+
+CHROO1: SUB TP,[6,,6]
+CHROO2: MOVE C,(TP) ; GET ATOM
+ HRRZ C,2(C) ; AND ITS OBLIST
+ CAMG C,VECBOT
+ MOVE C,(C)
+ HRROS C
+ JRST CHROOT
+BADPNM: ERRUUO EQUOTE BAD-PNAME
+
+
+\f; STATE TABLES FOR \ OF FIRST CHAR
+; Each word is a state and each 4 bit byte tells where to go based on the input
+; type. The types are defined in READER >. The input type selects a byte pointer
+; into the table which is indexed by the current state.
+
+RADIX 16.
+
+STATS: 431192440 ; INITIAL STATE (0)
+ 434444444 ; HERE ON INIT +- (1)
+ 222222242 ; HERE ON INIT . (2)
+ 434445642 ; HERE ON INIT DIGIT (3)
+ 444444444 ; HERE IF NO \ NEEDE (4)
+ 454444642 ; HERE ON DDDD. (5)
+ 487744444 ; HERE ON E (6)
+ 484444444 ; HERE ON E+- (7)
+ 484444442 ; HERE ON E+-DDD (8)
+ 494444444+<1_28.> ; HERE ON * (HACK IS TO GET A 10 IN THERE) (9)
+ 494494444+<1_28.>+<2_16.> ; HERE ON *DDDDD (10)
+ 444444442
+
+RADIX 8.
+
+STABYT: 400400,,STATS(A) ; LETTERS
+ 340400,,STATS(A) ; NUMBERS
+ 300400,,STATS(A) ; PLUS SIGN +
+ 240400,,STATS(A) ; MINUS SIGN -
+ 200400,,STATS(A) ; asterick *
+ 140400,,STATS(A) ; PERIOD .
+ 100400,,STATS(A) ; LETTER E
+ 040400,,STATS(A) ; extra
+ 000400,,STATS(A) ; HERE ON RAP UP
+
+\f;PRINT LONG CHARACTER STRINGS.
+;
+PCHSTR: MOVE B,(TP)
+ TLZ FLAGS,ATMBIT ;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
+ MOVE D,[AOS E] ;GET INSTRUCTION TO COUNT CHARACTERS
+ SETZM E ;ZERO COUNT
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP) ;GIVE PCHRST SOME GOODIES TO PLAY WITH
+ PUSHJ P,PCHRST ;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
+ SUB TP,[4,,4] ;FLUSH MUNGED GOODIES
+ MOVE A,E ;PUT COUNT RETURNED IN REG A
+ TLNN FLAGS,NOQBIT ;SKIP (NO QUOTES) IF IN PRINC (BIT ON)
+ ADDI A,2 ;PLUS TWO FOR QUOTES
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF ;START NEW LINE IF NO SPACE
+ TLNE FLAGS,NOQBIT ;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
+ JRST PCHS01 ;OTHERWISE, DON'T QUOTE
+ MOVEI A,"" ;PRINT A DOUBLE QUOTE
+ MOVE B,-2(TP)
+ PUSHJ P,PITYO
+
+PCHS01: MOVE D,[PUSHJ P,PITYO] ;OUTPUT INSTRUCTION
+ PUSHJ P,PCHRST ;TYPE STRING
+
+ TLNE FLAGS,NOQBIT ;AGAIN, SKIP IF DOUBLE-QUOTING TO BE DONE
+ JRST PNEXT ;RESTORE REGS & POP UP ONE LEVEL TO CALLER
+ MOVEI A,"" ;PRINT A DOUBLE QUOTE
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,PITYO
+ JRST PNEXT
+
+
+;INTERNAL ROUTINE USED TO COUNT OR OUTPUT CHARACTER STRINGS.
+;THE APPROPRIATE ESCAPING CONVENTIONS ARE USED AS DETERMINED BY THE FLAG BITS.
+PCHRST: PUSH P,A ;SAVE REGS
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+
+PCHR02: INTGO ; IN CASE VERY LONG STRING
+ HRRZ C,-1(TP) ;GET COUNT
+ SOJL C,PCSOUT ; DONE?
+ HRRM C,-1(TP)
+ ILDB A,(TP) ; GET CHAR
+
+ TLNE FLAGS,NOQBIT ;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
+ JRST PCSPRT ;IF BIT IS ON, PRINT WITHOUT ESCAPING
+ CAIN A,ESCHAR ;SKIP IF NOT THE ESCAPE CHARACTER
+ JRST ESCPRN ;ESCAPE THE ESCAPE CHARACTER
+ CAIN A,"" ;SKIP IF NOT A DOUBLE QUOTE
+ JRST ESCPRN ;OTHERWISE, ESCAPE THE """
+ IDIVI A,CHRWD ;CODE HERE FINDS CHARACTER TYPE
+ LDB B,BYTPNT(B) ; "
+ CAIG B,NONSPC ;SKIP IF NOT A NUMBER/LETTER
+ JRST PCSPRT ;OTHERWISE, PRINT IT
+ TLNN FLAGS,ATMBIT ;SKIP IF PRINTING AN ATOM-NAME (UNQUOTED)
+ JRST PCSPRT ;OTHERWISE, NO OTHER CHARS TO ESCAPE
+
+ESCPRN: MOVEI A,ESCHAR ;TYPE THE ESCAPE CHARACTER
+ PUSH P,B ; SAVE B
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ XCT (P)-1
+ POP P,B ; RESTORE B
+
+PCSPRT: LDB A,(TP) ;GET THE CHARACTER AGAIN
+ PUSH P,B ; SAVE B
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ TLNE FLAGS,NOQBIT ; SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
+ TLO FLAGS,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
+ XCT (P)-1 ;PRINT IT
+ TLZ FLAGS,CNTLPC ; SWITCH OFF ^P MODE
+ POP P,B ; RESTORE B
+ JRST PCHR02 ;LOOP THROUGH STRING
+
+PCSOUT: POP P,D
+ POP P,C ;RESTORE REGS & RETURN
+ POP P,B
+ POP P,A
+ POPJ P,
+
+
+\f
+; PRINT AN ARBITRARY BYTE STRING
+
+PBYTE: PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ MOVEI A,"#
+ MOVE B,(TP)
+ PUSHJ P,PRETIF
+ LDB B,[300600,,-2(TP)]
+ MOVSI A,TFIX
+ PUSHJ P,IPRINT
+ MOVE B,(TP)
+ PUSHJ P,SPACEQ
+ MOVEI A,"{
+ MOVE B,(TP)
+ PUSHJ P,PRETIF
+ HRRZ A,-3(TP) ; CHAR COUNT
+ JUMPE A,CLSBYT
+
+BYTLP: SOS -3(TP)
+ ILDB B,-2(TP) ; GET A BYTE
+ MOVSI A,TFIX
+ PUSHJ P,IPRINT
+ HRRZ A,-3(TP)
+ JUMPE A,CLSBYT
+ MOVE B,(TP)
+ PUSHJ P,SPACEQ
+ JRST BYTLP
+
+CLSBYT: MOVEI A,"}
+ MOVE B,(TP)
+ PUSHJ P,PRETIF
+ SUB TP,[2,,2]
+ JRST PNEXT
+
+
+;PRINT AN ARGUMENT LIST
+;CHECK FOR TIME ERRORS
+
+PARGS: MOVEI B,-1(TP) ;POINT TO ARGS POINTER
+ PUSHJ P,CHARGS ;AND CHECK THEM
+ JRST PVEC ; CHEAT TEMPORARILY
+
+
+
+;PRINT A FRAME
+PFRAME: MOVEI B,-1(TP) ;POINT TO FRAME POINTER
+ PUSHJ P,CHFRM
+ HRRZ B,(TP) ;POINT TO FRAME ITSELF
+ HRRZ B,FSAV(B) ;GET POINTER TO SUBROUTINE
+ CAIL B,HIBOT
+ SKIPA B,@-1(B) ; SUBRS AND FSUBRS
+ MOVE B,3(B) ; FOR RSUBRS
+ MOVSI A,TATOM
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ;PRINT FUNCTION NAME
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ JRST PNEXT
+
+PPVP: MOVE B,(TP) ; PROCESS TO B
+ MOVSI A,TFIX
+ JUMPE B,.+3
+ MOVE A,PROCID(B)
+ MOVE B,PROCID+1(B) ;GET ID
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ JRST PNEXT
+
+; HERE TO PRINT LOCATIVES
+
+LOCPT1: HRRZ A,-1(TP)
+ JUMPN A,PUNK
+LOCPT: MOVEI B,-1(TP) ; VALIDITY CHECK
+ PUSHJ P,CHLOCI
+ HRRZ A,-1(TP)
+ JUMPE A,GLOCPT
+ MOVE B,(TP)
+ MOVE A,(B)
+ MOVE B,1(B)
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ JRST PNEXT
+
+GLOCPT: MOVEI A,2
+ MOVE B,-2(TP) ; GET CHANNEL
+ PUSHJ P,RETIF
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM
+ MOVE B,MQUOTE GLOC
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ PUSHJ P,SPACEQ
+ MOVE B,(TP)
+ MOVSI A,TATOM
+ MOVE B,-1(B)
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ PUSHJ P,SPACEQ
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ MOVEI A,">
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+LOCRPT: MOVEI A,2
+ MOVE B,-2(TP) ; GET CHANNEL
+ PUSHJ P,RETIF
+ MOVEI A,"%
+ PUSHJ P,PITYO
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ MOVSI A,TATOM
+ MOVE B,MQUOTE RGLOC
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ PUSHJ P,SPACEQ
+ MOVE B,(TP)
+ MOVSI A,TATOM
+ ADD B,GLOTOP+1 ; GET TO REAL ATOM
+ MOVE B,-1(B)
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ PUSHJ P,SPACEQ
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ PUSH TP,-3(TP)
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2]
+ MOVE B,-2(TP) ; MOVE IN CHANNEL
+ MOVEI A,">
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+\f;PRINT UNIFORM VECTORS.
+;
+PUVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
+ MOVEI A,2 ; ROOM FOR ! AND SQ BRACK?
+ PUSHJ P,RETIF
+ MOVEI A,"! ;TYPE AN ! AND OPEN SQUARE BRACKET
+ PUSHJ P,PITYO
+ MOVEI A,"[
+ PUSHJ P,PITYO
+
+ MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
+ TLNN C,777777 ;SKIP ONLY IF COUNT IS NOT ZERO
+ JRST NULVEC ;ELSE, VECTOR IS EMPTY
+
+ HLRE A,C ;GET NEG COUNT
+ MOVEI D,(C) ;COPY POINTER
+ SUB D,A ;POINT TO DOPE WORD
+ HLLZ A,(D) ;GET TYPE
+ PUSH P,A ;AND SAVE IT
+
+PUVE02: MOVE A,(P) ;PUT TYPE CODE IN REG A
+ MOVE B,(C) ;PUT DATUM INTO REG B
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ;TYPE IT
+ SUB TP,[2,,2] ; POP CHANNEL OF STACK
+ MOVE C,(TP) ;GET AOBJN POINTER
+ AOBJP C,NULVE1 ;JUMP IF COUNT IS ZERO
+ MOVEM C,(TP) ;PUT POINTER BACK ONTO STACK
+
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ
+ MOVE C,(TP)
+ JRST PUVE02 ;LOOP THROUGH VECTOR
+
+NULVE1: SUB P,[1,,1] ;REMOVE STACK CRAP
+NULVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
+ MOVEI A,"! ;TYPE CLOSE BRACKET
+ PUSHJ P,PRETIF
+ MOVEI A,"]
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+\f;PRINT A GENERALIZED VECTOR
+;
+PVEC: MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR [
+ MOVEI A,"[ ;PRINT A LEFT-BRACKET
+ PUSHJ P,PITYO
+
+ MOVE C,(TP) ;GET AOBJN POINTER TO VECTOR
+ TLNN C,777777 ;SKIP IF POINTER-COUNT IS NON-ZERO
+ JRST PVCEND ;ELSE, FINISHED WITH VECTOR
+PVCR01: MOVE A,(C) ;PUT FIRST WORD OF NEXT ELEMENT INTO REG A
+ MOVE B,1(C) ;SECOND WORD OF LIST INTO REG B
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ;PRINT THAT ELEMENT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+
+ MOVE C,(TP) ;GET AOBJN POINTER FROM TP-STACK
+ AOBJP C,PVCEND ;POSITIVE HERE SERIOUS ERROR! (THOUGH NOT PDL)
+ AOBJN C,.+2 ;SKIP AND CONTINUE LOOP IF COUNT NOT ZERO
+ JRST PVCEND ;ELSE, FINISHED WITH VECTOR
+ MOVEM C,(TP) ;PUT INCREMENTED POINTER BACK ON TP-STACK
+
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ
+ MOVE C,(TP) ; RESTORE REGISTER C
+ JRST PVCR01 ;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR
+
+PVCEND: MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR ]
+ MOVEI A,"] ; PRINT A RIGHT-BRACKET
+ PUSHJ P,PITYO
+ JRST PNEXT
+
+\f;PRINT A LIST.
+;
+PLIST: MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF1 ;NEW LINE IF NO SPACE LEFT FOR "("
+ MOVEI A,"( ;TYPE AN OPEN PAREN
+ PUSHJ P,PITYO
+ PUSHJ P,LSTPRT ;PRINT THE INSIDES
+ MOVE B,-2(TP) ; RESTORE CHANNEL TO B
+ PUSHJ P,RETIF1 ;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
+ MOVEI A,") ;TYPE A CLOSE PAREN
+ PUSHJ P,PITYO
+ JRST PNEXT
+
+PSEG: TLOA FLAGS,SEGBIT ;PRINT A SEGMENT (& SKIP)
+
+PFORM: TLZ FLAGS,SEGBIT ;PRINT AN ELEMENT
+
+PLMNT3: MOVE C,(TP)
+ JUMPE C,PLMNT1 ;IF THE CALL IS EMPTY GO AWAY
+ MOVE B,1(C)
+ MOVEI D,0
+ CAMN B,IMQUOTE LVAL
+ MOVEI D,".
+ CAMN B,IMQUOTE GVAL
+ MOVEI D,",
+ CAMN B,IMQUOTE QUOTE
+ MOVEI D,"'
+ JUMPE D,PLMNT1 ;NEITHER, LEAVE
+
+;ITS A SPECIAL HACK
+ HRRZ C,(C)
+ JUMPE C,PLMNT1 ;NIL BODY?
+
+;ITS VALUE OF AN ATOM
+ HLLZ A,(C)
+ MOVE B,1(C)
+ HRRZ C,(C)
+ JUMPN C,PLMNT1 ;IF TERE ARE EXTRA ARGS GO AWAY
+
+ PUSH P,D ;PUSH THE CHAR
+ PUSH TP,A
+ PUSH TP,B
+ TLNN FLAGS,SEGBIT ;SKIP (CONTINUE) IF THIS IS A SEGMENT
+ JRST PLMNT4 ;ELSE DON'T PRINT THE "."
+
+;ITS A SEGMENT CALL
+ MOVE B,-4(TP) ; GET CHANNEL INTO B
+ MOVEI A,2 ; ROOM FOR ! AND . OR ,
+ PUSHJ P,RETIF
+ MOVEI A,"!
+ PUSHJ P,PITYO
+
+PLMNT4: MOVE B,-4(TP) ; GET CHANNEL INTO B
+ PUSHJ P,RETIF1
+ POP P,A ;RESTORE CHAR
+ PUSHJ P,PITYO
+ POP TP,B
+ POP TP,A
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ JRST PNEXT
+
+
+PLMNT1: TLNN FLAGS,SEGBIT ;SKIP IF THIS IS A SEGMENT
+ JRST PLMNT5 ;ELSE DON'T TYPE THE "!"
+
+;ITS A SEGMENT CALL
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ MOVEI A,2 ; ROOM FOR ! AND <
+ PUSHJ P,RETIF
+ MOVEI A,"!
+ PUSHJ P,PITYO
+
+PLMNT5: MOVE B,-2(TP) ; GET CHANNEL FOR B
+ PUSHJ P,RETIF1
+ MOVEI A,"<
+ PUSHJ P,PITYO
+ PUSHJ P,LSTPRT
+ MOVEI A,"!
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ TLNE FLAGS,SEGBIT ;SKIP IF NOT SEGEMNT
+ PUSHJ P,PRETIF
+ MOVEI A,">
+ PUSHJ P,PRETIF
+ JRST PNEXT
+
+
+\f
+LSTPRT: SKIPN C,(TP)
+ POPJ P,
+ HLLZ A,(C) ;GET NEXT ELEMENT
+ MOVE B,1(C)
+ HRRZ C,(C) ;CHOP THE LIST
+ JUMPN C,PLIST1
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ;PRINT THE LAST ELEMENT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ POPJ P,
+
+PLIST1: MOVEM C,(TP)
+ PUSH TP,-3(TP) ; GET CHANNEL FOR IPRINT
+ PUSH TP,-3(TP)
+ PUSHJ P,IPRINT ;PRINT THE NEXT ELEMENT
+ SUB TP,[2,,2] ; POP CHANNEL OFF STACK
+ MOVE B,-2(TP) ; GET CHANNEL INTO B
+ PUSHJ P,SPACEQ
+ JRST LSTPRT ;REPEAT
+
+PNEXT: POP P,FLAGS ;RESTORE PREVIOUS FLAG BITS
+ SUB TP,[2,,2] ;REMOVE INPUT ELEMENT FROM TP-STACK
+ POP P,C ;RESTORE REG C
+ POPJ P,
+
+OPENIT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,FLAGS
+ PUSHJ P,OPNCHN
+ POP P,FLAGS
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ JUMPGE B,FNFFL ;ERROR IF IT CANNOT BE OPENED
+ HRRZ E,-2(B)
+ POPJ P,
+
+
+END
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff