.TITLE P.FILE    PASCAL FILE INPUT/OUTPUT ROUTINES
	.MCALL	NMBLK$,GET$,PUT$,FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A
	.MCALL	FSRSZ$,QIOW$,ALUN$,DIR$
	.MCALL	OPEN$R,OPEN$W,CLOSE$,DELET$
	.MCALL	FINIT$
.PSECT P$FILE
;MISC
IN=4
OUT=2


;PASCAL FILE BLOCK OFFSETS
EOF=2
LUN=3
MAXSIZ=4
LINK=8.
FDBPNT=8.
IOFNC=16.
HOWOPN=18.
FILE=20.
BUFHDR=30.
BUFSIZ=30.
MODE=32.
STATUS=33.
VALID=34.
DOSBUF=36.
BUFFER=38.
;
LF=12
CR=15

.PAGE
.SBTTL P$FINT - INITIALIZE
CLUN:	.WORD	1
P$FINT::;PASCAL INITIALIZE FILE BLOCK
	;TO DUMMY FILE

	;REGISTERS
	;USES: R0,R1,R3
		;R0 = MAX SIZE OF RECORD
		;R1 = BUFFER SIZE
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R2

MOV	CLUN,R2
DEC	R2
BNE	1$
FINIT$
1$:
MOV	R3,R2
MOV	R3,(R2)
ADD	#BUFFER,(R2)+ ;POINTER TO FILE VARIABLE
MOVB	#1,(R2)+ ;SET EOF TO TRUE
MOVB	CLUN,(R2)+	;SET LOGICAL UNIT NUMBER
INC	CLUN
MOV	R0,(R2)+
CLR	HOWOPN(R3) ;SET TO DUMMY FILE
MOV	R1,BUFSIZ(R3) ;BUFFER SIZE
MOV	FCBIDX,R2	;FCB INDEX
MOV	R1,F.URBD(R2)	;SIZE OF PASCAL BUFFER
MOV	(R2)+,FDBPNT(R3)
MOV	R2,FCBIDX
RTS	PC
.PAGE
.SBTTL P$FRST - RESET
P$FRST::;PASCAL FILE PROCEDURE RESET
	;BINDS FILE NAME TO PASCAL FILE
	;AND OPENS THE FILE FOR INPUT
	;UNLESS IT DOES NOT EXIST
	;IN WHICH CASE IT IS OPENED FOR OUTPUT.
	;IF ALREADY OPENED, THE FILE IS CLOSED FIRST.

	;REGISTERS
	;USES: R0,R1,R2,R3,SP
		;R0 -> NAME BLOCK
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R0,R1,R2

JSR	PC,PREAMB
BCS	XRST	;IF A TERMINAL
BEQ	OPNOUT ;FILE DOES NOT EXIST, OPEN FOR OUTPUT
MOVB	#IN,HOWOPN(R3)

JSR	PC,F.OPEN ;OPEN THE FILE
CLRB	EOF(R3)	;FALSE -> EOF
CLR	R0 ;CLEAR LEFTOVERS
JSR	PC,P$FGES ;GET A BUFFER FULL
RTS	PC ;AND RETURN

XRST:
MOVB	#IN,HOWOPN(R3)
MOV	#IO.RLB,IOFNC(R3)	;STANDARD QIO FUNCTION
MOVB	#24,MODE(R3)	; TERMINAL USES SPECIAL FORMATTED ASCII ON INPUT
CLRB	EOF(R3) ;FALSE->EOF
MOV	#1,VALID(R3)	;MAKE CURRENT CHAR A NULL
MOVB	LUN(R3),$$ALUN+A.LULU
DIR$	#$$ALUN
RTS	PC
;
$$ALUN: ALUN$	1,TI,0
.PAGE
.SBTTL P$FREW - REWRITE
P$FREW::;PASCAL PROCEDURE REWRITE
	;BINDS FILE NAME TO PASCAL FILE,
	;DELETING IT IF IT ALREAD EXISTS,
	;AND OPENS IT FOR OUTPUT.

	;REGISTERS
	;USES: R0,R1,R2,R3,SP
		;R0 -> NAME BLOCK
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R0,R1,R2

JSR	PC,PREAMB
BCS	RWT ;IF A TERMINAL
BEQ	OPNOUT ;IF FILE DOES NOT EXIST
JSR	PC,F.DELT	;DELETE OLD FILE

OPNOUT:
MOVB	#OUT,HOWOPN(R3)
JSR	PC,F.OPEN ;OPEN THE FILE FOR OUTPUT
BR	XRWT

