.TITLE	PASLIB -- RUN-TIME SUPPORT
	.IDENT	/771002/
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A,OPEN$R,OPEN$W
	.MCALL	GET$,PUT$,NMBLK$,FSRSZ$,QIOW$,DIR$,CLOSE$,DELET$
	.MCALL	FINIT$,EXIT$S
;
; PASCAL RUN-TIME SUPPORT
; FILE SUPPORT AND INITIALIZATION
; FOR RSX-11D V6B LEAVE THE LINE DEFINING THE SYSTEM TYPE AS IS
; FOR RSX-11M V3 COMMENT THE SYSTEM TYPE LINE OUT.
;
RSX11D=0	;SYSTEM TYPE
;
;  HEAP DEFINITION:
;
	.PSECT	......,RW,GBL,OVR
;
.HEAP.::.WORD	HPSIZE	;(NUMBER OF BYTES IN HEAP)
;	.WORD	0	;(TOP OF HEAP)
	.WORD	0	;(PREVIOUS HEAP)
	.WORD	HPSIZE-8.	;(CURRENT HEAP SIZE)
;
;  USAGE: IN TKB COMMAND FILE:
;
;	EXTSCT=......:SIZE
;	GBLPAT=.HEAP.:SIZE
;
;
;  GLOBAL AREA DEFINITION (PAS$$$)
;
;	.PSECT	PAS$$,RW,GLB,OVR
;		.BLKB	STKSIZ
;
;  USAGE: IN TKB COMMAND FILE:
;
;	EXTSCT=PAS$$:STKSIZ
;	STACK=2
;
;	.PSECT	PAS$$$,RW,GBL,OVR
;
;	.STCK.	.WORD	0,0,0	DUMMY STACK FRAME
;		.WORD	.HEAP.
;		.WORD	OUTPUT+32.	CONSOLE OUTPUT FILE BLOCK
;		.BYTE	FILDIR,EOF
;		.WORD	MAXSIZ
;		.WORD	FDBPNT
;		.WORD	IOFNC
;		.WORD	VALID
;		.WORD	BUFSIZ
;		.WORD	STATUS,MODE
;		.WORD	DEVTYP
;		.WORD	DEVNAM
;		.WORD	LOGNAM
;		.WORD	BUFPTR
;		.WORD	0,0,0,0
;		.BLKB	MAXSIZ
;  SAME THING FOR CONSOLE INPUT AT LOCATION 74.
;
;
.PAGE
;
	.PSECT	$$FILE
;
; PASCAL FILE BLOCK DEFINITION
BUFVAR=0
EOF=2
FILDIR=3
MAXSIZ=4
FDBPNT=6
IOFNC=8.
VALID=10.
BUFSIZ=12.
LUN=14.
STATUS=15.
DEVTYP=16.
DEVNAM=18.
LOGNAM=20.
BUFPTR=22.
BUFFER=32.
;
;MISC CONSTANTS
DV.SY=75250	;	.RAD50	/SY/
DV.KB=42420	;	.RAD50	/KB/
LN.CMO=12327	;	.RAD50	/CMO/
LN.CMI=12321	;	.RAD50	/CMI/
OUT=1
IN=2
;
;LAYOUT OF GLOBALS:
OUTPUT=10.
INPUT=74.
;
.PAGE
	.SBTTL	$$$000 - INIT
; INIT - INITIALIZE HEAP AND USERS CONSOLE
; PARMS
;	R0 -> HEAP
;	R5 -> GLOBALS
; REGISTER USAGE
;	R0 -> HEAP, SCRATCH
;	R1 - SCRATCH
;	R2 - NOT USED
;	R3 -> (OUT,IN) FILE BLOCKS
;	R4 - NOT USED
; CALLS: P$FINT
;
$$$000::
; MAKE DUMMY STACK FRAME
	FINIT$		;INITIALIZE RSX-11D FILE SYSTEM
	MOV	R5,R1
	CLR	(R1)+
	CLR	(R1)+
	CLR	(R1)+
; INITIALIZE HEAP
	MOV	R0,6(R5)	;LOCATION OF HEAP
	MOV	(R0)+,R1	;HEAP SIZE
	MOV	R0,(R0)
	ADD	#6,(R0)+	;@TOP OF HEAP
	CLR	(R0)+		;@PREVIOUS HEAP
	MOV	R1,(R0)
	SUB	#8.,(R0)	;CURRENT SIZE
; INITIALIZE CONSOLE OUTPUT
	MOV	R5,R3
	ADD	#OUTPUT,R3	;R3 -> OUTPUT FILE BLOCK
	MOV	#1,R0		;BUFVAR SIZE = 1 BYTE
	MOV	#32.,R1		;BUFSIZ = 32 BYTES
	JSR	PC,P$FINT	;INITIALIZE FILE BLOCK
	MOVB	#OUT,FILDIR(R3)
	MOV	#LN.CMO,LOGNAM(R3)
	MOV	#IO.WVB,IOFNC(R3)
	MOV	#400,DEVTYP(R3)
	MOV	#5,LUN(R3)
