;;; -*- Mode:MIDAS -*- 

TITLE	PR FANCY FILE PRINTER

;Written by ... JMB 8/23/76
;LSC feature changed since DM gone now ... CSTACY 1/30/84
;LSC feature updated again since KL-MC about to die -- Zvona 5/12/86

;Has special print modes depending upon JNAME:
;	:DOC {:CALL :UUO :USET :SUSET :TTYVAR :INTRUP} <descriptor>
;	:LSC gets you the current LSC movie schedule
;	:PRIM ==> PRINT TO IMLAC
;	:TVDOC ==> TRIVIA DOCUMENTATION
;See  .INFO.;PR INFO  FOR COMPLETE DETAILS


.MLLIT==1

	;ACCUMULATOR DEFINITIONS

N=0				;NUMBER OF OUTPUT CHARACTERS
A=1
B=2
C=3
D=4
E=5
CC=6				;CHARACTER COUNT FOR INDEX MAKING
PSBP=7				;PAGE STRING BP
PSNUM=10			;STRING LENGTH
P=11				;STACK POINTER
SWTCHS=12			;CONTAINS ALL SWITCHES
DES=13				;DESCRIPTOR NAME
MSK=14				;MASK FOR DESCRIPTOR MATCHING
OBP=15				;OUTPUT BYTE POINTER
IBP=16				;INPUT BYTE POINTER
Z=17				;RETURN ADDRESS FOR JSP


	;SWITCH DEFINITIONS

AS==1				;DON'T PRINT CONTROL-ATSIGNS
CS==4				;STOP AT FIRST ^C (DEFAULTS ON)
DS==10				;NEXT NAME IS DESCRIPTOR
FS==40				;OUTPUT FILE IN USE
IS==400				;OUTPUT IN IMAGE MODE TO TTY
LS==4000			;LIST DOCUMENTATION DIRECTORY
PS==100000			;PAGE AT ^L OR ^_


	;DEVICE DEFINITIONS

TTYI==0
TTYO==1				;OUTPUT FILE, NOT NECESSARILY A TTY
DSKBI==2
DSKIO==3


	;INSTRUCTION DEFINITIONS

ERROR==JRST


	LOC	42

	JSR	TSINT


	LOC	100


	;RANDOM LOCATIONS

JCL:	BLOCK	16
FN1:	0			;FIRST NAME FLAG
FN2:	0			;SECOND NAME FLAG
NAME:	0			;SLOT TO BUILD A NAME IN
JNAM:	0			;JOB NAME
DEVICE:	0			;INPUT FILE NAMES,
SNAME:	0			;DEFAULTS FROM DDT OR OUTPUT FILE NAMES
FNAME1:	0
FNAME2:	0
ONAME1:	0			;OUTPUT FILE NAMES,
ONAME2:	0			;DEFAULTS FROM DDT
ODEVIC:	0
OSNAME:	0
XFNAME:	0
YFNAME:	0
IXNAME:	0
CHARS:	0
TSROL:	0			;SCROLL MODE?
TYP:	0			;DESCRIPTOR TYPE
GETDES:	0			;DESCRIPTOR SEARCH LOOP?
NEWDES:	0			;SEARCHING FOR NEW DESCRIPTOR?
BUFLEN==1000
BFR:	BLOCK	BUFLEN
ENDBFR:	10700,,BFR+BUFLEN-1	;END OF INPUT BUFFER
OBUFLN==100
OBUF:	BLOCK	OBUFLN
PDL:	BLOCK	20

	;INITIAL SETUP

