/ FUNCTION PACKAGE FOR 12K U/W-FOCAL:		-JVZ-
/ 12KFNS.PA
/REVISIONS:
/ TAD TXTEND CHANGED TO TAD BUFEND AT 14447	1/3/79

/ FCOM AND FRA:  RANDOM ACCESS FUNCTIONS

/THE 'FCOM' FUNCTION PROVIDES ACCESS TO DATA ARRAYS IN FIELD
/2 (OR 4) USING EITHER OF 2 STORAGE MODES: SIGNED DOUBLE PRE-
/CISION OR 4-WORD FLOATING-POINT.  THE STORAGE MODE IS DETER-
/MINED BY THE SIGN OF THE 'FCOM' INDEX.  POSITIVE INDICES
/(0-1023) ACCESS FLOATING-POINT NUMBERS WHILE NEGATIVE VALUES
/REFERENCE DOUBLE PRECISION INTEGERS IN THE SAME WAY THAT THE
/KE-8E EAE DOES IT.  STORAGE BEGINS AT THE TOP OF THE FIELD &
/EXTENDS DOWNWARD TOWARD THE TEXT AREA.  THIS PROVIDES A REA-
/SONABLE TRADEOFF BETWEEN LARGE DATA ARRAYS AND LONG PROGRAMS.

/THE VALUE OF THE 'FCOM' FUNCTION IS JUST THE VALUE OF THE
/VARIABLE AT THE LOCATION REFERENCED.  TO STORE A NEW VALUE
/AT THAT LOCATION, SIMPLY INCLUDE A SECOND PARAMETER IN THE
/FUNCTION CALL; THE VALUE OF THIS EXPRESSION WILL THEN BE
/PLACED IN THE ARRAY AT THE SPECIFIED LOCATION.  DATA CON-
/VERSION BETWEEN INTEGER AND FLOATING-POINT MODES IS AUTO-
/MATIC.  EXAMPLES: SET X(I)=FCOM(I+100); X FCOM(J,FSIN(J))

/THE 'FRA' FUNCTION PROVIDES 'FCOM-LIKE' ACCESS TO DATA ARRAYS
/STORED IN BINARY FORM ON ANY MASS-STORAGE DEVICE.  SEVERAL
/DATA MODES ARE AVAILABLE: SINGLE WORD (SIGNED OR UNSIGNED),
/DOUBLE PRECISION AND 4-WORD FLOATING POINT.  A DIFFERENT
/INDEXING SCHEME IS EMPLOYED TO HANDLE ALL THESE MODES.

/THE FILE USED BY FRA MUST FIRST BE LOOKED UP USING THE
/'OPEN INPUT' COMMAND.  FOLLOWING THIS 'FRA' MUST BE INITIAL-
/IZED SO THAT THE NECESSARY POINTERS CAN BE TRANSFERRED AND
/THE DATA FORMAT SELECTED.  THE FOLLOWING TYPES OF CALLS ARE
/PERMITTED: (I IS NON-NEGATIVE, V IS ANY EXPRESSION)

/	FRA(I)		READ THE I-TH VALUE
/	FRA(I,V)	STORE V IN THIS LOCATION
/	FRA(-1)		UPDATE THE LAST BLOCK
/	FRA(-1,M)	INITIALIZE AND SET THE DATA MODE

/THE VALUE OF 'M' DETERMINES THE DATA MODE:

/	M=0		UNSIGNED INTEGERS
/	M=1		SIGNED INTEGERS
/	M=2		DOUBLE PRECISION
/	M=4		4-WORD FLOATING-POINT

/'FRA' RETURNS 0 WHEN CALLED WITH A NEGATIVE INDEX.

/'FRA' USES ITS OWN ROUTINES FOR MODES 0-1, AND THE 'FCOM'
/ROUTINES FOR MODES 2 & 4.  BOTH FUNCTIONS ARE COMPLETELY
/RECURSIVE, I.E. THEY MAY BE USED AS ARGUMENTS OF THEMSELVES.

	PAGE 21		/PRECEEDING THE 8K FUNCTIONS
FRA,	TAD HORD	/CHECK SIGN OF THE INDEX
	SPA CLA		/INITIALIZATION?
	JMP INITL	/YES, OR UPDATE
	FIXIT
