X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=%3Cmdl.int%3E%2Fprint.mid.346;fp=%3Cmdl.int%3E%2Fprint.mid.346;h=4e295bd8fdf692c4c103640b17df0ca2e3d36f95;hb=bab072f950a643ac109660a223b57e635492ac25;hp=0000000000000000000000000000000000000000;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c;p=pdp10-muddle.git diff --git a//print.mid.346 b//print.mid.346 new file mode 100644 index 0000000..4e295bd --- /dev/null +++ b//print.mid.346 @@ -0,0 +1,2711 @@ +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 + + + MFUNCTION 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 + 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 + 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 + + +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, + + + ;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 + + +; 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 + +; 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 + + + +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 + PUSH TP,B + PUSH P,0 ; ATOM CALLER ROUTINE + PUSH P,C + SKIPN C,PRNTYP+1 + JRST PATOM + ADDI C,TATOM+TATOM + SKIPE (C) ; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH + JRST PRDIS1 + SKIPN C,1(C) + JRST PATOM + JRST (C) + +CPCHST: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE + PUSH TP,B + PUSH P,C ; STRING CALLER ROUTINE + PUSH P,FLAGS + SKIPN C,PRNTYP+1 + JRST PATOM + ADDI C,TCHSTR+TCHSTR + SKIPE (C) ; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH + JRST PRDIS1 + SKIPN C,1(C) + JRST PCHSTR + JRST (C) + + + +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, + + +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 + + ; 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 + ; 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 + + ; 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 + 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 + + + ; 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 + HLRZ B,-2(TP) + CAIL B,-4 ; 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 +EXPEN: MOVE B,-4(TP) ; GET CHANNEL INTO B + 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 + + ; 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 + + + ; 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 /###/ + ASCII /##/ + ASCII /#/ + +PFIXU4: HRRZ E,(C) ; GET CURRENT VAL + MOVE E,1(E) + MOVEM C,-2(TP) + PUSHJ P,ATOSQ ; GET SQUOZE + JRST BADFXU + TLO E,400000 ; USE TO DIFFERENTIATE BETWEEN STRING + PUSHJ P,EOUT + MOVE C,-2(TP) + +; 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 + MOVEM C,-2(TP) + +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 + MOVE C,-2(TP) + 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, + + + ; 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 /% + PUSHJ P,PRETIF + JRST PNEXT + +; HERE TO DO OFFSETS: %> + +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 + + ; 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 + ;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 + + + ;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 + + ;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*" + + ;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 + + ;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 + +; 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: "- + "+ + + +;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 + + + ;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 + + + ; 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 + + ;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, + + + +; 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 + + ;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 + + ;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 + + ;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 + + + +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 + \ No newline at end of file