; INITIALIZE CONSOLE INPUT
	MOV	R5,R3
	ADD	#INPUT,R3
	MOV	#1,R0
	MOV	#32.,R1
	JSR	PC,P$FINT
	MOVB	#IN,FILDIR(R3)
	CLRB	EOF(R3)
	MOV	#LN.CMI,LOGNAM(R3)
	.IF DF RSX11D
	MOV	#IO.RLB+8.,IOFNC(R3)
	.IFF
	MOV	#IO.RLB,IOFNC(R3)
	.ENDC
	MOV	#400,DEVTYP(R3)
	MOV	#5,LUN(R3)
; RETURN
	RTS	PC
.PAGE
	.SBTTL	$$$001 - EXIT
; EXIT - RETURN TO MONITOR
; PARMS
;	R5 -> GLOBALS
; REGISTER USAGE
;	R0,R1,R2,R3,R4 - NOT USED
;
$$$001::
; EXIT TO MONITOR
	EXIT$S
.PAGE
	.SBTTL	$$$004 - NEW
; GET A BLOCK FROM THE HEAP
; PARMS
;	1. POINTER TO CURRENT HEAP
;	2. SIZE REQUESTED (IN BYTES, WILL BE ROUNDED UP TO MULTIPLE OF FOUR)
; REGISTER USAGE
;	R0 = SIZE
;	R1 -> CURRENT HEAP
;	R2,R3,R4 - NOT USED
;
$$$004::
	MOV	2(SP),R0	;SECOND PARM
	MOV	(SP)+,(SP)	;MOVE DOWN RETURN ADDRESS
	INC	R0		;ROUND UP SIZE TO
	BIC	#1,R0		;...TO A MULTIPLE OF TWO
	BLE	5$		;VALID REQUEST?
	MOV	2(SP),R1	;FIRST PARM
	BEQ	5$		;ERROR, NO HEAP HEADER
	SUB	R0,6(R1)	;ADJUST CURRENT SIZE
	BLT	5$		;NOT ENOUGH ROOM
	MOV	2(R1),2(SP)	;RETURN POINTER
	ADD	R0,2(R1)	;ADJUST POINTER TO TOP OF HEAP
	RTS	PC
;
5$:	MOV	#-1,2(SP)	;RETURN NIL POINTER JUST IN CASE
	MOV	#10,-(SP)	;PASCAL NEW - HEAP OVERFLOW
	JSR	PC,P$HERR
	RTS	PC
.PAGE
	.SBTTL	$$$006 - MARK
; MARK THE HEAP
; PARMS
;	1. POINTER TO POINTER TO CURRENT HEAP
; REGISTER USAGE
;	R0 - SCRATCH
;	R1 -> CURRENT HEAP POINTER
;	R2 -> NEW HEAP
;	R3 - SCRATCH
;	R4 - NOT USED
;
$$$006::
	MOV	2(SP),R1	;PARM
	MOV	(SP)+,(SP)	;MOVE DOWN RETURN ADDRESS
	MOV	(R1),R3		;R3->HEAP HEADER
	BEQ	5$		;ERROR, NO HEAP
	MOV	6(R3),R0	;CURRENT SIZE
	CMP	R0,#8.
	BLT	5$		;NOT ENOUGH ROOM
	MOV	2(R3),R2	;R2->TOP OF HEAP
	MOV	R2,R3
	MOV	R0,(R3)+	;INITIALIZE HEAP HEADER WITH SIZE,
	MOV	R2,(R3)
	ADD	#8.,(R3)+	;...POINTER TO TOP OF HEAP,
	MOV	(R1),(R3)+	;...LINK TO OLD HEAP
	MOV	R0,(R3)
	SUB	#8.,(R3)	;...AND CURRENT SIZE
	MOV	R2,(R1)		;UPDATE CURRENT HEAP POINTER
	RTS	PC
;
5$:	MOV	#11,-(SP)	;PASCAL MARK - HEAP OVERFLOW
	JSR	PC,P$HERR
	RTS	PC
.PAGE
	.SBTTL	$$$007 - RELEASE
; CUT BACK HEAP TO LAST MARK
; PARMS
;	1. POINTER TO POINTER TO CURRENT HEAP
; REGISTER USAGE
;	R0 -> CURRENT HEAP POINTER
;	R1 -> CURRENT/DISCARDED HEAP HEADER
;	R2,R3,R4 - NOT USED
;
$$$007::
	MOV	2(SP),R0	;PARM
	MOV	(SP)+,(SP)	;MOVE DOWN RETURN ADDRESS
	MOV	(R0),R1		;R1->CURRENT HEAP HEADER
	BEQ	5$		;ERROR, NO CURRENT HEAP
	MOV	4(R1),(R0)	;PREVIOUS HEAP BECOMES CURRENT HEAP
	BEQ	5$		;ERROR, NO PREVIOUS HEAP
	RTS	PC