RWT:	;OPEN TERMINAL FOR OUTPUT
MOV	#OUT,HOWOPN(R3)
MOV	#IO.WVB,IOFNC(R3)	;STANDARD QIO FUNCTION
MOV	#4,MODE(R3)	; TERMINAL USES NORMAL FORMATTED ASCII FOR OUTPUT
MOVB	LUN(R3),$$ALUN+A.LULU
DIR$	#$$ALUN
WT:XRWT:
MOVB	#1,EOF(R3) ;TRUE->EOF
RTS	PC
.PAGE
.SBTTL P$FCLO - CLOSE
P$FCLO::;PASCAL FILE CLOSE

	;REGISTERS
	;USES: R3
		;R3 -> PASCAL FILE BLOCK

TSTB	HOWOPN(R3)	;DUMMY FILE
BEQ	CLO2		;IF SO, IGNORE
JSR	PC,CLOSE	;CLOSE FILE
CLRB	HOWOPN(R3)

CLO2:
RTS	PC
.PAGE
.SBTTL P$FGET - GET
P$FGET::;PASCAL FILE PROCEDURE GET

	;REGISTERS
	;USES: R3,R0,SP
		;R0 = SIZE, IN BYTES, OF CURRENT
			;BUFFER VARIABLE
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R0,R1,R2

TSTB	HOWOPN(R3)	;DUMMY FILE
BEQ	GETOK		;IF SO, IGNORE
TSTB	EOF(R3);IS EOF SET
BNE	GETERR	;IT MUST NOT BE
ADD	R0,(R3)	;BUMP POINTER
SUB	R0,VALID(R3);REDUCE SIZE REMAINING
CMP	VALID(R3),MAXSIZ(R3) ;ENOUGH LEFT IN BUFFER?
BGE	GETOK
MOV	R3,R1
ADD	#BUFFER,R1 ;R1 -> PASCAL BUFFER
MOV	(R3),R2	;R2 -> LEFTOVERS
MOV	R1,(R3)	;NEW PASCAL BUFFER VARIABLE POINTER
MOV	VALID(R3),R0 ;R0 = SIZE OF LEFTOVERS
BLE	GETBUF	;IF SIZE <= 0, SKIP THE MOVE
MOV	R0,-(SP) ;SAVE SIZE OF LEFTOVERS

GETMOV:	;MOVE LEFTOVERS TO THE BEGINNING OF BUFFER
MOVB	(R2)+,(R1)+
SOB	R0,GETMOV
MOV	(SP)+,R0 ;RESTORE SIZE OF LEFTOVERS
GETBUF:
JSR	PC,P$FGES;GET ANOTHER BUFFER FULL

GETOK:
RTS	PC	;RETURN

GETERR:
MOV	#1,-(SP)	;ERROR #1: EOF ON GET
JSR	PC,P$IOER	;IO ERROR OUTPUT
RTS	PC		;CONTINUE IS POSSIBLE
.PAGE
P$FGES:	;SUBROUTINE TO GET A BUFFER FULL
	;REGISTERS
	;USES: R3,R0,SP
		;R0 = SIZE OF LEFTOVERS
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R0,R1,R2

BITB	#1,MODE(R3)	;ASCII => TERMINAL
BEQ	GESTRM


MOV	R0,-(SP);SAVE SIZE OF LEFTOVERS
MOV	BUFSIZ(R3),R2
MOV	(R3),R1	;BUFFER POINTER
MOV	FDBPNT(R3),R0	;FDB POINTER
GES:
GET$	R0,R1,R2	;GET NEXT RECORD
BCS	GES3	;GET ERROR, CHECK FOR EOF
MOV	F.NRBD(R0),VALID(R3)	;NUMBER OF BYTES IN THE RECORD
BEQ	GES	;ZERO LENGTH RECORD, REPEAT GET

BITB	#FD.CR,F.RATT(R0)	;IS IT A TEXT FILE?
BEQ	GES0			;NO, TREAT AS BINARY
ADD	VALID(R3),R1		;POINT TO END OF BUFFER
MOVB	#LF,(R1)+	;INSERT LINE FEED TO INDICATE ENDOFLINE
INC	VALID(R3)	;INCREMENT VALID DATA SIZE
GES0:
ADD	(SP)+,VALID(R3) ;ADD LEFTOVERS TO AMOUNT JUST READ
GES1:
CLRB	EOF(R3)		;SET EOF TO FALSE
TST	VALID(R3) ;IS THERE ANY VALID DATA
BGT	GESRET
GES2:
MOVB	#1,EOF(R3) ;IF NOT, SET PASCAL EOF TO TRUE
GESRET:
RTS	PC	;RETURN
;
GES3:
CMPB	#IE.EOF,F.ERR(R0)	;END OF FILE?
BNE	GETERR
CLR	VALID(R3)		;NO VALID DATA
BR	GES0
;
GESTRM:
MOV	IOFNC(R3),$$QIOW+Q.IOFN
MOVB	LUN(R3),$$QIOW+Q.IOLU
MOV	(R3),$$QIOW+Q.IOPL
MOV	#1,$$QIOW+Q.IOPL+2
DIR$	#$$QIOW
CMP	#-10,IOST
BEQ	GES2
MOV	IOST+2,VALID(R3)
RTS	PC	;RETURN
;
$$QIOW: QIOW$	IO.RVB,1,32.,50.,IOST,,<IOST,1,0>
IOST:	.WORD	0,0
.PAGE
.SBTTL P$FPUT - PUT
P$FPUT::;PASCAL FILE PROCEDURE PUT
	;REGISTERS
	;USES: R3,R0,SP
		;R0 = SIZE, IN BYTES, OF CURRENT
			;BUFFER VARIABLE
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R0,R1

