/ FUNCTION PACKAGE FOR 32K LAB-FOCAL		-JVZ-

/ FQ: MULTI-TASKING OPERATIONS

/ THIS CODE ADDS A TASK SCHEDULER AND FOUR INDEPENDENT TIMERS
/TO LAB-FOCAL.  IT WAS ORIGINALLY DESIGNED AND IMPLEMENTED BY
/JAMES N. BUTCH OF EAGLE RESEARCH CORP., ST.ALBANS, W.V., FOR
/THAT FIRM'S COSMOS-8 SYSTEM.  THIS VERSION IS BASICALLY SIM-
/ILAR, BUT USES ONLY ONE PAGE OF CODE INSTEAD OF TWO.

/ THE CENTRAL IDEA IS THAT OF A 12-LEVEL PRIORITY QUEUE WHICH
/ALLOWS SELECTED 'DO' CALLS TO BE SCHEDULED IN A USER-DEFINED
/SEQUENCE.  THESE CALLS CAN BE INITIATED DIRECTLY BY THE PRO-
/GRAM, AS A RESULT OF A HARDWARE INTERRUPT, OR AT A GIVEN IN-
/TERVAL (OR TIME) SET BY ONE OF FOUR INDEPENDENT TIMERS.

/ MULTI-TASKING OPERATION IS CONTROLLED BY THE 'FQ' FUNCTION,
/WITH CALLS HAVING 1, 2, 3 OR 4 ARGUMENTS:

/	FQ(TASKNO, LINENO, TIMER/TRIGGER, INTERVAL)

/WHERE 'TASKNO' IS A VALUE FROM 1-12 WHICH DEFINES THE PRIOR-
/ITY OF THE TASK (1=HIGHEST, 12=LOWEST), 'LINENO' IS THE LINE
/(OR GROUP) NUMBER SPECIFYING WHAT TO DO, 'TIMER' IS THE NUM-
/BER (1-4) OF THE OPTIONAL TIMER USED TO SCHEDULE THIS PARTI-
/CULAR TASK, AND 'INTERVAL' IS A VALUE (LESS THAN 2^23) WHICH
/SPECIFIES THE NUMBER OF SECONDS BETWEEN CALLS.  POSITIVE IN-
/TERVALS REPEAT -- NEGATIVE VALUES MEAN 'DO IT ONLY ONCE...'.

/ TASKS WHICH DO NOT USE ANY OF THE TIMERS CAN BE INITIALIZED
/BY A CALL GIVING JUST THE TASK- AND LINE-NUMBER; A CALL WITH
/ONLY THE TASK NUMBER WILL THEN SCHEDULE THAT TASK FOR EXECU-
/TION.  (ALTERNATIVELY, THE TASK CAN BE STARTED BY A HARDWARE
/INTERRUPT.)  SPECIFYING A LINENO VALUE OF 'ZERO' WILL REMOVE
/THE TASK FROM THE ASSIGNMENT TABLE.  'NEGATIVE' LINE NUMBERS
/ARE NOT RECOGNIZED BY THE 'FQ' FUNCTION -- HENCE ONLY SINGLE
/LINES OR ENTIRE GROUPS CAN BE ASSIGNED AS TASKS.  CALLS WITH
/THREE ARGUMENTS DEFINE SCHMITT-TRIGGER EVENTS (LAB OVERLAY).

/ A TASK NUMBER OF '0' DE-ACTIVATES THE SCHEDULER WITHOUT DE-
/STROYING THE CURRENT ASSIGNMENTS.  A VALUE GREATER THAN '12'
/RESTARTS IT.  NEGATIVE TASK NUMBERS CAUSE THE ENTIRE ASSIGN-
/MENT TABLE TO BE CLEARED.  CALLS OF THE FORM 'FQ(0,MSK)' SET
/AN INTERNAL EVENT MASK TO SELECTIVELY IGNORE CERTAIN EVENTS.