;
5$:	MOV	#12,-(SP)	;PASCAL RELEASE - NO PREVIOUS HEAP
	JSR	PC,P$HERR
	RTS	PC
.PAGE
	.SBTTL	$$$016 - FILE BLOCK INIT
; FILE BLOCK INITIALIZATION
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. MAXIMUM SIZE OF BUFFER VARIABLE (BYTES)
;	3. BUFFER SIZE (BYTES)
; REGISTER USAGE
;	R0 = BUFFER VARIABLE SIZE
;	R1 = BUFFER SIZE
;	R2 - SCRATCH
;	R3 -> FILE BLOCK
;	R4 - NOT USED
$$$016::
	MOV	6.(SP),R3	;GET FIRST PARM
	MOV	(SP)+,4(SP)	;MOVE DOWN RETURN ADDRESS
	MOV	(SP)+,R1	;BUFFER SIZE
	MOV	(SP)+,R0	;MAX SIZE OF BUFFER VARIABLE
;
P$FINT:	MOV	R3,R2
	MOV	R3,(R2)
	ADD	#BUFFER,(R2)+	;@BUFVAR
	MOV	#1,(R2)+	;EOF=TRUE
	MOV	R0,(R2)+	;BUFVAR SIZE
	CLR	(R2)+		;FDBPNT
	CLR	(R2)+		;IOFNC
	CLR	(R2)+		;VALID
	MOV	R1,(R2)+	;BUFSIZ
	CLR	(R2)+		;LUN,STATUS
	CLR	(R2)+		;CLEAR DEVTYP
	CLR	(R2)+		;CLEAR DEVNAM
	CLR	(R2)+		;LOGICAL NAME
	MOV	R3,(R2)
	ADD	#BUFFER,(R2)+	;BUFFER POINTER
	CLR	(R2)+		;FOUR WORDS UNUSED
	CLR	(R2)+
	CLR	(R2)+
	CLR	(R2)+
	CLR	(R2)		;CLEAR FIRST WORD IN BUFFER
	RTS	PC
.PAGE
	.SBTTL	$$$017 - RESET
	.SBTTL	$$$018 - REWRITE
; PARMS:
;	1. POINTER TO PASCAL FILE BLOCK
;	2. POINTER TO ASCII STRING CONTAINING FILE NAME
;	3. A WORD TO BE USED AS LOGICAL NAME FOR $ASSIGN
; TWO ENTRIES TO THIS ROUTINE DIFFER ONLY IN THE
; VALUE THEY LOAD INTO R1
;
; REGISTER USAGE
;	R0,R1,R2 - SCRATCH
;	R3 -> FILE BLOCK
;	R4 - SCRATCH (SAVED AND RESTORED)
;
;
$$$017::
	MOV	#IN,R1
	BR	COMMON
;
$$$018::
	MOV	#OUT,R1
;
COMMON:	MOV	6(SP),R3	;GET FIRST PARM
	MOV	(SP)+,4(SP)	;MOVE DOWN RETURN ADDRESS
	MOV	(SP)+,R2	;GET THIRD PARM
	MOV	(SP)+,R0	;GET SECOND PARM
P$FOPN:
;
	TSTB	FILDIR(R3)	;ALREADY OPENED?
	BEQ	2$
	JSR	PC,P$FCLO	;YES, CLOSE IT.
;
2$:	MOVB	R1,FILDIR(R3)	;NEW FILE DIRECTION
	MOV	R2,LOGNAM(R3)	;LOGICAL NAME
	MOV	#DV.SY,DEVNAM(R3) ;...DEVICE NAME,
	CLR FDSBK		;ZERO DEVICE STRING LENGTH,
	CLR FDSBK+4		;DIRECTORY STRING LENGTH,
	CLR FDSBK+10		;AND FILENAME LENGTH
	MOV R0,R1		;START OF FILE STRING
B0:
	  CMPB (R0),#':
	  BNE L0
	    MOV R1,FDSBK+2	;POINTER TO START OF STRING
	    MOV R0,R2
	    SUB R1,R2
	    INC R2
	    MOV R2,FDSBK	;LENGTH OF DEVICE STRING
	    MOV R0,R1
	    INC R1		;START OF NEXT STRING
	    BR L1
L0:
	    CMPB (R0),#']
	    BNE L2
	      MOV R1,FDSBK+6	;POINTER TO START OF STRING
	      MOV R0,R2
	      SUB R1,R2
	      INC R2
	      MOV R2,FDSBK+4	;LENGTH OF DIRECTORY STRING
	      MOV R0,R1
	      INC R1		;START OF NEXT STRING
	      BR L3
