/PATCHES TO FOCAL ITSELF !

	FIELD 1
	*0
SETUP,	GETC		/MOVE PAST THE COMMA
	TAD ONFLAG
	SORTJ		/CHECK COMMAND CODE
	    COMLST-1
	    SETGO-COMLST
SETGO,	SET		/MULTIPLE SET COMMAND
	FINCR		/STANDARD FOR COMMAND

	*PDLXR
	RESTOR-1	/INITIALIZE STACK POINTER

	*16
	ZBLOCK 1	//FREE INDEX REGISTER

	*PC
	PC0

	*PACKST
	RESTOR-1
	RNDM		//FRAN INITIALIZATION

	*34
	ZBLOCK 4	//FREE LOCATIONS

	*FLAC
	2
	3110		/LOAD 'PI'
	3755
	2421

	*FISW
	0		/SET TO FLOATING OUTPUT

	*57
INBUF,	0		/MOVED TO SAVE A WORD
	LINE1

	*INDEV
	XI33		/PATCHED FOR 'FRAN'
GINC,	WORDS+2		//INTERCHANGE GINC & NAGSW

	*70
NAGSW,	1		//FOR CONVENIENCE OF FSF'S

	*72
MCOM,	-",		//USEFUL CONSTANT ON PAGE ZERO NOW
LIST6,	214		/F.F. (^L)
	207		/BELL
LIST7=.
	*102
M12,	-12		/DECIMAL CONVERSION CONSTANT
	*110		//REPLACE 'P277', 'M2' & 'MINUSA'
P13,	13
C100,	100

FLOAT=JMP I .		/FOR USER FUNCTIONS
	FIN+2

	*117
M4,	-4		/USED BY 'GETARG','^',& 'FRAN'

	*126
M40,	-40		/FOR 'GETLN', 'GETC', & 'RECOVR'

	*132
FP0,	FLTZER		/MOVED FOR ^L FUDGE
	LINE0
END,	STVAR		//PATCH THIS WHEN ADDING FUNCTIONS!
	LINE1

	*137
POPA=JMS I .		/REDEFINE SOME NEW INSTRUCTIONS
	XPOPA
PUSHJ=JMS I .
	XPUSHJ
POPJ=JMP I .
	XPOPJ
PUSHA=JMS I .
	XPUSHA
PUSHF=JMS I .
	PD2
POPF=JMS I .
	PD3

	*146
PACKC=JMS I .
	PACBUF

	*151
	OUT
ECHO,	CHIN		/ENTRY POINT IS USED FOR 'INSUB'

	*154
GETLN=JMS I .
	XGETLN		//MAY BE CALLED RECURSIVELY

	*166
TABCNT,	ERR2		/ERROR ENTRY IS ALSO TAB COUNTER
DPC,	PCD		/(TAD I PC) - 8K SUBROUTINES
DTHIS,	THISD		/(TAD I THISLN)
DPT1,	PT1D		/(TAD I PT1)
DXRT,	XRTD		/(TAD I XRT)
DAXIN,	AXIND		/(DCA I AXIN)
FCHECK,	TESTF		//FOCAL STATEMENT FUNCTIONS
TOP,	FEXP-WORDS-2	/ADJUSTED BY THE INITIAL DIALOG
	RECOVR-2	/MANUAL RESTART ENTRY POINT
	*201
	TAD C100	/INITIALIZE PC

	*211
	JMS I ECHO	/SHOULD WE PRINT A '*'?

	*212
	TAD BUFR	/COMMAND INPUT BUFFER

	*215
	TAD BOTTOM	/INPUT LIMIT
	DCA PACKST

	*221
	LIST7-1		/MOVED DOWN ONE
	INLIST-LIST7

	*226
BOTTOM,	RESTORE-1	/(OR PCHK-1) - START OF PDL

	*231
	TAD BUFR	/INITIALIZE FOR UNPACKING

	*235
	TAD TXTEND	/THE LAST WORD!
	DCA PACKST

	*241
	JMP GZERR	/GROUP 0 ERROR

	*245
	STL RAR		/'TAD P4000'
	TAD NAGSW	//NAGSW MOVED

	*255
	JMS I DAXIN	/DCA I AXIN

	*273
	JMS I DPC	/TAD I PC

	*302
TXTEND,	3576		/(OR 5576 W/O FILE COMMANDS)
	EJECT
/ROUTINE TO EVALUATE A LINE NUMBER  -  "GETLN"

XGETLN,	0
	TAD .-1		/PERMIT RECURSIVE CALLS
	PUSHA		/& DIFFERENT ENTRY POINT
	PUSHJ		/EVALUATE ARGUMENT
	    EVAL
	FIXIT		/FIX FLAC AND SET AC
	TAD M40		/MINUS THIRTY-TWO
	SMA CLA
	ERROR2		/BAD GROUP NUMBER
	TAD LORD	/GET GROUP AGAIN
	RTL6		/SHIFT INTO PLACE
	RAL
	DCA LINENO	/FIRST PART IS DONE
	NEGATE		/INTEGER PART
	FENT
	FADD I FLARGP	/SUBTRACT INTEGER
	FMUL FL100	/INCREASE FRACTION
	FADD FLP5	/ROUND OFF BINARY ARITHMETIC
	FEXT
	FIXIT		/FIX THIS PART NOW
	CLL
	SZA CLA
	JMP .+5		/NOT GROUP OR ALL
	TAD LINENO
	SNA CLA		/WAS IT ALL ?
	STL IAC		/YES: LINK & NAGSW = 1
	JMP .+7		/GROUP: LINK & NAGSW = 0
	TAD LINENO
	SNA
GZERR,	ERROR2		/GROUP ZERO IS ILLEGAL
	TAD LORD	/COMBINE GROUP & STEP NUMBERS
	DCA LINENO
	STL RAR		/SET NAGSW=4000 & CLEAR LINK
	DCA NAGSW
	POPJ		/LINK=1 IF "ALL"

FL100,	7
	3100
	0
FLP5,	0
	2000
	0
	0
	EJECT
/LIST OF FUNCTION ADDRESSES (NAMES ARE IN "FNTABL")

FNTABF=.

	ERROR5		/COM	-COMMON STORAGE
	XSQRT		/SQT	-SQUARE ROOT
	FSGN		/SGN	-SIGN (OMSI VERSION)
	FABS		/ABS	-ABSOLUTE VALUE
	FITR		/ITR	-INTEGER VALUE
	FRAN		/RAN	-RANDOM NUMBER (OMSI)
	FSIN		/SIN	-TRIG FUNCTIONS FOR
	FCOS		/COS	-ANGLES IN RADIANS
	ARTN		/ATN	-USE PI TO CONVERT
	FLOG		/LOG	-LOGARITHM (BASE E)
	FEXP		/EXP	-EXPONENTIAL (BASE E)

/END OF BASIC NUMERICAL FUNCTIONS - REMAINDER DO I/O

	FIN		/IN	-SINGLE CHARACTER INPUT
	FOUT		/OUT	-SINGLE CHARACTER OUTPUT
	FIND		/IND	-CHARACTER SEARCH
	FLEN		/LEN	-FILE LENGTH
	ERROR5		/ADC	-ANALOG INPUT
	ERROR5		/DAC	-ANALOG OUTPUT
	ERROR5		/DVM	-DIGITAL VOLTMETER
	ERROR5		/DIS	-OSCILLOSCOPE DISPLAY

/ADDITIONAL FUNCTIONS - TABLE CROSSES PAGE BOUNDARY

	ERROR5		/CNT	-FREQUENCY COUNTER
	ERROR5		/SYN	-FREQUENCY SYNTHESIZER
	ERROR5		/REQ	-FREQUENCY GENERATOR
	ERROR5		/TIM	-TIME OF DAY (CLOCK)
	ERROR5		/TRG	-SCHMITT TRIGGERS
	ERROR5		/POT	-POTENTIOMETERS
	ERROR5		/SWS	-SENSE SWITCHES
	ERROR5		/RLY	-RELAY REGISTER
	ERROR5		/PSD	-DIGITAL LOCK-IN
	ERROR5		/AVR	-SIGNAL AVERAGER
	ERROR5		/FFX	-FAST FOURIER TRANSFORM

/NOTE: THE ORIGINAL CODE FOR 'FADC' AND 'FDIS' REMAINS AND
/USERS WITH THE APPROPRIATE HARDWARE MAY PUT THE ADDRESSES
/IN THE TABLE IN PLACE OF 'ERROR5': FADC=1343 & FDIS=1142.
/CHANGES TO "DO" DUE TO MOVING NAGSW & GINC FOR F FUNCTIONS
/ALSO HANDLES MULTIPLE CALLS IN ONE COMMAND: DO 5.1,4,12.9

	*420
DO,	TAD DOEXIT	/SET UP NORMAL EXIT
	PUSHA
	GETLN

	*426
	    CHAR	//SAVE CHAR,LINENO,NAGSW (AND T2)
	TAD NAGSW

	*436
	JMS I DXRT	/TAD I XRT

	*444
	    CHAR
	JMS I DPC

	*452
	TAD NAGSW

	*460
	JMS I DPT1	/TAD I PT1

	*455
	JMS I DPT1	/TAD I PT1

	*470
	    CHAR

	*473
	TAD CHAR	/CHECK FOR ADDITIONAL CALLS
	TAD MCOM
	SZA CLA
	POPJ		/EXIT "DO"
	GETC		/MOVE PAST COMMA
	JMP DO+2	/'DO' ANOTHER ONE!
DOEXIT,	PROC
	EJECT
	/PUSH DOWN LIST SUBROUTINES - STACK IN FIELD 0

