.TITLE	BUFFIO - FLEXIBLE I/O CALLS
	.IDENT	/26JAN8/	;13:35 MK
;	.ENTRY	BUFFIO - FLEXIBLE I/O CALLS
;+
; B U F F I O
;
; PURPOSE:	THIS PACKAGE ALLOWS THE FORTRAN PROGRAMMER (AND THE BUSY
;		MACRO CODER) TO DO VARIABLE LENGTH I/O, ALONG WITH
;		FILE REFERENCING BY LUN NUMBER, AND DISPOSITION
;		PROCESSING AT CLOSE.  ACCESS VARIATIONS ARE ALSO
;		AVAILABLE AS FILES ARE OPENED.  KEEP IN MIND THAT ONLY
;		SEQUENTIAL FILES MAY BE REFERENCED.  EACH ENTRY POINT
;		IS DOCUMENTED SEPARATELY.  NOTE THAT, IF AN ERROR RESULTS
;		IN THE TASK EXITING, ALL FILES OPENED IN THIS PACKAGE
;		WILL BE CLOSED FIRST.
;
; INTERFACE:	CALLING SEQUENCE:  (FORTRAN-CALLABLE SUBROUTINES)
;			CALL BUFOPN
;			CALL BUFFIN
;			CALL BUFOUT
;			CALL BUFCLS
;			CALL BUFDEL
;
; LANGUAGE:	MACRO-11
;
;-
; REVISIONS:
;    JUL-75	RK	WRITTEN
; 21-JUL-75	RK	FIXED BUG IN CONVERSION OF ERROR NUMBER FOR
;			ERROR MESSAGE.
; 10-FEB-76	MK	TOOK OUT MACRO CALL FOR SOB.
;			CHANGED CALL SYNTAX FOR NEW CALL MACRO.
; 30-MAR-76	MK	CHANGED ENTRY POINTS TO AVOID NAME CONFLICTS
;			WITH FORTRAN LIBRARY (OPEN, CLOSE, DELETE
;			CHANGED TO BUFOPN, BUFCLS, BUFDEL).
; 02-SEP-76	SS	MAKE 11M/11D COMPATIBLE, DEFINE NON-STANDARD
;			MACROS LOCALLY.
; 20-JAN-77	NS	TAKE OUT DEFINITIONS OF NON-STANDARD
;			MACROS - HANDLED IN PREFIX FILE.
; 27-JAN-77	NS	PREFIX FILE NOT USED - THIS IS A D ONLY FILE,
;			THEREFORE PUT IN MCALLS FOR PUSH AND .DATAB.
; 26-JAN-78	MK	GET RID OF .DATAB MACRO CALL AND REPLACE WITH
;			EQUIVALENT .ASCII
;
	.SBTTL	MACROS - CALLS AND DEFINTIONS
;
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A,NMBLK$
	.MCALL	FSRSZ$,DIR$,EXIT$S,POP,OPEN$,ALUN$C
	.MCALL	CSI$,GTSK$C,GET$,PUT$,CLOSE$,DELET$
	.MCALL	PRINT$,GLUN$C,WTSE$S,QIO$
	.MCALL	CALL,PUSH
;
;
;
;
;
	.MACRO	WRITE,BUF,LEN,?L
	MOV	BUF,QIOW+Q.IOPL
	MOV	LEN,QIOW+Q.IOPL+2
	DIR$	#QIOW
	BCS	L
	WTSE$S	#MSGEFN
L:
	.ENDM	WRITE
;
	.MACRO	EXIT,?LOOP,?NEXT
	MOV	#NFILES,R0
	MOV	#FDBS,R1
LOOP:	TSTB	F.LUN(R1)
	BEQ	NEXT
	PUSH	<R0,R1>
	CLOSE$	R1
	POP	<R1,R0>
NEXT:	ADD	#S.FDB,R1
	SOB	R0,LOOP
	MOV	SPSAV,SP
	EXIT$S
	.ENDM	EXIT
;
	.MACRO	RETURN
	MOV	SPSAV,SP
	RTS	PC
	.ENDM	RETURN

	.SBTTL	INTERNAL SUBROUTINES
;
;
;	SUBROUTINE:	HEADER - CONDITIONALLY ASSIGN LUN TO TT0:, GET
;			 THE TASK NAME AND CONVERT TO ASCII, AND WRITE
;			 MESSAGE HEADER.
;
;	CALL:		CALL HEADER
;
HEADER:	PUSH	<R0,R1,R2,R3,R4,R5>
	GLUN$C	MSGLUN,TSKDAT	;GET LUN ASSIGNMENT
	CMP	TSKDAT,#"TT	;IS MSG LUN ASSIGNED TO A TT?
	BEQ	HED1		;YES, LEAVE IT
	ALUN$C	MSGLUN,TT,0	;ASSIGN THE LUN TO TT0:
HED1:	GTSK$C	TSKDAT		;GET TASK DATA
	CALL	R50ASC <=6,TSKDAT,MSG7> ;PUT ASCII TASK NAME IN MSG
	WRITE	#LF,#2		;SKIP A LINE
	WRITE	#MSG7,#LEN7	;WRITE THE MESSAGE
	POP	<R5,R4,R3,R2,R1,R0>
	RTS	PC		;RETURN
;
;
;	SUBROUTINE:	NAMEIN - CONVERT AND MOVE INFORMATION
;			 FROM THE SPECIFIED FDB INTO THE
;			 MESSAGE BUFFER, AND WRITE THE BUFFER.
;
;	CALL:		CALL NAMEIN <FDB>
;
NAMEIN:	PUSH	<R0,R1,R2,R3,R4,R5> ;SAVE REGISTERS
	MOV	2(R5),R0	;ADDR OF FDB
	ADD	#F.FNB,R0	;POINT TO FILENAME BLOCK
	MOV	#FILE17,R1	;ADDR OF MESSAGE BUFFER
	MOVB	N.DVNM(R0),(R1)+ ;MOVE DEVICE NAME
	MOVB	N.DVNM+1(R0),(R1)+
	MOV	N.UNIT(R0),R2	;UNIT # TO REGISTER
	ADD	#60,R2		;CONVERT TO ASCII
	MOVB	R2,(R1)+	;UNIT NUMBER TO MESSAGE
	MOVB	#':,(R1)+	;COLON AFTER DEVICE
	PUSH	<R0,R1>
	ADD	#N.FNAM,R0
	CALL	R50ASC <=9.,R0,R1> ;PUT FILENAME IN MESSAGE
	POP	<R1,R0>
	ADD	#9.,R1
	MOVB	#'.,(R1)+	;PUT A PERIOD AFTER THE FILENAME
	PUSH	<R0,R1>
	ADD	#N.FTYP,R0
	CALL	R50ASC <=3,R0,R1> ;PUT FILE TYPE IN MESSAGE
	POP	<R1,R0>
	ADD	#3,R1
	MOVB	#';,(R1)+	;PUT A SEMI-COLON AFTER EXTENSION
	ADD	#2,R1
	MOV	R1,R2
	MOV	N.FVER(R0),R1
	MOV	R2,R1
	CLR	R2
	CALL	$CBDSG		;PUT VERSION IN MESSAGE
	WRITE	#MSG17,#LEN17	;WRITE FILE SPECS
	POP	<R5,R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RTS	PC		;RETURN
;
;
;	SUBROUTINE:	PUTNUM - PUT THE ASCII CHARACTERS REPRESENTING
;			 THE 1ST BYTE OF SPECIFIED DATA INTO THE
;			 LOCATION.
;
;	CALL:		CALL PUTNUM <NUMBER,LOC>
;
PUTNUM:	PUSH	<R0,R1,R2,R3,R4,R5> ;SAVE REGISTERS
	MOV	4(R5),R0	;ADDR OF OUTPUT
	MOVB	@2(R5),R1	;NUMBER TO CONVERT
	CLR	R2		;SUPPRESS LEADING ZEROS
	CALL	$CBDSG		;CONVERT AND STORE
	POP	<R5,R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RTS	PC		;RETURN
;
;
;	SUBROUTINE:	GETFDB - SEARCH THE FDB TABLE, AND RETURN THE
;			 ADDRESS OF THE FDB CONTAINING THE SPECIFIED
;			 LUN. IF NOT FOUND, WRITE THE HEADER, WRITE AN
;			 ERROR MESSAGE WITH THE SPECIFIED ENTRY POINT
;			 AS AUTHOR, SET THE "C" BIT, AND RETURN.
;
;	CALL:		CALL GETFDB <LUN,ENTRY>
;
	.ENABL	LSB
GETFDB:	PUSH	<R0,R1,R2,R3,R4,R5> ;SAVE REGISTERS
	MOV	#NFILES,R0	;NUMBER OF FDBS
	MOV	#FDBS,R1	;ADDR OF FDB TABLE
10$:	CMPB	@2(R5),F.LUN(R1) ;IS THIS THE FDB?
	BEQ	30$		;YES
	ADD	#S.FDB,R1	;POINT TO THE NEXT FDB
	SOB	R0,10$		;FALL THROUGH IF NO MORE FDBS
	MOV	4(R5),R0	;ADDR OF ENTRY POINT NAME
	MOV	#MSG10,R1	;ADDR OF MESSAGE
	MOV	#6,R2		;MOV 6 CHARS
20$:	MOVB	(R0)+,(R1)+
	SOB	R2,20$
	CALL	PUTNUM	<2(R5),LUN10> ;PUT LUN # IN MSG
	CALL	HEADER		;ASSIGN LUN AND WRITE HEADER
	WRITE	#MSG10,#LEN10	;WRITE MESSAGE
	SEC			;INDICATE ERROR
	POP	<R5,R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RTS	PC		;RETURN
30$:	MOV	R1,FDBLOC	;SAVE THE FDB ADDR
	CLC			;INDICATE NO ERROR
	POP	<R5,R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RTS	PC		;RETURN
	.DSABL	LSB

	.SBTTL	SYMBOL DEFINITIONS