L2:
	      CMPB 1(R0),#40
	      BNE L4
		MOV R1,FDSBK+12	;POINTER TO START OF STRING
		MOV R0,R2
		SUB R1,R2
		INC R2
		MOV R2,FDSBK+10	;LENGTH OF FILENAME STRING
L4:
L3:
L1:
	  INC R0
	CMPB (R0),#40
	BNE B0
	TST FDBPNT(R3)
	BNE L6
	  MOV #FDBPTR,R0
B1:
	TST -(R0)
	BEQ L7
	CMP R0,#FDBUSE
	BNE B1
L7:
	  TST (R0)
	  BNE L11
	    INC (R0)
	    ADD #FDBPTR-FDBUSE,R0
	    MOV (R0),R0
	    MOV R0,FDBPNT(R3)
	    BR L12
L11:
	    MOV #1,-(SP)
	    CALL P$HERR	;PASCAL RESET/REWRITE - NO FDB SPACE
	    RTS PC
L12:
L6:
	MOV	FDBPNT(R3),R0
	MOV	(R3),F.URBD+2(R0)	;PASCAL BUFFER ADDRESS
	BITB	#IN,FILDIR(R3)
	BNE	106$
	OPEN$W	R0
	BCC	10$
	CLRB	EOF(R3)
111$:	BICB	#IN!OUT,FILDIR(R3)
	MOV	#2,-(SP)
	JSR	PC,P$HERR	;PASCAL RESET - FILE NOT FOUND
				;PASCAL REWRITE - UNABLE TO OPEN FILE
	RTS	PC
106$:	OPEN$R	R0
	BCC	107$
	MOVB	#1,EOF(R3)
	BR	111$
107$:	CLRB	EOF(R3)		;YES, FALSE => EOF
	BIT	#400,DEVTYP(R3)	;IS IT A TERMINAL?
	BNE	10$
	JSR	PC,P$FFST	;NO, GET FIRST BUFFERFULL
10$:	RTS	PC
;
.PAGE
	.SBTTL	$$$020 - CLOSE
; PARMS:
;	1. FILE BLOCK
; REGISTER USAGE
;	R0,R1,R2 - NOT USED
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FBRK
;
$$$020::
	MOV	2(SP),R3
	MOV	(SP)+,(SP)
;
P$FCLO:	TSTB	FILDIR(R3)		;WAS FILE OPEN?
	BEQ	1$			;IF NOT, SKIP ALL OF THIS
	JSR	PC,P$FBRK		;YES, DUMP FINAL BUFFER(IF OUTPUT)
;
	MOV	R0,-(SP)
	MOV	FDBPNT(R3),R0
	CLOSE$	R0
	MOV	(SP)+,R0
;
1$:	RTS	PC
.PAGE
	.SBTTL	$$$021 - GET
; PARMS
;	1. FILE BLOCK
;	2. SIZE OF LAST BUFFER VARIABLE
; REGISTER USAGE
;	R0 = SIZE OF LAST BUFFER VARIABLE
;	R1 -> START OF LEFTOVERS IN BUFFER
;	R2 - SCRATCH
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FNXT
;
$$$021::
	MOV	4(SP),R3
	MOV	(SP)+,2(SP)
	MOV	(SP)+,R0
;
P$FGET:	TSTB	EOF(R3)		;PASCAL EOF SET
	BNE	ERR001		;IT MUST NOT BE
	ADD	R0,(R3)		;BUMP BUFFER VARIABLE POINTER
	SUB	R0,VALID(R3)	;REDUCE SIZE OF REMAINING DATA
	CMP	VALID(R3),MAXSIZ(R3) ;IS THERE ENOUGH DATA FOR THIS
	BGE	1$		;...BUFFER VARIABLE
	MOV	(R3),R2		;R2 -> LEFTOVERS (IF ANY)
	MOV	R3,R1
	ADD	#BUFFER,R1	;R1 -> START OF BUFFER
	MOV	R1,(R3)		;NEW BUFFER VARIABLE POINTER
	MOV	VALID(R3),R0	;NO, GET SIZE OF LEFTOVERS IN R0
	BGT	3$
	CLR	R0		;JUST IN CASE
	BR	2$		;SKIP THE MOVE
; MOVE LEFTOVER DATA TO THE FRONT OF THE BUFFER
3$:	MOVB	(R2)+,(R1)+
	SOB	R0,3$
	MOV	VALID(R3),R0	;RESTORE SIZE OF LEFTOVERS
;
2$:	JSR	PC,P$FNXT	;GET NEXT BUFFERFULL
1$:	RTS	PC		;...AND RETURN
;
;
ERR001:	MOV	#3,-(SP)	;PASCAL GET - EOF ON GET
	JSR	PC,P$HERR
	RTS	PC
