.TITLE	GETFDB
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	GETFDB
;
;  DATE:	05-MAR-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL GETFDB(LUN,IFDB,[ISW])
;
;		LUN	= INTEGER CONTAINING A LOGICAL UNIT NUMBER.
;
;		IFDB	= 23-WORD INTEGER ARRAY TO RECIEVE FDB.
;
;		ISW	= VARIABLE TO RECIEVE THE INTEGER STATUS WORD.
;
;			   00 = SUCCESS
;
;			  -37 = NO FILE ACCESSED ON LUN
;			  -96 = INVALID LOGICAL UNIT NUMBER
;
;
;  DESCRIPTION:
;
;	THE "GETFDB" DIRECTIVE SAVES ENOUGH OF THE FORTRAN FILE DESCRIPTOR
;  BLOCK (FFDB) FOR A CURRENTLY OPEN FILE TO BE REOPENNED BY FILE-ID USING
;  THE "REOPEN" DIRECTIVE.
;
;

	.SBTTL	SYMBOL DEFINITIONS
;
;
	.PSECT				;
					;
	.MCALL	OTSWA,$AOTS,FBLOCK	; IN [11,40]F4P.MAC
	OTSWA				; DEFINE OTS OFFSETS
	FBLOCK				; DEFINE FDB AND FFDB OFFSETS
					;
;
;
;  REGISTER USAGE:
;
;	R0 = ADDR OF FDB
;	R1 = ADDR OF FFDB
;	R2 = LUN # OR # OF BYTES TO TRANSFER FOR SOB LOOPS
;	R3,R4 = SCRATCH
;	R5 = ARGUEMENT POINTER
;
;

	.SBTTL	ENTRY POINT -- SAVE FILE DESCRIPTOR BLOCK
;
;
					;
GETFDB::				;
					; TEST LUN
	MOV	@2(R5),R2		; GET LUN
	BLE	IEILU			; LUN.LE.0?
	$AOTS				; ADDR OF IMPURE OTS SECT INTO R3
	CMP	W.LUNS(R3),R2		; COMPARE LUN TO TKB OPTION
	BLT	IEILU			; LUN.GT.MAX LUN SPECIFIED DURING TKB
					;
					; TEST LUN OPEN
	JSR	PC,$FCHNL		; GET ADDR OF LUN'S FFDB IN R0
	BIT	#DV.OPN,D.STAT(R0)	; OPEN?
	BEQ	IENLN			; NO, ERROR
	MOV	R0,R1			; SAVE FFDB FOR LATER
	ADD	#D.FDB,R0		; START OF FDB
					;
					; SAVE FFDB HEADER
	MOV	#D.FDB,R2		; BYTE LENGTH OF HEADER
	MOV	4(R5),R3		; ADDR OF ARRAY (IFDB)
	MOV	R1,R4			; ADDR OF FFDB HEADER
2$:	MOVB	(R4)+,(R3)+		; MOVE HEADER TO ARRAY
	SOB	R2,2$			;
					;
					; SAVE FNB
	MOV	R0,R4			; FDB ADDR
	ADD	#F.FNB,R4		; START OF FNB
	MOV	#S.FNB,R2		; BYTE LENGTH OF FNB
4$:	MOVB	(R4)+,(R3)+		; MOVE FNB TO ARRAY
	SOB	R2,4$			;
					;
					; SAVE MISC FDB ITEMS
	MOV	F.ALOC(R0),(R3)+	; EXTENSION SIZE (EXTENDSIZE=)
	MOVB	F.MBCT(R0),(R3)+	; MULTIPLE BUFFER COUNT (BYTE)
	MOVB	F.MBFG(R0),(R3)+	; MULTIPLE BUFFER FLAG (BYTE)
					;

	.SBTTL	PROCESS ERRORS AND RETURN TO CALLER
;
;
					;
SUC:	CLR	R4			; SUCCESS
	BR	RTN			;
IEILU:	MOV	#IE.ILU,R4		; INVALID LUN
	BR	RTN			;
IENLN:	MOV	#IE.NLN,R4		; LUN NOT OPENED
					;
					;
RTN:	CMPB	#3,@R5			; THREE ARGUMENTS?
	BNE	2$			; NO, RETURN TO CALLER
	TST	6(R5)			; NULL ARGUMENT?
	BLT	2$			; YES, RETURN TO CALLER
	MOV	R4,@6(R5)		; NO, SET STATUS WORD
2$:	RTS	PC			; RETURN TO CALLER
	.END