TSTB	HOWOPN(R3)	;DUMMY FILE?
BEQ	PUTOK		;IF SO, IGNORE
TSTB	EOF(R3) ;IS PASCAL EOF SET
BEQ	PUTERR	;IF NOT, IT IS AN ERROR
ADD	R0,(R3)	;BUMP BUFFER VARIABLE POINTER
ADD	VALID(R3),R0 ;R0 = NEW VALID DATA SIZE
MOV	R0,VALID(R3)
ADD	MAXSIZ(R3),R0 ;R0 = VALID+MAXSIZ
CMP	R0,BUFSIZ(R3) ;ENOUGH ROOM LEFT FOR NEXT OUTPUT
BLE	PUTOK	;IF SO, SKIP WRITING OUT THE BUFFER
JSR	PC,P$FPUS ;WRITE OUT THE VALID DATA
MOV	R3,(R3)
ADD	#BUFFER,(R3) ;SETUP BUFFER VARIABLE POINTER
CLR	VALID(R3) ;ZERO SIZE OF VALID DATA

PUTOK:
RTS	PC	;RETURN

PUTERR:
MOV	#2,-(SP)	;ERROR #2: NO EOF ON PUT
JSR	PC,P$IOER	;IO ERROR
RTS	PC		;CONTINUE IS POSSIBLE
.PAGE
P$FPUS:	;SUBROUTINE TO WRITE OUT A BUFFER FULL

	;REGISTERS
	;USES: R3
		;R3 -> PASCAL FILE BLOCK
	;DESTROYS: R0

BITB	#1,MODE(R3)	;ASCII=> TERMINAL
BEQ	PUTTRM
MOV	FDBPNT(R3),R0	;FDB POINTER
MOV	VALID(R3),F.NRBD(R0)
PUT$	R0
RTS	PC
PUTTRM:
MOV	IOFNC(R3),$$QIOW+Q.IOFN
MOVB	LUN(R3),$$QIOW+Q.IOLU
MOV	R3,-(SP)
ADD	#BUFFER,(SP)
MOV	(SP)+,$$QIOW+Q.IOPL
MOV	VALID(R3),$$QIOW+Q.IOPL+2
DIR$	#$$QIOW
RTS	PC	;RETURN
.PAGE
.SBTTL MISC SUBROUTINES
PREAMB:	;COMMON PREAMBLE FOR RESET AND REWRITE
TSTB	HOWOPN(R3)	;IS FILE OPEN?
BEQ	NOTOPN
JSR	PC,P$FCLO	;YES, CLOSE IT

NOTOPN:	;NO, FILL IN PASCAL FILE BLOCK
MOV	R0,R2
ADD	#4,R2		;START OF DEVICE NAME
MOV	R2,FDSPT+2	;DATA SET DESCRIPTOR POINTER
MOV	#4,R1
1$:
CMPB	#':,(R2)+
BEQ	2$
SOB	R1,1$
2$:
SUB	R0,R2
SUB	#4,R2		;SIZE OF DEVICE NAME
MOV	R2,FDSPT
MOV	R0,R2
ADD	#8.,R2		;START OF FILE NAME
MOV	R2,FDSPT+10.	;DATA SET DESCRIPTOR POINTER
MOV	#12.,R1
3$:
CMPB	#' ,(R2)+
BEQ	4$
SOB	R1,3$
4$:
SUB	R0,R2
SUB	#9.,R2		;SIZE OF FILE NAME
MOV	R2,FDSPT+8.
MOV	#7,MODE(R3)	;MODE=UNFORMATTED BINARY DUMP
CLR	VALID(R3)	;SIZE VALID DATA
MOV	R3,R2
ADD	#BUFFER-2,R2
MOV	R2,R1
TST	(R1)+
CLR	(R1)		;CLEAR FIRST WORD OF BUFFER
MOV	R1,(R2)		;SYSTEM BUFFER POINTER
MOV	R1,(R3)		;PASCAL BUFFER VARIABLE POINTER