.PAGE
; SUBROUTINE TO GET (FIRST) NEXT BUFFERFULL
; EXPECTS
;	 R0 = SIZE OF LEFTOVERS
;	 R3 -> FILE BLOCK
; REGISTER USAGE
;	R0 = SIZE OF LEFTOVERS, SCRATCH
;	R1,R2 - SCRATCH
;	R3 -> FILE BLOCK
;	R4 - NOT USED
;
P$FFST:	CLR	R0		;FIRST BUFFER, NO LEFTOVERS
P$FNXT:	BITB	#IN,FILDIR(R3)	;OPENED FOR INPUT?
	BEQ	GES01		;IF NOT, SKIP ALL OF THIS
	BIT	#400,DEVTYP(R3)	;TERMINAL????
	BNE	GESTRM
	MOV	BUFSIZ(R3),-(SP)	;SAVE BUFFER SIZE
	SUB	R0,BUFSIZ(R3)	;REDUCE BUFFER SIZE FOR THIS READ
	MOV	(R3),R1		;GET POINTER TO START OF BUFFER
	ADD	R0,R1		;INCREASE BY LEFTOVERS
	MOV	R0,-(SP)	;SAVE SIZE OF LEFTOVERS
	MOV	BUFSIZ(R3),R2
	MOV	FDBPNT(R3),R0
GES:
	GET$	R0,R1,R2	;GET NEXT RECORD
	BCS	GES3		;GET ERROR CHECK FOR END OF FILE
	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	#12,(R1)+	;INSERT LINE FEED TO INDICATE ENDOFLINE
	INC	VALID(R3)
GES0:
	MOV	(SP)+,R0	;RESTORE SIZE OF LETOVERS
	MOV	(SP)+,BUFSIZ(R3);RESTORE BUFFER SIZE
	ADD	VALID(R3),R0	;ADD NR OF BYTES JUST READ TO LEFTOVERS
GES00::	MOV	R0,VALID(R3)	;UPDATE VALID
	BGT	GES01		;IF ANY VALID DATA THEN SKIP THE NEXT
GES2:
	MOVB	#1,EOF(R3)	;SET PASCAL EOF TO TRUE
GES01:	RTS	PC
;
GES3:	CMPB	#IE.EOF,F.ERR(R0)	;END OF FILE
	BNE	ERR001
	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
;
$$QIOW:	QIOW$	IO.RVB,1,32.,50.,IOST,,<IOST,1,0>
IOST:	.WORD	0,0
.PAGE
	.SBTTL	$$$022 - PUT
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. SIZE OF BUFFER VARIABLE TO PUT
; REGISTER USE
;	R0 = SIZE OF BUFFER VARIABLE
;	R1,R2 - NOT USED
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FBRK
;
$$$022::
	MOV	4(SP),R3
	MOV	(SP)+,2(SP)
	MOV	(SP)+,R0
;
P$FPUT:	TSTB	EOF(R3)		;YES, IS EOF SET?
	BEQ	ERR002
	ADD	R0,(R3)		;YES, BUMP BUFFER VARIABLE POINTER
	ADD	VALID(R3),R0	;R0=NEW SIZE OF VALID DATA
	MOV	R0,VALID(R3)	;UPDATE VALID
	ADD	MAXSIZ(R3),R0	;CHECK TO SEE IF THERE IS ROOM
	CMP	R0,BUFSIZ(R3)	;...ENOUGH FOR NEXT BUFFER VARIABLE
	BLE	1$
	JSR	PC,P$FBRK	;NOT ENOUGH ROOM, FLUSH THE BUFFER
;
1$:	RTS	PC
;
;
ERR002:	MOV	#4,-(SP)	;PASCAL PUT - NO EOF ON PUT
	JSR	PC,P$HERR
	RTS	PC
.PAGE
	.SBTTL	$$$023 - BREAK
; PARMS
;	1. POINTER TO FILE BLOCK
; REGISTER USE
;	R0,R1,R2 - NOT USED
;	R3 -> FILE BLOCK
;	R4 - NOT USED
;
$$$023::
	MOV	2(SP),R3
	MOV	(SP)+,(SP)
;
P$FBRK:	BITB	#OUT,FILDIR(R3)	;OPENED FOR OUTPUT?
	BEQ	1$
	TST	VALID(R3)	;ANY VALID DATA
	BLE	1$
	BIT	#400,DEVTYP(R3)	;TERMINAL?
	BNE	2$
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	FDBPNT(R3),R0
	MOV	VALID(R3),F.NRBD(R0)
	MOV	R3,R1
	ADD	#BUFFER,R1
	PUT$	R0,R1
	MOV	(SP)+,R1
	MOV	(SP)+,R0
3$:	MOV	R3,(R3)		;RE-INITIALIZE BUFFER VARIABLE POINTER
	ADD	#BUFFER,(R3)
	CLR	VALID(R3)	;...AND COUNT
