mirror of
https://github.com/PDP-10/its.git
synced 2026-01-24 03:18:05 +00:00
2283 lines
52 KiB
Plaintext
2283 lines
52 KiB
Plaintext
;;; -*-MIDAS-*-
|
||
;;; **************************************************************
|
||
;;; ***** MACLISP ****** PRINT AND FILE-HANDLING FUNCTIONS *******
|
||
;;; **************************************************************
|
||
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
|
||
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
|
||
;;; **************************************************************
|
||
|
||
|
||
SUBTTL FUNNY PRINTING ROUTINES
|
||
|
||
PGBOT PRT
|
||
|
||
|
||
.NOPOINT:
|
||
PUSHJ P,NOTNOT
|
||
HRRZM A,V.NOPOINT
|
||
POPJ P,
|
||
|
||
|
||
COMMENT | HERE IS A FINE HACK THAT GOT SUPERSEDED BY CTYP
|
||
|
||
CTY: PUSHJ P,TYOI ;THIS IS ALWAYS DONE BY A XCT "Q,CTY - FOR RANDOM Q.
|
||
TYOI: PUSH P,A ; USEFUL MAINLY BECAUSE IT SAVES A. WARNING!!!
|
||
MOVE A,-1(P) ; THIS CODE IS VERY HACKISH, DEPENDENT ON THE OPCODE
|
||
LDB A,[270600,,-1(A)] ; OF XCT (256). THIS ONLY WORKS FOR ASCII
|
||
PUSHJ P,(R) ; CHARS IN THE RANGE 40-57. THUS Q MUST BE AMONG
|
||
JRST POPAJ ; [ !"#$%&'()*+,-./] (THE BRACKETS ARE META-CHARS!)
|
||
|
||
| ;END OF COMMENT
|
||
|
||
|
||
;;; XCT N,CTYP
|
||
;;; CAUSES THE N'TH CHARACTER IN TYO1TB TO GET PRINTED VIA
|
||
;;; THE ROUTINE IN R. SYMBOLS ARE DEFINED FOR THESE XCT'S.
|
||
|
||
CTYP: PUSHJ P,TYO1C
|
||
TYO1C: PUSH P,A
|
||
HRRZ A,-1(P)
|
||
LDB A,[270400,,-1(A)]
|
||
MOVE A,TYO1TB(A)
|
||
PUSHJ P,(R)
|
||
JRST POPAJ
|
||
|
||
TYO1TB:
|
||
IRP X,,[#,(,),+,-,.,/,|,:,", ,_,E,D,,.]Z,,[NMBR,LPAR,RPAR,POS
|
||
NEG,DOT,SLSH,VBAR,CLN,DBLQ,SPC,BAK,E,D,CTLQ,DCML]
|
||
%!Z!%=XCT .IRPCNT,CTYP
|
||
"X
|
||
TERMIN
|
||
IFG .-TYO1TB-20, WARN [TOO MANY TYO1TB CHARACTERS]
|
||
|
||
|
||
|
||
SUBTTL NEWIO TYO FUNCTION AND RELATED ROUTINES
|
||
|
||
;;; CALLED BY FUNCTIONS LIKE PRINT WHICH TAKE AN ARG AND
|
||
;;; AN OPTIONAL ASCII OUTPUT FILE ARRAY. DOES ARGS CHECKING
|
||
;;; AND SETS UP AR1 WITH THE CORRECT OUTPUT FILE(S).
|
||
;;; IF ONE ARG IS GIVEN AND THERE ARE NO FILES TO OUTPUT TO
|
||
;;; (^W IS NON-NIL, AND EITHER ^R OR OUTFILES IS NIL),
|
||
;;; THEN A POPJ IS DONE, RETURNING FOR THE CALLING FUNCTION.
|
||
;;; LEFT HALF BITS IN AR1:
|
||
;;; 400000 RH OF AR1 HAS SINGLE FILE ARRAY (ELSE LIST)
|
||
;;; 200000 DO *NOT* OUTPUT TO TTY AS WELL
|
||
;;; IFN SFA, THEN ALSO PRINT/PRINC/PRIN1/TYO BIT
|
||
;;;
|
||
;;; CALLED BY:
|
||
;;; JSP F,PRNARG
|
||
;;; XXX,,[QPRINT] ;ATOM FOR WNA ERROR
|
||
;;; -OR- XXX,,[<SFA-BIT>,,QPRINT] ;IFN SFA
|
||
;;; XXX IS TYPICALLY JFCL. IF XXX IS NEGATIVE, THE RETURN VALUE
|
||
;;; FOR THE FUNCTION IS NIL INSTEAD OF T.
|
||
|
||
PRNARG: AOJN T,PRNAR2
|
||
POP P,A
|
||
PRNAR$: SOVE AR1 AR2A CPNAGX
|
||
PRNAR0: SKIPE AR1,TAPWRT ;IF ^R NOT SET, USE NIL
|
||
HRRZ AR1,VOUTFILES ;OTHERWISE USE OUTFILES
|
||
JUMPN AR1,PRNAR3
|
||
SKIPE TTYOFF
|
||
JRST PRNAR8
|
||
PRNAR3:
|
||
SFA$ HLRZ T,@(F) ;PLACE OPERATIONS FLAG IN AR1
|
||
SFA$ TLO AR1,(T)
|
||
TRNN AR1,-1
|
||
SFA$ JRST PRNTTY ;GOING TO THE TTY
|
||
SFA% JRST 1(F)
|
||
PUSHJ P,MPFLOK
|
||
JRST 1(F)
|
||
PRNAR7: PUSHJ P,OFCAN
|
||
EXCH A,AR1
|
||
PUSHJ P,[IOL [LOSING OUTPUT FILE SPECS!]]
|
||
EXCH A,AR1
|
||
JUMPE T,PRNAR0
|
||
JRST PRNAR4
|
||
|
||
IFN SFA,[
|
||
PRNTTY: TLNE AR1,200000 ;REALLY GOING TO THE TTY?
|
||
JRST 1(F) ;NOPE, SO RETURN
|
||
MOVSI T,AS.SFA ;IS C(TYO) AN SFA?
|
||
MOVE R,V%TYO
|
||
TDNN T,ASAR(R)
|
||
JRST 1(F) ;NOPE, SO ALL IS OK
|
||
HLLZ T,@(F) ;SFA OPERATION MASK
|
||
MOVEI TT,SR.WOM
|
||
TDNN T,@TTSAR(R) ;CAN THE SFA DO THIS OPERATION DIRECTLY?
|
||
JRST 1(F) ;NOPE, IT WILL HANDLER A LOWER-LEVEL THING
|
||
MOVEI C,(A) ;ARG IS THING TO PRINT/PRINC/PRIN1
|
||
MOVEI AR1,(R) ;THE SFA
|
||
JRST ISTCAL ;DO AN INTERNAL SFA CALL
|
||
] ;END IFN SFA
|
||
|
||
PRNAR2: CAME T,XC-1
|
||
JRST PRNAR9
|
||
MOVE A,-1(P)
|
||
MOVEM AR1,-1(P)
|
||
EXCH AR2A,(P)
|
||
PUSH P,CPNAGX
|
||
SKIPN AR1,AR2A
|
||
AOJA T,PRNAR0
|
||
PRNAR4: JSP T,PRNARK
|
||
JRST PRNARA ;ERRONEOUS FILE
|
||
JRST PRNAR6 ;LIST OF SOME KIND
|
||
SFA$ SKIPA ;NORMAL RETURN
|
||
SFA$ JRST PRNAR8 ;HANDLED THE SFA
|
||
PRNAR5: TLO AR1,600000 ;VALID FILE OBJECT
|
||
HLRZ T,@(F)
|
||
TLO AR1,(T)
|
||
JRST 1(F)
|
||
|
||
PRNAR6: TLO AR1,200000
|
||
JRST PRNAR3
|
||
|
||
PRNARA: TLO AR1,200000 ;MAKE ERROR MESSAGE PRINT CORRECTLY
|
||
JRST PRNAR7
|
||
|
||
PRNAR8: SKIPGE (F)
|
||
JRST FALSE
|
||
JRST TRUE
|
||
|
||
PRNAR9: HRRZ D,@(F)
|
||
JRST S1WNAL
|
||
|
||
PNAGX: RSTR AR2A AR1
|
||
CPNAGX: POPJ P,PNAGX
|
||
|
||
;;; CHECK LIST OF FILES IN AR1 FOR VALIDITY.
|
||
;;; SKIPS ON *FAILURE*.
|
||
|
||
MPFLOK: PUSH P,AR1 ;MUST PRESERVE LH OF AR1
|
||
MOVEI AR2A,(AR1)
|
||
MPFLO1: JUMPE AR2A,MPFLO2
|
||
HLRZ AR1,(AR2A)
|
||
JSP T,PRNARK
|
||
JRST MPFLO3 ;ERROR
|
||
JRST MPFLO3 ;LIST (NOT ALLOWED WITHIN ANOTHER LIST)
|
||
SFA$ SKIPA ;NORMAL
|
||
SFA$ JFCL ;HANDLED THE SFA
|
||
HRRZ AR2A,(AR2A)
|
||
JRST MPFLO1
|
||
|
||
MPFLO3: AOS -1(P) ;ERROR - SKIP
|
||
MPFLO2: POP P,AR1
|
||
POPJ P,
|
||
|
||
;;; CHECK OUT OBJECT IN AR1.
|
||
;;; SKIP 3 IF AN SFA, AND HANDLED IT
|
||
;;; SKIP 2 IF A VALID, OPEN, NON-BINARY, OUTPUT FILE OBJECT.
|
||
;;; SKIP 1 IF A LIST (ELEMENTS ARE NOT CHECKED).
|
||
;;; SKIP 0 OTHERWISE.
|
||
|
||
PRNARK: CAIN AR1,TRUTH ;ARG CHECK FOR PRNARG
|
||
HRRZ AR1,V%TYO ;FOR T, ASSUME CONTENTS OF TYO
|
||
JSP TT,XFOSP ;MUST BE FILE ARRAY OR SFA
|
||
JRST PRNRK2
|
||
IFN SFA,[
|
||
JRST PRNRK1
|
||
PUSH P,T ;SAVE T
|
||
MOVEI TT,SR.WOM ;AN SFA
|
||
HLLZ T,@(F) ;THE APPROPRIATE FUNCTION
|
||
TDNN T,@TTSAR(AR1) ;CAN THE SFA DO IT?
|
||
JRST PRNRK3 ;NOPE, RESTORE T AND PROCEED
|
||
PUSHJ FXP,SAV5 ;SAVE THE 'WORLD'
|
||
PUSHJ P,SAVX5
|
||
MOVEI C,(A) ;ARGUMENT TO SFA
|
||
PUSHJ P,ISTCAL
|
||
PUSHJ P,RSTX5
|
||
PUSHJ FXP,RST5
|
||
POP P,T
|
||
JRST 3(T) ;TRIPLE-SKIP RETURN
|
||
PRNRK3: POP P,T
|
||
JRST 2(T) ;DOUBLE-SKIP RETURN, LOWER-LEVEL WILL HANDLE IT
|
||
PRNRK1: ] ;END IFN SFA
|
||
MOVE TT,TTSAR(AR1)
|
||
TLNE TT,TTS.IO ;MUST BE OUTPUT FILE
|
||
TLNE TT,TTS<BN+CL> ;MUST NOT BE CLOSED, NOR BINARY
|
||
JRST (T) ;ERROR
|
||
JRST 2(T) ;SUCCESS - VALID FILE OBJECT
|
||
|
||
PRNRK2: MOVEI TT,(AR1)
|
||
LSH TT,-SEGLOG
|
||
SKIPGE ST(TT)
|
||
JRST 1(T) ;OKAY IF LIST (CALLER USUALLY WILL USE MPFLOK)
|
||
JRST (T) ;ELSE ERROR
|
||
|
||
IFN SFA,[
|
||
;;; FILE-ARRAY OR LIST IN AR1: IF ZERO USE V%TYO
|
||
PRTSTO: PUSH P,PRTSO1 ;IN CASE PRTSTR POPJS
|
||
PUSH FXP,F
|
||
PUSH FXP,A
|
||
MOVEI A,(FXP) ;GIVE IT A PDL NUMBER
|
||
JSP F,PRTSTR ;DO SFA CHECKING
|
||
[SO.TYO,,]
|
||
POP FXP,A
|
||
POPI P,1
|
||
PRTSO1: POPJ FXP,.+1 ;RETURN TO CALLER
|
||
POPI FXP,2 ;HANDLED ALL WE NEEDED TO
|
||
POPJ P,
|
||
|
||
PRTSTR: JUMPE AR1,PRTST1 ;HANDLE DEFAULT CONDITION SPECIALLY
|
||
JSP T,PRNARK ;CHECK OUT C(AR1)
|
||
JFCL ;PROBABLY BAD OUTFILES
|
||
JRST PRTSTL ;A LIST
|
||
JRST 1(F) ;A FILE ARRAY OR UNHANDLED SFA
|
||
POPJ P, ;A HANDLED SFA
|
||
|
||
PRTST1: HRRZ AR1,V%TYO
|
||
MOVEI TT,SR.WOM ;AN SFA
|
||
HLLZ T,@(F) ;THE APPROPRIATE FUNCTION
|
||
TDNN T,@TTSAR(AR1) ;CAN THE SFA DO IT?
|
||
JRST PRTST2 ;NOPE, RETURN NORMALLY
|
||
PUSHJ FXP,SAV5 ;SAVE THE 'WORLD'
|
||
PUSHJ P,SAVX5
|
||
MOVEI C,(A) ;ARGUMENT TO SFA
|
||
PUSHJ P,ISTCAL
|
||
PUSHJ P,RSTX5
|
||
PUSHJ FXP,RST5
|
||
POPJ P, ;RETURN
|
||
PRTST2: SETZ AR1, ;MAKE SURE AR1 IS STILL ZERO
|
||
JRST 1(F) ;THEN RETURN TO CALLER
|
||
|
||
PRTSTL: PUSHJ P,MPFLOK ;CHECK THE LIST IN AR1
|
||
JRST 1(F) ;RETURN IF ALL OK
|
||
PUSHJ P,OFCAN
|
||
EXCH A,AR1
|
||
PUSHJ P,[IOL [LOSING OUTPUT FILE SPECS!]]
|
||
EXCH A,AR1
|
||
JRST PRTSTR
|
||
] ;END IFN SFA
|
||
|
||
|
||
TYO$: JSP F,PRNAR$ ;USER'S "*TYO" ENTRY
|
||
SFA$ [SO.TYO,,QTYO$]
|
||
SFA% [QTYO$]
|
||
JRST %TYO1
|
||
|
||
%TYO: JSP F,PRNARG ;USER'S "TYO" ENTRY
|
||
SFA% JFCL [Q%TYO]
|
||
SFA$ JFCL [SO.TYO,,Q%TYO]
|
||
%TYO1: JSP T,GTRDTB
|
||
PUSHJ P,TYO1
|
||
JRST TRUE
|
||
|
||
TYO: SKIPE AR1,TAPWRT ;ENTRY FOR SINGLE-ENTER INTERNALS
|
||
HRRZ AR1,VOUTFILES ;TEMP ??
|
||
SFA$ JSP F,PRTSTO ;DO SFA CHECKING STUFF
|
||
|
||
$TYO: PUSH FXP,T ;ENTRY FOR PRIN1, PRINC, GC-PRINTOUT,
|
||
PUSH FXP,TT ; AND MULTIPLE-ENTER INTERNALS
|
||
PUSH P,[PXTTTJ]
|
||
JSP T,GTRDTB
|
||
TYOPR: SKIPA TT,A ;MUST SAVE R FOR PRINT
|
||
TYO1: JSP F,TYOARG
|
||
;AT THIS POINT: CHAR IN TT, FILE(S) IN AR1, READTABLE IN AR2A
|
||
;MUST SOVE A,B,C,AR1,R
|
||
TYO6: .5LKTOPOPJ
|
||
STRTYO: JUMPGE AR1,TYO5
|
||
TLNN AR1,200000
|
||
SKIPE TTYOFF
|
||
JRST TYO6A
|
||
SKIPLE TYOSW
|
||
JRST TYO6A
|
||
PUSH P,AR1
|
||
HRR AR1,V%TYO
|
||
TLZ AR1,600000
|
||
PUSHJ P,TYOF
|
||
POP P,AR1
|
||
TYO6A: MOVEI T,(AR1)
|
||
CAIE T,TRUTH
|
||
JRST TYO6B
|
||
HRR AR1,V%TYO ;T MEANS SAME AS VALUE OF TYO,
|
||
SKIPN TTYOFF ; BUT CAN BE SILENCED BY ^W
|
||
TYO6B: SKIPGE TYOSW
|
||
POPJ P,
|
||
JRST TYOF
|
||
|
||
TYO5:
|
||
REPEAT 2, PUSH P,AR1
|
||
HRRZS -1(P)
|
||
TLNN AR1,200000
|
||
SKIPE TTYOFF
|
||
JRST TYO2
|
||
HRR AR1,V%TYO
|
||
SKIPG TYOSW
|
||
PUSHJ P,TYOF
|
||
TYO2: SKIPL TYOSW
|
||
TYO2A: SKIPN AR1,-1(P)
|
||
JRST TYO4
|
||
HLRZ AR1,(AR1)
|
||
CAIN AR1,TRUTH
|
||
JRST TYO2Z
|
||
HLL AR1,(P)
|
||
JRST TYO2B
|
||
TYO2Z: HRRZ AR1,V%TYO
|
||
HLL AR1,(P)
|
||
SKIPN TTYOFF
|
||
TYO2B: PUSHJ P,TYOF
|
||
HRRZ AR1,@-1(P)
|
||
MOVEM AR1,-1(P)
|
||
JRST TYO2A
|
||
|
||
TYO4: POP P,AR1 ;PRESERVE AR1
|
||
JRST POP1J
|
||
|
||
TYOARG: JSP T,FXNV1
|
||
IFN SAIL\ITS, TDNN TT,[777777,,770000] ;UP TO 12. BITS OKAY
|
||
IFE SAIL\ITS, TDNN TT,[777777,,777400] ;UP TO 8 BITS OKAY
|
||
JRST (F)
|
||
JRST TYOAGE
|
||
|
||
|
||
;;; TYO ONE CHARACTER TO ONE FILE. MUST PRESERVE AR1,AR2A
|
||
;;; USER INTERRUPTS LOCKED OUT. (??)
|
||
;;; FILE ARRAY IN AR1.
|
||
;;; READTABLE IN AR2A.
|
||
;;; CHARACTER IN TT (MUST BE PRESERVED).
|
||
;;; TYOF HANDLES ALL CHARPOS, LINENUM, AND PAGENUM PROCESSING,
|
||
;;; CONTROL CHARACTERS, SAIL MODE OUTPUT, ETC.
|
||
;;; ALL CR'S NOT FOLLOWED BY LF'S HAVE LF'S SUPPLIED FOR THEM.
|
||
;;; MUST SAVE R FOR PRINT.
|
||
|
||
TYOFA: MOVE TT,A
|
||
TYOFIL: .5LKTOPOPJ
|
||
TYOF: TRNN AR1,-1
|
||
JRST TYOFE
|
||
IFN SFA,[
|
||
MOVSI T,AS.SFA ;AN SFA?
|
||
TDNN T,ASAR(AR1)
|
||
JRST TYOFS0 ;NOPE
|
||
PUSHJ FXP,SAV5 ;SAVE THE 'WORLD'
|
||
PUSHJ P,SAVX5
|
||
SKIPGE TT ;DO A CONVERSION ON FORMAT INFO
|
||
MOVNI TT,(TT)
|
||
JSP T,FXCONS ;CONS UP A FIXNUM
|
||
HLLZ T,AR1 ;HAS THIS SFA BEEN HACKED AT A HIGHER LEVEL?
|
||
TLZ T,600000 ;BITS NOT OF INTEREST TO THE SFA
|
||
MOVEI TT,SR.WOM
|
||
TDNE T,@TTSAR(AR1) ;CHECK THE OPERATIONS MASK
|
||
JRST TYOFS1 ;ALRADY DONE IT, SO RETURN
|
||
HRRZS INHIBI ;REALLY DIDN'T WANT THAT .5LKTOPOPJ
|
||
MOVEI C,(A) ;AS THE ARGUMENT TO THE SFA
|
||
MOVEI B,Q%TYO ;A TYO OPERATION
|
||
MOVEI A,(AR1) ;THE SFA ITSELF
|
||
PUSHJ P,ISTCSH ;DO SHORT INTERNAL SFA CALL
|
||
TYOFS1: PUSHJ FXP,RST5
|
||
JRST RSTX5 ;RESTORE ACS AND RETURN
|
||
TYOFS0: ] ;END IFN SFA
|
||
MOVE T,TTSAR(AR1)
|
||
JUMPL TT,TYOF7 ;NEGATIVE => FORMAT INFO
|
||
SKIPGE ATO.LC(T)
|
||
PUSHJ P,TYOFXL
|
||
IT% CAIN TT,177 ;RUBOUT HAS NO PRINT WIDTH
|
||
IT% JRST TYOF4
|
||
CAIN TT,7 ;<BELL> HAS NO PRINT WIDTH
|
||
JRST TYOF0G
|
||
IT$ CAIE TT,177 ;ITS RUBOUT PRINTS AS TWO CHARACTERS
|
||
CAIGE TT,40 ;CONTROL CHARACTERS HAVE WIDTH
|
||
JRST TYOF2 ; OF 1 OR 2, OR ELSE ARE FUNNY
|
||
TYOF0D: AOS D,AT.CHS(T) ;INCREMENT CHARPOS
|
||
SKIPE ATO.LC(T) ;SKIP UNLESS LAST CHAR WAS /
|
||
JRST TYOF0G
|
||
SKIPLE FO.LNL(T) ;ZERO OR NEGATIVE LINEL => INFINITY
|
||
TLNE T,TTS<IM> .SEE STERPRI
|
||
JRST TYOF0E ;FOR IMAGE OUTPUT, NO EXTRA CHARS
|
||
CAMLE D,FO.LNL(T)
|
||
SKIPE V%TERPRI
|
||
JRST TYOF0E
|
||
HRLM TT,(P) ;NEW LINE NEEDED BEFORE THIS CHAR
|
||
MOVEI TT,^M ;BECAUSE OF AUTO-TERPRI
|
||
PUSHJ P,TYOF4
|
||
PUSHJ P,TYOFXL
|
||
MOVEI TT,1
|
||
MOVEM TT,AT.CHS(T) ;SO THIS CHAR WILL BE AT CHARPOS 1
|
||
HLRZ TT,(P)
|
||
TYOF0E: MOVE D,@TTSAR(AR2A) ;GET READTABLE ENTRY FOR THIS
|
||
TLNE D,2000 .SEE SYNTAX ;IF THIS IS A /, SET FLAG
|
||
HLLOS ATO.LC(T) ; FOR NEXT TIME AROUND
|
||
JRST TYOF4
|
||
|
||
TYOF0G: SETZM ATO.LC(T) ;RESET / FLAG
|
||
JRST TYOF4 ;OUTPUT CHAR, IGNORING LINEL
|
||
|
||
TYOF2: CAIG TT,^M ;FOUND CONTROL CHAR
|
||
CAIGE TT,^H
|
||
JRST TYOF3 ;REGULAR CONTROL CHAR
|
||
JRST @.+1-^H(TT) ;FORMAT EFFECTOR - PECULIAR
|
||
TYOFBS ;^H BACKSPACE
|
||
TYOFTB ;^I TAB
|
||
TYOFLF ;^J LINE FEED
|
||
TYOF3 ;^K <NOT REALLY FORMAT CHAR>
|
||
TYOFFF ;^L FORM FEED
|
||
TYOFCR ;^M CARRIAGE RETURN
|
||
|
||
TYOFXL: SETZM ATO.LC(T) ;LINE FEED NEEDED BEFORE THIS CHAR
|
||
CAIE TT,^J ;FORGET IT IF THIS CHAR IS LF
|
||
TLNE T,TTS<IM> ;DON'T GENERATE LF FOR IMAGE FILE
|
||
POPJ P,
|
||
HRLM TT,(P)
|
||
MOVEI TT,^J
|
||
PUSHJ P,TYOFLF
|
||
HLRZ TT,(P)
|
||
POPJ P,
|
||
|
||
TYOFE: EXCH A,AR1
|
||
%WTA [SIXBIT \NOT A FILE - TYO!\]
|
||
|
||
|
||
TYOF3: CAIN TT,33 ;ALTMODES ARE ALWAYS 1 WIDE
|
||
JRST TYOF0D
|
||
MOVE D,F.MODE(T) ;RANDOM CONTROL CHAR
|
||
IFE SAIL,[
|
||
IT$ CAIE TT,177 ;RUBOUT PRINTS TWO POSITIONS EVEN IN SAIL MODE
|
||
TLNN D,FBT<SA> ;SKIP IF SAIL MODE FILE
|
||
AOS AT.CHS(T) ;OTHERWISE CONTROL CHARS ARE 2 WIDE
|
||
] ;END OF IFE SAIL
|
||
JRST TYOF0D
|
||
|
||
TYOFBS: SKIPLE AT.CHS(T) ;BACKSPACE - UNLESS AGAINST LEFT MARGIN,
|
||
SOS AT.CHS(T) ; DECREMENT CHARPOS
|
||
SETZM ATO.LC(T) ;CLEAR / FLAG
|
||
JRST TYOF4
|
||
|
||
TYOFTB: MOVEI D,7 ;TAB FOUND - JUMP TO NEXT
|
||
IORM D,AT.CHS(T) ;MULTIPLE-OF-8 CHARPOS
|
||
JRST TYOF0D
|
||
|
||
TYOFLF: AOS D,AT.LNN(T) ;INCREMENT LINENUM
|
||
SKIPLE FO.PGL(T) ;ZERO PAGEL => INFINITY
|
||
CAMGE D,FO.PGL(T) ;SKIP IF OVER PAGE LENGTH
|
||
JRST TYOF4
|
||
SETZM AT.LNN(T) ;ZERO LINE NUMBER
|
||
AOS AT.PGN(T) ;INCREMENT PAGE NUMBER
|
||
JRST TYFFF0
|
||
|
||
TYOFFF: SETZM AT.LNN(T) ;ZERO LINE NUMBER
|
||
AOS AT.PGN(T) ;INCREMENT PAGE NUMBER
|
||
TLNN T,TTS.TY ;IF TTY THEN DON'T GIVE END PAGE INT ON ^L
|
||
TYFFF0: SKIPN FO.EOP(T) ;IF IT HAS AN ENDPAGEFN, THEN
|
||
JRST TYOF4 ; WANT TO GIVE USER INTERRUPT
|
||
PUSHJ P,TYOF4
|
||
MOVEI D,200000+2*FO.EOP+1
|
||
HRLI D,(AR1)
|
||
JRST UINT
|
||
|
||
TYOF7: SKIPLE FO.LNL(T) ;INFINITE LINEL
|
||
TLNE T,TTS<IM> ; OR IMAGE MODE TTY
|
||
POPJ P, ; => IGNORE FORMAT DATA
|
||
SKIPN V%TERPRI
|
||
SKIPN AT.CHS(T) ;CAN'T DO ANY BETTER THAN TO BE
|
||
POPJ P, ; AT THE BEGINNING OF A LINE
|
||
MOVEI D,(TT)
|
||
ADD D,AT.CHS(T)
|
||
CAMG D,FO.LNL(T)
|
||
POPJ P,
|
||
SETZM AT.CHS(T)
|
||
PUSH FXP,TT
|
||
MOVEI TT,^M ;IF TOO LONG, DO AN AUTO-TERPRI
|
||
PUSHJ P,TYOFCR
|
||
POP FXP,TT
|
||
POPJ P,
|
||
|
||
TYOFCR: SETZM AT.CHS(T) ;CR - SET CHARPOS TO ZERO
|
||
PUSHJ P,TYOF4
|
||
SETOM ATO.LC(T) ;SET LF FLAG (MUSTN'T DO UNTIL AFTER IOT
|
||
POPJ P, ; OF CR BECAUSE A **MORE** MIGHT OCCUR)
|
||
|
||
TYOF4: .SEE PTYO
|
||
IFN ITS\D20,[
|
||
TLNE T,TTS.TY
|
||
JRST TYOF4C
|
||
] ;IFN ITS\D20
|
||
TYOF6:
|
||
TYOF4A: SKIPL F.MODE(T) .SEE FBT.CM
|
||
JRST TYOF5
|
||
IFN ITS,[
|
||
MOVE D,F.CHAN(T) ;CHARMODE (UNIT MODE)
|
||
LSH D,27 ;TYI USES THIS CODE TOO (SAVES F)
|
||
IOR D,[.IOT TT]
|
||
SPECPRO INTTYX
|
||
TYOXCT: XCT D
|
||
NOPRO
|
||
] ;END OF IFN ITS
|
||
IFN D10,[
|
||
SA$ OUTCHR TT
|
||
IFE SAIL,[
|
||
TLNE T,TTS.IM
|
||
TLNN T,TTS.TY
|
||
JRST .+3
|
||
IONEOU TT ;DO THIS IF IMAGE MODE TTY
|
||
JRST .+5
|
||
CAIE TT,33 ;NON-SAIL MONITORS LOSE ALTMODES
|
||
OUTCHR TT
|
||
CAIN TT,33 ;FOR THEM, WE OUTPUT ALTMODE AS $
|
||
OUTCHR C$ ; (ON THE TTY ONLY!)
|
||
] ;END OF IFE SAIL
|
||
] ;END OF IFN D10
|
||
IFN D20,[
|
||
PUSHJ FXP,SAV2
|
||
HRRZ 1,F.JFN(T)
|
||
MOVEI 2,(TT)
|
||
BOUT ;OUTPUT THE BYTE
|
||
ERJMP OIOERR
|
||
PUSHJ FXP,RST2
|
||
] ;END OF IFN D20
|
||
AOS F.FPOS(T) ;ADJUST FILE POSITION (DOESN'T HURT IF F.FLEN NEG)
|
||
C$: POPJ P,"$
|
||
|
||
INTTYR: HRROS INHIBIT .SEE $IWAIT ;COME HERE AFTER INTERRUPT
|
||
MOVE T,TTSAR(AR1) ;FILE ARRAY MAY HAVE MOVED
|
||
POPJ P, .SEE TYIXCT TYICAL
|
||
|
||
TYOF5: ;BLOCK MODE
|
||
IFN ITS\D20,[
|
||
IDPB TT,FB.BP(T) ;PUT BYTE IN BUFFER
|
||
SOSLE FB.CNT(T) ;DECREMENT COUNT
|
||
] ;END OF IFN ITS\D20
|
||
IFN D10,[
|
||
MOVE D,FB.HED(T) ;FOR D10, BYTE POINTER AND COUNT ARE IN BUFFER HEADER
|
||
IDPB TT,1(D) ;PUT BYTE IN BUFFER
|
||
SOSLE 2(D) ;DECREMENT COUNT
|
||
] ;END OF IFN D10
|
||
POPJ P,
|
||
HRLM TT,(P)
|
||
MOVE TT,T
|
||
PUSH FXP,F
|
||
PUSHJ P,IFORCE
|
||
POP FXP,F
|
||
HLRZ TT,(P)
|
||
TYOF5Y: MOVE T,TTSAR(AR1)
|
||
POPJ P,
|
||
|
||
IFN ITS\D20,[
|
||
TYOF4C: TLNN T,TTS.IM ;DO NOT HACK THIS FOR IMAGE MODE
|
||
CAIE TT,^P ;^P IS THE DISPLAY ESCAPE CODE, AND
|
||
JRST TYOF4A ; MUST BE TREATED SPECIALLY
|
||
SKIPGE F.MODE(T) .SEE FBT.CM
|
||
JRST TYOF4J
|
||
MOVE TT,FB.CNT(T) ;FOR BLOCK MODE, BE CAREFUL
|
||
PUSH FXP,F
|
||
CAIGE T,2 ; ABOUT SPLITTING A ^P-CODE
|
||
PUSHJ P,IFORCE ; ACROSS A BLOCK BOUNDARY
|
||
POP FXP,F
|
||
TYOF4J: MOVE T,TTSAR(AR1) ;OUTPUT ^P AS ^P P
|
||
MOVEI TT,^P
|
||
PUSHJ P,TYOF4A
|
||
MOVE T,TTSAR(AR1)
|
||
MOVEI TT,"P
|
||
PUSHJ P,TYOF4A
|
||
JRST TYOF5Y
|
||
] ;END OF IFN ITS\D20
|
||
|
||
|
||
|
||
SUBTTL TERPRI AND PTYO FUNCTIONS
|
||
|
||
|
||
%TERPRI:
|
||
JUMPN T,.+3
|
||
PUSH P,R70
|
||
MOVNI T,1
|
||
PUSH P,(P) ;EVEN THOUGH LSUBR (0 . 1)
|
||
SOS T ;PRETEND TO BE (1 . 2) FOR PRNARG'S SAKE
|
||
JSP F,PRNARG ;PRNARG MAY DO A POPJ FOR US - BEWARE!
|
||
SFA% 400000,,[Q%TERPRI] ;BIT 4.9 => RETURN VALUE IS NIL
|
||
SFA$ 400000,,[SO.TRP,,Q%TERPRI] ;BIT 4.9 => RETURN VALUE IS NIL
|
||
JRST TERP1
|
||
|
||
TRP$: JSP F,PRNAR$
|
||
SFA% 400000,,[QTRP$]
|
||
SFA$ 400000,,[SO.TRP,,QTRP$]
|
||
JRST TERP1
|
||
|
||
TERPRI: SKIPE AR1,TAPWRT ;1/4-INTERNAL TERPRI
|
||
HRRZ AR1,VOUTFILES
|
||
SFA$ JSP F,PRTSTR ;DO SFA CHECKING STUFF
|
||
SFA$ [SO.TRP,,]
|
||
TERP1: JSP T,GTRDTB ;SEMI-INTERNAL TERPRI
|
||
MOVEI A,NIL
|
||
ITERPRI:
|
||
PUSH P,A ;INTERNAL TERPRI - SAVES A,B,C
|
||
MOVEI TT,^M ;MUST HAVE FILE ARRAY IN AR1,
|
||
PUSHJ P,TYO6 ; READTABLE IN AR2A
|
||
MOVEI TT,^J
|
||
PUSHJ P,TYO6
|
||
JRST POPAJ
|
||
|
||
PTYO: CAIN B,TRUTH ; +TYO: SUBR 2
|
||
MOVE B,V%TYO ;IF T, MAKE TYO
|
||
SKIPE V.RSET
|
||
JRST PTYO2
|
||
PTYO1: MOVE TT,(A) ;FIRST ARG IS ASCII VALUE
|
||
IFN SFA,[
|
||
MOVSI T,AS.SFA ;CHECK IF AN SFA
|
||
TDNE T,ASAR(B) ;SFA BIT SET IN ASAR?
|
||
JRST PTYO3
|
||
] ;END IFN SFA
|
||
.5LKTOPOPJ
|
||
MOVE T,TTSAR(B) ;SECOND ARG IS FILE
|
||
MOVEI A,TRUTH ;RETURNS T
|
||
JRST TYOF4
|
||
|
||
PTYO2: MOVE AR1,B
|
||
IFN SFA,[
|
||
JSP TT,XFOSP
|
||
JRST TYO$ ;LET *TYO GENERATE THE ERROR FOR NON-FILE
|
||
JRST PTYO2A
|
||
PTYO3: MOVEI C,(A) ;THIRD ARG IS THE FIXNUM
|
||
MOVEI A,(B) ;FIRST ARG IS SFA ITSELF
|
||
MOVEI B,Q%TYO ;TYO OPERATION
|
||
JRST ISTCSH
|
||
PTYO2A:] ;END IFN SFA
|
||
PUSHJ P,ATOFOK
|
||
MOVE B,AR1
|
||
UNLOCKI
|
||
JRST PTYO1
|
||
|
||
|
||
SUBTTL PRINT, PRIN1, PRINC, PRINT-OBJECT
|
||
|
||
PRINT: SKIPE AR1,TAPWRT ;INTERNAL "SUBR" VERSION OF PRINT
|
||
MOVE AR1,VOUTFILES
|
||
SFA$ JSP F,PRTSTR ;DO SFA CHECKING STUFF
|
||
SFA$ [SO.PRT,,]
|
||
JRST $PRINT
|
||
|
||
IFN HNKLOG,[
|
||
%PRO: ;PRINT-OBJECT SUBR (4 . 5)
|
||
PRINTOBJECT:
|
||
JSP TT,LWNACK ;Check number of arguments
|
||
LA45,,Q%PRO
|
||
CAMN T,IN0-5 ;5 arguments?
|
||
POP P,AR1 ; Ignore it for LISPM compatability
|
||
POP P,B ;STREAM
|
||
POP P,AR1 ;SLASHIFY-P
|
||
POP P,C ;I-PRINLEVEL
|
||
POP P,A ;Object
|
||
PUSH P,[TRUE] ;Arrange to return T
|
||
PUSH P,C ;Save these two values
|
||
PUSH P,AR1 ;From PRNARG harm and the GC
|
||
PUSH FXP,P ;Remember our stack pointer
|
||
PUSH P,A ;Now pretend we're a standard LSUBR (1 . 2)
|
||
PUSH P,B
|
||
MOVNI T,2 ;Called with 2 args
|
||
JSP F,PRNARG
|
||
SFA% JFCL [Q%PRO]
|
||
SFA$ JFCL [SO.OUT,,Q%PRO]
|
||
MOVE R,[PR.ATR,,$TYO] ;AR1 SHOULD BE SET UP BEFORE COMING HERE
|
||
POP FXP,P ;Flush cruft PRNARG pushed
|
||
MOVEI D,%PRO3 ;Come back to %PRO3 after checking PRINLEVEL
|
||
SKIPE V%TERPRI
|
||
TLZ R,PR.ATR ;TERPRI NON-NIL => NEVER AUTO-TERPRI
|
||
JRST PRINT0
|
||
|
||
%PRO3: POP P,A
|
||
POP P,TT ;SLASHIFY-P
|
||
SKIPN TT ;Is this really PRINC
|
||
TLO R,PR.PRC ; Note the fact
|
||
POP P,TT ;I-PRINLEVEL
|
||
MOVE TT,(TT)
|
||
MOVEM TT,PRINLV
|
||
|
||
PUSH P,A
|
||
JRST PRINT1 ;Print it as if called by PRIN1
|
||
%PROX:
|
||
|
||
] ; END of IFN HNKLOG,
|
||
|
||
%PRINT: JSP F,PRNARG ;LSUBR (1 . 2)
|
||
SFA% JFCL [Q%PRINT]
|
||
SFA$ JFCL [SO.PRT,,Q%PRINT]
|
||
$PRINT: JSP T,GTRDTB ;AR1 SHOULD BE SET UP BEFORE COMING HERE
|
||
PUSHJ P,ITERPRI
|
||
CTY1: PUSHJ P,$PRIN1
|
||
CTY2: %SPC%
|
||
POPJ P,
|
||
|
||
PRIN1B: MOVE A,B
|
||
PRIN1: SKIPE AR1,TAPWRT ;INTERNAL "SUBR" VERSION OF PRIN1
|
||
MOVE AR1,VOUTFILES
|
||
SFA$ JSP F,PRTSTR
|
||
SFA$ [SO.PR1,,]
|
||
JRST $PRIN1
|
||
%PRIN1:
|
||
%PR1: JSP F,PRNARG ;LSUBR (1 . 2)
|
||
SFA% JFCL [Q%PR1]
|
||
SFA$ JFCL [SO.PR1,,Q%PR1]
|
||
$PRIN1: MOVE R,[PR.ATR,,$TYO] ;AR1 SHOULD BE SET UP BEFORE COMING HERE
|
||
%PR1A: JSP T,GTRDTB
|
||
PUSHJ P,PRINTY
|
||
JRST TRUE
|
||
|
||
PRINC: SKIPE AR1,TAPWRT ;INTERNAL "SUBR" VERSION OF PRINC
|
||
MOVE AR1,VOUTFILES
|
||
SFA$ JSP F,PRTSTR
|
||
SFA$ [SO.PRC,,]
|
||
JRST $PRINC
|
||
%PRINC:
|
||
%PRC: JSP F,PRNARG ;LSUBR (1 . 2)
|
||
SFA% JFCL [Q%PRC]
|
||
SFA$ JFCL [SO.PRC,,Q%PRC]
|
||
$PRINC: MOVE R,[PR.PRC,,$TYO] ;AR1 SHOULD BE SET UP BEFORE COMING HERE
|
||
JRST %PR1A
|
||
|
||
;;; SUBR VERSIONS - *PRINT, *PRIN1, *PRINC
|
||
IFE SFA,[
|
||
IRPS X,,[PRT$:PR1$:PRC$:]Y,,[$PRINT,$PRIN1,$PRINC]
|
||
X: JSP F,PRNAR$
|
||
[Q!X]
|
||
|
||
JRST Y
|
||
TERMIN
|
||
] ;END IFE SFA
|
||
|
||
IFN SFA,[
|
||
IRPS X,,[PRT$:PR1$:PRC$:]Y,,[$PRINT,$PRIN1,$PRINC]Z,,[SO.PRT,SO.PR1,SO.PRC]
|
||
X: JSP F,PRNAR$
|
||
[Z,,Q!X]
|
||
JRST Y
|
||
TERMIN
|
||
] ;END IFN SFA
|
||
|
||
|
||
SUBTTL MAIN PRINTOUT ROUTINE
|
||
|
||
;;; ***** OKAY, OUTPUT LOVERS, HERE'S YOUR MAIN PRINT ROUTINE *****
|
||
|
||
;;; CALLED WITH OBJECT TO PRINT IN A, ADDRESS OF "TYO" ROUTINE IN R.
|
||
;;; CLOBBERS A (RETURNS GARBAGE); TO SAVE A OVER PRINTY, USE APRINT.
|
||
;;; VARIOUS BITS ARE KEPT IN THE LEFT HALF OF R.
|
||
;;; SOME ARE PASSED IN, AND OTHERS ARE INITIALIZED AND USED INTERNALLY.
|
||
PR.PRC==400000 ;MUST BE SIGN BIT! 0 => PRIN1, 1 => PRINC. (PASSED IN)
|
||
PR.ATR==200000 ;1 => DO AUTO-TERPRI HACKS
|
||
PR.NAS==10000 ;NOT A PSEUDO-STRING
|
||
PR.NUM==4000 ;SYMBOL LOOKS LIKE A NUMBER SO FAR
|
||
PR.NVB==2000 ;NOT PROVEN YET THAT VERTICAL BAR NEEDED
|
||
PR.EFC==1000 ;EMBEDDED FUNNY CHARACTER IN SYMBOL FLAG (1 => NONE SEEN)
|
||
PR.NLS==400 ;NOT PROVEN YET THAT LEADING SLASH NEEDED
|
||
;;; PRINTA EXPECTS B,C,T,TT,R SAFE OVER THE "TYO" ROUTINE.
|
||
;;; THE "TYO" ROUTINE GENERALLY EXPECTS AR1 AND AR2A SAFE OVER PRINTA.
|
||
;;; USES DIRECTLY OR INDIRECTLY A,B,C,T,TT,D,R,F.
|
||
;;; IN THE USELESS VERSION OF LISP, THERE ARE ABBREVIATION HACKS:
|
||
;;; PRINTY IS THE ENTRY FOR PRIN1/PRINC; ABBREVIATION IS CONTROLLED
|
||
;;; BY BIT 1.1 OF (STATUS ABBREVIATE). TYOSW INDICATES WHETHER
|
||
;;; A CHAR IS MEANT FOR TTY, FILES, OR BOTH (IN THIS WAY THE TTY
|
||
;;; CAN RECEIVE ABBREVIATIONS WHILE FILES RECEIVE FULL S-EXPRS).
|
||
;;; PRINTF IS THE ENTRY FOR FLATSIZE/EXPLODE; ABBREVIATION IS
|
||
;;; CONTROLLED BY BIT 1.2 OF (STATUS ABBREVIATE).
|
||
;;; PRINTA IS THE ENTRY FOR ALL OTHER PRINT HACKERS; IT
|
||
;;; NEVER ABBREVIATES.
|
||
|
||
IFE USELESS,[
|
||
PRINTY: SKIPE V%TERPRI ;TERPRI NON-NIL => NEVER AUTO-TERPRI
|
||
PRINTF: ;ENTRY FOR FLATSIZE/EXPLODE
|
||
PRINTA: TLZ R,PR.ATR ;OTHER GUYS DON'T WANT AUTO-TERPRI HACKS
|
||
PRINT3: PUSH P,A ;MAIN RECURSIVE ENTRY FOR PRINTING
|
||
ROT A,-SEGLOG ;NOTE THAT A IS SAFE ON PDL
|
||
SKIPL TT,ST(A) ;MUST DO A ROT, NOT LSH! SEE PRINX
|
||
JRST PRINX
|
||
%LPAR% ;PRINT A LIST. FIRST TYO A (
|
||
PRINT4: HLRZ A,@(P)
|
||
IFN HNKLOG,[
|
||
TLNE TT,HNK
|
||
JRST PRINH0
|
||
PRINH6:
|
||
] ;END OF IFN HNKLOG
|
||
PUSHJ P,PRINT3 ;NOW PRINT CAR OF THE LIST
|
||
HRRZ A,@(P)
|
||
JUMPE A,PRIN8A ;IF CDR IS NIL, NEED ONLY A )
|
||
PRIN7A: MOVEM A,(P)
|
||
%SPC% ;ELSE SPACE IN BETWEEN
|
||
LSH A,-SEGLOG ;WE KNOW A IS NON-NIL!
|
||
SKIPGE TT,ST(A)
|
||
JRST PRINT4 ;IF CDR IS NON-ATOMIC, LOOP
|
||
%DOT% ;ELSE DOTTED LIST
|
||
%SPC%
|
||
PUSHJ P,PRIN1A ;SO PRINT THE ATOM AFTER THE LISP DOT
|
||
PRIN8A: %RPAR% ;NOW TYO A )
|
||
JRST POP1J
|
||
] ;END OF IFE USELESS
|
||
|
||
|
||
IFN USELESS,[
|
||
|
||
PRINTY: MOVEI D,PRINT1 ;ENTRY FOR PRIN1/PRINC
|
||
SKIPE V%TERPRI
|
||
TLZ R,PR.ATR ;TERPRI NON-NIL => NEVER AUTO-TERPRI
|
||
JRST PRINT0
|
||
|
||
PRINTF: MOVEI D,PRINT2 ;ENTRY FOR FLATSIZE/EXPLODE
|
||
TLZ R,PR.ATR
|
||
JRST PRINT0
|
||
|
||
APRINT: PUSH P,A
|
||
PUSH P,CPOPAJ
|
||
PRINTA: MOVEI D,PRIN3A ;ENTRY FOR NO ABBREVIATIONS
|
||
TLZ R,PR.ATR
|
||
PRINT0: PUSH P,A ;CLOBBERS ARG (RETURNS GARBAGE)
|
||
SKIPN V.RSET ;IF IN *RSET MODE, CHECK VALUES OF
|
||
JRST PRIN0A ; PRINLEVEL AND PRINLENGTH
|
||
IRP X,,[%LEVEL,%LENGTH]Y,,[%LV,%LN]
|
||
Y!CHK: SKIPN A,V!X ;NIL IS A VALID VALUE
|
||
JRST PRT!Y
|
||
SKOTT A,FX
|
||
JRST Y!ERR
|
||
SKIPGE (A)
|
||
JRST Y!ERR
|
||
PRT!Y:
|
||
TERMIN
|
||
PRIN0A: SETOM PRINLV ;PRINLV HAS <ACTUAL PRINT LEVEL>-1
|
||
SETZM ABBRSW ;ASSUME ABBRSW ZERO
|
||
JSP T,RSXST
|
||
MOVEI A,LRCT-2 ;GET (STATUS ABBREVIATE)
|
||
NW% HRRZ T,@RSXTB
|
||
NW$ LDB T,[001120,,RSXTB] ;PICK UP CHTRAN
|
||
HRRZ A,(P) ;MUST LEAVE ARG IN A FOR PRINT3, %PRO3
|
||
SETZM PRPRCT
|
||
JRST (D) ;DISPATCH TO PRINT1, PRINT2, PRINT3, %PRO3
|
||
|
||
PRINT1: SETOM ABBRSW ;PRIN1/PRINC
|
||
SKIPE TAPWRT ;OPEN FILES? WHETHER OR NOT TO ABBREVIATE THEM
|
||
JRST PRIN1Q
|
||
SKIPN TTYOFF ;IF NO FILES OPEN, THEN ABBREVIATE FOR TTY
|
||
JRST PRIN3A
|
||
PRIN1Q: TRNN T,1 ;ULTIMATE DECISION ON FILE ABBREVIATION
|
||
HRRZS ABBRSW ; COMES FROM (STATUS ABBREVIATE)
|
||
JRST PRIN3A
|
||
|
||
PRINT2: TRNE T,2 ;FLATSIZE/EXPLODE - DECIDE WHETHER IT
|
||
SETOM ABBRSW ; WANTS ABBREVIATION OR NOT
|
||
JRST PRIN3A
|
||
|
||
PRINT3: PUSH P,A ;MAIN RECURSIVE ENTRY FOR PRINTING
|
||
PRIN3A: ROT A,-SEGLOG ;NOT LSH! SEE PRINX
|
||
SKIPL TT,ST(A)
|
||
JRST PRINX ;IF SO, USE AN ATOM PRINTER
|
||
IFN HNKLOG,[
|
||
TLNN TT,HNK ;Is this a hunk?
|
||
JRST PRN3NH ; Nope...
|
||
PUSH FXP,PRPRCT
|
||
PUSH FXP,FLAT1 ;If for some totally random reason it called FLATSIZE..
|
||
MOVE A,(P)
|
||
PUSH P,TT ;TT get's used WAY WAY below!
|
||
PUSHJ P,USRHNP ;Is this a user hunk?
|
||
POP P,TT
|
||
POP FXP,FLAT1
|
||
POP FXP,PRPRCT
|
||
JUMPE T,PRN3NH ;If not, just print an ordinary hunk
|
||
MOVEI T,FLAT2
|
||
MOVEI B,FLATO2
|
||
CAIE B,(R) ;Is this really a FLATSIZE hack?
|
||
CAIN T,(R)
|
||
JRST FLTHNK ; Yes, just get the FLATSIZE and add it in
|
||
MOVEI B,TRUTH ;Say this comes from PRINT
|
||
PUSH FXP,PRINLV ;Don't let calls to FLATSIZE screw us!
|
||
PUSHJ P,SENDFL ;Send the message to the frob
|
||
POP FXP,PRINLV
|
||
MOVE T,(A) ;Get the size
|
||
PUSHJ P,PRINLP ;print all necessary lparens
|
||
MOVE A,(P) ;Recover the object
|
||
PUSHJ P,SENDPR ;Send it to the frob
|
||
JRST POP1J
|
||
|
||
FLTHNK: SETZ T,
|
||
PUSHJ P,PRINLP ;Be sure to get any needed parens out there
|
||
PUSH FXP,FLAT1 ;Remember how much we got so far
|
||
MOVEI A,FLATO2 ;For test
|
||
SETZ B, ;We are really comming from FLATSIZE
|
||
CAIN A,(R) ;Is this from FLATSIZE-OBJECT with PRINTP T?
|
||
MOVEI B,TRUTH ; Yes, we're really a recursive call from PRINT
|
||
MOVE A,(P) ;Recover our object from the stack
|
||
PUSHJ P,SENDFL ;Send the message to the frob
|
||
MOVE TT,(A) ;Get the result
|
||
POP FXP,FLAT1 ;Recover flatsize-so-far
|
||
ADDM TT,FLAT1 ;and add them up
|
||
JRST POP1J
|
||
|
||
SENDFL: PUSH P,AR1
|
||
MOVE AR1,B ;Get whether from PRINT
|
||
MOVEI B,QFLATSIZE
|
||
JRST SENDP1
|
||
|
||
SENDPR: PUSH P,AR1
|
||
MOVEI B,Q%SLFPR
|
||
SENDP1: SOVE AR2A R
|
||
PUSH FXP,PRPRCT ;Save pending RPAREN count
|
||
PUSH FXP,PRINLV ;And paren level
|
||
PUSHJ P,[PUSH P,A ;Object
|
||
PUSH P,B ;Message
|
||
TLNN AR1,200000 ;If 200000 is not set, then we are
|
||
SETZI AR1, ;printing to the TTY and OUTFILES
|
||
;so a stream of NIL will suffice.
|
||
MOVEI AR1,(AR1) ;Eliminate flags from left half
|
||
PUSH P,AR1 ;stream or printp if FLATSIZE
|
||
MOVEI A,(FXP) ;Fixnum level
|
||
PUSH P,A
|
||
PUSH P,NIL ;No slashification
|
||
MOVEI T,TRUTH
|
||
SKIPL R ;Are we doing PRIN1 instead of PRINC?
|
||
MOVEM T,(P) ; Then say to do slashification
|
||
MOVNI T,5
|
||
XCT SENDI ;Ask the SEND interpreter
|
||
]
|
||
SNDPR0: POP FXP,PRINLV
|
||
POP FXP,PRPRCT
|
||
RSTR R AR2A AR1
|
||
POPJ P,
|
||
|
||
PRN3NH:
|
||
]; END IFN HNKLOG,
|
||
|
||
MOVE T,TYOSW ;Save old value of TYOSW
|
||
HRLM T,-1(P) ; (I.E. that of previous level)
|
||
JUMPN T,PRINT4 ;If previous level was non-abbrev,
|
||
SKIPN ABBRSW ; Or if we don't ever want abbrev,
|
||
JRST PRINT4 ; Then needn't try to abbrev!
|
||
AOS T,PRINLV ;Else increment level count
|
||
SKIPE V%LEVEL ;If PRINLEVEL=NIL, or if actual level
|
||
CAMGE T,@V%LEVEL ; Is less, then don't abbrev
|
||
JRST PRINT4
|
||
SKIPL ABBRSW
|
||
SETOM TYOSW
|
||
CAME T,@V%LEVEL ;If we're exactly equal to PRINLEVEL,
|
||
JRST PRIN3F
|
||
MOVEI T,1
|
||
PUSHJ P,PRINLP
|
||
%NMBR% ; SHOOT OUT LEVEL ABBREVIATION
|
||
PRIN3F: SKIPGE ABBRSW ;IF WE ONLY WANT ABBREVIATION,
|
||
JRST PRINT9 ; NEEDN'T GROVEL OVER THE SUBLIST
|
||
HRRZS TYOSW ;ELSE SIGNAL NON-ABBREV ONLY MODE
|
||
PRINT4: PUSH FXP,PRPRCT ;SAVE PARENS COUNTS
|
||
HLLOS PRPRCT ;CLEAR RIGHT PARENS COUNT, AND
|
||
AOS PRPRCT ; INCREMENT LEFT PARENS COUNT
|
||
PUSH FXP,XC-1 ;<ACTUAL PRINT LENGTH>-1 FOR THIS LEVEL
|
||
MOVE T,TYOSW ;SAVE CURRENT TYOSW (DETERMINES WHETHER
|
||
HRLM T,(P) ; ABBREV MODE OUTPUT WANTS A ) AT END)
|
||
PRINT5: SKIPN TYOSW ;IF WE ARE IN NON-ABBREV ONLY MODE,
|
||
SKIPN ABBRSW ; OR IF WE NEVER WANT ABBREV,
|
||
JRST PRINT7 ; THEN DON'T TRY TO ABBREV!
|
||
AOS T,(FXP) ;ELSE INCREMENT PRINT LENGTH
|
||
SKIPE V%LENGTH ;IF PRINLENGTH=NIL, OR IF WE'RE LESS
|
||
CAMGE T,@V%LENGTH ; THAN IT, THEN DON'T ABBREV
|
||
JRST PRINT7
|
||
SKIPL ABBRSW
|
||
SETOM TYOSW
|
||
CAME T,@V%LENGTH
|
||
JRST PRINT6 ;IF WE'RE EXACTLY EQUAL, THEN ABBREV
|
||
MOVEI T,3
|
||
PUSHJ P,PRINLP
|
||
REPEAT 3, %DOT%
|
||
PRINT6: SKIPGE ABBRSW ;IF WE DON'T WANT NON-ABBREV ONLY MODE,
|
||
JRST PRINT8 ; THEN CAN IGNORE REST OF LIST
|
||
HRRZS TYOSW ;ELSE SIGNAL NON-ABBREV ONLY MODE
|
||
PRINT7: HRRZ A,(P)
|
||
HRRZ B,(A)
|
||
HLRZ A,(A)
|
||
HRRZ T,-1(FXP)
|
||
ADDI T,1
|
||
SKIPN B
|
||
HRRM T,PRPRCT
|
||
IFN HNKLOG,[
|
||
TLNE TT,HNK
|
||
JRST PRINH0
|
||
PRINH6:
|
||
] ;END OF IFN HNKLOG
|
||
PUSHJ P,PRINT3 ;SO PRINT THE CAR OF THE LIST
|
||
SETZM PRPRCT
|
||
HRRZ A,(P)
|
||
HRRZ A,(A)
|
||
JUMPE A,PRINT8 ;IF CDR IS NIL, NEED ONLY A ) NOW
|
||
PRIN7A: HRRM A,(P)
|
||
%SPC% ;ELSE SPACE BETWEEN
|
||
LSH A,-SEGLOG
|
||
SKIPL TT,ST(A)
|
||
JRST PRIN7B ; IF AN ATOM, THEN NEED A DOT
|
||
TLNN TT,HNK ; IF NOT A HUNK, THEN A CDR WHICH IS A LIST,
|
||
JRST PRINT5 ; SO LOOP. ELSE, WE HAVE A DOTTED LIST
|
||
PRIN7B: %DOT%
|
||
%SPC%
|
||
HRRZ T,-1(FXP)
|
||
ADDI T,1
|
||
MOVEM T,PRPRCT
|
||
HRRZ A,(P) ;SET UP A WITH CDR-OBJECT TO PRINT (HUNK OR ATOM)
|
||
PUSHJ P,PRINT3 ;JUMP TO GENERAL RECURSIVE PRINTER
|
||
PRINT8: HLRZ T,(P) ;THIS WILL TELL TYO WHAT TO
|
||
MOVEM T,TYOSW ; DO WITH THE )
|
||
PRIN8A: %RPAR% ;TYO A ) TO END THE LIST
|
||
|
||
IFE USELESS, PRIN8B: ;A normally useless symbol
|
||
|
||
SUB FXP,R70+1
|
||
POP FXP,PRPRCT
|
||
PRINT9: HLRZ T,-1(P) ;RESTORE TYOSW TO WHAT IT WAS
|
||
MOVEM T,TYOSW ; ON LAST (RECURSIVE!) ENTRY
|
||
JUMPN T,POP1J ;IF AND ONLY IF WE AOS'ED PRINLV,
|
||
SKIPE ABBRSW ; WE MUST NOW SOS IT, AND THEN POP1J
|
||
SOS PRINLV
|
||
JRST POP1J
|
||
] ;END OF IFN USELESS
|
||
|
||
SUBTTL PRINT A HUNK
|
||
|
||
IFN HNKLOG,[
|
||
|
||
PRINH0: SKIPN VHUNKP ;IF HUNKP IS NIL, THEN PRINT A HUNK
|
||
JRST PRINH6 ; AS IF IT WERE A LIST CELL
|
||
|
||
IFE USELESS,[
|
||
PUSHJ P,USRHNP ;Is this a user's extended hunk?
|
||
JUMPE T,PRINH8
|
||
|
||
PUSHJ P,SENDPR
|
||
JRST PRIN8B
|
||
|
||
PRINH8:
|
||
]; -- END of IFE USELESS,
|
||
|
||
HRRZS TT ;Flush left half
|
||
CAIN TT,QHUNK0
|
||
CAIE A,-1
|
||
JRST .+2
|
||
JRST PRHN3B
|
||
PUSH FXP,TT
|
||
PUSHJ P,PRINT3 ;PRINT FIRST ELT
|
||
IFN USELESS, SETZM PRPRCT
|
||
POP FXP,TT
|
||
MOVSI T,-1
|
||
2DIF [LSH T,(TT)]0,QHUNK0
|
||
HRR T,(P)
|
||
ADD T,R70+1
|
||
JUMPGE T,PRHN3A ;"HUNK2" CASE, WITH 2 ELEMENTS
|
||
PUSH P,T
|
||
PRINH2: MOVEM T,(P)
|
||
PRHN2B: HRRZ A,(P)
|
||
HRRZ A,(A)
|
||
CAIN A,-1
|
||
JRST PRINH3
|
||
%SPC%
|
||
%DOT%
|
||
%SPC%
|
||
PUSHJ P,PRINT3
|
||
HRRZ A,(P)
|
||
HLRZ A,(A)
|
||
CAIN A,-1
|
||
JRST PRINH3
|
||
%SPC%
|
||
%DOT%
|
||
%SPC%
|
||
PUSHJ P,PRINT3
|
||
MOVE T,(P)
|
||
AOBJN T,PRINH2
|
||
PRINH3: SUB P,R70+1 ;FINISHED WITH HUNK (EXCEPT FOR CDR)
|
||
PRHN3A: %SPC%
|
||
%DOT%
|
||
%SPC%
|
||
PRHN3B: HRRZ A,(P)
|
||
HRRZ A,(A)
|
||
PUSHJ P,PRINT3
|
||
%SPC%
|
||
%DOT%
|
||
JRST PRIN8A
|
||
|
||
|
||
] ;END OF IFN HNKLOG
|
||
|
||
SUBTTL PRINT ATOM DISPATCH, AND PRINT AN ARRAY OR A RANDOM
|
||
|
||
PRINX: PUSH P,CPOP1J ;PRINT AN ATOM (ON THE PDL)
|
||
PRIN1A: ;TT HAS ST ENTRY
|
||
HRRZ A,-1(P) ;NIL IS SYMBOL, NOT RANDOM!!!
|
||
JUMPE A,PRINIL
|
||
2DIF JRST (TT),.,QLIST .SEE STDISP ;TT MUST HAVE ST ENTRY
|
||
PRIN1Z: JRST PRINI ;FIXNUM
|
||
JRST PRINO ;FLONUM
|
||
BG$ JRST PRINB ;BIGNUM
|
||
JRST PRINN ;SYMBOL
|
||
HN$ REPEAT HNKLOG+1, .VALUE ;HUNKS
|
||
JFCL ;RANDOM
|
||
IFN .-PRIN1Z-NTYPES+2, WARN [WRONG LENGTH TABLE]
|
||
IFN USELESS,[
|
||
MOVEI T,25.
|
||
PUSHJ P,PRINLP
|
||
SETZM PRPRCT
|
||
] ;END OF IFN USELESS
|
||
%NMBR% ;ARRAY (AND RANDOM)
|
||
TLNN TT,SA
|
||
JRST PRINX5
|
||
HRRZ A,-1(P)
|
||
MOVE TT,ASAR(A)
|
||
CAIE TT,ADEAD
|
||
JRST PRINA2
|
||
SKIPA TT,[440700,,[ASCIZ \DEAD-ARRAY\]]
|
||
PRINA1: PUSHJ P,(R)
|
||
ILDB A,TT
|
||
JUMPN A,PRINA1
|
||
POPJ P,
|
||
|
||
PRINA2: TLNE TT,AS<FIL>
|
||
JRST PRNFL
|
||
TLNE TT,AS<JOB>
|
||
JRST PRNJB
|
||
SFA$ TLNE TT,AS.SFA ;SFA?
|
||
SFA$ JRST PRNSR
|
||
JFFO TT,.+1
|
||
HRRZ A,ARYTYP(D)
|
||
TLC TT,AS<SX> ;CROCK FOR NSTORE ARRAYS
|
||
TLNN TT,AS<SX+GCP>
|
||
SETZ A,
|
||
PUSHJ P,PRINSY
|
||
%NEG%
|
||
HRRZ A,-1(P)
|
||
LDB F,[TTSDIM,,TTSAR(A)]
|
||
PRINA3: HRRZ A,-1(P)
|
||
MOVNI TT,(F)
|
||
MOVE TT,@TTSAR(A)
|
||
IFE USELESS, MOVE C,@VBASE ;BETTER BE A FIXNUM!
|
||
IFN USELESS,[
|
||
HRRZ C,VBASE
|
||
CAIE C,QROMAN
|
||
SKIPA C,(C)
|
||
PUSHJ P,PROMAN
|
||
] ;END OF IFN USELESS
|
||
PUSHJ P,PRINI9
|
||
SOJE F,PRINA4
|
||
%CLN%
|
||
JRST PRINA3
|
||
PRINA4: %NEG%
|
||
PRINX5: HRRZ TT,-1(P)
|
||
PRINL4: MOVEI C,10 ;N BASE 8
|
||
JRST PRINI3
|
||
|
||
|
||
SUBTTL PRINT A FILE OBJECT, PRINT A JOB OBJECT, PRINT AN SFA
|
||
|
||
;;; PRINT A JOB OBJECT AS #JOB-|<NAME>|-<ADDRESS>
|
||
;;; PRINT A FILE OBJECT AS #FILE-<DIR>-|<NAME>|-<ADDRESS>
|
||
;;; PRINT AN SFA AS #SFA-|<SFA-PRINTNAME>|-<ADDRESS>
|
||
;;; WHERE <DIR> IS "IN" OR "OUT", <NAME> IS THE TRUENAME,
|
||
;;; <SFA-PRINTNAME> IS THE THING GIVEN AS THE THIRD ARG TO CREATE-SFA
|
||
;;; AND <ADDRESS> IS THE OCTAL ADDRESS OF THE SAR.
|
||
|
||
IFN SFA,[
|
||
PRNSR: MOVEI T,[ASCIZ \SFA-\]
|
||
JRST PRNF5
|
||
] ;END IFN SFA
|
||
PRNJB: MOVEI T,[ASCIZ \JOB-\]
|
||
JRST PRNF5
|
||
PRNFL: MOVEI T,[ASCIZ \FILE-\]
|
||
PRNF5: PUSHJ P,PRNSTO
|
||
HRRZ A,-1(P)
|
||
MOVE TT,ASAR(A)
|
||
SFA$ TLNE TT,AS.SFA ;SFA?
|
||
SFA$ JRST PRNSR1 ;YES, PRINT DIFFERENTLY
|
||
PUSH FXP,TT
|
||
TLNE TT,AS.JOB ;DON'T PRINT DIR FOR JOB ARRAY
|
||
JRST PRNF6
|
||
MOVE TT,TTSAR(A)
|
||
;FORMERLY, THIS ROUTINE USED PRINSY TO PRINT IN OR OUT. BUT, SINCE THIS
|
||
;ROUTINE CAN BE CALLED FROM THE GARBAGE COLLECTOR, THE POINTERS COULD BE
|
||
;MARKED AND THEREFORE INVALID. TO AVOID PRINTING LOSSAGE, PRINTING IS DONE
|
||
;MANUALLY.
|
||
MOVEI T,[ASCII \IN\] ;ASSUME INPUT FILE
|
||
TLNE TT,TTS<IO>
|
||
MOVEI T,[ASCII \OUT\]
|
||
PUSHJ P,PRNSTO
|
||
%NEG%
|
||
PRNF6: %VBAR%
|
||
POP FXP,T ;SAVED ASAR
|
||
MOVNI TT,LPNBUF
|
||
PUSH FXP,PNBUF+LPNBUF(TT) ;UNFORTUNATELY, SOMEONE MIGHT BE USING
|
||
AOJL TT,.-1 ; PNBUF, SO WE MUST SAVE IT
|
||
HRRZ A,-1(P)
|
||
PUSH FXP,R
|
||
20$ MOVE TT,TTSAR(A) ;FOR D20 CLOSED FILE NEEDS SPECIAL HANDLING
|
||
20$ TLNN TT,TTS.CL ;CLOSED? (ASAR SAVED IN T)
|
||
TLNE T,AS.JOB ;DON'T GET TRUENAME FOR JOB ARRRAYS
|
||
JRST PRNJ1
|
||
PUSHJ P,TRU6BT ;GET TRUENAME OF FILE ON FXP
|
||
PRNJ2: PUSHJ P,6BTNSL ;CONVERT THAT TO A NAMESTRING IN PNBUF
|
||
POP FXP,R
|
||
MOVEI TT,-LPNBUF+1(FXP)
|
||
MOVSI T,-LPNBUF
|
||
PRNF1: MOVE D,PNBUF(T) ;SWAP PNBUF WITH COPY ON PDL
|
||
EXCH D,(TT)
|
||
MOVEM D,PNBUF(T)
|
||
ADDI TT,1
|
||
AOBJN T,PRNF1
|
||
MOVEI T,-LPNBUF+1(FXP)
|
||
PUSHN FXP,1 ;BE SURE STRING ENDS WITH ZEROS
|
||
PUSHJ P,PRNSTO
|
||
POPI FXP,LPNBUF+1 ;POP THE CRUD
|
||
%VBAR%
|
||
JRST PRINA4
|
||
|
||
PRNSTO: HRLI T,440700
|
||
ILDB A,T
|
||
JUMPE A,CPOPJ
|
||
PUSHJ P,(R)
|
||
JRST .-3
|
||
|
||
PRNJ1: HRRZ TT,TTSAR(A)
|
||
HRLI TT,-L.F6BT
|
||
20% PUSH FXP,F.RDEV(TT)
|
||
20$ PUSH FXP,F.DEV(TT)
|
||
AOBJN TT,.-1
|
||
JRST PRNJ2
|
||
IFN SFA,[
|
||
PRNSR1: %VBAR%
|
||
MOVEI TT,SR.PNA ;GET THE PNAME
|
||
HRRZ A,-1(P) ;PICK UP ARRAY POINTER
|
||
HRRZ A,@TTSAR(A)
|
||
PUSH FXP,R ;REMEMBER R OVER RECURSIVE CALL TO PRINT
|
||
TLO R,PR.PRC
|
||
PUSHJ P,PRINTA ;PRINT THE NAME
|
||
POP FXP,R
|
||
%VBAR%
|
||
JRST PRINA4
|
||
] ;END IFN SFA
|
||
|
||
SUBTTL PRINT AN ATOMIC SYMBOL
|
||
|
||
;PRINIL:
|
||
;IFN USELESS, PUSHJ P,PLP1
|
||
; MOVEI A,"( ;PRINT () FOR NIL
|
||
; PUSHJ P,(R)
|
||
; MOVEI A,")
|
||
; JRST (R)
|
||
|
||
PRINSY: PUSH P,A
|
||
PUSH P,CPOP1J
|
||
JUMPE A,PRINIL
|
||
PRINN: SKIPA A,-1(P)
|
||
PRINIL: MOVEI A,[$$$NIL,,]
|
||
JSP C,MAPNAME
|
||
JUMPGE R,PRNN2 .SEE PR.PRC
|
||
IFN USELESS, PUSHJ P,PLP1
|
||
PRNN1: JSP C,(C) ;FOR PRINC, JUST OUTPUT THE CHARS
|
||
POPJ P,
|
||
MOVEI A,(TT)
|
||
PUSHJ P,(R)
|
||
JRST PRNN1
|
||
|
||
PRNN2:
|
||
TLO R,PR.NAS+PR.NVB+PR.NUM+PR.EFC+PR.NLS
|
||
MOVE A,-1(P)
|
||
PUSH P,B
|
||
MOVEI B,Q%ISM
|
||
PUSHJ P,GET1
|
||
SKIPE A
|
||
TLZ R,PR.NAS+PR.NVB
|
||
POP P,B
|
||
JSP C,(C) ;GET FIRST CHAR
|
||
JRST PRNN2A ;FOR NULL PNAME, JUST PRINT HANGING LEFT PARENS
|
||
SETZ F, ;F COUNTS: <# SLASHES,,# CHARS>
|
||
HRRZ A,VREADTABLE
|
||
MOVE D,@TTSAR(A)
|
||
TLNN D,14 ;IF NOT A DIGIT OR A SIGN,
|
||
TLZ R,PR.NUM ; THEN IT ISN'T NUMBER-LIKE
|
||
TLNN D,400 ;IF NOT SLASHIFIED AS FIRST CHAR,
|
||
AOJA F,PRNN3A ; JUST BUMP CHAR COUNTER
|
||
TLZ R,PR.EFC ;ELSE ONE FUNNY CHAR SEEN ALREADY
|
||
TLNE D,171000 ;REAL WEIRDIES FORCE VERTICAL BARS
|
||
TLZ R,PR.NVB
|
||
PRNN3: ADD F,R70+1 ;BUMP CHAR COUNT AND SLASH COUNT
|
||
PRNN3A: JSP C,(C) ;GET NEXT CHAR
|
||
JRST PRNN4
|
||
MOVE D,@TTSAR(A)
|
||
TLNN D,24 ;IF IT LOOKS LIKE A NUMBER SO FAR
|
||
TLZN R,PR.NUM ; BUT THIS NEXT CHAR ISN'T DIGIT OR ARROW,
|
||
JRST PRNN3B
|
||
TRNE F,777770 ; THEN WE NEED A LEADING SLASH IF THERE WERE
|
||
TLZ R,PR.NLS ; MORE THAN SEVEN LEADING NUMBER-LIKE CHARS
|
||
PRNN3B: TLNN D,100 ;IF NOT SLASHIBLE IN FIRST POSITION,
|
||
PRNN3C: AOJA F,PRNN3A ; JUST BUMP CHAR COUNTER
|
||
TLNN D,2000 ;VERTICAL BARS CAN'T HELP A SLASH
|
||
CAIN TT,"| ; OR VERTICAL BAR, SO COUNT THEM AS
|
||
AOJA F,PRNN3C ; TWO CHARACTERS AND NO SLASHES
|
||
TLNN D,171000 ;REAL WEIRDIES
|
||
TLZN R,PR.EFC ; OR TWO EMBEDDED FUNNY CHARS
|
||
TLZ R,PR.NVB ; FORCE VERTICAL BARS
|
||
JRST PRNN3
|
||
|
||
PRNN4: CAIN F,1 ;A SIGN WITH NO FOLLOWING
|
||
TLNN D,10 ; DIGITS DOESN'T NEED A SLASH
|
||
CAIA
|
||
JRST PRNN4A
|
||
TLNE R,PR.NUM ;IF THE WHOLE THING IS NUMBER-LIKE,
|
||
TLZ R,PR.NLS ; THEN DEFINITELY NEED A LEADING SLASH
|
||
PRNN4A: MOVEI T,2(F)
|
||
TLNN R,PR.NVB
|
||
JRST PRNN4B
|
||
HLRZ T,F ;WE AREN'T USING VERTICAL-BARS OR DOUBLE-QUOTES
|
||
ADDI T,1(F) ; SO MUST COMPUTE UP ROOM TAKEN BY
|
||
TLNN R,PR.NLS ; CHARS AND SLASHES, PLUS ONE FOR THE SPACE
|
||
ADDI T,1 ; WHICH MAY FOLLOW
|
||
PRNN4B: PUSHJ P,PRINLP
|
||
SKIPN A,-1(P)
|
||
MOVEI A,[$$$NIL,,]
|
||
JSP C,MAPNAME
|
||
TLNE R,PR.NVB
|
||
JRST PRNN6
|
||
TLNN R,PR.NAS ;IF USING |'S OR "'S THEN OUTPUT LEADING ONE
|
||
JRST [ %DBLQ%
|
||
JRST PRNN5 ]
|
||
%VBAR%
|
||
PRNN5: JSP C,(C)
|
||
JRST PRNN5X
|
||
CAIN TT,^M
|
||
JRST PRNN5A
|
||
TLNN R,PR.NAS
|
||
JRST [ CAIN TT,"" ;WITHIN A PSEUDO-STRING, "'S MUST BE SLAHSED
|
||
JRST PRNN5A
|
||
JRST PRNN5B ]
|
||
CAIN TT,"| ;NOT IN A PSEUDO-STRING, SO |'S MUST BE SLASHED
|
||
JRST PRNN5A
|
||
PRNN5B: MOVE A,VREADTABLE
|
||
MOVE D,@TTSAR(A)
|
||
TLNE D,2000
|
||
PRNN5A: %SLSH%
|
||
MOVEI A,(TT)
|
||
PUSHJ P,(R)
|
||
JRST PRNN5
|
||
|
||
PRNN5X: TLNN R,PR.NAS
|
||
JRST [ %DBLQ%
|
||
POPJ P, ]
|
||
%VBAR%
|
||
POPJ P,
|
||
|
||
PRNN6: MOVEI F,400
|
||
PRNN6A: JSP C,(C)
|
||
POPJ P,
|
||
20$ PUSH P,B ;B MUST BE PRESERVED
|
||
MOVE A,VREADTABLE
|
||
MOVE D,@TTSAR(A)
|
||
TLOE R,PR.NLS
|
||
TLNE D,(F)
|
||
%SLSH%
|
||
MOVEI A,(TT)
|
||
PUSHJ P,(R)
|
||
20$ POP P,B
|
||
MOVEI F,100
|
||
JRST PRNN6A
|
||
|
||
|
||
PRNN2A:
|
||
IFN USELESS,[
|
||
HLRZ T,PRPRCT
|
||
PRNN2B: SOJL T,PRNN2C
|
||
%LPAR%
|
||
JRST PRNN2B
|
||
PRNN2C: HRRZS PRPRCT
|
||
] ;END OF IFN USELESS
|
||
TLNN R,PR.NAS
|
||
JRST [ %DBLQ% ;FOR NULL PSEUDO-STRING, PRINT ""
|
||
%DBLQ%
|
||
JRST PLP1 ]
|
||
%VBAR% ;FOR NULL PNAME, PRINT ||
|
||
%VBAR%
|
||
JRST PLP1
|
||
|
||
|
||
;;; COROUTINE TO DELIVER UP CHARACTERS OF A PRINT NAME.
|
||
;;; USES JSP C,(C) TO CALL. USES B, T; YIELDS CHARS IN TT.
|
||
;;; SETUP USES A. SKIPS UNLESS NO MORE CHARS.
|
||
|
||
MAPNAME:
|
||
HLRZ B,(A)
|
||
HRRZ B,1(B)
|
||
JSP C,(C)
|
||
MAPNM1: HLRZ T,(B)
|
||
MOVE T,(T)
|
||
TRZ T,1 ;FORCE OFF LOW ORDER BIT, IS UNUSED IN ASCII
|
||
MAPNM2: SETZ TT,
|
||
ROTC T,7
|
||
SKIPN T ;ONLY CHECK FOR NULLS IF AT THE END OF THE WORD
|
||
JUMPE TT,MAPNM3
|
||
JSP C,1(C)
|
||
JRST MAPNM2
|
||
|
||
MAPNM3: HRRZ B,(B)
|
||
JUMPN B,MAPNM1
|
||
JRST (C)
|
||
|
||
|
||
;;; ROUTINE TO FEED FORMATTING INFORMATION TO TYO IF DESIRED,
|
||
;;; THEN PRINT ANY PENDING LEFT PARENTHESES.
|
||
;;; THE LENGTH OF THE ATOM TO BE PRINTED IS IN T.
|
||
;;; USES ONLY A AND T.
|
||
|
||
PRINLP: TLNN R,PR.ATR
|
||
JRST PLP1
|
||
IFN USELESS,[
|
||
MOVSI T,(T)
|
||
ADD T,PRPRCT
|
||
HLRZ T,T
|
||
ADD T,PRPRCT
|
||
] ;END OF IFN USELESS
|
||
TRNE T,777000
|
||
MOVEI T,777
|
||
HRROI A,1(T) ;ALLOW FOR FOLLOWING SPACE
|
||
PUSHJ P,(R)
|
||
PLP1: .SEE PRNN1
|
||
IFE USELESS, POPJ P,
|
||
IFN USELESS,[
|
||
HLRZ T,PRPRCT
|
||
PRINLQ: SOJL T,CPOPJ
|
||
%LPAR%
|
||
JRST PRINLQ
|
||
] ;END OF IFN USELESS
|
||
|
||
SUBTTL PRINT A FIXNUM
|
||
|
||
PRINI: MOVE A,VBASE
|
||
IFN USELESS, CAIN A,QROMAN
|
||
IFN USELESS, JRST PRINRM
|
||
SKOTT A,FX
|
||
JRST BASER
|
||
MOVE C,(A) ;TRUE VALUE OF BASE IN C
|
||
CAIG C,36.
|
||
CAIGE C,2
|
||
JRST BASER
|
||
PRI2D: HRRZ A,-1(P)
|
||
JSP T,FXNV1 ;THE TYO ROUTINE MUST SAVE TT HERE
|
||
IFN USELESS,[
|
||
MOVMS TT ;ESTIMATE LENGTH OF FIXNUM
|
||
JFFO TT,.+2 ; ASSUMING OCTAL BASE
|
||
MOVEI D,43
|
||
MOVNI T,3
|
||
IDIVM D,T ;AVOID CLOBBERING EXTRA ACS
|
||
ADDI T,14
|
||
SKIPGE @-1(P) ;ALLOW FOR MINUS SIGN
|
||
ADDI T,1
|
||
PUSHJ P,PRINLP
|
||
MOVE TT,@-1(P)
|
||
] ;END OF IFN USELESS
|
||
CAIN C,8 ;FOR OCTAL NUMBERS, WE MAY WANT
|
||
JRST PRI2B ; TO USE A FUNNY SHIFTED FORMAT
|
||
PRI2C: JUMPL TT,PRI2Q
|
||
SKIPE V.NOPOINT
|
||
JRST PRINI2 ;HAPPY PRATT?
|
||
CAILE C,10.
|
||
%POS%
|
||
JRST PRINI2
|
||
|
||
PRI2Q: %NEG%
|
||
PRI2A: MOVNS TT
|
||
PRINI2: JSP T,PRI. ;INSERT DECIMAL POINT IF NECESSARY
|
||
PRINI9: MOVEI T,1 ;MUST SAVE F - SEE GCPNT1, GCWORRY
|
||
TLZN TT,400000 ;IF NUMBER COULD BE MOBY, THEN MOVE HIGH ORDER BIT
|
||
PRINI3: SETZ T, .SEE FP4B1 ;MUSTN'T DISTURB B
|
||
JSP D,PRINI5
|
||
SKIPE TT,T
|
||
PUSHJ P,PRINI3
|
||
FP7A1: HLRZ A,(P)
|
||
FP7B: MOVEI A,"0(A)
|
||
CAIE A,".
|
||
JRST (R)
|
||
%DCML%
|
||
POPJ P,
|
||
|
||
PRINI5: DIVI TT-1,(C)
|
||
CAILE TT,9
|
||
ADDI TT,"A-"9-1 ;KLUDGY DIGITS GREATER THAN 9 ARE "A, B, C, ..., Y, Z"
|
||
PRINI7: HRLM TT,(P)
|
||
JRST (D)
|
||
|
||
PRI.: CAIN C,10. ;IF THE RADIX IS 10.
|
||
SKIPE V.NOPOINT ; AND *NOPOINT IS NOT SET,
|
||
JRST (T) ; THEN KLUDGILY ARRANGE
|
||
HRLI T,".-"0 ; TO PRINT A "." AFTER THE
|
||
HLLM T,(P) ; DIGITS ARE PRINTED
|
||
PUSH P,[FP7A1]
|
||
JRST (T)
|
||
|
||
PRI2B: MOVM D,TT
|
||
TRNN D,777
|
||
TLNN D,-1
|
||
JRST PRI2C
|
||
MOVEI T,(C)
|
||
MOVE C,VREADTABLE
|
||
MOVE D,TT
|
||
MOVEI TT,LRCT-1 ;RH OF LAST RCT ENTRY IS (STATUS _)
|
||
HRRZ C,@TTSAR(C)
|
||
EXCH T,C
|
||
MOVE TT,D
|
||
JUMPE T,PRI2C
|
||
MOVNI D,11 ;PRINT OUT AS ONE OF:
|
||
TRNE TT,777000 ; NNNNNNNNN_11
|
||
JRST PRI2B3 ; NNNNNN_22
|
||
MOVNI D,22 ; NNN_33
|
||
TLNN TT,777 ; N_41
|
||
MOVNI D,33 ; IN ORDER THAT LOSERS NEED NOT
|
||
TLNN TT,77777 ; COUNT ALL THE ZEROS OF AN
|
||
MOVNI D,41 ; OCTAL NUMBER.
|
||
PRI2B3: ASH TT,(D)
|
||
PUSH FXP,D
|
||
PUSHJ P,PRI2C
|
||
%BAK%
|
||
POP FXP,TT
|
||
JRST PRI2A
|
||
|
||
IFN USELESS,[
|
||
PROMAN: AOS (P)
|
||
JRST PRINR0
|
||
|
||
PRINRM: HRRZ A,-1(P)
|
||
JSP T,FXNV1
|
||
PRINR0: MOVEI C,10.
|
||
JUMPLE TT,PRI2D
|
||
CAIL TT,4000.
|
||
JRST PRI2D
|
||
MOVEI T,15.
|
||
PUSHJ P,PRINLP
|
||
SETZ T,
|
||
PRINR1: IDIVI TT,10.
|
||
HRLM D,(P)
|
||
ADDI T,1
|
||
JUMPE TT,PRINR2
|
||
PUSHJ P,PRINR1
|
||
PRINR2: HLRZ TT,(P)
|
||
SUBI T,1
|
||
JUMPE TT,CPOPJ
|
||
CAIE TT,9
|
||
JRST PRINR3
|
||
HLRZ A,PRINR9(T)
|
||
PUSHJ P,(R)
|
||
HLRZ A,PRINR9+1(T)
|
||
JRST (R)
|
||
|
||
PRINR3: CAIE TT,4
|
||
JRST PRINR4
|
||
HLRZ A,PRINR9(T)
|
||
PUSHJ P,(R)
|
||
HRRZ A,PRINR9(T)
|
||
JRST (R)
|
||
|
||
PRINR4: CAIGE TT,5
|
||
JRST PRINR6
|
||
SUBI TT,5
|
||
HRRZ A,PRINR9(T)
|
||
PRINR5: PUSHJ P,(R)
|
||
PRINR6: SOJL TT,CPOPJ
|
||
HLRZ A,PRINR9(T)
|
||
JRST PRINR5
|
||
|
||
PRINR9: "I,,"V
|
||
"X,,"L
|
||
"C,,"D
|
||
"M,,
|
||
] ;END OF IFN USELESS
|
||
|
||
SUBTTL PRINT A FLONUM
|
||
|
||
|
||
PRINO:
|
||
IFN USELESS,[
|
||
MOVEI T,17. ;GROSS ESTIMATE OF LENGTH OF FLONUM
|
||
PUSHJ P,PRINLP
|
||
] ;END OF IFN USELESS
|
||
MOVE T,@-1(P)
|
||
;A FLONUM TO PRINT IS IN T
|
||
FP0:
|
||
FP0A: JUMPGE T,FP0B
|
||
%NEG%
|
||
MOVNS T
|
||
FP0B:
|
||
;A POSITIVE FLONUM TO PRINT IS IN T;
|
||
FP1:
|
||
SETZB TT,F ;TT IS SECOND WORD FOR T; F WILL BE EXPONENT
|
||
CAMGE T,[0.01]
|
||
JRST FP4 ;0.01 (OR 0.1) AND 1.0^8 ARE CHOSEN SO THAT THE
|
||
CAML T,[1.0^8] ; FRACTIONAL PART WILL HAVE AT LEAST ONE
|
||
JRST FP4E0 ; BIT, BUT NOT LOSE ANY OFF THE RIGHT END
|
||
;A POSITIVE FLONUM BETWEEN .01 AND 1.0^8 IS IN T
|
||
FP3: SETZB TT,D
|
||
ASHC T,-33 ;SPLIT EXPONENT PART OFF - MANTISSA IN TT
|
||
ASHC TT,-243(T) ;SPLIT NUMBER INTO INTEGRAL AND FRACTIONAL PART
|
||
MOVSI F,200000 ;COMPUTE POSITION OF LAST SIGNIFICANT BITS
|
||
ASH F,-243+<43-33>(T) ;F GETS A VALUE EQUAL TO 1/2 LSB
|
||
PUSH FXP,F
|
||
PUSH FXP,D ;SAVE FRACTION
|
||
MOVEI C,10. ;PRINT INTEGER PART AS A DECIMAL FIXNUM
|
||
PUSHJ P,PRINI3
|
||
%DCML% ;PRINT DECIMAL POINT
|
||
POP FXP,TT
|
||
;NOW TT HAS FRACTION INFO BITS, AND (FXP) HAS SLIDING MASK BIT (TOLERANCE)
|
||
FP3A: MOVE T,TT ;REMAINING INFO BITS IN TT
|
||
MULI T,10. ;T GETS NEXT DIGIT TO PRINT, MORE OR LESS
|
||
POP FXP,F
|
||
JFCL 8,.+1 ;CLEAR OVERFLOW
|
||
IMULI F,10. ;OVERFLOW ON (FSC 231400000001 0) AND (FSC 175631463150 0)
|
||
JFCL 8,FP3A1 ;CUT OFF WHEN MASK BIT OVERFLOWS
|
||
CAMGE TT,F
|
||
JRST FP3A1 ; OR WHEN REMAINING INFO BITS ARE BELOW MASK
|
||
MOVN D,F
|
||
TLZ D,400000
|
||
CAMLE TT,D
|
||
AOJA T,FPX0 ;LAST SIG DIGIT, BUT ROUND UPWARDS
|
||
PUSH FXP,F
|
||
PUSHJ P,FPX0 ;OUTPUT A DIGIT, AND GO AROUND FOR ANOTHER
|
||
JRST FP3A
|
||
|
||
FP3A1: TLNE TT,200000 ;SIZE OF REMAINDER DETERMINES ROUNDING
|
||
ADDI T,1
|
||
FPX0: MOVEI A,"0(T) ;COME HERE TO OUTPUT A DIGIT IN T
|
||
JRST (R)
|
||
|
||
;HERE ON FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
|
||
FP4: JUMPN T,FP4E ;FLOATING POINT "E" FORMAT
|
||
PUSHJ P,FP4A ;CLEVER WAY TO PRINT OUT "0.0" QUICKLY
|
||
%DCML%
|
||
FP4A: MOVEI A,"0
|
||
JRST (R)
|
||
|
||
;HERE ON FLONUMS >= 1.0E8
|
||
FP4E0: SKIPN KA10P
|
||
JRST .+5
|
||
FDVL T,D1.0E8 ;BE DOUBLY PRECISE IN DIVIDING
|
||
FDVR TT,D1.0E8 ; BY 10^8 TO GET NUMBER IN RANGE
|
||
FADL T,TT
|
||
JRST .+2
|
||
DFDV T,D1.0E8
|
||
ADDI F,8
|
||
CAML T,D1.0E8
|
||
JRST FP4E0 ;KEEP DIVIDING UNTIL < 10^8
|
||
FP4E1: CAMGE T,D10.0
|
||
JRST FP4B
|
||
SKIPN KA10P
|
||
JRST .+5
|
||
FDVL T,D10.0 ;NOW REDUCE UNTIL < 10.0
|
||
FDVRI TT,(10.0)
|
||
FADL T,TT
|
||
JRST .+2
|
||
DFDV T,D10.0
|
||
AOJA F,FP4E1
|
||
|
||
|
||
;HERE FOR NON-ZERO FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
|
||
FP4E: CAML T,[1.0^-8] ;BE DOUBLY PRECISE IN MULTIPLYING BY 10^8
|
||
JRST FP4E2A
|
||
SKIPN KA10P
|
||
JRST .+7
|
||
FMPR TT,D1.0E8
|
||
MOVEM TT,D
|
||
FMPL T,D1.0E8
|
||
UFA TT,D
|
||
FADL T,D
|
||
JRST .+2
|
||
DFMP T,D1.0E8
|
||
SUBI F,8
|
||
JRST FP4E
|
||
|
||
FP4E2: SKIPN KA10P
|
||
JRST .+7
|
||
FMPRI TT,(10.0) ;NOW INCREASE UNTIL >= 1.0
|
||
MOVEM TT,D
|
||
FMPL T,D10.0
|
||
UFA TT,D
|
||
FADL T,D
|
||
JRST .+2
|
||
DFMP T,D10.0
|
||
FP4E2A: CAMGE T,[1.0]
|
||
SOJA F,FP4E2
|
||
;HERE WHEN NUMBER BETWEEN 1.0 (INCL) AND 10.0 (EXCL); F IS THE EXPONENT TO BE PRINTED.
|
||
FP4B: SKIPE KA10P
|
||
JRST .+6
|
||
|
||
TLNN TT,200000 ;DECIDE WHETHER ROUNDING WILL HAVE ANY EFFECT
|
||
JRST FP4B1
|
||
HLLZ TT,T ;IF SO, CREATE A FLONUM WHOSE VALUE IS
|
||
TLZ TT,777 ; 1/2 LSB OF FRACTION IN T
|
||
ADD TT,[777000,,1]
|
||
|
||
FADR T,TT ;ADD LOW PART TO HIGH PART, ROUNDING
|
||
CAMGE T,D10.0 ;ROUNDING UP MAY TAKE US OUT OF RANGE AGAIN
|
||
JRST FP4B1
|
||
FDVRI T,(10.0)
|
||
ADDI F,1 ;ADJUST EXPONENT FOR THE DIVISION
|
||
|
||
|
||
;; FALLS THRU
|
||
|
||
FP4B1: PUSH FLP,F ;DON'T USE FXP! WILL CONFLICT WITH MASK OF DB$
|
||
PUSHJ P,FP3 ;NUMBER HAS BEEN NORMALIZED FOR 1.0 .LE. X < 10.0
|
||
%E% ;FOR SINGLE PRECISION, "E" INDICATES EXPONENT
|
||
POP FLP,TT ;POP EXPONENT
|
||
SKIPLE TT ;PRINT SIGN (BUT PRINT NO SIGN FOR 0)
|
||
%POS%
|
||
SKIPGE TT
|
||
%NEG%
|
||
MOVEI C,10.
|
||
MOVMS TT
|
||
JRST PRINI3 ;PRINT EXPONENT AS A DECIMAL INTEGER
|
||
|
||
|
||
|
||
SUBTTL PRINT A COMPLEX OR A DUPLEX
|
||
|
||
IFN CXFLAG,[
|
||
PRINCX:
|
||
IFN USELESS,[
|
||
MOVEI T,35.
|
||
SKIPN @-1(P)
|
||
MOVEI T,18.
|
||
PUSHJ P,PRINLP
|
||
] ;END OF IFN USELESS
|
||
SKIPE T,@-1(P) ;DON'T PRINT REAL PART IF 0
|
||
PUSHJ P,FP0
|
||
KA HRRZ A,-1(P)
|
||
KA MOVE T,(A)
|
||
KA MOVE TT,1(A)
|
||
KIKL DMOVE T,@-1(P)
|
||
JUMPE T,PRNCX2
|
||
SKIPL TT
|
||
%POS%
|
||
PRNCX2: JUMPE TT,PRNCX4
|
||
SKIPGE TT
|
||
%NEG%
|
||
MOVM T,TT
|
||
PUSHJ P,FP0
|
||
PRNCX3: MOVEI A,"J ;CROCK
|
||
JRST (R)
|
||
|
||
PRNCX4: MOVEI A,"0
|
||
PUSHJ P,(R)
|
||
JRST PRNCX3
|
||
] ;END OF IFN CXFLAG
|
||
|
||
IFN DXFLAG,[
|
||
PRINDX:
|
||
IFN USELESS,[
|
||
MOVEI T,60.
|
||
SKIPN @-1(P)
|
||
MOVEI T,30.
|
||
PUSHJ P,PRINLP
|
||
] ;END OF IFN USELESS
|
||
KA HRRZ A,-1(P)
|
||
KA MOVE T,(A)
|
||
KA MOVE TT,1(A)
|
||
KIKL DMOVE T,@-1(P)
|
||
SKIPE T ;DON'T PRINT REAL PART IF 0
|
||
PUSHJ P,DFP0
|
||
HRRZ A,-1(P)
|
||
KA MOVE T,2(A)
|
||
KA MOVE TT,3(A)
|
||
KIKL DMOVE T,2(A)
|
||
SKIPN @-1(P)
|
||
JRST PRNDX2
|
||
SKIPL T
|
||
%POS%
|
||
PRNDX2: JUMPE T,PRNCX4
|
||
SKIPGE T
|
||
%NEG%
|
||
JUMPGE T,PRNDX5
|
||
KA DFN T,TT
|
||
KIKL DMOVN T,T
|
||
PRNDX5: PUSHJ P,DFP0
|
||
JRST PRNCX3
|
||
] ;END OF IFN DXFLAG
|
||
|
||
IFN BIGNUM,[
|
||
|
||
SUBTTL PRINT A BIGNUM
|
||
|
||
PRINB:
|
||
IFN USELESS,[
|
||
HRRZ B,@-1(P)
|
||
MOVEI T,1
|
||
PRINB0: ADDI T,12.
|
||
HRRZ B,(B)
|
||
JUMPN B,PRINB0
|
||
PUSHJ P,PRINLP
|
||
] ;END OF IFN USELESS
|
||
HRRZ A,-1(P)
|
||
SKIPGE A,(A)
|
||
JRST PRINBQ
|
||
IFE USELESS, HRRZ D,@VBASE
|
||
IFN USELESS,[
|
||
HRRZ D,VBASE
|
||
CAIE D,QROMAN
|
||
SKIPA D,(D)
|
||
MOVEI D,10.
|
||
] ;END OF IFN USELESS
|
||
CAILE D,10.
|
||
%POS%
|
||
JRST PRINBZ
|
||
PRINBQ: %NEG% ;NEGATIVE BIGNUM
|
||
PRINBZ: MOVEM R,RSAVE
|
||
HRRZM P,FSAVE ;STORE PDL POSITION SO AR1 AND AR2A CAN BE FOUND
|
||
PUSH P,AR1
|
||
PUSH P,AR2A
|
||
PUSHJ P,YPOCB
|
||
PUSH P,A
|
||
PUSH P,[PRINB4]
|
||
MOVE B,VBASE
|
||
IFN USELESS,[
|
||
CAIN B,QROMAN
|
||
SKIPA D,[10.]
|
||
] ;END OF IFN USELESS
|
||
JSP T,FXNV2
|
||
MOVE C,D
|
||
JSP T,PRI.
|
||
MOVE R,D
|
||
MOVEI F,1
|
||
MOVE T,D
|
||
PRBAB: MUL T,D
|
||
JUMPN T,.+4
|
||
MOVE T,TT
|
||
MOVE R,TT
|
||
AOJA F,PRBAB
|
||
MOVEM F,NORMF
|
||
MOVE D,R
|
||
PRINB3: MOVE C,A
|
||
HLRZ B,(C)
|
||
MOVE F,(B)
|
||
MOVEI R,0
|
||
PNFBLP: DIV R,D
|
||
MOVEM R,(B)
|
||
MOVE B,(C)
|
||
TRNN B,-1
|
||
JRST PRBFIN
|
||
MOVE C,(C)
|
||
MOVE R,F
|
||
HLRZ B,(C)
|
||
MOVE F,(B)
|
||
JRST PNFBLP
|
||
|
||
|
||
PRBFNA: HLR A,B
|
||
PRBFIN: MOVS B,(A)
|
||
TLNE B,-1
|
||
SKIPE (B)
|
||
JRST .+2
|
||
JRST PRBFNA
|
||
PUSH FXP,F
|
||
MOVE R,(A)
|
||
TRNN R,-1
|
||
JRST PRBNUF
|
||
PUSHJ P,PRINB3
|
||
PRINBI: POP FXP,TT
|
||
MOVE F,NORMF
|
||
MOVE R,RSAVE
|
||
PRINBJ: SETZ T,
|
||
JSP D,PRINI5
|
||
SOJE F,FP7A1
|
||
MOVE TT,T
|
||
PUSHJ P,PRINBJ
|
||
JRST FP7A1
|
||
|
||
PRBNUF: HLRZ A,R
|
||
MOVE TT,(A)
|
||
MOVE AR2A,FSAVE
|
||
MOVE AR1,1(AR2A) ;RESTORE AR1 AND AR2A
|
||
MOVE AR2A,2(AR2A)
|
||
HRRZ C,VBASE
|
||
IFN USELESS, CAIN C,QROMAN
|
||
IFN USELESS, SKIPA R,[10.]
|
||
JSP T,FXNV3
|
||
MOVE C,R
|
||
MOVE R,RSAVE
|
||
SKIPE TT
|
||
PUSHJ P,PRINI3
|
||
JRST PRINBI
|
||
|
||
PRINB4: POP P,A
|
||
MOVEI B,TRUTH
|
||
PUSHJ P,RECLAIM
|
||
POP P,AR2A
|
||
POP P,AR1
|
||
POPJ P,
|
||
] ;END OF IFN BIGNUM
|
||
|
||
SUBTTL FLATSIZE, FLATC, EXPLODEC, EXPLODEN, EXPLODE
|
||
|
||
FLATSIZE:
|
||
PUSH P,CFIX1 ;SUBR 1
|
||
SKOTTN A,LS
|
||
IFN HNKLOG,[
|
||
TLNN TT,HNK
|
||
JRST FLAT5
|
||
PUSHJ P,USRHNP ;Is this a user's extended hunk?
|
||
JUMPE T,FLAT5
|
||
SETZ B, ;Say we aren't PRINT
|
||
SETZ R, ;Say to do slashification
|
||
PUSHJ P,SENDFL
|
||
MOVE TT,(A) ;Get the result
|
||
POPJ P, ;And make it into a FIXNUM
|
||
] ; End of IFN HNKLOG,
|
||
|
||
FLAT5: SKIPA R,CFLAT2 ;POPJ IS POSITIVE
|
||
FLAT4: HRROI R,FLAT2
|
||
FLAT3: SETZM FLAT1
|
||
PUSHJ P,PRINTF
|
||
SKIPA TT,FLAT1
|
||
FLAT2: AOS FLAT1
|
||
CFLAT2: POPJ P,FLAT2
|
||
|
||
IFN HNKLOG,[
|
||
%FLO: ;(FLATSIZE-OBJECT object printp i-depth slash)
|
||
FLATOBJECT: ;LSUBR (4 . 5)
|
||
JSP TT,LWNACK ;Check number of arguments
|
||
LA45,,Q%FLO
|
||
CAMN T,IN0-5 ;5 args?
|
||
POP P,AR1 ; Yes, throw one away
|
||
POP P,AR1
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
PUSH P,CFIX1
|
||
MOVE TT,(C)
|
||
MOVEM TT,PRINLV
|
||
MOVE R,[PR.ATR,,FLAT2]
|
||
SKIPE B ;Is this from inside print?
|
||
HRRI R,FLATO2 ; Yes, fake out PRINT to think it's from print
|
||
SKIPN AR1 ;Slashify?
|
||
TLO R,PR.PRC ; Nope, tell PRINT not to.
|
||
SETZM FLAT1
|
||
PUSHJ P,PRINTF
|
||
MOVE TT,FLAT1
|
||
POPJ P,
|
||
|
||
FLATO2: AOS FLAT1
|
||
POPJ P,
|
||
]; END of IFN HNKLOG,
|
||
|
||
FLATC: PUSH P,CFIX1 ;SUBR 1
|
||
SKOTTN A,LS
|
||
IFN HNKLOG,[
|
||
TLNN TT,HNK
|
||
JRST FLAT7
|
||
PUSHJ P,USRHNP ;Is this a user-extend HUNK?
|
||
JUMPE T,FLAT7 ;Maybe not
|
||
SETZ AR1 ;Say not from PRINT
|
||
SETO R, ;Say no slashification
|
||
SETZ B, ;Say we aren't print
|
||
PUSHJ P,SENDFL ;Send it the message to get value to return
|
||
MOVE TT,(A) ;Get result (better be fixnum)
|
||
POPJ P, ;We'll definately return a fixnum! (we cons it)
|
||
] ; End of IFN HNKLOG,
|
||
|
||
FLAT7: TLNN TT,SY
|
||
JRST FLAT7A
|
||
FLATC1: HLRZ TT,(A) ;FAST-FLATC FOR SYMBOLS
|
||
HRRZ A,1(TT)
|
||
FLTC1A: SETZ TT,
|
||
FLATC2: HRRZ B,(A) ;COUNT 5 CHARS PER PNAME WORD
|
||
ADDI TT,BYTSWD
|
||
JUMPE B,FLATC3
|
||
HRRZ A,(B)
|
||
ADDI TT,BYTSWD
|
||
JUMPN A,FLATC2
|
||
MOVEI A,(B)
|
||
FLATC3: HLRZ A,(A) ;LAST PNAME WORD MAY BE PARTIAL
|
||
SKIPN T,(A) ;WATCH OUT FOR NULL PNAME!
|
||
SUBI TT,1
|
||
TRNE T,177_1
|
||
POPJ P,
|
||
TRNE T,177_10
|
||
SOJA TT,CPOPJ
|
||
SUBI TT,3
|
||
TDNE T,[177_17]
|
||
AOJA TT,CPOPJ
|
||
TLNN T,(177_26)
|
||
SUBI TT,1
|
||
POPJ P,
|
||
|
||
FLAT7A: JUMPN A,FLAT4
|
||
HRRZ A,$$$NIL+1
|
||
JRST FLTC1A
|
||
|
||
$EXPLODEC:
|
||
PUSHJ P,USRHPP ;Is this a user hunk?
|
||
JUMPN T,$$EXPU ;If so, send an EXPLODEC message
|
||
MOVE R,EXPL0 ;SUBR 1 ;HRRZI IS NEGATIVE!!!
|
||
JRST $$EXP1
|
||
|
||
$$EXPU: PUSH P,A
|
||
PUSH P,[QEXPLODE]
|
||
PUSH P,NIL ;SLASHIFY-P
|
||
PUSH P,NIL ;NUMBER-P
|
||
JRST $$EXSN
|
||
|
||
$$EXPLODEN:
|
||
PUSHJ P,USRHPP ;Is this a user hunk?
|
||
JUMPE T,$$EXP0 ;Nope, hack normally
|
||
PUSH P,A
|
||
PUSH P,[QEXPLODE]
|
||
PUSH P,NIL ;SLASHIFY-P
|
||
PUSH P,[TRUTH] ;NUMBER-P
|
||
$$EXSN: MOVNI T,4
|
||
XCT SENDI ;Never returns
|
||
|
||
$$EXP0: HRROI R,EXPL2 ;SUBR 1
|
||
$$EXP1: SKOTT A,SY
|
||
JRST EXPL4
|
||
HLRZ T,(A)
|
||
HRRZ A,1(T)
|
||
PUSH P,R70 ;FORMING LIST OF CHARS
|
||
MOVEI B,(P)
|
||
PUSH P,A
|
||
PUSH P,B
|
||
XOR R,EXPL0
|
||
PUSH FXP,R
|
||
EXPLY1: SKIPN A,-1(P)
|
||
JRST EXPLY9
|
||
HLRZ B,(A)
|
||
MOVE D,(B)
|
||
HRRZ A,(A)
|
||
MOVEM A,-1(P)
|
||
EXPLY2: JUMPE D,EXPLY1
|
||
SETZ TT,
|
||
LSHC TT,7
|
||
SKIPE (FXP)
|
||
JRST EXPLY3
|
||
PUSH FXP,D
|
||
PUSHJ P,RDCH2
|
||
POP FXP,D
|
||
JRST EXPLY4
|
||
EXPLY3: MOVEI A,IN0(TT) .SEE HINUM
|
||
EXPLY4: PUSHJ P,NCONS
|
||
HRRM A,@(P)
|
||
HRRZM A,(P)
|
||
JRST EXPLY2
|
||
|
||
EXPLY9: SUB P,R70+2
|
||
SUB FXP,R70+1
|
||
JRST POPAJ
|
||
|
||
EXPLODE:
|
||
PUSHJ P,USRHPP ;Is it a USERHUNK?
|
||
JUMPE T,EXPL0
|
||
PUSH P,A
|
||
PUSH P,[QEXPLODE]
|
||
PUSH P,[TRUTH] ;SLASHIFY-P
|
||
PUSH P,NIL ;NUMBER-P
|
||
JRST $$EXSN
|
||
|
||
EXPL0: HRRZI R,EXPL1 ;SUBR 1
|
||
EXPL4: PUSH P,R70
|
||
HRRZM P,EXPL5
|
||
PUSHJ P,PRINTF
|
||
JRST POPAJ
|
||
|
||
EXPL1: SOVE B C
|
||
PUSHJ P,SAVX5
|
||
ANDI A,177
|
||
PUSHJ P,RDCH3
|
||
POP P,C
|
||
EXPL3: PUSHJ P,NCONS
|
||
HRRM A,@EXPL5
|
||
HRRZM A,EXPL5
|
||
PUSHJ P,RSTX5
|
||
JRST POPBJ
|
||
|
||
EXPL2: PUSH P,B
|
||
PUSHJ P,SAVX5
|
||
MOVEI A,IN0(A)
|
||
JRST EXPL3
|
||
|
||
|
||
SUBTTL BAKTRACE
|
||
|
||
BAKTRACE: ;PRINT A BAKTRACE
|
||
JSP TT,LWNACK
|
||
LA01,,QBAKTRACE
|
||
MOVNI TT,1
|
||
JRST BKTR0
|
||
BAKLIST: ;RETURN A LIST (SIMILAR TO PRINTED FORMAT)
|
||
JSP TT,LWNACK
|
||
LA01,,QBAKLIST
|
||
MOVSI TT,400000
|
||
BKTR0: MOVEM TT,BACTYF ;TYPE FLAG FOR BAKTRACE/BAKLIST
|
||
MOVEI A,NIL ;START WITH NIL
|
||
SKIPE T ;OR USER SUPPLIED ARG
|
||
POP P,A
|
||
JSP R,GTPDLP ;GET APPROPRIATE PDL POINTER
|
||
0
|
||
JFCL
|
||
MOVEI A,(D) ;SAVE PDL POINTER IN A
|
||
MOVE B,(A) ;GET TOP OF STACK
|
||
CAME B,[QBAKTRACE,,CPOPJ]
|
||
CAMN B,[QBAKLIST,,CPOPJ]
|
||
SOS A ;SKIP FIRST SLOT IF CALL TO US
|
||
MOVEI R,60 ;LOOK AT ABOUT 60 STACK LOCATIONS
|
||
HRRZ TT,C2 ;GET PDL ORIGION
|
||
SUBM A,TT ;SAVE PDL OFFSET IN TT
|
||
CAIG TT,(R) ;FEWER THAN 60 LOCATIONS TO LOOK AT?
|
||
MOVE R,TT ;YES, SO LOOK AT THAT MANY
|
||
MOVE T,A
|
||
SETZM CPJSW ;ASSUME *RSET HAS BEEN OFF
|
||
MOVEI B,CPOPJ
|
||
BKTR3: MOVE TT,(T) ;CUT OUT STUFF FROM *RSET LOOP, IF USED
|
||
CAIN B,(TT)
|
||
TLNN TT,-1
|
||
SKIPA
|
||
SETOM CPJSW ;APPARENTLY *RSET HAS BEEN ON
|
||
TLZ TT,-1#10000
|
||
CAMN TT,[10000,,LSPRET]
|
||
MOVEI A,-1(T)
|
||
SOS T
|
||
SOJG R,BKTR3
|
||
MOVEM A,BKTRP ;SET UP FOR BAKTRACE LOOP AND GO THERE
|
||
MOVE A,BACTYF
|
||
AOJE A,BKTR2 ;IF TRACING THEN SKIP LIST HACKING STUFF
|
||
PUSH P,R70 ;SET UP LIST TO HOLD BAKLISTING
|
||
HRLM P,(P) ;SET UP LAST-OF-LIST POINTER
|
||
BKTR2: HRRZ A,C2 ;THE PDL-HUNTING LOOP
|
||
ADDI A,1
|
||
CAML A,BKTRP
|
||
JRST BKTR2X ;EXIT WHEN BACKED UP TO BOTTOM OF PDL
|
||
AOSN BACTYF
|
||
STRT [SIXBIT \^MBAKTRACE^M!\]
|
||
HRRZ A,@BKTRP
|
||
CAIN A,CPOPJ ;IN *RSET MODE, THIS IS A TAG
|
||
JRST BKTR1C ;PUT ON PDL UPON ENTRY TO A FUNCTION
|
||
CAIN A,ILIST3
|
||
JRST BKTR1B
|
||
MOVE D,@BKTRP
|
||
TLNE D,10000#-1 ;TO BE A PUSHJ RETURN ADDR, THERE MUST
|
||
CAIN A,BKCOM1 ; BE PC FLAGS IN LH
|
||
JRST BKTR1
|
||
CAIL A,BEGFUN
|
||
CAIL A,ENDFUN
|
||
JRST BKTR1A
|
||
CAIE A,CON2
|
||
CAIN A,CON3
|
||
JRST BKTR1G
|
||
CAIN A,PG0A
|
||
JRST BKTR1E
|
||
CAIN A,LMBLP1
|
||
JRST BKTR1
|
||
CAILE A,BRLP1
|
||
CAILE A,BRLP2
|
||
SKIPA
|
||
JRST BKTR1H
|
||
CAIN A,REKRD1
|
||
JRST BKTRR3
|
||
CAIE A,UNBIND
|
||
JRST BKTR1A
|
||
BKTR1: SOS BKTRP
|
||
JRST BKTR2
|
||
BKTR2X: AOSE BACTYF
|
||
SKIPL BACTYF
|
||
JRST TERPRI
|
||
POP P,A
|
||
JRST RHAPJ
|
||
|
||
BKTR1A: CAMGE A,@VBPORG ;LETS HOPE THAT BPORG ISN'T SCREWED UP
|
||
CAIGE A,BBPSSG
|
||
JRST BKTR1
|
||
BK1A2: MOVEI AR1,-1(A)
|
||
BK1A4: HLRZ B,-1(A) ;SOMEWHERE IN BINARY PROGRAMS
|
||
MOVEI R,PRIN1B ;IF "CALL", THEN SUBR ATOM NAME WILL BE IN B
|
||
TRC B,37 ;LIKELY NOT AN INSTRUCTION IF ALL THE INDIRECT,
|
||
TRCE B,37 ; AND INDEXING BITS ARE ONES
|
||
CAIGE B,(CALL )
|
||
JRST BKTR1
|
||
CAIG B,(JCALLF 17,)
|
||
JRST BK1A1
|
||
CAIE B,(XCT) ;MIGHT BE A XCT OF A CALL, JRST, PUSHJ TO SUBR
|
||
JRST .+3
|
||
HRRZ A,-1(A) ;IF SO, CYCLE TO TRY TO FIND CALLED SUBR NAME
|
||
AOJA A,BK1A4
|
||
MOVEI R,ERRADR ;HA! MAYBE PUSHJ OR JRST, SO NOW WE HAVE
|
||
CAIN B,(JRST 0,) ; ONLY BEGINNING ADDRESS OF SUBR. HENCE
|
||
JRST BK1A1 ; IT HAS TO BE DECODED INTO ATOM NAME.
|
||
CAIE B,(PUSHJ P,)
|
||
JRST BKTR1 ;LOSE, DON'T KNOW WHAT KIND OF INST THIS IS
|
||
HLLZ B,@BKTRP
|
||
TLNN B,10000 ;USER MODE FLAG - STOPS RANDOM
|
||
JRST BKTR1 ; DATA NOT ENTERED BY PUSHJ
|
||
|
||
BK1A1: MOVE B,-1(A) ;EITHER "(J)CALL(F)", "JRST", OR "PUSHJ P,"
|
||
TLNE B,7777760 ;LET INDIRECTION HAPPEN, BUT CAN'T CHANCE
|
||
TLNE B,((17)) ; DOING IT IF THE UUO IS INDEXED, OR
|
||
JRST BK1A1B ; ADDRESSES AN AC
|
||
MOVEI B,@-1(A) ;LET INDIRECT DO ITS THING
|
||
BK1A1C: PUSH P,AR1 ;ORIGINAL PC WHEREFROM SUBR WAS CALLED
|
||
SKIPGE BACTYF
|
||
JRST BK1A3
|
||
PUSHJ P,(R) ;R HAS EITHER PRIN1B OR ERRADR
|
||
STRT [SIXBIT \_!\] ; DEPENDING ON WHETHER "CALL" OR "PUSHJ P,"
|
||
POP P,B
|
||
PUSHJ P,ERRADR
|
||
STRT [SIXBIT \ !\]
|
||
JRST BKTR1
|
||
|
||
BK1A3: CAIE R,ERRADR
|
||
SKIPA A,B
|
||
PUSHJ P,ERRDCD ;"ERRDCD" DECODES ADDRESS IN B, GETS ATOM IN A
|
||
EXCH A,(P)
|
||
PUSHJ P,ERRDCD
|
||
PUSH P,[QLA]
|
||
PUSH P,A
|
||
MOVNI T,3
|
||
JRST BKT1F2
|
||
|
||
BK1A1B: CAIN R,ERRADR
|
||
TDZA B,B
|
||
MOVEI B,QM
|
||
JRST BK1A1C
|
||
|
||
BKTR1B: MOVE D,BKTRP
|
||
HRRZ B,-1(D) ;PROBABLY FOR ENTRY TO SOME SUBR, LSUBR, OR EXPR
|
||
CAIE B,ELSB1 ;LISTING TINGS UP ON THE PDL
|
||
CAIN B,ESB1
|
||
JRST .+3
|
||
CAIE B,IAPPLY
|
||
JRST BKTR1
|
||
HLRE B,-1(D)
|
||
ADDI B,-3(D)
|
||
HLRZ A,(B)
|
||
JUMPE A,BKTR1
|
||
HRRZM B,BKTRP
|
||
SKIPGE BACTYF
|
||
JRST BKT1B1
|
||
STRT [SIXBIT \(!\]
|
||
PUSHJ P,PRIN1
|
||
STRT [SIXBIT \ EVALARGS) !\]
|
||
JRST BKTR1
|
||
|
||
BKTR1C: HLRZ A,@BKTRP ;PROBABLY ENTERED AN F-TYPE FUNCTION
|
||
JUMPE A,BKTR1 ;WELL, NIL ISN'T REALLY A FUNCTION
|
||
BKTR1F: SKIPGE BACTYF
|
||
JRST BKT1F1
|
||
PUSHJ P,PRIN1
|
||
STRT [SIXBIT \_ !\]
|
||
JRST BKTR1
|
||
|
||
BKT1B1: SKIPA B,[QEVALARGS]
|
||
BKT1F1: MOVEI B,QLA
|
||
PUSH P,A
|
||
PUSH P,B
|
||
MOVNI T,2
|
||
BKT1F2: PUSHJ FXP,LISTX
|
||
PUSHJ P,NCONS
|
||
HLRZ B,(P)
|
||
HRRM A,(B) ;NCONC MOST RECENT GOODIE ONTO END OF LIST
|
||
HRLM A,(P) ;UPDATE LAST-OF-LIST POINTER
|
||
JRST BKTR1
|
||
|
||
BKTR1H: MOVNI T,LERSTP+5-1 ;2 FROM BREAK, 2 FROM EDERRL, 1 FROM BRLP = 5
|
||
MOVEI A,QBREAK ;-1 SINCE BKTR1 WILL TAKE OFF ONE MORE
|
||
JRST BKTR1D
|
||
BKTR1E: MOVNI T,LPRP ;BACK UP OFF A PROG
|
||
MOVEI A,QPROG
|
||
BKTR1D: ADDM T,BKTRP
|
||
JRST BKTR1I
|
||
|
||
BKTR1G: MOVEI A,QCOND ;FOUND A COND ENTRY
|
||
BKTR1I: SKIPE CPJSW
|
||
JRST BKTR1 ;IF *RSET WAS ON, ENTRY IS BE MARKED BY CPOPJ
|
||
JRST BKTR1F
|
||
|
||
BKTRR3: SKIPA T,XC-3
|
||
BKTRR5: MOVNI T,5
|
||
ADDM T,BKTRP
|
||
JRST BKTR1
|
||
|
||
|
||
PGTOP PRT,[PRINT,TYO,EXPLODE,FLATC,BAKTRACE,ETC]
|