/FX - RANDOM ACCESS FUNCTION:

/THIS OVERLAY TO U/W-FOCAL WAS ADAPTED FROM THE ORIGINAL FX
/FUNCTION WRITTEN BY LAWRENCE MOSS AND AVAILABLE AS FOCAL8-
/268.  THIS VERSION IS MODELED AFTER U/W-FOCAL'S FCOM FUNC-
/TION AND THUS PERMITS RECURSIVE CALLS WHEREAS THE ORIGINAL
/VERSION DID NOT.  THE PATCH REPORTED IN DECUSCOPE VOL. 13,
/NO. 2 (PP 19-20) HAS BEEN INCLUDED.  THERE ARE TWO ERRORS
/ASSOCIATED WITH THIS FUNCTION:

/	?13.22	INDEX TOO LARGE (>2047)
/	?13.75	STORAGE AREA EXCEEDED

/BE EXTREMELY CAREFUL NOT TO USE 'FX' AFTER ANY OF THE LIB-
/RARY COMMANDS (E.G. LIST, SAVE, CALL, RUN, GOSUB, ETC.)
/UNTIL THE FILE HAS BEEN REOPENED.  THESE COMMANDS CHANGE
/VITAL ADDRESSES USED BY 'FX' AND CAN EASILY CAUSE DATA TO
/BE WRITTEN IN THE WRONG PLACE!  CONSULT THE DECUS WRITEUP.
/NOTE THE CONVENIENCE OF THE 'XECUTE' COMMAND WHEN STORING
/VARIABLES:  X FX() FX(I,ARG) FX(FX(J),FX(K)); ETC.

/SYMBOL DEFINITIONS:

	FIELD 0
	FLNGTH=56
	STBLK=57
	INHND=120
	OUTHND=126
	OUTFLG=127
	BLKCNT=3656
	OBLK=3725
	O3=3737
	OPTR1=3751
	OPTR2=3752
	ONMTMP=3753

	FIELD 1
	INDEX=14
	BLOCK=33
	EXP=44
	HORD=45
	LORD=46
	CHAR=66
	MCOM=72
	C200=123
	END=134
	FIXIT=4453
	POPA=4537
	PUSHJ=4540
	PUSHA=4542
	ERROR2=4566
	RETURN=5536
	EVAL=1613
	FNTABF=355
	FNTABL=2155
	*END
	STVAR		/22 FEWER 4-WORD VARIABLES

	*FNTABF
	FX		/USE THE 'FCOM' SLOT

	*FNTABL
	"X		/REPLACE THE FN CODE

	*3224		/USER FUNCTION AREA

SET=(DCA I 3375)&(DCA I 3374)	/LINK TO THE NEXT PAGE
TEMP=(BLKCNT)&(OBLK)&0+32	/SAVE A FEW LITERALS!

FX,	FIXIT		/BRING INDEX INTO THE AC
	SPA
	ERROR2		/INDEX MUST BE LESS THAN 2048
	PUSHA		/SAVE INDEX - PERMITS FX(FX) CALLS
	TAD CHAR
	TAD MCOM
	SZA CLA		/'GET' OR 'PUT' OPERATION?
	JMP GET
	PUSHJ
	    EVAL-1	/PICK UP THE SECOND ARGUMENT