;
1$:	RTS	PC
;
2$:	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
	BR	3$
.PAGE
	.SBTTL	$$$024 - READ CHARACTER
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. POINTER TO CHARACTER
; REGISTER USAGE
;	R0 - SIZE OF BUFFER VARIABLE
;	R1,R2 - USED BY P$FGET
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FGET
;
$$$024::
	MOV	4(SP),R3
	MOV	(SP)+,2(SP)
;
P$FRDC:	BIT	#400,DEVTYP(R3)	;TERMINAL?
	BNE	1$
;
	MOVB	@(R3),@(SP)+	;NO, MOVE THEN GET
	MOV	#1,R0
	JSR	PC,P$FGET
	BR	2$
;
1$:	MOV	#1,R0		;YES, GET THEN MOVE
	JSR	PC,P$FGET
	MOVB	@(R3),@(SP)+
;
2$:	RTS	PC
.PAGE
	.SBTTL	$$$025 - WRITE CHARACTER
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. CHARACTER
;	3. WIDTH OF FIELD
; REGISTER USAGE
;	R0 - BUFFER VARIABLE SIZE
;	R1 - HOLDS PAD CHAR TO P$FPAD
;	R2 - NOT USED
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FPUT,P$FPAD
; RASH ASSUMPTION: P$FPUT DOES NOT DISTURB R2,R3
;
$$$025::
	MOV	6(SP),R3
	MOV	(SP)+,4(SP)
	MOV	(SP)+,R2
;
P$FWRC:	CMPB	(SP),#12	;IS CHAR A LINE FEED?
	BNE	1$
;
	MOVB	#15,@(R3)	;YES, SYSTEM LIKES TO SEE A
	MOV	#1,R0		;...CR BEFORE EVERY LF
	JSR	PC,P$FPUT
;
1$:	MOVB	(SP)+,@(R3)	;MOVE THE CHAR INTO THE BUFFER
	MOV	#1,R0		;AND PUT
	JSR	PC,P$FPUT
;
	MOV	#' ,R1		; PAD CHAR IS BLANK
	DEC	R2		;WIDTH - 1 IS NR OF PADS
	JSR	PC,P$FPAD
;
	RTS	PC
.PAGE
	.SBTTL	$$$027 - WRITE STRING
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. POINTER TO STRING
;	3. LENGTH OF STRING
;	4. WIDTH OF FIELD
; REGISTER USAGE
;	R0 - SIZE OF BUFFER VARIABLE
;	R1 - HOLDS PAD CHAR TO P$FPAD
;	R2 - SCRATCH
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FPUT,P$FPAD
; RASH ASSUMPTION: P$FPUT DOES NOT DISTURB R2,R3
;
$$$027::
	MOV	8.(SP),R3
	MOV	(SP)+,6(SP)
;
	TST	(SP)		;WIDTH > 0?
	BGT	1$
;
	MOV	2(SP),(SP)	;NO, MAKE IT SAME AS LENGTH
1$:	SUB	2(SP),(SP)	;WIDTH NOW IS NR OF BLANKS FOR PADDING
	BGE	4$
	ADD	(SP),2(SP)	;LENGTH IS NOW FIELD WIDTH
4$:
	MOV	2(SP),R2	;GET LENGTH
	BLT	2$		;IF LENGTH <= 0, SKIP STRING OUTPUT
;
3$:	MOVB	@4(SP),@(R3)	;MOVE A CHAR
	INC	4(SP)		;BUMP POINTER
	MOV	#1,R0		;AND PUT
	JSR	PC,P$FPUT
	SOB	R2,3$
;
2$:	MOV	#' ,R1		; PAD CHAR IS BLANK
	MOV	(SP)+,R2	;GET WIDTH OF PAD
	CMP	(SP)+,(SP)+	;DISCARD LENGTH AND POINTER TO STRING
	JSR	PC,P$FPAD	;OUTPUT TRAILING BLANKS (IF ANY)
;
	RTS	PC
.PAGE
; P$FPAD - PUTS OUT PAD CHARACTERS
; EXPECTS
;	R1 = PAD CHARACTER
;	R2 = CHARACTER COUNT
;	R3 -> FILE BLOCK
; REGISTER USAGE
;	R0 - BUFFER VARIABLE SIZE
;	R1 - CHARACTER FOR PAD
;	R2 - COUNTER
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FPUT
; RASH ASSUMPTION: P$FPUT DOES NOT DISTURB R1, R2
;
P$FPAD:	TST	R2
	BLE	1$
;
2$:	MOVB	R1,@(R3)
	MOV	#1,R0
	JSR	PC,P$FPUT
	SOB	R2,2$