;
;
	NFILES=4		;MAX NUMBER OF FILES OPEN AT ONCE
	IOEFN=17.		;EVENT FLAG FOR I/O
	MSGLUN=2		;LUN FOR ERROR MESSAGES
	MSGEFN=24		;EVENT FLAG FOR MESSAGES
	CSI$			;DEFINE CSI SYMBOLS

	.SBTTL	STORAGE ALLOCATION AND INITIALIZATION
;
;
	FSRSZ$	NFILES
FDBS:
	.REPT	NFILES
	FDBDF$
	FDAT$A	R.VAR
	FDRC$A
	FDOP$A	,CSIBLK+C.DSDS,NMBLK
	.ENDR
NMBLK:	NMBLK$	,,,SY,0
QIOW:	QIO$	IO.WVB,MSGLUN,MSGEFN,,,,<0,0,40,0,0,0>
CSIBLK:	.BLKB	C.SIZE
SPSAV:	.WORD	0
FDBLOC:	.WORD	0
TSKDAT:	.BLKW	16.

	.SBTTL	MESSAGE DEFINITONS
;
;
LF:	.BYTE	15,12
BUFIN:	.ASCII	/BUFFIN/
BFOUT:	.ASCII	/BUFOUT/
CLOS:	.ASCII	/BUFCLS/
DELET:	.ASCII	/BUFDEL/
;
;
	.NLIST	BEX
;
;
MSG1:	.ASCII	/BUFOPN -- FILE ALREADY OPEN ON LUN #/
LUN1:	.ASCII	/  /
LEN1=.-MSG1
MSG2:	.ASCII	/BUFOPN -- CAN'T OPEN FILE ON LUN #/
LUN2:	.ASCII	/  /
	.ASCII	/. ALL FDB'S ARE IN USE./<12><15>
	.ASCII	/EITHER CLOSE A FILE OR REASSEMBLE BUFFIO/
LEN2=.-MSG2
MSG3:	.ASCII	/BUFOPN -- SYNTAX ERROR IN FILE DESCRIPTION:/
LEN3=.-MSG3
MSG4:	.ASCII	/BUFOPN -- NO SWITCHES ALLOWED IN FILE DESCRIPTION:/
LEN4=.-MSG4
MSG5:	.ASCII	/BUFOPN -- OPEN FAILURE FOR LUN #/
LUN5:	.ASCII	/  /
	.ASCII	/. ERR IS /
ERR5:	.ASCII	/   /
LEN5=.-MSG5
MSG6:	.ASCII	/BUFOPN -- ILLEGAL LUN NUMBER: /
LUN6:	.ASCII	/   /
LEN6=.-MSG6
MSG7:	.ASCII	/       /
	.ASCII	/ABORTED BY BUFFIO PACKAGE:/
LEN7=.-MSG7
MSG10:	.ASCII	/       -- NO FILE OPEN ON LUN #/
LUN10:	.ASCII	/  /
LEN10=.-MSG10
MSG11:	.ASCII	/BUFFIN -- READ ERROR /
ERR11:	.ASCII	/   /
	.ASCII	/ ON LUN #/
LUN11:	.ASCII	/  /
LEN11=.-MSG11
MSG12:	.ASCII	/BUFOUT -- WRITE ERROR /
ERR12:	.ASCII	/   /
	.ASCII	/ ON LUN #/
LUN12:	.ASCII	/  /
LEN12=.-MSG12
MSG13:	.ASCII	/BUFCLS -- ERROR /
ERR13:	.ASCII	/   /
	.ASCII	/ ON LUN #/
LUN13:	.ASCII	/  /
LEN13=.-MSG13
MSG14:	.ASCII	/BUFOPN -- DON'T USE LUNS #1 OR #2, PLEASE/
LEN14=.-MSG14
MSG15:	.ASCII	/BUFCLS -- DISPOSITIONS WERE NOT PERFORMED/
LEN15=.-MSG15
MSG16:	.ASCII	/BUFDEL -- ERROR /
ERR16:	.ASCII	/   /
	.ASCII	/ ON LUN #/
LUN16:	.ASCII	/  /
LEN16=.-MSG16
MSG17:	.ASCII	/FILE: /
FILE17:	.ASCII	/                     /
LEN17=.-MSG17
;
;
	.LIST	BEX
;
;
	.EVEN

	.SBTTL	ENTRY POINT: BUFOPN