PUT,	JMS FIND	/LOCATE THE CORRECT BLOCK
	TAD EXP
	DCA I INDEX
	TAD HORD
	DCA I INDEX
	TAD LORD
	DCA I INDEX
	CMA
	DCA DISK	/SET THE PROTECT FLAG
	JMP I (EXIT

GET,	JMS FIND	/LOCATE BLOCK & SET INDEX REG.
	TAD I INDEX
	DCA EXP
	TAD I INDEX
	DCA HORD
	TAD I INDEX
	DCA LORD
	JMP I (EXIT	/FX EXIT
FIND,	0		/FIND CORRECT BLOCK & SET INDEX REG
	DCA BLOCK	/CLEAR QUOTIENT FOR DIVIDE LOOP
	POPA		/RECALL INDEX
	CDF		/FOR SUBSEQUENT OPERATIONS
	SNA
	JMP SET		/'0' TRANSFERS INPUT POINTERS
	DCA INDEX
	TAD INDEX
	TAD (-124	/84(10) VARIABLES/BLOCK
	SPA
	JMP .+3		/COULD EASILY USE EAE INST. HERE
	ISZ BLOCK
	JMP .-6
DERR,	CLA CLL RAL	/REMOVE REMAINDER
	TAD BLOCK	/THIS IS THE RELATIVE BLOCK NO.
	TAD I (STBLK	/SET BY 'OPEN OUTPUT' & 'OPEN INPUT'
	CIA
	TAD I (OBLK	/THIS IS THE CURRENT BLOCK
	SNA CLA
	JMP FOUND	/NO ACCESS REQUIRED

	TAD I (FLNGTH	/CHECK MAX. BLOCK SIZE
	SPA		/RK8 FUDGE
	JMP .+3		/USUAL CASE
	CLA
	TAD .+2		/-100
	TAD BLOCK
	SMA CLA		/DOES THIS BLOCK FIT?
	ERROR2		/NO - TOO BIG

	ISZ DISK	/CHECK SAVE FLAG
	JMP .+3		/NOTHING WRITTEN
	TAD (4200	/WRITE CODE
	JMS DISK	/SAVE CURRENT BLOCK
	TAD BLOCK
	TAD I (STBLK
	DCA I (OBLK	/UPDATE CURRENT BLOCK NO.
	TAD C200	/READ CODE
	JMS DISK	/BRING IN THE NEW BLOCK

	TAD BLOCK	/SET BLKCNT=MAXIMUM SIZE
	CIA
	TAD I (BLKCNT
	SMA CLA		/IS NEW ONE BIGGER?
	JMP .+3		/NO
	TAD BLOCK	/YES
	DCA I (BLKCNT

FOUND,	CMA		/SET UP INDEX REGISTER
	TAD ARG2	/BEGINNING OF BUFFER
	TAD INDEX
	TAD INDEX	/YES - IT IS CRUDE!
	TAD INDEX
	DCA INDEX
	JMP I FIND
DISK,	0		/READ-WRITE SUBROUTINE
	DCA ARG1	/AC=FUNCTION
	TAD I (OBLK
	DCA ARG3	/FILL IN THE BLOCK NO.
	TAD I (OUTHND
	DCA TEMP	/GET HANDLER ENTRY POINT
	CDF 10
	CIF
	IOF		/HANG THE DO-NOT-DISTURB SIGN
	JMS I TEMP
ARG1,	0
ARG2,	4400
ARG3,	0
	JMP ERR		/WRITE-LOCK
	ION		/TAKE DOWN THE SIGN
	CDF
	JMP I DISK

ERR,	CDF CIF		/DEVICE ERROR = ?29.68
	JMP I DERR

	PAGE

/SET,	DCA I (OBLK
/	DCA I (BLKCNT
	INHND
	TAD I .-1	/MOVE INPUT POINTERS
	DCA I .+1
	OUTHND
	DCA I .+3
	CDF 10
	RETURN		/FUNCTION RETURN
	ONMTMP
	O3
EXIT,	CMA		/FUDGE CHARACTER COUNT
	DCA I .-2
	CMA
	DCA I .+1	/SET 'FILE OPEN' FLAG
	OUTFLG
	TAD .+5		/KLUDGE OUTPUT POINTERS
	DCA I .+5
	TAD .+5		/FOR 'OUTPUT CLOSE'
	DCA I .+5
	JMP SET+7	/RETURN

	4777		/LAST BUFFER LOCATION
	OPTR1
	4776
	OPTR2
STVAR=.
	$