;
1$:	RTS	PC
.PAGE
	.SBTTL	$$$030 - READ INTEGER
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. POINTER TO INTEGER VARIABLE
; REGISTERS
;	R0 - SCRATCH
;	R1 - SCRATCH
;	R2 - SCRATCH, VALUE OF CONVERTED INTEGER
;	R3 -> FILE BLOCK
;	R4 -> SCRATCH
; CALLS: P$FGET, P$TCAI
$$$030::
	MOV 4(SP),R3		; UNPACK PARMS--GET -> FILE BLOCK
	MOV (SP)+,2(SP)		; SAVE RETURN ADDR.
1$:	CMPB #' ,@(R3)		; IGNORE CONTROL CHARS & SPACES
	BLT 2$
	MOV #1,R0
	JSR PC,P$FGET
	BR 1$
2$:	MOV #1,R0
	CMPB #'+,@(R3)		; CHECK FOR SIGN
	BNE 4$
	JSR PC,P$FGET		; BUMP PAST '+'
3$:	JSR PC,P$TCAI		; CONVERT FOLLOWING INTEGER
	BR 5$
4$:	CMPB #'-,@(R3)
	BNE 3$		; NO SIGN--JUST CONVERT
	JSR PC,P$FGET		; BUMP PAST '-'
	JSR PC,P$TCAI		; CONVERT
	NEG R2			; NEGATE
5$:	MOV R2,@(SP)+		; STORE RESULT, POP STACK
	RTS PC			; GO HOME
.PAGE
;P$TCAI - CONVERT ASCII TO INTEGER
; EXPECTS 
;	R3 -> FILE BLOCK
; REGISTER USAGE
;	R0 - SCRATCH
;	R1 - SCRATCH
;	R2 - FINAL VALUE RETURNED
;	R3 -> FILE BLOCK
;	R4 - SCRATCH
; CALLS: P$FGET
P$TCAI:
	MOV R4,-(SP)		; SAVE R4
	CLR -(SP)		; TEMP FOR CONVERTED VALUE
1$:	MOVB @(R3),R4		; NEXT (FIRST) DIGIT
	SUB #'0,R4
	BLT 2$			; QUIT ON NON-DIGIT
	CMP #9.,R4
	BLT 2$			; MUST BE IN RANGE 0..9
	MOV (SP)+,R1
	MUL #10.,R1		; SINGLE PRECISION MULT.
	ADD R4,R1		; ADD IN LAST DIGIT
	MOV R1,-(SP)		; HOLD INTERMEDIATE RESULT
	MOV #1,R0		; # BYTES...
	JSR PC,P$FGET		; ...TO GET
	BR 1$			; GET NEXT DIGIT
;
2$:	MOV (SP)+,R2		; POP RETURN VALUE
	MOV (SP)+,R4		; RESTORE R4
	RTS PC			; AND GO HOME
.PAGE
	.SBTTL	$$$031 - WRITE INTEGER
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. INTEGER TO BE OUTPUT
;	3. WIDTH OF FIELD
; REGISTER USAGE
;	R0 - INPUT VALUE
;	R1 - WIDTH, PAD CHAR TO P$FPAD
;	R2 -> CONVERTED STRING
; 	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FPAD, P$TCIA, P$FPUT
;
$$$031::
	MOV	6(SP),R3	; UNPACK STACK FRAME;  -> FILE BLOCK
	MOV	(SP)+,4(SP)	; RETURN ADDRESS
	MOV	2(SP),R0	; INTEGER
	MOV	SP,R2
	SUB	#6,SP		; FOR CONVERTED STRING
	MOV	R2,-(SP)
	TST	R0
	BLT	1$
	JSR	PC,P$TCIA
	BR	2$
1$:	NEG	R0
	JSR	PC,P$TCIA
	MOVB	#'-,-(R2)	; MINUS SIGN
2$:	SUB	R2,(SP)
	MOV	8.(SP),R1	; GIVEN WIDTH
	BGT	6$
	CLR	R1		; NO WIDTH SPECIFIED - NO PAD NEEDED
	BR	4$
6$:	SUB	(SP),R1		; COMPUTE PAD LENGTH
	BGE	4$		; INSERT STARS IF NEG
	TST	(SP)+
	MOV	6(SP),R2
	MOVB	#'*,R1
	JSR	PC,P$FPAD
	BR	5$
4$:	MOV	R2,-(SP)
	MOV	R1,R2
	MOVB	#' ,R1
	JSR	PC,P$FPAD
	MOV	(SP)+,R2
	MOV	(SP)+,R1
7$:	MOVB	(R2)+,@(R3)
	MOV	#1,R0
	JSR	PC,P$FPUT
	SOB	R1,7$
5$:	ADD	#10.,SP		; CUT BACK STACK
	RTS	PC