XPUSHA,	0
	CDI
	JMP I .+2
	JMP I XPUSHA
	APUSHX

XPUSHJ,	0
	CLA IAC
	TAD XPUSHJ	/BUMP RETURN ADDRESS
	JMS XPUSHA	/SAVE IT ON THE STACK
	TAD I XPUSHJ	/GET THE ADDRESS
	DCA XPUSHJ	/INDIRECT INDIRECT!
	JMP I XPUSHJ

XPOPA,	0
	CDF
	TAD I PDLXR
	CDF 10
	JMP I XPOPA

RETRN,	TAD C100	/R COMMAND
	DCA PC
XPOPJ,	JMS XPOPA
	DCA XPOPA
	JMP I XPOPA

PD2,	0		/PUSHF
	TAD PD2
	CDI
	DCA I .+3
	CDF 10		/RESET CALLING FIELD
	JMP I .+2	/FAKE A JMS
	MPD2
	MPD2+1

PD3,	0		/POPF
	CLA CMA
	TAD I PD3
	ISZ PD3
	DCA XRT
	JMS XPOPA	/DUMP FOUR WORDS
	DCA I XRT
	JMS XPOPA
	DCA I XRT
	JMS XPOPA
	DCA I XRT
	JMS XPOPA
	DCA I XRT
	JMP I PD3
	EJECT
INPUT,	0		/RELOCATED TO EXPAND COMMANDS
	TAD I ECHO	/READS FROM KEYBOARD OR TEXT
	SZA CLA		/WHICH ONE?
	JMP .+3
	GETC		/TEXT
	JMP I INPUT

	READC		/KEYBOARD
	SORTJ
	    SPECIAL-1	/_,RO,LF,ALT,^L
	    INFIX-SPECIAL
	JMP I INPUT
INLIST=.

	*575
	FINFIN		/; SHORT FORM
	FLIMIT-1	/CR
	SETUP		/, CHECK S,F
	*622
	DCA ONFLAG	/SAVE CODE - CLEAR FLAG

	*630
	TAD ONFLAG
	SORTJ		/COMMAND BRANCH POINT
	    COMLST-1
	    COMGO-COMLST
WRITE=.+1
	*652
	JMS I DTHIS	/TAD I THISD
	*657
	TAD NAGSW	//NAGSW MOVED
	*661
	JMS I DPT1	/TAD I PT1
	*664
	JMS I DPT1	/TAD I PT1
	*673
	TAD NAGSW

	*756
	GETC		/X COMMAND - FOR I/O AND
XECUTE,	PUSHJ		/FOCAL STATEMENT FUNCTIONS
	    EVAL
	SORTJ
	    GLIST
	    ELIST-GLIST-1
	JMP XECUTE

ELIST,	XECUTE-1
	PROCESS
	PC1

/FOCAL COMMAND CODES:  THERE ARE FOUR NEW COMMANDS!

COMLST=.
	"S		/SET
	"F		/FOR
	"D		/DO
	"I		/IF
	"O		/ON
	"G		/GOTO
	"Z		/ZERO
	"R		/RETURN
	"X		/XECUTE
	"C		/COMMENT
	"L		/LIBRARY
	"A		/ASK
	"T		/TYPE
	"W		/WRITE
	"M		/MODIFY
	"E		/ERASE
	"Q		/QUIT
	LF		/STAR
	LF		/STAR
	*1017
	CMA CLL RAL	/'TAD M2'

	*1027
	JMS I MCR	/PATCH "IF"

	*1032
	ILIST-TLIST	/ILIST MOVED

	*1045
	TAD MEQ		/MOVED

	*1054
	POPA

	*1070
	EVAL		/ADD 1

/CHANGES TO "FOR" FOR NEGATIVE INCREMENTS & FASTER LOOPING:

	*1112
LIMIT,	    BUFFER	/LEAVE FLARG ALONE
	POPF
	    FLAC	/LOAD INCREMENT
	POPA
	DCA PT1		/VARIABLE POINTER
	GETSGN
	DCA T3		/SAVE SIGN OF INCREMENT
	FENT
	FADD I PT1	/INCREMENT LOOP INDEX
	FPUT I PT1	/AND SAVE IT AGAIN
	FSUB I LIMIT	/COMPARE WITH LIMIT
	FEXT
	TAD T3		/SET PROPER SIGN
	SPA CLA
	NEGATE
	GETSGN		/NOW TEST IT
	SMA SZA CLA
	POPJ		/END OF LOOP
	TAD M16		/EFFECTIVE PUSHDOWN FOR
	TAD PDLXR	/PT1, INCREMENT, LIMIT,
	DCA PDLXR	/TEXTP, AND PUSHJ PROC.
	JMP I FPROC	/CONTINUE LOOP
M16,	-16
MEQ,	-"=

FDIS=.			/ORIGINAL DISPLAY FUNCTION
	*1145
	TAD MCOM	/MCOM MOVED TO PAGE ZERO

	*1155
	POPA

	*1157
	RETURN		/CLEARS AC IF NON-ZERO
/COMMAND BRANCH POINTS:

COMGO=.

	SET
	FOR
	DO
	IF
	ON
	GOTO
	ZERO
	RETRN
	XECUTE
	COMMENT
	LIB
	ASK
	TYPE
	WRITE
	MODIFY
	ERASE
	QUIT
	STAR
	STAR
/CHANGES TO "ASK" "TYPE" & "MODIFY"

	*1203
	PUSHJ		/EVALUATE EXPRESSION
	    EVAL
	JMS I FOUTPUT	/PRINT RESULT
TYPE,	DCA ATSW	/NEW ATSW

TASK,	SORTJ		/!,",#,$,%,: ?
	    ALIST-1
	    ATLIST-ALIST
	ISZ ATSW	/"ASK" OR "TYPE" ?
	JMP TYPE-3

	PUSHJ		/LOOKUP VARIABLE
	    GETARG
	TAD CHAR	/SAVE NEXT CHARACTER
	DCA ATSW
	TAD ALIST	/GET ":"
	ISZ I ECHO	/'JMS I ECHO' TO PRINT IT
	CLA IAC
	JMS I FINPUT	/READ A NUMBER
	TAD ATSW
	DCA CHAR	/RESTORE CHARACTER
ASK,	CMA
	JMP TYPE	/SET ATSW


TCRLF,	TAD CCR		/'!'=CR AND LF
	PRINTC

TASK4,	DCA DEBGSW	/RE-ENABLE TRACE
	GETC		/MOVE ALONG
	JMP TASK

FORMAT,	GETC		/MOVE PAST '%'
	GETLN		/GET FORMAT
	TAD LINENO
	DCA FISW	/SAVE FOR LATER
	JMP TASK

SPLAT,	TAD CCR		/'#'=CR W/O LF
	JMS I OUTDEV
	DCA I TABCNT	/RESET TAB COUNTER
	TAD C200	/GET NULL FOR DELAY
	JMP TCRLF+1

ATSW=	ONFLAG
	EJECT
/NEW MODIFY COMMAND - ALSO PERMITS 'MOVING' LINES:

/IF A SECOND LINENO IS GIVEN (SEPARATED BY A COMMA) THE
/MODIFIED LINE WILL BE SAVED WITH A NEW NUMBER, LEAVING
/THE OLD LINE UNCHANGED.

MODIFY,	GETLN		/READ THE FIRST LINENO
	SORTC		/CHECK FOR A SECOND ONE
	    COMMA-1
	GETC		/MOVE PAST COMMA
	PUSHJ		/OTHERWISE 'EVAL' GIVES ZERO
	    EVAL
	TAD BUFR	/SET 'TEXTP'
	DCA AXIN
	FINDLN		/LOOK UP OLD LINE
	ERROR2		/NOT THERE
	DCA XCTIN
	GETSGN
	SZA CLA		/NEW LINENO?
	PUSHJ		/YES: SET IT UP
	    XGETLN+5
	TAD LINENO
	JMS I DAXIN	/PACK IT
	ISZ DEBGSW	/DISABLE TRACE & PROTECT LINENO
SCONT,	JMS I INDEV	/GET SEARCH CHARACTER (SILENTLY)
	DCA DMPSW

	*1277
	LISTGO-LIST3	/LISTGO HAS MOVED

	*1310
	LIST6-1
	SRNLST-LIST6

	*1354
QUOTE,	ISZ DEBGSW	/DISABLE TRACE
	GETC
	SORTJ		/" OR CR
	    TLIST2-1
	    TLIST3-TLIST2
	PRINTC
	JMP QUOTE+1

SRNLST,	1273
	SCONT
	1302		/MOVE UP ONE TO ADD TAB
	SCONT+1
LISTGO,	0261
	1312

ALIST,	":		/ADDED FOR TAB
/CHANGES TO GETARG FOR DOUBLE SUBSCRIPTING, FASTER LOOKUP,
/THE ZERO COMMAND AND ZERO-VARIABLE REPLACEMENT.

	*1411
	TAD ADD		/SAVE NAME
	DCA EFOP	/WHERE WE CAN PUSH IT
GETLP,	GETC		/GET NEXT CHAR
	SORTC		/END OF NAME?
	    TERMS-1
	JMP GSERCH	/YES
	ISZ XCTIN	/IS THIS THE SECOND CHAR
	JMP GETLP	/IGNORE ADDITIONAL CHARS
	TAD CHAR	/PACK SECOND CHAR
	AND P77		/MASK IT
	JMP GETLP-2	/ADD TO NAME

GSERCH,	TSTLPR		/CHECK FOR SUBSCRIPT
	JMP GS1
	JMS I GECALL	/PICK IT UP
	JMS I LOOK42	/CHECK FOR SECOND SUBSCRIPT