START:	MOVEI	P,PDL		;SET UP PDL
 	.OPEN	TTYO,[.UAO,,'TTY]
	.LOSE	1000
	.OPEN	TTYI,[.UAI,,'TTY]
	.LOSE	1000
	.SUSET	[.SIMSK2,,[3]]	;ENABLE TTY INTERRUPTS
	.CALL	TTYSET	    	;SET UP TTY TO TAKE CONTROL-S
	.LOSE	1000
	.CALL	TTYGET		;CHECK FOR SCROLLAGE
	.LOSE	1000
	TLNE	A,%TSROL
	SETOM	TSROL

	MOVE	IBP,ENDBFR
	MOVE	OBP,[440700,,OBUF]
	SETZ	N,
	MOVEI	SWTCHS,CS	;C SWITCH STARTS SET (STOP AT ^C)
	.SUSET	[.RXJNAME,,JNAM]	;GET JOB NAME
	MOVE	A,JNAM
	CAME	A,[SIXBIT /CALL/]	;SPECIAL FORMS OF DOC
	CAMN	A,[SIXBIT /.CALL/]
	JRST	DOCTYP
	CAME	A,[SIXBIT /UUO/]
	CAMN	A,[SIXBIT /USET/]
	JRST	DOCTYP
	CAME	A,[SIXBIT /TVDOCT/]
	CAMN	A,[SIXBIT /TVDOC/]
	JRST	DOCTYP
	CAME	A,[SIXBIT /MUD/]
	CAMN	A,[SIXBIT /MUDDLE/]
	JRST	DOCTYP
	CAME	A,[SIXBIT /SUSET/]
	CAMN	A,[SIXBIT /TTYVAR/]
	JRST	DOCTYP
	CAMN	A,[SIXBIT /INTRUP/]
	JRST	DOCTYP
	CAMN	A,[SIXBIT /PRIM/]
	JRST	PRIM
	CAMN	A,[SIXBIT /LSC/]	;IF LSC, GO TO SPECIAL ROUTINE
	JRST	LSC
;	CAMN	A,[SIXBIT /NLSC/]	;IF NLSC, GO TO SPECIAL ROUTINE
;	JRST	NLSC
	JRST	GETJCL

PRIM:	.CALL	CNSGET
	.LOSE	1000
	TLNN	A,%TOIML
	JRST	FINIS
	XORI	SWTCHS,IS
	.CALL	SCPOS
	.LOSE	1000
	JRST	GETJCL

DOCTYP:	MOVEM	A,TYP			;SAVE DOC TYPE FOR LATER REFERENCE
	MOVE	A,[SIXBIT /DOC/]
	MOVEM	A,JNAM

GETJCL:	.BREAK	12,[5,,JCL]	;GET JCL LINE
	MOVE	D,[440700,,JCL]	;GET BP TO JCL
	MOVE	E,TYP
	CAME	E,[SIXBIT /TVDOC/]
	.BREAK	12,[6,,DEVICE]	;SET UP DEFAULTS FROM DDT
	MOVE	A,FNAME1
	MOVEM	A,XFNAME
	MOVE	B,FNAME2
	MOVEM	B,YFNAME
	
 
	;JCL PARSER

LOOP:	SETZM	NAME
	MOVE	C,[440600,,NAME];CLEAR NAME SLOT
GETCHR:	CAIE	B,^X		;CATCH LEFTOVER ^X OR ^Y
	CAIN	B,^Y
	JRST	FIELD
	ILDB	B,D
	JUMPE	B,FOPEN
	CAIE	B,40
	CAIN	B,11
	JRST	GETCHR
FIELD:	CAIE	B,40		;HERE TO GET A NAME
	CAIN	B,11
	JRST	FNAM		;SPACE AND TAB MAKE FNAME1 AND 2
	CAIE	B,0
	CAIN	B,15
	JRST	FNAM		;SO DOES 0 AND <CR>
	CAIN	B,":
	JRST	DEV
	CAIN	B,";
	JRST	DIR
	CAIN	B,"_
	JRST	OFILE
	CAIN	B,"/
	JRST	SWITCH
	CAIE	B,^X		;TRAP ^X AND ^Y CROCKS
	CAIN	B,^Y
	JRST	XYNAME
	CAIN	B,^Q		;HANDLE QUOTING
	ILDB	B,D
	CAIGE	B,40		;SUBI B,40 < 0 (BAD CHARACTER)
	ERROR	ILLCHR
	SUBI	B,40
	CAIL	B,100
	SUBI	B,40		;CASE CONVERSION
	TLNE	C,770000	;IGNORE MORE THAN 6 CHARACTERS,
	JRST	NXTCHR-1
	MOVE	A,JNAM
	TRNN	SWTCHS,DS	;UNLESS D SWITCH IS SET,
	CAMN	A,[SIXBIT /DOC/]	;OR JNAME IS DOC,
	CAIA
	JRST	NXTCHR
	LDB	E,[360600,,NAME]
	CAIE	E,'.		;AND FIRST CHAR IN NAME WAS "."
	JRST	NXTCHR
	MOVE	E,NAME		;IF ALL THAT WAS TRUE, FLUSH "." & ADD NEW CHAR
	LSH	E,6
	MOVEM	E,NAME
	DPB	B,C
	SKIPA
	IDPB	B,C
NXTCHR:	ILDB	B,D
	JRST	FIELD


	;FILE NAME STORERS

DEV:	MOVE	A,NAME
	MOVEM	A,DEVICE
	JRST	LOOP

DIR:	MOVE	A,NAME
	MOVEM	A,SNAME
	JRST	LOOP

FNAM:	TRNE	SWTCHS,DS
	JRST	DESNAM
	MOVE	A,NAME
	JUMPE	A,LOOP
	SKIPN	FN1
	JRST	FNAM1
	SETOM	FN2
	MOVEM	A,FNAME2
	JRST	LOOP

FNAM1:	MOVEM	A,FNAME1
	SETOM	FN1
	JRST	LOOP

DESNAM:	MOVE	DES,NAME
	TRZ	SWTCHS,DS
	JRST	LOOP

OFILE:	MOVE	B,DEVICE	;TRANSFER CURRENT NAMES TO OUTPUT FILE NAME SLOTS
	MOVEM	B,ODEVIC
	MOVE	B,SNAME
	MOVEM	B,OSNAME
	MOVE	B,FNAME1
	MOVEM	B,ONAME1
	MOVE	B,FNAME2
	MOVEM	B,ONAME2
	.BREAK	12,[6,,DEVICE]	;RESET DEFAULTS FROM DDT
	MOVE	A,FNAME1
	MOVEM	A,XFNAME
	MOVE	B,FNAME2
	MOVEM	B,YFNAME
	SETZM	FN2
	MOVE	A,NAME
	TRNN	SWTCHS,DS
	JRST	.+3
	SETZM	FN1
	JRST	DESNAM
	SKIPE	FN1
	JRST	.+4
	JUMPE	A,LOOP
	MOVEM	A,ONAME1
	JRST	LOOP
	SETZM	FN1
	JUMPE	A,LOOP
	MOVEM	A,ONAME2
	JRST	LOOP


	;HANDLERS FOR SPECIAL JCL COMMANDS

SWITCH:	ILDB	B,D
	CAIE	B,"C
	CAIN	B,"c
	JRST	CSWI
	CAIE	B,"P
	CAIN	B,"p
	JRST	PSWI
	CAIE	B,"A
	CAIN	B,"a
	JRST	ASWI
	CAIE	B,"L
	CAIN	B,"l
	JRST	LSWI
	CAIE	B,"D
	CAIN	B,"d
	JRST	DSWI
	CAIE	B,"I
	CAIN	B,"i
	JRST	ISWI
	JRST	ILLSWI
CSWI:	XORI	SWTCHS,CS	;COMPLEMENT APPROPRIATE BIT
	JRST	NXTCHR
PSWI:	XORI	SWTCHS,PS
	JRST	NXTCHR
ASWI:	XORI	SWTCHS,AS
	JRST	NXTCHR
LSWI:	XORI	SWTCHS,LS
	JRST	NXTCHR
DSWI:	TRO	SWTCHS,DS
	SKIPE	NAME
	JRST	FNAM+2
	JRST	NXTCHR
ISWI:	XORI	SWTCHS,IS
	JRST	NXTCHR

XYNAME:	SKIPE	NAME		;CAUSE BREAK IF NAME AROUND
	JRST	FNAM
	MOVE	A,XFNAME
	CAIE	B,^X
	MOVE	A,YFNAME
	MOVEM	A,NAME
	MOVEI	B,40
	JRST	FNAM


	;DISK AND TTY OPENS

LSC:	.CALL	LSCOPN		;Get channel to LSC movies file
	ERROR	NOLSC
	JRST	PLOOP		;Print the file until ^C seen.

;NLSC:	.CALL	NLSCOP		;GET CHANNEL TO LSC MOVIES FILE
;	ERROR	MVELST
;	JRST	NLSCRD

FOPEN:	MOVE	A,JNAM
	CAME	A,[SIXBIT /DOC/]
	JRST	FOPEN1
	SKIPN	TYP		;IF DOC TYPE COMES FROM JNAME, DO FIXUPS
	JRST	FOPEN2
	SKIPE	FN1
	MOVE	DES,FNAME1
	JRST	FOPEN3
FOPEN2:	SKIPN	FN1		;IF NO TYPE NAME, GIVE POSSIBILITIES
	ERROR	DLIST
	MOVE	A,FNAME1
	MOVEM	A,TYP
	SKIPE	FN2
	MOVE	DES,FNAME2
FOPEN3:	SKIPN	DES		;IF NO DESCRIPTOR, LIST DIRECTORY
	IORI	SWTCHS,LS
	MOVE	A,[SIXBIT /DSK/]
	MOVEM	A,DEVICE
	MOVE	B,TYP
	CAME	B,[SIXBIT /MUD/]
	CAMN	B,[SIXBIT /MUDDLE/]
	CAIA
	JRST	DITS
	MOVE	A,[SIXBIT /MUDMAN/]
	MOVEM	A,SNAME
	MOVE	A,[SIXBIT /MUDDLE/]
	MOVEM	A,FNAME1
	MOVE	A,[SIXBIT /ORDER/]
	JRST	FOPEN0
DITS:	MOVE	A,[SIXBIT /.INFO./]
	MOVEM	A,SNAME
	MOVE	A,[SIXBIT /ITS/]
	MOVEM	A,FNAME1
	CAME	B,[SIXBIT /CALL/]
	CAMN	B,[SIXBIT /.CALL/]
	JRST	[MOVE	A,[SIXBIT /.CALLS/]
		 JRST	FOPEN0]
	CAMN	B,[SIXBIT /UUO/]
	JRST	[MOVE	A,[SIXBIT /UUOS/]
		 JRST	FOPEN0]
	CAME	B,[SIXBIT /SUSET/]
	CAMN	B,[SIXBIT /USET/]
	JRST	[MOVE	A,[SIXBIT /USETS/]
		 JRST	FOPEN0]
	CAMN	B,[SIXBIT /TTYVAR/]
	JRST	[MOVE	A,B
		JRST FOPEN0]
	CAMN	B,[SIXBIT /INTRUP/]
	JRST	[MOVE	A,[SIXBIT /%PI/]
		 JRST	FOPEN0]
	CAME	B,[SIXBIT /TVDOCT/]
	CAMN	B,[SIXBIT /TVDOC/]
	JRST	[MOVE A,TYP
		 JRST	FOPEN0]
	ERROR	BADTYP
FOPEN0:	MOVEM	A,FNAME2
	JUMPE	B,FOPEN1
	TRZ	A,7777
	IOR	A,[SIXBIT /    IX/]
	MOVEM	A,IXNAME

FOPEN1:	.CALL	DSKOPN		;DO ALL OF THE NORMAL OPENS
	ERROR	ILFILE
	SKIPN	ODEVIC		;IF OUTPUT FILE GIVEN,
	JRST	FOPEN4
	.CALL	OFOPEN		;OPEN IT AS "TTYO",
	.LOSE	1000
	TRZ	SWTCHS,PS	;TURN OFF PAGING,
	TRO	SWTCHS,FS	;AND TURN ON F SWITCH
FOPEN4:	JUMPN	B,DOCRD

	TRNE	SWTCHS,IS	;IF I SWITCH IS SET,
	JRST	ILOOP		;DO SUPERIMAGE OUTPUT
	SKIPE	ODEVIC		;IF OUTPUT FILE GIVEN,
	TRO	SWTCHS,IS	;TURN ON IMAGING (JUST TO FOOL MOREAGE)
	TRNE	SWTCHS,PS	;IF P SWITCH IS SET,
	SKIPE	TSROL		;AND NOT SCROLLING,
	JRST	PLOOP0
	MOVEI	PSNUM,2		;CLEAR PAGE BEFORE STARTING
	MOVE	PSBP,[440700,,[ASCII /C/]]
	.CALL	PBLOCK
	.LOSE	1000
	JRST	PLOOP


	;READ AND PRINT LOOPS FOR VARIOUS MODES

PLOOP0:	TRNN	SWTCHS,FS
	.IOT	TTYO,[^J]
PLOOP:	JSP	Z,CIN		;HERE TO PRINT FILE
	JRST	CFINIS
	CAIE	A,^C
	JRST	.+3
	TRNE	SWTCHS,CS	;STOP IF ^C AND C SWITCH IS SET
	JRST	CFINIS
	TRNN	SWTCHS,PS	;SKIP THIS SECTION IF P SWITCH NOT SET
	JRST	.+4
	CAIE	A,^L
	CAIN	A,^_
	JRST	PAGE
	CAIN	A,^@		;DON'T PRINT ^@ IF A SWITCH SET
	TRNN	SWTCHS,AS
	JSP	Z,COUT
	JRST	PLOOP

ILOOP:	SETZ	B,
ILOOP1:	JSP	Z,CIN		;HERE TO PRINT FILE IN SUPERIMAGE MODE
	JRST	FINIS
	CAIN	A,^C
	AOJA	B,ILOOP1
	JUMPE	B,ILOOP3
	MOVE	C,A
	MOVEI	A,^C
ILOOP2:	.CALL	IMGIOT
	.LOSE	1000
	SOJN	B,ILOOP2
	MOVE	A,C
ILOOP3:	.CALL	IMGIOT		;OUTPUT CHAR
	.LOSE	1000
	JRST	ILOOP1

;LSCRD:	JSP	Z,CIN		;READ UNTIL ^@
;	ERROR	MVELST
;	JUMPN	A,LSCRD
;PRLOOP:	JSP	Z,CIN		;READ & PRINT UNTIL NEXT ^@
;	JRST	CFINIS
;	JUMPE	A,CFINIS
;	JSP	Z,COUT
;	JRST	PRLOOP
;
;NLSCRD:	JSP	Z,CIN		;READ UNTIL "
;	ERROR	MVELST
;	CAIE	A,""
;	JRST	NLSCRD
;	MOVEI	PSNUM,2		;CLEAR PAGE BEFORE STARTING
;	MOVE	PSBP,[440700,,[ASCII /C/]]
;	.CALL	PBLOCK
;	.LOSE	1000
;NPLOOP:	JSP	Z,CIN		;READ & PRINT UNTIL NEXT "
;	JRST	CFINIS
;	CAIN	A,""
;	JRST	NMDONE
;	CAIE	A,"\		;HANDLE QUOTING
;	JRST	.+3
;	JSP	Z,CIN
;	JRST	CFINIS
;	JSP	Z,COUT
;	JRST	NPLOOP
;NMDONE:	JSP	Z,CIN		;LOOK FOR A (
;	JRST	CFINIS
;	CAIE	A,"(
;	JRST	NMDONE
;NMDON1:	JSP	Z,CIN		;NOW GET A "
;	JRST	CFINIS
;	CAIE	A,""
;	JRST	NMDON1
;	JSP	Z,OBCLR
;	PUSHJ	P,MORE		;DO MOREAGE
;	JRST	NPLOOP		;NOW PRINT THIS MESSAGE

DOCRD:	LDB	A,[360600,,DES];FLUSH LEADING DOTS IN DESCRIPTOR
	CAIE	A,'.
	JRST	.+3
	LSH	DES,6
	JRST	DOCRD
	TRNE	SWTCHS,LS
	JRST	DOCRD1
	MOVEI	A,DSKBI
	.CALL	RFDATE
	ERROR	RFDLST
	MOVE	D,B
	MOVEI	A,.UII
	.CALL	IDXOPN
	JRST	MAKIDX
	MOVEI	A,DSKIO
	.CALL	RFDATE
	ERROR	RFDLST
	CAME	B,D
	JRST [	.CALL [	SETZ
			SIXBIT	/DELEWO/
			SETZI	DSKIO]
		.LOSE	1000
		JRST	MAKIDX]
	MOVE	A,DES		;SET UP MASK FOR DESCRIPTOR COMPARISON
	MOVEI	B,[	0
			770000,,0
			777700,,0
			-1,,0
			-1,,770000
			-1,,777700
			-1]
MLOOP:	ANDCM	A,(B)
	SKIPE	A
	AOJA	B,MLOOP
	MOVE	MSK,(B)
	SETOM	GETDES
	JRST	GETDOC
MAKIDX:	MOVEI	PSNUM,46.
	MOVE	PSBP,[440700,,[ASCII /New documentation file, must index, hang on.../]]
	.CALL	PBLOCK
	.LOSE	1000
	MOVEI	A,.UIO
	.CALL	IDXOPN
	ERROR	IDOLST
	JRST	DOCRD1		;FIRST PAGE DOESN'T HAVE TO START WITH ^L
DOCRD0:	JSP	Z,CIN		;READ UNTIL ^L OR ^_
	JRST	DOCEND
	CAIE	A,^L
	CAIN	A,^_
	JRST	DOCRD1
	JRST	DOCRD0
DOCRD1:	SETZ	E,		;USE E TO KEEP TRACK OF LEADING DOTS
	JSP	Z,CIN		;READ UNTIL A LETTER/NUMBER IS FOUND
	JRST	DOCEND
	CAIE	A,".
	JRST	.+3
	MOVE	E,A
	JRST	DOCRD1+1
	CAIG	A,40
	JRST	DOCRD1
	MOVE	B,[440600,,C]
	SETZ	C,
	MOVEM	CC,CHARS
	SOS	CHARS
GNLOOP:	SUBI	A,40		;GET DESCRIPTOR NAME ON THIS PAGE
	IDPB	A,B
	JSP	Z,CIN
	JRST	DOCEND
	CAIE	A,"*		;THESE SPECIAL CHARACTERS MAY BE PART OF A NAME
	CAIN	A,"+
	JRST	GDCHAR
	CAIE	A,"-
	CAIN	A,"/
	JRST	GDCHAR
	CAIE	A,"=
	CAIN	A,"?
	JRST	GDCHAR
	CAIL	A,"0		;NON-LETTER/NUMBER SIGNALS END OF NAME
	CAILE	A,"Z
	JRST	DOCRD2
	CAILE	A,"9
	CAIL	A,"A
	SKIPA
	JRST	DOCRD2
GDCHAR:	TLNE	B,770000	;IGNORE MORE THAN SIX CHARACTERS
	JRST	GNLOOP
DOCRD2:	TRNN	SWTCHS,LS	;IF L SWITCH SET, LIST NAMES AS PASSED
	JRST	INDEX
	SKIPE	E		;PRINT DOT IF THERE WAS ONE BEFORE NAME
	.IOT	TTYO,E
	JSP	Z,OSIX		;PRINT DESCRIPTOR NAME
DOCRD3:	.IOT	TTYO,A		;PRINT REST OF LINE
	CAIN	A,^J
	JRST	DOCRD0
	JSP	Z,CIN
	JRST	DOCEND
	JRST	DOCRD3
DOCEND:	TRNE	SWTCHS,LS	;IF IN LIST MODE, END AT EOF
	JRST	FINIS
	.IOT	DSKIO,[0]
	.CALL	SFDATE
	ERROR	SFDLST
	.CLOSE	DSKIO,
	MOVE	IBP,[10700,,BFR+BUFLEN-1]
	MOVEM	IBP,ENDBFR
	JRST	FOPEN1
INDEX:	.IOT	DSKIO,C		;WRITE OUT DESCRIPTOR NAME
	SKIPE	E		;IF THERE WAS A DOT,
	SOS	CHARS		;	ALLOW SPACE FOR IT
	.IOT	DSKIO,CHARS	;WRITE OUT POSITION
	JRST	DOCRD0

DESCMP:	.IOT	DSKIO,C
GETDOC:	.IOT	DSKIO,C
	SKIPN	C
	JRST [	SKIPN	NEWDES
		ERROR	DOCLST
		JRST	FINIS]
	AND	C,MSK		;FLUSH UNWANTED PART
	CAME	C,DES		;SEE IF THIS IS DESIRED DESCRIPTOR
	JRST	DESCMP
	SKIPN	NEWDES
	JRST	PRDOC
	MOVE	IBP,[10700,,BFR+BUFLEN-1]
	MOVEM	IBP,ENDBFR
	PUSHJ	P,MORE
	TRNE	SWTCHS,FS
	.IOT	TTYO,[12.]
	SETZM	NEWDES
PRDOC:	.IOT	DSKIO,C		;YES, CLEAR PAGE & PRINT NAME
	IDIVI	C,5
	.ACCESS	DSKBI,C
 	TRNE	SWTCHS,FS	;IF NOT OUTPUT FILING,
	JRST	SLOOP
	SKIPE	TSROL		;OR SCROLLING,
	JRST	SLOOP-1
	MOVEI	PSNUM,2		;CLEAR SCREEN
	MOVE	PSBP,[440700,,[ASCII /C/]]
	.CALL	PBLOCK
	.LOSE	1000
	JRST	SLOOP
	.IOT	TTYO,[^M]
	.IOT	TTYO,[^J]
SLOOP:	JUMPE	D,CPLOOP
	JSP	Z,CIN
	ERROR	FILLST
	SOJA	D,SLOOP
CPLOOP:	JSP	Z,CIN		;READ & PRINT UNTIL NEXT ^L OR ^_ OR EOF
	JRST	CFINIS
	CAIE	A,^L
	CAIN	A,^_
	JRST	NXTDES
	CAIN	A,^C
	TRNN	SWTCHS,CS
	CAIA
	JRST	NXTDES
	JSP	Z,COUT
	JRST	CPLOOP

NXTDES:	JSP	Z,OBCLR
	SETOM	NEWDES
	JRST	GETDOC


	;PAGER FOR READING PAGED FILES (^L OR ^_) WITH P SWITCH SET; MORE HANDLER

PAGE:	JSP	Z,OBCLR
	SETZ	B,		;B USED FOR SPACE COUNTER
	JSP	Z,CIN
	JRST	FINIS		;DON'T PAGE IF AT END OF FILE
	CAIE	A,^C
	JRST	.+3
	TRNE	SWTCHS,CS
	JRST	FINIS
	CAIE	A,^M		;FLUSH TRAILING CARRIAGE-RETURNS & LINE-FEEDS
	CAIN	A,^J
	JRST	PAGE
	CAIN	A,40
	AOJA	B,PAGE+1
	PUSHJ	P,MORE
	JUMPE	B,PAGEND
	MOVEI	C,40
	.IOT	TTYO,C		;PRINT SPACES, IF ANY
	SOJG	B,.-1
PAGEND:	.IOT	TTYO,A
	JRST	PLOOP

MORE:	TRNE	SWTCHS,IS+FS	;IF I SWITCH OR F SWITCH IS ON,
	POPJ	P,		;DO NOTHING
	PUSH	P,PSNUM
	PUSH	P,PSBP
	PUSH	P,A
	SKIPE	NEWDES
	JRST [	MOVEI	PSNUM,14.
		MOVE	PSBP,[440700,,[ASCII /--Next Match--/]]
		JRST	DMORE]
	MOVEI	PSNUM,8.
	MOVE	PSBP,[440700,,[ASCII /--More--/]]
DMORE:	.CALL	PBLOCK		;PAGER USING ^P HACKERY
	.LOSE	1000
	.LISTEN	A,
	.CALL	PEEK
	.LOSE	1000
	CAIN	A,40
	JRST	MORE1
	CAIE	A,177
	CAIN	A,^S
	CAIA
	JRST	MORE2
	.CALL	TYI
	.LOSE	1000
MORE2:	MOVEI	PSNUM,7
	MOVE	PSBP,[440700,,[ASCII /Flushed/]]
	.CALL	PBLOCK
	.LOSE	1000
	SKIPE	GETDES
	CAIE	A,177
	JRST	FINIS
	SKIPE	NEWDES
	JRST	FINIS
	MOVEI	A,NXTDES
	MOVEM	A,TSINT+1
	MOVE	OBP,[440700,,OBUF]
	SETZ	N,
	JRST	MPOPS

MORE1:	.CALL	TYI
	.LOSE	1000
	MOVEI	PSNUM,4
	MOVE	PSBP,[440700,,[ASCII /TL/]]
	SKIPN	TSROL
	JRST	.+3
	MOVEI	PSNUM,2
	MOVE	PSBP,[440700,,[ASCII /
/]]
	.CALL	PBLOCK
	.LOSE	1000
MPOPS:	POP	P,A
	POP	P,PSBP
	POP	P,PSNUM
	POPJ	P,


	;ERROR MESSAGE PRINTER (WORD POINTER IN C)

ERRPRT:	MOVEI	PSNUM,2
	MOVE	PSBP,[440700,,[ASCII /A/]]
	.CALL	PBLOCK
	.LOSE	1000
	HRLI	C,440700
ERLOOP:	ILDB	B,C
	JUMPE	B,ERRDON
	.IOT	TTYO,B
	JRST	ERLOOP
ERRDON:	.IOT	TTYO,[^M]
	.IOT	TTYO,[^J]
	JRST	FINIS


	;SIXBIT OUTPUT ROUTINE (PUT WORD IN C, USES B & D)

OSIX:	MOVE	B,[440600,,C]
OLOOP:	ILDB	D,B
	JUMPE	D,(Z)
	ADDI	D,40
	.IOT	TTYO,D
	TLNE	B,770000
	JRST	OLOOP
	JRST	(Z)


	;IOT SIMULATOR FOR READING FROM DISK FILE

CIN:	CAMN	IBP,ENDBFR
	JRST	CIN1
	ILDB	A,IBP
	AOJ	CC,		;INCREMENT CHARACTER COUNT
	JRST	1(Z)		;NORMAL RETURN
CIN1:	MOVE	A,ENDBFR
	CAME	A,[10700,,BFR+BUFLEN-1]
	JRST	(Z)		;EOF RETURN
	MOVE	A,[-BUFLEN,,BFR]
	.IOT	DSKBI,A
	MOVE	IBP,[10700,,BFR-1]
	SKIPL	A
	JRST	CIN
	SOJ	A,
	HRRM	A,ENDBFR
	JRST	CIN


	;IOT SIMULATOR FOR WRITING TO TTY & REAL STRING OUTPUTER

COUT:	IDPB	A,OBP
	AOJ	N,
	CAIE	N,OBUFLN*5
	JRST	(Z)
OBCLR:	JUMPE	N,(Z)
	MOVE	OBP,[440700,,OBUF]
	.CALL [	SETZ
		SIXBIT	/SIOT/
		1000,,TTYO
		OBP
		SETZ	N]
	.LOSE	1000
	MOVE	OBP,[440700,,OBUF]
	JRST	(Z)


	;INTERRUPT HANDLER

TSINT:	0
	0
	PUSH	P,A
	MOVE	A,TSINT
NXTINT:	TRZE	A,2
	PUSHJ	P,MORE
	TRZE	A,1
	JRST	TYIINT
INTRET:	POP	P,A
	.DISMIS	TSINT+1
TYIINT:	MOVEI	A,TTYI
	.ITYIC	A,
	JRST	INTRET		;IGNORE FALSE CHAR INTERRUPTS
	.RESET	TTYO,		;FLUSH OUTPUT
	.RESET	TTYI,		;AND INPUT
	.IOT	TTYO,A
	JRST	FINIS


	;VARIOUS CALL BLOCKS

DSKOPN:	SETZ
	SIXBIT	/OPEN/
	5000,,.BAI
	1000,,DSKBI
	DEVICE
	FNAME1
	FNAME2
	SETZ	SNAME

IDXOPN:	SETZ
	SIXBIT	/OPEN/
	4000,,A
	1000,,DSKIO
	DEVICE
	FNAME1
	IXNAME
	SETZ	SNAME

OFOPEN:	SETZ
	SIXBIT	/OPEN/
	5000,,.UAO
	1000,,TTYO
	ODEVIC
	ONAME1
	ONAME2
	SETZ	OSNAME

RFDATE:	SETZ
	SIXBIT	/RFDATE/
	A
	SETZM	B

SFDATE:	SETZ
	SIXBIT	/SFDATE/
	1000,,DSKIO
	SETZ	D

LSCOPN:	SETZ
	SIXBIT	/OPEN/
	5000,,.BAI
	1000,,DSKBI
	[SIXBIT /KS/]
	[SIXBIT /MOVIES/]
	[SIXBIT /LSC/]
	SETZ	[SIXBIT /COMAIL/]

;NLSCOP:	SETZ
;	SIXBIT	/OPEN/
;	5000,,.BAI
;	1000,,DSKBI
;	[SIXBIT /DM/]
;	[SIXBIT /SPECS/]
;	[SIXBIT /545MVE/]
;	SETZ	[SIXBIT /.BATCH/]

PBLOCK:	SETZ
	SIXBIT	/SIOT/
	5000,,%TJDIS		;ENABLE ^P HACKERY
	1000,,TTYO
	PSBP
	SETZ	PSNUM

IMGIOT:	SETZ
	SIXBIT	/IOT/
	5000,,%TJSIO
	1000,,TTYO
	SETZ	A

TYI:	SETZ
	SIXBIT	/IOT/
	5000,,%TIACT
	1000,,TTYI
	SETZ	A

PEEK:	SETZ
	SIXBIT	/IOT/
	5000,,%TIPEK+%TIACT
	1000,,TTYI
	SETZ	A

TTYSET:	SETZ
	SIXBIT	/TTYSET/
	1000,,TTYI
	[404040,,404040]
	SETZ	[414040,,500040]

TTYGET:	SETZ
	SIXBIT	/TTYGET/
	1000,,TTYI
	2000,,A
	2000,,A
	SETZM	A

CNSGET:	SETZ
	SIXBIT	/CNSGET/
	1000,,TTYI
	2000,,A
	2000,,A
	2000,,A
	2000,,A
	SETZM	A

SCPOS:	SETZ
	SIXBIT	/SCPOS/
	1000,,TTYI
	1000,,0
	SETZI


	;ERROR CRUFTIES

DEFINE DEFERR NAME,STRING
NAME:	MOVEI	C,[ASCIZ/!STRING!/]
	JRST	ERRPRT
TERMIN

	DEFERR	ILLCHR,[Illegal character in JCL]
	DEFERR	ILFILE,[File not found]
	DEFERR	ILLSWI,[Illegal switch]
	DEFERR	MVELST,[Information not currently available]
	DEFERR	NOLSC,[The LSC movie guide seems to be missing.]
	DEFERR	DOCLST,[No such descriptor found in this DOC file]
	DEFERR	DLIST,[Known documentation types: CALL UUO USET SUSET TTYVAR INTRUP MUD(DLE)]
	DEFERR	BADTYP,[Bad DOC type, use DOC^K to list possibilities]
	DEFERR	SFDLST,[Set-file-date CALL lost]
	DEFERR	RFDLST,[Read-file-date CALL lost]
	DEFERR	IDOLST,[Open for output of new index file lost]
	DEFERR	FILLST,[Documentation file or index in bad format]


	;NORMAL EXIT

CFINIS:	JSP	Z,OBCLR
FINIS:	.VALUE	[ASCIZ ":KILLî:VKî"]

	END	START