/ THERE ARE SOME RESTRICTIONS DUE TO THE NATURE OF THE IMPLE-
/MENTATION WHICH SHOULD BE KEPT IN MIND WHEN DESIGNING MULTI-
/TASKING PROGRAMS: 1) THE CLOCK IS DISABLED DURING SYSTEM I/O
/CALLS, HENCE THE TIMING MAY BE OFF; 2) THE SCHEDULER IS ONLY
/CALLED WHEN THE PROGRAM BEGINS A NEW LINE, HENCE THE CURRENT
/LINE ALWAYS HAS THE HIGHEST PRIORITY; THIS CAN INHIBIT OTHER
/TASKS INDEFINITELY (E.G. WHILE WAITING FOR KEYBOARD INPUT!).

/NOTE: NO ERROR IS GIVEN IF A TASK IS REQUESTED SEVERAL TIMES
/BEFORE IT HAS A CHANCE TO RUN, BUT IT WILL ONLY BE RUN ONCE!
/NOTE: THE TASK SCHEDULER IS CALLED AT THE START OF EACH LINE
/AND DURING 'HESITATES'.  LOADING A NEW PROGRAM CLEARS 'FQSW'.

	*14000
SCHED,	TAD THISLN	/UPDATE THE PROGRAM COUNTER
	DCA PC
	TAD FQSW	/IS THE SCHEDULER ENABLED?
	SZA CLA
	TAD EVFLGS	/TEST (MASKED) EVENT FLAGS
	AND EVMASK
	STL CIA
	TAD CPLEVL	/COMPARE WITH CURRENT LEVEL
	SNL CLA
	JMP I (XPOPJ	/LOWER PRIORITIES MUST WAIT

	TAD CPLEVL	/SAVE CURRENT TASK LEVEL
	PUSHA
	TAD (TSKTBL-1	/INITIALIZE TABLE POINTER
	DCA STOR
	SKP		/'PUSHA' SETS THE LINK!
QLUP,	TAD CPLEVL
	RAR		/4000, 2000, 1000, ETC.
	DCA CPLEVL
	ISZ STOR	/BUMP TABLE POINTER
	TAD CPLEVL
	AND EVMASK
	CIF P		/FREEZE EVENTS MOMENTARILY
	AND EVFLGS
	SNA
	JMP QLUP	/NOT THIS LEVEL
	CMA
	AND EVFLGS
	DCA EVFLGS	/RESTORE, SANS HIGHEST BIT

	CDF L
	TAD I STOR	/GET TASK ASSIGNMENT
	CDF P
	SNA
	JMP SCHEDX	/'0' = 'NOP'
	DCA LINENO
	TAD LINENO
	AND P177	/STRIP STEP NUMBER
	DCA NAGSW
	PUSHJ		/'PUSHJ' SETS THE LINK!
	    DEWPT
SCHEDX,	POPA		/RESTORE PREVIOUS LEVEL
	DCA CPLEVL
	JMP SCHED+2	/AND RUN SCHEDULER AGAIN
/////
EVMASK,	7777		/EVENT MASK

/NOTE: 'SET FQ(0,NEW.MASK.VALUE)' CHANGES THE VALUE OF EVMASK
FQUE,	FIXIT		/GET TASK NUMBER
	STL CIA
	DCA FQSW	/USE SCHEDULER SWITCH
	TAD (TSKTBL-1
	DCA STOR	/INITIALIZE POINTER
	ISZ STOR
	RAR		/4000, 2000, 1000, ETC.
	SNA
	JMP QUE3	/TASKNO NOT <1:12>
	ISZ FQSW
	JMP .-5
	DCA FQSW	/SAVE PRIORITY CODE

	TSTCMA		/ONLY ONE ARGUMENT?
	JMP QUE2	/YES, SCHEDULE TASK
	GETLN
	TAD LINENO	/SAVE LINE/GROUP NO.
	CDF L
	DCA I STOR
	TSTCMA		/NEED A TIMER?
	FLOATR		/NO

	GETNXT		/GET TIMER NUMBER
	CLL RAL
	AND P7		/MODULO 4
	TAD (TASKID
	DCA STOR	/INDEX INTO ID TABLE
	TSTCMA
	SKP		/NO VALUE = DISABLE
	TAD FQSW
	DCA I STOR	/STORE PRIORITY CODE
	GET10X		/GET 10*PRESET VALUE
	SM0
	JMS I ABSOL	/GET -(ABSOLUTE VAL.)
	TAD STOR	/PLACE IN TABLE
	TAD (TIMERS-TASKID-1
	JMS STOR
	TAD SIGN	/ONLY ONCE?
	SMA CLA
	FLOAT		/(ONCE EVERY 19.4 DAYS!)
	SP6
/OR	TAD (PRESET-TIMERS-2
	TAD XRT
	JMS STOR
/////

QUE1,	TSTCMA		/EVENT MASK SPECIFICATION?
	FLOATR
	GETNXT		/SET EVENT MASK (-1 = ALL)
	DCA EVMASK
QUE2,	TAD FQSW	/GET PRIORITY CODE
	CMA
	CIF P		/LOCK OUT INTERRUPTS
	AND EVFLGS
	TAD FQSW	/SET THE DESIRED BIT
	DCA EVFLGS
	FLOATR		/RE-ENABLE INTERRUPTS

QUE3,	ISZ HORD	/NEGATIVE TASK NO.?
	JMP QUE1
	TAD (TSKTBL-1	/YES
	CDI L
	JMP I STOR	/CLEAR ASSIGNMENT TABLE

STOR,	0		/PUT D.P. ENTRY IN TABLE
	DCA XRT		/SAVE INDEX
	TAD HORD
	CIF P		/FREEZE THINGS MOMENTARILY
	DCA I XRT
	TAD LORD
	DCA I XRT
	JMP I STOR	/REENABLE INTERRUPTS AGAIN

/NOTE: INTERRUPT CODE ASSUMES 'PRESET' = 'TIMERS'+10

TIMERS,	ZBLOCK 2^4	/FOUR D.P. COUNTERS

PRESET,	ZBLOCK 2^4	/INITIAL VALUES FOR ABOVE

	PAGE
/ FCOM AND FRA:  RANDOM ACCESS FUNCTIONS

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

/THE VALUE OF THE 'FCOM' FUNCTION IS JUST THE VALUE STORED AT
/THE LOCATION REFERENCED.  TO STORE A NEW VALUE AT THAT LOCA-
/TION, SIMPLY INCLUDE A SECOND PARAMETER IN THE FUNCTION CALL.
/THE VALUE OF THE EXPRESSION WILL THEN BE PLACED IN THE ARRAY
/AT THE SPECIFIED LOCATION.  DATA CONVERSION BETWEEN INTEGER
/AND FLOATING-POINT FORMATS IS DONE AUTOMATICALLY.  EXAMPLES:

/SET X(I)=FCOM(I+1); SET FCOM(J,FSQT(J)); SET FCOM(K,FCOM(L))

/THE 'FRA' FUNCTION PROVIDES SIMILAR ACCESS FOR LARGE ARRAYS
/STORED IN BINARY FORM ON ANY MASS-STORAGE DEVICE.  SEVERAL
/DATA MODES ARE AVAILABLE: SINGLE WORD (SIGNED OR UNSIGNED),
/DOUBLE PRECISION OR 4-WORD (FLOATING POINT).  THE DATA MODE
/DEFAULTS TO FLOATING POINT, BUT MAY BE CHANGED AT ANY TIME.

/THE FRA FUNCTION ALWAYS ACCESSES THE CURRENT INPUT FILE; TO
/ALTERNATE BETWEEN SEVERAL DIFFERENT FILES, JUST PREFACE THE
/FUNCTION CALL WITH THE APPROPRIATE 'O I/N' COMMAND:

/	O I/1 DATA;T FRA(1);O I/2;T FRA(2);O I/3,ETC.

/THE FOLLOWING FOUR GENERAL TYPES OF CALLS ARE PERMITTED:

/	FRA(+I)		READ THE I-TH VALUE
/	FRA(+I,V)	CHANGE THE I-TH VALUE
/	FRA(-1)		UPDATE THE LAST BLOCK
/	FRA(-1,M)	SET THE DATA MODE:

/	UNSIGNED INTEGERS	M= 0	256	(00 TO 4095)
/	SIGNED INTEGERS		M= 1	256	(+2047-2048)
/	TWO-WORD INTEGERS	M= 2	128	(+/- 2^23-1)
/	3-WORD FLOATING POINT	M= 3*	 85.3	(*NOT AVAIL)
/	4-WORD FLOATING-POINT	M= 4	 64	(DEFAULT= 4)

/COLUMN 3 INDICATES THE NUMBER OF DATA VALUES PER OS/8 BLOCK.

/'FRA' CALLS WITH A NEG. 'INDEX' ALWAYS RETURN THE VALUE '0'.

/'FRA' USES ITS OWN ROUTINES FOR MODES 0 AND 1 AND THE 'FCOM'
/ROUTINES FOR MODES 2 AND 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 FIRST ARGUMENT
	SPA CLA
	JMP INITL	/NEG. => INITIALIZE OR UPDATE

	FIXIT		/GET INTEGER PART OF INDEX
	SP6
	TAD W0
	CMA STL RAR	/COMPUTE SHIFT COUNT
	DCA LAST1
	SHIFTL
	ISZ LAST1
	JMP .-2
	TAD LORD
	CLL RTR
	CLL RTR
	PUSHA		/SAVE BUFFER ADDRESS
	TAD HORD
	PUSHA		/SAVE RELATIVE BLOCK

	TSTCMA		/CHECK FOR A SECOND ARGUMENT
	JMP .+4		/NONE = 'FETCH'
	PUSHJ		/GET THE VALUE
	    EVAL
	TAD P13		/SET FLAG FOR 'STORE'
	DCA EX1

	POPA		/POP THE BLOCK NUMBER
	DCA XRT
	TAD XRT		/CHECK IF LEGAL BLOCK
	CDF L
	SNA
	JMP .+5		/BLOCK 0 IS ALWAYS OK
	CLL CMA
	TAD I W0+1	/COMPARE W/ FILE SIZE
	SNL CLA
	ERROR2		/INDEX IS OUT OF RANGE

	SM0		/FORCE READ OF NEW FILE
	AND I (INFLG
	TAD I (INBLK	/IS IT THE SAME BLOCK?
	CIA
	TAD XRT
	SNA CLA
	JMP FIXPT	/YES, DATA IS IN BUFFER

	JMS LAST1	/CHECK FOR ANY CHANGES
	TAD XRT
	DCA I (INBLK
	CDI L
	JMS I ATSW	/OK, READ IT IN
FIXPT,	STA STL		/BACKUP BUFFER ADDRESS
	POPA
	CDF L
	TAD I W0-1
	DCA XRT		/SAVE BUFFER ADDR.(-1)

	TAD EX1		/R OR W?
	SZA
	DCA I (INFLG	/SET THE 'CHANGED' FLAG
	TAD W0
	STL RAL
	TAD EX1		/SET UP THE PROPER EXIT
	TAD JMPR0
	DCA .+1		/PUT JUMP INSTR. INLINE

LAST1,	HLT		/CHECK FOR CHANGES & UPDATE
	CDF L
	TAD I (INFLG	/HAVE WE CHANGED ANYTHING?
	SPA SNA CLA
JMPR0,	JMP R0-1	/NO
	SM0		/YES
	CDI L
	JMS I ATSW	/WRITE IT OUT
	JMP I LAST1	/DF=L

/HERE ARE ALL THE READ AND WRITE ROUTINES:

R0,	TAD I XRT	/UNSIGNED INTEGERS
	FL0ATR
R1,	TAD I XRT	/SIGNED INTEGERS
	FLOATR
R2,	TAD P27		/DOUBLE PRECISION
	DCA EXP
R3,	JMP I .+1	/THREE-WORD SLOT
	GET+6
R4,	JMP I .+1	/FLOATING POINT
	GET+2

	IBUF		/SEPARATES LISTS BY 13

W0,	4	/MODE	/SINGLE PRECISION
	FL
W1,	FIXIT		/SIGNED OR UNSIGNED
	JMP I W3+0
W2,	FIXIT		/DOUBLE PRECISION
	JMP I W3+1
W3,	GET-2		/NO 3-WORD MODE
	GET-4
W4,	JMP I .+1	/FLOATING POINT
	PUT
FINAL,	JMS LAST1	/UPDATE THE LAST BLOCK
	FLOATR

INITL,	TSTCMA		/UPDATE OR INITIALIZE?
	JMP FINAL
	GETNXT		/EVALUATE MODE PARAMETER
	TAD M4		/AND CHECK FOR VALIDITY
	SZA
	CML IAC
	SNL CLA		/0-4? (EXCLUDING 3)
	ERROR2		/MODE ERROR
	TAD LORD
	DCA W0		/SAVE MODE PARAMETER
/////

FL0AT,	CLL RAR
	FLOAT		/UNSIGNED INTEGER FLOAT ROUTINE
	ISZ EXP
	RAR		/JUST SHIFT EVERYTHING RIGHT ONE
FLOTX,	DCA LORD
	RETURN		/'FL0ATR'
/////

FAND,	FIXIT		/D.P. (24-BIT) 'AND' FUNCTION
	PUSHA
	TAD HORD	/USEFUL FOR PACKING/UNPACKING
	PUSHA
	PUSHJ		/'FRA' FILES...
	    ENEXT
	FIXIT
	CLA I
	POPA
	AND HORD
	DCA HORD
	POPA
	AND LORD
	JMP FLOTX
/////

NXTARG,	0		/NON-RECURSIVE EVAL - 'GETNXT'
/	TAD NXTARG
/	PUSHA		/(THE COMMENTED CODE
	PUSHJ
	    EVAL
/	POPA		/MAKES IT RECURSIVE)
/	DCA NXTARG
	FIXIT
	JMP I NXTARG	/FOR COMMANDS, SOME FUNCTIONS
/////
	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

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 TXTEND	/'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:	PATCH THE 'CDF' ABOVE TO CHANGE STORAGE FIELD
/THE 'HESITATE' COMMAND PROVIDES A PROGRAMMABLE PAUSE
/WHICH CAN BE USED TO SYNCHRONIZE THE PROGRAM WITH EX-
/TERNAL EVENTS.  THE TIMING IS BASED ON A 100HZ CLOCK,
/WITH THE ARGUMENT SPECIFYING THE LENGTH (TO THE NEAR-
/EST TENTH-SECOND) OF THE DELAY INTERVAL (MAX=204.7!).

HESI,	GET10X		/PARAMETER = DELAY TIME (SEC)
	CMA
	DCA OTIM	/SAVE THE 1'S COMPLEMENT
TATE,	PUSHJ
	    SCHED+2	/CALL THE SCHEDULER
	TAD OTIM
	SPA CLA		/HAS THE TIMER RUN OUT?
	JMP TATE
	CONTINUE	/YES, CONTINUE PROGRAM
/////

/THE 'FTIM' FUNCTION ALLOWS THE PROGRAM TO KEEP TRACK OF
/REAL TIME, RESETTING THE 'STOP WATCH' WHENEVER IT LIKES.

	FL100
FTIM,	CHKSGN		/CHECK SIGN OF THE ARGUMENT
	JMP TIM0
	SPA CLA		/ - = RESET COUNTER
	DCA EXP
	FIXIT		/ 0 = READ COUNTER
	MULT10
	MULT10		/ + = PRESET COUNTER
	TAD TIM0+1
	JMS I TIM1	/ONLY SETTABLE TO WHOLE SEC
TIM0,	FENT
	FGET P27	/ALWAYS RETURN THE COUNTER
	FNOR FLAC
	FDIV I FTIM-1	/100HZ (10 MSEC) RESOLUTION
	FEXT
	RETURN
TIM1,	STOR
/////

/NOTE: 'IESET' HAS BEEN LEFT AS A SUBROUTINE INSTEAD
/OF BEING BUILT INTO 'TOCK' SO THAT OTHER INTERRUPT-
/SERVICE ROUTINES CAN CALL IT TO SET THEIR OWN FLAGS.

TEMP1,	ISZ HORD	/NON-INTERRUPT DELAY
TEMP2,	JMP TATE+4
IESET,	JMP TATE+1	/SET INTERRUPT EVENT FLAG
	DCA TEMP2
	TAD EVFLGS
	CMA		/REMOVE BIT WE'RE SETTING
	AND TEMP2
	TAD EVFLGS	/SET IT
	DCA EVFLGS
	JMP I IESET
/////
/ROUTINE TO INCREMENT THE 'FQUE' TIMERS EVERY 0.1 SEC

TOCK,	-12		/INCREMENT D.P. TIMERS
	SZA
	DCA TEMP1
	TAD TEMP1	/COPY POINTER
	DCA TEMP2
	ISZ TEMP1
	ISZ I TEMP1
	JMP NOVR	/NO OVERFLOW
	ISZ I TEMP2
	JMP NOVR	/STILL NO OVERFLOW
	TAD TEMP1
	TAD P7
	DCA IESET	/INDEX TO RESET TABLE
	TAD I IESET
	DCA I TEMP2
	ISZ IESET
	TAD I IESET
	DCA I TEMP1
	TAD I TOCK	/SET THE EVENT FLAG
	JMS IESET
NOVR,	ISZ TEMP1
	ISZ TOCK
	JMP I TOCK
/////


/SIMPLE NON-INTERRUPT LINE-PRINTER HANDLER

LPECHO,	CRTEST		/'NO ECHO'
LPCALL,	0		/SELECT WITH 'O L'
	6666
	JMS I LPECHO	/OPTIONAL ECHO
	6656
	TAD LPM23	/CHECK FOR XOFF
	AND P177
	SZA CLA		/BUFFER FULL?
	6661
	JMP LPCALL+3	/WAIT FOR LP FLAG
	JMP I LPCALL
LPM23,	-23
/////
/ FUNCTION PACKAGE FOR LAB-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.

	*ERROR2-10

/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)
/////

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
X3,	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
	FMUL I FLARGP
/	PAGE BOUNDARY
	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 'RDG' UNITS

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
	FMUL I (RDGOV4
INVRS,	FPUT I FLARGP	/OR 'FEXT'
	FGET I (RDGOV4
	FSUB I FLARGP	/ATN(X)=RDG/4-ATN(1/X)
	FEXT
	JMP I (EXIT2	/TAKE CARE OF THE SIGN
/////
/ARCTANGENT CONSTANTS

A23,	-13;4736;6436;5432
A21,	-10;2631;0515;1247
A19,	-6;5463;4630;6156
A17,	-5;2500;6471;3743
A15,	-4;5670;3654;1664
A13,	-4;2722;0766;3453
A11,	-4;4266;6330;5514
E0,	+0;3777;7777/7775
A9,	-3;2204;0441;7142
A7,	-3;5056;2150;2756
A5,	-2;2023;0156;7455
A3,	-2;4465;4651;5615
A1,	+0;2427;6301;5544
/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 26	/SKIP ONE
/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 LAB-FOCAL (JVZ).

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

FSIN,	CHKSGN		/CHECK THE SIGN
	JMP QUAD1	/ARGUMENT WAS 0
	FENT
	FDIV RDGOV4	/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 FLT1	/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		/USE '1003' INSTEAD
C11,	-22;4313;2133
C9,	-14;2500;3207
C7,	-7;5464;5650;4204
C5,	-3;2431;5360;3221
FLT1,	+1;2000;0000/0000
C3,	+0;5325;0414;3240
PIOV2,	+1;3110;3755;2421

/MISCELLANEOUS ROUTINES TO FILL OUT THE PAGE

FRCT,	0		/EXTRACT MANTISSA
	FENT
	FIXUP		/='FNOR'
	FSUB I FLARGP
	FEXT
	NEGATE
	JMP I FRCT	/USED BY 'FSIN','FRAC'

FRAC,	FIXIT		/GET THE FRACTIONAL PART
	JMS FRCT
	RETURN

FIN,	READC		/SINGLE CHARACTER INPUT
	TAD CHAR
	FLOAT		/'FLOATR'
	RETURN

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

/FOUT, FSGN, FITR AND FABS FORM A LONG CHAIN....
FSGN,	TAD HORD	/CREATE 1.0; ATTACH SIGN
	SZA CLA
	IAC
	FLOAT
SC3,
FITR,	TAD P14		/IMPROVED INTEGER FUNCTION
	JMS I FRCT+2	/REPLACES 'FIXIT;CLA' (6D)

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

FIND,	FIXIT		/CHARACTER SEARCH FUNCTION
	DCA I GETLN&177	/SAVE IN 'XGETLN'
	JMS I INDEV	/READ A CHARACTER
	DCA CHAR
	SORTJ		/CHECK FOR EOF, MATCH
	    CTRLZ-1
	    FINISH-XGETLN
	TAD CHAR	/AND ECHO AS DIRECTED
	ECHOC
	JMP FIND+2	/EOF->0, MATCH->CHAR

RDGOV4,	1;3110;3755;2421

FRDG,	FENT		/GET UNIT OF CIRCULAR MEASURE
	FPUT RDGOV4
	FEXT
	RETURN		/RAD=PI/2,  DEG=90,  GRAD=100

FDAY,	FIXIT		/READ (OR CHANGE) SYSTEM DATE
	CIF T
	JMP DAY

CMATST,	0		/TEST FOR A COMMA - 'TSTCMA'
	FLARG+1		/'CLA'
	TAD (200-",
	TAD CHAR
	SZA CLA
	JMP I CMATST	/FIRST RETURN IF IT'S NOT
	GETC
	ISZ CMATST
	JMP I CMATST	/REMOVE IT AND TAKE 2ND RTN

	PAGE 36		/MORE AFTER THE F.P. PACKAGE
/'FPAL' PROVIDES LAB-FOCAL WITH DIRECT ACCESS TO PDP/8 MA-
/CHINE CODE AT THE KEYBOARD LEVEL. THE VALUE OF THE FIRST
/ARGUMENT IS PLACED IN THE AC BEFORE CALLING THE FUNCTION
/AND THE VALUE OF THE AC IS ALSO RETURNED BY THE FUNCTION.

/THE REMAINING ARGUMENTS ARE TREATED AS A STRING OF OCTAL
/INSTRUCTIONS WHICH ARE STASHED AWAY IN FIELD 1 FROM 7601
/TO 7641.  NO ERROR CHECKING IS PERFORMED, SO BE CAREFUL!

/EX: TYPE FPAL(N,6531,6532,6534,5203,6533); READ A/D CONV

FPAL,	TAD P7600	/USE THE STRING BUFFER
	DCA PT1
	TAD FMQ		/START WITH 'FIXIT'
PAL1,	DCA I PT1	/STORE THINGS AWAY
	TAD PALX	/PREPARE A 'FLOATR'
	ISZ PT1
	DCA I PT1
	TSTCMA		/MORE?
	JMP I P7600	/NO, OVER AND OUT

PAL2,	DCA PALTM	/CLEAR INSTRUCTION
	TESTC		/LOOK FOR A TERMINATOR
	TAD PALTM	/FOUND ONE
	JMP PAL1	/F = ERROR
	GETC		/N = GET NEXT CHARACTER
	TAD PALTM	/L SHIFT PREVIOUS VALUE
	CLL RAL
	CLL RAL
	CLL RAL
	TAD SORTCN	/ADD IN THE NEXT DIGIT
	JMP PAL2
/////
F0LINKS=.		/FIELD 0 LINKS GO HERE (TO SNA-1)
/////

/NEW RANDOM NUMBER FUNCTION REPLACES OLD STANDARD (DECUS:
/FOCAL8-1).  IT HAS BEEN GIVEN ONLY MINIMAL TESTING, BUT
/APPEARS REASONABLY UNBIASED WITH NO OBSERVABLE PAIR COR-
/RELATION.				-JVZ- (MARCH '82)

	*SPA+1
FRAN,	FENT		/COMPUTE (ARG+R.N.)^2, SO THE
	FADD I LEVEL0
	FMUL FLAC	/USER MAY CHANGE THE SEQUENCE
	FPUT I LEVEL0
	FEXT
	DCA I LEVEL0	/CLEAR EXPONENT
	TAD P13
	DCA EXP
	DCA HORD	/CREATE FRAC FROM LOWER 24 BITS
	RETURN
/////
FSR=.
/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		/MAGIC LOCATION
FSF,	PUSHJ		/EVALUATE THE LINE NUMBER
	    YGETLN	/(ARG. IS ALREADY IN FLAC)
	PUSHF		/SAVE LINENO, NAGSW, AND LASTC
	    LINENO
	TAD (10		/OFFSET OF '!' FROM 'PI'
ARG,	DCA LASTC
	TSTCMA		/MORE ARGUMENTS?
	JMP DOF		/NO
	PUSHJ
	    EVAL	/GET THE NEXT ONE
	TAD LASTC
	SETSVP		/SET CDF, PT1
	FENT
	FPUTIPT1	/MUST USE THE VAR. PTR.
	FEXT
	SP4
	TAD LASTC	/POINT TO THE NEXT S.V.
	JMP ARG

DOF,	POPA
	DCA LINENO	/RESTORE LINENO & NAGSW
	POPA
	DCA NAGSW
	PUSHJ		/EXECUTE A 'DO' CALL
	    DO+2
	POPA		/RECALL PREVIOUS POINTER
	DCA LASTC
	ISZ PDLXR	/DISCARD 'FCNT'
FSFX,	TAD SQRT+2
	DCA .+2
	FENT
PALTM,	FGET I FLARGP	/GET THE RESULT AGAIN IN CASE
	FEXT		/A 'FOR' COMMAND WIPED IT OUT
	RETURN
/////

	*FSR
FSR,	LAS		/READ THE (RIGHT) SWITCHES
PALX,	FLOATR
/////

FMQ,	FIXIT		/DISPLAY A NUMBER IN THE MQ
	MQL
	RETURN		/(REQUIRES A 'FRONT PANEL')
/////
/ '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
	    ENEXT
	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 C100	/BUFFPT-FLARGP
	JMP FSFX	/GET THE RIGHT ONE & RETURN
/////

/IMPROVED SQUARE ROOT FUNCTION (NEWTON'S METHOD):

FSQT,	CHKSGN		/BETTER CHECK THE SIGN
	FLP5		/0 (NOP)
	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 EVEN OR ODD
	IAC		/ODD - ADD ONE
	DCA EXP
	TAD M5		/INITIALIZE ITERATION COUNTER
	DCA T3

SQRT,	FENT		/NEWTON'S METHOD
	FPUT I BUFFPT	/SAVE APPROX.
	FGET I FLARGP	/RESTORE ARGUMENT
	FDIV I BUFFPT
	FADD I BUFFPT
	FMUL I FSQT+1	/DIVIDE BY 2
	FEXT
	ISZ T3		/5 ITERATIONS ARE SUFFICIENT
	JMP SQRT
	RETURN
/////
	PAGE