GS1,	DCA SUBS	/SAVE SUBSCRIPT
	TAD EFOP	/INSERT NAME AT END OF TABLE
	DCA I LASTV	/TO MAKE SURE THAT IT IS FOUND
	TAD .+2		/BEGIN WITH 'SECRET' VARIABLES
	JMP GLOOP+2
	STVAR-1

	CMA		/BACKUP TO NAME
GLOOP,	TAD XRT
	TAD XINC	/ADVANCE TO NEXT ONE
	DCA XRT
	TAD I XRT	/COMPARE NAMES
	CIA
	TAD EFOP
	SZA CLA
	JMP GLOOP	/TRY AGAIN
	TAD XRT		/END OF TABLE ?
	CIA
	TAD LASTV
	SNA CLA
	JMP MAKVAR	/YES: ADD NEW VARIABLE
	TAD I XRT	/NO: CHECK FOR SUBSCRIPT MATCH
	CIA
	TAD SUBS
	SZA CLA
	JMP GLOOP-1	/NOT THIS ONE
GEXIT,	STL IAC		/FOUND: POINT TO DATA
	TAD XRT
	DCA PT1
	POPJ		/LINK=1
	EJECT
ZLOOP,	SNL CLA		/ORGANIZED TO RETAIN ERROR CODE
	ERROR2		/STORAGE FULL
	TAD I XRT	/IS THIS ONE ZERO?
	SNA CLA
	JMP ZFOUND	/YES
	TAD XRT
	TAD XINC
ZSERCH,	DCA XRT		/POINT TO MANTISSA
	TAD XRT		/CHECKED THEM ALL YET?
	CLL CMA
	TAD LASTV
	JMP ZLOOP

MAKVAR,	TAD TOP		/TEST FOR OVERFLOW
	CLL CIA
	TAD LASTV
	SZL CLA
	JMP ZINITL	/REPLACE A ZERO VARIABLE
	TAD LASTV	/UPDATE STORAGE LIMIT
	TAD GINC
	DCA LASTV
	TAD SUBS	/INSERT SUBSCRIPT
	DCA I XRT
SET20,	DCA I XRT	/ZERO DATA
	TAD XRT
	DCA PT1		/SET POINTER
	JMP ZEXIT
SUBS=.

	*1527
ZEXIT,	DCA I XRT
	DCA I XRT
	DCA I XRT	/(POPJ) FOR 3 WORD VERSION
	POPJ		/LINK=0

	*1546
	TAD SORTCN	/SAME RESULT
	TAD M11		/WITHOUT M271

	*1553
ZINITL,	STL RTL
	TAD END		/INITIALIZE X-REGISTER
	JMP ZSERCH

ZFOUND,	TAD M4		/POINT TO NAME
	TAD XRT
	DCA XRT
	TAD EFOP
	DCA I XRT	/REPLACE THE NAME
	JMP SET20-2	/AND THE SUBSCRIPT

XINC,	WORDS+1
GECALL,	ECALL
LOOK42,	TEST42
	*1567
ATLIST,	XTAB		/FOR : ADDITION
	FORMAT		/%
	QUOTE		/"
	TCRLF		/!
	SPLAT		/#
	TDUMP		/$
	TASK4		/SP
	TASK4		/,

	PAGE





	*1626		/'EVAL' FOUND A TERMINATOR WHICH IS
	JMP 1650	/NOT AN OPERATOR->END OF EXPRESSION
	TAD FP0		/POINT TO 0 FOR MISSING OPERANDS
	DCA PT1
	CMA CLL RAL	/'TAD M2'

	*1705
	POPA

	*1736
	DCA I ECHO	/CLEAR FLAG

	*1757
	POPA

	*1757
	JMS I FCHECK	/CHECK FN NAME FOR ZERO
	SORTJ		/FUNCTION FINDER - NEW TABLES
	    FNTABL-1
	    FNTABF-FNTABL
	*2010
FIN,	READC		/SINGLE CHARACTER INPUT
	TAD CHAR
	DCA HORD	/FLOAT ROUTINE
	DCA LORD
	TAD P13		/SET PROPER EXPONENT
	DCA FLAC
	DCA OVER2
EFUN3,	FENT		/END OF FUNCTION CALLS
	FNOR FLAC	/LET NORMALIZE SAVE FLAC

	*2050
	POPA

	*2053
	POPA

	*2077
	DCA T3		/NUMBER OF WORDS TO DELETE

	*2105
	CDF		/CHANGE DATA FIELD FOR 'DELETE'

	*2122
	TAD T3

	*2132
	TAD T3

	*2136
	TAD T3

	*2146
	TAD T3
	EJECT
/LIST OF CODED FUNCTION NAMES (ADDRESSES ARE IN "FNTABF")

	*2155
FNTABL=.

	2567		/COM
	2702		/SQT
	2650		/SGN
	2533		/ABS
	2636		/ITR
	2630		/RAN
	2654		/SIN  "PLT"="SIN"
	2575		/COS
	2572		/ATN
	2625		/LOG
	2624		/EXP  "INT"="EXP"

	1140		/IN
	2672		/OUT
	2604		/IND  "FCRT=FIND"
	2610		/LEN
	2517		/ADC
	2525		/DAC
	2611		/DVM
	2565		/DIS  "AVE"="DIS"

	2574		/CNT
	2714		/SYN
	2643		/REQ
	2657		/TIM  "NUM"="TIM"
	2673		/TRG
	2662		/POT
	2715		/SWS
	2671		/RLY
	2652		/PSD  "SET"="PSD"
	2602		/AVR
	1144		/FFX  "FFT"="FIN"
/ERASE COMMAND IS ONLY FOR TEXT - USE ZERO FOR VARIABLES

ERASE,	PUSHF		/GET NULL FOR HEADER
	    FLTZER
	GETLN		/WHICH LINE ?
	SNL		/ALL ?
	JMP ERL		/ERASE LINES OR GROUPS
ERA,	TAD ENDT	/ERASE ALL
	DCA BUFR
	CDF		/TEXT IS IN FIELD 0
	DCA I CFRS	/PLACE ZERO IN FIRST LINE
	CDI
	JMP NONAME	/UPDATE HEADER

ERL,	TAD BUFR	/PROTECT REST OF TEXT
	DCA AXIN
ERG,	DELETE		/EXTRACT GIVEN LINE
	ISZ THISLN	/ADVANCE ONE LINE
	TAD NAGSW	/GROUP OPERATION?
	SMA CLA		/SKIP IF SINGLE LINE
	JMS I DTHIS	/TAD I THISLN
	TSTGRP		/DONE ERASING GROUP?
	JMP ERA+4	/YES: ERASE PROGRAM FLAG
	JMS I DTHIS	/UPDATE LINE NUMBER
	DCA LINENO
	JMP ERG		/CONTINUE

	*2253
	JMS I DXRT	/TAD I XRT

	*2262
	JMS I DTHIS	/TAD I THISLN
	EJECT
/CHANGES TO 'GETC' TO TURN "@" INTO A "SPACE".

	*2276
UTRA=.-2
UTE,	SPA		/DON'T CLEAR AC
	TAD C100	/300-377 & 340-376
	TAD M77		/240-276 & 200-236
	SNA
	JMP UTX		/"?" FOUND
UTQ,	TAD P337
	DCA CHAR
	TAD DEBGSW
	TAD DMPSW
	SNA CLA		/PRINT ONLY IF BOTH ARE ZERO
	PRINTC
	JMP I UTRA	/RETURN
EXTR,	JMS GET1
	SMA		/REVERSE TESTING AT 'UTE'
	JMP UTE+1
	JMP UTE+2
UTX=.
	*2326
	TAD M40
	JMP UTQ
GET1,	0		/UNPACK 6 BITS
	ISZ XCT		/WHICH HALF ?
	JMP GET3
GEND=.+1
	*2341
	JMP EXTR
	TAD CHAR	/BITS 6-11 ONLY
	SZA		/ADD 40 IF ZERO
	TAD M40
	JMP I GET1	/RETURNS TO UTE OR EXTR+1
GET3,	CDF
	TAD I AXOUT
	CDF 10
	DCA GTEM
	CMA
	DCA XCT
	TAD GTEM
	RTL6		/'BSW;NOP' FOR 8/E
	RAL
	JMP GEND

	*2361
	CDF		/CHANGE TO TEXT FIELD

	*2374
	DCA I P77	/WE'VE ADDED A NEW LINE: KILL
	CDF 10		/'CURRENT PROGRAM SAVED' FLAG

	*2377
TLIST3,	TASK4
	*INFIX+1
	INPUT+1		/RO
	INPUT+1		/LF

	*INFIX+4
	INPUT+1		/^L

FLTONE,	0001		/ALL THIS MUST BE MOVED DOWN ONE
	2000
FLTZER,	0000
	0000
	0000
	0000

ILIST,	IF1		/,  LIST MOVED TO EXPAND COMMANDS
	PROCESS		/;
	PC1		/CR

TERMER,	0		/COMMAND WORD SORT
	SORTC
	    GLIST-1
	ISZ TERMER	/2ND EXIT = FOUND
	CDI
	JMP I TERMER

	*2432
	CMA CLL RAL	/GENERATE A "."
	JMS I ODG

	*2436
	TAD M140	/PSEUDO SPACE

	*2453
	TAD M12		/PATCH 'PRNT'

	*2466
