.TITLE	VAFAKE
;GET AROUND DIFFICULTIES USING FORTRAN VIRTUAL ARRAYS
	.IDENT	/GCE000/
;GLENN C. EVERHART 5/1985
;
;THIS ROUTINE IS DESIGNED TO HANDLE THE PROBLEM ONE ENCOUNTERS
;WHEN ENLARGING ARRAYS USING F4P OR F77 UNDER RSX. IT ALLOWS
;ONE TO CREATE VIRTUAL ARRAYS AND PASS THEM DIRECT TO LOW LEVEL
;ROUTINES WITHOUT HAVING TO CHANGE CALLING SEQUENCES FOR
;ALL INTERMEDIATE LEVELS.
;
; The problem that frequently occurs is that you want to enlarge
;some arrays in commons and don't have the address space. If you
;use virtual arrays, you can't put them in common and can only 
;pass them to subroutines via the argument list.
;	Suppose you have a service subroutine 5 levels down that's
;called from ALL OVER THE PLACE and you want it to be able to get
;at a virtual array but don't want to change 1000 calls to it
;to fix it up, nor do you want to mess the calls of every calling
;routine up.
;	Here's the answer. Change the global entry name of your
;subroutine to something unique (let's say it's to be named
;GBLFOO) and name THIS routine with the original global name
;of the subroutine. (I'm assuming Fortran call sequence here;
;minor mods for other languages will generally be needed.). So
;we'll assume THIS routine is named "FOO" now.
;	You modify your low level routine so the last argument
;in its' calling sequence is the virtual array and you set the
;NARG parameter here to the number of arguments of your
;subroutine GBLFOO, counting the argument for the virtual
;array. Then you add a single call to THIS routine in your
;main program with NARG+1 arguments (it doesn't matter
;what the extra call argument is; it's ignored) but with
;the virtual array argument in place after the main program
;sets up the virtual array. Thus you make only a SMALL
;number of changes.
;	Now this program records where the virtual array
;info is passed, and on subsequent calls where fewer than
;NARG arguments are passed, it fills in the saved address
;so your Fortran routine sees a correct address. This should
;permit reasonable use.
	;define NARG here

.IFF NDF,NARG .PRINT NARG NEEDS TO BE DEFINED. ASSUMING 2.
	.IIF	NDF,NARG,NARG=2	;ASSUME 2 ARGUMENTS DEFAULT
	.PSECT	DATA,RW,D
ARGLST:	.BLKW	NARG		;SAVE AREA FOR ARGUMENTLIST
	.WORD	0,0		;PLUS SLOP PLUS COUNTER
	.PSECT	CODE,RO,I
FOO::
;NOTE CALL DOES A
; MOV #ARGLST,R5
; JSR PC,FOO
; 	SO WE COPY THE ARG LIST. FIRST WORD OF ARGLIST LOW
;	BYTE IS NUMBER ARGS.
	CMPB	@R5,#NARG	;GOT SETUP CASE HERE?
	BLOS	1$		;IF LOS NO, JUST DO USUAL
	MOV	#NARG,ARGLST
	MOVB	(R5),R0		;COUNTER OF ARGS
	BIC	#^C377,R0	;CLEAR TO 8 BITS
	DEC	R0		;FORGET EXTRA END ONE
	BLE	2$		;SAFETY IN CASE ZERO OR NEG.
	TST	(R5)+		;PASS ARG COUNT
	MOV	#ARGLST,R1
3$:	MOV	(R5)+,(R1)+	;COPY ARG LIST
	SOB	R0,3$			;DO IT ALL
2$:	RTS	PC
1$:
;HERE WE MAY HAVE FEWER ARGS THAN IN THE ARG LIST SO FAKE IT THAT
;WE HAVE CORRECT NUMBER.
	MOVB	(R5),R0		;GET NUMBER ARGS
	BIC	#^C377,R0	;ZOT TO 8 BITS
	MOV	#ARGLST,R1	;OUR BUILT-IN ARG LIST AREA
	TST	R0
	BLE	4$		;BE SURE THERE ARE ARGS HERE
	TST	(R5)+		;SKIP COUNT NOW
5$:	MOV	(R5)+,(R1)+
	SOB	R0,5$		;COPY ARG LIST ADDRESSES
4$:	MOV	#ARGLST,R5	;FIX SO CALLED ROUTINE SEES R5 POINTING
				;AT OUR ARG LIST WITH ALWAYS NARG ARGS.
	JMP	GBLFOO		;GO TO THE REAL ROUTINE. RETURN GETS
				;BACK TO OUR CALLER THEN.
; NOTE THAT NAME "FOO" AND "GBLFOO" NEED TO BE EDITED TO THE
; DESIRED NAMES FOR THIS TO BE USEFUL. REPLICATE THIS CODE FOR
; ANY SUCH CASES DESIRED.
	.END