.TITLE	GETVIR
	.IDENT	/V03.1/
;
;+
;
;  GETVIR -- (Map and) Return the virtual address of a Virtual Array Element
;
;  Authors:	Joanne Vinton & Larry Baker
;  Modified by: Tim MacDonald, Howard Bundock, & Gary Maxwell
;
;  Contact:	U.S. Geological Survey
;		National Strong Motion Data Center
;		345 Middlefield Road, Mailstop 977
;		Menlo Park, California  94025
;
;
;  Usage:	iadr = GETVIR(array,index,kbytes,ierr,ifrc)
;
;  Inputs:	array	Virtual array name; DO NOT subscript!
;		index	The element of the array to access
;		ifrc	(optional) if present and non-zero, a remap of
;			  the virtual array is forced (see following notes)
;
;  Outputs:	iadr	Virtual address of the requested element
;		kbytes	The number of bytes per array element
;		ierr	Returned status:
;			  if zero, call was successful
;			  if non-zero, bad parameters, invalid index, etc.
;
;  For additional information on Fortran OTS handling of Virtual Arrays,
;  see the Fortran Object Time System manual. When a virtual array is 
;  passed to the OTS handler, the address of its ADB (Array Descriptor Block)
;  is passed.
;
;  Typical usage for performing disk I/O into a virtual array:
;
;	integer iparam(6)
;	virtual array(10000)
;  c
;	iparam(1) = GETVIR(array,1,kbytes,ierr)		! Map and get address
;	if (ierr .ne. 0) Stop 'GETVIR error'
;	iparam(2) = 512					! Read 512 bytes
;	iparam(4) = ivbnhi				! Virtual block number
;	iparam(5) = ivbnlo
;	Call WTQIO(IORVB,lun,iefn,,iosb,iparam,ierr)	! Issue request
;
;
;  Important Notes!
;
;	Only the element specified in the argument list is guaranteed to be 
;	mapped.	If the OTS finds the element to be already mapped, no other 
;	action is taken, except to return the virtual address of the element.
;	The significance of this is that if I/O operations are to be done
;	directly into the virtual array, the user must be certain that
;	the entire I/O buffer is mapped, or the QIO will fail.
;
;	When remapping is necessary, the OTS will map the window at the
;	32 word boundary that is just under or equal to the element requested
;	(e.g., optimized for ascending access).
;
;	If your program cannot guarantee that the entire buffer that is required
;	will be mapped, use the "ifrc" argument and set it to a non-zero value.
;
;       For most applications, disk reads and writes will be used. In this case,
;	512 bytes are transfered at a time. Since the virtual array window is
;	a multiple of this (4K words), it is usually sufficient to map the
;	first element of the array, and then allow remapping to occur as 
;	required when the 4K word boundary is crossed. If you design your 
;	application carefully, you should only require the "ifrc" argument 
;	once (if at all!), when the first QIO is to be performed. "ifrc" 
;	is really only required when you will be performing I/O into random 
;	sections of the virtual array.
;
;-
;

;
; NOTE: The following offset into the OTS impure work area may change with a
;	future release of Fortran-77. This offset is valid for F77 V5.0.
;

W.WNHI	=	304		; Offset to Virtual Array high map address

	.PSECT	GETVIR,RO,D
;
VRTTBL:	.WORD	VRTBC$		; Entry points for array mapping
	.WORD	VRTLC$
	.WORD	VRTMC$
	.WORD	VRTIC$
	.WORD	VRTJC$
	.WORD	VRTRC$
	.WORD	VRTDC$
	.WORD	VRTCC$
;
BYTTBL:	.WORD	1		; Element size return value array
	.WORD	2
	.WORD	4
	.WORD	2
	.WORD	4
	.WORD	4
	.WORD	10
	.WORD	10

	.PSECT	CODE,I,RO

GETVIR::
	MOV	2(R5),-(SP)	;PUSH ADB ADDRESS FOR CALL TO VRTxC$
	MOV	@4(R5),R0	;INDEX INTO VIRTUAL ARRAY, FOR CALL TO VRTxC$
	MOV	#1,@10(R5)	;ASSUME ERROR

	CMPB	(R5),#5		;IS THERE A FORCE ARGUMENT?
	BLT	10$		;IF LT NO
	CMP	12(R5),#-1	;IS THE ARGUMENT SPECIFIED?
	BEQ	10$		;IF EQ -1 NO
	TST	@12(R5)		;FORCE A REMAP OF THE ARRAY?
	BEQ	10$		;IF EQ NO
	MOV	@#$OTSV,R3	;GET POINTER TO THE WORK AREA
	CLR	W.WNHI(R3)	;FORCE REMAP OF VIRTUAL ARRAY

10$:	MOV	(SP),R1		;GET ADDRESS OF ADB
	MOV	4(R1),R1	;GET A.CWRD--CONTAINS THE DATA TYPE
	BIC	#103777,R1	;MASK OUT FLAG, NO. OF DIMENSIONS & ELEMENT
				; SIZE
	ASH	#-11.,R1	;DATA TYPE IS IN BITS 11-14
	DEC	R1		;CHANGE INTEGER 1-8 TO 0-7 FOR USE AS AN OFFSET
	BLT	RET		;IF LT 0, ERROR
	CMP	#7.,R1		;IS R1 > 7?
	BLT	RET		;IF LT, YES
	ASL	R1		;CHANGE TO BYTES

	CALL	@VRTTBL(R1)	;CALL THE MAPPING ROUTINE--
				;THE VIRTUAL ADDRESS IS RETURNED IN R0
	MOV	BYTTBL(R1),@6(R5) ;RETURN THE NUMBER OF BYTES PER ELEMENT
	CLR	@10(R5)		;INDICATE SUCCESS

RET:	RETURN

	.END