.TITLE FORTRAN VIRTUAL ARRAY HANDLING
	;         --> VERSION 1.2 <--


; THIS MODULE PROVIDES FORTRAN DISK VIRTUAL ARRAY CAPABILITY
; FOR PDP-11 FORTRAN IV VERSION 2 UNDER RT11.

; EDIT   25-MAY-81
;
; CONVERSION TO RT11 - DELETED VIRSET ROUTINE AND SIMPLIFIED THE .ENTER CALL

; *************************WARNING*************************
;       THIS PROGRAM CONTAINS SELF-MODIFYING CODE
; *********************************************************


; HARVEY WIGGINS AND STEVE JENKINS
; UNIVERSITY OF TEXAS AT DALLAS
; CALLIER CENTER FOR COMMUNICATION DISORDERS
; COMPUTER FACILITY
; 1966 INWOOD ROAD
; DALLAS, TEXAS  75235
; (214) 783-3070

; REVISED 15-FEB-85  PAUL LUSTGRAAF
; ADDED ERROR CHECKING FOR SIZE OF TEMP FILE

	.MCALL	.ENTER, .READW, .WRITW, .PRINT, .EXIT

	.GLOBL	$$VIR,	$VGETQ,	$VGETL,	$VSTOQ,	$VSTOL,	$VGETI
	.GLOBL	$VSTOI,	$VGETF,	$VSTOF,	$VGETD,	$VSTOD
	.NLIST	BEX

NUMBUF=4.	; NUMBER OF 256.-WORD BUFFERS TO ASSEMBLE
		; THIS MODULE IS CODED TO SUPPORT VALUES FOR
		; NUMBUF OF  2, 4, 8, AND 16.


	.PSECT VCOUNT,RW,D,GBL,REL,OVR

; COUNTERS FOR EFFICIENCY EVALUATION

ACCESS:	.BLKW	2		; NUMBER OF ARRAY ACCESSES
				; STORED AS TWO-WORD INTEGER
FAULT:	.BLKW	2		; NUMBER OF BLOCK FAULTS
				; STORED AS TWO-WORD INTEGER

	.PSECT	VIRHND		; DEFAULT PROGRAM PSECT

; DUMMY LABEL FOR GLOBAL RESOLUTION

$$VIR::	.WORD	0.		; THIS GLOBAL IS REFERENCED SOMEWHERE BY THE
				; FORTRAN VIRTUAL ARRAY CODE.  IF OMITTED,
				; AN UNDEFINED GLOBAL ERROR IS GENERATED AT
				; LINK TIME.  IT IS IN THIS MODULE STRICTLY
				; TO RESOLVE THE GLOBAL REFERENCE.
	.PAGE
