.TITLE INSOVL
;                                                                       DSC   1
;  COPYRIGHT (C) NOT-AT-ALL---                                          DSC   2
;                                                                       DSC   3
;     THIS SOFTWARE IS FURNISHED BY GROUP WX-1 OF THE LOS ALAMOS        DSC   4
;     SCIENTIFIC LABORATORY, UNIVERSITY OF CALIFORNIA, UNDER CONTRACT   DSC   5
;     TO THE UNITED STATES DEPARTMENT OF ENERGY AND MAY NOT BE COPIED   DSC   6
;     IN WHOLE OR PART WITHOUT THE INCLUSION OF THIS NOTICE.  THIS      DSC   7
;     SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY BE PROVIDED OR         DSC   8
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  TITLE TO AND       DSC   9
;     OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN THE        DSC  10
;     PUBLIC DOMAIN.                                                    DSC  11
;                                                                       DSC  12
;     THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT     DSC  13
;     NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY THE         DSC  14
;     AUTHOR, THE UNIVERSITY OF CALIFORNIA, THE DEPARTMENT OF ENERGY,   DSC  15
;     OR ANY FEDERAL OR NON-FEDERAL GOVERNMENT.  IT IS UNDERSTOOD THAT  DSC  16
;     THE DIGITAL EQUIPMENT CORPORATION CAN NOT BE BLAMED EITHER.       DSC  17
;                                                                       DSC  18
;     THE AUTHOR ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY   DSC  19
;     OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY SOMEONE.    DSC  20
;                                                                       DSC  21
;     IF USERS FIND THEMSELVES IN DEEP TROUBLE, HELP MAY OR MAY NOT     DSC  22
;     BE OBTAINED THRU THE LASL WX-1 PROGRAMMING STAFF.                 DSC  23
;     BURT K. DAVIS       505-667-2863 OR                               DSC  22
;     O. KENT OLMSTEAD    505-667-2671.                                 DSC  24
;                                                                       DSC  25
;
; NAME: INSOVL (INSTALL OVERLAY)
; AUTHOR: O.K.OLMSTEAD
; DATE: 6/12/78
;	MODIFIED 9/78 BY OKO FOR GERERAL CLEAN UP AND CORRECT GOBN BUG.
; FUNCTION: CONTROLLEE TO REPLACE OVERLAYS IN A TARGET TASK IMAGE
; DISCUSSION:
;	DEC'S TASK BUILDER WILL NOT HANDLE COLOSSAL SIZED PROGRAMS HAVING
;	 MANY THOUSANDS OF SYMBOLS.  THIS PROGRAM GETS AROUND THIS PROBLEM.
;     ALSO , IT ALLOWS FOR SELECTIVE UPDATING OF INDIVIDUAL
;     OVERLAYS WITHOUT REQUIRING A COMPLETE TASK REBUILD.
;
;     THE GENERAL PLAN IS:
;
;     1.   TKB A TASK IMAGE USING DUMMY OVERLAYS TO
;          GET THE SEGMENT DESCRIPTOR ENTRIES FOR EACH OVERLAY
;          SET UP BY TKB IN THE ROOT AND RESERVE TASK OVERLAY IMAGE SPACE.
;
;     2.   BUILD EACH OVERLAY SEPARATELY WITH THE ROOT TO GET THE OVERLAY IMAGE.
;
;     3.   THE LAST AND MOST DIFFICULT STEP (WHICH THIS PROGRAM
;          PERFORMS) IS TO TAKE THE REAL OVERLAY IMAGE CREATED
;          IN STEP 2 AND MODIFY THE TARGET TASK IMAGE CREATED IN
;          STEP 1 BY REPLACING THE DUMMY OVERLAY IMAGE.
;
; COMMENTS:
;     THIS APPROACH SEEMS REASONABLE BECAUSE EACH OVERLAY BEGINS
;     ON A BLOCK BOUNDRY ON DISK.  THERE ARE POINTERS TO THE
;     OVERLAY IMPURE STORAGE AREA IN THE TASK HEADER WHICH GIVE
;     ACCESS TO THE NECESSARY POINTERS IN THE SEGMENT DESCRIPTORS
;     WHICH GIVE THE DISK ADDRESS OF THE OVERLAYS.
;
; ASSUMPTIONS:
;     1.   DUMMY OVERLAYS HAVE A DIMENSIONED ARRAY BIG ENOUGH
;          TO RESERVE ENOUGH DISK BLOCKS FOR INPLACE REPLACEMENT.
;          IN THE INTEREST OF SIMPLICITY IN THIS PROGRAM WE DON'T
;          WANT TO WORRY ABOUT OVERLAY IMAGES THAT ARE BIGGER THAN
;          EXISTING ALLOCATED DISK SPACE AND THE ATTENDENT POINTER
;          FIX-UP PROBLEMS (THIS IS A NICE FUTURE ENHANCEMENT).
;     2.   THE REAL OVERLAY IS THE FIRST OVERLAY IN THE SOURCE IMAGE.
;     3.   THE REAL  OVERLAY MUST BE BUILT ALONG WITH THE
;          TARGET ROOT AND THE SAME NUMBER OF OVERLAYS (THE
;          EXTRAS CAN BE DUMMYS) JUST TO KEEP THE LOAD ADDRESS
;          THE SAME.  (SAME NUMBER OF OVERLAYS ARE REQUIRED TO
;          GENERATE THE SAME NUMBER OF AUTO LOAD VECTORS IN THE
;	   ROOT.)
;
; INPUT:
;     PARAMETER LIST FROM CONTROLLER (IE. A FORTRAN PROGRAM)
;     1.   NUMBER OF PARAMETERS (DEFAULT FROM FORTRAN)
;     2.   OVERLAY NUMBER IN TARGET FILE(STARTING AT 0)
;     3.   RAD50 OF SOURCE TASK FILE NAME
;     4.   RAD50 OF TARGET FILE NAME
;     5.   RETURN STATUS
;     SOURCE FILE 
;     TARGET FILE 
;
; OUTPUT:
;     STATUS OF OPERATION IN PARAMETER LIST.
;	1 - SUCCESSFUL COPY
;	2 - SOURCE.TSK OPEN FAILURE
;	3 - TARGET.TSK OPEN FAILURE
;	4 - LOST - NOT AT TARGET ROOT SEGMENT DESCRIPTOR
;	5 - READ$ ERROR
;	6 - SOURCE OVERLAY IS TOO LONG FOR RESERVED SPACE IN TARGET IMAGE.
;	7 - 
;	8 - ROOT LENGTHS DO NOT MATCH
;	9 - READ ERROR DURING COPY
;	10 - WRITE ERROR DURING COPY
;	11 - LOST - NOT AT SOURCE $$ALVC
;	12 - LOST - NOT AT TARGET $$ALVC
;	13 - WRITE$ ERROR WHILE WRITING ALV
;	14 - SOURCE ROOT NOT IN  SAME VBN AS TARGET
;
;
; DESIGN:
;
;	OPEN SOURCE.TSK FOR BLOCK I/O
;	OPEN TARGET.TSK FOR BLOCK I/O
;	READ TARGET LABEL BLOCK
;	GET HEADER BLOCK #
;	READ TARGET  HEADER BLOCK
;	GET ADDRESS OF IMPURE OVERLAY AREA
;	READ TARGET IMPURE OVERLAY AREA BLOCK
;	GET ADDRESS OF SEGMENT DESCRIPTORS
;	GET ADDRESS OF $$ALVC
;	READ TARGET SEGMENT DESCRIPTOR BLOCK
;	IF TARGET.SGD(ROOT) .NE. 120000
;		THEN STOP *NOT AT TARGET ROOT*
;	READ SOURCE SEGMENT DESCRIPTOR BLOCK
;	IF SRD.SGD(ROOT) .NE. 120000
;		THEN STOP *NOT AT SORUCE ROOT*
;	IF SRC.SGD(ROOT).LENGTH > TARGET.SGD(ROOT).LENGTH
;		THEN STOP --*ROOTS NOT THE SAME*
;	IF SRC.SGD(1).LENGTH > TARGET.SGD(OVERLAY#).LENGTH
;		THEN STOP --*OVERLAY WON'T FIT*
;	IBN := SRC.SGD(1).BLKNUMBER
;	OBN := TARGET.SGD(OVERLAY#).BLKNUMBER
;	ADJUST OBN FOR 4K BLOCK LIMITS
;	#BLK := SRC.SGD(1).LENGTH / 1000 OCTAL
;	FOR I = 0 TO #BLK DO
;		READ SRC.TSK(IBN + I)
;		WRITE TARGET.TSK(OBN + I)
;	OD
;	READ SRC.ALV BLOCK
;	IF SRC.ALV(1) .NE. 4737
;		THEN STOP *NOT AT $$ALVC*
;	READ TARGET.ALV BLOCK
;	IF TARGET.ALV(OVERLAY#) .NE. 4737
;		THEN STOP *NOT AT TARGET $$ALVC*
;	TARGET.ALV(OVERLAY#) := SRC.ALV(1)
;	WRITE TARGET.ALV BLOCK
;	ENDPROG
	.PAGE
	.SBTTL VARIABLE DEFINITION
;
;************************************************************
;************************************************************
;	D E F I N E  F O R  A P P R O P R I A T E  S Y S T E M
RSX11M	= 0	;RSX11M SYSTEMS
;IAS	= 0	;IAS/RSX11D SYSTEMS
;
;************************************************************
;************************************************************
	.PSECT	
	.MCALL FDBDF$,FDBK$A,FDRC$A,FDOP$A,NMBLK$,FSRSZ$
	.MCALL OPEN$M,OPEN$R,READ$,WRITE$,CLOSE$,WTSE$C
	.MCALL NBOF$L,LBLDF$,HDRDF$
;
	LBLDF$
	HDRDF$
;
;
TARLUN	= 3	;TARGET LUN #
TARFLG	= 3	;TARGET EVENT FLAG
SRCFLG	= 4	;SOURCE EVENT FLAG
SRCLUN	= 4	;SOURCE LUN #
;
; STATUS RETURN VALUES
OK	= 1	;COPY OK
SRCOF	= 2	;SOURCE OPEN FAILURE
TAROF	= 3	;TARGET OPEN FAILURE
NOROOT	= 4	;NOT AT ROOT BLOCK
RDERR	= 5	;READ$ ERROR
LNGERR	= 6	;NEW OVERLAY TOO LONG FOR TARGET
ADRERR	= 7
RTERR	= 8.	;ROOT LENGTHS DO NOT MATCH
RCPYER	= 9.	;READ COPY ERROR
WCPYER	= 10.	;WRITE COPY ERROR
LSALV	= 11.	;LOST SOURCE ALV
LTALV	= 12.	;LOST TARGET ALV
WALVE	= 13.	;ERR WHILE WRITING ALV
NOSRCR	= 14.	;NO SOURCE ROOT
;
; OFFSETS INTO INFO TABLE
;
TBLLEN	= 4		;LENGTH OF INFO TABLE
;
XFADR	= 0		;BUF ADRS OF ALV TRANSFER ADRS
OVLBN	= 2		;ABS BLK # OF OVERLAY (2 WORDS)
LENADR	= 6		;OFFSET TO LENGTH FIELD IN BUFFER
;
; OFFSETS INTO SEGMENT DESCRIPTOR
RBN	= 0		;REL BLK # IN BITS 0-11
LADR	= 2		;LOAD ADDRESS
LEN	= 4		;LENGTH OF OVERLAY IN BYTES
LNKUP	= 6		;LINK UP
LNKDN	= 10		;LINK DOWN
LNKNXT	= 12		;LINK NEXT
;
; OFFSETS INTO PARAMETER LIST
;
OVLNO	= 2		;OVERLAY NUMBER
SRCFIL	= 4		;RAD50 OF SOURCE FILE NAME
TARFIL	= 6		;RAD50 OF TARGET FILE NAME
RTNSTS	= 10		;RETURN STATUS
;
VBN:	.WORD	0,0	;HOLDS VIRTUAL BLOCK # TO BE READ
HDRBLK:	.WORD	0	;ABS BLK # OF HEADER
OVLOS:	.WORD	0	;OFFSET TO IMPURE OVERLAY AREA
RSGD:	.WORD	0	;ADRS OF ROOT SEG DESCRIPTOR
RTOS:	.WORD	0	;OFFSET INTO BUFFER TO ROOT SGD
ALV:	.WORD	0	;ADRS OF ALV ($$ALVC)
ALVOS:	.WORD	0	;OFFSET INTO BUFFER TO ALV
ALVBN:	.WORD	0	;BLOCK # OF ALV
MATBF:	.WORD	0	;FLAG FOR MATB IF NEW BLOCK READ IN
TARLEN:	.WORD	0	;TEMP TO HOLD ADRS OF ROOT LEN FIELD
	.IFDF	IAS
VAOS:	.WORD	0	;TEMP TO HOLD OFFSET TO VIRT ADRS 0
	.ENDC
;
;
;************************************************************
;************************************************************
; OVERLAY # OF THE TRANSITIONS PAST 4K LIMIT
;	THESE MAY BE MODIFIED BY GBLPAT IN TKB
;
BOUND1:: .WORD	54.
BOUND2:: .WORD	109.
BOUND3:: .WORD	198.
;
; NOTE:	THREE BOUNDS ARE SUFFICIENT TO COVER ABOUT 200 OVERLAYS OF
;	18K WORDS EACH.
;
;************************************************************
;************************************************************
	.PAGE
	.SBTTL FDB DEFINITIONS
TARFDB: 	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	TARBLK,1000,,TARFLG,TARSTS
	FDOP$A	TARLUN,,TARFNB
;************************************************************
TARFNB:	NMBLK$	TARGET,TSK,,SY,0
;************************************************************
TARSTS:	.WORD	0,0		;STATUS BLOCK
TARTBL:	.BLKW	TBLLEN		;TARGET INFO TABLE
TARBLK:	.BLKB	1000
;
;
SRCFDB:	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	SRCBLK,1000,,SRCFLG,SRCSTS
	FDOP$A	SRCLUN,,SRCFNB
;***********************************************************
SRCFNB:	NMBLK$	SRC,TSK,,SY,0
;***********************************************************
SRCSTS:	.WORD	0,0
SRCTBL:	.BLKW	TBLLEN
SRCBLK:	.BLKB	1000
	.PAGE
	.SBTTL MAIN PROGRAM
;
;
; START OF EXECUTABLE CODE
;
;
;
INSOVL::
	MOV	TARFIL(R5),R1
	MOV	(R1)+,TARFNB+N.FNAM	;SET PROPER TARGET FILE NAME
	MOV	(R1),TARFNB+N.FNAM+2
	MOV	SRCFIL(R5),R1
	MOV	(R1)+,SRCFNB + N.FNAM	;SET PROPER SOURCE FILE NAME
	MOV	(R1),SRCFNB + N.FNAM + 2
;
	OPEN$R	#SRCFDB		;OPEN SOURCE.TSK READ ONLY
	BCC	1$
	MOV	#SRCOF,@RTNSTS(R5)	;ERR
	RETURN
1$:	OPEN$M	#TARFDB		;OPEN TARGET.TSK FOR MODIFY
	BCC	2$
	MOV	#TAROF,@RTNSTS(R5)	; ERR
	RETURN
2$:
;
; FIND SEGMENT DESCRIPTOR ENTRY
	MOV	#TARFDB,R0
	MOV	#TARBLK,R3
	MOV	R3,F.BKDS+2(R0)	;RESTORE BUF ADRS IF NOT FIRST PASS
	MOV	#1,VBN+2	;BLK # OF LABEL BLOCK
	CLR	R1
	CALL	RDBLK		;READ LABEL BLOCK
;
	MOV	L$BHRB(R3),R2	;REL BLOCK # OF HEADER
	.IFDF	RSX11M
	INC	R2		;ADD ONE FOR 11M RELATIVE BLOCK COUNT
	.ENDC
	MOV	R2,VBN+2
	MOV	R2,HDRBLK	;SAVE IN INFO TABLE
	CALL	RDBLK		;READ HEADER BLOCK
;
	.IFDF	IAS
;	COMPUTE ADRS OF VIRT ADRS 0
	CLR	R4
15$:	ADD	#64.,R4		;32 WORDS PER BLOCK
	DEC	HDRSIZ(R3)
	BNE	15$
	MOV	R4,VAOS		;SAVE VIRT ADRS OFFSET
	ADD	R4,R3		;R3 POINTS TO VIR ADRS 0
	MOV	N.OVT(R3),R4	;GET ADRS OF IMPURE OVERLAY AREA
	.ENDC
	.IFDF	RSX11M
	MOV	H.OVLY(R3),R4	;GET ADRS OF IMPURE OVERLAY AREA
	.ENDC
	CALL	ADTBN		;CONVERT ADDRESS TO BLK # AND OFFSET
	MOV	R2,VBN+2
	CALL	RDBLK		;READ INPURE OVERLAY AREA
;
	MOV	R4,OVLOS	;SAVE OFFSET
	MOV	#2,R2		;OFFSET FROM PSECT TO ADRS OF SGD
	CALL	MATB
	MOV	(R4),RSGD	;SAVE IN INFO TABLE
	MOV	OVLOS,R4	;OFFSET TO IMPURE OVERLAY AREA PSECT
	MOV	#8.,R2		;OFFSET FROM PSECT TO ADRS WANTED
	TST	MATBF		;JIF LAST MATB DID NOT READ IN A BLOCK
	BEQ	20$		;DON'T NEED TO LOOP, JUST ONE BLOCK
	SUB	#1000,R4	;ALLOW FOR ONE BUFFER
	ADD	R2,R4		;ADJUST OFFSET FROM PSECT
	BR	21$
20$:	CALL	MATB
21$:	MOV	(R4),ALV
	ADD	#20.,ALV	;SAVE ADRS OF $$ALVC
	MOV	RSGD,R4
	CALL	ADTBN
	MOV	R2,VBN+2
	CALL	RDBLK		;READ BLOCK W/ ROOT SGD
;

	MOV	R4,RTOS
	MOV	#TARBLK,R3
	ADD	R4,R3		;R3 IS FWA OF ROOT SGD
	CMP	(R3),#120000	;CK TO BE SURE IT IS ROOT SGD
	BEQ	6$
	MOV	#NOROOT,@RTNSTS(R5)
	RETURN
6$:	MOV	#LEN,R2		;OFFSET FOO SGD PSECT
	CALL	MATB
	MOV	R4,TARLEN	;SAVE ADRS OF TARGET LEN
;
; NOW READ IN SOURCE SEGMENT DESCRIPTOR. 
; IT HAD BETTER BE AT THE SAME VBN #
; ELSE  THE TWO FILES DO NOT HAVE THE SAME ROOT
;
	MOV	#SRCFDB,R0
	CALL	RDBLK		;READ SOURCE SGD BLOCK
	MOV	#SRCBLK,R1
	ADD	RTOS,R1		;MAKE ADRS OF ROOT SGD
	CMP	(R1),#120000	;MAKE SURE WE'RE AT ROOT
	BEQ	3$
	MOV	#NOSRCR,@RTNSTS(R5)
	RETURN
3$:
	MOV	#LEN,R2		;OFFSET FROM SGD PSECT
	MOV	RTOS,R4		;OFFSET TO PSECT
	CALL	MATB
	CMP	@TARLEN,(R4)	;COMPARE TARGET ROOT LENGTH TO SOURCE LENGTH
	BEQ	4$
	MOV	#RTERR,@RTNSTS(R5)	;ROOTS ARE NOT THE SAME
	RETURN
;
4$:
	MOV	#SRCTBL,R1
	MOV	#SRCFDB,R0
;************************************************************
	CLR	R2		;ASSUME REAL OVERLAY IS FIRST
;*************************************************************
	CALL	GOBN		;GET BLK # OF SOURCE OVERLAY
	MOV	#TARTBL,R1
	MOV	#TARFDB,R0
	MOV	@OVLNO(R5),R2
	CALL	GOBN		;GET BLK # OF DUMMY OVERLAY
;
; CORRECT FOR 4K BLOCK LIMIT IN TKB TASK IMAGE
	MOV	@OVLNO(R5),R2
	CMP	R2,BOUND1
	BLT	45$
	ADD	#10000,TARTBL+OVLBN+2
	CMP	R2,BOUND2
	BLT	45$
	ADD	#10000,TARTBL+OVLBN+2
	CMP	R2,BOUND3
	BLT	45$
	ADD	#10000,TARTBL+OVLBN+2
;***********************************************************
;	ADD ADDITIONAL BOUND CHECKS HERE IF NECESSARY
;	THESE COVER ABOUT 200 OVERLAYS AT 18K WORDS EACH
;***********************************************************
45$:
;
	CMP	@TARTBL+LENADR,@SRCTBL+LENADR ;COMPARE OVERLAY LENGTHS
	BHIS	5$
	MOV	#LNGERR,@RTNSTS(R5)
	RETURN
5$:
	MOV	@SRCTBL+LENADR,R2	;LENGTH OK
; COMPUTE # OF BLKS TO COPY
	SWAB	R2		;DIVIDE BY 1000 BYTES/BLOCK
	BIC	#177400,R2
	ASR	R2
	INC	R2		;ADJUST FOR COUNT STARTING AT 0
;
; COPY BLOCK FROM REAL OVERLAY TO TARGET OVERLAY
CPY:	READ$	#SRCFDB,#SRCBLK,,#SRCTBL+OVLBN,#SRCFLG
	BCC	7$
	MOV	#RCPYER,@RTNSTS(R5)
	RETURN
7$:
	WTSE$C	SRCFLG
	WRITE$	#TARFDB,#SRCBLK,,#TARTBL+OVLBN,#TARFLG
	BCC	8$
	MOV	#WCPYER,@RTNSTS(R5)
	RETURN
8$:
	INC	SRCTBL+OVLBN+2
	WTSE$C	TARFLG
	INC 	TARTBL+OVLBN+2
	DEC	R2
	BEQ	9$
	JMP	CPY
9$:
; NOW FIX XFER ADRS IN TARGET ALV
	MOV	#TARBLK,TARFDB+F.BKDS+2
;
	MOV	ALV,R4
	CALL	ADTBN
	MOV	R4,ALVOS	;SAVE ALV OFFSET
	MOV	R2,ALVBN	;SAVE ALV VBN
	MOV	R2,VBN+2
;
	MOV	#SRCFDB,R0
	CLR	R1		;FLAG FOR RDBLK
	CALL	RDBLK
	MOV	#SRCBLK,R3
	ADD	ALVOS,R3
	CMP	#4737,(R3)	;SHOULD BE A JSR PC,$AUTO
	BEQ	10$
	MOV	#LSALV,@RTNSTS(R5)
	RETURN
10$:
	MOV	#SRCTBL,R1
;***********************************************************
	CLR	R2		;ASSUME FIRST OVERLAY
;***********************************************************
	CALL	FIXTFA		;SET UP ADRS OF ALV IN BUFFER
	MOV	ALVBN,VBN+2	;RESTORE INCASE IT WAS ALTERED
;
	MOV	#TARFDB,R0
	CLR	R1
	CALL	RDBLK
	MOV	#TARBLK,R3
	ADD	ALVOS,R3
	CMP	#4737,(R3)
	BEQ	12$
	MOV	#LTALV,@RTNSTS(R5)
	RETURN
12$:
	MOV	#TARTBL,R1
	MOV	@OVLNO(R5),R2
	CALL	FIXTFA
;
; NOW MAKE THE CHANGE
	MOV	@SRCTBL+XFADR,@TARTBL+XFADR ;CHANGE XFER ADRS IN TARGET ALV
	WRITE$	R0,,,#VBN,#TARFLG
	BCC	13$
	MOV	#WALVE,@RTNSTS(R5)
	RETURN
13$:	WTSE$C	TARFLG
	MOV	#OK,@RTNSTS(R5)
	CLOSE$	#SRCFDB
	CLOSE$	#TARFDB
	RETURN
	.PAGE
	.SBTTL RDBLK
;
; INPUT:
;	R0 = FDB ADRS
;	R1 NE 0 IF CALLED BY MATB
;
RDBLK:
	READ$	R0,,,#VBN,#TARFLG,,,ERR
	WTSE$C	TARFLG
	RETURN
;
ERR:	TST	(SP)+		;POP RTN TO RDBLK
	TST	(SP)+		;POP RTN TO CALLER
	TST	R1
	BEQ	1$
	TST	(SP)+		;POP RTN TO MATB
1$:
	MOV	#RDERR,@RTNSTS(R5)
	RETURN			;RETURN TO FORTRAN
	.PAGE
	.SBTTL ADTBN
;
; FUNCTION: CONVERT ADDRESS TO BLOCK NUMBER AND OFFSET WITHIN THE BLOCK
; INPUT:
;	R4 = ADDRESS
; OUTPUT:
;	R2 = VBN
;	R4 = OFFSET
;
ADTBN:
	MOV	R4,R2
	BIC	#177000,R4
	SWAB	R2
	BIC	#177600,R2
	ASR	R2
	ADD	HDRBLK,R2	;MAKE ABS VBN
	.IFDF	IAS
	ADD	VAOS,R4		;ADJUST TO VIRT ADRS 0
	BIT	#1000,R4	;DID WE CROSS A BUFFER BOUNDARY?
	BEQ	1$
	INC	R2
	BIC	#1000,R4
1$:
	.ENDC
	RETURN
	.PAGE
	.SBTTL GOBN
;
; FUNCTION: GET OVERLAY BLOCK NUMBER
; INPUT:
;	R0 = FDB
;	R1 = INFO TBL
;	R2 = OVERLAY #
; OUTPUT:
;	BLOCK # IN INFO TBL
;	DATA BUFFER OVERWRITTEN
;
; DESCRIPTION:
;	ASSUME OVERLAY # IS GOOD.  RATHER THAN FOLLOW THE LINKAGE,
;	WE CALCULATE THE OFFSET FROM ROOT SEGMENT DESCRIPTOR
;
GOBN:
	INC	R2		;ALLOW FOR ROOT SGD
	MUL	#12.,R2		;SKIP 6 WORDS PER SGD- DBL PREC, ANS IN R3
	MOV	RTOS,R4
	MOV	R3,R2		;OFFSET FROM ROOT SGD
	CALL	MATB		;MAP ADRS TO BLOCK
	MOV	(R4),R2
	BIC	#170000,R2	;CLEAR OUT STATUS FIELD
	ADD	HDRBLK,R2	;ADD HDR OFFSET
	MOV	R2,OVLBN+2(R1)	;SAVE IN INFO TABLE
	SUB	R1,R4		;CONVERT BACK TO AN OFFSET
	SUB	#TBLLEN*2,R4
	MOV	#LEN,R2		;OFFSET FROM PSECT
	CALL	MATB		;MAP TO LEN FIELD IN SGD
	MOV	R4,LENADR(R1)	;SAVE ADRS OF LEN FIELD
	RETURN
	.PAGE
	.SBTTL MATB
; FUNCTION: MAP ADDRESS TO PHYSICAL BUFFER
; INPUT:
;	R0 = FDB
;	R2 = OFFSET FROM PSECT
;	R4 = OFFSET TO PSECT
;	VBN = CURRENT VBN OF PSECT
; OUTPUT:
;	BUFFER HOLDS BLOCK CONTAINING THE ELEMENT IDENTIFIED BY ADRS
;	R4 = BUFFER ADRS OF ELEMENT
; DESCRIPTION:
;	IF SUM OF OFFSETS IS BEYOND BUFFER BOUNDARY, READ IN NEXT BLOCK
;	REPEAT UNTIL OFFSETS ARE WITHIN BUFFER BOUNDARY
;
MATB:
	CLR	MATBF		;CLEAR BLOCK READ FLAG
	MOV	F.BKDS+2(R0),R3	;ADRS OF DATA BUFFER
	ADD	R3,R4
	ADD	R2,R4		;ADRS OF OBJECT IN BUFFER
	MOV	R3,-(SP)	;SAVE TEMPORARILY
	ADD	#1000,R3	;ADRS OF END OB BUFFER
1$:	MOV	R4,R2
	SUB	R3,R2		;SEE IF IN THIS BUFFER
	BLT	2$		;JIF YES
	MOV	R1,SAV
	MOV	#1,R1		;FLAG FOR RDBLK
	INC	VBN+2		;NO, SO READ NEXT BLOCK
	CALL	RDBLK
	INC	MATBF		;SET FLAG THAT BLOCK WAS READ
	MOV	SAV,R1
	MOV	R2,R4		;R2 IS THE OFFSET INTO NEW BUFFER
	ADD	(SP),R4		;ADRS OF OBJECT IN BUFFER
	BR	1$		;REPEAT
2$:
	TST	(SP)+		;POP ADRS OF BUFFER
	RETURN
SAV:	.WORD	0
	.PAGE
	.SBTTL FIXTFA
; FUNCTION: SET UP BUFFER WITH BLOCK CONTAINING ALV
; INPUT:
;	R0 = FDB
;	R1 = INFO TBL
;	R2 = OVERLAY #
; OUTPUT:
;	XFADR IN TBL SET TO ADRS OF ALV
;	BUFFER HAS CORRECT DATA BLOCK
;
FIXTFA:
	MUL	#8.,R2		;SKIP 4 WORDS PER ALV
	MOV	R3,R2
	ADD	#6,R2		;MOV TO TRANSFER ADRS IN ALV
	MOV	ALVOS,R4
	CALL	MATB
;
	MOV	R4,XFADR(R1)	;R4 POINTS TO ALV XFER ADRS
	RETURN
	.END