.TITLE	PAG
	.IDENT	/MRH001/
	.MCALL	FINIT$,FSRSZ$,QIOW$,DIR$,CALL,RETURN
	.MCALL	OPEN$W,OPEN$,OPEN$R,GET$,PUT$,CLOSE$
	.MCALL	CSI$,CSI$1,CSI$2,CSI$SW,GMCR$,EXIT$S,GTIM$
	.MCALL	GCML$,RCML$,GCMLB$,PRINT$,CSI$ND
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A
	.MCALL	FDOP$R,NMBLK$
;+
;
; PAG	PAGINATE LISTING PROGRAM
;
;	PROVIDES LISTINGS OF PROGRAMS ETC ON A PAGINATED BASIS
;	HEADER LINES CONTAIN DEVICE, UIC NAME ETC AND DATE TIME
;
;	LISTING A MAX OF 55 LINES/PAGE SO DONT PRINT OVER FOLD
;
;CALLING SEQUENCE
;
;MCR>PAG[ELIST] DEV:[UIC]NAME.TYPE
;
;		OPTIONAL SWITCH "/TA" PUTS LEADING TAB IN FOR
;		USE WITH LP1 SO CAN PUNCH AND PUT IN RING BINDER
;
;OR
;
;MCR>PAG[ELIST] DEV:[UIC]NAME.TYP=DEV:[UIC]NAME.TYP
;
;IF NO OUTPUT FILE SPEC IS GIVEN, THE OUTPUT DEFAULTS TO:
;
;SY:NAME.LST
;
;AND THE FILE IS AUTOMATICALLY SPOOLED TO LP:
;
;
;FOR OBVIOUS REASONS, NO WILD CARDS ARE SUPPORTED
;
;
;		F. BORGER
;		MICHAEL REESE MEDICAL CENTER
;
;		FEB 27 1980
;
;
; EVF'S AND LUNS
;
OUTLUN	=1	;OUTPUT FILE LUN
OUTEVF	=1	;AND EVF
;
TILUN	=2	;TERMINAL IO LUN
TIEVF	=2	;AND EVF
;
TIFLUN	=3	;TERMINAL "FILE" LUN
TIFEVF	=3	;AND EVF
;
INFLUN	=4	;THE FIRST IN-FILE LUN
INFEVF	=4	;AND EVF

	.SBTTL	MAIN LINE CODE
START:	FINIT$			;SET UP FOR FILE IO FOR FILE I/O
	JSR	PC,.RDFUI	;GET UIC I'M RUNNING UNDER
	MOV	R1,UIC		;SAVE THE UIC (BINARY)
;
	GCML$	#GCBLK		;GET THE COMMAND LINE
	CMPB	#GE.EOF,GCBLK+G.ERR ;END OF FILE ON COMMAND INPUT ?
	BNE	5$		;NO
	EXIT$S			;YES, QUIT
5$:	TSTB	GCBLK+G.ERR	;ANY OTHER ERRORS ?
	BPL	6$		;NO
	DIR$	#ERPRI		;REPORT COMMAND LINE FILE ERROR
	DIR$	#CMDERR
	EXIT$S
6$:	MOV	#1,INPFLG	;SET FLAG THAT INPUT FILE SPEC SEEN
				;FILL IN POINTERS IN CSI BLOCK
	MOV	GCBLK+G.CMLD+2,CSBLK+C.CMLD+2
	MOV	GCBLK+G.CMLD,CSBLK+C.CMLD
	CSI$1	#CSBLK		;AND PARSE IT
	CSI$2	#CSBLK,INPUT,#SWITCH	;TRY FOR AN INPUT SPEC
	BITB	#CS.NMF,C.STAT(R0) ;WAS INPUT SPEC'D
	BNE	7$		;BR IF IT WAS
	CLR	INPFLG		;ELSE CLEAR FLAG THAT SAYS IT WAS
	CSI$2	#CSBLK,OUTPUT	;DEFAULT TO FILE SPEC TO BE SPOOLED
7$:	BITB	#CS.DIF,C.STAT(R0) ;DID THEY SPEC A UIC ?
	BEQ	22$		;NO
	MOV	#CSBLK+C.DIRD,R2 ;YES POINT TO DESCRIPTOR
	MOV	#UIC,R3		;PLACE TO STORE IT
	JSR	PC,.ASCPP	;CONVERT STRING TO OCTAL NUMBER
22$:	BITB	#CS.NMF,C.STAT(R0) ;IS A NAME GIVEN?
	BNE	4$		;YES
	DIR$	#ERPRI
	DIR$	#NAMERR
	EXIT$S