; LOGICAL (BYTE) OPERATIONS
; ENTRY POINT FOR LOGICAL GET OPERATION
$VGETQ::
$VGETL::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	(SP)+,R3	; POP ARRAY INDEX
	CLR	R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	MOVB	(R1),-(SP)	; PUSH RETURNED VALUE
	MOV	RETURN,-(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT

; ENTRY POINT FOR LOGICAL STORE OPERATION

$VSTOQ::
$VSTOL::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	2.(SP),R3	; READ ARRAY INDEX
	CLR	R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	MOVB	(SP)+,(R1)	; MOVE VALUE FROM STACK TO BUFFER
	MOV	SP,MODTBL(R2)	; MARK THIS BLOCK MODIFIED
	MOV	RETURN,(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT
	.PAGE
; INTEGER (WORD) OPERATIONS
; ENTRY POINT FOR INTEGER GET OPERATION

$VGETI::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	(SP)+,R3	; POP ARRAY INDEX
	MOV	#1,R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	MOV	(R1),-(SP)	; PUSH RETURNED VALUE
	MOV	RETURN,-(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT

; ENTRY POINT FOR INTEGER STORE OPERATION

$VSTOI::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; READ ARRAY BASE PAGE NUMBER
	MOV	2.(SP),R3	; POP ARRAY INDEX
	MOV	#1,R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	MOV	(SP)+,(R1)	; MOVE VALUE FROM STACK TO BUFFER
	MOV	SP,MODTBL(R2)	; MARK THIS BLOCK MODIFIED
	MOV	RETURN,(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT
	.PAGE
; REAL (2-WORD) OPERATIONS
; ENTRY POINT FOR REAL GET OPERATION

$VGETF::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	(SP)+,R3	; POP ARRAY INDEX
	MOV	#2,R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	MOV	(R1)+,-(SP)	; PUSH FIRST WORD
	MOV	(R1),-(SP)	; AND SECOND WORD
	MOV	RETURN,-(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT

; ENTRY POINT FOR REAL STORE OPERATION

$VSTOF::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	4.(SP),R3	; READ ARRAY INDEX
	MOV	#2,R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	ADD	#2.,R1		; MOVE VALUES FROM STACK TO BUFFER 
	MOV	(SP)+,(R1)
	MOV	(SP)+,-(R1)
	MOV	SP,MODTBL(R2)	; MARK THIS BLOCK MODIFIED
	MOV	RETURN,(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT
	.PAGE
; DOUBLE PRECISION AND COMPLEX (4-WORD) OPERATIONS
; ENTRY POINT FOR DOUBLE PRECISION GET OPERATION

$VGETD::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	(SP)+,R3	; POP ARRAY INDEX
	MOV	#3,R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	MOV	(R1)+,-(SP)	; PUSH ALL FOUR WORDS
	MOV	(R1)+,-(SP)	; ONTO STACK
	MOV	(R1)+,-(SP)
	MOV	(R1),-(SP)
	MOV	RETURN,-(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT

; ENTRY POINT FOR DOUBLE PRECISION STORE OPERATION

$VSTOD::JSR	PC,INIT		; INITIALIZE UPON FIRST ENTRY
	MOV	(SP)+,R0	; POP ARRAY BASE PAGE NUMBER
	MOV	8.(SP),R3	; READ ARRAY INDEX
	MOV	#3,R4		; SET SHIFT COUNT FOR BYTE OFFSET CONVERSION
	JSR	PC,BUFMAN	; CALL BUFFER MANAGER
	ADD	#6.,R1		; MOVE VALUES FROM STACK INTO BUFFER
	MOV	(SP)+,(R1)
	MOV	(SP)+,-(R1)
	MOV	(SP)+,-(R1)
	MOV	(SP)+,-(R1)
	MOV	SP,MODTBL(R2)	; MARK THIS BLOCK MODIFIED
	MOV	RETURN,(SP)	; RESTORE RETURN ADDRESS
	RTS	PC		; EXIT
	.PAGE
; ENTRY POINT FOR INITIALIZATION
; (CALLED IMPLICITLY THE FIRST TIME AN ARRAY REFERENCE IS MADE)

; OPEN VIRTUAL ARRAY FILE

INIT:	.ENTER	#AREA,#14.,#DBLK,#0 ; OPEN A FILE ON CHANNEL 14
				    ; WITH NAME 'FORTRA.VIR' AND OPEN CODE 0
				    ; FILE IS JUST "TEMPORARY", HOWEVER
	BCS	ERROR		; BRANCH IF ERROR
	MOV	R0,SIZE		; SAVE THE SIZE OF THE FILE

; RESET ENTRY POINTS NOW THAT FILE IS OPEN

	MOV	#8.,R0		; SET UP LOOP COUNTER FOR 8 ENTRY POINTS
	MOV	#ENTPTS,R1	; PUT ADDRESS OF ENTRY POINT TABLE IN R1
1$:	MOV	(R1)+,R2	; GET ADDRESS OF ENTRY POINT
	MOV	RESET,(R2)+	; PUT IN FIRST WORD OF REPLACEMENT INSTRUCTION
	MOV	RESET+2,(R2)	; AND SECOND WORD
	SOB	R0,1$		; FINISH THE LIST
	SUB	#4,(SP)		; RESET RETURN ADDRESS FOR ENTRY POINT
				; INSTEAD OF FOLLOWING INSTRUCTION
	RTS	PC
DBLK:	.RAD50	/DK FORTRAVIR/
; RESET ENTRY POINTS TABLES
RESET:	MOV	(SP)+,@#RETURN	; REPLACES JUMP AT EACH ENTRY POINT
				; AFTER ARRAY FILE IS OPENED
				; FUNCTION OF THIS INSTRUCTION WHEN IN PLACE
				; IS TO SAVE THE SUBROUTINE RETURN ADDRESS
				; FROM THE STACK UPON ENTRY
ENTPTS:	$VGETL			; LIST OF ENTRY POINTS TO RESET
	$VSTOL			; AFTER OPENING FILE
	$VGETI
	$VSTOI
	$VGETF
	$VSTOF
	$VGETD
	$VSTOD

; ROUTINE FOR I/O ERRORS

ERROR:	.PRINT	#ERRMSG		;TELL OPER
	BR	QUIT

; ROUTINE FOR FILE TOO SMALL ERROR

TOOSML:	.PRINT	#SMLMSG		;TELL OPER
QUIT:	.EXIT			;CRASH IT RIGHT HERE...
ERRMSG:	.ASCIZ	'VIRHND-F-I/O ERROR'
SMLMSG:	.ASCIZ	/VIRHND-F-NOT ENOUGH DISK SPACE FOR VIRTUAL ARRAYS/
	.EVEN
	.PAGE
; BUFFER MANAGER
; CALCULATE DESIRED DISK BLOCK, PUT IN R0
; PUT OFFSET FROM TOP OF BLOCK IN R1

BUFMAN:	MUL	#64.,R0		; CONVERT BASE PAGE TO FULL 22-BIT ADDRESS
	CLR	R2		; MAKE ARRAY ELEMENT INDEX INTO
	ASHC	R4,R2		; A BYTE OFFSET
	ADD	R3,R1		; ADD ARRAY BASE ADDRESS
	ADC	R0		; TO ARRAY ELEMENT OFFSET
	ADD	R2,R0		; IN DOUBLE-PRECISION INTEGER
	DIV	#512.,R0	; DIVIDE BY 512 TO GET BLOCK NUMBER IN R0
				; AND ELEMENT OFFSET IN BLOCK IN R1
	ADD	#1.,ACCESS	; COUNT ACCESS
	ADC	ACCESS+2.	; TWO-WORD INTEGER
	CMP	R0,SIZE		; TEMP FILE LARGE ENOUGH?
	BHIS	TOOSML		;IF NOT, BRANCH
; SCAN RESIDENCY TABLE FOR DESIRED BLOCK
	MOV	#RESTBL,R2	; GET RESIDENCY TABLE
	MOV	#NUMBUF,R3	; GET BUFFER COUNT
1$:	CMP	R0,(R2)+	; DESIRED BLOCK IN BUFFER (R2)?
	BEQ	BLKIN		; YES
	SOB	R3, 1$		; NO, CONTINUE SEARCH
	ADD	#1.,FAULT	; COUNT BLOCK FAULT
	ADC	FAULT+2		; TWO-WORD INTEGER
; SCAN ACCESS TABLE FOR LEAST RECENTLY ACCESSED BUFFER
	MOV	#NUMBUF,R4	; GET BUFFER COUNT
	MOV	#ACCTBL,R2	; GET ACCESS TABLE
	MOV	R2,R3		; DOING COMPARES IN SAME TABLE
2$:	CMP	(R2),(R3)+	; BUFFER R3 LESS RECENTLY ACCESSED?
	BLOS	3$		; NO, CONTINUE
	MOV	R3,R2		; YES, HOLD POINTER
	SUB	#2,R2		; BUT BACK IT UP ONE WORD
3$:	SOB	R4,2$		; KEEP ON SEARCHING
	SUB	#ACCTBL,R2	; CORRECT TO AN INDEX NUMBER
; WRITE CURRENT BUFFER IF MODIFIED, READ DESIRED BLOCK
	MOV	R0,R4		; R0 IS VOLATILE IN FOLLOWING MACRO CALLS
	TST	MODTBL(R2)	; THIS BUFFER MODIFIED?
	BEQ	READ		; NO, OVERLAY IT
WRITE:	.WRITW	#AREA,#14.,BUFTBL(R2),#256.,RESTBL(R2)
				; YES, WRITE IT BACK OUT
	BCS	ERROR		; BRANCH IF ERROR
READ:	.READW	#AREA,#14.,BUFTBL(R2),#256.,R4
				; READ IN REQUESTED BLOCK
	BCS	ERROR		; BRANCH IF ERROR
	MOV	R4,RESTBL(R2)	; UPDATE RESIDENCY WORD
	CLR	MODTBL(R2)	; NEW BLOCK IS UNMODIFIED
	BR	BLKI
	.PAGE
; DESIRED BLOCK IS NOW RESIDENT IN BUFFER (R2)

BLKIN:	SUB	#RESTBL+2,R2	; CORRECT TO BUFFER NUMBER
BLKI:	INC	COUNT		; INCREMENT ACCESS COUNTER
	BNE	2$		; CONTINUE UNLESS COUNTER=0
	MOV	#NUMBUF,R0	; GET BUFFER COUNT
	MOV	#ACCTBL,R3	; SET UP TO CLEAR ACCESS TABLE
1$:	CLR	(R3)+		; SET ENTRY FOR BUFFER (R3) TO 0
	SOB	R0,1$		; CLEAR IT ALL
	INC 	COUNT		; SET COUNT TO 1
2$:	MOV	COUNT,ACCTBL(R2); UPDATE ACCESS COUNT FOR BUFFER (R2)
	ADD	BUFTBL(R2),R1	; GET ELEMENT ADDRESS IN BUFFER
	RTS	PC		; EXIT WITH BUFFER NUMBER IN R2
				; AND BUFFER ADDRESS OF ELEMENT IN R1
	.PAGE
; STORAGE, BUFFERS, AND PAGING TABLES
AREA:	.BLKW	5		; ARGUMENT AREA FOR RT-11 EMT CALLS
RETURN:	.BLKW			; TEMPORARY STORAGE FOR JSR RETURN ADDRESSES
COUNT:	.BLKW			; ACCESS COUNTER
SIZE:	.WORD	0		; SIZE OF TEMP FILE

; DISK BUFFER AREA

BUFF00:	.BLKW	256.		; BUFFER 00
BUFF01:	.BLKW	256.		; BUFFER 01
.IF	GT NUMBUF-2.
BUFF02:	.BLKW	256.		; BUFFER 02
BUFF03:	.BLKW	256.		; BUFFER 03
.IF	GT NUMBUF-4.
BUFF04:	.BLKW	256.		; BUFFER 04
BUFF05:	.BLKW	256.		; BUFFER 05
BUFF06:	.BLKW	256.		; BUFFER 06
BUFF07:	.BLKW	256.		; BUFFER 07
.IF	GT NUMBUF-8.
BUFF08:	.BLKW	256.		; BUFFER 08
BUFF09:	.BLKW	256.		; BUFFER 09
BUFF10:	.BLKW	256.		; BUFFER 10
BUFF11:	.BLKW	256.		; BUFFER 11
BUFF12:	.BLKW	256.		; BUFFER 12
BUFF13:	.BLKW	256.		; BUFFER 13
BUFF14:	.BLKW	256.		; BUFFER 14
BUFF15:	.BLKW	256.		; BUFFER 15
.ENDC
.ENDC
.ENDC

; PAGING TABLES

BUFTBL:	BUFF00			; TABLE OF ADDRESSES OF BUFFERS
	BUFF01
.IF	GT NUMBUF-2.
	BUFF02
	BUFF03
.IF	GT NUMBUF-4.
	BUFF04
	BUFF05
	BUFF06
	BUFF07
.IF	GT NUMBUF-8.
	BUFF08
	BUFF09
	BUFF10
	BUFF11
	BUFF12
	BUFF13
	BUFF14
	BUFF15
.ENDC
.ENDC
.ENDC
	.PAGE
; BUFFER CONTROL TABLES

RESTBL:	.REPT	NUMBUF	; HOLDS CURRENT RESIDENT BLOCK # FOR EACH BUFFER
	.WORD	-1
	.ENDR
ACCTBL:	.REPT	NUMBUF	; VALUE OF ACCESS COUNTER AT LAST ACCESS
	.WORD	0
	.ENDR
MODTBL:	.REPT	NUMBUF	; NONZERO TO INDICATE BUFFER N HAS BEEN MODIFIED
	.WORD	0
	.ENDR

	.END