OUT,	0		/"PRINTC"
	SNA		/USE AC IF NON-ZERO
	TAD CHAR	/OTHERWISE USE CHAR
	TAD MCR
	CIF
	JMS I .-1	/ADJUST TAB COUNTER
	JMS I OUTDEV	/NORMAL RETURNS
	JMP I OUT
	JMS I OUTDEV	/CARRIAGE RETURNS !
	TAD CLF
	JMP .-4

ODG,	OUTDG
	EJECT
	-"?
PACBUF,	0	/CHANGES TO 'PACKC' TO SAVE FIVE WORDS
	TAD .-2
	*2507
	TAD P40
	*2512
	JMP I RUBIT
	TAD P377
	*2516
P377,	AND (140	/DOUBLE DUTY
	TAD M140
	SZA
	TAD (140
M140,	SZA CLA
	JMP PA1
	TAD P77		/200-237 & 340-377
	JMS PCK1
PA1,	TAD T2		/240-337
	AND P77
	SZA		/OMIT 300
	JMS PCK1
PACX,	CDF 10
	JMP I PACBUF
RUBIT,	RUB1
PCK1=.
	*2541
	JMS AXIND	/DCA I AXIN
P40,	40
	DCA ADD
	TAD PACKST	/CHECK LIMIT
	CLL CIA

	*2552
AXIND,	0		/8K PATCH
	CDF
	DCA I AXIN
	CDF 10
	JMP I AXIND

	*2564
CHIN,	0		/'READC' (IF AC=0)
	SNA		/'ECHO' IF AC NON-ZERO
	JMS I INDEV
	DCA CHAR
	SORTJ		/PRESERVES 'SORTCN'
	    ECHOLST-1	/FOR FUNCTION CALLS
	    ECHOGO-ECHOLST
IECHO,	PRINTC		/'ION' IF NOT ECHOING
	JMP I CHIN
ECHOGO,	.-1		/DON'T ECHO
	.-2		/LF OR R.O.

	PAGE
/INTERRUPT PROCESSOR: CHANGES FOR ^F AND ^C

M3,	-3		/KEYBOARD KONSTANT
INTRPT,	DCA SAVAC	/SAVE WORKING REGISTERS
	RAR
	DCA SAVLK

TINT,	TSF		/CHECK OUTPUT FIRST WHILE DF=0
	JMP KINT
	TCF
	DCA TELSW	/TURN OFF THE IN-PROGRESS FLAG
	TAD I OPTRI	/I/O BUFFER IS IN FIELD 0 NOW
	SNA
	JMP KINT	/DONE
	TPC		/TYPE NEXT CHARACTER
	DCA TELSW	/CLEAR AC & TURN ON THE FLAG
	DCA I OPTRI	/ZERO OUT THE DATA JUST USED
	TAD OPTRI	/GET POINTER AND
	IAC		/ADVANCE MODULO 16
	AND P17		/(CIRCULAR BUFFER)
	TAD OPTR0	/ADD START
	DCA OPTRI	/NEW POINTER

KINT,	KSF		/NOW CHECK KEYBOARD
	JMP XINT
	KRS		/READ BUFFER
	AND P177	/IGNORE PARITY
	SNA		/LEADER/TRAILER ?
	JMP XINT-1
	TAD M3
	SNA		/TEST FOR CTRL C
	JMP MINT
	TAD M3
	SNA		/TEST FOR CTRL F
	JMP RECOVR
	TAD CTRLF	/RESTORE
	DCA XI33+1	/SAVE AND KILL ISZ
	TAD INBUF
	SZA CLA		/TEST FOR OVERFLOW
	ERROR2
	TAD XI33+1	/'ZBLOCK 2' FOR 8/E
	DCA INBUF
	KCC		/CLEAR BUFFER

XINT,	JMP .+3		/CDI ?0	     -PATCH FOR OTHER
	ZBLOCK 2	/JMP I .+1   -INTERRUPT SERVICE
			/?INT	     -IN ANY FIELD
	TAD SAVLK
	CLL RAL
	TAD SAVAC
	CDI
	JMP 4		/RE-ENABLE INTERRUPT SYSTEM

MINT,	CDI
	JMP I P7600	/MONITOR = 07600
/TTY INTERUPT I/O HANDLERS:
/OUTPUT BUFFER HAS BEEN MOVED AND THE INPUT
/IS MODIFIED SO AS TO INCREMENT A RANDOM NO.

XI33,	0		/VIA (INDEV)
	ISZ I PT1	/BUMP RANDOM NUMBER
	TAD INBUF	/ANY INPUT?
	SPA SNA		/YES AND NON-ZERO RNDM NO.
	JMP .-3		/NO OR ZERO RANDOM NUMBER
	DCA XI33+1	/SAVE TEMPORARILY
CTRLF,	206		/'KCC' FOR 8/E
	DCA INBUF	/CLEAR INPUT BUFFER
	TAD XI33+1	/PLACE CHARACTER IN AC
	JMP I XI33

OPTR0,	IOBUF
OPTRI,	IOBUF
OPTRO,	IOBUF

XOUTL,	0		/VIA (OUTDEV)
	DCA XI33	/SAVE CURRENT CHARACTER
	CDF
	ION		/BE SURE INTERRUPT IS ON
	TAD I OPTRO	/ANY ROOM?
	SZA CLA		/A CHARACTER IS NON-ZERO
	JMP .-2		/NO = WAIT
	IOF
	TAD TELSW	/IN PROGRESS?
	SZA CLA
	JMP .+5		/YES
	TAD XI33	/NO
	TLS		/TYPE CHARACTER
	DCA TELSW	/SET IN-PROGRESS FLAG
	JMP .+10	/RETURN
	TAD XI33	/PUT DATA IN EXTRA
	DCA I OPTRO	/BUFFER SPACE
	TAD OPTRO	/ADVANCE POINTER
	IAC		/MODULO 16
	AND P17		/(CIRCULAR STORE)
	TAD OPTR0	/ADD BEGINNING
	DCA OPTRO	/NEW VALUE
	ION
	CDF 10
	JMP I XOUTL

SAVAC,	0
SAVLK,	0
TELSW,	0
	EJECT
/ERROR RECOVERY ROUTINE - REWRITTEN TO PROVIDE FOR
/PROPER RESTARTING OF LOW SPEED READER AS WELL AS
/MANUAL RESTARTS.

ERROR5,	DCA ERR2	/TABLE ERROR
ERR2,	0		/TAB COUNTER TOO !
	ION
	TAD TELSW	/WAIT FOR OUTPUT TO FINISH
	SZA CLA
	JMP .-2
	CMA
	TAD ERR2	/PREPARE ERROR CODE
	JMP RECOVR+1

RECOVX,	TAD M40		/CREATE A "?"
	PRINTC
	PRNTLN		/FOLLOWED BY ERROR CODE
	ISZ PC
	JMS I DPC	/GET PROGRAM STEP
	SNA
	JMP .+6		/DIRECT COMMAND ERROR
	DCA LINENO
	TAD P7700
	PRINTC		/ATSIGN
	PRINTC		/SPACE
	PRNTLN		/LINE NO.
	TAD CCR
	PRINTC
	JMP START

	DCA TELSW	/CLEAR BUSY FLAG
	SKP CLA		/MANUAL RESTART = ?00.00
RECOVR,	TAD C200	/KEYBOARD BREAK = ?01.00
	DCA LINENO
	CDI		/DISABLE INTERRUPTS AND SET DF
	KCC
	DCA INBUF	/CLEAR INPUT BUFFER
	TAD OPTR0	/RESET OUTPUT POINTERS
	DCA OPTRI
	TAD OPTR0
	DCA OPTRO
	TAD M20
	DCA I OPTR0	/LOOP COUNTER
	TAD OPTR0
	DCA I P13	/FIELD 0 X-REG.
	IOF		/PATCHED BY PLOT OVERLAY
	JMP I (REKOVR	/RESTORE OUTPUT TO TTY
RUB1,	TAD XCTIN	/REMOVE A CHARACTER
	SZA CLA		/HALF-WORD?
	JMP .+7
	TAD AXIN	/CHECK POSITION
	CIA
	TAD BUFR	/BEGINNING OF LINE
	TAD DEBGSW	/PROTECT LINENO
	*3015
	JMS I ECHO	/SHALL WE ECHO A '\'?
	*3020
	CDF		/LOWER FIELD TO RUBOUT TEXT
	*3041
	PACX		/CORRECT POINTER
	*3044
	TAD C100	/MOVED

	*3052
TDUMP,	TAD DMPSW	/CHANGES FOR LOWER-FIELD TEXT,
	DCA ATSW	/TRACE PROTECTION, AND IMPROVED
	TAD END		/SUBSCRIPT OUTPUT: -999 TO +999
	DCA PT1
	TAD LASTV
	CIA
	TAD PT1
	SNA CLA		/ALL DONE?
	POPJ		/YES: END THIS LINE
	TAD P177
	DCA AXOUT	/SET 'TEXTP'
	DCA XCT
	DCA DMPSW	/TURN ON TRACE
	TAD I PT1
	CDF		/RESET BY 'GETC'
	DCA I C200	/INSERT NAME
	GETC
	GETC		/PRINT "XX("
	GETC
	ISZ PT1
	TAD I PT1	/GET THE SUBSCRIPT
	DCA T3
	JMS I SDUMP	/PRINT IT
	GETC		/PRINT ")"
	TAD ATSW
	DCA DMPSW	/RESET TRACE
	ISZ PT1
	FENT
	FGET I PT1	/GET VALUE
	FEXT
	JMS I FOUTPUT	/PRINT IT
	TAD CCR
	PRINTC
	CMA CLL RAL	/'TAD M2'
	TAD GINC
	TAD PT1
	JMP TDUMP+3	/NEXT ONE
SDUMP,	FGO6
/LIBRARY CALL AND FILE OPERATIONS:

LGOSUB,	PUSHJ		/EXECUTE SUBROUTINE
	    DO+3
	CMA CLL RTL	/LINE FEED = RETURN
LIB,	CIF		/L COMMAND ENTRY
	JMP I 7		/LCMND = FPNT IN FIELD 0

ICHAR,	0		/FILE INPUT VIA (INDEV)
	CDI
	JMS I (ICHAR0	/CALL LOWER FIELD
	JMP I ICHAR

OCHAR,	0		/FILE OUTPUT VIA (OUTDEV)
	CDI
	JMS I (OCHAR0
	JMS I (XOUTL	/ECHO RETURN
	JMP I OCHAR	/NO ECHO RETURN

EOF,	0		/TRYING TO READ FROM A FILE
	TAD (XI33	/AFTER THE END (SHAME ON YOU!)
	DCA INDEV	/RESET POINTER TO TTY
	TAD CPRNT+1	/AND TURN ON THE ECHO
	DCA I (IECHO
	TAD (XOUTL	/'EOF' IS ALSO USED BY 'RECOVR'
	DCA OUTDEV
	TAD P337	/RETURN A "_" TO CLEAR
	JMP I EOF	/THE "^Z" PREVIOUSLY READ
	EJECT
/CROSS-FIELD LINKS:

CGET,	0		/'GETC' FOR DOWN BELOW
	GETC
	TAD CHAR
	CDI
	JMP I CGET

CPRNT,	0		/FOR TAB AND LIST ROUTINES
	PRINTC
	CDI
	JMP I CPRNT

PT1D,	0		/8K ROUTINES
	CDF
	TAD I PT1
	CDF 10
	JMP I PT1D

THISD,	0
	CDF
	TAD I THISLN
	CDF 10
	JMP I THISD

	PAGE
/THE ZERO COMMAND AND PROTECTED VARIABLES LIVE HERE:

ZERO,	TESTC		/Z COMMAND: CHECK ARGUMENT
	JMP ZALL	/T NO ARGUMENT = ALL VARIABLES
	GETC		/N ILLEGAL (SLIGHT FUDGE)
	CLA		/F IN CASE LINK=0
	SORTJ		/L NORMAL RETURN
	    GLIST-1	/LOOK FOR SPACE, COMMA
	    ZLIST-GLIST
	PUSHJ		/NEITHER SPACE NOR COMMA,
	    GETARG	/SO MUST BE A NAME
	SZL
	PUSHJ		/WRITE ZEROS
	    SET20
	JMP ZERO+3	/CHECK NEXT TERMINATOR

ZALL,	TAD END		/PUT BEGINNING
	DCA LASTV	/INTO END
	JMP ZERO+4	/AND RETURN

ZLIST,	ZERO+2		/SP
	ZERO+2		/,
	PROCESS		/;
	PC1		/CR

FNEW=.			/USER FUNCTION AREA
STVAR=.			/SYMBOL TABLE BEGINS AFTER FUNCTIONS
EXCLM=WORDS+2+.		/USED FOR DOUBLE SUBSCRIPTING
DUMMY=WORDS^3+6+.	/USED FOR FOCAL STATEMENT FUNCTIONS
	*4400
UPDATE,	CLA CMA		/'ONCE-ONLY' CODE
	TAD END
	DCA I (GLOOP-2	/INITIALIZE VARIABLE SEARCH
	TAD END
	DCA LASTV
	TAD GLOOK	/PI
	JMS GLOOK
	FENT
	FPUT I PT1
	FEXT
	TAD (4100	/!
	JMS GLOOK
	TAD PT1
	DCA I (DIMEN	/DIMENSION CONSTANT
	TAD (4200	/"
	JMS GLOOK
	TAD (4300	/#
	JMS GLOOK
	TAD PT1
	DCA I (ARG-1	/FIRST DUMMY VARIABLE
	TAD (4400	/$
	JMS GLOOK
	TAD (4500	/%
	JMS GLOOK
	CMA CLL RAL
	TAD PT1
	TAD GINC
	DCA END
	TAD END
	DCA LASTV	/CLEAR THE SYMBOL TABLE

	TAD PACK2	/INITIALIZE THE DATE
	DCA AXIN
	DCA XCTIN
	TAD I (7666	/TODAY (IN CODE)
	SZA
	JMP .+3
	TAD PACKIT	/INSERT EARLY STOP
	JMP NODATE
	RTL6
	RAR
	AND P17
	JMS PACK2
	TAD I (7666
	RTR
	AND P77
	CLL RAR
	JMS PACK2
	TAD (7		/GOOD 'TILL 1980 !
	JMS PACKIT
	TAD I (7666
	AND (7
	JMS PACKIT
	TAD ADD		/GET HALF-WORD
	SZA		/CHECK IF STORED
	JMS I DAXIN
NODATE,	CDI
	DCA I (NAMLOC
	TAD P177
	DCA I (K177	/RESET POINTER AND
	JMP NONAME+2	/PUT DATE IN HEADER

PACK2,	NUDATE-1
	DCA T1
	DCA T2
	TAD T1
	SKP
	ISZ T2
	TAD (-12
	SMA
	JMP .-3
	TAD (12
	DCA T1
	TAD T2
	SZA
	JMS PACKIT
	TAD T1
	JMS PACKIT
	CMA		/"0"-1="/"
	JMS PACKIT
	JMP I PACK2

PACKIT,	7715
	TAD C260
	DCA CHAR
	PACKC
	JMP I PACKIT

GLOOK,	2011
	DCA EFOP
	PUSHJ
	     GS1
	JMP I GLOOK

	PAGE
/EXTENDED PRECISION SIN & COS - REFERENCE DECUS FOCAL8-231
/ALGORITHM DUE TO DR. H.B. THOMPSON - UNIV. OF TOLEDO,OHIO

	*4675
	FLARG		/TEMPORARY FOR EXP
	XSQR
	*5034
	EXIT2		/POINTERS FOR ATN
	FLARG
	PIOT

	*5065
	TAD P13		/NEW LOCATION

	*5200
FCOS,	NEGATE		/COS(X)=SIN(PI/2-X)
	FENT
	FADD PIOT
	FEXT
FSIN,	GETSGN
	SNA		/X=0 ?
	RETURN
	SMA CLA		/X<0 ?
	JMP .+3
	NEGATE		/YES
	CMA
	DCA T3		/REMEMBER SIGN
	FENT
	FDIV TWOPI	/CHANGE X TO REVOLUTIONS
	FEXT

TESTQ,	TAD FLAC	/CHECK QUADRANT
	SPA
	JMP LTHALF	/QUAD I & II
	SZA CLA
	JMP GTONE
	TAD T3		/QUAD III & IV
	CMA		/REVERSE SIGN
	DCA T3
GTONE,	TAD HORD	/G.T. ONE REVOLUTION
	AND P1777	/REMOVE LEADING BIT &
	DCA HORD	/NORMALIZE = SUBTRACT
	JMS I NORM	/2^N REVOLUTIONS
	GETSGN
	SNA CLA		/TEST FOR ZERO RESULT
	RETURN
	JMP TESTQ

LTHALF,	IAC
	SZA CLA		/L.T. 1/4 ?
	JMP APPROX	/YES: QUAD I
	NEGATE		/NO:  QUAD II
	FENT
	FADD I HALF	/X->0.5-X
	FEXT
APPROX,	FENT		/SIX TERM POLYNOMIAL
	FPUT I FLARGP	/SAVE RESULT
	FMUL FLAC	/SQUARE IT
	FPUT XSQR
	FMUL C11
	FADD C9
	FMUL XSQR
	FADD C7
	FMUL XSQR
	FADD C5
	FMUL XSQR
	FADD C3
	FMUL XSQR
	FADD TWOPI
	FMUL I FLARGP	/CONVERT TO ODD POWERS
	FEXT
EXIT2,	TAD T3		/CHECK SIGN
	JMP FABS+1

HALF,	FLP5
P1777,	1777

PIOT,	1;3110;3755;2421
TWOPI,	3;3110;3755;2421
C11,	4;4313;0510
C9,	6;2500;3124
C7,	7;5464;5652;3636
C5,	7;2431;5360;3430
C3,	6;5325;0414;3220
XSQR,	ZBLOCK 4
	EJECT
PCD,	0		/SYMBOL TABLE LIMIT
	CDF
	TAD I PC
	CDF 10
	JMP I PCD

VFN,	0		/GET VARIABLE FILE NAME
	PUSHJ
	    EVAL-1	/EVALUATE THE EXPRESSION
	FIXIT		/& TAKE THE INTEGER PART
	TAD HORD
	SZA CLA		/LEAVE ZERO ALONE
	STL RAR
	DCA OVER2	/ROUND UP
	JMS I NORM
	CMA
	JMS I FOUTPUT	/SET UP THE NUMERIC STRING
	CIF
	JMP I VFN	/RETURN WITH STRING ADDRESS
NORM,	DNORM

FINFIN,	PUSHF		/DEFAULT INCREMENT
FP1,	    FLTONE
	JMP I .+1
	FCONT

/PERMANENT FUNCTIONS:

FITR,	FIXIT		/SHORTEST FUNCTION
	RETURN		/THAT THERE CAN BE

FOUT,	FIXIT		/SINGLE CHARACTER OUTPUT
	SNA
	STL RAR		/IN CASE IT'S ZERO
	PRINTC

FSGN,	GETSGN		/REAL SIGNUM FUNCTION
	SNA CLA
	RETURN		/ALSO USED BY FOUT
	FENT
	FGET I FP1
	FEXT

FABS,	TAD I .+4	/CHECK ORIGINAL SIGN
	SPA CLA
	NEGATE
	RETURN
	FLARG+1
/THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO
/INCLUDE NEGATIVE INTEGERS, I.E. %-N .  N IS THE NUMBER
/OF DIGITS TO BE OUTPUT IN FLOATING FORMAT.  TYPE %, (=%0)
/CONTINUES TO OUTPUT ALL SIGNIFICANT DIGITS IN THIS FORMAT
/BUT ADDITIONALLY ONE CAN NOW SPECIFY ANY NUMBER (1-31) OF
/DIGITS COMMEASUREATE WITH THE ACCURACY OF THE DATA.

/OTHER CHANGES IMPLEMENTED HERE ARE THE FOLLOWING: FLOATING
/FORMAT IS NOW IN STANDARD SCIENTIFIC NOTATION (ONE DIGIT
/BEFORE THE DECIMAL POINT) AND THE ROUND-OFF CONSTANT HAS
/BEEN CORRECTED (4 IS USED INSTEAD OF 5).  THE SYMBOLS AND
/COMMENTS ARE LARGELY THOSE FOUND ON PP 67-69 OF FOCAL-1969

DIGITS=12		/NUMBER OF DECIMAL DIGITS OUT

	*5400

TGO,	0
	DCA FLTXR	/SAVE BUFFER ADDRESS
	TAD FISW	/GET FORMAT SAVED BY % TRAP
	STL RTR		/SHIFT FIELD SIZE
	RTR		/BACK INTO PLACE
	RTR		/ARITHMETICALLY
	SNL		/NEGATIVE FORMAT ? (OR >W.32)
	AND P77		/REMOVE STEP NO. IF POSITIVE
	RAR		/FIELD SIZE IS ONLY 5 BITS
	SNA		/ZERO IS SPECIAL
	TAD MD		/MEANS SAME AS %-DIGITS
	DCA T1		/T1 IS NEGATIVE FOR FLOATING FORMAT
	TAD T1
	CIA		/INVERT
	SMA		/- FIELD LENGTH FOR POS. FORMAT
	JMP R6-3	/E TYPE: CALCULATE ROUND-OFF
	DCA FLAC	/F TYPE: SAVE  -FIELD LENGTH

	TAD FISW	/GET NUMBER OF DECIMAL PLACES
	AND P77		/LINE PART OF "LINENO"
	DCA DECP	/OBVIOUSLY .DD IS LESS THAN .63
	TAD FLAC
	TAD DECP
	SPA		/ F-D > 0 ?
	JMP .+5		/YES
	CLA CMA		/NO
	TAD T1
	DCA DECP	/MAKE D = F-1
	CMA
	TAD T3		/COMPARE DECIMAL EXPONENT
	SMA		/ F-D > E ?
	CLA		/NO: ROUND OFF TO F PLACES
	TAD T1		/YES
	SPA		/ D+E < 0 ?
	JMP K4-1	/YES: NO ROUNDING NEEDED, PRINT!
	TAD MD		/NO: ROUND TO D+E PLACES
	SMA		/WITH A MAXIMUM OF D PLACES
	CLA
R6,	TAD P13		/ *ROUND UP*  'TAD P7' - 3 WORDS
	DCA T2		/SAVE NUMBER+1 OF PLACES TO RND TO.
	TAD FLTXR	/START OF BUFFER-1
	TAD T2		/SET UP BUFFER ADDRESS AT WHICH
	DCA PLCE	/ROUNDING OFF SHOULD START
	TAD T2
	CIA		/SETUP COUNT OF MAXIMUM NO.
	DCA T2		/OF CARRIES ALLOWABLE
	TAD K4		/LITTLE EXTRA ON FIRST DIGIT
RET,	ISZ I PLCE	/ADD 1 TO DIGIT AT CURRENT POSITION
	TAD I PLCE
	TAD M12		/MINUS TEN
	SPA CLA		/CARRY REQUIRED?
	JMP K4+1	/NO: GO TO OUTPUT
	DCA I PLCE	/YES: MAKE CURRENT DIGIT ZERO
	ISZ T2		/BEGINNING OF BUFFER REACHED?
	JMP DECR	/NO: DECREMENT BUF. ADR. AND REPEAT
	ISZ I PLCE	/YES: SET MANTISSA TO 0.1
	ISZ T3		/COMPENSATE BY INC. EXPONENT
K4,	4		/'NOP'
	CLA CMA		/SET SIGN COUNTER
	DCA T2
	TAD FLAC	/ *PRINT*
	SNA		/FLOATING OUTPUT ?
	JMP FLOUT	/YES
	TAD T3		/COMPARE EXPONENT WITH FIELD SIZE
	SMA SZA		/ E > F ?
	JMP FLOUT+2	/YES: USE FLOATING FORMAT
	TAD DECP
	SMA		/ E < F-D ?
	CLA		/NO: TAKE P = E
	CIA		/YES: TAKE P = F-D
	TAD T3
	CIA
	DCA T1		/SET UP MINUS P

BACK,	TAD T3		/PRINT DD.DDD
	TAD T1
	SNA CLA		/ P = E ?
	JMP DIG		/YES: PRINT DIGIT
	IAC		/NO ('376' TO SUPPRESS 1ST ZERO)
	TAD T1
	SPA CLA		/ P < 1 ?
	TAD M20		/YES: PRINT SPACE (240-260), NOT 0
IN,	JMS OUTA	/PRINT CHARACTER
	ISZ T1		/P CHARACTERS PRINTED?
	JMP BACK	/NO
	CMA CLL RAL	/YES ('TAD 376')
	JMS I OPUT	/PRINT DECIMAL POINT
	JMP BACK

DECR,	CMA		/BACKUP TO TOP OF BUFFER
	TAD PLCE
	DCA PLCE
	JMP RET
FLOUT,	TAD T1		/SET FIELD SIZE
	DCA FLAC
	CLA CMA		/SET FLAG
	DCA PLCE
	ISZ TGO		/SET SECOND RETURN

DIG,	CMA
	TAD T3		/REDUCE E BY 1
	DCA T3
	JMS GETD	/GET NEXT DIGIT
	ISZ PLCE	/TEST FLAG
	JMP IN		/NORMAL RETURN

	JMS I OPUT	/PRINT FIRST FLOATING DIGIT
	CMA CLL RAL	/CREATE A PERIOD (256-260)
	SKP		/DON'T FETCH & DON'T COUNT
	JMS GETD	/FETCH NEXT DIGIT
	JMS OUTA	/PRINT IT
	JMP .-2		/AND REPEAT

DECP=.
GETD,	0		/ROUTINE TO UNLOAD BUFFER
	TAD I FLTXR	/AUTO-INDEX REG. SET UP UPON ENTRY
	ISZ FLOP	/TEST FOR END OF SIGNIFICANT FIG.
	JMP I GETD
	CLA CMA		/FORCE -1 IN ORDER TO
	DCA FLOP	/OUTPUT EXTRA ZEROS
	JMP I GETD	/LEAVE C(AC) = 0

PLCE=.
OUTA,	0
	JMS I OPUT	/PRINT CHARACTER
	ISZ FLAC	/F CHARACTERS PRINTED?
	JMP I OUTA	/NO: RETURN
	JMP I TGO	/YES: NUMBER FINISHED

MD,	-DIGITS
OPUT,	OUTDG
ABSOLV=.
/PATCHES TO REMOVE 'M2' AND 'MINUSA' FROM PAGE ZERO

	*5613
	TAD M2

	*5622
	TAD M240	/ALREADY ON PAGE ZERO

	*5650
	TAD MAT		/SUBSTITUTE -"@ FOR -"A
	SPA SNA CLA

	*5665
M2,	-2
	INPUT		/INPUT POINTER

	*5755
	CLA STL
	TAD AC1H
MAT,	SMA		/=-300
	CLL

	*5774
	ZBLOCK 4	/FOR CROSS-FIELD CALLS TO 'MULT10'
/FLOATING OUTPUT CONVERSION ROUTINES:

/REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING'
/MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) AN
/EXTENDED RANGE FOR THE SYMBOL TABLE DUMP SUBSCRIPT OUT-
/PUT (+/-999); (3) A PROVISION FOR NON-PRINTING CALLS WHICH
/JUST SET UP THE OUTPUT BUFFER.

	*6000
FLOUTP,	0
	DCA T2		/SET NON-PRINT FLAG
	GETSGN		/SAVE SIGN/ZERO INFO
	DCA FGO6
	JMS I .+2	/NOW TAKE ABSOLUTE VALUE
	JMP FGO3	/INITIALIZE DECIMAL EXPONENT
	ABSOLV

FGO1,	FENT		/NUMBER TOO SMALL
	FMUL I TENPT	/MULTIPLY BY 10.
	FEXT
	CMA		/REDUCE EXPONENT
	JMP .+5

FGO2,	FENT		/NUMBER TOO LARGE
	FMUL I PTTEN	/MULTIPLY BY 0.1
	FEXT
	IAC		/INCREASE EXPONENT
	TAD T3

FGO3,	DCA T3		/SAVE DECIMAL EXPONENT
	TAD FLAC	/CHECK BINARY EXPONENT
	SPA
	JMP FGO1	/TOO SMALL
	TAD M5
	SMA CLA		/IS EXP 0 TO 4 ?
	JMP FGO2	/TOO LARGE

FGO4,	DCA I REMPT	/CLEAR REMAINDER
	TAD SADR	/INITIALIZE BUFFER POINTER
	DCA FLTXR
	TAD FLAC	/COMPUTE FIRST DIGIT
	CMA
	DCA I DIGPT
	TAD DCOUNT
	DCA FLAC
	JMS I DOUBLE	/ROTATE OUT THE 1ST 4 BITS
	ISZ I DIGPT	/AND CLEAR DIGIT
	JMP .-2

	TAD I REMPT	/TEST FOR 0,1-9,10-15
	SNA
	JMP FGO5	/IGNORE FIRST ZERO
	TAD M12
	SPA CLA
	JMP SPACE+2	/1-9
	IAC
	DCA I FLTXR	/OUTPUT A "1"
	ISZ FLAC	/COUNT THE DIGIT
	ISZ T3		/BUMP DECIMAL EXPONENT
SPACE,	240
	TAD M12		/CORRECT THE REMAINDER
	TAD I REMPT	/COMPUTE RESULTANT OR SECOND DIGIT
	ISZ T3
	JMP .+3
	SKP

FGO5,	JMS I M10PT	/IE. 0.672 X 10 = 6 + 0.72.. ETC.
	DCA I FLTXR
	ISZ FLAC	/ALL DIGITS OUTPUT ??
	JMP .-3		/NO: CONTINUE
	TAD DCOUNT
	DCA FLOP	/SAVE NO. OF DIGITS
	TAD SADR	/GET BUFFER POINTER
	ISZ T2		/TEST PRINT FLAG
	JMS I ROUND	/OUTPUT MANTISSA
	JMP I FLOUTP	/FIXED POINT DONE

	TAD CHRT	/PRINT "E"
	PRINTC
	JMS FGO6	/OUTPUT THE EXPONENT
	JMP I FLOUTP	/FLOATING POINT DONE

FGO6,	0		/ALSO CALLED BY TDUMP
	TAD T3		/GET EXPONENT
	SPA CLA		/TEST SIGN
	STL RTL		/+2 -> -3
	TAD M5
	JMS OUTDG	/PRINT SIGN
	DCA T2		/INITIALIZE HUNDREDS
	TAD T3		/NOW TAKE ABSOLUTE VALUE
	SPA
	CIA

	SKP		/SUBSTITUTE EAE DIVIDE
	ISZ T2
	TAD M144	/SUBTRACT ONE HUNDRED
	SMA		/TEST FOR OVERDRAW
	JMP .-3
	TAD C144	/RESTORE
	DCA T3		/SAVE TENS AND UNITS
	TAD T2		/PRINT HUNDREDS
	SZA		/UNLESS ZERO
	JMS OUTDG
	TAD T3		/PRINT TWO DIGITS
	JMS I .+2
	JMP I FGO6
	PRNT

C144,	+144
M144,	-144
	"=
OUTDG,	0		/MULTI-PURPOSE ROUTINE
	SMA		/IGNORE SPACES AND THE LIKE OR
	ISZ T2		/DIGITS OTHER THAN THE FIRST !
	JMP DGOUT

	DCA T2		/SAVE THE FIRST DIGIT
	TAD SPACE	/OR 'TAD OUTDG-1' FOR AN "=" SIGN
	PRINTC		/OR 'CLA' TO REMOVE EITHER
	TAD FGO6	/GET SIGN INFO
	SNA
	DCA T3		/CORRECT EXPONENT OF ZERO
	SPA CLA
	TAD C15		/"-"
	TAD SPACE	/FOR POSITIVE NOS. ('SZA')
	PRINTC
	TAD T2		/RESTORE AC

DGOUT,	TAD C260	/FORM ASCII
	PRINTC
	JMP I OUTDG

C15,	15		/255
CHRT,	"E
ROUND,	TGO
TENPT,	TEN
PTTEN,	PTEN
M10PT,	MULT10
REMPT,	REMAIN
DIGPT,	REMAIN+1
SADR,	BUFFER-1
DCOUNT,	-DIGITS-1

FLEN,	CDI		/COMPUTE REMAINING FILE LENGTH
	JMP I .+1
	XLEN

XRTD,	0
	CDF
	TAD I XRT
	CDF 10
	JMP I XRTD
	*6254
	FMUL PTEN

	*6275
RNDM,	4421		/INCREMENTED AT RANDOM
	3040
	0001
	0000

	*6306
	INPUT

	*6311
PTEN,	-3		/INPUT-OUTPUT CONSTANT MOVED
	3146
	3146		/AND CORRECTED
	3150

/DOUBLE SUBSCRIPTING FEATURE PERMITS VARIABLES OF THE FORM:
/X(I,J).  ALGORITHM COMPUTES SINGLE SUBSCRIPT BASED ON THE
/MAXIMUM NUMBER OF ROWS OF A TWO-DIMENSION ARRAY, E.G. THE
/MAXIMUM VALUE OF I.  THIS VALUE MUST BE STORED IN THE
/FIRST "SECRET VARIABLE" (!).  THE FORMULA IS J*!-!+I.  IT
/WILL WORK NO MATTER WHAT THE VALUE OF ! IS, BUT THE SUB-
/SCRIPTS ARE ONLY UNIQUE IF !=MAX(I).

/WHILE THE NUMBER OF COLUMNS DOES NOT AFFECT THE INDEXING
/IT IS SUGGESTED FOR CONSISTENCY THAT THIS DIMENSION BE
/STORED IN THE SECOND "SECRET VARIABLE" (") SO THAT ALL
/MATRIX ROUTINES CAN USE THESE VARIABLES FOR LOOP INDICES
/THEREBY PERMITTING COMPLETELY GENERAL PROGRAMMING.

TEST42,	0		/DOUBLE SUBSCRIPTING ROUTINE
	TAD CHAR	/CHECK FOR SECOND SUBSCRIPT
	TAD MCOM
	SZA CLA
	JMP ONLY1
	PUSHF		/RECURSIVE CALLS LIKELY
	    FLAC	/SO SAVE FIRST SUBSCRIPT
	PUSHJ		/EVALUATE THE SECOND (CAN EVEN
	    EVAL-1	/HANDLE SUBSCRIPTED SUBSCRIPTS!)
	POPF		/TEMPORARY STORAGE
	    FLARG	/FOR THE FIRST ONE
	FENT
	FMUL I DIMEN	/DIMENSION (!) TIMES
	FSUB I DIMEN	/ (SECOND MINUS ONE)
	FADD I FLARGP	/PLUS OFFSET OF FIRST
	FEXT
ONLY1,	POPA		/GET VARIABLE NAME FROM PDL
	DCA EFOP	/AND RESTORE FOR SEARCH
	JMS I .+3	/CHECK FOR PROPER RIGHT PAREN.
	FIXIT		/FIX FLAC TO GET SUBSCRIPT
	JMP I TEST42
	PARTEST
DIMEN,	EXCLM+2		/DATA POINTER FOR (!)
/IMPROVED RANDOM NUMBER FUNCTION (OMSI) USES 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
/ALSO THE DISCUSSION BY G.A. GRIFFITH IN DECUS FOCAL8-1.

	DUBLAD		/X(1)=(2^17+3)*X(0) MOD 2^35
FRAN,	FENT
	FNOR RNDM-1	/LOAD FLOP
	FGET RNDM	/SHIFT LEFT TWELVE
	FEXT
	TAD M4
	DCA FLAC
	JMS I DOUBLE	/SHIFT LEFT FOUR MORE &
	ISZ FLAC	/LEAVE ZERO IN EXPONENT
	JMP .-2
	JMS I FRAN-1
	JMS I DOUBLE	/ADD IN 3 TIMES ORIGINAL
	JMS I FRAN-1
	FENT
	FPUT RNDM-1	/SAVE FOR NEXT CALL
	FEXT
	CMA CLL RAR	/=3777
	AND HORD
	DCA HORD	/BE POSITIVE IT'S POSITIVE
	RETURN



/THE TAB COMMAND FOR 'ASK/TYPE' STATEMENTS HAS BEEN EX-
/TENDED TO PERMIT 'SKIPPING' CHARACTERS DURING INPUT. A
/NEGATIVE COLUMN NUMBER SPECIFIES THE NUMBER OF CHARACTERS
/TO IGNORE; IF THE INPUT ECHO IS ON THESE CHARACTERS WILL
/BE SENT TO THE OUTPUT.  THIS FEATURE PERMITS IGNORING
/UNWANTED PARTS OF A FILE (LABELS, ETC.) DURING INPUT.

XTAB,	PUSHJ		/EVALUTE COLUMN NO.
	    EVAL-1
	FIXIT		/AND SET RESULT IN AC
	CIF
	JMP TAB		/SAME PAGE, FIELD 0

SKIP1,	READC		/SKIP ONE CHARACTER
	CIF
	JMP POS		/RETURN TO LOWER FIELD
/MISCELLANEOUS CHANGES TO FLOATING POINT PACKAGE

/MOST ARE STANDARD 4 WORD CHANGES BUT SOME ARE SUGGESTIONS
/BY JIM CRAPUCHETTES (DECUS FOCAL8-269) TO SPEED THINGS UP.

	*6402
	SKP		/'DCA OVER1' FOR 3-WORD VERSION
	DCA OVER2
JUMP=SIGNF
	*6407
	DCA JUMP	/SAVE FP INSTRUCTION
	TAD JUMP
	RTL		/MOVE "I" BIT TO LINK
	RTL		/ AND "Z" BIT TO AC0
	SPA CLA		/PAGE 0 ?
	TAD FPNT	/NO, GET PAGE #
	AND P7600
	DCA T1		/AND SAVE IT ('MQL')
	TAD JUMP	/NOW GET RELATIVE LOCATION
	AND P177
	TAD T1		/MERGE PAGE ADDRESS ('MQA')
	DCA T1
	SNL		/WAS IT INDIRECT ?
	JMP .+3		/NO
	TAD I T1	/YES
	DCA T1
	ISZ FPNT	/BUMP TO NEXT INSTRUCTION
	CMA
	TAD T1
	DCA FLTXR2	/SET UP TRANSFER
	TAD JUMP	/GET OP CODE
	CLL RTL
	RTL
	AND P17
	SNA
	JMP FLGT	/0 = "FGET"
	TAD OPTABL	/POINT TO OPERATION
	DCA JUMP
	TAD I JUMP
	SNA
	JMP FLPT	/0 = "FPUT"
	DCA JUMP
	TAD I FLTXR2	/MOVE OPERAND INTO FLOP
	DCA FLOP
	TAD I FLTXR2
	DCA AC1H
	TAD I FLTXR2
	DCA AC1L
	TAD I FLTXR2	/'JMP I JUMP' FOR 3 WORDS
	DCA OVER1
	JMP I JUMP

FLPT,	TAD .+2
	JMP XFER
	FLAC-1
FLGT,	TAD .-1
	DCA FLTXR2
	CMA
	TAD T1
XFER,	DCA FLTXR	/AVOID LOOP OVERHEAD
	TAD I FLTXR
	DCA I FLTXR2
	TAD I FLTXR
	DCA I FLTXR2
	TAD I FLTXR
	DCA I FLTXR2
	TAD I FLTXR	/'JMP FPNT+1' FOR 3 WORDS
	DCA I FLTXR2
	JMP FPNT+1

FIND,	FIXIT		/CHARACTER SEARCH FUNCTION
	CIA
	DCA FPNT
	JMP FINDER

	*6515
FINDER,	JMS I INDEV	/READ A CHARACTER INTO AC
	TAD FPNT
	SNA		/FOUND IT ?
	RETURN		/DON'T ECHO SEARCH CHAR.
	TAD LORD	/NO:   RESTORE CODE
	JMS I ECHO	/& ECHO AS DIRECTED
	JMP FINDER
COMMA,	",		/'SORTA USEFUL'
FLEX=.			/"^" ENTRY POINT CHANGED
	*6537
	DCA T1
	NOP		/PATCH FOR 3-WORD VERSION

	*6545
	FLTONE		/MOVED DOWN ONE

	*6550
	JMP .+5		/IMPROVED "^" LOOP
	JMS I OPTABL+4
	TAD M4		/PSEUDO PUSHF - SAME DATA
	TAD PDLXR
	DCA PDLXR
	POPF		/RECALL ARGUMENT
	    FLOP
	ISZ T1
	JMP .-7
	JMP FPNT+1
OPTABL,	.+11

	PAGE
	FLEX

	*TEST2
	43
	*7003
	214		/^L IS IGNORED IN AN 'ASK' COMMAND

	*DMULT4
	DCA DATUM-5

	*7072
	NOP

/CHANGES TO THE SIGN-CHECKING ROUTINES FOR MULTIPLY/DIVIDE
/IN ORDER TO SHORTEN THEM SOMEWHAT TO MAKE ROOM FOR "ZERO".

	*7102
	JMS RESOLV	/EXIT FROM 'FMUL' AND 'FDIV'
	JMS I .+2	/SET SIGN AND NORMALIZE
	JMP I .-3
	DNORM

	*7127
	STL RAR		/SET 4000

	*7132
	DCA SIGNF	/SIGN OF PRODUCT/QUOTIENT
	GETSGN
	SNA		/TEST FOR ZERO RESULT
	JMP ZER0
	SPA CLA		/TAKE ABSOLUTE VALUE
	NEGATE
	TAD AC1H
	SZA		/REVERSE THIS SKIP
	JMP I SIGN

ZER0,	DCA FLAC	/QUICK EXIT IF RESULT IS ZERO
	DCA HORD
	DCA LORD
	DCA OVER2
	JMP I SIGN-1	/FPNT+1
	EJECT
/CORRECTIONS TO THE DIVIDE ROUTINE FOR 3 WORD MANTISSAS

	*MIF
	-43		/SHIFT COUNT FOR DIVIDE

	*7271		/CORRECT THE DIVIDE ROUTINE
	TAD OVER1
	TAD OVER2
	DCA TEST4
	RAL
	TAD AC1L	/COMBINE ONE POSITION
	TAD LORD
	DCA MP2		/SAVE RESULT
	RAL
	TAD HORD	/ADD OVERFLOW
	TAD AC1H
	SNL		/SKIP IF OVERFLOW
	JMP .+6
	DCA HORD	/UPDATE FLAC
	TAD TEST4
	DCA OVER2
	TAD MP2
	DCA LORD
	CLA		/IF NO OVERFLOW
	TAD MP1		/SAVE OVERFLOW BITS CIRCULARLY
	RAL
	DCA MP1
	TAD MP4
	RAL
	DCA MP4
	TAD DNORM
/FOCAL STATEMENT FUNCTIONS:  F(N,ARG1,ARG2,...)

/N IS A LINE OR GROUP NO. (CONVENIENTLY USE A VARIABLE
/NAME WHICH IDENTIFIES THE FUNCTION!) AND THE ARG'S RE-
/PLACE THE VALUE OF THE FIRST ENTRIES IN THE SYMBOL TABLE
/BEGINNING WITH THE PROTECTED VARIABLE (#). THUS THE FIRST
/THREE REPLACEABLE VARIABLES ARE #,$,%.  NOTE THAT ! AND "
/ARE USED FOR SUBSCRIPTING.  FUNCTIONS REQUIRING MORE THAN
/THREE ARGUMENTS WILL NEED TO DEFINE ADDITIONAL SYMBOLS AT
/THE BEGINNING OF THE TABLE.  AS AN EXAMPLE:  Z;Z D1 D2 D3
/SETS UP THREE ADDITIONAL "DUMMY" VARIABLES.  OF COURSE
/THEY ARE PERFECTLY GOOD REGULAR VARIABLES TOO.

	*7502
TESTF,	0		/CHECK FOR FSF FUNCTION
	POPA		/GET FUNCTION NAME
	SZA		/CHECK FOR 0 = "F"
	JMP I TESTF	/NORMAL FUNCTION

FSF,	PUSHJ		/EVALUATE LINE NUMBER
	    XGETLN+5	/(ARG. IS ALREADY IN FLAC)
	TAD ONFLAG	/SAVE CURRENT POINTER
	PUSHA		/FOR RECURSIVE CALLS
	PUSHF		/SAVE RESULTS
	    LINENO	/AND NAGSW
	TAD .+2		/FIRST DUMMY VARIABLE
	JMP ARG+7
	DUMMY+2

ARG,	PUSHJ		/EVALUATE REAL ARGUMENTS
	    EVAL-1
	FENT
	FPUT I ONFLAG	/SAVE UNDER DUMMY NAME
	FEXT
	TAD ONFLAG
	TAD GINC	/ADVANCE TO NEXT ONE
	DCA ONFLAG
	TAD CHAR
	TAD MCOM
	SNA CLA		/ADDITIONAL ARGUMENTS ?
	JMP ARG

DOF,	POPF		/RESTORE LINENO & NAGSW
	    LINENO
	TAD SORTCN	/SAVE SORTCN
	PUSHA
	PUSHJ		/EXECUTE A DO BRANCH
	    DO+3
	POPA
	DCA SORTCN
	POPA		/RESTORE POINTER
	DCA ONFLAG
	JMP I .+1	/LEAVE FLARG ALONE
	EFUN3+4
IFF,	IF+1
	*SPA SNA
LGETLN,	0		/FOR LIBRARY COMMANDS
	GETLN
	CIF
	JMP I LGETLN

/ON COMMAND:  ON (EXPRESSION)-,0,+;CONTINUATION

/THIS COMMAND WORKS JUST LIKE THE 'IF' COMMAND EXCEPT THAT
/AFTER EXECUTING THE BRANCH THE PROGRAM RETURNS TO THE NEXT
/COMMAND (WHICH MAY BE ON THE SAME LINE).  ALSO, IT IS NOW
/POSSIBLE TO INDICATE THE REST OF THE LINE AS THE SELECTED
/BRANCH BY OMITTING THE LINE NUMBER.  THUS: "IF (-1),X,Y;Z"
/WILL ZERO THE VARIABLES AND "ON (X-Y)X,,Y" WILL CONTINUE
/THE PROGRAM IF X=Y, OTHERWISE IT WILL FIRST CALL X OR Y
/(WHICHEVER IS SMALLEST) AND THEN CONTINUE THE PROGRAM.

	OCMND
ON,	TESTC		/O COMMAND
	CMA		/T ON  "
	DCA ONFLAG	/N SET FLAG
	JMP I IFF	/F CONTINUE
	CIF		/L "O"THER
	JMP I ON-1

/"IF" PATCH TO CHECK FOR MISSING LINENO (=CONT. SAME LINE)
/ALSO DECIDES BETWEEN "IF" (=GOTO) AND "ON" (=DO) BRANCHES.

	*-215		/VIA MCR !
ONTEST,	0
	GETLN
	SZL		/CHECK FOR BLANK
	JMP I ONTEST
	ISZ ONFLAG	/TEST FLAG
	JMP I IFTEST	/IF
	SORTC		/ON
	    COMMA-1
	DCA CHAR	/PREVENT MULTIPLE CALLS
	PUSHJ
	    DO+3
	JMP I ONTEST	/CONTINUE
IFTEST,	GOTO+1