CMP	#"TI,4(R0)	;TEST FOR TI DEVICE
BNE	LOOKUP		;IF NOT A TERMINAL DO A LOOKUP
SEC			;SET CARRY TO INDICATE TERMINAL
			;TO CALLING ROUTINE
RTS	PC		;AND RETURN

LOOKUP:
MOV	R3,-(SP)	;SAVE REGISTER 3
MOV	FDBPNT(R3),R0	;ADDRESS OF FDB
MOV	(R3),F.URBD+2(R0); ADDRESS OF PASCAL BUFFER
MOV	R0,R1
ADD	#F.FNB,R1	;ADDRESS OF FILE NAME BLOCK
MOV	#FDSPT,R2	;ADDRESS OF DATA SET DESCRIPTOR
MOV	R0,R3
ADD	#F.DFNB,R3	;POINTER TO DEFAULT FILE NAME BLOCK
MOV	(R3),R3		;ADDRESS OF DEFAULT FILE NAME BLOCK
;
CALL	.PARSE		;PARSE DATA SET DESCRIPTOR
CALL	.FIND		;LOCATE FILE ENTRY AND SET FILE ID
MOV	(SP)+,R3	;RESTORE REGISTER THREE
BCS	1$
CLZ
BR	2$
1$:
SEZ
2$:
CLC
;
RTS	PC
;
FDSPT:	.WORD	0,0	;DEVICE NAME
	.WORD	0,0	;DIRECTORY UIC
	.WORD	0,0	;FILE NAME
;

CLOSE:	;CLOSE FILE
CMPB	#OUT,HOWOPN(R3)	;IS THIS AN OUTPUT FILE?
BNE	CLO1

TST	VALID(R3)	;IS THERE ANY VALID DATA?
BLE	CLO1

JSR	PC,P$FPUS	;FLUSH OUTPUT BUFFER

CLO1:
JSR	PC,F.CLOS	;CLOSE
RTS	PC
.PAGE
.SBTTL RSX-11D INTERFACE SUBROUTINES

F.OPEN:	;RSX-11D OPEN
MOV	FDBPNT(R3),R0	;POINTER TO FDB
CMPB	#OUT,HOWOPN(R3)	;IS IT AN OUTPUT FILE?
BEQ	1$
OPEN$R	R0		;NO, OPEN AS READ-ONLY FOR INPUT
RTS	PC
1$:
OPEN$W	R0		;YES, OPEN AS A NEW FILE FOR WRITE
RTS	PC

F.DELT:	;RSX-11D DELET
MOV	FDBPNT(R3),R0	;POINTER TO THIS FILES FDB
DELET$	R0
RTS	PC

F.CLOS:	;RSX-11D CLOSE
MOV	FDBPNT(R3),R0	;POINTER TO FDB
CLOSE$	R0
RTS	PC
.PAGE
.SBTTL FILE CONTROL BLOCKS
;
;
FCBIDX:	.WORD	1$
1$:	.WORD	FCB01
	.WORD	FCB02
	.WORD	FCB03
	.WORD	FCB04
	.WORD	FCB05
	.WORD	FCB06
;
FCB01:	FDBDF$
	FDAT$A	R.VAR,,,-5,-5
	FDRC$A	,FCBREC,1
	FDOP$A	1,FDSPT,FCBDFB,FO.WRT
	FDBF$A	32.,,1
;
FCB02:	FDBDF$
	FDAT$A	R.VAR,,,-5,-5
	FDRC$A	,FCBREC,1
	FDOP$A	2,FDSPT,FCBDFB,FO.WRT
	FDBF$A	32.,,1
;
FCB03:	FDBDF$
	FDAT$A	R.VAR,,,-5,-5
	FDRC$A	,FCBREC,1
	FDOP$A	3,FDSPT,FCBDFB,FO.WRT
	FDBF$A	32.,,1
;
FCB04:	FDBDF$
	FDAT$A	R.VAR,,,-5,-5
	FDRC$A	,FCBREC,1
	FDOP$A	4,FDSPT,FCBDFB,FO.WRT
	FDBF$A	32.,,1
;
FCB05:	FDBDF$
	FDAT$A	R.VAR,,,-5,-5
	FDRC$A	,FCBREC,1
	FDOP$A	5,FDSPT,FCBDFB,FO.WRT
	FDBF$A	32.,,1
;
FCB06:	FDBDF$
	FDAT$A	R.VAR,,,-5,-5
	FDRC$A	,FCBREC,1
	FDOP$A	6,FDSPT,FCBDFB,FO.WRT
	FDBF$A	32.,,1
;
FCBREC:	.WORD	0
FCBDFB:	NMBLK$	PASCAL,TMP,,SY,0
;
.PAGE
.SBTTL I/O ERROR MESSAGE OUTPUT
P$IOER:
	MOV	2(SP),R0
	IOT		;JUST ABORT THE TURKEY
	FSRSZ$	3
.END