4$:	FDOP$R	#INFDB,,#CSBLK+C.DSDS ;FILL IN FILE NAME TO BE LISTED
	OPEN$R	#INFDB			;AND OPEN IT
	BCC	44$		;BR IF OK
	DIR$	#ERPRI		;ELSE REPORT PROBLEM
	DIR$	#NAMERR
	EXIT$S
44$:					;CHANGE OUTPUT FILE TYPE TO "LST
	MOV	CSBLK+C.DSDS+10,R1	;GET LENGTH OF NAME STRING
	MOV	R1,NAMLEN		;SAVE LENGTH
	MOV	CSBLK+C.DSDS+12,R2	;AND START
441$:	CMPB	(R2)+,#'.		;FOUND THE "." IN THE FILE NAME
	BEQ	442$			;YES
	SOB	R1,441$			;NO, GET ANOTHER
					;HAD TO HAVE . TO OPEN INPUT FILE SO ASSUME OK
442$:	MOVB	#'L,(R2)+		;OVERWRITE "TYP" WITH "LST"
	MOVB	#'S,(R2)+
	MOVB	#'T,(R2)+
	MOV	NAMLEN,R1		;GET LENGTH AGAIN
	MOV	CSBLK+C.DSDS+12,R2	;AND START
	MOV	#NAMSAV,R3		;POINT TO SAVE AREA
444$:	MOVB	(R2)+,(R3)+		;SAVE NAME STRING
	SOB	R1,444$
	TST	INPFLG			;WAS THERE AN INPUT FILE SPEC
	BEQ	333$			;IF NOT, DEFAULT TO NAME.LST
	CSI$2	#CSBLK,OUTPUT		;GET OUTPUT FILE NAME
	BITB	#CS.DIF,C.STAT(R0)	;DID THEY SPEC A UIC ?
	BEQ	222$			;NO
	MOV	#CSBLK+C.DIRD,R2	;YES POINT TO DESCRIPTOR
	MOV	#UIC,R3			;PLACE TO STORE IT
	JSR	PC,.ASCPP		;CONVERT STRING TO OCTAL NUMBER
222$:	BITB	#CS.NMF,C.STAT(R0)	;IS A NAME GIVEN?
	BNE	333$			;BRANCH IF NAME OK
	MOV	NAMLEN,R1		;GET LENGTH AGAIN
	MOV	CSBLK+C.DSDS+12,R2	;POINT TO CSI BLOCK
	MOV	#NAMSAV,R3		;POINT TO SAVE AREA
244$:	MOVB	(R3)+,(R2)+		;RESTORE NAME STRING
	SOB	R1,244$
333$:	FDOP$R	#OUTFDB,,#CSBLK+C.DSDS ;FILL IN FILENAME OF OUTPUT FILE
	OPEN$W	#OUTFDB			;AND OPEN IT
	BCC	2$			;BR IF OPEN WENT
	DIR$	#ERPRI			;TELL HIM FILE PROBLEMS
	DIR$	#FILERR
	JMP	DIE			;AND CLOSE INPUT, THEN EXIT
;

	.SBTTL	TRANSFER TO LISTING FILE
2$:
	DIR$	#GETTIM		;GET DATE AND TIME
	
	MOV	#1,PAGE		;SET PAGE # TO 1
	MOVB	INFDB+F.FNB+N.UNIT,DEVNUM ;FILL IN DEVICE UNIT NUMBER IN BLOCK
REGO:	MOV	#EDBLK,R0	;SET FOR EDMSG
	MOV	#HDRME0,R1	;ADDRESS OF INPUT LINE
	TST	TABFLG		;WANT LEADING TAB ?
	BEQ	11$		;BR IF NOT
	MOV	#HDRMEA,R1	;ELSE CHANGE FORMAT
11$:	MOV	#HDRBF0,R2	;ADDRESS OF BUFFER
	JSR	PC,$EDMSG	;FILL IN NAME
	MOV	#HDRME1,R1	;ADDRESS OF BUFFER
	MOV	#PAGE,R2	;ADDRESS OF BUFFER
	JSR	PC,$EDMSG	;FILL IN PAGE #
	SUB	#EDBLK,R0	;GET LENGTH OF XFER
	MOV	R0,OUTFDB+F.NRBD ;TELL SYS LENGTH
	PUT$	#OUTFDB,#EDBLK	;PUT THE FIRST HEADER LINE
	MOV	#EDBLK,R0	;ADDRESS OF OUTPUT BUFFER
	MOV	#EDMES0,R1	;ADDRESS OF INPUT LINE
	TST	TABFLG		;WANT LEADING TAB ?
	BEQ	12$		;NO
	MOV	#EDMESA,R1	;CHANGE INPUT LINE