R3,	CLA CLL RTL	/=7306
	PUSHF		/SAVE THE INDEX
	    FLAC
	TSTCMA		/READ OR WRITE?
	JMP .+4		/READ
	PUSHJ		/WRITE
	    EVAL	/EVALUATE THE EXPRESSION
	TAD P13		/ALTER THE INSTRUCTION

	DCA REED
	POPF		/RECALL THE INDEX
	    FLOP
	TAD SHIFTS
	DCA LAST1
	JMS I R3	/SHIFT RIGHT ONE BIT
	ISZ LAST1
	JMP .-2
	TAD (BLKNO&0	/FIRST BLOCK OF THIS FILE
	SNA
	ERROR2		/FILE NOT AVAILABLE
	TAD AC1L	/THIS IS NOW THE RELATIVE BLOCK #
	CIA
	TAD ARG3	/IS IT THE SAME AS THE LAST ONE?
	SNA CLA
	JMP CORE	/YES, DATA IS IN CORE
	JMS LAST1	/CHECK FOR ANY UPDATES
	TAD (FLNGTH	/FILE SIZE
	STL CIA
	TAD AC1L
	SNL CLA		/IS THIS A LEGAL INDEX?
	ERROR2		/NO, IT'S TOO LARGE
	TAD AC1L
	TAD (BLKNO&0
	DCA ARG3	/SET THE NEW BLOCK NUMBER
	JMS DISK	/AND READ IT IN

CORE,	TAD REED	/R OR W?
	SZA CLA
	DCA DISK	/SET THE 'CHANGE' FLAG
	TAD REED
	TAD WRIT	/SET UP THE PROPER EXIT
	DCA REED
	TAD OVR1	/DEVELOP THE BUFFER ADDRESS
	CLL RTR
	CLL RTR
	TAD (3200-1	/BUFFER ADDRESS
	CDF
	DCA XRT
REED,	JMP W0		/NOW FOR THE EASY PART!

WRIT,	JMP R0		/OR ELSEWHERE...
INITL,	TSTCMA		/UPDATE OR INITIALIZE?
	JMP FINAL	/UPDATE
	PUSHJ
	    EVAL
	FIXIT		/GET THE DATA MODE
	TAD M4
	SNA
	CLL
	IAC
	SZL		/0-4? (EXCLUDING 3)
	ERROR2		/MODE ERROR
	TAD (-15
	STL RAR		/DETERMINE THE SHIFT COUNT
	DCA SHIFTS
	TAD LORD
	STL RAL
	TAD JMPR0	/AND THE PROPER R/W ROUTINE
	DCA WRIT
	CDF		/NOW GET THE POINTERS
	TAD I ATSW	/=BLKNO
	DCA (BLKNO&0
	TAD I (ILNGTH
	DCA (FLNGTH
	TAD I W0+1	/=INHND
	DCA (HANDLR
	CDF P
FINAL,	JMS LAST1	/UPDATE THE LAST BLOCK
	DCA ARG3
	FLOATR

DISK,	NOP		/READ/WRITE SUBROUTINE
	TAD C200	/= 1 BLOCK IN FIELD 0
	DCA ARG1
	CIF		/GO BELOW
	I0F		/OR 'NOP'
	JMS I (HANDLR	/CALL THE (INPUT) HANDLER
ARG1,	200
	3200
ARG3,	0
	JMP W3		/DEVICE ERROR
	I0N
	JMP I DISK

LAST1,	0		/CHECK FOR CHANGES & UPDATE
	TAD DISK	/HAVE WE WRITTEN ANYTHING?
	SZA CLA
JMPR0,	JMP .+3		/NO
	SM0		/YES
	JMS DISK	/RESET THE FLAG
	JMP I LAST1	/AND REALLY DO IT
/HERE ARE ALL THE READ AND WRITE ROUTINES:

R0,	TAD I XRT	/UNSIGNED INTEGERS
	FL0ATR

R1,	TAD I XRT	/SIGNED INTEGERS
	FLOATR

R2,	TAD W0		/DOUBLE PRECISION
	DCA EXP

	JMP I .+1
	GET+6

R4,	JMP I .+1	/FLOATING POINT
	GET+2

SHIFTS,	0		/SEPARATES THE LISTS BY 13

W0,	27		/SINGLE PRECISION
	INHND		/<1000(8)

W1,	FIXIT		/SIGNED OR UNSIGNED
	JMP I (GET-2

W2,	JMP I .+1
	PUT+6

W3,	CIF		/GENERATE ?29.70
	JMP I R3

W4,	JMP I .+1
	PUT

	PAGE
/FCOM:	STORAGE FUNCTION FOR DATA ARRAYS

FCOM,	FIXIT		/FIX INDEX AND SET EXP, OVER
	PUSHA		/SAVE INDEX ON THE STACK
	TSTCMA		/CHECK FOR A SECOND ARGUMENT
	JMP GET
	PUSHJ		/GET THE ARGUMENT
	    EVAL
	JMS INDEX	/COMPUTE THE INDEX
	JMP .+7		/IT WAS NEGATIVE

PUT,	TAD EXP		/FLOATING STORAGE
	DCA I XRT
	TAD OVER
	DCA I XRT
	TAD LORD
	SKP
	FIXIT		/INTEGER STORAGE
	DCA I XRT
	TAD HORD
	DCA I XRT
	RETURN		/FUNCTION RETURN

GET,	JMS INDEX	/FIGURE IT OUT
	JMP .+5		/NOTE: EXP=27, OVER=0
	TAD I XRT	/FLOATING RETRIEVAL
	DCA EXP
	TAD I XRT
	DCA OVER
	TAD I XRT	/INTEGER RETRIEVAL
	DCA LORD
	TAD I XRT
	DCA HORD
	RETURN		/'RETURN' FLOATS INTEGERS
	NOP

INDEX,	0		/COMPUTE INDEX AND BRANCH
	POPA		/EXAMINE THE ARGUMENT
	SPA		/FLOATING
	JMP .+3		/INTEGER
	ISZ INDEX	/SET POSITIVE RETURN
	CMA CLL RAL	/-(I+1)*4 FOR FLOATING
	CLL RAL		/*2 FOR INTEGER STORAGE
	STL CMA
	TAD BUFEND	/'IAC' IF LAST PAGE FREE
	TAD BUFR	/'NOP' FOR 20K SYSTEM
	SNL SZA		/CHECK TEXT LIMIT
	ERROR2		/FCOM INDEX EXCEEDED RANGE
	CMA		/SUBTRACT ONE
	TAD BUFR	/'NOP' FOR 20K SYSTEM
	DCA XRT		/LOAD INDEX REGISTER
	CDF T		/'CDF 40' FOR 20K
	JMP I INDEX

/NOTE: 'INDEX' IS EASILY CHANGED TO STORE IN FIELDS 4-7.
/THIS PATCH MODIFIES THE 'INDEX' ROUTINE SO THAT POSITIVE
/INDICES FROM 0-2047 MAY BE USED TO ADDRESS ALL LOCATIONS
/IN FIELDS 4 & 5.  THE 'NEGATIVE INDEX' FEATURE HAS BEEN
/ELIMINATED: ONLY FLOATING-POINT STORAGE IS AVAILABLE.

NOPUNCH
	*PUT-1
	NOP		/ELIMINATE THE 'NEG.' RETURN
	*GET
	CDF 40		/USE THIS LOC. FOR A CONSTANT
	JMS INDEX	/AND MOVE THIS DOWN ONE

	*INDEX+2
	SPA		/CHECK STORAGE LIMIT
	JMP .+10	/KEEP THE SAME ERROR CODE
	CLL RTL		/MULTIPLY THE INDEX BY 4
	SZA		/LEAVING THE FIELD INFO
	CIA		/IN THE LINK
	CMA		/SUBTRACT ONE
	DCA XRT		/AND SAVE THE INDEX
	RTL		/SHIFT THE FIELD BIT OVER
	SKP
	ERROR2		/INDEX GREATER THAN 2047(10)
	RTL
	TAD GET		/ADD THE 'CDF' INSTRUCTION
	DCA .+1

/THIS PATCH MODIFIES THE 'INDEX' ROUTINE SO THAT POSITIVE
/INDICES FROM 0-4095 MAY BE USED TO ADDRESS ALL LOCATIONS
/IN FIELDS 4-7.  THE 'NEGATIVE INDEX' FEATURE HAS BEEN
/ELIMINATED: ONLY FLOATING-POINT STORAGE IS AVAILABLE.

	*PUT-1
	NOP		/ELIMINATE THE 'NEG.' RETURN
	*GET
	CDF 40		/USE THIS LOC. FOR A CONSTANT
	JMS INDEX	/AND MOVE THIS DOWN ONE

	*INDEX+2
	CLL RTL		/MULTIPLY THE INDEX BY 4
	DCA XRT		/LEAVING THE FIELD INFO
	IAC		/IN BIT 11 AND THE LINK
	AND XRT
	RTL		/SHIFT THE FIELD BITS OVER
	RTL
	TAD GET		/ADD THE 'CDF' INSTRUCTION
	DCA .+6		/AND SAVE FOR LATER
	SM2		/=7776
	AND XRT		/CLEAN UP THE INDEX
	CIA
	CMA		/SUBTRACT ONE
ENPUNCH;*.+3

/THE CHANGES ARE CONSTRUCTED SO THAT THEY DO NOT INTER-
/FERE WITH 'FRA' WHICH USES SOME OF THE 'FCOM' ROUTINES.
/THE 'HESITATE' COMMAND PROVIDES A PROGRAMMABLE PAUSE TO
/BE USED WHENEVER IT IS NECESSARY TO SYNCHRONIZE THE PRO-
/GRAM WITH AN EXTERNAL DEVICE. THE TIMING IS PROVIDED BY
/A SOFTWARE LOOP WHICH MUST BE ADJUSTED FOR DIFFERENT MA-
/CHINES.   ASSEMBLY OPTIONS ARE PROVIDED FOR THE 8/E AND
/8/I AND OTHERS ARE EASILY PATCHED.  TIMES ARE EXPRESSED
/IN MILLISECONDS, SO 'H 1000' PROVIDES A 1 SECOND DELAY.

HESI,	PUSHJ		/PARAMETER = DELAY TIME
	    EVAL	/  (IN MILLISECONDS)
	NEGATE
	SZL		/ZERO OR MISSING ARGUMENT?
	CONTINUE	/AVOID A 4HR 40MIN DELAY !
	FIXIT		/CONVERT TO DOUBLE PRECISION
	SNA		/1ST CYCLE MAY BE A BIT OFF
	TAD TATE	/GET LOOP CONSTANT
	IAC		/COUNT DOWN
	SNA		/DONE?
	ISZ LORD	/1.003 MS PER MAJOR CYCLE
	JMP .-5		/TIMES THE NUMBER OF CYCLES
	ISZ HORD
	JMP .-6
	CONTINUE	/RETURN TO MAINLINE
TATE,
IFDEF	TFLI <-320>	/1.2 USEC (8/E)
IFNDEF	TFLI <-234>	/1.6 USEC (8/I)
/////
/ FUNCTION PACKAGE FOR 8K U/W-FOCAL:		-JVZ-

/THESE FUNCTIONS ARE BASED ON THE SERIES APPROXIMATIONS DE-
/VELOPED BY D.A. DALBY AND D.E. WELLS OF THE BEDFORD INSTI-
/TUTE OF OCEANOGRAPHY, DARTMOUTH, NOVA SCOTIA (DECUS 8-103)
/WHILE EXHAUSTIVE TESTING HAS NOT BEEN CARRIED OUT, TYPI-
/CALLY THE RESULTS ARE CORRECT TO CA. 3 IN THE TENTH DIGIT.

	*4600-12

/EXPONENTIAL CONSTANTS:

E1,	+0;4000;0000;0275
E2,	-1;3777;7775;1652
E3,	-2;5252;5353;1521
E4,	-4;2524;7613;5106
E5,	-6;5700;2131;0200
E6,	-11;2560;3573;7333
E7,	-14;5542;5227;4775
/BASE E EXPONENTIAL FUNCTION:

FEXP,	CHKSGN		/TAKE THE ABSOLUTE VALUE
	1
	FENT
	FDIV LN2	/FORM N+F
	FPUT I FLARGP
	FEXT
	NEGATE
	FIXIT		/FORM -N
	DCA T2
	NORMALIZE
/////
	FENT
	FADD I FLARGP	/FORM F
	FMUL LN2
	FPUT I FLARGP
	FMUL E7
	FADD E6
	FMUL I FLARGP
	FADD E5
	FMUL I FLARGP
	FADD E4
	FMUL I FLARGP
	FADD I X3
	FMUL I FLARGP
	FADD I X2
	FMUL I FLARGP
	FADD I X1
	FMUL I FLARGP
	FADD I X0
	FEXT
/////
	TAD T2		/DIVIDE THE SUM BY 2^N
	TAD EXP
	DCA EXP
	TAD FINISH	/POINT TO 'RETURN'
	DCA CHKARG
	TAD T3
	JMP EXPX	/FEXP(X)=1/FEXP(-X)
/////

X3,	E3
X2,	E2
X1,	E1
X0,	E0
CHKARG,	0		/ARGUMENT CHECK FOR 'FLOG', 'FATN'
	DCA T2		/SET THE FLIP-FLOP
	CHKSGN		/LOOK AT THE SIGN FIRST
	JMP I CHKARG	/ZERO
	ISZ CHKARG	/NON-ZERO
	CLA CMA		/COMPARE WITH UNITY
	TAD EXP
	TAD T2		/.LT. OR .GT. ONE?
EXPX,	SPA CLA
	JMP I CHKARG	/YOUR CHOICE
	FENT
	FPWR FEXP+1	/= -1.7427...
	FPUT I FLARGP	/SAVE THE RECIPROCAL
	FEXT
	TAD .-2
	JMP I CHKARG	/T3=SIGN FLAG, AC=INVERSION FLAG
/////

/LOGARITHM CONSTANTS:

LN2,	+0;2613;4413;7676
L12,	-12;4132;5467;5141
L11,	-7;3467;0413;5110
L10,	-5;4633;3721;5500
L9,	-4;3470;0312;3507
L8,	-3;4770;3123;3611
L7,	-2;2050;7523;5173
/NAPERIAN LOGARITHM

FLOG,	SM0		/CHECK OUT THE ARGUMENT
	JMS CHKARG
	ERROR2		/CAN'T TAKE THE LN OF ZERO
	DCA T3
	CMA
	TAD EXP
	FLOAT		/FLOAT THE EXPONENT
	IAC
	DCA I FLARGP	/REPLACE IT WITH 1
	NORMALIZE
/////
	FENT		/DO THE SERIES
	FMUL LN2
	FPUT I BUFFPT
	FGET I FLARGP	/JUST THE MANTISSA NOW
	FSUB I FP1
	FPUT I FLARGP	/BACK AGAIN!
	FMUL L12
	FADD L11
	FMUL I FLARGP
	FADD L10
	FMUL I FLARGP
	FADD L9
	FMUL I FLARGP
	FADD L8
	FMUL I FLARGP
	FADD L7
/	PAGE BOUNDARY
	FMUL I FLARGP
	FADD L6
	FMUL I FLARGP
	FADD L5
	FMUL I FLARGP
	FADD L4
	FMUL I FLARGP
	FADD L3
	FMUL I FLARGP
	FADD L2
	FMUL I FLARGP
	FADD L1
	FMUL I FLARGP
	FADD I BUFFPT	/ADD N*LN2
	FEXT
	JMP I (EXIT2	/NEGATE RESULT IF NECESSARY
/ARCTANGENT FUNCTION FOR ANGLES IN RADIANS

FATN,	JMS I (CHKARG
	RETURN		/ATN(0)=0
	DCA INVRS	/SET THE EXIT
	FENT
	FMUL FLAC
	FPUT I BUFFPT	/SAVE THE SQUARE
	FMUL A23
	FADD A21
	FMUL I BUFFPT
	FADD A19
	FMUL I BUFFPT
	FADD A17
	FMUL I BUFFPT
	FADD A15
	FMUL I BUFFPT
	FADD A13
	FMUL I BUFFPT
	FADD A11
	FMUL I BUFFPT
	FADD A9
	FMUL I BUFFPT
	FADD A7
	FMUL I BUFFPT
	FADD A5
	FMUL I BUFFPT
	FADD A3
	FMUL I BUFFPT
	FADD A1
	FMUL I FLARGP	/CONVERT TO ODD POWERS
INVRS,	FPUT I FLARGP	/OR 'FEXT'
	FGET I (PIOV2
	FSUB I FLARGP	/ATN(X)=PI/2-ATN(1/X)
	FEXT
	JMP I (EXIT2	/TAKE CARE OF THE SIGN
/////
/ARCTANGENT CONSTANTS

A23,	-12;5457;4432;1701
A21,	-7;2145;4241;4605
A19,	-6;4166;3357;4120
A17,	-4;2040;1626;5457
A15,	-4;4507;1221;3170
A13,	-3;2222;2557;0167
A11,	-3;5107;0475;7567
E0,	+0;3777;7777/7775
A9,	-3;3427;7472;2175
A7,	-2;5555;7621;6402
A5,	-2;3146;3041;1767
A3,	-1;5252;5253;5611
A1,	+0;3777;7777;7755
/LOGARITHM CONSTANTS

L6,	-2;5312;1653;0406
L5,	-2;3137;6765;6402
L4,	-2;4000;7041;0031
L3,	-1;2525;2301;7431
L2,	-1;4000;0006;2241
L1,	+0;3777;7777;7445

	PAGE
/EXTENDED PRECISION SIN & COS - TAKEN FROM DEC'S FLOATING-
/POINT PACKAGE (R. BEAN) & FOCAL8-231 (DR. H.B. THOMPSON).
/THE COEFFICIENTS HAVE BEEN OPTIMIZED FOR U/W-FOCAL (JVZ).

FCOS,	SM0		/ONLY NEGATE IF POSITIVE
	JMS I ABSOL	/(SUGGESTED BY G. CHASE)
	FENT
	FADD PIOV2	/COS(X)=SIN(PI/2-X)
	FEXT

FSIN,	CHKSGN		/CHECK THE SIGN
	JMP QUAD1	/ARGUMENT WAS 0
	FENT
	FDIV PIOV2	/CONVERT TO QUADRANTS
	FPUT I FLARGP
	FEXT

	FIXIT		/GET THE INTEGER PART
	AND SC3		/MODULO 4
	TAD FSIN+1
	DCA QUAD0	/SET UP THE BRANCH
	JMS FRCT	/GET THE FRACTION

QUAD0,	0		/AND PROCESS IT
	FENT
	FSUB I FP1	/SUBTRACT 1.0
	FEXT
	JMP I QUAD0

	NEGATE
QUAD1,	JMP QUAD5	/USE  X
QUAD2,	JMS QUAD0	/USE 1-X
QUAD3,	JMP QUAD1-1	/USE -X
QUAD4,	JMS QUAD0	/USE X-1

QUAD5,	FENT		/SIX TERM POLYNOMIAL
	FPUT I FLARGP	/SAVE THE ARGUMENT
	FMUL FLAC
	FPUT I BUFFPT	/SAVE THE SQUARE
	FMUL C11
	FADD C9
	FMUL I BUFFPT
	FADD C7
	FMUL I BUFFPT
	FADD C5
	FMUL I BUFFPT
	FADD C3
	FMUL I BUFFPT
	FADD PIOV2
	FMUL I FLARGP	/CONVERT TO ODD POWERS
	FEXT
/COMMON EXIT ROUTINE FOR EXTENDED FUNCTIONS

EXIT2,	TAD T3		/CHECK SIGN
	JMP FABS+1

/SINE AND COSINE CONSTANTS

SC3,	3
C11,	-22;4313;2133
C9,	-14;2500;3207
C7,	-7;5464;5650;4204
C5,	-3;2431;5360;3221
C3,	+0;5325;0414;3240
PIOV2,	+1;3110;3755;2421

/COMMON ROUTINES FOR EXTENDED FUNCTIONS

SGNCHK,	0		/ALSO CALLED BY 'GETLN'
	JMS I ABSOL	/TAKE THE ABSOLUTE VALUE
	FENT
	FPUT I FLARGP	/AND PUT IT BACK AGAIN
	FEXT
	TAD SIGN	/'FPUT' LEAVES L=1
	SZA
	ISZ SGNCHK	/FIRST RETURN = ZERO
	DCA T3
	TAD T3
	JMP I SGNCHK	/AC,T3 = SIGN OF THE ARGUMENT

FRCT,	0		/CALLED BY 'FSIN', 'FRAC'
	FENT
	FIXER		/='FNOR'
	FSUB I FLARGP
	FEXT
	NEGATE
	JMP I FRCT
/REVISED SQUARE ROOT FUNCTION

FSR,	LAS SKP		/READ THE SWITCH REGISTER
FSQT,	CHKSGN		/BETTER CHECK THE SIGN
	FLOATR		/0 OR SWITCHES
	SPA CLA		/WAS THE ARGUMENT NEGATIVE?
	ERROR2		/CAN'T TAKE IMAGINARY ROOTS
	TAD EXP		/'CHKSGN' SETS L=1
	SMA
	CLL		/USE AN ARITHMETIC SHIFT
	RAR		/DIVIDE EXPONENT BY TWO
	SZL		/TEST IF IT WAS ODD OR EVEN
	IAC		/ODD - ADD ONE
	DCA EXP
	TAD M5		/INITIALIZE ITERATION COUNTER
	DCA T3

SQRT,	FENT		/NEWTON'S METHOD IS USED
	FPUT I BUFFPT	/SAVE APPROXIMATION
	FGET I FLARGP	/GET BACK THE ARGUMENT
	FDIV I BUFFPT
	FADD I BUFFPT
	FMUL I (FLP5	/DIVIDE BY 2
	FEXT
	ISZ T3		/5 ITERATIONS ARE SUFFICIENT
	JMP SQRT
	RETURN

FRAC,	FIXIT		/FIND THE FRACTIONAL PART
	JMS FRCT
	RETURN

FOUT,	FIXIT		/SINGLE-CHARACTER OUTPUT
	SNA
	SM0		/IN CASE IT'S ZERO
	PRINTC

FSGN,	TAD HORD	/REAL SIGNUM FUNCTION
	SZA CLA
	IAC
	FLOAT		/PREPARE 1.0

FITR,	TAD P43		/IMPROVED INTEGER FUNCTION
	JMS I FRCT+2	/REPLACES 'FIXIT;CLA' (6D)

FABS,	TAD I (FLARG+1	/CHECK THE ORIGINAL SIGN
	SPA CLA
	NEGATE
	RETURN		/ALSO USED BY OTHER FUNCTIONS

	PAGE 36		/MORE AFTER THE F.P. PACKAGE
/THE 'Y' COMMAND ADDS OR SUBTRACTS ONE TO A LIST OF VARI-
/ABLES DEPENDING UPON WHETHER THE NAME IS PRECEEDED BY A
/MINUS SIGN OR NOT. THUS 'Y I' IS THE SAME AS 'S I=I+1',
/WHILE 'Y -I' IS LIKE 'S I=I-1'. SPACES, COMMAS OR MINUS
/SIGNS MAY BE USED TO SEPARATE THE NAMES: 'Y N-O,P Q- R'
/WILL ADD ONE TO 'N,P,Q' AND SUBTRACT ONE FROM 'O,R'.

DECR,	GETC		/PASS THE MINUS SIGN
	TAD YNCR+2	/MODIFY THE INSTRUCTION
	DCA YNCR-3	/'FADD/FSUB I FP1'
	SPNOR
	SORTJ		/CHECK ON WHAT TO DO
	    YLST-1
	    YGO-YLST
	PUSHJ		/ERRORS WILL BE TRAPPED HERE
	    GETARG
	TSTCMA		/REMOVE SEPARATORS
	FADD I FP1	/NOP
	FENT
	FGETIPT1	/LOAD THE VARIABLE
	FADD I FP1	/ADD OR SUBTRACT ONE
	FPUTIPT1	/STORE IT AWAY AGAIN
	FEXT
YNCR,	TAD .-6		/'Y' DO WE HAVE THIS COMMAND?
	JMP DECR+2	/REPEAT?
	FSUB I FP1	/BECAUSE THE USERS DEMAND IT!

/ 'FMIN' & 'FMAX' COMPARE TWO ARGUMENTS, RETURNING THE
/LARGER OR SMALLER OF THE TWO.  THANKS TO  R. MAZUR OF
/THE HOCHSHULE DER BUNDESWEHR IN MUENCHEN FOR THE IDEA.

FMIN,	SM0		/AC=4000
FMAX,	PUSHA		/REMEMBER THE ENTRY POINT
	PUSHF		/SAVE THE FIRST ARGUMENT
	    FLAC
	PUSHJ		/GET THE SECOND ARGUMENT
	    EVAL-3
	POPF		/RECALL ARGUMENT NO. 1
	    BUFFER
	FENT
	FSUB I BUFFPT	/MAKE THE COMPARISON
	FEXT
	POPA		/GET THE SWITCH
	TAD HORD	/CHECK THE SIGN
	SPA CLA
	TAD .+2
	JMP FSFX	/GET THE RIGHT ONE & RETURN
	BUFFPT-FLARGP
/////

FIN,	READC		/SINGLE CHARACTER INPUT
	TAD CHAR
	FLOAT		/'FLOATR'
	RETURN
/////
/FOCAL STATEMENT FUNCTIONS:  F(N,ARG1,ARG2,...)

/N IS A LINE OR GROUP NO. (USE A CONVENIENT VARIABLE TO
/LABEL THE FUNCTION) AND THE ARGUMENTS REPLACE THE VALUE
/OF THE SECRET VARIABLES, BEGINNING WITH '#'.  FSF'S ARE
/NOT FULLY RECURSIVE SINCE THEY ALL USE THE SAME SECRET
/VARIABLES.  THE VALUE RETURNED BY THE FUNCTION IS JUST
/THE LAST EXPRESSION EVALUATED.

	*SNA
FSF,	PUSHJ		/EVALUATE THE LINE NUMBER
	    MODEPT	/(ARG. IS ALREADY IN FLAC)
	PUSHF		/SAVE LINENO, NAGSW, AND LASTC
	    LINENO
	TAD FSFP

ARG,	DCA LASTC
	TSTCMA		/MORE ARGUMENTS?
	JMP DOF		/NO
	PUSHJ
	    EVAL	/GET THE NEXT ONE
	TAD LASTC
	DCA PT1		/MUST USE THE VAR. PTR.
	FENT
	FPUTIPT1
	FEXT
	TAD GINC
	TAD LASTC	/POINT TO THE NEXT
	JMP ARG

DOF,	POPA		/RESTORE LINENO & NAGSW
	DCA LINENO
	POPA
	DCA NAGSW
	PUSHJ		/EXECUTE A 'DO' CALL
	    DO+2
	POPA		/RECALL PREVIOUS POINTER
	DCA LASTC
	ISZ PDLXR	/DUMP 'FISW'
FSFX,	TAD (FGET I FLARGP
	DCA .+2
	FENT
	FGET I FLARGP	/GET THE RESULT AGAIN IN CASE
	FEXT		/A 'FOR' COMMAND WIPED IT OUT
	RETURN
/////
FSFP,	WORDS^3+STVAR+10/#

GETL,	GETLN		/READ LINE NUMBER FOR 'GTNAME'
	CDI L
	JMP NAMEND+2
/////
/IMPROVED RANDOM NUMBER FUNCTION (OMSI) USES A TTY WAIT
/LOOP TO INITIALLY SET A RANDOM VALUE.  AFTER THE FIRST
/INPUT SUCCESSIVE NUMBERS ARE GENERATED FROM THE POWER
/RESIDUE ALGORITHM DUE TO P.T. BRADY (DECUS 5-25).  SEE
/THE DISCUSSION BY G.A. GRIFFITH IN DECUS FOCAL8-1.

FRAN,   FENT            / X(1)=(2^17+3)*X(0) MOD 2^35
        FNOR I LEVEL0   / GET PREVIOUS VALUE
        FGET I (RANDOM+1/ SHIFT LEFT TWELVE
        FEXT
        DCA EXP         / ZERO THE EXPONENT
        SHIFTL
        SHIFTL          / SHIFT LEFT FOUR MORE
        SHIFTL
        SHIFTL
        JMS I (DUBLAD   / PLUS 3 TIMES ORIGINAL
        SHIFTL
        JMS I (DUBLAD
        FENT
        FPUT I LEVEL0   / SAVE FOR THE NEXT CALL
        FEXT
        CMA CLL RAR     /=3777
        AND HORD
        DCA HORD        /BE POSITIVE IT'S POSITIVE
        RETURN
/////

VFN,    TAD LORD /+HORD /GENERATE A NUMERIC FILE NAME
        SZA CLA         /IS THE ARGUMENT ZERO?
        SM0             /ROUND UP
        DCA OVER
        NORMALIZE
        SM1
        PRINTN          /CONVERT TO ASCII
        CIF L
        JMP VFR         /RETURN WITH STRING ADDRESS
/////

LGETC,  SNL             /'GETC' FOR THE LIBRARY ROUTINES
        GETC
        TAD CHAR
        CDI L
        JMP MGETC+3     /SAME PAGE, DOWN BELOW
/////

GETA,   PUSHJ           /CALLED BY 'GTNAME', 'O A' & 'O C'
            EVAL        /EVALUATE AN EXPRESSION
        FIXIT
        CIF L
        JMP MGETA-1     /DF=P, L=0
/////
        PAGE
