.TITLE	ULBIO
;
;   SUPPORT FOR FORTRAN ACCESS TO A UNIVERSAL LIBRARY;
;   SUPPORT FOR .MARK AND .POINT FOR FORTRAN.
;
; FORTRAN-CALLABLE ROUTINE TO ISSUE A $ULA CALL.
;
; THE UNIVERSAL LIBRARY FILE MUST BE OPENED FIRST, READ-ONLY.
;
; INTEGER ULBOPN,ULBCLS
; IRET = ULBOPN(LUN,MODULE-NAME,BUFFER)
;
;      LUN IS AN INTEGER, LOGICAL UNIT NUMBER
;      MODULE-NAME IS A TWO-WORD RAD50 MODULE NAME
;            (CALL RAD50 (#_CHARACTERS, ASCII-NAME, MODULE-NAME))
;      BUFFER IS A 7-WORD BUFFER FOR STORING THE FIRST 7 WORDS OF THE FDB
;      IRET IS RETURN CODE: SHOULD BE +
;
; SUBSEQUENT READS TO THE LUN READ FROM THE MODULE.
;
; IRET = ULBCLS(LUN,BUFFER)
;
;      LUN IS LOGICAL UNIT NUMBER
;      BUFFER IS THE UNALTERED BUFFER FROM THE PREVIOUS CALL OF ULBOPN.
;      IRET IS RETURN CODE
;
; MUST BE CALLED BEFORE CALLING ULBOPN A SECOND TIME OR CLOSING FILE.
;
	.PSECT	ULBIO,RO,I,CON,LCL,REL
ULBOPN::
	MOV	@2(R5),R2		;GET LUN
	MOV	@#$OTSV,R3		;ADDRESS WORK AREA
	CALL	$FCHNL			;FFDB ADDRESS IN R0
	BCS	ERROR
	ADD	#14,R0			;ADDRESS FCS FDB
	MOV	4(R5),R1		;POINT TO RAD50 NAME
	MOV	(R1)+,NAMBUF		;MOVE TO BUFFER
	MOV	@R1,NAMBUF+2
	MOV	#NAMBUF,R1		;POINT TO BUFFER
	MOV	6(R5),R2		;POINT TO BUFFER FOR ORIGINAL FDB
	MOV	#7,R3			;COUNT 7 WORDS
	MOV	R0,R4			;COPY FDB ADDRESS
1$:	MOV	(R4)+,(R2)+		;MOVE
	SOB	R3,1$
	MOV	F.URBD+2(R0),-(SP)	;SAVE BUFFER DESCRIPTOR
	MOV	F.URBD(R0),-(SP)
	MOV	#100,F.URBD(R0)		;PUT SIZE OF NAMBUF-4 IN FDB
	CALL	$ULA			;OPEN THE MODULE
	BCS	FILER2
	MOV	F.VBN+2(R0),BEGBLK	;SAVE STARTING VBN (L.O. ONLY)
	CALL	.MARK			;THIS PECULIAR CODE SEEMS TO BE
	BCS	FILER2			;  NECESSARY IF A SUBSEQUENT READ
	CALL	.POINT			;  IS TO RECOGNIZE THE EOF AND NOT
	BCS	FILER2			;  GO ON READING TO THE END OF BLOCK.
	MOV	F.EFBK(R0),F.HIBK(R0)	;SET HIGHEST VB = EOF BLOCK
	MOV	F.EFBK+2(R0),F.HIBK+2(R0)
	MOV	(SP)+,F.URBD(R0)	;RESTORE BUFFER DESC.
	MOV	(SP)+,F.URBD+2(R0)
	BR	FILERR			;GET RETURN CODE AND RETURN
;
ERROR:	MOV	#-1,R0			;ERROR RETURN
	RETURN
;
FILER2:	ADD	#4,SP			;CLEAN UP STACK
FILERR:	MOVB	F.ERR+1(R0),R1
	MOVB	F.ERR(R0),R0
	RETURN
;
ULBCLS::
	MOV	@2(R5),R2		;GET LUN
	MOV	@#$OTSV,R3		;ADDRESS WORK AREA
	CALL	$FCHNL			;FFDB ADDRESS IN R0
	BCS	ERROR
	ADD	#14,R0			;ADDRESS FCS FDB
	MOV	4(R5),R1		;POINT TO BUFFER TO RESTORE
	MOV	#7,R2			;COUNTER
2$:	MOV	(R1)+,(R0)+		;MOVE 7 WORDS
	SOB	R2,2$
	CLR	R0
	CLR	R1
	RETURN
;
	.PSECT	ULBDAT,RW,D,OVR,GBL,REL
NAMBUF:	.BLKW	42.			;BUFFER FOR NAME AND MODULE HEADER
BEGBLK:	.WORD	0			;FOR STARTING BLOCK
;
;  .POINT, .MARK
;
;  INTEGER FPOINT, FPOSIT
;
;  IRET = FPOSIT(LUN,POSIT)
;
;        LUN IS UNIT NUMBER
;        POSIT IS 2-WORD BUFFER TO RECEIVE CURRENT BLOCK AND BYTE OFFSET
;
;  IRET = FPOINT(LUN,POSIT)
;
;        LUN IS UNIT NUMBER
;        POSIT IS 2-WORD BUFFER CONTAINING BLOCK AND BYTE OFFSET
;
;  IRET = ULBRWD(LUN)
;
;         REWINDS CURRENT LIBRARY MODULE
;
;  IRET = FEOF(LUN)    POSITION FILE TO EOF
;
;
	.PSECT	ULBIO,RO,I,CON,LCL,REL
FPOSIT::
	MOV	@2(R5),R2		;GET LUN
	MOV	@#$OTSV,R3		;ADDRESS WORK AREA
	CALL	$FCHNL			;FFDB ADDRESS IN R0
	BCS	ERROR
	ADD	#14,R0			;ADDRESS FCS FDB
	CALL	.MARK
	BCS	FILERR
	MOV	4(R5),R1		;ADDRESS OUTPUT BUFFER
	MOV	R2,(R1)+		;RETURN L.O. BLOCK NUMBER
	MOV	R3,(R1)+		;RETURN BYTE OFFSET
	CLR	R0
	CLR	R1
	RTS	PC
;
FPOINT::
	MOV	@2(R5),R2		;GET LUN
	MOV	@#$OTSV,R3		;ADDRESS WORK AREA
	CALL	$FCHNL			;FFDB ADDRESS IN R0
	BCS	ERROR
	ADD	#14,R0			;ADDRESS FCS FDB
	MOV	4(R5),R1		;ADDRESS INPUT BUFFER
	MOV	(R1)+,R2		;L.O. BLOCK NUMBER
	MOV	@R1,R3			;BYTE OFFSET
	CLR	R1			;H.O. BLCOK NUMBER
	CALL	.POINT
	BR	FILERR			;GET RETURN CODE
;
ULBRWD::
	MOV	@2(R5),R2		;GET LUN
	MOV	@#$OTSV,R3		;ADDRESS WORK AREA
	CALL	$FCHNL			;FFDB ADDRESS IN R0
	BCS	ERROR
	ADD	#14,R0			;ADDRESS FCS FDB
	MOV	BEGBLK,R2		;L.O. BLOCK NUMBER
	CLR	R3			;BYTE OFFSET
	CLR	R1			;H.O. BLCOK NUMBER
	CALL	.POINT
	BR	FILERR			;GET RETURN CODE
;
FEOF::
	MOV	@2(R5),R2		;GET LUN
	MOV	@#$OTSV,R3		;ADDRESS WORK AREA
	CALL	$FCHNL			;FFDB ADDRESS IN R0
	BCS	ERRORA
	ADD	#14,R0			;ADDRESS FCS FDB
	MOV	F.EFBK(R0),R1		;HIGH ORDER BLOCK NUMBER
	MOV	F.EFBK+2(R0),R2		;LOW
	MOV	F.FFBY(R0),R3		;NEXT BYTE
	CALL	.POINT			;POINT TO EOF
	JMP	FILERR
;
ERRORA:	JMP	ERROR			;BRANCH AID
;
	.END