TITLE FAKE   - A SET OF F IV ROUTINES TO FAKE DYNAMIC ARRAY ASSIGNMENTS
SUBTTL DYNDIM - PJ HAGAN, JAN 70.

;THE PACKAGE INCLUDES THE FOLLOWING ROUTINES
;A)	DYNDIM	ALLOCATES CORE TO ARRAY AND STORES ARRAY ADDRESS IN
;		DUMMY ARRAY NAME
;B)	FAKE	TRANSFERS CALLS FROM PROGRAM TO SUBROUTINE AFTER DOCTORING
;		LINKS TO DYNAMIC ARRAYS
;C)	SETJFF	DOES BOOKEEPING TO ALLOW RETURN OF DYNAMIC ARRAY 
;		SPACE.
;ACCUMULATORS
	A=0
	B=1
	C=2
	D=3
	E=4
	P=17

;PARAMETERS
	OUTSTR=3

;SUBROUTINE DYNDIM
;ALLOCATE CORE TO DYNAMIC ARRAY
;CALL  DYNDIM (A,ID,IFLAG)
;	WHERE	A IS A DUMMY ARRAY NAME
;		ID IS THE NUMBER OF CORE LOCATIONS REQUIRED FOR ARRAY
;		IFLAG RETURNS TO USER
;			=0 O.K. RETURN
;			=-1 IF NO CORE AVAILABLE
;			=+1 IF ZERO OR NEGATIVE ARRAY LENGTH REQUESTED


EXTERNAL JOBFF,JOBREL

ENTRY DYNDIM

	MLON

DYNDIM:	Z
	SETZM @2(16)		;CLEAR FLAG
	HRRZ A,JOBFF
	MOVE B,@1(16)		;GET LENGTH OF ARRAY
	JUMPLE B,DYNNEG		;AN ARRAY OF NEGATIVE LENGTH REQUESTED
	ADD B,A
	HRRZ C,JOBREL		;HIGHEST LOCATION OF USER'S CORE
	CAMG B,C		;WILL ARRAY FIT?
	JRST DYDIM1		;YES!
	MOVE C,B
	CALLI C,11		;NO! CORE UUO
	JRST DYDIM2		;ERROR RETURN

DYDIM1:	MOVEM A,@(16)		;STORE ADR OF ARRAY IN DUMMY
	MOVEM B,JOBFF		;UPDATE FIRST FREE
	SETZM @A		;ZEROISE FIRST WORD IN ARRAY
	HRLS A			;SET UP BLOCK TRANSFER TO
	AOS A			;ZEROISE ARRAY
	BLT A,(B)
	JRA 16,3(16)		;RETURN

DYDIM2:	MOVEI A,[ASCIZ /CORE AVAILABLE, BUT NOT TO YOU
/]
	SKIPN C
	MOVEI A,[ASCIZ /NO CORE AVAILABLE
/]
	TTCALL OUTSTR,@A
	SETOM @2(16)
	JRA 16,3(16)		;RETURN

DYNNEG:	MOVEI B,[ASCIZ /ARRAY LENGTH < OR = 0 REQUESTED
/]
	TTCALL OUTSTR,@B
	MOVEI B,1
	MOVEM B,@2(16)		;SET IFLAG
	JRA 16,3(16)		;RETURN

;SUBROUTINE SETJFF
;ROUTINE WHICH ALLOWS A USER TO SAVE AND RESTORE JOBFF
;N.B. BEFORE RESTORING JOBFF THE USER MUST RELEASE ALL DEVICES WHICH
;HAVE SET UP BUFFERS SUBSEQUENT TO SAVING JOBFF
;CALL SETJFF (NCOR)
;	WHERE	NCOR IS SET INITIALLY TO ZERO, BUT ON THE FIRST CALL TO
;		THIS SUBROUTINE IS SET NON-ZERO THUS INICATING JOBFF HAS
;		BEEN SAVED.

ENTRY SETJFF

SETJFF:	Z
	SKIPE @(16)		;FIRST ENTRY?
	JRST SETJF1		;NO!
	MOVE A,JOBFF		;YES!
	MOVEM A,JOBKP#
	SETOM @(16)		;MARK AS SAVED
	JRA 16,1(16)		;RETURN

SETJF1:	MOVE A,JOBKP		;RESTORE ORIGINAL JOBFF
	MOVEM A,JOBFF
	JRA 16,1(16)		;RETURN



;SUBROUTINE FAKE
;	THIS ROUTINE AS AN INTERMEDIATE ROUTINE BETWEEN A PROGRAM
;AND ITS SUBROUTINE. IT FAKES ARRAY ADDRESSES TO ALLOW THE SUBROUTINE
;TO USE DYNAMICALLY DIMENSIONED ARRAYS.
;
;CALL FAKE (I,J,SUBPR,ARRAY1,ARRAY2.....,ARG1,ARG2,ARG3.....)
;	WHERE	I IS THE NO OF DYNAMIC ARRAY DUMMIES, ARRAYN.
;		J IS THE TOTAL NUMBER OF ARGUMENTS FOR THE SUBROUTINE
;		  CALL TO BE GENERATED BY FAKE.
;		SUBPR IS THE SUBROUTINE NAME, DEFINED IN THE FORTRAN
;		PROGRAM IN A EXTERNAL STATEMENT
;		ARRAYN ARE THE DYNAMICALLY DEMENSIONED ARRAY DUMMIES
;		ARGN ARE THE REST OF THE ARGUMENTS NEEDED FOR THE
;		SUBROUTINE CALL.

ENTRY FAKE

FAKE:	Z
	MOVN B,@(16)		;GET NO OF DYNAMICALLY DIMENSIONED ARRAYS
	HRLI B,3(16)		;GET ADDRESS FIRST DUMMY
	MOVSS B
	MOVN C,@1(16)		;GET NO OF ARGS
	HRLI C,FAKE3+1		;POSITION FOR ARG IN CALL STR
	MOVSS C			;COUNTER AND INDEX

FAKE1:	MOVE A,@(B)		;GET ARRAY ADR
	HLL A,(B)		;SET ARG DESCRIPTION
	MOVEM A,(C)		;PLACE IN NEW CALL STRING
	AOBJP C,FAKE5		;DONE LAST ARGUMENT
	AOBJN B,FAKE1		;REPEAT FOR EACH ARRAY

FAKE2:	MOVE A,(B)
	MOVEM A,(C)		;TRANSFER ARGS
	AOS B
	AOBJN C,FAKE2		;GET NXT ARG

FAKE5:	HRR A,2(16)		;SET UP SUBROUTINE ADDRESS
	HRRM A,.+1

FAKE3:	JSA 16,0		;ISSUE CALL
	REPEAT 20,<		;ROOM FOR 20 ARGUMENTS
	JUMP 00,0
>
	JRA 16,4(16)		;RETURN TO MAINLINE

	END