;
;+
; B U F O P N
;
; PURPOSE:	UPON RETURN, AN FDB (IF YOU DON'T KNOW WHAT IT
;			IS, DON'T WORRY) WILL HAVE BEEN TAILORED TO THE
;	 		FILE, AND THE FILE OPENED.  AT THIS POINT, YOU
;	 		WILL BE READY TO PROCEED USING THE OTHER ENTRY
;	 		POINTS OF THIS PACKAGE.
;
;			IF AN ERROR IS DETECTED DURING PROCESSING, A
;	 		MESSAGE WILL BE WRITTEN TO TT0: AND THE TASK WILL
;			EXIT.  IF AN ERROR IS ENCOUNTERED TRYING TO OPEN
;	 		THE FILE, AN ERROR NUMBER WILL BE RETURNED AS WELL.
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL BUFOPN (LUN,FSPEC [,LENGTH] [,ACCESS])
;
;		INPUT:	LUN = LOGICAL UNIT NUMBER FOR FILE. THE FILE WILL
;		   		WILL BE ASSIGNED TO THIS NUMBER, AND ALL
;				OTHER CALLS TO THIS PACKAGE REFERENCE
;		   		THE LUN ONLY. NOTE: DON'T USE  #1 OR #2
;			   	FOR A LUN. OTHER ROUTINES USE THEM.
;
;			FSPEC = FILE SPECIFICATION STRING. STANDARD RSX,
;			   	FORMAT.  EXAMPLE: 'SY0:[23,3]JOB.DAT'. NOTE
;				THAT IF THE FSPEC PARAMETER IS NULL, OR
;		   		LENGTH PARAMETER IS ZERO, THE OPEN WILL BE
;				TRIED USING THE CURRENT ASSIGNMENT OF
;		   		THE LUN.
;
;			LENGTH	= NUMBER OF BYTES (CHARACTERS) IN THE
;		   		FSPEC STRING.  IF NOT SPECIFIED, FSPEC
;				MUST BE TERMINATED BY A ZERO BYTE.
;		   		IF THE SINGLE QUOTE FORM OF FORTRAN CALL
;				IS USED, FORTRAN TAKES CARE OF THIS FOR YOU.
;
;			ACCESS	= FILE ACCESS SPECIFICATION. MAY BE ANY
;			   	LOGICAL COMBINATION OF THE FOLLOWING OCTAL
;				NUMBERS:
;
;					001 = OPEN FOR READING ONLY
;					016 = OPEN FOR WRITING (CREATING)
;					106 = OPEN FOR APPENDING
;					002 = OPEN FOR MODIFICATION
;					006 = OPEN FOR UPDATING, AND
;						APPENDING IF NEEDED
;					100 = INHIBIT SUPERSEDE ON FILE CREATION
;					020 = CREATE A TEMPORARY FILE
;					040 = SHARED ACCESS
;
;				   NOTE THAT THE DEFAULT IS 016 (WRITE).
;
;		OUTPUT:	NONE
;
; REFERENCES:	 ERROR NUMBERS ARE MAPPED TO MESSAGES IN
; 		THE BACK OF THE EXECUTIVE REFERENCE MANUAL.
;
; RESTRICTIONS:	DON'T USE #1 OR #2 FOR A LUN.  OTHER ROUTINES USE THEM.
;
;-
;   2.4  PROGRAM FLOW--
;
;	SEE IF WE GOT A REASONABLE LUN #
;
	.ENABL	LSB
BUFOPN::MOV	SP,SPSAV	;SAVE STACK POINTER
	PUSH	R5		;SAVE ARGUMENT POINT ON STACK
	TSTB	@2(R5)		;LOOK AT THE LUN #
	BLE	2$		;BAD
	CMPB	@2(R5),#1	;IS IT #1?
	BEQ	2$		;YES, BAD
	CMPB	@2(R5),#2	;IS IT #2?
	BNE	5$		;NO, OK
;
;	SOME TURKEY SENT US A WEIRD LUN
;
2$:	CALL	HEADER		;ASSIGN LUN AND PUT OUT HEADER
	CALL	PUTNUM <2(R5),LUN6> ;PUT LUN # IN MSG
	WRITE	#MSG6,#LEN6	;WRITE MESSAGE
	EXIT
;
;	SEE IF THE SPECIFIED LUN # IS ALREADY IN USE
;
5$:	MOV	#NFILES,R0	;NUMBER OF FDB'S
	MOV	#FDBS,R1	;ADDR OF FDB'S
10$:	CMPB	@2(R5),F.LUN(R1) ;IS THIS FDB USING THE REQUESTED LUN?
	BNE	20$		;NO, CHECK THE NEXT FDB
;
;	THE SPECIFIED LUN IS ALREADY IN USE (TURKEY)
;
	CALL	HEADER		;ASSIGN LUN AND PUT OUT HEADER
	CALL	PUTNUM <2(R5),LUN1> ;PUT LUN # IN MSG
	WRITE	#MSG1,#LUN1	;WRITE THE MESSAGE
	EXIT			;OUT YA GO!
;
;	KEEP LOOKING AT FDB'S
;
20$:	ADD	#S.FDB,R1	;POINT TO THE NEXT FDB
	SOB	R0,10$		;FALL THROUGH IF WE'VE LOOKED AT ALL
;
;	GOOD. THIS LUN IS A GOOD ONE, NOW WE TRY TO FIND AN UNSED
;	 (LUN=0) FDB.
;
	MOV	#NFILES,R0
	MOV	#FDBS,R1
30$:	TSTB	F.LUN(R1)	;IS THIS FDB ASSIGNED?
	BEQ	SETFDB		;NO
	ADD	#S.FDB,R1	;POINT TO THE NEXT ONE
	SOB	R0,30$		;FALL THROUGH IF NO MORE
;
;	ALL FDB'S ARE IN USE, WRITE A MESSAGE AND EXIT
;
	CALL	HEADER		;ASSIGN LUN AND PUT OUT HEADER
	CALL	PUTNUM <2(R5),LUN2> ;PUT LUN # IN HEADER
	WRITE	#MSG2,#LEN2	;WRITE MESSAGE
	EXIT
	.DSABL	LSB
;
;	WE'VE GOT AN AVAILABLE FDB (R1=FDB ADDR). STASH THE LUN #
;
SETFDB:	MOVB	@2(R5),F.LUN(R1) ;PUT LUN # IN FDB
	MOV	R1,FDBLOC	;STASH THE FDB ADDR AS WELL
;
;	NOW USE CSI PROCESSORS TO GENERATE DATASET POINTER FROM
;	 THE FILE SPECIFICATION STRING
;
	MOV	#CSIBLK,R0	;ADDR OF CSI CONTROL BLOCK
	CMPB	@R5,#2		;DID WE GET 2 ARGS?
	BLT	5$		;NO
	CMP	4(R5),#-1	;WAS FSPEC GIVEN?
	BEQ	5$		;NO
	MOV	4(R5),C.CMLD+2(R0) ;ADDR OF STRING
;
;	IF STRING LENGTH IS EXPLICIT, STORE IN CONTROL BLOCK. IF NOT,
;	 SCAN STRING FOR A NULL BYTE WHILE COUNTING CHARACTERS.
;
	CMPB	@R5,#3		;HAVE WE GOT THREE ARGS?
	BLT	10$		;NO
	CMP	6(R5),#-1	;WAS LENGTH EXPLICIT?
	BEQ	10$		;NO
	MOV	@6(R5),C.CMLD(R0) ;STASH STRING LENGTH IN CONTROL BLOCK
	BGT	40$
5$:	JMP	60$		;GO OPEN IF LENGTH IS LE 0
10$:	CLR	C.CMLD(R0)	;ZERO COUNTER
	MOV	4(R5),R2	;ADDR OF STRING
20$:	TSTB	(R2)+		;IS CHARACTER NULL?
	BEQ	40$		;YES, WE'RE DONE
	INC	C.CMLD(R0)	;BUMP COUNTER
	BR	20$		;TEST NEXT CHARACTER
;
;	CSI PART1 COMPRESSES BLANKS AND CHECKS SYNTAX
;
40$:	CALL	.CSI1
	BCC	50$		;PROCEED IF NO ERROR
;
;	CSI PART1 FOUND A SYNTAX ERROR. PRINT MESSAGE AND ECHO
;	 SPEC STRING BACK TO USER.
;
	CALL HEADER		;ASSIGN LUN AND PUT OUT HEADER
	WRITE	#MSG3,#LEN3	;WRITE MESSAGE
	WRITE	C.CMLD+2(R0),C.CMLD(R0) ;WRITE SECTION OF STRING IN ERROR
	EXIT
;
;	CSI PART2 GENERATES THE DATASET POINTER
;
50$:	MOVB	#CS.OUT,C.TYPR(R0) ;REQUEST OUTPUT LINE
	CLR	C.SWAD(R0)	;NO SWITCHES
	CALL	.CSI2
	BCC	60$		;PROCEED IF NO ERROR
;
;	CSI PART2 FOUND AN ERROR, SO ITS MOST LIKELY A SWITCH HAVING
;	 BEEN SPECIFIED
;
	CALL HEADER		;ASSIGN LUN AND PUT OUT HEADER
	WRITE	#MSG4,#LEN4	;WRITE MESSAGE
	WRITE	C.CMLD+2(R0),C.CMLD(R0) ;ECHO STRING
	EXIT
;
;	THE DATASET POINTER IS READY, SEE IF ACCESS WAS SPECIFIED.
;	 THE DEFAULT IS WRITE ACCESS, NO SHARE.
;
60$:	POP	R5		;RESTORE ARGUMENT POINTER
	MOV	#FO.WRT,R2	;DEFAULT TO WRITE ACCESS, NO SHARE
	CMPB	@R5,#4		;DID WE GET FOUR ARGS?
	BLT	63$		;NO
	TST	10(R5)		;WAS ACCESS SPECIFIED?
	BLT	63$		;NO
	MOV	@10(R5),R2	;SET ACCESS
;
;	WE'RE READY TO TRY THE OPEN. R2 IS THE
;	 ACCESS BITS AND THE LUN IS IN THE FDB.
;
63$:	PUSH	R5		;SAVE ARGUMENTS (IN CASE IT DOESN'T WORK)
	OPEN$	FDBLOC,R2
	BCS	BADOPN
	RETURN			;RETURN IF EVERYTHING OK
;
;	WELL, IT WAS FUN, BE WE DIDN'T GET THE FILE OPENED.
;
BADOPN:	POP	R5		;GET THE ARG POINTER
	CALL	HEADER		;ASSIGN LUN AND PUT OUT HEADER
	CALL	PUTNUM <2(R5),LUN5> ;PUT LUN # IN MSG
	ADD	#F.ERR,R0	;POINT TO ERROR NUMBER
	CALL	PUTNUM <R0,ERR5> ;PUT ERROR NUMBER IN MSG
	WRITE	#MSG5,#LEN5	;WRITE MESSAGE
	WRITE	CSIBLK+C.CMLD+2,CSIBLK+C.CMLD ;ECHO BACK FSPEC
	EXIT

	.SBTTL	ENTRY POINT: BUFFIN
;+
;
; B U F F I N
;
; PURPOSE:	READ ONE RECORD FROM FILE INTO BUFFER
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL BUFFIN (LUN,BUFFER,BUFLEN,BYTES)
;
;		INPUT:	LUN   =	LOGICAL UNIT NUMBER.  FILE MUST HAVE BEEN
;				OPENED USING THIS NUMBER.
;			BUFFER=	BUFFER OF AT LEAST "BUFLEN" BYTES TO
;				RECEIVE DATA
;			BUFLEN=	MAXIMUM NUMBER OF BYTES TO READ.
;
;		OUTPUT:	BYTES =	 NUMBER OF BYTES ACTUALLY READ INTO BUFFER.
;		   		IF AN END-OF-FILE IS READ, THIS PARAMETER
;				IS SET TO -1.
;
;		EFFECTS: UPON RETURN, ONE RECORD WILL HAVE BEEN READ FROM
;			THE FILE.  THE NUMBER OF BYTES READ WILL BE IN
;	 		"BYTES". NOTE THAT IF THE RECORD IS LARGER THAN
;	 		"BUFLEN" AN ERROR WILL RESULT.  IF THE RECORD IS
;	 		SMALLER THAN "BUFLEN", "BYTES" WILL REFLECT THE
;	 		SIZE, BUT THERE WILL BE NO ZERO OR BLANK FILLING
;	 		OF THE BUFFER.
;
;-
;   2.4  PROGRAM FLOW--
;
;	SEE IF WE'VE OPENED A FILE ON THIS LUN
;
BUFFIN::MOV	SP,SPSAV	;SAVE THE STACK POINTER
	PUSH	R5		;SAVE ARGUMENT POINTER ON STACK
	CALL	GETFDB <2(R5),BUFIN> ;FIND THE RIGHT FDB
	BCC	20$		;IF WE GOT IT
;
;	WE DON'T HAVE THIS FILE OPEN, SO IT'S HARD TO READ IT. A
;	 MESSAGE HAS BEEN WRITTEN BY THE GETFDB ROUTINE.
;
	EXIT
;
;	WE'VE GOT THE FDB ADDR IN FDBLOC. SET THE BUFFER ADDR
;	 AND LENGTH INTO THE FDB.
;
20$:	MOV	FDBLOC,R1	;PUT FDB ADDR IN R1
	POP	R5		;RESTORE ARGUMENT POINTER
	MOV	4(R5),F.URBD+2(R1) ;SET BUFFER ADDR
	MOV	@6(R5),F.URBD(R1) ;SET BUFFER LENGTH
;
;	ISSUE CALL TO READ RECORD AND CHECK ERROR INDICATION
;
	PUSH	R5		;SAVE ARGUMENT POINTER
	GET$	FDBLOC		;READ A RECORD
	BCS	BADGET
;
;	THE DATA IS IN THE BUFFER, RETURN THE NUMBER OF BYTES READ
;
	POP	R5		;GET THE ARG POINTER
	MOV	F.NRBD(R0),@10(R5) ;RETURN THE BYTE COUNT
	RETURN
;
;	WE GOT A READ ERROR. IF IT WAS EOF, RETURN A -1 FOR THE BYTE
;	 COUNT. OTHERWISE PRINT A MESSAGE.
;
BADGET:	CMPB	#IE.EOF,F.ERR(R0) ;WAS IT EOF?
	BNE	10$		;NO
	POP	R5		;GET ARG POINTER
	MOV	#-1,@10(R5)	;RETURN -1 FOR BYTE COUNT
	RETURN
10$:	ADD	#F.ERR,R0	;POINT TO ERROR NUMBER
	CALL	PUTNUM <R0,ERR11> ;PUT NUMBER INTO MSG
	MOV	FDBLOC,R0	;ADDR OF THE FDB
	ADD	#F.LUN,R0	;POINT TO LUN #
	CALL	PUTNUM <R0,LUN11> ;PUT LUN # IN MSG
	CALL	HEADER		;ASSIGN LUN AND WRITE HEADER
	WRITE	#MSG11,#LEN11	;WRITE MESSAGE
	CALL	NAMEIN <FDBLOC> ;WRITE FILE DESCRIPTOR
	EXIT

	.SBTTL	ENTRY POINT: BUFOUT
;+
;
;
; B U F O U T
;
; PURPOSE:	UPON RETURN, THE DATA IN BUFFER WILL HAVE BEEN WRITTEN
;		OUT TO THE FILE.
;
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL BUFOUT (LUN,BUFFER,BUFLEN)
;
;		INPUT:	LUN   =	LOGICAL UNIT NUMBER. FILE MUST HAVE
;			   	BEEN OPENED USING THIS NUMBER.
;			BUFFER=	BUFFER CONTAINING DATA TO BE WRITTEN.
;			BUFLEN=	NUMBER OF BYTES IN BUFFER. (LENGTH OF
;				RECORD)
;
;		OUTPUT:	NONE
;
;
;
;-
;   2.4  PROGRAM FLOW--
;
;	SEE IF WE'VE OPENED A FILE ON THIS LUN
;
BUFOUT::MOV	SP,SPSAV	;SAVE STACK POINTER
	PUSH	R5		;SAVE ARGUMENT POINTER
	CALL	GETFDB <2(R5),BFOUT> ;FIND THE RIGHT FDB
	BCC	20$		;IF OK
;
;	CAN'T WRITE THIS FILE BECAUSE IT ISN'T OPEN. A MESSAGE HAS
;	 BEEN WRITTEN BY THE GETFDB ROUTINE.
;
	EXIT
;
;	SET THE RECORD LENGTH AND BUFFER ADDRESSES IN THE FDB
;
20$:	MOV	FDBLOC,R1	;PUT FDB ADDR IN R1
	POP	R5		;RETSORE ARGUMENT POINTER
	MOV	4(R5),F.NRBD+2(R1) ;PUT BUFFER ADDR IN FDB
	MOV	@6(R5),F.NRBD(R1) ;PUT BUFFER LENGTH IN FDB
;
;	ISSUE CALL TO WRITE A RECORD AND CHECK FOR ERROR
;
	PUT$	FDBLOC		;ISSUE CALL
	BCS	BADPUT
	RETURN			;RETURN IF OK
;
;	WE GOT A WRITE ERROR. PRINT THE MESSAGE.
;
BADPUT:	ADD	#F.ERR,R0	;POINT TO ERROR NUMBER
	CALL	PUTNUM <R0,ERR12> ;PUT ERROR # IN MSG
	MOV	FDBLOC,R0	;ADDR OF FDB
	ADD	#F.LUN,R0	;POINT TO LUN #
	CALL	PUTNUM <R0,LUN12> ;PUT LUN # IN MSG
	CALL	HEADER		;ASSIGN LUN AND WRITE HEADER
	WRITE	#MSG12,#LEN12	;WRITE MSG
	CALL	NAMEIN <FDBLOC>	;WRITE FILE SPECIFIER
	EXIT

	.SBTTL	ENTRY POINT: BUFCLS
;
;+
;
;
; B U F C L S
;
; PURPOSE:	UPON RETURN, THE FILE WILL HAVE BEEN CLOSED, THE
; 		BUFFER SPACE FREED, AND THE LUN RELEASED.  IF A
;		DISPOSITION WAS SPECIFIED, THE FILE DATA WILL HAVE
; 		BEEN SENT TO THE SPOOLER.
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL BUFCLS (LUN [,DISP])
;
;		INPUT:	LUN  =	LOGICAL UNIT NUMBER OF FILE TO BE CLOSED.
;			DISP =	DISPOSITON CODE. IF ZERO OR NOT SPECIFIED
;		   		THE FILE WILL BE CLOSED ONLY. 
;				0 = FILE WILL BE CLOSED ONLY
;				1 = PRINT ONLY
;				2 = PRINT AND DELETE (SPOOL)
;      	      	    NOT SPECIFIED = FILE WILL BE CLOSED ONLY
;
;		OUTPUT:	NONE
;
;
;-
;
;   2.4  PROGRAM FLOW--
;
;	SEE IF WE'VE GOT A FILE OPEN ON THE SPECIFIED LUN
;
BUFCLS::MOV	SP,SPSAV	;SAVE THE STACK POINTER
	PUSH	R5		;SAVE ARGUMENT POINTER
	CALL	GETFDB <2(R5),CLOS> ;FIND THE RIGHT FDB
	BCC	20$		;IF OK
;
;	NO FILE OPEN ON THE GIVEN LUN. A MESSAGE HAS BEEN
;	 WRITTEN BY THE GETFDB ROUTINE. IF THE USER WANTED
;	 DISPOSITONS PERFORMED, ASSURE HIME THEY WERE NOT.
;
	POP	R5		;RESTORE ARGUMENT POINTER
	CMPB	@R5,#2		;DID WE GET 2 ARGS?
	BLT	17$		;NO
	WRITE	#MSG15,#LEN15	;SAY WE DID'NT DO DISP
17$:	EXIT
;
;	CLOSE THE FILE
;
20$:	CLOSE$	FDBLOC		;CLOSE THE FILE
	BCC	CLOSED		;CHECK FOR DISPOSITIONS IF NO ERROR
;
;	WE GOT AN ERROR ON CLOSING THE FILE. WRITE A MESSAGE
;
BADCLS:	CLRB	F.LUN(R0)	;RELEASE FDB
	ADD	#F.ERR,R0	;POINT TO ERROR NUMBER
	CALL	PUTNUM <R0,ERR13> ;PUT ERROR NUMBER IN MSG
	MOV	FDBLOC,R0	;ADDR OF FDB
	ADD	#F.LUN,R0	;POINT TO LUN #
	CALL	PUTNUM <R0,LUN13> ;PUT LUN # IN MSG
	CALL	HEADER		;ASSIGN LUN AND WRITE HEADER
	WRITE	#MSG13,#LEN13	;WRITE MESSAGE
	POP	R5		;RESTORE ARGUMENT POINTER
	CMPB	@R5,#2		;DID WE GET 2 ARGS?
	BLT	10$		;NO
	WRITE	#MSG15,#LEN15	;SAY WE DIDN'T DO DISP
10$:	CALL	NAMEIN <FDBLOC>	;WRITE FILE DESCRIPTOR
	EXIT
;
;	THE FILE WAS CLOSED OK, CHECK TO SEE IF A DISPOSITION
;	 WAS REQUESTED. IF SO, DO IT.
;
CLOSED:	POP	R5		;RESTORE ARGUMENT POINTER
	CMPB	@R5,#2		;DID WE GET 2 ARGS?
	BLT	60$		;NO
	TST	2(R5)		;WAS A DISP GIVEN?
	BLT	60$		;NO
	TST	@2(R5)		;WAS IT .GT.0 ?
	BLE	60$		;NO
	CMP	@2(R5),#2	;WAS IT .LE. 2 ?
	BGT	60$		;NO
	BEQ	10$		;TELL THE SPOOLER TO PRINT AND DELETE
	CLR	F.FNAM(R0)	;CLEAR FILE NAME
	CLR	F.FNAM+2(R0)
	CLR	F.FNAM+4(R0)
	CLR	F.FTYP(R0)	;CLEAR FILE TYPE
	CLR	F.FVER(R0)	;CLEAR FILE VERSION
	CLR	F.FNB+N.DID(R0)	;CLEAR DIRECTORY ID
	CLR	F.FNB+N.DID+2(R0)
	CLR	F.FNB+N.DID+4(R0)
10$:	OPEN$	FDBLOC,#1	;OPEN THE FILE READ-ONLY (SO PRINT$ WORKS)
	PRINT$	FDBLOC		;SEND FILE TO SPOOLER AND CLOSE
60$:	MOV	FDBLOC,R0	;ADDR OF FDB
	CLRB	F.LUN(R0)	;RELEASE FDB
	RETURN

	.SBTTL	ENTRY POINT: BUFDEL
;+
;
;
; B U F D E L
;
; PURPOSE:	UPON RETURN, THE FILE DESCRIBED BY THE SPECIFIED LUN
;		WILL HAVE BEEN CLOSED IF IT WAS OPEN, ITS DIRECTORY
; 		ENTRY REMOVED, AND ITS FILE SPACE RELEASED.
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL BUFDEL (LUN)
;
;		INPUT:	LUN  =	LOGICAL UNIT NUMBER OF FILE TO BE DELETED.
;
;		OUTPUT:	NONE
;
; RESTRICTIONS:	THESE ROUTINES ARE NOT USABLE UNDER RSX-11M.
;-
;   2.4  PROGRAM FLOW--
;
;	SEE IF WE'VE GOT A FILE OPEN ON THE SPECIFIED LUN
;
BUFDEL::MOV	SP,SPSAV	;SAVE THE STACK POINTER
	CALL	GETFDB <2(R5),DELET> ;SEARCH FOR PROPER LUN
	BCC	10$		;IF OK
;
;	NO FILE OPEN, THE "GETLUN" ROUTINE HAS WRITTEN A MESSAGE,
;	 SO EXIT
;
	EXIT
;
;	WE'VE GOT THE FDB ADDR IN FDBLOC. DELETE THE FILE, AND
;	 ZERO THE LUN.
;
10$:	DELET$	FDBLOC		;DELETE THE FILE
	CLRB	F.LUN(R0)	;FREE THE FDB
	BCS	BADEL		;BRANCH IF ERROR ON DELETE
	RETURN
;
;	WE'VE GOT A DELETE ERROR. WRITE A MESSAGE
;
BADEL:	ADD	#F.ERR,R0	;POINT TO ERROR NUMBER
	CALL	PUTNUM <R0,ERR16> ;PUT ERROR NUMBER IN MSG
	MOV	FDBLOC,R0	;FDB ADDR
	ADD	#F.LUN,R0	;POINT TO LUN #
	CALL	PUTNUM <R0,LUN16> ;PUT LUN # IN MSG
	CALL	HEADER		;ASSIGN LUN AND WRITE HEADER
	WRITE	#MSG16,#LEN16	;WRITE MESSAGE
	CALL	NAMEIN <FDBLOC> ;WRITE FILE DESCRIPTOR
	EXIT
	.END