/PATCH TO U/W-FOCAL TO FIX ZVR FEATURE  -JVZ-

/THIS PATCH FIXES A SERIOUS PROBLEM IN THE LOGIC OF THE ZVR
/FEATURE WHICH COULD CAUSE A VARIABLE ON THE LEFT OF AN '='
/TO BE REPLACED BY A DIFFERENT VARIABLE DURING THE EVALUA-
/TION OF THE RIGHT-HAND-SIDE.  THIS LEADS TO A COMPLETELY
/ERRONEOUS RESULT WITHOUT ANY ERROR INDICATION WHATSOEVER!
/THIS PATCH DOES NOT CURE THE PROBLEM WITH 'FOR' LOOP IN-
/DICES DISCUSSED ON PAGE 5 OF THE WRITEUP, HOWEVER THIS
/DIFFICULTY MAY BE AVOIDED BY USING A PROTECTED VARIABLE.

/TO ADD THIS PATCH TO THE ORIGINAL VERSION OF U/W-FOCAL:

/	.DA 12/1/75
/	.R ABSLDR
/	*FOCAL,FCMOD,ZVRFIX/1=100$
/	.SA SYS:UFOCAL

	FIELD 1
	XRT=11
	PT1=30
	LASTV=31
	EFOP=56
	GINC=65
	CHAR=66
	M240=114
	M4=117
	FLARGP=125
	END=134
	TOP=175
	GETC=4545
	ERROR2=4566
	RETURN=5536
	POPJ=5541

	*160
	XSPNOR		/NEED TO MOVE A FEW THINGS

	*3213
	SET20		/FIX THE 'ZERO' COMMAND

	*1430
	DCA SUBS

	*1453
	JMP MAKVAR

	*1456
	TAD SUBS

	*1465
ZCONT,	SZL		/ORGANIZED TO RETAIN ERROR CODE
	ERROR2		/SYMBOL TABLE FULL
	TAD LASTV	/SETS THE LINK
	JMP ZSERCH
SUBS=.
XSPNOR,	0		/'SPNOR' MUST BE RELOCATED
	TAD CHAR
	TAD M240
	SZA CLA
	JMP I XSPNOR
	GETC
	JMP XSPNOR+1

ZLOOP,	TAD LASTV	/CHECK PROGRESS
	CLL CMA
	TAD XRT
	TAD XINC	/XRT=XRT+XINC-1
	JMP ZCONT

ZINITL,	CLA STL IAC	/INITIATE SEARCH FOR ZERO
	TAD END

ZSERCH,	DCA XRT
	TAD I XRT	/EXPONENT +
	TAD I XRT	/HIGH ORDER
	SNA CLA		/CHECK THAT BOTH ARE ZERO
	SNL		/AND NOT ADDITIVE INVERSES
	JMP ZLOOP

ZFOUND,	TAD M4		/POINT TO THE NAME
	TAD XRT		/CLEARS THE LINK
	DCA XRT
	TAD EFOP	/REPLACE IT
	DCA I XRT
	TAD SUBS	/AND THE SUBSCRIPT TOO
	DCA I XRT

SET20,	DCA I XRT	/ZERO THE DATA
	TAD XRT
	DCA PT1		/SET THE DATA POINTER
	DCA I XRT
	DCA I XRT
	DCA I XRT	/'POPJ' FOR 3 WORD VERSION
	POPJ		/LINK=0

	*1541
	TAD M260

	*1553
MAKVAR,	TAD TOP		/CREATE A NEW VARIABLE
	STL CIA
	TAD LASTV
M260,	SNL SMA		/IS THERE ROOM FOR IT?
	JMP ZINITL	/NO: GO REPLACE SOMETHING
	TAD TOP
	TAD GINC	/UPDATE THE STORAGE POINTER
	DCA LASTV
	JMP SET20-2	/INSERT THE SUBSCRIPT
XINC=.
/NOW FOR A LITTLE DIVERSION TO MAKE ROOM FOR ANOTHER PATCH:

	*7400
XSQRT,	CLA CLL		/WE'RE GOING TO REWRITE 'FSQT'!
	TAD HORD	/(SHOULD HAVE DONE THIS AGES AGO!)
	SNA
	RETURN		/FSQT(0)=0
	SPA CLA
	ERROR2		/IMAGINARY ROOTS ARE ILLEGAL

	TAD EXP		/ADJUST THE MAGNITUDE
	SPA
	CML		/MATCH THE SIGN BIT
	RAR
	SZL
	IAC		/ADD 1 IF ITS ODD
	DCA EXP

	TAD SQCON1	/STUPID, BUT FOLLOW TRADITION
	DCA HORD
	DCA LORD
	DCA OVER2

ROOTGO,	FENT		/METHOD DUE TO SIR ISSAC NEWTON
	FPUT ITER1	/SAVE APPROXIMATION
	FGET I FLARGP	/LOAD ARGUMENT AGAIN
	FDIV ITER1
	FADD ITER1	/ADD THE PREVIOUS ONE
	FEXT
	CMA
	TAD EXP		/AND DIVIDE BY TWO
	DCA EXP

	TAD EXP
	CIA
	TAD ITER1	/COMPARE EXPONENTS
	SZA CLA
	JMP ROOTGO	/NOT EQUAL

	TAD HORD
	CIA
	TAD ITER1+1	/COMPARE HIGH ORDERS
	SZA CLA
	JMP ROOTGO	/TRY AGAIN
	TAD LORD
	CIA
	TAD ITER1+2	/ARE LOW-ORDERS EQUAL?
	SMA
	CIA
	IAC		/PLUS OR MINUS ONE BIT
	SPA CLA
	JMP ROOTGO
	RETURN		/YES

/THERE IS ACTUALLY A -MUCH- BETTER WAY: SEE VERSION 3 !!
/NOW FIX THE 'SET' COMMAND:  ALL THIS TO INSERT 5 WORDS!

ZCHECK,	TAD PT1		/CHECK FOR A ZERO VARIABLE
	DCA XRT		/WHICH MIGHT BE REPLACED
	TAD I XRT	/INAPPROPRIATELY
	SNA CLA
	ISZ I PT1	/MAKE IT UN-REPLACEABLE
	TAD CHAR
	TAD MEQ
	JMP I .+1	/AND CONTINUE AS BEFORE
	1046
MEQ,	-"=
ITER1=	.+1
SQCON1=	.

	*1044
	JMP I .+1	/REPLACE 'TAD CHAR'
	ZCHECK		/	 'TAD MEQ'


	EXP=44
	HORD=45
	LORD=46
	OVER2=47

	FENT=4407
FIXMRI	FGET=0000
FIXMRI	FADD=1000
FIXMRI	FDIV=3000
FIXMRI	FPUT=6000
	FEXT=0000
	$