12$:	MOV	#EDBUF,R2	;ADDRESS OF DATA BUFFER
	JSR	PC,$EDMSG	;DO DEVICE AND UIC
	MOV	#EDMES1,R1	;POINT TO 2ND DECODE LINE
	MOV	#EDBUF1,R2	;AND 2ND DATA BUFFER
	JSR	PC,$EDMSG	;DO NAME.TYPE;VERSION
	MOV	#EDMES2,R1	;POINT TO LAST DECODE LINE
	MOV	#EDBUF2,R2	;AND LAST DATA BUFFER
	JSR	PC,$EDMSG	;AND DO DATE, TIME, PAGE #
	SUB	#EDBLK,R0	;SUB START OF RESULTANT HEADER LINE
	CLR	R5		;CLEAR LINES/PAGE COUNTER
	MOV	R0,OUTFDB+F.NRBD ;SET LENGTH OF VARIABLE LINE
	PUT$	#OUTFDB,#EDBLK	;PUT OUT VARIABLE HEADER LINE
IN:	GET$	#INFDB,#BUF1,#132.	;GET A RECORD
	CMPB	INFDB+F.ERR,#IE.EOF	;END OF FILE
	BEQ	DONE			;YES
	TST	INFDB+F.ERR		;NO
	BPL	333$			;IF PLUS OK
	DIR$	#ERPRI
	DIR$	#FILERR
	JMP	DONE			;AND EXIT
333$:	MOV	INFDB+F.NRBD,OUTFDB+F.NRBD ;TRANSFER SIZE OF LINE
	ADD	TABFLG,OUTFDB+F.NRBD	;ADJUST FOR LEADING TAB
	TST	TABFLG			;IS THERE LEADING TAB
	BEQ	335$			;NO
	PUT$	#OUTFDB,#BUF0		;YES
	BR	336$
335$:	PUT$	#OUTFDB,#BUF1		;AND PUT THE RECORD
336$:	BCC	334$		;BR IF OK
	DIR$	#ERPRI
	DIR$	#FILERR
	JMP	DONE		;AND EXIT
334$:	INC	R5		;COUNT A LINE
	CMP	R5,#54.		;NEAR END OF PAGE ?
	BLT	IN		;NO, JUST DO NEXT LINE
	CLR	R5		;YES, CLEAR COUNTER
	INC	PAGE		;INC PAGE NUMBER FOR PRINTOUT
	JMP	REGO		;PRINT HEADER LINE AGAIN
DONE:				;NORMAL EXIT
	TST	INPFLG		;SPOOL THE OUTPUT ?
	BNE	1$		;NOT IF TWO FILES WERE SPECIFIED
	PRINT$	#OUTFDB		;SPOOL THE FILE TO LP
	BR	DIE		;AND QUIT
1$:	CLOSE$	#OUTFDB		;CLOSE THE OUTPUT FILE IF NOT SPOOLED
DIE:	CLOSE$	#INFDB		;CLOSE INPUT FILE
	EXIT$S			;AND EXIT

	.SBTTL	FDB'S
	.SBTTL		INPUT FDB
;
;
; THE INPUT FILE
;
INFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILE ATTRIBUTES
	FDRC$A	,BUF1,132.	;RECORD
	FDOP$A	INFLUN		;FILE NAME
	FDBF$A	INFEVF		;EVF
;
;
;
;
	.SBTTL		OUTPUT FDB
;
;
; THE OUTPUT FDB
;
;
OUTFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILE ATTRIBUTES
	FDRC$A	,BUF1,132.	;RECORD
	FDOP$A	OUTLUN		;FILE NAME
	FDBF$A	OUTEVF		;EVF
;
;
	.SBTTL		TERMINAL FDB
;;;;;
;
; THE TERMINAL'S FDB
;
TIFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILES ATTRIBUTES
	FDRC$A	,BUF1,80.	;RECORD
	FDOP$A	TIFLUN,TIDSDS	;FILE NAME
	FDBF$A	TIFEVF		;FILE EVF
;
TIDSDS:	.WORD	LTI,TI
	.WORD	0,0
	.WORD	0,0
;
TI:	.ASCII	/TI:/
LTI=.-TI
	.EVEN

	.SBTTL		ERROR MESSAGES