.PAGE
; P$TCIA - CONVERT INTEGER TO ASCII
; EXPECTS
;	R0 - INTEGER
;	R2 -> BUFFER FOR CONVERTED STRING
; REGISTER USAGE
;	R0 - SCRATCH
;	R1 - SCRATCH
;	R2 -> BUFFER
;	R3 - NOT USED
;	R4 - NOT USED
; CALLS: NONE
;
P$TCIA:
1$:	MOV	R0,R1
	CLR	R0
	DIV	#10.,R0
	ADD	#'0,R1
	MOVB	R1,-(R2)
	TST	R0
	BNE	1$
	RTS	PC
.PAGE
	.SBTTL	$$$039 - WRITE OCTAL
; PARMS
;	1. POINTER TO FILE BLOCK
;	2. INTEGER TO BE OUTPUT
;	3. WIDTH OF FIELD (>= 6)
; REGISTER USAGE
;	R0 - SCRATCH
;	R1 - PAD CHARACTER, VALUE TO CONVERT
;	R2 - PAD COUNT, LOOP COUNT
;	R3 -> FILE BLOCK
;	R4 - NOT USED
; CALLS: P$FPAD, P$FPUT
;
$$$039::
	MOV	6(SP),R3	; UNPACK STACK FRAME; -> FILE BLOCK
	MOV	(SP)+,4(SP)	; RETURN ADDRESS
	MOV	(SP)+,R2	; WIDTH OF FIELD
	BLE	2$
	SUB	#6,R2
	BGT	1$		; PAD WITH BLANKS
	BEQ	2$		; NO PADDING
	MOV	#'*,R1		; PAD WITH *'S
	NEG	R2
	JSR	PC,P$FPAD
	TST	(SP)+
	BR	3$
1$:	MOV	#' ,R1
	JSR	PC,P$FPAD	; OUTPUT BLANKS
2$:	MOV	#6,R2
	MOV	(SP)+,R1	; INTEGER VALUE
	CLR	R0
	ASHC	#1,R0		; 1ST DIGIT IS ONE BIT
4$:	ADD	#'0,R0		; CONVERT TO DIGIT
	MOVB	R0,@(R3)
	MOV	#1,R0		; UPDATE ONE BYTE
	JSR	PC,P$FPUT
	CLR	R0
	ASHC	#3,R0		; NEXT DIGIT
	SOB	R2,4$
3$:	RTS	PC
.PAGE
.SBTTL	P$HERR - ERROR OUTPUT
;
;  ERROR OUTPUT
;
;	ERROR SUMMARY:
;
;		 1 - RESET/REWRITE - NO FDB SPACE
;		 2 - RESET - FILE NOT FOUND
;		 3 - GET - EOF ON INPUT
;		 4 - PUT - NO EOF ON OUTPUT
;		10 - NEW - HEAP OVERFLOW
;		11 - MARK - HEAP OVERFLOW
;		12 - RELEASE - NO PREVIOUS HEAP
;
P$HERR:	MOV	2(SP),R1	;ERROR CODE
	MOV	(SP)+,(SP)	;PUSH DOWN RETURN ADDRESS
	MOV	#ASCBUF,R0	;ADDRESS FOR ASCII STRING
	CLR	R2
	CALL	$CBDMG		;CONVERT TO ASCII
	SUB	#MASK,R0	;STRING LENGTH
	MOV	R0,$$QIOW+Q.IOPL+2
	MOV	#MASK,$$QIOW+Q.IOPL
	MOV	#5,$$QIOW+Q.IOLU
	MOV	#IO.WVB,$$QIOW+Q.IOFN
	DIR$	#$$QIOW
	RTS	PC
;
;
MASK:	.ASCII	<15><12>/PASCAL RUN-TIME ERROR NUMBER: /
ASCBUF:	.ASCII	/      /
MASKL=.-MASK
	.EVEN
;
.PAGE
.SBTTL	FILES11 INTERFACE DATA
;
;
;  RSX-11D INTERFACE DATA AREAS
;
; FDBUSE AND FDBPTR MUST ALWAYS APPEAR IN ORDER
FDBUSE:	.WORD	0,0,0		;FDB USAGE INDICATORS
FDBPTR:	.WORD	FDB001,FDB002,FDB003
FDB001:	FDBDF$
	FDAT$A	R.VAR
	FDRC$A	,FCBREC,1
	FDOP$A	1,FDSBK,FCBDFB,FO.WRT
	FDBF$A	32.,,1
FDB002:	FDBDF$
	FDAT$A	R.VAR
	FDRC$A	,FCBREC,1
	FDOP$A	2,FDSBK,FCBDFB,FO.WRT
	FDBF$A	32.,,1
FDB003:	FDBDF$
	FDAT$A	R.VAR
	FDRC$A	,FCBREC,1
	FDOP$A	3,FDSBK,FCBDFB,FO.WRT
	FDBF$A	32.,,1
FCBREC:	.WORD	0
FCBDFB:	NMBLK$	PASCAL,TMP,,SY,0
FDSBK:	.WORD	0,0
	.WORD	0,0
	.WORD	0,0
;
	FSRSZ$	3
	.END