;
ERPRI:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<PRIMES,PRILEN,44>
PRIMES:	.ASCII	/***PAG---/
PRILEN=.-PRIMES
	.EVEN
NAMERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<NAMMES,NAMLNG,53>
NAMMES:	.ASCII	/BAD FILE NAME***/
NAMLNG=.-NAMMES
	.EVEN
FILERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<FILMES,FILLEN,53>
FILMES:	.ASCII	/ERROR ON FILE IO***/
FILLEN=.-FILMES
	.EVEN
CMDERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<CMDMES,CMDLEN,53>
CMDMES:	.ASCII	/ERROR ON INDIRECT COMMAND FILE***/
CMDLEN=.-CMDMES
	.EVEN

	.SBTTL	MISCELLANEOUS
	.SBTTL		CSI CONTROL BLOCK
;
	CSI$
CSBLK:	.BLKB	C.SIZE
	.EVEN
;
	.SBTTL		GCML CONTROL BLOCK
;
GCLUN	=TILUN
GCBLK:	GCMLB$	2,RNP,,GCLUN
;
	.SBTTL		SWITCH TABLE
;
;COMMAND STRING INTERPERTER SWITCH
;
SWITCH:	CSI$SW	TA,2,TABFLG	;SPECIFY SWITCH ITSELF
	CSI$ND
;
	.SBTTL		OTHER THINGS
;
;
TABFLG:	.WORD	0		;FLAG TO PUT IN LEADING TAB
EDLEN:	.WORD	0		;LENGTH OF HEADER LINE
;
GETTIM:	GTIM$	EDBUF2		;GET TIME IN 2ND EDMSG BUFFER
;
BUF0:	.BYTE	0,11		;LEADING TAB
BUF1:	.BLKW	132.		;THE RECORD BUFFER
;
	FSRSZ$	3		;MAKE ROOM FOR FILE STORAGE

.SBTTL	EDMSG DATA
;
HDRME0:	.ASCII	 /%F%NMICHAEL REESE MEDICAL CENTER    - - -   /
	.ASCIZ	/DEPARTMENT OF MEDICAL PHYSICS COMPUTER%25S%X/
	.EVEN
HDRMEA:	.ASCII	 /%F%N%8SMICHAEL REESE MEDICAL CENTER    - -   /
	.ASCIZ	/DEPARTMENT OF MEDICAL PHYSICS COMPUTER%25S%X/
	.EVEN
HDRBF0=INFDB+F.FNB+N.FNAM
HDRME1:	.ASCIZ	 / PAGE %D/
	.EVEN
EDMES0:	.ASCII	/%NLISTING OF %2A%M:/	;DEVICE AND NUMBER
	.ASCIZ	/[%B,%B]/		;UIC
	.EVEN
EDMESA:	.ASCII	/%N%8SLISTING OF %2A%M:/	;DEVICE AND NUMBER
	.ASCIZ	/[%B,%B]/		;UIC
	.EVEN
EDBUF:	.WORD	INFDB+F.FNB+N.DVNM	;DEVICE STRING
DEVNUM:	.WORD	0			;DEVICE NUMBER
	.WORD	GUIC		;GROUP UIC
	.WORD	MUIC		;MEMBER UIC
;
UIC:			;START CODE STORES UIC HERE
MUIC:	.BYTE	0		;SAVE MEMBER UIC HERE
GUIC:	.BYTE	0		;SAVE GROUP UIC
;
;STORAGE FOR FILE NAME FOR OUTPUT
INPFLG:	.WORD	0		;FLAG FOR INPUT FILE SPECIFIED
NAMLEN:	.WORD	0		;LENGTH OF STRING
NAMSAV:	.BLKB	40.		;BUFFER TO STORE STRING
;
EDMES1:	.ASCIZ	/%X%4S/			;NAME,TYPE VERSION
	.EVEN
EDBUF1=INFDB+F.FNB+N.FNAM		;POINT HIM TO INPUT FDB
;
;
EDMES2:	.ASCIZ	/ON %Y AT %3Z   PAGE %D%2N/ ;DATE,TIME PAGE #
	.EVEN
EDBUF2:	.BLKW	6		;ROOM FOR DATE AND TIME
PAGE:	.BLKW	2		;DO TIME, THEN SET PAGE # TO WHATEVER
;
;
;NOW THE OUTPUT BUFFER
;
EDBLK:	.BLKB	150.		;ONE LINE OF OUTPUT
	.END	START