TITLE	BASIC M6502 8K VER 1.1 BY MICRO-SOFT
SEARCH	M6502
SALL
RADIX 10			;THROUGHOUT ALL BUT MATH-PAK.

$Z::				;STARTING POINT FOR M6502 SIMULATOR
	ORG	0		;START OFF AT LOCATION ZERO.
SUBTTL	SWITCHES,MACROS.

REALIO=4			;5=STM
				;4=APPLE.
				;3=COMMODORE.
				;2=OSI
				;1=MOS TECH,KIM
				;0=PDP-10 SIMULATING 6502
INTPRC==1			;INTEGER ARRAYS.
ADDPRC==1			;FOR ADDITIONAL PRECISION.
LNGERR==0			;LONG ERROR MESSAGES.
TIME==	0			;CAPABILITY TO SET AND READ A CLK.
EXTIO== 0			;EXTERNAL I/O.
DISKO== 0			;SAVE AND LOAD COMMANDS
NULCMD==1			;FOR THE "NULL" COMMAND
GETCMD==1
RORSW==1
ROMSW==1			;TELLS IF THIS IS ON ROM.
CLMWID==14
LONGI==1			;LONG INITIALIZATION SWITCH.
STKEND=511
BUFPAG==0
LINLEN==72			;TERMINAL LINE LENGTH.
BUFLEN==72			;INPUT BUFFER SIZE.
ROMLOC= ^O20000			;ADDRESS OF START OF PURE SEGMENT.
KIMROM=1
IFE	ROMSW,<KIMROM==0>
IFN	REALIO-1,<KIMROM==0>
IFN	ROMSW,<
RAMLOC= ^O40000			;USED ONLY IF ROMSW=1
IFE	REALIO,<ROMLOC= ^O20000 ;START AT 8K.
	RAMLOC=^O1400>>
IFE	REALIO-3,<
	DISKO==1
	RAMLOC==^O2000
	ROMLOC=^O140000
	NULCMD==0
	GETCMD==1
	linlen==40
	BUFLEN==81
	CQOPEN=^O177700
	CQCLOS=^O177703
	CQOIN= ^O177706		;OPEN CHANNEL FOR INPUT
	CQOOUT=^O177711		;FILL FOR COMMO.
	CQCCHN=^O177714
	CQINCH=^O177717		;INCHR'S CALL TO GET A CHARACTER
	OUTCH= ^O177722
	CQLOAD=^O177725
	CQSAVE=^O177730
	CQVERF=^O177733
	CQSYS= ^O177736
	ISCNTC=^O177741
	CZGETL=^O177744		;CALL POINT FOR "GET"
	CQCALL=^O177747		;CLOSE ALL CHANNELS
	CQTIMR=^O215
	BUFPAG==2
	BUF==256*BUFPAG
	STKEND==507
	CQSTAT=^O226
	CQHTIM=^O164104
	EXTIO==1
	TIME==1
	GETCMD==1
	CLMWID==10
	PI=255				;VALUE OF PI CHARACTER FOR COMMODORE.
	ROMSW==1
	RORSW==1
	TRMPOS=^O306>
IFE	REALIO-1,<GETCMD==1
	DISKO==1
	OUTCH=^O17240			;1EA0
	ROMLOC==^O20000
	RORSW==0
	CZGETL=^O17132>
IFE	REALIO-2,<
	RORSW==0
	RAMLOC==^O1000
IFN	ROMSW,<
	RORSW==0
	RAMLOC==^O100000>
	OUTCH==^O177013>
IFE	REALIO-4,<
	RORSW==1
	NULCMD==0
	GETCMD==1
	CQINLN==^O176547
	CQPRMP==^O63
	CQINCH==^O176414
	CQCOUT==^O177315
	CQCSIN==^O177375
	BUFPAG==2
	BUF=BUFPAG*256
	ROMLOC=^O4000
	RAMLOC=^O25000			;PAGE 2A
	OUTCH=^O176755
	CZGETL=^O176414
	LINLEN==40
	BUFLEN==240
	RORSW==1
	STKEND=507>
IFE	RORSW,<
DEFINE	ROR (WD),<
	LDAI	0
	BCC	.+4
	LDAI	^O200
	LSR	WD
	ORA	WD
	STA	WD>>

DEFINE ACRLF,<
	13
	10>
DEFINE	SYNCHK	(Q),<
	LDAI	<Q>
	JSR	SYNCHR>
DEFINE	DT(Q),<
IRPC	Q,<IFDIF <Q><">,<EXP "Q">>>
DEFINE	LDWD	(WD),<
	LDA	WD
	LDY	<WD>+1>
DEFINE	LDWDI	(WD),<
	LDAI	<<WD>&^O377>
	LDYI	<<WD>/^O400>>
DEFINE	LDWX	(WD),<
	LDA	WD
	LDX	<WD>+1>
DEFINE	LDWXI	(WD),<
	LDAI	<<WD>&^O377>
	LDXI	<<WD>/^O400>>
DEFINE	LDXY	(WD),<
	LDX	WD
	LDY	<WD>+1>
DEFINE	LDXYI	(WD),<
	LDXI	<<WD>&^O377>
	LDYI	<<WD>/^O400>>
DEFINE	STWD	(WD),<
	STA	WD
	STY	<WD>+1>
DEFINE	STWX	(WD),<
	STA	WD
	STX	<WD>+1>
DEFINE	STXY	(WD),<
	STX	WD
	STY	<WD>+1>
DEFINE	CLR	(WD),<
	LDAI	0
	STA	WD>
DEFINE	COM	(WD),<
	LDA	WD
	EORI	^O377
	STA	WD>
DEFINE	PULWD	(WD),<
	PLA
	STA	WD
	PLA
	STA	<WD>+1>
DEFINE	PSHWD	(WD),<
	LDA	<WD>+1
	PHA
	LDA	WD
	PHA>
DEFINE	JEQ	(WD),<
	BNE	.+5
	JMP	WD>
DEFINE	JNE	(WD),<
	BEQ	.+5
	JMP	WD>
DEFINE	BCCA(Q),<	BCC	Q>	;BRANCHES THAT ALWAYS BRANCH
DEFINE	BCSA(Q),<	BCS	Q>	;THESE ARE USED ON THE 6502 BECAUSE
DEFINE	BEQA(Q),<	BEQ	Q>	;THERE IS NO UNCONDITIONAL BRANCH
DEFINE	BNEA(Q),<	BNE	Q>
DEFINE	BMIA(Q),<	BMI	Q>
DEFINE	BPLA(Q),<	BPL	Q>
DEFINE	BVCA(Q),<	BVC	Q>
DEFINE	BVSA(Q),<	BVS	Q>
DEFINE	INCW(R),<
	INC	R
	BNE	%Q
	INC	R+1
%Q:>
DEFINE	SKIP1,	<XWD ^O1000,^O044>	;BIT ZERO PAGE TRICK.
DEFINE	SKIP2,	<XWD ^O1000,^O054>	;BIT ABS TRICK.
IF1,<
IFE	REALIO,<PRINTX/SIMULATE/>
IFE	REALIO-1,<PRINTX KIM>
IFE	REALIO-2,<PRINTX OSI>
IFE	REALIO-3,<PRINTX COMMODORE>
IFE	REALIO-4,<PRINTX APPLE>
IFE	REALIO-5,<PRINTX STM>
IFN	ADDPRC,<PRINTX ADDITIONAL PRECISION>
IFN	INTPRC,<PRINTX INTEGER ARRAYS>
IFN	LNGERR,<PRINTX LONG ERRORS>
IFN	DISKO,<PRINTX SAVE AND LOAD>
IFE	ROMSW,<PRINTX RAM>
IFN	ROMSW,<PRINTX ROM>
IFE	RORSW,<PRINTX NO ROR>
IFN	RORSW,<PRINTX ROR ASSUMED>>
PAGE
SUBTTL	INTRODUCTION AND COMPILATION PARAMETERS.
COMMENT *

--------- ---- -- ---------
COPYRIGHT 1976 BY MICROSOFT
--------- ---- -- ---------
7/27/78 FIXED BUG WHERE FOR VARIABLE AT BYTE FF MATCHED RETURN SEARCHING
	FOR GOSUB ENTRY ON STACK IN FNDFOR CALL BY CHANGING STA FORPNT
	TO STA FORPNT+1. THIS IS A SERIOUS BUG IN ALL VERSIONS.
7/27/78 FIXED BUG AT NEWSTT UNDER IFN BUFPAG WHEN CHECK OF CURLIN
	WAS DONE BEFORE CURLIN SET UP SO INPUT RETRIES OF FIRST STATEMENT
	WAS GIVING SYNTAX ERROR INSTEAD OF REDO FROM START (CODE WAS 12/1/77 FIX)
7/1/78	SAVED A FEW BYTES IN INIT FOR COMMODORE (14)
7/1/78 FIXED BUG WHERE REPLACING A LINE OVERFLOWING MEMORY LEFT LINKS
	IN A BAD STATE. (CODE AT NODEL AND FINI) BUG#4
7/1/78 FIXED BUG WHERE GARBAGE COLLECTION NEVER(!) COLLECTS TEMPS
	(STY GRBPNT  AT FNDVAR, LDA GRBPNT ORA GRBPNT+1 AT GRBPAS)
	THIS WAS COMMODORE BUG #2
7/1/78 FIXED BUG WHERE DELETE/INSERT OF LINE COULD CAUSE A GARBAGE COLLECTION WITH BAD VARTAB IF OUT OF MEMORY
	 (LDWD MEMSIZ STWD FRETOP=JSR RUNC CLC ALSO AT NODEL)
3/9/78 EDIT TO FIX COMMO TRMPOS AND CHANGE LEFT$ AND RIGHT$ TO ALLOW A SECOND ARGUMENT OF 0 AND RETURN A NULL STRING
2/25/78 FIXED BUG THAT INPFLG WAS SET WRONG WHEN BUFPAG.NE.0
	INCREASED NUMLEV FROM 19 TO 23
2/11/78 DISALLOWED SPACES IN RESERVED WORDS. PUT IN SPECIAL CHECK FOR "GO TO"
2/11/78 FIXED BUG WHERE ROUNDING OF THE FAC BEFORE PUSHING COULD CAUSE A STRING POINTER
	IN THE FAC TO BE INCREMENTED
1/24/78 fixed problem where user defined function undefined check fix was smashing error number in [x]
12/1/77 FIXED PROBLEM WHERE PEEK WAS SMASHING (POKER) CAUSING POKE OF PEEK TO FAIL
12/1/77 FIXED PROBLEM WHERE PROBLEM WITH VARTXT=LINNUM=BUF-2 CAUSING BUF-1 COMMA TO DISAPPEAR
12/1/77 FIXED BUFPAG.NE.0 PROBLEM AT NEWSTT AND STOP : CODE WAS STILL
	ASSUMING TXTPTR+1.EQ.0 IFF STATEMENT WAS DIRECT
*
NUMLEV==23			;NUMBER OF STACK LEVELS RESERVED
				;BY AN EXPLICIT CALL TO "GETSTK".
STRSIZ==3			;# OF LOCS PER STRING DESCRIPTOR.
NUMTMP==3			;NUMBER OF STRING TEMPORARIES.
CONTW==15			;CHARACTER TO SUPPRESS OUTPUT.

PAGE
SUBTTL	SOME EXPLANATION.
COMMENT *

M6502 BASIC CONFIGURES BASIC AS FOLLOWS

LOW LOCATIONS
	PAGE	ZERO

		STARTUP:
		INITIALLY A JMP TO INITIALIZATION CODE BUT
		CHANGED TO A JMP TO "READY".
		RESTARTING THE MACHINE AT LOC 0 DURING PROGRAM
		EXECUTION CAN LEAVE THINGS MESSED UP.

		LOC OF FAC TO INTEGER AND INTEGER TO FAC 
		ROUTINES.

		"DIRECT" MEMORY:
		THESE ARE THE MOST COMMONLY USED LOCATIONS.
		THEY HOLD BOOKKEEPING INFO AND ALL OTHER
		FREQUENTLY USED INFORMATION.
		ALL TEMPORARIES, FLAGS, POINTERS, THE BUFFER AREA,
		THE FLOATING ACCUMULATOR, AND ANYTHING ELSE THAT
		IS USED TO STORE A CHANGING VALUE SHOULD BE LOCATED
		IN THIS AREA. CARE MUST BE MADE IN MOVING LOCATIONS
		IN THIS AREA SINCE THE JUXTAPOSITION OF TWO LOCATIONS
		IS OFTEN DEPENDED UPON.

		STILL IN RAM WE HAVE THE BEGINNING OF THE "CHRGET"
		SUBROUTINE. IT IS HERE SO [TXTPTR] CAN BE THE
		EXTENDED ADDRESS OF A LOAD INSTRUCTION.
		THIS SAVES HAVING TO BOTHER ANY REGISTERS.

	PAGE	ONE
		THE STACK.

	STORAGE PAGE TWO AND ON
		IN RAM VERSIONS THESE DATA STRUCTURES COME AT THE
		END OF BASIC. IN ROM VERSON THEY ARE AT RAMLOC WHICH
		CAN EITHER BE ABOVE OR BELOW ROMLOC, WHICH IS WHERE
		BASIC ITSELF RESIDES.

				A ZERO.
		[TXTTAB]	POINTER TO NEXT LINE'S POINTER.
				LINE # OF THIS LINE (2 BYTES).
				CHARACTERS ON THIS LINE.
				ZERO.
				POINTER AT NEXT LINE'S POINTER
					(POINTED TO BY THE ABOVE POINTER).
				... REPEATS ...
		LAST LINE:	POINTER AT ZERO POINTER.
				LINE # OF THIS LINE.
				CHARACTERS ON THIS LINE.
				ZERO.
				DOUBLE ZERO (POINTED TO BY THE ABOVE POINTER).
		[VARTAB]	SIMPLE VARIABLES. 6 BYTES PER VALUE.
				2 BYTES GIVE THE NAME, 4 BYTES THE VALUE.
				... REPEATS ...
		[ARYTAB]	ARRAY VARIABLES. 2 BYTES NAME, 2 BYTE
				LENGTH, NUMBER OF DIMENSIONS , EXTENT OF
				EACH DIMENSION (2BYTES/), VALUES
				... REPEATS ...
		[STREND]	FREE SPACE.
				... REPEATS ...
		[FRETOP]	STRING SPACE IN USE.
				... REPEATS ...
		[MEMSIZ]	HIGHEST MACHINE LOCATION.
				UNUSED EXCEPT BY THE VAL FUNCTION.

		ROM -- CONSTANTS AND CODE.

	FUNCTION DISPATCH ADDRESSES (AT ROMLOC)
		"FUNDSP" CONTAINS THE ADDRESSES OF THE
		FUNCTION ROUTINES IN THE ORDER OF THE
		FUNCTION NAMES IN THE CRUNCH LIST.
		THE FUNCTIONS THAT TAKE MORE THAN ONE ARGUMENT
		ARE AT THE END. SEE THE EXPLANATION AT "ISFUN".

	THE OPERATOR LIST
		THE "OPTAB" LIST CONTAINS AN OPERATOR'S PRECEDENCE
		FOLLOWED BY THE ADDRESS OF THE ROUTINE TO PERFORM
		THE OPERATION. THE INDEX INTO THE
		OPERATOR LIST IS MADE BY SUBTRACTING OFF THE CRUNCH VALUE
		OF THE LOWEST NUMBERED OPERATOR. THE ORDER
		OF OPERATORS IN THE CRUNCH LIST AND IN "OPTAB" IS IDENTICAL.
		THE PRECEDENCES ARE ARBITRARY EXCEPT FOR THEIR
		COMPARATIVE SIZES. NOTE THAT THE PRECEDENCE FOR
		UNARY OPERATORS SUCH AS "NOT" AND NEGATION ARE
		SETUP SPECIALLY WITHOUT USING THE LIST.

	THE RESERVED WORD OR CRUNCH LIST
		WHEN A COMMAND OR PROGRAM LINE IS TYPED IN
		IT IS STORED IN "BUF". AS SOON AS THE WHOLE LINE
		HAS BEEN TYPED IN ("INLIN" RETURNS) "CRUNCH" IS
		CALLED TO CONVERT ALL RESERVED WORDS TO THEIR
		CRUNCHED VALUES. THIS REDUCES THE SIZE OF THE 
		PROGRAM AND SPEEDS UP EXECUTION BY ALLOWING
		LIST DISPATCHES TO PERFORM FUNCTIONS, STATEMENTS,
		AND OPERATIONS. THIS IS BECAUSE ALL THE STATEMENT
		NAMES ARE STORED CONSECUTIVELY IN THE CRUNCH LIST.
		WHEN A MATCH IS FOUND BETWEEN A STRING
		OF CHARACTERS AND A WORD IN THE CRUNCH LIST
		THE ENTIRE TEXT OF THE MATCHED WORD IS TAKEN OUT OF
		THE INPUT LINE AND A RESERVED WORD TOKEN IS PUT
		IN ITS PLACE. A RESERVED WORD TOKEN IS ALWAYS EQUAL
		TO OCTAL 200 PLUS THE POSITION OF THE MATCHED WORD
		IN THE CRUNCH LIST.

	STATEMENT DISPATCH ADDRESSES
		WHEN A STATEMENT IS TO BE EXECUTED, THE FIRST
		CHARACTER OF THE STATEMENT IS EXAMINED
		TO SEE IF IT IS LESS THAN THE RESERVED
		WORD TOKEN FOR THE LOWEST NUMBERED STATEMENT NAME.
		IF SO, THE "LET" CODE IS CALLED TO
		TREAT THE STATEMENT AS AN ASSIGNMENT STATEMENT.
		OTHERWISE A CHECK IS MADE TO MAKE SURE THE
		RESERVED WORD NUMBER IS NOT TOO LARGE TO BE A
		STATEMENT TYPE NUMBER. IF NOT THE ADDRESS
		TO DISPATCH TO IS FETCHED FROM "STMDSP" (THE STATEMENT
		DISPATCH LIST) USING THE RESERVED WORD
		NUMBER FOR THE STATEMENT TO CALCULATE AN INDEX INTO
		THE LIST.

	ERROR MESSAGES
		WHEN AN ERROR CONDITION IS DETECTED,
		[ACCX] MUST BE SET UP TO INDICATE WHICH ERROR
		MESSAGE IS APPROPRIATE AND A BRANCH MUST BE MADE
		TO "ERROR". THE STACK WILL BE RESET AND ALL
		PROGRAM CONTEXT WILL BE LOST. VARIABLES
		VALUES AND THE ACTUAL PROGRAM REMAIN INTACT.
		ONLY THE VALUE OF [ACCX] IS IMPORTANT WHEN
		THE BRANCH IS MADE TO ERROR. [ACCX] IS USED AS AN
		INDEX INTO "ERRTAB" WHICH GIVES THE TWO
		CHARACTER ERROR MESSAGE THAT WILL BE PRINTED ON THE
		USER'S TERMINAL.


	TEXTUAL MESSAGES
		CONSTANT MESSAGES ARE STORED HERE. UNLESS
		THE CODE TO CHECK IF A STRING MUST BE COPIED
		IS CHANGED THESE STRINGS MUST BE STORED ABOVE
		PAGE ZERO, OR ELSE THEY WILL BE COPIED BEFORE
		THEY ARE PRINTED.

	FNDFOR	
		MOST SMALL ROUTINES ARE FAIRLY SIMPLE
		AND ARE DOCUMENTED IN PLACE. "FNDFOR" IS
		USED FOR FINDING "FOR" ENTRIES ON
		THE STACK. WHENEVER A "FOR" IS EXECUTED, A
		16-BYTE ENTRY IS PUSHED ONTO THE STACK.
		BEFORE THIS IS DONE, HOWEVER, A CHECK
		MUST BE MADE TO SEE IF THERE
		ARE ANY "FOR" ENTRIES ALREADY ON THE STACK
		FOR THE SAME LOOP VARIABLE. IF SO, THAT "FOR" ENTRY
		AND ALL OTHER "FOR" ENTRIES THAT WERE MADE AFTER IT
		ARE ELIMINATED FROM THE STACK. THIS IS SO A
		PROGRAM THAT JUMPS OUT OF THE MIDDLE
		OF A "FOR" LOOP AND THEN RESTARTS THE LOOP AGAIN
		AND AGAIN WON'T USE UP 18 BYTES OF STACK
		SPACE EVERY TIME. THE "NEXT" CODE ALSO
		CALLS "FNDFOR" TO SEARCH FOR A "FOR" ENTRY WITH
		THE LOOP VARIABLE IN
		THE "NEXT". AT WHATEVER POINT A MATCH IS FOUND
		THE STACK IS RESET. IF NO MATCH IS FOUND A
		"NEXT WITHOUT FOR"  ERROR OCCURS. GOSUB EXECUTION
		ALSO PUTS A 5-BYTE ENTRY ON STACK.
		WHEN A RETURN IS EXECUTED "FNDFOR" IS
		CALLED WITH A VARIABLE POINTER THAT CAN'T
		BE MATCHED. WHEN "FNDFOR" HAS RUN
		THROUGH ALL THE "FOR" ENTRIES ON THE STACK  
		IT RETURNS AND THE RETURN CODE MAKES
		SURE THE ENTRY THAT WAS STOPPED
		ON IS A GOSUB ENTRY. THIS ASSURES THAT
		IF YOU GOSUB TO A SECTION OF CODE
		IN WHICH A FOR LOOP IS ENTERED BUT NEVER
		EXITED THE RETURN WILL STILL BE
		ABLE TO FIND THE MOST RECENT
		GOSUB ENTRY. THE "RETURN" CODE ELIMINATES THE
		"GOSUB" ENTRY AND ALL "FOR" ENTRIES MADE AFTER
		THE GOSUB ENTRY.

	NON-RUNTIME STUFF
		THE CODE TO INPUT A LINE, CRUNCH IT, GIVE ERRORS,
		FIND A SPECIFIC LINE IN THE PROGRAM,
		PERFORM A "NEW", "CLEAR", AND "LIST" ARE
		ALL IN THIS AREA. GIVEN THE EXPLANATION OF
		PROGRAM STORAGE SET FORTH ABOVE, THESE ARE
		ALL STRAIGHTFORWARD.

	NEWSTT
		WHENEVER A STATEMENT FINISHES EXECUTION IT
		DOES A "RTS" WHICH TAKES
		EXECUTION BACK TO "NEWSTT". STATEMENTS THAT
		CREATE OR LOOK AT SEMI-PERMANENT STACK ENTRIES
		MUST GET RID OF THE RETURN ADDRESS OF "NEWSTT" AND
		JMP TO "NEWSTT" WHEN DONE. "NEWSTT" ALWAYS
		CHRGETS THE FIRST CHARACTER AFTER THE STATEMENT
		NAME BEFORE DISPATCHING. WHEN RETURNING
		BACK TO "NEWSTT" THE ONLY THING THAT
		MUST BE SET UP IS THE TEXT POINTER IN
		"TXTPTR". "NEWSTT" WILL CHECK TO MAKE SURE
		"TXTPTR" IS POINTING TO A STATEMENT TERMINATOR.
		IF A STATEMENT SHOULDN'T BE PERFORMED UNLESS
		IT IS PROPERLY FORMATTED (I.E. "NEW") IT CAN
		SIMPLY DO A RETURN AFTER READING ALL OF
		ITS ARGUMENTS. SINCE THE ZERO FLAG
		BEING OFF INDICATES THERE IS NOT
		A STATEMENT TERMINATOR "NEWSTT" WILL
		DO THE JMP TO THE "SYNTAX ERROR"
		ROUTINE. IF A STATEMENT SHOULD BE STARTED
		OVER IT CAN DO LDWD OLDTXT, STWD TXTPTR RTS SINCE THE TEXT PNTR
		AT "NEWSTT" IS ALWAYS STORED IN "OLDTXT".
		THE ^C CODE STORES [CURLIN] (THE
		CURRENT LINE NUMBER) IN "OLDLIN" SINCE THE ^C CHECK
		IS MADE BEFORE THE STATEMENT POINTED TO IS
		EXECUTED. "STOP" AND "END" STORE THE TEXT POINTER
		FROM "TXTPTR", WHICH POINTS AT THEIR TERMINATING
		CHARACTER, IN "OLDTXT".

	STATEMENT CODE
		THE INDIVIDUAL STATEMENT CODE COMES
		NEXT. THE APPROACH USED IN EXECUTING EACH
		STATEMENT IS DOCUMENTED IN THE STATEMENT CODE
		ITSELF.

	FRMEVL, THE FORMULA EVALUATOR
		GIVEN A TEXT POINTER POINTING TO THE STARTING
		CHARACTER OF A FORMULA, "FRMEVL"
		EVALUATES THE FORMULA AND LEAVES
		THE VALUE IN THE FLOATING ACCUMULATOR (FAC).
		"TXTPTR" IS RETURNED POINTING TO THE FIRST CHARACTER
		THAT COULD NOT BE INTERPRETED AS PART OF THE
		FORMULA. THE ALGORITHM USES THE STACK
		TO STORE TEMPORARY RESULTS:

			0. PUT A DUMMY PRECEDENCE OF ZERO ON
				THE STACK.
			1. READ LEXEME (CONSTANT,FUNCTION,
				VARIABLE,FORMULA IN PARENS)
				AND TAKE THE LAST PRECEDENCE VALUE
				OFF THE STACK.
			2. SEE IF THE NEXT CHARACTER IS AN OPERATOR.
				IF NOT, CHECK PREVIOUS ONE. THIS MAY CAUSE
				OPERATOR APPLICATION OR AN ACTUAL
				RETURN FROM "FRMEVL".
			3. IF IT IS, SEE WHAT PRECEDENCE IT HAS
				AND COMPARE IT TO THE PRECEDENCE
				OF THE LAST OPERATOR ON THE STACK.
			4. IF = OR LESS REMEMBER THE OPERATOR
				POINTER OF THIS OPERATOR
				AND BRANCH TO "QCHNUM" TO CAUSE
				APPLICATION OF THE LAST OPERATOR.
				EVENTUALLY RETURN TO STEP 2
				BY RETURNING TO JUST AFTER "DOPREC".
			5. IF GREATER PUT THE LAST PRECEDENCE
				BACK ON, SAVE THE OPERATOR ADDRESS,
				CURRENT TEMPORARY RESULT,
				AND PRECEDENCE AND RETURN TO STEP 1.

		RELATIONAL OPERATORS ARE ALL HANDLED THROUGH
		A COMMON ROUTINE. SPECIAL
		CARE IS TAKEN TO DETECT TYPE MISMATCHES SUCH AS 3+"F".

	EVAL -- THE ROUTINE TO READ A LEXEME
		"EVAL" CHECKS FOR THE DIFFERENT TYPES OF
		ENTITIES IT IS SUPPOSED TO DETECT.
		LEADING PLUSES ARE IGNORED,
		DIGITS AND "." CAUSE "FIN" (FLOATING INPUT)
		TO BE CALLED. FUNCTION NAMES CAUSE THE
		FORMULA INSIDE THE PARENTHESES TO BE EVALUATED
		AND THE FUNCTION ROUTINE TO BE CALLED. VARIABLE
		NAMES CAUSE "PTRGET" TO BE CALLED TO GET A POINTER
		TO THE VALUE, AND THEN THE VALUE IS PUT INTO
		THE FAC. AN OPEN PARENTHESIS CAUSES "FRMEVL"
		TO BE CALLED (RECURSIVELY), AND THE ")" TO
		BE CHECKED FOR. UNARY OPERATORS (NOT AND
		NEGATION)  PUT THEIR PRECEDENCE ON THE STACK
		AND ENTER FORMULA EVALUATION AT STEP 1, SO
		THAT EVERYTHING UP TO AN OPERATOR GREATER THAN
		THEIR PRECEDENCE OR THE END OF THE FORMULA
		WILL BE EVALUATED.

	DIMENSION AND VARIABLE SEARCHING
		SPACE IS ALLOCATED FOR VARIABLES AS THEY ARE
		ENCOUNTERED. THUS "DIM" STATEMENTS MUST BE
		EXECUTED TO HAVE EFFECT. 6 BYTES ARE ALLOCATED
		FOR EACH SIMPLE VARIABLE, WHETHER IT IS A STRING,
		NUMBER OR USER DEFINED FUNCTION. THE FIRST TWO
		BYTES GIVE THE NAME OF THE VARIABLE AND THE LAST FOUR
		GIVE ITS VALUE. [VARTAB] GIVES THE FIRST LOCATION
		WHERE A SIMPLE VARIABLE NAME IS FOUND AND [ARYTAB]
		GIVES THE LOCATION TO STOP SEARCHING FOR SIMPLE
		VARIABLES. A "FOR" ENTRY HAS A TEXT POINTER
		AND A POINTER TO A VARIABLE VALUE SO NEITHER
		THE PROGRAM OR THE SIMPLE VARIABLES CAN BE
		MOVED WHILE THERE ARE ACTIVE "FOR" ENTRIES ON THE STACK.
		USER DEFINED FUNCTION VALUES ALSO CONTAIN
		POINTERS INTO SIMPLE VARIABLE SPACE SO NO USER-DEFINED
		FUNCTION VALUES CAN BE RETAINED IF SIMPLE VARIABLES
		ARE MOVED. ADDING A SIMPLE VARIABLE IS JUST
		ADDING SIX TO [ARYTAB] AND [STREND], BLOCK TRANSFERING
		THE ARRAY VARIABLES UP BY SIX AND MAKING SURE THE
		NEW [STREND] IS NOT TOO CLOSE TO THE STRINGS.
		THIS MOVEMENT OF ARRAY VARIABLES MEANS
		THAT NO POINTER TO AN ARRAY WILL STAY VALID WHEN
		NEW SIMPLE VARIABLES CAN BE ENCOUNTERED. THIS IS
		WHY ARRAY VARIABLES ARE NOT ALLOWED FOR "FOR"
		LOOP VARIABLES. SETTING UP A NEW ARRAY VARIABLE
		MERELY INVOLVES BUILDING THE DESCRIPTOR,
		UPDATING [STREND], AND MAKING SURE THERE IS
		STILL ENOUGH ROOM BETWEEN [STREND] AND STRING SPACE.
		"PTRGET", THE ROUTINE WHICH RETURNS A POINTER
		TO A VARIABLE VALUE, HAS TWO IMPORTANT FLAGS. ONE IS
		"DIMFLG" WHICH INDICATES WHETHER "DIM" CALLED "PTRGET"
		OR NOT. IF SO, NO PRIOR ENTRY FOR THE VARIABLE IN
		QUESTION SHOULD BE FOUND, AND THE INDEX INDICATES
		HOW MUCH SPACE TO SET ASIDE. SIMPLE VARIABLES CAN
		BE "DIMENSIONED", BUT THE ONLY EFFECT WILL BE TO
		SET ASIDE SPACE FOR THE VARIABLE IF IT HASN'T BEEN
		ENCOUNTERED YET. THE OTHER IMPORTANT FLAG IS "SUBFLG"
		WHICH INDICATES WHETHER A SUBSCRIPTED VARIABLE SHOULD BE
		ALLOWED IN THE CURRENT CONTEXT. IF [SUBFLG] IS NON-ZERO
		THE OPEN PARENTHESIS FOR A SUBSCRIPTED VARIABLE
		WILL NOT BE SCANNED BY "PTRGET", AND "PTRGET" WILL RETURN
		WITH A TEXT POINTER POINTING TO THE "(", IF
		THERE WAS ONE.
	STRINGS
		IN THE VARIABLE TABLES STRINGS ARE STORED JUST LIKE
		NUMERIC VARIABLES. SIMPLE STRINGS HAVE THREE VALUE
		BYTES WHICH ARE INITIALIZED TO ALL ZEROS (WHICH
		REPRESENTS THE NULL STRING). THE ONLY DIFFERENCE
		IN HANDLING IS THAT WHEN "PTRGET" SEES A "$" AFTER THE
		NAME OF A VARIABLE, "PTRGET" SETS [VALTYP]
		TO NEGATIVE ONE AND TURNS
		ON THE MSB (MOST-SIGNIFIGANT-BIT) OF THE VALUE OF
		THE FIRST CHARACTER OF THE VARIABLE NAME.
		HAVING THIS BIT ON IN THE NAME OF THE VARIABLE ENSURES
		THAT THE SEARCH ROUTINE WILL NOT MATCH
		'A' WITH 'A$' OR 'A$' WITH 'A'. THE MEANING OF
		THE THREE VALUE BYTES ARE:
			LOW
				LENGTH OF THE STRING
				LOW 8 BITS
				HIGH 8 BITS  OF THE ADDRESS
					OF THE CHARACTERS IN THE
					STRING IF LENGTH.NE.0.
					MEANINGLESS OTHERWISE.
			HIGH
		THE VALUE OF A STRING VARIABLE (THESE 3 BYTES)
		IS CALLED THE STRING DESCRIPTOR TO DISTINGUISH
		IT FROM THE ACTUAL STRING DATA. WHENEVER A
		STRING CONSTANT IS ENCOUNTERED IN A FORMULA OR AS
		PART OF AN INPUT STRING, OR AS PART OF DATA, "STRLIT"
		IS CALLED, CAUSING A DESCRIPTOR TO BE BUILT FOR
		THE STRING. WHEN ASSIGNMENT IS MADE TO A STRING POINTING INTO
		"BUF" THE VALUE IS COPIED INTO STRING SPACE SINCE [BUF]
		IS ALWAYS CHANGING.

		STRING FUNCTIONS AND THE ONE STRING OPERATOR "+"
		ALWAYS RETURN THEIR VALUES IN STRING SPACE.
		ASSIGNING A STRING A CONSTANT VALUE IN A PROGRAM
		THROUGH A "READ" OR ASSIGNMENT STATEMENT
		WILL NOT USE ANY STRING SPACE SINCE
		THE STRING DESCRIPTOR  WILL POINT INTO THE
		PROGRAM ITSELF. IN GENERAL, COPYING IS DONE
		WHEN A STRING VALUE IS IN "BUF", OR IT IS IN STRING
		SPACE AND THERE IS AN ACTIVE POINTER TO IT.
		THUS F$=G$ WILL CAUSE COPYING IF G$ HAS ITS
		STRING DATA IN STRING SPACE. F$=CHR$(7)
		WILL USE ONE BYTE OF STRING SPACE TO STORE THE
		NEW ONE CHARACTER STRING CREATED BY "CHR$", BUT
		THE ASSIGNMENT ITSELF WILL CAUSE NO COPYING SINCE
		THE ONLY POINTER AT THE NEW STRING IS A
		TEMPORARY DESCRIPTOR CREATED BY "FRMEVL" WHICH WILL
		GO AWAY AS SOON AS THE ASSIGNMENT IS DONE.
		IT IS THE NATURE OF GARBAGE COLLECTION THAT
		DISALLOWS HAVING TWO STRING DESCRIPTORS POINT TO THE SAME
		AREA IN STRING SPACE. STRING FUNCTIONS AND OPERATORS
		MUST PROCEED AS FOLLOWS:
			1) FIGURE OUT THE LENGTH OF THEIR RESULT.

			2) CALL "GETSPA" TO FIND SPACE FOR THEIR
			RESULT. THE ARGUMENTS TO THE FUNCTION
			OR OPERATOR MAY CHANGE SINCE GARBAGE COLLECTION
			MAY BE INVOKED. THE ONLY THING THAT CAN
			BE SAVED DURING THE CALL TO "GETSPA" IS A POINTER
			TO THE DESCRIPTORS OF THE ARGUMENTS.
			3) CONSTRUCT THE RESULT DESCRIPTOR IN "DSCTMP".
			"GETSPA" RETURNS THE LOCATION OF THE AVAILABLE
			SPACE.
			4) CREATE THE NEW VALUE BY COPYING PARTS
			OF THE ARGUMENTS OR WHATEVER.
			5) FREE UP THE ARGUMENTS BY CALLING "FRETMP".
			6) JUMP TO "PUTNEW" TO GET THE DESCRIPTOR IN
			"DSCTMP" TRANSFERRED INTO A NEW STRING TEMPORARY.

		THE REASON FOR STRING TEMPORARIES IS THAT GARBAGE
		COLLECTION HAS TO KNOW ABOUT ALL ACTIVE STRING DESCRIPTORS
		SO IT KNOWS WHAT IS AND ISN'T IN USE. STRING TEMPORARIES ARE
		USED TO STORE THE DESCRIPTORS OF STRING EXPRESSIONS.
		
		INSTEAD OF HAVING AN ACTUAL VALUE STORED IN THE
		FAC, AND HAVING THE VALUE OF A TEMPORARY RESULT
		BEING SAVED ON THE STACK, AS HAPPENS WITH NUMERIC
		VARIABLES, STRINGS HAVE THE POINTER TO A STRING DESCRIPTOR
		STORED IN THE FAC, AND IT IS THIS POINTER
		THAT GETS SAVED ON THE STACK BY FORMULA EVALUATION.
		STRING FUNCTIONS CANNOT FREE THEIR ARGUMENTS UP RIGHT
		AWAY SINCE "GETSPA" MAY FORCE
		GARBAGE COLLECTION AND THE ARGUMENT STRINGS
		MAY BE OVER-WRITTEN SINCE GARBAGE COLLECTION
		WILL NOT BE ABLE TO FIND AN ACTIVE POINTER TO
		THEM. FUNCTION AND OPERATOR RESULTS ARE BUILT IN
		"DSCTMP" SINCE STRING TEMPORARIES ARE ALLOCATED
		(PUTNEW) AND DEALLOCATED (FRETMP) IN A FIFO ORDERING
		(I.E. A STACK) SO THE NEW TEMPORARY CANNOT
		BE SET UP UNTIL THE OLD ONE(S) ARE FREED. TRYING
		TO BUILD A RESULT IN A TEMPORARY AFTER
		FREEING UP THE ARGUMENT TEMPORARIES COULD RESULT
		IN ONE OF THE ARGUMENT TEMPORARIES BEING OVERWRITTEN
		TOO SOON BY THE NEW RESULT.

		STRING SPACE IS ALLOCATED AT THE VERY TOP
		OF MEMORY. "MEMSIZ" POINTS BEYOND THE LAST LOCATION OF
		STRING SPACE. STRINGS ARE STORED IN HIGH LOCATIONS
		FIRST. WHENEVER STRING SPACE IS ALLOCATED (GETSPA).
		[FRETOP], WHICH IS INITIALIZED TO [MEMSIZ], IS UPDATED
		TO GIVE THE HIGHEST LOCATION IN STRING SPACE
		THAT IS NOT IN USE. THE RESULT IS THAT
		[FRETOP] GETS SMALLER AND SMALLER, UNTIL SOME
		ALLOCATION WOULD MAKE [FRETOP] LESS THAN OR EQUAL TO
		[STREND]. THIS MEANS STRING SPACE HAS RUN INTO THE
		THE ARRAYS AND THAT GARBAGE COLLECTION MUST BE CALLED.

		GARBAGE COLLECTION:
			0. [MINPTR]=[STREND] [FRETOP]=[MEMSIZ]
			1. [REMMIN]=0
			2. FOR EACH STRING DESCRIPTOR
			(TEMPORARIES, SIMPLE STRINGS, STRING ARRAYS)
			IF THE STRING IS NOT NULL AND ITS POINTER IS
			.GT.MINPTR AND .LT.FRETOP,
			[MINPTR]=THIS STRING DESCRIPTOR'S POINTER,
			[REMMIN]=POINTER AT THIS STRING DESCRIPTOR.
			END.
			3. IF REMMIN.NE.0 (WE FOUND AN UNCOLLECTED STRING),
			BLOCK TRANSFER THE STRING DATA POINTED
			TO IN THE STRING DESCRIPTOR POINTED TO BY "REMMIN"
			SO THAT THE LAST BYTE OF STRING DATA IS AT
			[FRETOP]. UPDATE [FRETOP] SO THAT IT
			POINTS TO THE LOCATION JUST BELOW THE ONE
			THE STRING DATA WAS MOVED INTO. UPDATE
			THE POINTER IN THE DESCRIPTOR SO IT POINTS
			TO THE NEW LOCATION OF THE STRING DATA.
			GO TO STEP 1.

		AFTER CALLING GARBAGE COLLECTION "GETSPA" AGAIN CHECKS
		TO SEE IF [ACCA] CHARACTERS ARE AVAILABLE BETWEEN
		[STREND] AND [FRETOP]; IF NOT, AN "OUT OF STRING"
		ERROR IS INVOKED.

	MATH PACKAGE
		THE MATH PACKAGE CONTAINS FLOATING INPUT (FIN),
		FLOATING OUTPUT (FOUT), FLOATING COMPARE (FCOMP)
		... AND ALL THE NUMERIC OPERATORS AND FUNCTIONS.
		THE FORMATS, CONVENTIONS AND ENTRY POINTS ARE ALL
		DESCRIBED IN THE MATH PACKAGE ITSELF.

	INIT -- THE INITIALIZATION ROUTINE
		THE AMOUNT OF MEMORY,
		TERMINAL WIDTH, AND WHICH FUNCTIONS TO BE RETAINED
		ARE ASCERTAINED FROM THE USER. A ZERO IS PUT DOWN
		AT THE FIRST LOCATION NOT USED BY THE MATH-PACKAGE
		AND [TXTTAB] IS SET UP TO POINT AT THE NEXT LOCATION.
		THIS DETERMINES WHERE PROGRAM STORAGE WILL START.
		SPECIAL CHECKS ARE MADE TO MAKE SURE
		ALL QUESTIONS IN "INIT" ARE ANSWERED REASONABLY, SINCE
		ONCE "INIT" FINISHES, THE LOCATIONS IT USES ARE
		USED FOR PROGRAM STORAGE. THE LAST THING "INIT" DOES IS
		CHANGE LOCATION ZERO TO BE A JUMP TO "READY" INSTEAD
		OF "INIT". ONCE THIS IS DONE THERE IS NO WAY TO RESTART
		"INIT".
HIGH LOCATIONS

*
PAGE
SUBTTL	PAGE ZERO.
IFN	REALIO-3,<
START:	JMP	INIT		;INITIALIZE - SETUP CERTAIN LOCATIONS
				;AND DELETE FUNCTIONS IF NOT NEEDED,
				;AND CHANGE THIS TO "JMP READY"
				;IN CASE USER RESTARTS AT LOC ZERO.
RDYJSR: JMP	INIT		;CHANGED TO "JMP STROUT" BY "INIT"
				;TO HANDLE ERRORS.
ADRAYI: ADR(AYINT)		;STORE HERE THE ADDR OF THE
				;ROUTINE TO TURN THE FAC INTO A 
				;TWO BYTE SIGNED INTEGER IN [Y,A]
ADRGAY: ADR(GIVAYF)>		;STORE HERE THE ADDR OF THE
				;ROUTINE TO CONVERT [Y,A] TO A FLOATING
				;POINT NUMBER IN THE FAC.
IFN	ROMSW,<
USRPOK: JMP	FCERR>		;SET UP ORIG BY INIT.
;
; THIS IS THE "VOLATILE" STORAGE AREA AND NONE OF IT
; CAN BE KEPT IN ROM. ANY CONSTANTS IN THIS AREA CANNOT
; BE KEPT IN A ROM, BUT MUST BE LOADED IN BY THE 
; PROGRAM INSTRUCTIONS IN ROM.
;
; --- GENERAL RAM ---:
CHARAC: BLOCK	1		;A DELIMITING CHARACTER.
INTEGR= CHARAC			;A ONE-BYTE INTEGER FROM "QINT".
ENDCHR: BLOCK	1		;THE OTHER DELIMITING CHARACTER.
COUNT:	BLOCK	1		;A GENERAL COUNTER.

; --- FLAGS ---:
DIMFLG: BLOCK	1		;IN GETTING A POINTER TO A VARIABLE
				;IT IS IMPORTANT TO REMEMBER WHETHER IT
				;IS BEING DONE FOR "DIM" OR NOT.
				;DIMFLG AND VALTYP MUST BE
				;CONSECUTIVE LOCATIONS.
KIMY=	DIMFLG			;PLACE TO PRESERVE Y DURING OUT.
VALTYP: BLOCK	1		;THE TYPE INDICATOR.
				;0=NUMERIC 1=STRING.
IFN	INTPRC,<
INTFLG: BLOCK	1>		;TELLS IF INTEGER.
DORES:	BLOCK	1		;WHETHER CAN OR CAN'T CRUNCH RES'D WORDS.
				;TURNED ON WHEN "DATA"
				;BEING SCANNED BY CRUNCH SO UNQUOTED
				;STRINGS WON'T BE CRUNCHED.
GARBFL= DORES			;WHETHER TO DO GARBAGE COLLECTION.
SUBFLG: BLOCK	1		;FLAG WHETHER SUB'D VARIABLE ALLOWED.
				;"FOR" AND USER-DEFINED FUNCTION
				;POINTER FETCHING TURN
				;THIS ON BEFORE CALLING "PTRGET"
				;SO ARRAYS WON'T BE DETECTED.
				;"STKINI" AND "PTRGET" CLEAR IT.
				;ALSO DISALLOWS INTEGERS THERE.
INPFLG: BLOCK	1		;FLAGS WHETHER WE ARE DOING "INPUT"
				;OR "READ".
TANSGN: BLOCK	1		;USED IN DETERMINING SIGN OF TANGENT.
IFN	REALIO,<
CNTWFL: BLOCK	1>		;SUPPRESS OUTPUT FLAG.
				;NON-ZERO MEANS SUPPRESS.
				;RESET BY "INPUT", READY AND ERRORS.
				;COMPLEMENTED BY INPUT OF ^O.

IFE	REALIO-4,<ORG	80>	;ROOM FOR APPLE PAGE 0 STUFF.
; --- RAM DEALING WITH TERMINAL HANDLING ---:
IFN	EXTIO,<
CHANNL: BLOCK	1>		;HOLDS CHANNEL NUMBER.
IFN	NULCMD,<
NULCNT: 0>			;NUMBER OF NULLS TO PRINT.
IFN	REALIO-3,<
TRMPOS: BLOCK	1>		;POSITION OF TERMINAL CARRIAGE.
LINWID: LINLEN			;LENGTH OF LINE (WIDTH).
NCMWID: NCMPOS			;POSITION BEYOND WHICH THERE ARE
				;NO MORE FIELDS.
LINNUM: 0			;LOCATION TO STORE LINE NUMBER BEFORE BUF
				;SO THAT "BLTUC" CAN STORE IT ALL AWAY AT ONCE.
	44			;A COMMA (PRELOAD OR FROM ROM)
				;USED BY INPUT STATEMENT SINCE THE
				;DATA POINTER ALWAYS STARTS ON A
				;COMMA OR TERMINATOR.
IFE	BUFPAG,<
BUF:	BLOCK	BUFLEN>		;TYPE IN STORED HERE.
				;DIRECT STATEMENTS EXECUTE OUT OF
				;HERE. REMEMBER "INPUT" SMASHES BUF.
				;MUST BE ON PAGE ZERO
				;OR ASSIGNMENT OF STRING
				;VALUES IN DIRECT STATEMENTS WON'T COPY
				;INTO STRING SPACE -- WHICH IT MUST.
				;N.B. TWO NONZERO BYTES MUST PRECEDE "BUFLNM".

; --- STORAGE FOR TEMPORARY THINGS ---:
TEMPPT: BLOCK	1		;POINTER AT FIRST FREE TEMP DESCRIPTOR.
				;INITIALIZED TO POINT TO TEMPST.
LASTPT: BLOCK	2		;POINTER TO LAST-USED STRING TEMPORARY.
TEMPST: BLOCK	STRSIZ*NUMTMP	;STORAGE FOR NUMTMP TEMP DESCRIPTORS.
INDEX1: BLOCK	2		;INDEXES.
INDEX=	INDEX1
INDEX2: BLOCK	2
RESHO:	BLOCK	1		;RESULT OF MULTIPLIER AND DIVIDER.
IFN	ADDPRC,<
RESMOH: BLOCK	1>		;ONE MORE BYTE.
RESMO:	BLOCK	1
RESLO:	BLOCK	1
ADDEND= RESMO			;TEMPORARY USED BY "UMULT".
	0			;OVERFLOW FOR RES.

; --- POINTERS INTO DYNAMIC DATA STRUCTURES ---;
TXTTAB: BLOCK	2		;POINTER TO BEGINNING OF TEXT.
				;DOESN'T CHANGE AFTER BEING
				;SETUP BY "INIT".
VARTAB: BLOCK	2		;POINTER TO START OF SIMPLE
				;VARIABLE SPACE.
				;UPDATED WHENEVER THE SIZE OF THE
				;PROGRAM CHANGES, SET TO [TXTTAB]
				;BY "SCRATCH" ("NEW").
ARYTAB: BLOCK	2		;POINTER TO BEGINNING OF ARRAY
				;TABLE.
				;INCREMENTED BY 6 WHENEVER
				;A NEW SIMPLE VARIABLE IS FOUND, AND
				;SET TO [VARTAB] BY "CLEARC".
STREND: BLOCK	2		;END OF STORAGE IN USE.
				;INCREASED WHENEVER A NEW ARRAY
				;OR SIMPLE VARIABLE IS ENCOUNTERED.
				;SET TO [VARTAB] BY "CLEARC".
FRETOP: BLOCK	2		;TOP OF STRING FREE SPACE.
FRESPC: BLOCK	2		;POINTER TO NEW STRING.
MEMSIZ: BLOCK	2		;HIGHEST LOCATION IN MEMORY.

; --- LINE NUMBERS AND TEXTUAL POINTERS ---:
CURLIN: BLOCK	2		;CURRENT LINE #.
				;SET TO 0,255 FOR DIRECT STATEMENTS.
OLDLIN: BLOCK	2		;OLD LINE NUMBER (SETUP BY ^C,"STOP"
				;OR "END" IN A PROGRAM).
POKER=	LINNUM			;SET UP LOCATION USED BY POKE.
				;TEMPORARY FOR INPUT AND READ CODE
OLDTXT: BLOCK	2		;OLD TEXT POINTER.
				;POINTS AT STATEMENT TO BE EXEC'D NEXT.
DATLIN: BLOCK	2		;DATA LINE # -- REMEMBER FOR ERRORS.
DATPTR: BLOCK	2		;POINTER TO DATA. INITIALIZED TO POINT
				;AT THE ZERO IN FRONT OF [TXTTAB]
				;BY "RESTORE" WHICH IS CALLED BY "CLEARC".
				;UPDATED BY EXECUTION OF A "READ".
INPPTR: BLOCK	2		;THIS REMEMBERS WHERE INPUT IS COMING FROM.

; --- STUFF USED IN EVALUATIONS ---:
VARNAM: BLOCK	2		;VARIABLE'S NAME IS STORED HERE.
VARPNT: BLOCK	2		;POINTER TO VARIABLE IN MEMORY.
FDECPT= VARPNT			;POINTER INTO POWER OF TENS OF "FOUT".
FORPNT: BLOCK	2		;A VARIABLE'S POINTER FOR "FOR" LOOPS
				;AND "LET" STATEMENTS.
LSTPNT= FORPNT			;PNTR TO LIST STRING.
ANDMSK= FORPNT			;THE MASK USED BY WAIT FOR ANDING.
EORMSK= FORPNT+1		;THE MASK FOR EORING IN WAIT.
OPPTR:	BLOCK	2		;POINTER TO CURRENT OP'S ENTRY IN "OPTAB".
VARTXT= OPPTR			;POINTER INTO LIST OF VARIABLES.
OPMASK: BLOCK	1		;MASK CREATED BY CURRENT OPERATOR.
DOMASK=TANSGN			;MASK IN USE BY RELATION OPERATIONS.
DEFPNT: BLOCK	2		;POINTER USED IN FUNCTION DEFINITION.
GRBPNT= DEFPNT			;ANOTHER USED IN GARBAGE COLLECTION.
DSCPNT: BLOCK	2		;POINTER TO A STRING DESCRIPTOR.
IFN	ADDPRC,<BLOCK	1>	;FOR TEMPF3.
FOUR6:	EXP	STRSIZ		;VARIABLE CONSTANT USED BY GARB COLLECT.

; --- ET CETERA ---:
JMPER:	JMP	60000
SIZE=	JMPER+1
OLDOV=	JMPER+2			;THE OLD OVERFLOW.
TEMPF3= DEFPNT			;A THIRD FAC TEMPORARY (4 BYTES).
TEMPF1:
IFN	ADDPRC,<0>		;FOR TEMPF1S EXTRA BYTE.
HIGHDS: BLOCK	2		;DESINATION OF HIGHEST ELEMENT IN BLT.
HIGHTR: BLOCK	2		;SOURCE OF HIGHEST ELEMENT TO MOVE.
TEMPF2:
IFN	ADDPRC,<0>		;FOR TEMPF2S EXTRA BYTE.
LOWDS:	BLOCK	2		;LOCATION OF LAST BYTE TRANSFERRED INTO.
LOWTR:	BLOCK	2		;LAST THING TO MOVE IN BLT.
ARYPNT= HIGHDS			;A POINTER USED IN ARRAY BUILDING.
GRBTOP= LOWTR			;A POINTER USED IN GARBAGE COLLECTION.
DECCNT= LOWDS			;NUMBER OF PLACES BEFORE DECIMAL POINT.
TENEXP= LOWDS+1			;HAS A DPT BEEN INPUT?
DPTFLG= LOWTR			;BASE TEN EXPONENT.
EXPSGN= LOWTR+1			;SIGN OF BASE TEN EXPONENT.

; --- THE FLOATING ACCUMULATOR ---:
FAC:
FACEXP: 0
FACHO:	0			;MOST SIGNIFICANT BYTE OF MANTISSA.
IFN	ADDPRC,<
FACMOH: 0>			;ONE MORE.
FACMO:	0			;MIDDLE ORDER OF MANTISSA.
FACLO:	0			;LEAST SIG BYTE OF MANTISSA.
FACSGN: 0			;SIGN OF FAC (0 OR -1) WHEN UNPACKED.
SGNFLG: 0			;SIGN OF FAC IS PRESERVED BERE BY "FIN".
DEGREE= SGNFLG			;A COUNT USED BY POLYNOMIALS.
DSCTMP= FAC			;THIS IS WHERE TEMP DESCS ARE BUILT.
INDICE= FACMO			;INDICE IS SET UP HERE BY "QINT".
BITS:	0			;SOMETHING FOR "SHIFTR" TO USE.

; --- THE FLOATING ARGUMENT (UNPACKED) ---:
ARGEXP: 0
ARGHO:	0
IFN	ADDPRC,<ARGMOH: 0>
ARGMO:	0
ARGLO:	0
ARGSGN: 0

ARISGN: 0			;A SIGN REFLECTING THE RESULT.
FACOV:	0			;OVERFLOW BYTE OF THE FAC.
STRNG1= ARISGN			;POINTER TO A STRING OR DESCRIPTOR.

FBUFPT: BLOCK	2		;POINTER INTO FBUFFR USED BY FOUT.
BUFPTR= FBUFPT			;POINTER TO BUF USED BY "CRUNCH".
STRNG2= FBUFPT			;POINTER TO STRING OR DESC.
POLYPT= FBUFPT			;POINTER INTO POLYNOMIAL COEFFICIENTS.
CURTOL= FBUFPT			;ABSOLUTE LINEAR INDEX IS FORMED HERE.
PAGE
SUBTTL	RAM CODE.
; THIS CODE GETS CHANGED THROUGHOUT EXECUTION.
; IT IS MADE TO BE FAST THIS WAY.
; ALSO, [X] AND [Y] ARE NOT DISTURBED
;
; "CHRGET" USING [TXTPTR] AS THE CURRENT TEXT PNTR
; FETCHES A NEW CHARACTER INTO ACCA AFTER INCREMENTING [TXTPTR]
; AND SETS CONDITION CODES ACCORDING TO WHAT'S IN ACCA.
;	NOT C=	NUMERIC	  ("0" THRU "9")
;	Z=	":" OR END-OF-LINE (A NULL)
;
; [ACCA] = NEW CHAR.
; [TXTPTR]=[TXTPTR]+1
;
; THE FOLLOWING EXISTS IN ROM IF ROM EXISTS AND IS LOADED
; DOWN HERE BY INIT. OTHERWISE IT IS JUST LOADED INTO THIS
; RAM LIKE ALL THE REST OF RAM IS LOADED.
;
CHRGET: INC	CHRGET+7	;INCREMENT THE WHOLE TXTPTR.
	BNE	CHRGOT
	INC	CHRGET+8
CHRGOT: LDA	60000		;A LOAD WITH AN EXT ADDR.
TXTPTR= CHRGOT+1
	CMPI	" "		;SKIP SPACES.
	BEQ	CHRGET
QNUM:	CMPI	":"		;IS IT A ":"?
	BCS	CHRRTS		;IT IS .GE. ":"
	SEC
	SBCI	"0"		;ALL CHARS .GT. "9" HAVE RET'D SO
	SEC
	SBCI	256-"0"		;SEE IF NUMERIC.
				;TURN CARRY ON IF NUMERIC.
				;ALSO, SETZ IF NULL.
CHRRTS: RTS			;RETURN TO CALLER.

RNDX:	128			;LOADED OR FROM ROM.
	79			;THE INITIAL RANDOM NUMBER.
	199
	82
IFN	ADDPRC,<89>		;ONE MORE BYTE.

ORG	255			;PAGE 1 STUFF COMING UP.
LOFBUF: BLOCK	1		;THE LOW FAC BUFFER. COPYABLE.
;---  PAGE ZERO/ONE BOUNDARY ---.
				;MUST HAVE 13 CONTIGUOUS BYTES.
FBUFFR: BLOCK	3*ADDPRC+13	;BUFFER FOR "FOUT".
				;ON PAGE 1 SO THAT STRING IS NOT COPIED.

;STACK IS LOCATED HERE. IE FROM THE END OF FBUFFR TO STKEND.
PAGE
SUBTTL	DISPATCH TABLES, RESERVED WORDS, AND ERROR TEXTS.

	ORG	ROMLOC

STMDSP: ADR(END-1)
	ADR(FOR-1)
	ADR(NEXT-1)
	ADR(DATA-1)
IFN	EXTIO,<
	ADR(INPUTN-1)>
	ADR(INPUT-1)
	ADR(DIM-1)
	ADR(READ-1)
	ADR(LET-1)
	ADR(GOTO-1)
	ADR(RUN-1)
	ADR(IF-1)
	ADR(RESTORE-1)
	ADR(GOSUB-1)
	ADR(RETURN-1)
	ADR(REM-1)
	ADR(STOP-1)
	ADR(ONGOTO-1)
IFN	NULCMD,<
	ADR(NULL-1)>
	ADR(FNWAIT-1)
IFN	DISKO,<
IFE	REALIO-3,<
	ADR(CQLOAD-1)
	ADR(CQSAVE-1)
	ADR(CQVERF-1)>
IFN	REALIO,<
IFN	REALIO-2,<
IFN	REALIO-3,<
IFN	REALIO-5,<
	ADR(LOAD-1)
	ADR(SAVE-1)>>>>
IFN	REALIO-1,<
IFN	REALIO-3,<
IFN	REALIO-4,<
	ADR(511)		;ADDRESS OF LOAD
	ADR(511)>>>>		;ADDRESS OF SAVE
	ADR(DEF-1)
	ADR(POKE-1)
IFN	EXTIO,<
	ADR(PRINTN-1)>
	ADR(PRINT-1)
	ADR(CONT-1)
IFE	REALIO,<
	ADR(DDT-1)>
	ADR(LIST-1)
	ADR(CLEAR-1)
IFN	EXTIO,<
	ADR(CMD-1)
	ADR(CQSYS-1)
	ADR(CQOPEN-1)
	ADR(CQCLOS-1)>
IFN	GETCMD,<
	ADR(GET-1)>		;FILL W/ GET ADDR.
	ADR(SCRATH-1)

FUNDSP: ADR(SGN)
	ADR(INT)
	ADR(ABS)
IFE	ROMSW,<
USRLOC: ADR(FCERR)>		;INITIALLY NO USER ROUTINE.
IFN	ROMSW,<
USRLOC: ADR(USRPOK)>
	ADR(FRE)
	ADR(POS)
	ADR(SQR)
	ADR(RND)
	ADR(LOG)
	ADR(EXP)
IFN	KIMROM,<
REPEAT	4,<
	ADR(FCERR)>>
IFE	KIMROM,<
COSFIX: ADR(COS)
SINFIX: ADR(SIN)
TANFIX: ADR(TAN)
ATNFIX: ADR(ATN)>
	ADR(PEEK)
	ADR(LEN)
	ADR(STR)
	ADR(VAL)
	ADR(ASC)
	ADR(CHR)
	ADR(LEFT)
	ADR(RIGHT)
	ADR(MID)
OPTAB:	121
	ADR(FADDT-1)
	121
	ADR(FSUBT-1)
	123
	ADR(FMULTT-1)
	123
	ADR(FDIVT-1)
	127
	ADR(FPWRT-1)
	80
	ADR(ANDOP-1)
	70
	ADR(OROP-1)
NEGTAB: 125
	ADR(NEGOP-1)
NOTTAB: 90
	ADR(NOTOP-1)
PTDORL: 100			;PRECEDENCE.
	ADR	(DOREL-1)	;OPERATOR ADDRESS.
;
; TOKENS FOR RESERVED WORDS ALWAYS HAVE THE MOST
; SIGNIFICANT BIT ON.
; THE LIST OF RESERVED WORDS:
;
Q=128-1
DEFINE	DCI(A),<Q=Q+1
	DC(A)>
RESLST: DCI"END"
	ENDTK==Q
	DCI"FOR"
	FORTK==Q
	DCI"NEXT"
	DCI"DATA"
	DATATK==Q
IFN	EXTIO,<
	DCI"INPUT#">
	DCI"INPUT"
	DCI"DIM"
	DCI"READ"
	DCI"LET"
	DCI"GOTO"
	GOTOTK==Q
	DCI"RUN"
	DCI"IF"
	DCI"RESTORE"
	DCI"GOSUB"
	GOSUTK=Q
	DCI"RETURN"
	DCI"REM"
	REMTK=Q
	DCI"STOP"
	DCI"ON"
IFN	NULCMD,<
	DCI"NULL">
	DCI"WAIT"
IFN	DISKO,<
	DCI"LOAD"
	DCI"SAVE"
IFE	REALIO-3,<
	DCI"VERIFY">>
	DCI"DEF"
	DCI"POKE"
IFN	EXTIO,<
	DCI"PRINT#">
	DCI"PRINT"
	PRINTK==Q
	DCI"CONT"
IFE	REALIO,<
	DCI"DDT">
	DCI"LIST"
IFN	REALIO-3,<
	DCI"CLEAR">
IFE	REALIO-3,<
	DCI"CLR">
IFN	EXTIO,<
	DCI"CMD"
	DCI"SYS"
	DCI"OPEN"
	DCI"CLOSE">
IFN	GETCMD,<
	DCI"GET">
	DCI"NEW"
	SCRATK=Q
; END OF COMMAND LIST.
	"T"
	"A"
	"B"
	"("+128
	Q=Q+1
	TABTK=Q
	DCI"TO"
	TOTK==Q
	DCI"FN"
	FNTK==Q
	"S"
	"P"
	"C"
	"("+128			;MACRO DOESNT LIKE ('S IN ARGUMENTS.
	Q=Q+1
	SPCTK==Q
	DCI"THEN"
	THENTK=Q
	DCI"NOT"
	NOTTK==Q
	DCI"STEP"
	STEPTK=Q
	DCI"+"
	PLUSTK=Q
	DCI"-"
	MINUTK=Q
	DCI"*"
	DCI"/"
	DCI"^"
	DCI"AND"
	DCI"OR"
	190			;A GREATER THAN SIGN
	Q=Q+1
	GREATK=Q
	DCI"="
	EQULTK=Q
	188
	Q=Q+1			;A LESS THAN SIGN
	LESSTK=Q
;
; NOTE DANGER OF ONE RESERVED WORD BEING A PART
; OF ANOTHER:
; IE . . IF 2 GREATER THAN F OR T=5 THEN...
; WILL NOT WORK!!! SINCE "FOR" WILL BE CRUNCHED!!
; IN ANY CASE MAKE SURE THE SMALLER WORD APPEARS
; SECOND IN THE RESERVED WORD TABLE ("INP" AND "INPUT")
; ANOTHER EXAMPLE: IF T OR Q THEN ... "TO" IS CRUNCHED
;
	DCI"SGN"
	ONEFUN=Q
	DCI"INT"
	DCI"ABS"
	DCI"USR"
	DCI"FRE"
	DCI"POS"
	DCI"SQR"
	DCI"RND"
	DCI"LOG"
	DCI"EXP"
	DCI"COS"
	DCI"SIN"
	DCI"TAN"
	DCI"ATN"
	DCI"PEEK"
	DCI"LEN"
	DCI"STR$"
	DCI"VAL"
	DCI"ASC"
	DCI"CHR$"
LASNUM==Q			;NUMBER OF LAST FUNCTION
				;THAT TAKES ONE ARG
	DCI"LEFT$"
	DCI"RIGHT$"
	DCI"MID$"
	DCI"GO"
GOTK==Q
	0			;MARKS END OF RESERVED WORD LIST

IFE LNGERR,<
Q=0-2
DEFINE	DCE(X),<Q=Q+2
	DC(X)>
ERRTAB: DCE"NF"
	ERRNF==Q		;NEXT WITHOUT FOR.
	DCE"SN"
	ERRSN==Q		;SYNTAX
	DCE"RG"
	ERRRG==Q		;RETURN WITHOUT GOSUB.
	DCE"OD"
	ERROD==Q		;OUT OF DATA.
	DCE"FC"
	ERRFC==Q		;ILLEGAL QUANTITY.
	DCE"OV"
	ERROV==Q		;OVERFLOW.
	DCE"OM"
	ERROM==Q		;OUT OF MEMORY.
	DCE"US"
	ERRUS==Q		;UNDEFINED STATEMENT.
	DCE"BS"
	ERRBS==Q		;BAD SUBSCRIPT.
	DCE"DD"
	ERRDD==Q		;REDIMENSIONED ARRAY.
	DCE"/0"
	ERRDV0==Q		;DIVISION BY ZERO.
	DCE"ID"
	ERRID==Q		;ILLEGAL DIRECT.
	DCE"TM"
	ERRTM==Q		;TYPE MISMATCH.
	DCE"LS"
	ERRLS==Q		;STRING TOO LONG.
IFN	EXTIO,<
	DCE"FD"			;FILE DATA.
	ERRBD==Q>
	DCE"ST"
	ERRST==Q		;STRING FORMULA TOO COMPLEX.
	DCE"CN"
	ERRCN==Q		;CAN'T CONTINUE.
	DCE"UF"
	ERRUF==Q>		;UNDEFINED FUNCTION.

IFN LNGERR,<
Q=0
; NOTE: THIS ERROR COUNT TECHNIQUE WILL NOT WORK IF THERE ARE MORE
; THAN 256 CHARACTERS OF ERROR MESSAGES
ERRTAB: DC"NEXT WITHOUT FOR"
	ERRNF==Q
	Q=Q+16
	DC"SYNTAX"
	ERRSN==Q
	Q=Q+6
	DC"RETURN WITHOUT GOSUB"
	ERRRG==Q
	Q=Q+20
	DC"OUT OF DATA"
	ERROD==Q
	Q=Q+11
	DC"ILLEGAL QUANTITY"
	ERRFC==Q
	Q=Q+16
	DC"OVERFLOW"
	ERROV==Q
	Q=Q+8
	DC"OUT OF MEMORY"
	ERROM==Q
	Q=Q+13
	DC"UNDEF'D STATEMENT"
	ERRUS==Q
	Q=Q+17
	DC"BAD SUBSCRIPT"
	ERRBS==Q
	Q=Q+13
	DC"REDIM'D ARRAY"
	ERRDD==Q
	Q=Q+13
	DC"DIVISION BY ZERO"
	ERRDV0==Q
	Q=Q+16
	DC"ILLEGAL DIRECT"
	ERRID==Q
	Q=Q+14
	DC"TYPE MISMATCH"
	ERRTM==Q
	Q=Q+13
	DC"STRING TOO LONG"
	ERRLS==Q
	Q=Q+15
IFN	EXTIO,<
	DC"FILE DATA"
	ERRBD==Q
	Q=Q+9>
	DC"FORMULA TOO COMPLEX"
	ERRST==Q
	Q=Q+19
	DC"CAN'T CONTINUE"
	ERRCN==Q
	Q=Q+14
	DC"UNDEF'D FUNCTION"
	ERRUF==Q>

;
; NEEDED FOR MESSAGES IN ALL VERSIONS.
;
ERR:	DT" ERROR"
	0
INTXT:	DT" IN "
	0
REDDY:	ACRLF
IFE REALIO-3,<
	DT"READY.">
IFN REALIO-3,<
	DT"OK">
	ACRLF
	0
BRKTXT: ACRLF
	DT"BREAK"
	0
PAGE
SUBTTL	GENERAL STORAGE MANAGEMENT ROUTINES.
;
; FIND A "FOR" ENTRY ON THE STACK VIA "VARPNT".
;
FORSIZ==2*ADDPRC+16
FNDFOR: TSX			;LOAD XREG WITH STK PNTR.
	REPEAT	4,<INX>		;IGNORE ADR(NEWSTT) AND RTS ADDR.
FFLOOP: LDA	257,X		;GET STACK ENTRY.
	CMPI	FORTK		;IS IT A "FOR" TOKEN?
	BNE	FFRTS		;NO, NO "FOR" LOOPS WITH THIS PNTR.
	LDA	FORPNT+1	;GET HIGH.
	BNE	CMPFOR
	LDA	258,X		;PNTR IS ZERO, SO ASSUME THIS ONE.
	STA	FORPNT
	LDA	259,X
	STA	FORPNT+1
CMPFOR: CMP	259,X
	BNE	ADDFRS		;NOT THIS ONE.
	LDA	FORPNT		;GET DOWN.
	CMP	258,X
	BEQ	FFRTS		;WE GOT IT! WE GOT IT!
ADDFRS: TXA
	CLC			;ADD 16 TO X.
	ADCI	FORSIZ
	TAX			;RESULT BACK INTO X.
	BNE	FFLOOP
FFRTS:	RTS			;RETURN TO CALLER.

;
; THIS IS THE BLOCK TRANSFER ROUTINE.
; IT MAKES SPACE BY SHOVING EVERYTHING FORWARD.
;
; ON ENTRY:
; [Y,A]=[HIGHDS]    (FOR REASON).
; [HIGHDS]= DESTINATION OF [HIGH ADDRESS].
; [LOWTR]= LOWEST ADDR TO BE TRANSFERRED.
; [HIGHTR]= HIGHEST ADDR TO BE TRANSFERRED.
;
; A CHECK IS MADE TO ASCERTAIN THAT A REASONABLE
; AMOUNT OF SPACE REMAINS BETWEEN THE BOTTOM
; OF THE STRINGS AND THE HIGHEST LOCATION TRANSFERRED INTO.
;
; ON EXIT:
; [LOWTR] ARE UNCHANGED.
; [HIGHTR]=[LOWTR]-200 OCTAL.
; [HIGHDS]=LOWEST ADDR TRANSFERRED INTO MINUS 200 OCTAL.
;
BLTU:	JSR	REASON		;ASCERTAIN THAT STRING SPACE WON'T
				;BE OVERRUN.
	STWD	STREND
BLTUC:	SEC			;PREPARE TO SUBTRACT.
	LDA	HIGHTR
	SBC	LOWTR		;COMPUTE NUMBER OF THINGS TO MOVE.
	STA	INDEX		;SAVE FOR LATER.
	TAY
	LDA	HIGHTR+1
	SBC	LOWTR+1
	TAX			;PUT IT IN A COUNTER REGISTER.
	INX			;SO THAT COUNTER ALGORITHM WORKS.
	TYA			;SEE IF LOW PART OF COUNT IS ZERO.
	BEQ	DECBLT		;YES, GO START MOVING BLOCKS.
	LDA	HIGHTR		;NO, MUST MODIFY BASE ADDR.
	SEC
	SBC	INDEX		;BORROW IS OFF SINCE [HIGHTR].GT.[LOWTR].
	STA	HIGHTR		;SAVE MODIFIED BASE ADDR.
	BCS	BLT1		;IF NO BORROW, GO SHOVE IT.
	DEC	HIGHTR+1	;BORROW IMPLIES SUB 1 FROM HIGH ORDER.
	SEC
BLT1:	LDA	HIGHDS		;MOD BASE OF DEST ADDR.
	SBC	INDEX
	STA	HIGHDS
	BCS	MOREN1		;NO BORROW.
	DEC	HIGHDS+1	;DECREMENT HIGH ORDER BYTE.
	BCC	MOREN1		;ALWAYS SKIP.
BLTLP:	LDADY	HIGHTR		;FETCH BYTE TO MOVE
	STADY	HIGHDS		;MOVE IT IN, MOVE IT OUT.
MOREN1: DEY
	BNE	BLTLP
	LDADY	HIGHTR		;MOVE LAST OF THE BLOCK.
	STADY	HIGHDS
DECBLT: DEC	HIGHTR+1
	DEC	HIGHDS+1	;START ON NEW BLOCKS.
	DEX
	BNE	MOREN1
	RTS			;RETURN TO CALLER.

;
; THIS ROUTINE IS USED TO ASCERTAIN THAT A GIVEN
; NUMBER OF LOCS REMAIN AVAILABLE FOR THE STACK.
;    THE CALL IS:
;	LDAI	NUMBER OF 2-BYTE ENTRIES NEEDED.
;	JSR	GETSTK
;
; THIS ROUTINE MUST BE CALLED BY ANY ROUTINE WHICH PUTS
; AN ARBITRARY AMOUNT OF STUFF ON THE STACK,
; I.E., ANY RECURSIVE ROUTINE LIKE "FRMEVL".
; IT IS ALSO CALLED BY ROUTINES SUCH AS "GOSUB" AND "FOR"
; WHICH MAKE PERMANENT ENTRIES ON THE STACK.
;
; ROUTINES WHICH MERELY USE AND FREE UP THE GUARANTEED
; NUMLEV LOCATIONS NEED NOT CALL THIS.
;
;
; ON EXIT:
;    [A] AND [X] HAVE BEEN MODIFIED.
;
GETSTK: ASL	A,		;MULT [A] BY 2. NB, CLEARS C BIT.
	ADCI	2*NUMLEV+<3*ADDPRC>+13	;MAKE SURE 2*NUMLEV+13 LOCS
				;(13 BECAUSE OF FBUFFR)
	BCS	OMERR		;WILL REMAIN IN STACK.
	STA	INDEX
	TSX			;GET STACKED.
	CPX	INDEX		;COMPARE.
	BCC	OMERR		;IF STACK.LE.INDEX1, OM.
	RTS

;
; [Y,A] IS A CERTAIN ADDRESS. "REASON" MAKES SURE
; IT IS LESS THAN [FRETOP].
;
REASON: CPY	FRETOP+1
	BCC	REARTS
	BNE	TRYMOR		;GO GARB COLLECT.
	CMP	FRETOP
	BCC	REARTS
TRYMOR: PHA
	LDXI	8+ADDPRC	;IF TEMPF2 HAS ZERO IN BETWEEN.
	TYA
REASAV: PHA
	LDA	HIGHDS-1,X	;SAVE HIGHDS ON STACK.
	DEX
	BPL	REASAV		;PUT 8 OF THEM ON STK.
	JSR	GARBA2		;GO GARB COLLECT.
	LDXI	256-8-ADDPRC
REASTO: PLA
	STA	HIGHDS+8+ADDPRC,X	;RESTORE AFTER GARB COLLECT.
	INX
	BMI	REASTO
	PLA
	TAY
	PLA			;RESTORE A AND Y.
	CPY	FRETOP+1	;COMPARE HIGHS
	BCC	REARTS
	BNE	OMERR		;HIGHER IS BAD.
	CMP	FRETOP		;AND THE LOWS.
	BCS	OMERR
REARTS: RTS

PAGE
SUBTTL	ERROR HANDLER, READY, TERMINAL INPUT, COMPACTIFY, NEW, REINIT.
OMERR:	LDXI	ERROM
ERROR:
IFN	REALIO,<
	LSR	CNTWFL>		;FORCE OUTPUT.
IFN	EXTIO,<
	LDA	CHANNL		;CLOSE NON-TERMINAL CHANNEL.
	BEQ	ERRCRD
	JSR	CQCCHN		;CLOSE IT.
	LDAI	0
	STA	CHANNL>
ERRCRD: JSR	CRDO		;OUTPUT CRLF.
	JSR	OUTQST		;PRINT A QUESTION MARK
IFE LNGERR,<
	LDA	ERRTAB,X,	;GET FIRST CHR OF ERR MSG.
	JSR	OUTDO		;OUTPUT IT.
	LDA	ERRTAB+1,X,	;GET SECOND CHR.
	JSR	OUTDO>		;OUTPUT IT.
IFN LNGERR,<
GETERR: LDA	ERRTAB,X
	PHA
	ANDI	127		;GET RID OF HIGH BIT.
	JSR	OUTDO		;OUTPUT IT.
	INX
	PLA			;LAST CHAR OF MESSAGE?
	BPL	GETERR>		;NO. GO GET NEXT AND OUTPUT IT.
TYPERR: JSR	STKINI		;RESET THE STACK AND FLAGS.
	LDWDI	ERR		;GET PNTR TO " ERROR".
ERRFIN: JSR	STROUT		;OUTPUT IT.
	LDY	CURLIN+1
	INY			;WAS NUMBER 64000?
	BEQ	READY		;YES, DON'T TYPE LINE NUMBER.
	JSR	INPRT
READY:
IFN	REALIO,<
	LSR	CNTWFL>		;TURN OUTPUT BACK ON IF SUPRESSED
	LDWDI	REDDY		;SAY "OK".
IFN	REALIO-3,<
	JSR	RDYJSR>		;OR GO TO INIT IF INIT ERROR.
IFE	REALIO-3,<
	JSR	STROUT>		;NO INIT ERRORS POSSIBLE.
MAIN:	JSR	INLIN		;GET A LINE FROM TERMINAL.
	STXY	TXTPTR
	JSR	CHRGET
	TAX			;SET ZERO FLAG BASED ON [A]
				;THIS DISTINGUISHES ":" AND 0
	BEQ	MAIN		;IF BLANK LINE, GET ANOTHER.
	LDXI	255		;SET DIRECT LINE NUMBER.
	STX	CURLIN+1
	BCC	MAIN1		;IS A LINE NUMBER. NOT DIRECT.
	JSR	CRUNCH		;COMPACTIFY.
	JMP	GONE		;EXECUTE IT.
MAIN1:	JSR	LINGET		;READ LINE NUMBER INTO "LINNUM".
	JSR	CRUNCH
	STY	COUNT		;RETAIN CHARACTER COUNT.
	JSR	FNDLIN
	BCC	NODEL		;NO MATCH, SO DON'T DELETE.
	LDYI	1
	LDADY	LOWTR
	STA	INDEX1+1
	LDA	VARTAB
	STA	INDEX1
	LDA	LOWTR+1		;SET TRANSFER TO.
	STA	INDEX2+1
	LDA	LOWTR
	DEY
	SBCDY	LOWTR		;COMPUTE NEGATIVE LENGTH.
	CLC
	ADC	VARTAB		;COMPUTE NEW VARTAB.
	STA	VARTAB
	STA	INDEX2		;SET LOW OF TRANS TO.
	LDA	VARTAB+1
	ADCI	255
	STA	VARTAB+1	;COMPUTE HIGH OF VARTAB.
	SBC	LOWTR+1		;COMPUTE NUMBER OF BLOCKS TO MOVE.
	TAX
	SEC
	LDA	LOWTR
	SBC	VARTAB		;COMPUTE OFFSET.
	TAY
	BCS	QDECT1		;IF VARTAB.LE.LOWTR,
	INX			;DECR DUE TO CARRY, AND
	DEC	INDEX2+1	;DECREMENT STORE SO CARRY WORKS.
QDECT1: CLC
	ADC	INDEX1
	BCC	MLOOP
	DEC	INDEX1+1
	CLC			;FOR LATER ADCQ
MLOOP:	LDADY	INDEX1
	STADY	INDEX2
	INY
	BNE	MLOOP		;BLOCK DONE?
	INC	INDEX1+1
	INC	INDEX2+1
	DEX
	BNE	MLOOP		;DO ANOTHER BLOCK. ALWAYS.
NODEL:	JSR	RUNC		;RESET ALL VARIABLE INFO SO GARBAGE
				;COLLECTION CAUSED BY REASON WILL WORK
	JSR	LNKPRG		;FIX UP THE LINKS
	LDA	BUF		;SEE IF ANYTHNG THERE
	BEQ	MAIN
	CLC
	LDA	VARTAB
	STA	HIGHTR		;SETUP HIGHTR.
	ADC	COUNT		;ADD LENGTH OF LINE TO INSERT.
	STA	HIGHDS		;THIS GIVES DEST ADDR.
	LDY	VARTAB+1
	STY	HIGHTR+1	;SAME FOR HIGH ORDERS.
	BCC	NODELC
	INY
NODELC: STY	HIGHDS+1
	JSR	BLTU
IFN	BUFPAG,<
	LDWD	LINNUM		;POSITION THE BINARY LINE NUMBER
	STWD	BUF-2>		;IN FRONT OF BUF
	LDWD	STREND
	STWD	VARTAB
	LDY	COUNT
	DEY
STOLOP: LDA	BUF-4,Y
	STADY	LOWTR
	DEY
	BPL	STOLOP
FINI:	JSR	RUNC		;DO CLEAR & SET UP STACK.
				;AND SET [TXTPTR] TO [TXTTAB]-1.
	JSR	LNKPRG		;FIX UP PROGRAM LINKS
	JMP	MAIN
LNKPRG: LDWD	TXTTAB		;SET [INDEX] TO [TXTTAB].
	STWD	INDEX
	CLC
;
; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES
; UP ALL THE LINKS. THE END OF EACH LINE IS FOUND
; BY SEARCHING FOR THE ZERO AT THE END.
; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM.
;
CHEAD:	LDYI	1
	LDADY	INDEX		;ARRIVED AT DOUBLE ZEROES?
	BEQ	LNKRTS
	LDYI	4
CZLOOP: INY			;THERE IS AT LEAST ONE BYTE.
	LDADY	INDEX
	BNE	CZLOOP		;NO, CONTINUE SEARCHING.
	INY			;GO ONE BEYOND.
	TYA
	ADC	INDEX
	TAX
	LDYI	0
	STADY	INDEX
	LDA	INDEX+1
	ADCI	0
	INY
	STADY	INDEX
	STX	INDEX
	STA	INDEX+1
	BCCA	CHEAD		;ALWAYS BRANCHES.
LNKRTS: RTS
;
; THIS IS THE LINE INPUT ROUTINE.
; IT READS CHARACTERS INTO BUF USING BACKARROW (UNDERSCORE, OR
; SHIFT O) AS THE DELETE CHARACTER AND @ AS THE 
; LINE DELETE CHARACTER. IF MORE THAN BUFLEN CHARACTERS
; ARE TYPED, NO ECHOING IS DONE UNTIL A BACKARROW OR @ OR CR
; IS TYPED. CONTROL-G WILL BE TYPED FOR EACH EXTRA CHARACTER.
; THE ROUTINE IS ENTERED AT INLIN.
;
IFE	REALIO-4,<
INLIN:	LDXI	128		;NO PROMPT CHARACTER
	STX	CQPRMP
	JSR	CQINLN		;GET A LINE ONTO PAGE 2
	CPXI	BUFLEN-1
	BCS	GDBUFS		;NOT TOO MANY CHARACTERS
	LDXI	BUFLEN-1
GDBUFS: LDAI	0		;PUT A ZERO AT THE END
	STA	BUF,X
	TXA
	BEQ	NOCHR
LOPBHT: LDA	BUF-1,X
	ANDI	127
	STA	BUF-1,X
	DEX
	BNE	LOPBHT
NOCHR:	LDAI	0
	LDXYI	<BUF-1>		;POINT AT THE BEGINNING
	RTS>
IFN	REALIO-4,<
IFN	REALIO-3,<
LINLIN: IFE	REALIO-2,<
	JSR	OUTDO>		;ECHO IT.
	DEX			;BACKARROW SO BACKUP PNTR AND
	BPL	INLINC		;GET ANOTHER IF COUNT IS POSITIVE.
INLINN: IFE	REALIO-2,<
	JSR	OUTDO>		;PRINT THE @ OR A SECOND BACKARROW
				;IF THERE WERE TOO MANY.
	JSR	CRDO>
INLIN:	LDXI	0
INLINC: JSR	INCHR		;GET A CHARACTER.
IFN REALIO-3,<
	CMPI	7		;IS IT BOB ALBRECHT RINGING THE BELL
				;FOR SCHOOL KIDS?
	BEQ	GOODCH>
	CMPI	13		;CARRIAGE RETURN?
	BEQ	FININ1		;YES, FINISH UP.
IFN	REALIO-3,<
	CMPI	32		;CHECK FOR FUNNY CHARACTERS.
	BCC	INLINC
	CMPI	125		;IS IT TILDA OR DELETE?
	BCS	INLINC		;BIG BAD ONES TOO.
	CMPI	"@"		;LINE DELETE?
	BEQ	INLINN		;YES.
	CMPI	"_"		;CHARACTER DELETE?
	BEQ	LINLIN>		;YES.
GOODCH:
IFN	REALIO-3,<
	CPXI	BUFLEN-1	;LEAVE ROOM FOR NULL.
			;COMMO ASSURES US NEVER MORE THAN BUFLEN.
	BCS	OUTBEL>
	STA	BUF,X
	INX
IFE	REALIO-2,<SKIP2>
IFN	REALIO-2,<BNE INLINC>
IFN REALIO-3,<
OUTBEL: LDAI	7
IFN	REALIO,<
	JSR	OUTDO>		;ECHO IT.
	BNE	INLINC>		;CYCLE ALWAYS.
FININ1: JMP	FININL>		;GO TO FININL FAR, FAR AWAY.
INCHR:	
IFE	REALIO-3,<
	JSR	CQINCH>		;FOR COMMODORE.
IFE	REALIO-2,<
INCHRL: LDA	^O176000
	REPEAT	4,<NOP>
	LSR	A,
	BCC	INCHRL
	LDA	^O176001	;GET THE CHARACTER.
	REPEAT	4,<NOP>
	ANDI	127>
IFE	REALIO-1,<
	JSR	^O17132>	;1E5A FOR MOS TECH.
IFE	REALIO-4,<
	JSR	CQINCH		;FD0C FOR APPLE COMPUTER.
	ANDI	127>
IFE	REALIO,<
	TJSR	INSIM##>	;GET A CHARACTER FROM SIMULATOR

IFN	REALIO,<
IFN	EXTIO,<
	LDY	CHANNL		;CNT-O HAS NO EFFECT IF NOT FROM TERM.
	BNE	INCRTS>
	CMPI	CONTW		;SUPPRESS OUTPUT CHARACTER (^W).
	BNE	INCRTS		;NO, RETURN.
	PHA
	COM	CNTWFL		;COMPLEMENT ITS STATE.
	PLA>
INCRTS: RTS			;END OF INCHR.
	
;
; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE
; BYTES WITH THE MSB ON. THIS SAVES SPACE AND TIME 
; BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION.
; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE
; RESERVED WORD LIST IN THE SAME ORDER THEY
; APPEAR IN STMDSP.
;
BUFOFS=0			;THE AMOUNT TO OFFSET THE LOW BYTE
				;OF THE TEXT POINTER TO GET TO BUF
				;AFTER TXTPTR HAS BEEN SETUP TO POINT INTO BUF
IFN	BUFPAG,<
BUFOFS=<BUF/256>*256>
CRUNCH: LDX	TXTPTR		;SET SOURCE POINTER.
	LDYI	4		;SET DESTINATION OFFSET.
	STY	DORES		;ALLOW CRUNCHING.
KLOOP:	LDA	BUFOFS,X
IFE	REALIO-3,<
	BPL	CMPSPC		;GO LOOK AT SPACES.
	CMPI	PI		;PI??
	BEQ	STUFFH		;GO SAVE IT.
	INX			;SKIP NO PRINTING.
	BNE	KLOOP>		;ALWAYS GOES.
CMPSPC: CMPI	" "		;IS IT A SPACE TO SAVE?
	BEQ	STUFFH		;YES, GO SAVE IT.
	STA	ENDCHR		;IF IT'S A QUOTE, THIS WILL
				;STOP LOOP WHEN OTHER QUOTE APPEARS.
	CMPI	34		;QUOTE SIGN?
	BEQ	STRNG		;YES, DO SPECIAL STRING HANDLING.
	BIT	DORES		;TEST FLAG.
	BVS	STUFFH		;NO CRUNCH, JUST STORE.
	CMPI	"?"		;A QMARK?
	BNE	KLOOP1
	LDAI	PRINTK		;YES, STUFF A "PRINT" TOKEN.
	BNE	STUFFH		;ALWAYS GO TO STUFFH.
KLOOP1: CMPI	"0"		;SKIP NUMERICS.
	BCC	MUSTCR
	CMPI	60		;":" AND ";" ARE ENTERED STRAIGHTAWAY.
	BCC	STUFFH
MUSTCR: STY	BUFPTR		;SAVE BUFFER POINTER.
	LDYI	0		;LOAD RESLST POINTER.
	STY	COUNT		;ALSO CLEAR COUNT.
	DEY
	STX	TXTPTR		;SAVE TEXT POINTER FOR LATER USE.
	DEX
RESER:	INY
RESPUL: INX
RESCON: LDA	BUFOFS,X
	SEC			;PREPARE TO SUBSTARCT.
	SBC	RESLST,Y	;CHARACTERS EQUAL?
	BEQ	RESER		;YES, CONTINUE SEARCH.
	CMPI	128		;NO BUT MAYBE THE END IS HERE.
	BNE	NTHIS		;NO, TRULY UNEQUAL.
	ORA	COUNT
GETBPT: LDY	BUFPTR		;GET BUFFER PNTR.
STUFFH: INX
	INY
	STA	BUF-5,Y
	LDA	BUF-5,Y
	BEQ	CRDONE		;NULL IMPLIES END OF LINE.
	SEC			;PREPARE TO SUBSTARCT.
	SBCI	":"		;IS IT A ":"?
	BEQ	COLIS		;YES, ALLOW CRUNCHING AGAIN.
	CMPI	DATATK-":"	;IS IT A DATATK?
	BNE	NODATT		;NO, SEE IF IT IS REM TOKEN.
COLIS:	STA	DORES		;SETUP FLAG.
NODATT: SEC			;PREP TO SBCQ
	SBCI	REMTK-":"	;REM ONLY STOPS ON NULL.
	BNE	KLOOP		;NO, CONTINUE CRUNCHING.
	STA	ENDCHR		;REM STOPS ONLY ON NULL, NOT : OR ".
STR1:	LDA	BUFOFS,X
	BEQ	STUFFH		;YES, END OF LINE, SO DONE.
	CMP	ENDCHR		;END OF GOBBLE?
	BEQ	STUFFH		;YES, DONE WITH STRING.
STRNG:	INY			;INCREMENT BUFFER POINTER.
	STA	BUF-5,Y
	INX
	BNE	STR1		;PROCESS NEXT CHARACTER.
NTHIS:	LDX	TXTPTR		;RESTORE TEXT POINTER.
	INC	COUNT		;INCREMENT RES WORD COUNT.
NTHIS1: INY
	LDA	RESLST-1,Y,	;GET RES CHARACTER.
	BPL	NTHIS1		;END OF ENTRY?
	LDA	RESLST,Y,	;YES. IS IT THE END?
	BNE	RESCON		;NO, TRY THE NEXT WORD.
	LDA	BUFOFS,X	;YES, END OF TABLE. GET 1ST CHR.
	BPL	GETBPT		;STORE IT AWAY (ALWAYS BRANCHES).
CRDONE: STA	BUF-3,Y,	;SO THAT IF THIS IS A DIR STATEMENT
				;ITS END WILL LOOK LIKE END OF PROGRAM.
IFN	<<BUF+BUFLEN>/256>-<<BUF-1>/256>,<
	DEC	TXTPTR+1>
	LDAI	<BUF&255>-1	;MAKE TXTPTR POINT TO
	STA	TXTPTR		;CRUNCHED LINE.
LISTRT: RTS			;RETURN TO CALLER.
;
; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE
; WHOSE NUMBER IS PASSED IN "LINNUM".
; THERE ARE TWO POSSIBLE RETURNS:
;
;	1) CARRY SET.
;	   LOWTR POINTS TO THE LINK FIELD IN THE LINE
;	   WHICH IS THE ONE SEARCHED FOR.
;
;	2) CARRY NOT SET.
;	   LINE NOT FOUND. [LOWTR] POINTS TO THE LINE IN THE
;	   PROGRAM GREATER THAN THE ONE SOUGHT AFTER.
;
FNDLIN: LDWX	TXTTAB		;LOAD [X,A] WITH [TXTTAB]
FNDLNC: LDYI	1
	STWX	LOWTR		;STORE [X,A] INTO LOWTR
	LDADY	LOWTR		;SEE IF LINK IS 0
	BEQ	FLINRT
	INY
	INY
	LDA	LINNUM+1	;COMP HIGH ORDERS OF LINE NUMBERS.
	CMPDY	LOWTR
	BCC	FLNRTS		;NO SUCH LINE NUMBER.
	BEQ	FNDLO1
	DEY
	BNE	AFFRTS		;ALWAYS BRANCH.
FNDLO1: LDA	LINNUM
	DEY
	CMPDY	LOWTR		;COMPARE LOW ORDERS.
	BCC	FLNRTS		;NO SUCH NUMBER.
	BEQ	FLNRTS		;GO TIT.
AFFRTS: DEY
	LDADY	LOWTR		;FETCH LINK.
	TAX
	DEY
	LDADY	LOWTR
	BCS	FNDLNC		;ALWAYS BRANCHES.
FLINRT: CLC			;C MAY BE HIGH.
FLNRTS: RTS			;RETURN TO CALLER.
;
; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL
; AS VARIABLE SPACE.
;
SCRATH: BNE	FLNRTS		;MAKE SURE THERE IS A TERMINATOR.
SCRTCH: LDAI	0		;GET A CLEARER.
	TAY			;SET UP INDEX.
	STADY	TXTTAB		;CLEAR	FIRST LINK.
	INY
	STADY	TXTTAB
	LDA	TXTTAB
	CLC
	ADCI	2
	STA	VARTAB		;SETUP [VARTAB].
	LDA	TXTTAB+1
	ADCI	0
	STA	VARTAB+1
RUNC:	JSR	STXTPT
	LDAI	0		;SET ZERO FLAG
;
; THIS CODE IS FOR THE CLEAR COMMAND.
;
CLEAR:	BNE	STKRTS		;SYNTAX ERROR IF NO TERMINATOR.
;
; CLEAR INITIALIZES THE VARIABLE AND
; ARRAY SPACE BY RESETING ARYTAB (THE END OF SIMPLE VARIABLE SPACE)
; AND STREND (THE END OF ARRAY STORAGE). IT FALLS INTO "STKINI"
; WHICH RESETS THE STACK. 
;
CLEARC: LDWD	MEMSIZ		;FREE UP STRING SPACE.
	STWD	FRETOP
IFN	EXTIO,<
	JSR	CQCALL>		;CLOSE ALL OPEN FILES.
	LDWD	VARTAB		;LIBERATE THE
	STWD	ARYTAB		;VARIABLES AND
	STWD	STREND		;ARRAYS.
FLOAD:	JSR	RESTOR		;RESTORE DATA.
;
; STKINI RESETS THE STACK POINTER ELIMINATING
; GOSUB AND FOR CONTEXT. STRING TEMPORARIES ARE FREED
; UP, SUBFLG IS RESET. CONTINUING IS PROHIBITED.
; AND A DUMMY ENTRY IS LEFT AT THE BOTTOM OF THE STACK SO "FNDFOR" WILL ALWAYS
; FIND A NON-"FOR" ENTRY AT THE BOTTOM OF THE STACK.
;
STKINI: LDXI	TEMPST		;INITIALIZE STRING TEMPORARIES.
	STX	TEMPPT
	PLA			;SETUP RETURN ADDRESS.
	TAY
	PLA
	LDXI	STKEND-257
	TXS
	PHA
	TYA
	PHA
	LDAI	0
	STA	OLDTXT+1	;DISALLOWING CONTINUING
	STA	SUBFLG		;ALLOW SUBSCRIPTS.
STKRTS: RTS

STXTPT: CLC
	LDA	TXTTAB
	ADCI	255
	STA	TXTPTR
	LDA	TXTTAB+1
	ADCI	255
	STA	TXTPTR+1	;SETUP TEXT POINTER.
	RTS
PAGE
SUBTTL	THE "LIST" COMMAND.

LIST:	BCC	GOLST		;IT IS A DIGIT.
	BEQ	GOLST		;IT IS A TERMINATOR.
	CMPI	MINUTK		;DASH PRECEDING?
	BNE	STKRTS		;NO, SO SYNTAX ERROR.
GOLST:	JSR	LINGET		;GET LINE NUMBER INTO NUMLIN.
	JSR	FNDLIN		;FIND LINE .GE. [NUMLIN].
	JSR	CHRGOT		;GET LAST CHARACTER.
	BEQ	LSTEND		;IF END OF LINE, # IS THE END.
	CMPI	MINUTK		;DASH?
	BNE	FLNRTS		;IF NOT, SYNTAX ERROR.
	JSR	CHRGET		;GET NEXT CHAR.
	JSR	LINGET		;GET END #.
	BNE	FLNRTS		;IF NOT TERMINATOR, ERROR.
LSTEND: PLA
	PLA			;GET RID OF "NEWSTT" RTS ADDR.
	LDA	LINNUM		;SEE IF IT WAS EXISTENT.
	ORA	LINNUM+1
	BNE	LIST4		;IT WAS TYPED.
	LDAI	255
	STA	LINNUM
	STA	LINNUM+1	;MAKE IT HUGE.
LIST4:	LDYI	1
IFE	REALIO-3,<
	STY	DORES>
	LDADY	LOWTR		;IS LINK ZERO?
	BEQ	GRODY		;YES, GO TO READY.
IFN	REALIO,<
	JSR	ISCNTC>		;LISTEN FOR CONT-C.
	JSR	CRDO		;PRINT CRLF TO START WITH.
	INY
	LDADY	LOWTR
	TAX
	INY
	LDADY	LOWTR		;GET LINE NUMBER.
	CMP	LINNUM+1	;SEE IF BEYOND LAST.
	BNE	TSTDUN		;GO DETERMINE RELATION.
	CPX	LINNUM		;WAS EQUAL SO TEST LOW ORDER.
	BEQ	TYPLIN		;EQUAL, SO LIST IT.
TSTDUN: BCS	GRODY		;IF LINE IS GR THAN LAST, THEN DUNE.
TYPLIN: STY	LSTPNT
	JSR	LINPRT		;PRINT AS INT WITHOUT LEADING SPACE.
	LDAI	" "		;ALWAYS PRINT SPACE AFTER NUMBER.
PRIT4:	LDY	LSTPNT		;GET POINTER TO LINE BACK.
	ANDI	127
PLOOP:	JSR	OUTDO		;PRINT CHAR.
IFE	REALIO-3,<
	CMPI	34
	BNE	PLOOP1
	COM	DORES>		;IF QUOTE, COMPLEMENT FLAG.
PLOOP1: INY
	BEQ	GRODY		;IF WE HAVE PRINTED 256 CHARACTERS
				;THE PROGRAM MUST BE MISFORMATED IN
				;MEMORY DUE TO A BAD LOAD OR BAD
				;HARDWARE. LET THE GUY RECOVER
	LDADY	LOWTR		;GET NEXT CHAR. IS IT ZERO?
	BNE	QPLOP		;YES. END OF LINE.
	TAY
	LDADY	LOWTR
	TAX
	INY
	LDADY	LOWTR
	STX	LOWTR
	STA	LOWTR+1
	BNE	LIST4		;BRANCH IF SOMETHING TO LIST.
GRODY:	JMP	READY
				;IS IT A TOKEN?
QPLOP:	BPL	PLOOP		;NO, HEAD FOR PRINTER.
IFE	REALIO-3,<
	CMPI	PI
	BEQ	PLOOP
	BIT	DORES		;INSIDE QUOTE MARKS?
	BMI	PLOOP>		;YES, JUST TYPE THE CHARACTER.
	SEC
	SBCI	127		;GET RID OF SIGN BIT AND ADD 1.
	TAX			;MAKE IT A COUNTER.
	STY	LSTPNT		;SAVE POINTER TO LINE.
	LDYI	255		;LOOK AT RES'D WORD LIST.
RESRCH: DEX			;IS THIS THE RES'D WORD?
	BEQ	PRIT3		;YES, GO TOSS IT UP..
RESCR1: INY
	LDA	RESLST,Y,	;END OF ENTRY?
	BPL	RESCR1		;NO, CONTINUE PASSING.
	BMI	RESRCH
PRIT3:	INY
	LDA	RESLST,Y
	BMI	PRIT4		;END OF RESERVED WORD.
	JSR	OUTDO		;PRINT IT.
	BNE	PRIT3		;END OF ENTRY? NO, TYPE REST.
PAGE
SUBTTL THE "FOR" STATEMENT.
;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
;	TOKEN (FORTK) 1 BYTE
;	A POINTER TO THE LOOP VARIABLE 2 BYTES
;	THE STEP 4+ADDPRC BYTES
;	A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
;	THE UPPER VALUE 4+ADDPRC BYTES
;	THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
;	A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;

FOR:	LDAI	128		;DON'T RECOGNIZE
	STA	SUBFLG		;SUBSCRIPTED VARIABLES.
	JSR	LET		;READ THE VARIABLE AND ASSIGN IT
				;THE CORRECT INITIAL VALUE AND STORE
				;A POINTER TO THE VARIABLE IN VARPNT.
	JSR	FNDFOR		;PNTR IS IN VARPNT, AND FORPNT.
	BNE	NOTOL		;IF NO MATCH, DON'T ELIMINATE ANYTHING.
	TXA			;MAKE IT ARITHMETICAL.
	ADCI	FORSIZ-3	;ELIMINATE ALMOST ALL.
	TAX			;NOTE C=1, THEN PLA, PLA.
	TXS			;MANIFEST.
NOTOL:	PLA			;GET RID OF NEWSTT RETURN ADDRESS
	PLA			;IN CASE THIS IS A TOTALLY NEW ENTRY.
	LDAI	8+ADDPRC
	JSR	GETSTK		;MAKE SURE 16 BYTES ARE AVAILABLE.
	JSR	DATAN		;GET A COUNT IN [Y] OF THE NUMBER OF
				;CHACRACTERS LEFT IN THE "FOR" STATEMENT
				;[TXTPTR] IS UNAFFECTED.
	CLC			;PREP TO ADD.
	TYA			;SAVE IT FOR PUSHING.
	ADC	TXTPTR
	PHA
	LDA	TXTPTR+1
	ADCI	0
	PHA
	PSHWD	CURLIN		;PUT LINE NUMBER ON STACK.
	SYNCHK	TOTK		;"TO" IS NECESSARY.
	JSR	CHKNUM		;VALUE MUST BE A NUMBER.
	JSR	FRMNUM		;GET UPPER VALUE INTO FAC.
	LDA	FACSGN		;PACK FAC.
	ORAI	127
	AND	FACHO
	STA	FACHO		;SET PACKED SIGN BIT.
	LDWDI	LDFONE
	STWD	INDEX1
	JMP	FORPSH		;PUT FAC ONTO STACK, PACKED.
LDFONE: LDWDI	FONE		;PUT 1.0 INTO FAC.
	JSR	MOVFM
	JSR	CHRGOT
	CMPI	STEPTK		;A STEP IS GIVEN?
	BNE	ONEON		;NO. ASSUME 1.0.
	JSR	CHRGET		;YES. ADVANCE POINTER.
	JSR	FRMNUM		;READ THE STEP.
ONEON:	JSR	SIGN		;GET SIGN IN ACCA.
	JSR	PUSHF		;PUSH FAC ONTO STACK (THRU A).
	PSHWD	FORPNT		;PUT PNTR TO VARIABLE ON STACK.
NXTCON: LDAI	FORTK		;PUT A FORTK ONTO STACK.
	PHA
;	BNEA	NEWSTT		;SIMULATE BNE TO NEWSTT. JUST FALL IN.
PAGE
SUBTTL	NEW STATEMENT FETCHER.
;
; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY TXTPTR
; IS ":" OR END-OF-LINE. THE ADDRESS OF THIS LOC IS LEFT
; ON THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
; IT CAN MERELY DO A RTS WHEN IT IS DONE.
;
NEWSTT: IFN	REALIO,<
	JSR	ISCNTC>		;LISTEN FOR CONTROL-C.
	LDWD	TXTPTR		;LOOK AT CURRENT CHARACTER.
IFN	BUFPAG,<
	CPYI	BUFPAG>		;SEE IF IT WAS DIRECT BY CHECK FOR BUF'S PAGE NUMBER
	BEQ	DIRCON
	STWD	OLDTXT		;SAVE IN CASE OF RESTART BY INPUT.
IFN	BUFPAG,<DIRCON:>
	LDYI	0
IFE	BUFPAG,<DIRCON:>
	LDADY	TXTPTR
	BNE	MORSTS		;NOT NULL -- CHECK WHAT IT IS
	LDYI	2		;LOOK AT LINK.
	LDADY	TXTPTR		;IS LINK 0?
	CLC		;CLEAR CARRY FOR ENDCON AND MATH THAT FOLLOWS
	JEQ	ENDCON		;YES - RAN OFF THE END.
	INY			;PUT LINE NUMBER IN CURLIN.
	LDADY	TXTPTR
	STA	CURLIN
	INY
	LDADY	TXTPTR
	STA	CURLIN+1
	TYA
	ADC	TXTPTR
	STA	TXTPTR
	BCC	GONE
	INC	TXTPTR+1
GONE:	JSR	CHRGET		;GET THE STATEMENT TYPE.
	JSR	GONE3
	JMP	NEWSTT
GONE3:	BEQ	ISCRTS		;IF TERMINATOR, TRY AGAIN.
				;NO NEED TO SET UP CARRY SINCE IT WILL
				;BE ON IF NON-NUMERIC AND NUMERICS
				;WILL CAUSE A SYNTAX ERROR LIKE THEY SHOULD
GONE2:	SBCI	ENDTK		;" ON ... GOTO AND GOSUB" COME HERE.
	BCC	GLET
	CMPI	SCRATK-ENDTK+1
	BCS	SNERRX		;SOME RES'D WORD BUT NOT
				;A STATEMENT RES'D WORD.
	ASL	A,		;MULTIPLY BY TWO.
	TAY			;MAKE AN INDEX.
	LDA	STMDSP+1,Y
	PHA
	LDA	STMDSP,Y
	PHA			;PUT DISP ADDR ONTO STACK.
	JMP	CHRGET
GLET:	JMP	LET		;MUST BE A LET
MORSTS: CMPI	":"
	BEQ	GONE		;IF A ":" CONTINUE STATEMENT
SNERR1: JMP	SNERR		;NEITHER 0 OR ":" SO SYNTAX ERROR
SNERRX: CMPI	GOTK-ENDTK
	BNE	SNERR1
	JSR	CHRGET		;READ IN THE CHARACTER AFTER "GO "
	SYNCHK	TOTK
	JMP	GOTO
PAGE
SUBTTL	RESTORE,STOP,END,CONTINUE,NULL,CLEAR.

RESTOR: SEC
	LDA	TXTTAB
	SBCI	1
	LDY	TXTTAB+1
	BCS	RESFIN
	DEY
RESFIN: STWD	DATPTR		;READ FINISHES COME TO "RESFIN".
ISCRTS: RTS

IFE	REALIO-1,<
ISCNTC: LDAI	1
	BIT	^O13500
	BMI	ISCRTS
	LDXI	8
	LDAI	3
	CMPI	3>
IFE	REALIO-2,<
ISCNTC: LDA	^O176000
	REPEAT	4,<NOP>
	LSR	A,
	BCC	ISCRTS
	JSR	INCHR		;EAT CHAR THAT WAS TYPED
	CMPI	3>		;WAS IT A CONTROL-C??

IFE	REALIO-4,<
ISCNTC: LDA	^O140000	;CHECK THE CHARACTER
	CMPI	^O203
	BEQ	ISCCAP
	RTS
ISCCAP: JSR	INCHR
	CMPI	^O203>
STOP:	BCS	STOPC		;MAKE [C] NONZERO AS A FLAG.
END:	CLC
STOPC:	BNE	CONTRT		;RETURN IF NOT CONT-C OR
				;IF NO TERMINATOR FOR STOP OR END.
				;[C]=0 SO WILL NOT PRINT "BREAK".
	LDWD	TXTPTR
IFN	BUFPAG,<
	LDX	CURLIN+1
	INX>
	BEQ	DIRIS
	STWD	OLDTXT
STPEND: LDWD	CURLIN
	STWD	OLDLIN
DIRIS:	PLA			;POP OFF NEWSTT ADDR.
	PLA
ENDCON: LDWDI	BRKTXT
IFN	REALIO,<
	LDXI	0
	STX	CNTWFL>
	BCC	GORDY		;CARRY CLEAR SO DON'T PRINT "BREAK".
	JMP	ERRFIN
GORDY:	JMP	READY		;TYPE "READY".

IFE	REALIO,<
DDT:	PLA			;GET RID OF NEWSTT RETURN.
	PLA
	HRRZ	14,.JBDDT##
	JRST	0(14)>
CONT:	BNE	CONTRT		;MAKE SURE THERE IS A TERMINATOR.
	LDXI	ERRCN		;CONTINUE ERROR.
	LDY	OLDTXT+1	;A STORED TXTPTR OF ZERO IS SETUP
				;BY STKINI AND INDICATES THERE IS
				;NOTHING TO CONTINUE.
	JEQ	ERROR		;"STOP", "END", TYPING CRLF TO 
				;"INPUT" AND  ^C SETUP OLDTXT.
	LDA	OLDTXT
	STWD	TXTPTR
	LDWD	OLDLIN
	STWD	CURLIN
CONTRT: RTS			;RETURN TO CALLER.

IFN	NULCMD,<
NULL:	JSR	GETBYT
	BNE	CONTRT		;MAKE SURE THERE IS TERMINATOR.
	INX
	CPXI	240		;IS THE NUMBER REASONABLE?
	BCS	FCERR1		;"FUNCTION CALL" ERROR.
	DEX			;BACK -1
	STX	NULCNT
	RTS
FCERR1: JMP	FCERR>
PAGE
SUBTTL	LOAD AND SAVE SUBROUTINES.

IFE	REALIO-1,<		;KIM CASSETTE I/O
SAVE:	TSX			;SAVE STACK POINTER
	STX	INPFLG
	LDAI	STKEND-256-200
	STA	^O362		;SETUP DUMMY STACK FOR KIM MONITOR
	LDAI	254		;MAKE ID BYTE EQUAL TO FF HEX
	STA	^O13771		;STORE INTO KIM ID
	LDWD	TXTTAB		;START DUMPING FROM TXTTAB
	STWD	^O13765		;SETUP SAL,SAH
	LDWD	VARTAB		;STOP AT VARTAB
	STWD	^O13767		;SETUP EAL,EAH
	JMP	^O14000
RETSAV: LDX	INPFLG		;RESORE THE REAL STACK POINTER
	TXS
	LDWDI	TAPMES		;SAY IT WAS DONE
	JMP	STROUT
GLOAD:	DT"LOADED"
	0
TAPMES: DT"SAVED"
	ACRLF
	0
PATSAV: BLOCK 20
LOAD:	LDWD	TXTTAB		;START DUMPING IN AT TXTTAB
	STWD	^O13765		;SETUP SAL,SAH
	LDAI	255
	STA	^O13771
	LDWDI	RTLOAD
	STWD	^O1		;SET UP RETURN ADDRESS FOR LOAD
	JMP	^O14163		;GO READ THE DATA IN
RTLOAD: LDXI	STKEND-256		;RESET THE STACK
	TXS
	LDWDI	READY
	STWD	^O1
	LDWDI	GLOAD		;TELL HIM IT WORKED
	JSR	STROUT
	LDXY	^O13755		;GET LAST LOCATION
	TXA			;ITS ONE TOO BIG
	BNE	DECVRT		;DECREMENT [X,Y]
	NOP
DECVRT: NOP
	STXY	VARTAB		;SETUP NEW VARIABLE LOCATION
	JMP	FINI>		;RELINK THE PROGRAM
IFE	REALIO-4,<
SAVE:	SEC			;CALCLUATE PROGRAM SIZE IN POKER
	LDA	VARTAB
	SBC	TXTTAB
	STA	POKER
	LDA	VARTAB+1
	SBC	TXTTAB+1
	STA	POKER+1
	JSR	VARTIO
	JSR	CQCOUT		;WRITE PROGRAM SIZE [POKER]
	JSR	PROGIO
	JMP	CQCOUT		;WRITE PROGRAM.

LOAD:	JSR	VARTIO
	JSR	CQCSIN		;READ SIZE OF PROGRAM INTO POKER
	CLC
	LDA	TXTTAB		;CALCULATE VARTAB FROM SIZE AND
	ADC	POKER		;TXTTAB
	STA	VARTAB
	LDA	TXTTAB+1
	ADC	POKER+1
	STA	VARTAB+1
	JSR	PROGIO
	JSR	CQCSIN		;READ PROGRAM.
	LDWDI	TPDONE
	JSR	STROUT
	JMP	FINI

TPDONE: DT"LOADED"
	0

VARTIO: LDWDI	POKER
	STWD	^O74
	LDAI	POKER+2
	STWD	^O76
	RTS
PROGIO: LDWD	TXTTAB
	STWD	^O74
	LDWD	VARTAB
	STWD	^O76
	RTS>
PAGE
SUBTTL	RUN,GOTO,GOSUB,RETURN.
RUN:	JEQ	RUNC		;IF NO LINE # ARGUMENT.
	JSR	CLEARC		;CLEAN UP -- RESET THE STACK.
	JMP	RUNC2		;MUST REPLACE RTS ADDR.
;
; A GOSUB ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS:
;	THE GOSUTK ONE BYTE
;	THE LINE NUMBER OF THE GOSUB STATEMENT TWO BYTES
;	A POINTER INTO THE TEXT OF THE GOSUB TWO BYTES
;
; HIGH ADDRESS.
;
; TOTAL FIVE BYTES.
;
GOSUB:	LDAI	3
	JSR	GETSTK		;MAKE SURE THERE IS ROOM.
	PSHWD	TXTPTR		;PUSH ON THE TEXT POINTER.
	PSHWD	CURLIN		;PUSH ON THE CURRENT LINE NUMBER.
	LDAI	GOSUTK
	PHA			;PUSH ON A GOSUB TOKEN.
RUNC2:	JSR	CHRGOT		;GET CHARACTER AND SET CODES FOR LINGET.
	JSR	GOTO		;USE RTS SCHEME TO "NEWSTT".
	JMP	NEWSTT

GOTO:	JSR	LINGET		;PICK UP THE LINE NUMBER IN "LINNUM".
	JSR	REMN		;SKIP TO END OF LINE.
	LDA	CURLIN+1
	CMP	LINNUM+1
	BCS	LUK4IT
	TYA
	SEC
	ADC	TXTPTR
	LDX	TXTPTR+1
	BCC	LUKALL
	INX
	BCSA	LUKALL		;ALWAYS GOES.
LUK4IT: LDWX	TXTTAB
LUKALL: JSR	FNDLNC		;[X,A] ARE ALL SET UP.
QFOUND: BCC	USERR		;GOTO LINE IS NONEXISTANT.
	LDA	LOWTR
	SBCI	1
	STA	TXTPTR
	LDA	LOWTR+1
	SBCI	0
	STA	TXTPTR+1
GORTS:	RTS			;PROCESS THE STATEMENT.
;
; "RETURN" RESTORES THE LINE NUMBER AND TEXT PNTR FROM THE STACK
; AND ELIMINATES ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB" ENTRY.
;
RETURN: BNE	GORTS		;NO TERMINATOR=BLOW HIM UP.
	LDAI	255
	STA	FORPNT+1	;MAKE SURE THE VARIABLE'S PNTR
				;NEVER GETS MATCHED.
	JSR	FNDFOR		;GO PAST ALL THE "FOR" ENTRIES.
	TXS
	CMPI	GOSUTK		;RETURN WITHOUT GOSUB?
	BEQ	RETU1
	LDXI	ERRRG
	SKIP2
USERR:	LDXI	ERRUS		;NO MATCH SO "US" ERROR.
	JMP	ERROR		;YES.
SNERR2: JMP	SNERR
RETU1:	PLA			;REMOVE GOSUTK.
	PULWD	CURLIN		;GET LINE NUMBER "GOSUB" WAS FROM.
	PULWD	TXTPTR		;GET TEXT PNTR FROM "GOSUB".
DATA:	JSR	DATAN		;SKIP TO END OF STATEMENT, 
				;SINCE WHEN "GOSUB" STUCK THE TEXT  PNTR
				;ONTO THE STACK, THE LINE NUMBER ARG
				;HADN'T BEEN READ YET.
ADDON:	TYA
	CLC
	ADC	TXTPTR
	STA	TXTPTR
	BCC	REMRTS
	INC	TXTPTR+1
REMRTS: RTS			;"NEWSTT" RTS ADDR IS STILL THERE.

DATAN:	LDXI	":"		;"DATA" TERMINATES ON ":" AND NULL.
	SKIP2
REMN:	LDXI	0		;THE ONLY TERMINATOR IS NULL.
	STX	CHARAC		;PRESERVE IT.
	LDYI	0		;THIS MAKES CHARAC=0 AFTER SWAP.
	STY	ENDCHR
EXCHQT: LDA	ENDCHR
	LDX	CHARAC
	STA	CHARAC
	STX	ENDCHR
REMER:	LDADY	TXTPTR
	BEQ	REMRTS		;NULL ALWAYS TERMINATES.
	CMP	ENDCHR		;IS IT THE OTHER TERMINATOR?
	BEQ	REMRTS		;YES, IT'S FINISHED.
	INY			;PROGRESS TO NEXT CHARACTER.
	CMPI	34		;IS IT A QUOTE?
	BNE	REMER		;NO, JUST CONTINUE.
	BEQA	EXCHQT		;YES, TIME TO TRADE.
PAGE
SUBTTL	"IF ... THEN" CODE.
IF:	JSR	FRMEVL		;EVALUATE A FORMULA.
	JSR	CHRGOT		;GET CURRENT CHARACTER.
	CMPI	GOTOTK		;IS TERMINATING CHARACTER A GOTOTK?
	BEQ	OKGOTO		;YES.
	SYNCHK	THENTK		;NO, IT MUST BE "THEN".
OKGOTO: LDA	FACEXP		;0=FALSE. ALL OTHERS TRUE.
	BNE	DOCOND		;TRUE !
REM:	JSR	REMN		;SKIP REST OF STATEMENT.
	BEQA	ADDON		;WILL ALWAYS BRANCH.
DOCOND: JSR	CHRGOT		;TEST CURRENT CHARACTER.
	BCS	DOCO		;IF A NUMBER, GOTO IT.
	JMP	GOTO
DOCO:	JMP	GONE3		;INTERPRET NEW STATEMENT.
PAGE
SUBTTL	"ON ... GO TO ..." CODE.
ONGOTO: JSR	GETBYT		;GET VALUE IN FACLO.
	PHA			;SAVE FOR LATER.
	CMPI	GOSUTK		;AN "ON ... GOSUB" PERHAPS?
	BEQ	ONGLOP		;YES.
SNERR3: CMPI	GOTOTK		;MUST BE "GOTOTK".
	BNE	SNERR2
ONGLOP: DEC	FACLO
	BNE	ONGLP1		;SKIP ANOTHER LINE NUMBER.
	PLA			;GET DISPATCH CHARACTER.
	JMP	GONE2
ONGLP1: JSR	CHRGET		;ADVANCE AND SET CODES.
	JSR	LINGET
	CMPI	44		;IS IT A COMMA?
	BEQ	ONGLOP
	PLA			;REMOVE STACK ENTRY (TOKEN).
ONGRTS: RTS			;EITHER END-OF-LINE OR SYNTAX ERROR.
PAGE
SUBTTL	LINGET -- READ A LINE NUMBER INTO LINNUM
;
; "LINGET" READS A LINE NUMBER FROM THE CURRENT TEXT POSITION.
;
; LINE NUMBERS RANGE FROM 0 TO 64000-1.
;
; THE ANSWER IS RETURNED IN "LINNUM".
; "TXTPTR" IS UPDATED TO POINT TO THE TERMINATING CHARCTER
; AND [A] = THE TERMINATING CHARACTER WITH CONDITION
; CODES SET UP TO REFLECT ITS VALUE.
;
LINGET: LDXI	0
	STX	LINNUM		;INITIALIZE LINE NUMBER TO ZERO.
	STX	LINNUM+1
MORLIN: BCS	ONGRTS		;IT IS NOT A DIGIT.
	SBCI	"0"-1		;-1 SINCE C=0.
	STA	CHARAC		;SAVE CHARACTER.
	LDA	LINNUM+1
	STA	INDEX
	CMPI	25		;LINE NUMBER WILL BE .LT. 64000?
	BCS	SNERR3
	LDA	LINNUM
	ASL	A,		;MULTIPLY BY 10.
	ROL	INDEX
	ASL	A
	ROL	INDEX
	ADC	LINNUM
	STA	LINNUM
	LDA	INDEX
	ADC	LINNUM+1
	STA	LINNUM+1
	ASL	LINNUM
	ROL	LINNUM+1
	LDA	LINNUM
	ADC	CHARAC		;ADD IN DIGIT.
	STA	LINNUM
	BCC	NXTLGC
	INC	LINNUM+1
NXTLGC: JSR	CHRGET
	JMP	MORLIN

PAGE
SUBTTL	"LET" CODE.
LET:	JSR	PTRGET		;GET PNTR TO VARIABLE INTO "VARPNT".
	STWD	FORPNT		;PRESERVE POINTER.
	SYNCHK	EQULTK		;"=" IS NECESSARY.
IFN	INTPRC,<
	LDA	INTFLG		;SAVE FOR LATER.
	PHA>
	LDA	VALTYP		;RETAIN THE VARIABLE'S VALUE TYPE.
	PHA
	JSR	FRMEVL		;GET VALUE OF FORMULA INTO "FAC".
	PLA
	ROL	A,		;CARRY SET FOR STRING, OFF FOR
				;NUMERIC.
	JSR	CHKVAL		;MAKE SURE "VALTYP" MATCHES CARRY.
				;AND SET ZERO FLAG FOR NUMERIC.
	BNE	COPSTR		;IF NUMERIC, COPY IT.
COPNUM:
IFN	INTPRC,<
	PLA			;GET NUMBER TYPE.
QINTGR: BPL	COPFLT		;STORE A FLTING NUMBER.
	JSR	ROUND		;ROUND INTEGER.
	JSR	AYINT		;MAKE 2-BYTE NUMBER.
	LDYI	0
	LDA	FACMO		;GET HIGH.
	STADY	FORPNT		;STORE IT.
	INY
	LDA	FACLO		;GET LOW.
	STADY	FORPNT
	RTS>
COPFLT: JMP	MOVVF		;PUT NUMBER @FORPNT.

COPSTR:
IFN	INTPRC,<PLA>		;IF STRING, NO INTFLG.
INPCOM:
IFN	TIME,<
	LDY	FORPNT+1	;TI$?
	CPYI	ZERO/256	;ONLY TI$ CAN BE THIS ON ASSIG.
	BNE	GETSPT		; WAS NOT TI$.
	JSR	FREFAC		;WE WONT NEEDIT.
	CMPI	6		;LENGTH CORRECT?
	BNE	FCERR2
	LDYI	0		;YES. DO SETUP.
	STY	FACEXP		;ZERO FAC TO START WITH.
	STY	FACSGN
TIMELP: STY	FBUFPT		;SAVE POSOTION.
	JSR	TIMNUM		;GET A DIGIT.
	JSR	MUL10		;WHOLE QTY BY 10.
	INC	FBUFPT
	LDY	FBUFPT
	JSR	TIMNUM
	JSR	MOVAF
	TAX			;IF NUM=0 THEN NO MULT.
	BEQ	NOML6		;IF =0, GO TIT.
	INX			;MULT BY TWO.
	TXA
	JSR	FINML6		;ADD IN AND MULT BY 2 GIVES *6.
NOML6:	LDY	FBUFPT
	INY
	CPYI	6		;DONE ALL SIX?
	BNE	TIMELP
	JSR	MUL10		;ONE LAST TIME.
	JSR	QINT		;SHIFT IT OVER TO THE RIGHT.
	LDXI	2
	SEI			;DISALLOW INTERRUPTS.
TIMEST: LDA	FACMOH,X
	STA	CQTIMR,X
	DEX
	BPL	TIMEST		;LOOP 3 TIMES.
	CLI			;TURN ON INTS AGAIN.
	RTS
TIMNUM: LDADY	INDEX		;INDEX SET UP BY FREFAC.
	JSR	QNUM
	BCC	GOTNUM
FCERR2: JMP	FCERR		;MUST BE NUMERIC STRING.
GOTNUM: SBCI	"0"-1		;C IS OFF.
	JMP	FINLOG>		;ADD IN DIGIT TO FAC.

GETSPT: LDYI	2		;GET PNTR TO DESCRIPTOR.
	LDADY	FACMO
	CMP	FRETOP+1	;SEE IF IT POINTS INTO STRING SPACE.
	BCC	DNTCPY		;IF [FRETOP],GT.[2&3,FACMO], DON'T COPY.
	BNE	QVARIA		;IT IS LESS.
	DEY
	LDADY	FACMO
	CMP	FRETOP		;COMPARE LOW ORDERS.
	BCC	DNTCPY
QVARIA: LDY	FACLO
	CPY	VARTAB+1	;IF [VARTAB].GT.[FACMO], DON'T COPY.
	BCC	DNTCPY
	BNE	COPY		;IT IS LESS.
	LDA	FACMO
	CMP	VARTAB		;COMPARE LOW ORDERS.
	BCS	COPY
DNTCPY: LDWD	FACMO
	JMP	COPYZC
COPY:	LDYI	0
	LDADY	FACMO
	JSR	STRINI		;GET ROOM TO COPY STRING INTO.
	LDWD	DSCPNT		;GET POINTER TO OLD DESCRIPTOR, SO 
	STWD	STRNG1		;MOVINS CAN FIND STRING.
	JSR	MOVINS		;COPY IT.
	LDWDI	DSCTMP		;GET POINTER TO OLD DESCRIPTOR.
COPYZC: STWD	DSCPNT		;REMEMBER POINTER TO DESCRIPTOR.
	JSR	FRETMS		;FREE UP THE TEMPORARY WITHOUT
				;FREEING UP ANY STRING SPACE.
	LDYI	0
	LDADY	DSCPNT
	STADY	FORPNT
	INY			;POINT TO STRING PNTR.
	LDADY	DSCPNT
	STADY	FORPNT
	INY
	LDADY	DSCPNT
	STADY	FORPNT
	RTS
PAGE
SUBTTL	PRINT CODE.
IFN	EXTIO,<
PRINTN: JSR	CMD		;DOCMD
	JMP	IODONE		;RELEASE CHANNEL.
CMD:	JSR	GETBYT
	BEQ	SAVEIT
	SYNCHK	44		;COMMA?
SAVEIT: PHP
	JSR	CQOOUT		;CHECK AND OPEN OUTPUT CHANNL.
	STX	CHANNL		;CHANNL TO OUTPUT ON.
	PLP			;GET STATUS BACK.
	JMP	PRINT>
STRDON: JSR	STRPRT
NEWCHR: JSR	CHRGOT		;REGET LAST CHARACTER.
PRINT:	BEQ	CRDO		;TERMINATOR SO TYPE CRLF.
PRINTC: BEQ	PRTRTS		;HERE AFTER SEEING TAB(X) OR , OR ;
				;IN WHICH CASE A TERMINATOR DOES NOT
				;MEAN TYPE A CRLF BUT JUST RTS.
	CMPI	TABTK		;TAB FUNCTION?
	BEQ	TABER		;YES.
	CMPI	SPCTK		;SPACE FUNCTION?
	CLC
	BEQ	TABER
	CMPI	44		;A COMMA?
	BEQ	COMPRT		;YES.
	CMPI	59		;A SEMICOLON?
	BEQ	NOTABR		;YES.
	JSR	FRMEVL		;EVALUATE THE FORMULA.
	BIT	VALTYP		;A STRING?
	BMI	STRDON		;YES.
	JSR	FOUT
	JSR	STRLIT		;BUILD DESCRIPTOR.
IFN	REALIO-3,<
	LDYI	0		;GET THE POINTER.
	LDADY	FACMO
	CLC
	ADC	TRMPOS		;MAKE SURE LEN+POS.LT.WIDTH.
	CMP	LINWID		;GREATER THAN LINE LENGTH?
				;REMEMBER SPACE PRINTED AFTER NUMBER.
	BCC	LINCHK		;GO TYPE.
	JSR	CRDO>		;YES, TYPE CRLF FIRST.
LINCHK: JSR	STRPRT		;PRINT THE NUMBER.
	JSR	OUTSPC		;PRINT A SPACE
	BNEA	NEWCHR		;ALWAYS GOES.
IFN	REALIO-4,<
IFN	BUFPAG,<
FININL: LDAI	0
	STA	BUF,X
	LDXYI	BUF-1>
IFE	BUFPAG,<
FININL: LDYI	0		;PUT A ZERO AT END OF BUF.
	STY	BUF,X
	LDXI	BUF-1>		;SETUP POINTER.
IFN	EXTIO,<
	LDA	CHANNL		;NO CRDO IF NOT TERMINAL.
	BNE	PRTRTS>>
CRDO:
IFE	EXTIO,<
	LDAI	13		;MAKE TRMPOS LESS THAN LINE LENGTH.
	STA	TRMPOS>
IFN	EXTIO,<
IFN	REALIO-3,<
	LDA	CHANNL
	BNE	GOCR
	STA	TRMPOS>
GOCR:	LDAI	13>		;X AND Y MUST BE PRESERVED.
	JSR	OUTDO
	LDAI	10
	JSR	OUTDO
CRFIN:
IFN	EXTIO,<
IFN	REALIO-3,<
	LDA	CHANNL
	BNE	PRTRTS>>
IFE	NULCMD,<
IFN	REALIO-3,<
	LDAI	0
	STA	TRMPOS>
	EORI	255>
IFN	NULCMD,<
	TXA			;PRESERVE [ACCX]. SOME NEED IT.
	PHA
	LDX	NULCNT		;GET NUMBER OF NULLS.
	BEQ	CLRPOS
	LDAI	0
PRTNUL: JSR	OUTDO
	DEX			;DONE WITH NULLS?
	BNE	PRTNUL
CLRPOS: STX	TRMPOS
	PLA
	TAX>
PRTRTS: RTS

COMPRT: LDA	TRMPOS
NCMPOS==<<<LINLEN/CLMWID>-1>*CLMWID>	;CLMWID BEYOND WHICH THERE ARE
IFN	REALIO-3,<
				;NO MORE COMMA FIELDS.
	CMP	NCMWID		;SO ALL COMMA DOES IS "CRDO".

	BCC	MORCOM
	JSR	CRDO		;TYPE CRLF.
	JMP	NOTABR>		;AND QUIT IF BEYOND LAST FIELD.
MORCOM: SEC
MORCO1: SBCI	CLMWID		;GET [A] MODULUS CLMWID.
	BCS	MORCO1
	EORI	255		;FILL PRINT POS OUT TO EVEN CLMWID SO
	ADCI	1
	BNE	ASPAC		;PRINT [A] SPACES.

TABER:	PHP			;REMEMBER IF SPC OR TAB FUNCTION.
	JSR	GTBYTC		;GET VALUE INTO ACCX.
	CMPI	41
	BNE	SNERR4
	PLP
	BCC	XSPAC		;PRINT [X] SPACES.
	TXA
	SBC	TRMPOS
	BCC	NOTABR		;NEGATIVE, DON'T PRINT ANY.
ASPAC:	TAX
XSPAC:	INX
XSPAC2: DEX			;DECREMENT THE COUNT.
	BNE	XSPAC1
NOTABR: JSR	CHRGET		;REGET LAST CHARACTER.
	JMP	PRINTC		;DON'T CALL CRDO.
XSPAC1: JSR	OUTSPC
	BNEA	XSPAC2
;
; PRINT THE STRING POINTED TO BY [Y,A] WHICH ENDS WITH A ZERO.
; IF THE STRING IS BELOW DSCTMP IT WILL BE COPIED INTO STRING SPACE.
;
STROUT: JSR	STRLIT		;GET A STRING LITERAL.
;
; PRINT THE STRING WHOSE DESCRIPTOR IS POINTED TO BY FACMO.
;
STRPRT: JSR	FREFAC		;RETURN TEMP POINTER.
	TAX			;PUT COUNT INTO COUNTER.
	LDYI	0
	INX			;MOVE ONE AHEAD.
STRPR2: DEX
	BEQ	PRTRTS		;ALL DONE.
	LDADY	INDEX		;PNTR TO ACT STRNG SET BY FREFAC.
	JSR	OUTDO
	INY
	CMPI	13
	BNE	STRPR2
	JSR	CRFIN		;TYPE REST OF CARRIAGE RETURN.
	JMP	STRPR2		;AND ON AND ON.
;
; OUTDO OUTPUTS THE CHARACTER IN ACCA, USING CNTWFL
; (SUPPRESS OR NOT), TRMPOS (PRINT HEAD POSITION),
; TIMING, ETCQ. NO REGISTERS ARE CHANGED.
;
OUTSPC:
IFN	REALIO-3,<
	LDAI	" ">
IFE	REALIO-3,<
	LDA	CHANNL
	BEQ	CRTSKP
	LDAI	" "
	SKIP2
CRTSKP: LDAI	29>		;COMMODORE'S SKIP CHARACTER.
	SKIP2
OUTQST: LDAI	"?"
OUTDO:	IFN	REALIO,<
	BIT	CNTWFL		;SHOULDN'T AFFECT CHANNEL I/O!
	BMI	OUTRTS>
IFN	REALIO-3,<
	PHA
	CMPI	32		;IS THIS A PRINTING CHAR?
	BCC	TRYOUT		;NO, DON'T INCLUDE IT IN TRMPOS.
	LDA	TRMPOS
	CMP	LINWID		;LENGTH = TERMINAL WIDTH?
	BNE	OUTDO1
	JSR	CRDO		;YES, TYPE CRLF
OUTDO1:
IFN EXTIO,<
	LDA	CHANNL
	BNE	TRYOUT>
INCTRM: INC	TRMPOS		;INCREMENT COUNT.
TRYOUT: PLA>			;RESTORE THE A REGISTER

IFE	REALIO-1,<
	STY	KIMY>		;PRESERVE Y.
IFE	REALIO-4,<ORAI	^O200>	;TURN ON B7 FOR APPLE.
IFN	REALIO,<
OUTLOC: JSR	OUTCH>		;OUTPUT THE CHARACTER.
IFE	REALIO-1,<
	LDY	KIMY>		;GET Y BACK.
IFE	REALIO-2,<REPEAT	4,<NOP>>
IFE	REALIO-4,<ANDI	^O177>	;GET [A] BACK FROM APPLE.

IFE	REALIO,<
	TJSR	OUTSIM##>	;CALL SIMULATOR OUTPUT ROUTINE
OUTRTS: ANDI	255		;SET Z=0.
GETRTS: RTS

PAGE
SUBTTL	INPUT AND READ CODE.
;
; HERE WHEN THE DATA THAT WAS TYPED IN OR IN "DATA" STATEMENTS
; IS IMPROPERLY FORMATTED. FOR "INPUT" WE START AGAIN.
; FOR "READ" WE GIVE A SYNTAX ERROR AT THE DATA LINE.
;
TRMNOK: LDA	INPFLG
	BEQ	TRMNO1		;IF INPUT TRY AGAIN.
IFN	GETCMD,<
	BMI	GETDTL
	LDYI	255		;MAKE IT LOOK DIRECT.
	BNEA	STCURL		;ALWAYS GOES.
GETDTL:>
	LDWD	DATLIN		;GET DATA LINE NUMBER.
STCURL: STWD	CURLIN		;MAKE IT CURRENT LINE.
SNERR4: JMP	SNERR
TRMNO1:
IFN	EXTIO,<
	LDA	CHANNL		;IF NOT TERMINAL, GIVE BAD DATA.
	BEQ	DOAGIN
	LDXI	ERRBD
	JMP	ERROR>
DOAGIN: LDWDI	TRYAGN
	JSR	STROUT		;PRINT "?REDO FROM START".
	LDWD	OLDTXT		;POINT AT START
	STWD	TXTPTR		;OF THIS CURRENT LINE.
	RTS			;GO TO "NEWSTT".
IFN	GETCMD,<
GET:	JSR	ERRDIR		;DIRECT IS NOT OK.
IFN	EXTIO,<
	CMPI	"#"		;SEE IF "GET#".
	BNE	GETTTY		;NO, JUST GET TTY INPUT.
	JSR	CHRGET		;MOVE UP TO NEXT BYTE.
	JSR	GETBYT		;GET CHANNEL INTO X
	SYNCHK	44		;COMMA?
	JSR	CQOIN		;GET CHANNEL OPEN FOR INPUT.
	STX	CHANNL>
GETTTY: LDXYI	BUF+1		;POINT TO 0.
IFN	BUFPAG,<
	LDAI	0		;TO STUFF AND TO POINT.
	STA	BUF+1>
IFE	BUFPAG,<
	STY	BUF+1>		;ZERO IT.
	LDAI	64		;TURN ON V-BIT.
	JSR	INPCO1		;DO THE GET.
IFN	EXTIO,<
	LDX	CHANNL
	BNE	IORELE>		;RELEASE.
	RTS>

IFN	EXTIO,<
INPUTN: JSR	GETBYT		;GET CHANNEL NUMBER.
	SYNCHK	44		;A COMMA?
	JSR	CQOIN		;GO WHERE COMMODORE CHECKS IN OPEN.
	STX	CHANNL
	JSR	NOTQTI		;DO INPUT TO VARIABLES.
IODONE: LDA	CHANNL		;RELEASE CHANNEL.
IORELE: JSR	CQCCHN
	LDXI	0		;RESET CHANNEL TO TERMINAL.
	STX	CHANNL
	RTS>
INPUT:	IFN	REALIO,<
	LSR	CNTWFL>		;BE TALKATIVE.
	CMPI	34		;A QUOTE?
	BNE	NOTQTI		;NO MESSAGE.
	JSR	STRTXT		;LITERALIZE THE STRING IN TEXT
	SYNCHK	59		;MUST END WITH SEMICOLON.
	JSR	STRPRT		;PRINT IT OUT.
NOTQTI: JSR	ERRDIR		;USE COMMON ROUTINE SINCE DEF DIRECT
	LDAI	44		;GET COMMA.
	STA	BUF-1
				;IS ALSO ILLEGAL.
GETAGN: JSR	QINLIN		;TYPE "?" AND INPUT A LINE OF TEXT.
IFN	EXTIO,<
	LDA	CHANNL
	BEQ	BUFFUL
	LDA	CQSTAT		;GET STATUS BYTE.
	ANDI	2
	BEQ	BUFFUL		;A-OK.
	JSR	IODONE		;BAD. CLOSE CHANNEL.
	JMP	DATA		;SKIP REST OF INPUT.
BUFFUL:>
	LDA	BUF		;ANYTHING INPUT?
	BNE	INPCON		;YES, CONTINUE.
IFN	EXTIO,<
	LDA	CHANNL		;BLANK LINE MEANS GET ANOTHER.
	BNE	GETAGN>		;IF NOT TERMINAL.
	CLC			;MAKE SURE DONT PRINT BREAK
	JMP	STPEND		;NO, STOP.
QINLIN:
IFN	EXTIO,<
	LDA	CHANNL
	BNE	GINLIN>
	JSR	OUTQST
	JSR	OUTSPC
GINLIN: JMP	INLIN
READ:	LDXY	DATPTR		;GET LAST DATA LOCATION.
	XWD	^O1000,^O251	;LDAI TYA TO MAKE IT NONZERO.
IFE	BUFPAG,<
INPCON: >
	TYA
IFN	BUFPAG,<
	SKIP2
INPCON: LDAI	0>		;SET FLAG THAT THIS IS INPUT
INPCO1: STA	INPFLG		;STORE THE FLAG.
;
; IN THE PROCESSING OF DATA AND READ STATEMENTS:
; ONE POINTER POINTS TO THE DATA (IE, THE NUMBERS BEING FETCHED)
; AND ANOTHER POINTS TO THE LIST OF VARIABLES.
;
; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A
; TERMINATOR -- A , : OR END-OF-LINE.
;
; AT THIS POINT TXTPTR POINTS TO LIST OF VARIABLES AND
; [Y,X] POINTS TO DATA OR INPUT LINE.
;
	STXY	INPPTR
INLOOP: JSR	PTRGET		;READ VARIABLE LIST.
	STWD	FORPNT		;SAVE POINTER FOR "LET" STRING STUFFING.
				;RETURNS PNTR TOP VAR IN VARPNT.
	LDWD	TXTPTR		;SAVE TEXT PNTR.
	STWD	VARTXT
	LDXY	INPPTR
	STXY	TXTPTR
	JSR	CHRGOT		;GET IT AND SET Z IF TERM.
	BNE	DATBK1
	BIT	INPFLG
IFN	GETCMD,<
	BVC	QDATA
	JSR	CZGETL		;DON'T WANT INCHR. JUST ONE.
IFE	REALIO-4,<
	ANDI	127>
	STA	BUF		;MAKE IT FIRST CHARACTER.
	LDXYI	<BUF-1>		;POINT JUST BEFORE IT.
IFE	BUFPAG,<
	BEQA	DATBK>
IFN	BUFPAG,<
	BNEA	DATBK>>		;GO PROCESS.
QDATA:	BMI	DATLOP		;SEARCH FOR ANOTHER DATA STATEMENT.
IFN	EXTIO,<
	LDA	CHANNL
	BNE	GETNTH>
	JSR	OUTQST
GETNTH: JSR	QINLIN		;GET ANOTHER LINE.
DATBK:	STXY	TXTPTR		;SET FOR "CHRGET".
DATBK1: JSR	CHRGET
	BIT	VALTYP		;GET VALUE TYPE.
	BPL	NUMINS		;INPUT A NUMBER IF NUMERIC.
IFN	GETCMD,<
	BIT	INPFLG		;GET?
	BVC	SETQUT		;NO, GO SET QUOTE.
	INX
	STX	TXTPTR
	LDAI	0		;ZERO TERMINATORS.
	STA	CHARAC
	BEQA	RESETC>
SETQUT: STA	CHARAC		;ASSUME QUOTED STRING.
	CMPI	34		;TERMINATORS OK?
	BEQ	NOWGET		;YES.
	LDAI	":"		;SET TERMINATORS TO ":" AND
	STA	CHARAC
	LDAI	44		;COMMA.
RESETC: CLC
NOWGET: STA	ENDCHR
	LDWD	TXTPTR
	ADCI	0		;C IS SET PROPERLY ABOVE.
	BCC	NOWGE1
	INY
NOWGE1: JSR	STRLT2		;MAKE A STRING DESCRIPTOR FOR THE VALUE
				;AND COPY IF NECESSARY.
	JSR	ST2TXT		;SET TEXT POINTER.
	JSR	INPCOM		;DO ASSIGNMENT.
	JMP	STRDN2
NUMINS: JSR	FIN
IFE	INTPRC,<
	JSR	MOVVF>
IFN	INTPRC,<
	LDA	INTFLG		;SET CODES ON FLAG.
	JSR	QINTGR>		;GO DECIDE ON FLOAT.
STRDN2: JSR	CHRGOT		;READ LAST CHARACTER.
	BEQ	TRMOK		;":" OR EOL IS OK.
	CMPI	44		;A COMMA?
	JNE	TRMNOK
TRMOK:	LDWD	TXTPTR
	STWD	INPPTR		;SAVE FOR MORE READS.
	LDWD	VARTXT
	STWD	TXTPTR		;POINT TO VARIABLE LIST.
	JSR	CHRGOT		;LOOK AT LAST VARIABLE LIST CHARACTER.
	BEQ	VAREND		;THAT'S THE END OF THE LIST.
	JSR	CHKCOM		;NOT END. CHECK FOR COMMA.
	JMP	INLOOP
;
; SUBROUTINE TO FIND DATA
; THE SEARCH IS MADE BY USING THE EXECUTION CODE FOR DATA TO
; SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT
; IS COMPARED WITH "DATATK". EACH NEW LINE NUMBER
; IS STORED IN "DATLIN" SO THAT IF AN ERROR OCCURS
; WHILE READING DATA THE ERROR MESSAGE CAN GIVE THE LINE
; NUMBER OF THE ILL-FORMATTED DATA.
;
DATLOP: JSR	DATAN		;SKIP SOME TEXT.
	INY
	TAX			;END OF LINE?
	BNE	NOWLIN		;SHO AIN'T.
	LDXI	ERROD		;YES = "NO DATA" ERROR.
	INY
	LDADY	TXTPTR
	BEQ	ERRGO5
	INY
	LDADY	TXTPTR		;GET HIGH BYTE OF LINE NUMBER.
	STA	DATLIN
	INY
	LDADY	TXTPTR		;GET LOW BYTE.
	INY
	STA	DATLIN+1
NOWLIN: LDADY	TXTPTR		;HOW IS IT?
	TAX
	JSR	ADDON		;ADD [Y] TO [TXTPTR].
	CPXI	DATATK		;IS IT A "DATA" STATEMENT.
	BNE	DATLOP		;NOT QUITE RIGHT. KEEP LOOKING.
	JMP	DATBK1		;THIS IS THE ONE !
VAREND: LDWD	INPPTR		;PUT AWAY A NEW DATA PNTR MAYBE.
	LDX	INPFLG
	BPL	VARY0
	JMP	RESFIN
VARY0:	LDYI	0
	LDADY	INPPTR		;LAST DATA CHR COULD HAVE BEEN
				;COMMA OR COLON BUT SHOULD BE NULL.
	BEQ	INPRTS		;IT IS NULL.
IFN	EXTIO,<
	LDA	CHANNL		;IF NOT TERMINAL, NO TYPE.
	BNE	INPRTS>
	LDWDI	EXIGNT
	JMP	STROUT		;TYPE "?EXTRA IGNORED"
INPRTS: RTS			;DO NEXT STATEMENT.
EXIGNT: DT"?EXTRA IGNORED"
	ACRLF
	0
TRYAGN: DT"?REDO FROM START"
	ACRLF
	0
PAGE
SUBTTL	THE NEXT CODE IS THE "NEXT CODE"
;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
;	TOKEN (FORTK) 1 BYTE
;	A POINTER TO THE LOOP VARIABLE 2 BYTES
;	THE STEP 4+ADDPRC BYTES
;	A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
;	THE UPPER VALUE (PACKED) 4+ADDPRC BYTES
;	THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
;	A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;
NEXT:	BNE	GETFOR
	LDYI	0		;WITHOUT ARG CALL "FNDFOR" WITH
	BEQA	STXFOR		;[FORPNT]=0.
GETFOR: JSR	PTRGET		;GET A POINTER TO LOOP VARIABLE
STXFOR: STWD	FORPNT		;INTO "FORPNT".
	JSR	FNDFOR		;FIND THE MATCHING ENTRY IF ANY.
	BEQ	HAVFOR
	LDXI	ERRNF		;"NEXT WITHOUT FOR".
ERRGO5: BEQ	ERRGO4
HAVFOR: TXS			;SETUP STACK. CHOP FIRST.
	TXA
	CLC
	ADCI	4		;POINT TO INCREMENT
	PHA			;SAVE THIS POINTER TO RESTORE TO [A]
	ADCI	5+ADDPRC	;POINT TO UPPER LIMIT
	STA	INDEX2		;SAVE AS INDEX
	PLA			;RESTORE POINTER TO INCREMENT
	LDYI	1		;SET HI ADDR OF THING TO MOVE.
	JSR	MOVFM		;GET QUANTITY INTO THE FAC.
	TSX
	LDA	257+7+ADDPRC,X, ;SET SIGN CORRECTLY.
	STA	FACSGN
	LDWD	FORPNT
	JSR	FADD		;ADD INC TO LOOP VARIABLE.
	JSR	MOVVF		;PACK THE FAC INTO MEMORY.
	LDYI	1
	JSR	FCOMPN		;COMPARE FAC WITH UPPER VALUE.
	TSX
	SEC
	SBC	257+7+ADDPRC,X, ;SUBTRACT SIGN OF INC FROM SIGN OF
				;OF (CURRENT VALUE-FINAL VALUE).
	BEQ	LOOPDN		;IF SIGN (FINAL-CURRENT)-SIGN STEP=0
				;THEN LOOP IS DONE.
	LDA	2*ADDPRC+12+257,X
	STA	CURLIN		;STORE LINE NUMBER OF "FOR" STATEMENT.
	LDA	257+13+<2*ADDPRC>,X
	STA	CURLIN+1
	LDA	2*ADDPRC+15+257,X
	STA	TXTPTR		;STORE TEXT PNTR INTO "FOR" STATEMENT.
	LDA	2*ADDPRC+14+257,X
	STA	TXTPTR+1
NEWSGO: JMP	NEWSTT		;PROCESS NEXT STATEMENT.
LOOPDN: TXA
	ADCI	2*ADDPRC+15		;ADDS 16 WITH CARRY.
	TAX
	TXS			;NEW STACK PNTR.
	JSR	CHRGOT
	CMPI	44		;COMMA AT END?
	BNE	NEWSGO
	JSR	CHRGET
	JSR	GETFOR		;DO NEXT BUT DON'T ALLOW BLANK VARIABLE
				;PNTR. [VARPNT] IS THE STK PNTR WHICH
				;NEVER MATCHES ANY POINTER.
				;JSR TO PUT ON DUMMY NEWSTT ADDR.
SUBTTL FORMULA EVALUATION CODE.
;
; THESE ROUTINES CHECK FOR CERTAIN "VALTYP".
; [C] IS NOT PRESERVED.
;
FRMNUM: JSR	FRMEVL
CHKNUM: CLC
	SKIP1
CHKSTR: SEC			;SET CARRY.
CHKVAL: BIT	VALTYP		;WILL NOT F UP "VALTYP".
	BMI	DOCSTR
	BCS	CHKERR
CHKOK:	RTS
DOCSTR: BCS	CHKOK
CHKERR: LDXI	ERRTM
ERRGO4: JMP	ERROR
;
; THE FORMULA EVALUATOR STARTS WITH
; [TXTPTR] POINTING TO THE FIRST CHARACTER OF THE FORMULA.
; AT THE END [TXTPTR] POINTS TO THE TERMINATOR.
; THE RESULT IS LEFT IN THE FAC.
; ON RETURN [A] DOES NOT REFLECT THE TERMINATOR.
;
; THE FORMULA EVALUATOR USES THE OPERATOR LIST (OPTAB)
; TO DETERMINE PRECEDENCE AND DISPATCH ADDRESSES FOR 
; EACH OPERATOR.
; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT.
;	THE ADDRESS OF THE OPERATOR ROUTINE.
;	THE FLOATING POINT TEMPORARY RESULT.
;	THE PRECEDENCE OF THE OPERATOR.
;
FRMEVL: LDX	TXTPTR
	BNE	FRMEV1
	DEC	TXTPTR+1
FRMEV1: DEC	TXTPTR
	LDXI	0		;INITIAL DUMMY PRECEDENCE IS 0.
	SKIP1
LPOPER: PHA			;SAVE LOW PRECEDENCE. (MASK.)
	TXA
	PHA			;SAVE HIGH PRECEDENCE.
	LDAI	1
	JSR	GETSTK		;MAKE SURE THERE IS ROOM FOR
				;RECURSIVE CALLS.
	JSR	EVAL		;EVALUATE SOMETHING.
	CLR	OPMASK		;PREPARE TO BUILD MASK MAYBE.
TSTOP:	JSR	CHRGOT		;REGET LAST CHARACTER.
LOPREL: SEC			;PREP TO SUBTRACT.
	SBCI	GREATK		;IS CURRENT CHARACTER A RELATION?
	BCC	ENDREL		;NO. RELATIONS ALL THROUGH.
	CMPI	LESSTK-GREATK+1 ;REALLY RELATIONAL?
	BCS	ENDREL		;NO -- JUST BIG.
	CMPI	1		;RESET CARRY FOR ZERO ONLY.
	ROL	A,		;0 TO 1, 1 TO 2, 2 TO 4.
	EORI	1
	EOR	OPMASK		;BRING IN THE OLD BITS.
	CMP	OPMASK		;MAKE SURE THE NEW MASK IS BIGGER.
	BCC	SNERR5		;SYNTAX ERROR. BECAUSE TWO OF THE SAME.
	STA	OPMASK		;SAVE MASK.
	JSR	CHRGET
	JMP	LOPREL		;GET THE NEXT CANDIDATE.
ENDREL: LDX	OPMASK		;WERE THERE ANY?
	BNE	FINREL		;YES, HANDLE AS SPECIAL OP.
	BCS	QOP		;NOT AN OPERATOR.
	ADCI	GREATK-PLUSTK
	BCC	QOP		;NOT AN OPERATOR.
	ADC	VALTYP		;[C]=1.
	JEQ	CAT		;ONLY IF [A]=0 AND [VALTYP]=-1 (A STR).
	ADCI	^O377		;GET BACK ORIGINAL [A].
	STA	INDEX1
	ASL	A,		;MULTIPLY BY 2.
	ADC	INDEX1		;BY THREE.
	TAY			;SET UP FOR LATER.
QPREC:	PLA			;GET PREVIOUS PRECEDENCE.
	CMP	OPTAB,Y		;IS OLD PRECEDENCE GREATER OR EQUAL?
	BCS	QCHNUM		;YES, GO OPERATE.
	JSR	CHKNUM		;CAN'T BE STRING HERE.
DOPREC: PHA			;SAVE OLD PRECEDENCE.
NEGPRC: JSR	DOPRE1		;SET A RETURN ADDRESS FOR OP.
	PLA			;PULL OFF PREVIOUS PRECEDENCE.
	LDY	OPPTR		;GET POINTER TO OP.
	BPL	QPREC1		;THAT'S A REAL OPERATOR.
	TAX			;DONE ?
	BEQ	QOPGO		;DONE !
	BNE	PULSTK
FINREL: LSR	VALTYP		;GET VALUE TYPE INTO "C".
	TXA
	ROL	A,		;PUT VALTYP INTO LOW ORDER BIT OF MASK.
	LDX	TXTPTR		;DECREMENT TEXT POINTER.
	BNE	FINRE2
	DEC	TXTPTR+1
FINRE2: DEC	TXTPTR
	LDYI	PTDORL-OPTAB	;MAKE [YREG] POINT AT OPERATOR ENTRY.
	STA	OPMASK		;SAVE THE OPERATION MASK.
	BNE	QPREC		;SAVE IT ALL. BR ALWAYS.
				;NOTE B7(VALTYP)=0 SO CHKNUM CALL IS OK.
QPREC1: CMP	OPTAB,Y		;LAST PRECEDENCE IS GREATER?
	BCS	PULSTK		;YES, GO OPERATE.
	BCC	DOPREC		;NO SAVE ARGUMENT AND GET OTHER OPERAND.
DOPRE1: LDA	OPTAB+2,Y
	PHA			;DISP ADDR GOES ONTO STACK.
	LDA	OPTAB+1,Y
	PHA
	JSR	PUSHF1		;SAVE FAC ON STACK UNPACKED.
	LDA	OPMASK		;[ACCA] MAY BE MASK FOR REL.
	JMP	LPOPER
SNERR5: JMP	SNERR		;GO TO AN ERROR.
PUSHF1: LDA	FACSGN
	LDX	OPTAB,Y,	;GET HIGH PRECEDENCE.
PUSHF:	TAY			;GET POINTER INTO STACK.
	PLA
	STA	INDEX1
	INC	INDEX1
	PLA
	STA	INDEX1+1
	TYA
				;STORE FAC ON STACK UNPACKED.
	PHA			;START WITH SIGN SET UP.
FORPSH: JSR	ROUND		;PUT ROUNDED FAC ON STACK.
	LDA	FACLO		;ENTRY POINT TO SKIP STORING SIGN.
	PHA
	LDA	FACMO
	PHA
IFN	ADDPRC,<
	LDA	FACMOH
	PHA>
	LDA	FACHO
	PHA
	LDA	FACEXP
	PHA
	JMPD	INDEX1		;RETURN.
QOP:	LDYI	255
	PLA			;GET HIGH PRECEDENCE OF LAST OP.
QOPGO:	BEQ	QOPRTS		;DONE !
QCHNUM: CMPI	100		;RELATIONAL OPERATOR?
	BEQ	UNPSTK		;YES, DON'T CHECK OPERAND.
	JSR	CHKNUM		;MUST BE NUMBER.
UNPSTK: STY	OPPTR		;SAVE OPERATOR'S POINTER FOR NEXT TIME.
PULSTK: PLA			;GET MASK FOR REL OP IF IT IS ONE.
	LSR	A,		;SETUP [C] FOR DOREL'S "CHKVAL".
	STA	DOMASK		;SAVE FOR "DOCMP".
	PLA			;UNPACK STACK INTO ARG.
	STA	ARGEXP
	PLA
	STA	ARGHO
IFN	ADDPRC,<
	PLA
	STA	ARGMOH>
	PLA
	STA	ARGMO
	PLA
	STA	ARGLO
	PLA
	STA	ARGSGN
	EOR	FACSGN		;GET PROBABLE RESULT SIGN.
	STA	ARISGN		;ARITHMETIC SIGN. USED BY
				;ADD, SUB, MULT, DIV.
QOPRTS: LDA	FACEXP		;GET IT AND SET CODES.
UNPRTS: RTS			;RETURN.

EVAL:	CLR	VALTYP		;ASSUME VALUE WILL BE NUMERIC.
EVAL0:	JSR	CHRGET		;GET A CHARACTER.
	BCS	EVAL2
EVAL1:	JMP	FIN		;IT IS A NUMBER.
EVAL2:	JSR	ISLETC		;VARIABLE NAME?
	BCS	ISVAR		;YES.
IFE	REALIO-3,<
	CMPI	PI
	BNE	QDOT
	LDWDI	PIVAL
	JSR	MOVFM		;PUT VALUE IN FOR PI.
	JMP	CHRGET
PIVAL:	^O202
	^O111
	^O017
	^O332
	^O241>
QDOT:	CMPI	"."		;LEADING CHARACTER OF CONSTANT?
	BEQ	EVAL1
	CMPI	MINUTK		;NEGATION?
	BEQ	DOMIN		;SHO IS.
	CMPI	PLUSTK
	BEQ	EVAL0
	CMPI	34		;A QUOTE? A STRING?
	BNE	EVAL3
STRTXT: LDWD	TXTPTR
	ADCI	0		;TO INC, ADD C=1.
	BCC	STRTX2
	INY
STRTX2: JSR	STRLIT		;YES. GO PROCESS IT.
	JMP	ST2TXT
EVAL3:	CMPI	NOTTK		;CHECK FOR "NOT" OPERATOR.
	BNE	EVAL4
	LDYI	NOTTAB-OPTAB		;"NOT" HAS PRECEDENCE 90.
	BNE	GONPRC		;GO DO ITS EVALUATION.
NOTOP:	JSR	AYINT		;INTEGERIZE.
	LDA	FACLO		;GET THE ARGUMENT.
	EORI	255
	TAY
	LDA	FACMO
	EORI	255
	JMP	GIVAYF		;FLOAT [Y,A] AS RESULT IN FAC.
				;AND RETURN.
EVAL4:	CMPI	FNTK		;USER-DEFINED FUNCTION?
	JEQ	FNDOER
	CMPI	ONEFUN		;A FUNCTION NAME?
	BCC	PARCHK		;FUNCTIONS ARE THE HIGHEST NUMBERED
	JMP	ISFUN		;CHARACTERS SO NO NEED TO CHECK
				;AN UPPER-BOUND.
PARCHK: JSR	CHKOPN		;ONLY POSSIBILITY LEFT IS
	JSR	FRMEVL		;A FORMULA IN PARENTHESIS.
				;RECURSIVELY EVALUATE THE FORMULA.
CHKCLS: LDAI	41		;CHECK FOR A RIGHT PARENTHESE
	SKIP2
CHKOPN: LDAI	40
	SKIP2
CHKCOM: LDAI	44
;
; "SYNCHK" LOOKS AT THE CURRENT CHARACTER TO MAKE SURE IT
; IS THE SPECIFIC THING LOADED INTO ACCA JUST BEFORE THE CALL TO
; "SYNCHK". IF NOT, IT CALLS THE "SYNTAX ERROR" ROUTINE.
; OTHERWISE IT GOBBLES THE NEXT CHAR AND RETURNS,
;
; [A]=NEW CHAR AND TXTPTR IS ADVANCED BY "CHRGET".
;
SYNCHR: LDYI	0
	CMPDY	TXTPTR		;CHARACTERS EQUAL?
	BNE	SNERR
CHRGO5: JMP	CHRGET
SNERR:	LDXI	ERRSN		;"SYNTAX ERROR"
	JMP	ERROR
DOMIN:	LDYI	NEGTAB-OPTAB	;A PRECEDENCE BELOW "^".
GONPRC: PLA			;GET RID OF RTS ADDR.
	PLA
	JMP	NEGPRC		;EVALUTE FOR NEGATION.

ISVAR:	JSR	PTRGET		;GET A PNTR TO VARIABLE.
ISVRET: STWD	FACMO
IFN	TIME!EXTIO,<
	LDWD	VARNAM>		;CHECK TIME,TIME$,STATUS.
	LDX	VALTYP
	BEQ	GOOO		;THE STRING IS SET UP.
	LDXI	0
	STX	FACOV
IFN	TIME,<
	BIT	FACLO		;AN ARRAY?
	BPL	STRRTS		;YES.
	CMPI	"T"		;TI$?
	BNE	STRRTS
	CPYI	"I"+128
	BNE	STRRTS
	JSR	GETTIM		;YES. PUT TIME IN FACMOH-LO.
	STY	TENEXP		;Y=0.
	DEY
	STY	FBUFPT
	LDYI	6		;SIX	DIGITS TO PRINT.
	STY	DECCNT
	LDYI	FDCEND-FOUTBL
	JSR	FOUTIM		;CONVERT TO ASCII.
	JMP	TIMSTR>
STRRTS: RTS
GOOO:
IFN	INTPRC,<
	LDX	INTFLG
	BPL	GOOOOO
	LDYI	0
	LDADY	FACMO		;FETCH HIGH.
	TAX
	INY
	LDADY	FACMO
	TAY			;PUT LOW IN Y.
	TXA			;GET HIGH IN A.
	JMP	GIVAYF>		;FLOAT AND RETURN.
GOOOOO:
IFN	TIME,<
	BIT	FACLO		;AN ARRAY?
	BPL	GOMOVF		;YES.
	CMPI	"T"
	BNE	QSTATV
	CPYI	"I"
	BNE	GOMOVF
	JSR	GETTIM
	TYA			;FOR FLOATB.
	LDXI	160		;SET EXPONNENT.
	JMP	FLOATB
GETTIM: LDWDI	<CQTIMR-2>
	SEI			;TURN OF INT SYS.
	JSR	MOVFM
	CLI			;BACK ON.
	STY	FACHO		;ZERO HIGHEST.
	RTS>
QSTATV:
IFN	EXTIO,<
	CMPI	"S"
	BNE	GOMOVF
	CPYI	"T"
	BNE	GOMOVF
	LDA	CQSTAT
	JMP	FLOAT
GOMOVF:>
IFN	TIME!EXTIO,<
	LDWD	FACMO>
	JMP	MOVFM		;MOVE ACTUAL VALUE IN.
				;AND RETURN.

ISFUN:	ASL	A,		;MULTIPLY BY TWO.
	PHA
	TAX
	JSR	CHRGET		;SET UP FOR SYNCHK.
	CPXI	2*LASNUM-256+1	;IS IT PAST "LASNUM"?
	BCC	OKNORM		;NO, MUST BE NORMAL FUNCTION.
;
; MOST FUNCTIONS TAKE A SINGLE ARGUMENT.
; THE RETURN ADDRESS OF THESE FUNCTIONS IS "CHKNUM"
; WHICH ASCERTAINS THAT [VALTYP]=0  (NUMERIC).
; NORMAL FUNCTIONS THAT RETURN STRING RESULTS
; (E.G., CHR$) MUST POP OFF THAT RETURN ADDR AND
; RETURN DIRECTLY TO "FRMEVL".
;
; THE SO-CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT,
; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH
; MUST BE A NUMBER BETWEEN 0 AND 255.
; THE CLOSED PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY
; TO "FRMEVL" WITH THE TEXT PNTR POINTING BEYOND THE ")".
; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT
; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE
; INTEGER ARGUMENT.
;
	JSR	CHKOPN		;CHECK FOR AN OPEN PARENTHESE
	JSR	FRMEVL		;EAT OPEN PAREN AND FIRST ARG.
	JSR	CHKCOM		;TWO ARGS SO COMMA MUST DELIMIT.
	JSR	CHKSTR		;MAKE SURE FIRST WAS STRING.
	PLA			;GET FUNCTION NUMBER.
	TAX
	PSHWD	FACMO		;SAVE POINTER AT STRING DESCRIPTOR
	TXA
	PHA			;RESAVE FUNCTION NUMBER.
				;THIS MUST BE ON STACK SINCE RECURSIVE.
	JSR	GETBYT		;[X]=VALUE OF FORMULA.
	PLA			;GET FUNCTION NUMBER.
	TAY
	TXA
	PHA
	JMP	FINGO		;DISPATCH TO FUNCTION.
OKNORM: JSR	PARCHK		;READ A FORMULA SURROUNDED BY PARENS.
	PLA			;GET DISPATCH FUNCTION.
	TAY
FINGO:	LDA	FUNDSP-2*ONEFUN+256,Y,	;MODIFY DISPATCH ADDRESS.
	STA	JMPER+1
	LDA	FUNDSP-2*ONEFUN+257,Y
	STA	JMPER+2
	JSR	JMPER		;DISPATCH!
				;STRING FUNCTIONS REMOVE THIS RET ADDR.
	JMP	CHKNUM		;CHECK IT FOR NUMERICNESS AND RETURN.

OROP:	LDYI	255		;MUST ALWAYS COMPLEMENT..
	SKIP2
ANDOP:	LDYI	0
	STY	COUNT		;OPERATOR.
	JSR	AYINT		;[FACMO&LO]=INT VALUE AND CHECK SIZE.
	LDA	FACMO		;USE DEMORGAN'S LAW ON HIGH
	EOR	COUNT
	STA	INTEGR
	LDA	FACLO		;AND LOW.
	EOR	COUNT
	STA	INTEGR+1
	JSR	MOVFA
	JSR	AYINT		;[FACMO&LO]=INT OF ARG.
	LDA	FACLO
	EOR	COUNT
	AND	INTEGR+1
	EOR	COUNT		;FINISH OUT DEMORGAN.
	TAY			;SAVE HIGH.
	LDA	FACMO
	EOR	COUNT
	AND	INTEGR
	EOR	COUNT
	JMP	GIVAYF		;FLOAT [A.Y] AND RET TO USER.

;
; TIME TO PERFORM A RELATIONAL OPERATOR.
; [DOMASK] CONTAINS THE BITS AS TO WHICH RELATIONAL
; OPERATOR IT WAS. CARRY BIT ON=STRING COMPARE.
;
DOREL:	JSR	CHKVAL		;CHECK FOR MATCH.
	BCS	STRCMP		;IT IS A STRING.
	LDA	ARGSGN		;PACK ARG FOR FCOMP.
	ORAI	127
	AND	ARGHO
	STA	ARGHO
	LDWDI	ARGEXP
	JSR	FCOMP
	TAX
	JMP	QCOMP
STRCMP: CLR	VALTYP		;RESULT WILL BE NUMERIC.
	DEC	OPMASK		;TURN OFF VALTYP WHICH WAS STRING.
	JSR	FREFAC		;FREE THE FACLO STRING.
	STA	DSCTMP		;SAVE FOR LATER.
	STXY	DSCTMP+1
	LDWD	ARGMO		;GET POINTER TO OTHER STRING.
	JSR	FRETMP		;FREES FIRST DESC POINTER.
	STXY	ARGMO
	TAX			;COPY COUNT INTO X.
	SEC
	SBC	DSCTMP		;WHICH IS GREATER. IF 0, ALL SET UP.
	BEQ	STASGN		;JUST PUT SIGN OF DIFFERENCE AWAY.
	LDAI	1
	BCC	STASGN		;SIGN IS POSITIVE.
	LDX	DSCTMP		;LENGTH OF FAC IS SHORTER.
	LDAI	^O377		;GET A MINUS 1 FOR NEGATIVES.
STASGN: STA	FACSGN		;KEEP FOR LATER.
	LDYI	255		;SET POINTER TO FIRST STRING. (ARG.)
	INX			;TO LOOP PROPERLY.
NXTCMP: INY
	DEX			;ANY CHARACTERS LEFT TO COMPARE?
	BNE	GETCMP		;NOT DONE YET.
	LDX	FACSGN		;USE SIGN OF LENGTH DIFFERENCE
				;SINCE ALL CHARACTERS ARE THE SAME.
QCOMP:	BMI	DOCMP		;C IS ALWAYS SET THEN.
	CLC
	BCC	DOCMP		;ALWAYS BRANCH.
GETCMP: LDADY	ARGMO		;GET NEXT CHAR TO COMPARE.
	CMPDY	DSCTMP+1	;SAME?
	BEQ	NXTCMP		;YEP. TRY FURTHER.
	LDXI	^O377		;SET A POSITIVE DIFFERENCE.
	BCS	DOCMP		;PUT STACK BACK TOGETHER.
	LDXI	1		;SET A NEGATIVE DIFFERENCE.
DOCMP:	INX			;-1 TO 1, 0 TO 2, 1 TO 4.
	TXA
	ROL	A
	AND	DOMASK
	BEQ	GOFLOT
	LDAI	^O377		;MAP 0 TO 0. ALL OTHERS TO -1.
GOFLOT: JMP	FLOAT		;FLOAT THE ONE-BYTE RESULT INTO FAC.

PAGE
SUBTTL	DIMENSION AND VARIABLE SEARCHING.
;
; THE "DIM" CODE SETS [DIMFLG] AND THEN FALLS INTO THE VARIABLE SEARCH
; ROUTINE, WHICH LOOKS AT DIMFLG AT THREE DIFFERENT POINTS.
;	1) IF AN ENTRY IS FOUND, "DIMFLG" BEING ON INDICATES
;		A "DOUBLY" DIMENSIONED VARIABLE.
;	2) WHEN A NEW ENTRY IS BEING BUILT "DIMFLG" BEING ON
;		INDICTAES THE INDICES SHOULD BE USED FOR THE
;		SIZE OF EACH INDEX. OTHERWISE THE DEFAULT OF TEN
;		IS USED.
;	3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF "DIMFLG" IS OFF
;		WILL INDEXING BE DONE.
;
DIM3:	JSR	CHKCOM		;MUST BE A COMMA
DIM:	TAX			;SET [ACCX] NONZERO.
				;[ACCA] MUST BE NONZERO TO WORK RIGHT.
DIM1:	JSR	PTRGT1
DIMCON: JSR	CHRGOT		;GET LAST CHARACTER.
	BNE	DIM3
	RTS
;
; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION
; AND  PUT A POINTER TO ITS VALUE IN VARPNT. [TXTPTR]
; POINTS TO THE TERMINATING CHARCTER.. NOT THAT EVALUATING SUBSCRIPTS
; IN A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO "PTRGET" SO AT
; THAT POINT ALL VALUES MUST BE STORED ON THE STACK.
;
PTRGET: LDXI	0		;MAKE [ACCX]=0.
	JSR	CHRGOT		;RETRIEVE LAST CHARACTER.
PTRGT1: STX	DIMFLG		;STORE FLAG AWAY.
PTRGT2: STA	VARNAM
	JSR	CHRGOT		;GET CURRENT CHARACTER
				;MAYBE WITH FUNCTION BIT OFF.
	JSR	ISLETC		;CHECK FOR LETTER.
	BCS	PTRGT3		;MUST HAVE A LETTER.
INTERR: JMP	SNERR
PTRGT3: LDXI	0		;ASSUME NO SECOND CHARACTER.
	STX	VALTYP		;DEFAULT IS NUMERIC.
IFN	INTPRC,<
	STX	INTFLG>		;ASSUME FLOATING.
	JSR	CHRGET		;GET FOLLOWING CHARACTER.
	BCC	ISSEC		;CARRY RESET BY CHRGET IF NUMERIC.
	JSR	ISLETC		;SET CARRY IF NOT ALPHABETIC.
	BCC	NOSEC		;ALLOW ALPHABETICS.
ISSEC:	TAX			;IT IS A NUMBER -- SAVE IN ACCX.
EATEM:	JSR	CHRGET		;LOOK AT NEXT CHARACTER.
	BCC	EATEM		;SKIP NUMERICS.
	JSR	ISLETC
	BCS	EATEM		;SKIP ALPHABETICS.
NOSEC:	CMPI	"$"		;IS IT A STRING?
	BNE	NOTSTR		;IF NOT, [VALTYP]=0.
	LDAI	^O377		;SET [VALTYP]=255 (STRING !).
	STA	VALTYP
IFN	INTPRC,<
	BNEA	TURNON		;ALWAYS GOES.
NOTSTR: CMPI	"%"		;INTEGER VARIABLE?
	BNE	STRNAM		;NO.
	LDA	SUBFLG
	BNE	INTERR
	LDAI	128
	STA	INTFLG		;SET FLAG.
	ORA	VARNAM		;TURN ON BOTH HIGH BITS.
	STA	VARNAM>
TURNON: TXA
	ORAI	128		;TURN ON MSB OF SECOND CHARACTER.
	TAX
	JSR	CHRGET		;GET CHARACTER AFTER $.
IFE	INTPRC,<
NOTSTR:>
STRNAM: STX	VARNAM+1	;STORE AWAY SECOND CHARACTER.
	SEC
	ORA	SUBFLG		;ADD FLAG WHETHER TO ALLOW ARRAYS.
	SBCI	40		;(CHECK FOR "(") WON'T MATCH IF SUBFLG SET. 
	JEQ	ISARY		;IT IS!
	CLR	SUBFLG		;ALLOW SUBSCRIPTS AGAIN.
	LDA	VARTAB		;PLACE TO START SEARCH.
	LDX	VARTAB+1
	LDYI	0
STXFND: STX	LOWTR+1
LOPFND: STA	LOWTR
	CPX	ARYTAB+1	;AT END OF TABLE YET?
	BNE	LOPFN
	CMP	ARYTAB
	BEQ	NOTFNS		;YES. WE COULDN'T FIND IT.
LOPFN:	LDA	VARNAM
	CMPDY	LOWTR		;COMPARE HIGH ORDERS.
	BNE	NOTIT		;NO COMPARISON.
	LDA	VARNAM+1
	INY
	CMPDY	LOWTR		;AND THE LOW PART?
	BEQ	FINPTR		;THAT'S IT ! THAT'S IT !
	DEY
NOTIT:	CLC
	LDA	LOWTR
	ADCI	6+ADDPRC	;MAKES NO DIF AMONG TYPES.
	BCC	LOPFND
	INX
	BNEA	STXFND		;ALWAYS BRANCHES.

;
; TEST FOR A LETTER.	/ CARRY OFF= NOT A LETTER.
;			  CARRY ON= A LETTER.
;
ISLETC: CMPI	"A"
	BCC	ISLRTS		;IF LESS THAN "A", RET.
	SBCI	"Z"+1
	SEC
	SBCI	256-"Z"-1	;RESET CARRY IF [A] .GT. "Z".
ISLRTS: RTS			;RETURN TO CALLER.

NOTFNS: PLA			;CHECK WHO'S CALLING.
	PHA			;RESTORE IT.
	CMPI	ISVRET-1-<ISVRET-1>/256*256	;IS EVAL CALLING?
	BNE	NOTEVL		;NO, CARRY ON.
IFN	REALIO-3,<
	TSX
	LDA	258,X
	CMPI	<<ISVRET-1>/256>
	BNE	NOTEVL>
LDZR:	LDWDI	ZERO		;SET UP PNTR TO SIMULATED ZERO.
	RTS			;FOR STRINGS OR NUMERIC.
				;AND FOR INTEGERS TOO.
NOTEVL:
IFN	TIME!EXTIO,<
	LDWD	VARNAM>
IFN	TIME,<
	CMPI	"T"
	BNE	QSTAVR
	CPYI	"I"+128
	BEQ	LDZR
	CPYI	"I"
	BNE	QSTAVR>
IFN	EXTIO!TIME,<
GOBADV: JMP	SNERR>
QSTAVR:
IFN	EXTIO,<
	CMPI	"S"
	BNE	VAROK
	CPYI	"T"
	BEQ	GOBADV>
VAROK:	LDWD	ARYTAB
	STWD	LOWTR		;LOWEST THING TO MOVE.
	LDWD	STREND		;GET HIGHEST ADDR TO MOVE.
	STWD	HIGHTR
	CLC
	ADCI	6+ADDPRC
	BCC	NOTEVE
	INY
NOTEVE: STWD	HIGHDS		;PLACE TO STUFF IT.
	JSR	BLTU		;MOVE IT ALL.
				;NOTE [Y,A] HAS [HIGHDS] FOR REASON.
	LDWD	HIGHDS		;AND SET UP
	INY
	STWD	ARYTAB		;NEW START OF ARRAY TABLE.
	LDYI	0		;GET ADDR OF VARIABLE ENTRY.
	LDA	VARNAM
	STADY	LOWTR
	INY
	LDA	VARNAM+1
	STADY	LOWTR		;STORE NAME OF VARIABLE.
	LDAI	0
	INY
	STADY	LOWTR
	INY
	STADY	LOWTR
	INY
	STADY	LOWTR
	INY
	STADY	LOWTR		;FOURTH ZERO FOR DEF FUNC.
IFN	ADDPRC,<
	INY
	STADY	LOWTR>
FINPTR: LDA	LOWTR
	CLC
	ADCI	2
	LDY	LOWTR+1
	BCC	FINNOW
	INY
FINNOW: STWD	VARPNT		;THIS IS IT.
	RTS
PAGE
SUBTTL	MULTIPLE DIMENSION CODE.
FMAPTR: LDA	COUNT
	ASL	A,
	ADCI	5		;POINT TO ENTRIES. C CLR'D BY ASL.
	ADC	LOWTR
	LDY	LOWTR+1
	BCC	JSRGM
	INY
JSRGM:	STWD	ARYPNT
	RTS

N32768: EXP	144,128,0,0	;-32768.

;
; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND
; TURNS IT INTO A POSITIVE INTEGER
; LEAVING THE RESULT IN FACMO&LO. NEGATIVE ARGUMENTS
; ARE NOT ALLOWED.
;
INTIDX: JSR	CHRGET
	JSR	FRMEVL		;GET A NUMBER
POSINT: JSR	CHKNUM
	LDA	FACSGN
	BMI	NONONO		;IF NEGATIVE, BLOW HIM OUT.
AYINT:	LDA	FACEXP
	CMPI	144		;FAC .GT. 32767?
	BCC	QINTGO
	LDWDI	N32768		;GET ADDR OF -32768.
	JSR	FCOMP		;SEE IF FAC=[[Y,A]].
NONONO: BNE	FCERR		;NO, FAC IS TOO BIG.
QINTGO: JMP	QINT		;GO TO QINT AND SHOVE IT.
;
; FORMAT OF ARRAYS IN CORE.
;
; DESCRIPTOR:
;	LOWBYTE = FIRST CHARACTER.
;	HIGHBYTE = SECOND CHARACTER (200 BIT IS STRING FLAG).
; LENGTH OF ARRAY IN CORE IN BYTES (INCLUDES EVERYTHING).
; NUMBER OF DIMENSIONS.
; FOR EACH DIMENSION STARTING WITH THE FIRST A LIST
; (2 BYTES EACH) OF THE MAX INDICE+1
; THE VALUES
;
ISARY:	LDA	DIMFLG
IFN	INTPRC,<
	ORA	INTFLG>
	PHA			;SAVE [DIMFLG] FOR RECURSION.
	LDA	VALTYP
	PHA			;SAVE [VALTYP] FOR RECURSION.
	LDYI	0		;SET NUMBER OF DIMENSIONS TO ZERO.
INDLOP: TYA			;SAVE NUMBER OF DIMS.
	PHA
	PSHWD	VARNAM		;SAVE LOOKS.
	JSR	INTIDX		;EVALUATE INDICE INTO FACMO&LO.
	PULWD	VARNAM		;GET BACK ALL... WE'RE HOME.
	PLA			;(# OF DIMS).
	TAY
	TSX
	LDA	258,X
	PHA			;PUSH DIMFLG AND VALTYP FURTHER.
	LDA	257,X
	PHA
	LDA	INDICE		;PUT INDICE ONTO STACK.
	STA	258,X,		;UNDER DIMFLG AND VALTYP.
	LDA	INDICE+1
	STA	257,X
	INY			;INCREMENT # OF DIMS.
	JSR	CHRGOT		;GET TERMINATING CHARACTER.
	CMPI	44		;A COMMA?
	BEQ	INDLOP		;YES.
	STY	COUNT		;SAVE COUNT OF DIMS.
	JSR	CHKCLS		;MUST BE CLOSED PAREN.
	PLA
	STA	VALTYP		;GET VALTYP AND
	PLA
IFN	INTPRC,<
	STA	INTFLG
	ANDI	127>
	STA	DIMFLG		;DIMFLG OFF STACK.
	LDX	ARYTAB		;PLACE TO START SEARCH.
	LDA	ARYTAB+1
LOPFDA: STX	LOWTR
	STA	LOWTR+1
	CMP	STREND+1	;END OF ARRAYS?
	BNE	LOPFDV
	CPX	STREND
	BEQ	NOTFDD		;A FINE THING! NO ARRAY!.
LOPFDV: LDYI	0
	LDADY	LOWTR
	INY
	CMP	VARNAM		;COMPARE HIGH ORDERS.
	BNE	NMARY1		;NO WAY IS IT THIS. GET OUT OF HERE.
	LDA	VARNAM+1
	CMPDY	LOWTR		;LOW ORDERS?
	BEQ	GOTARY		;WELL, HERE IT IS !!
NMARY1: INY
	LDADY	LOWTR		;GET LENGTH.
	CLC
	ADC	LOWTR
	TAX
	INY
	LDADY	LOWTR
	ADC	LOWTR+1
	BCC	LOPFDA		;ALWAYS BRANCHES.
BSERR:	LDXI	ERRBS		;GET BAD SUB ERROR NUMBER.
	SKIP2
FCERR:	LDXI	ERRFC		;TOO BIG. "FUNCTION CALL" ERROR.
ERRGO3: JMP	ERROR
GOTARY: LDXI	ERRDD		;PERHAPS A "RE-DIMENSION" ERROR
	LDA	DIMFLG		;TEST THE DIMFLG
	BNE	ERRGO3
	JSR	FMAPTR
	LDA	COUNT		;GET NUMBER OF DIMS INPUT.
	LDYI	4
	CMPDY	LOWTR		;# OF DIMS THE SAME?
	BNE	BSERR		;SAME SO GO GET DEFINITION.
	JMP	GETDEF

;
; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE.
;
; BUILDING AN ENTRY.
;
;	PUT DOWN THE DESCRIPTOR.
;	SETUP NUMBER OF DIMENSIONS.
;	MAKE SURE THERE IS ROOM FOR THE NEW ENTRY.
;	REMEMBER "VARPNT".
;	TALLY=4.
;	SKIP 2 LOCS FOR LATER FILL IN OF SIZE.
; LOOP: GET AN INDICE
;	PUT DOWN NUMBER+1 AND INCREMENT VARPTR.
;	TALLY=TALLY*NUMBER+1.
;	DECREMENT NUMBER-DIMS.
;	BNE LOOP
;	CALL "REASON" WITH [Y,A] REFLECTING LAST LOC OF VARIABLE.
;	UPDATE STREND.
;	ZERO ALL.
;	MAKE TALLY INCLUDE MAXDIMS AND DESCRIPTOR.
;	PUT DOWN TALLY.
;	IF CALLED BY DIMENSION, RETURN.
;	OTHERWISE INDEX INTO THE VARIABLE AS IF IT
;	 WERE FOUND ON THE INITIAL SEARCH.
;
NOTFDD: JSR	FMAPTR		;FORM ARYPNT.
	JSR	REASON
	LDAI	0
	TAY
	STA	CURTOL+1
IFE	ADDPRC,<
	LDXI	4>
IFN	ADDPRC,<
	LDXI	5>
	LDA	VARNAM		;THIS CODE ONLY WORKS FOR INTPRC=1
	STADY	LOWTR		;IF ADDPRC=1.
IFN	ADDPRC,<
	BPL	NOTFLT
	DEX>
NOTFLT: INY
	LDA	VARNAM+1
	STADY	LOWTR
	BPL	STOMLT
	DEX
IFN	ADDPRC,<
	DEX>
STOMLT: STX	CURTOL
	LDA	COUNT
	REPEAT	3,<INY>
	STADY	LOWTR		;SAVE NUMBER OF DIMENSIONS.
LOPPTA: LDXI	11		;DEFAULT SIZE.
	LDAI	0
	BIT	DIMFLG
	BVC	NOTDIM		;NOT IN A DIM STATEMENT.
	PLA			;GET LOW ORDER OF INDICE.
	CLC
	ADCI	1
	TAX
	PLA			;GET HIGH PART OF INDICE.
	ADCI	0
NOTDIM: INY
	STADY	LOWTR		;STORE HIGH PART OF INDICE.
	INY
	TXA
	STADY	LOWTR		;STORE LOW ORDER OF INDICE.
	JSR	UMULT		;[X,A]=[CURTOL]*[LOWTR,Y]
	STX	CURTOL		;SAVE NEW TALLY.
	STA	CURTOL+1
	LDY	INDEX
	DEC	COUNT		;ANY MORE INDICES LEFT?
	BNE	LOPPTA		;YES.
	ADC	ARYPNT+1
	BCS	OMERR1		;OVERFLOW.
	STA	ARYPNT+1	;COMPUTE WHERE TO ZERO.
	TAY
	TXA
	ADC	ARYPNT
	BCC	GREASE
	INY
	BEQ	OMERR1
GREASE: JSR	REASON		;GET ROOM.
	STWD	STREND		;NEW END OF STORAGE.
	LDAI	0		;STORING [ACCA] IS FASTER THAN CLEAR.
	INC	CURTOL+1
	LDY	CURTOL
	BEQ	DECCUR
ZERITA: DEY
	STADY	ARYPNT
	BNE	ZERITA		;NO. CONTINUE.
DECCUR: DEC	ARYPNT+1
	DEC	CURTOL+1
	BNE	ZERITA		;DO ANOTHER BLOCK.
	INC	ARYPNT+1	;BUMP BACK UP. WILL USE LATER.
	SEC
	LDA	STREND		;RESTORE [ACCA].
	SBC	LOWTR		;DETERMINE LENGTH.
	LDYI	2
	STADY	LOWTR		;LOW.
	LDA	STREND+1
	INY
	SBC	LOWTR+1
	STADY	LOWTR		;HIGH.
	LDA	DIMFLG
	BNE	DIMRTS		;BYE.
	INY
;
; AT THIS POINT [LOWTR,Y] POINTS BEYOND THE SIZE TO THE NUMBER OF
; DIMENSIONS. STRATEGY:
;	NUMDIM=NUMBER OF DIMENSIONS.
;	CURTOL=0.
; INLPNM:GET A NEW INDICE.
;	MAKE SURE INDICE IS NOT TOO BIG.
;	MULTIPLY CURTOL BY CURMAX.
;	ADD INDICE TO CURTOL.
;	NUMDIM=NUMDIM-1.
;	BNE	INLPNM.
;	USE [CURTOL]*4 AS OFFSET.
;
GETDEF: LDADY	LOWTR
	STA	COUNT		;SAVE A COUNTER.
	LDAI	0		;ZERO [CURTOL].
	STA	CURTOL
INLPNM: STA	CURTOL+1
	INY
	PLA			;GET LOW INDICE.
	TAX
	STA	INDICE
	PLA			;AND THE HIGH PART
	STA	INDICE+1
	CMPDY	LOWTR		;COMPARE WITH MAX INDICE.
	BCC	INLPN2
	BNE	BSERR7		;IF GREATER, "BAD SUBSCRIPT" ERROR.
	INY
	TXA
	CMPDY	LOWTR
	BCC	INLPN1
BSERR7: JMP	BSERR
OMERR1: JMP	OMERR
INLPN2: INY
INLPN1: LDA	CURTOL+1	;DON'T MULTIPLY IF CURTOL=0.
	ORA	CURTOL
	CLC			;PREPARE TO GET INDICE BACK.
	BEQ	ADDIND		;GET HIGH PART OF INDICE BACK.
	JSR	UMULT		;MULTIPLY [CURTOL] BY [LOWTR,Y,Y+1].
	TXA
	ADC	INDICE		;ADD IN [INDICE].
	TAX
	TYA
	LDY	INDEX1
ADDIND: ADC	INDICE+1
	STX	CURTOL
	DEC	COUNT		;ANY MORE?
	BNE	INLPNM		;YES.
	STA	CURTOL+1	;FIX ARRAY BUG ****
IFE	ADDPRC,<
	LDXI	4>
IFN	ADDPRC,<
	LDXI	5		;THIS CODE ONLY WORKS FOR INTPRC=1
	LDA	VARNAM		;IF ADDPRC=1.
	BPL	NOTFL1
	DEX>
NOTFL1: LDA	VARNAM+1
	BPL	STOML1
	DEX
IFN	ADDPRC,<
	DEX>
STOML1: STX	ADDEND
	LDAI	0
	JSR	UMULTD		;ON RTS, A&Y=HI . X=LO.
	TXA
	ADC	ARYPNT
	STA	VARPNT
	TYA
	ADC	ARYPNT+1
	STA	VARPNT+1
	TAY
	LDA	VARPNT
DIMRTS: RTS			;RETURN TO CALLER.
SUBTTL	INTEGER ARITHMETIC ROUTINES.
	;TWO BYTE UNSIGNED INTEGER MULTIPLY.
	;THIS IS FOR MULTIPLY DIMENSIONED ARRAYS.
	; [X,Y]=[X,A]=[CURTOL]*[LOWTR,Y,Y+1].
UMULT:	STY	INDEX
	LDADY	LOWTR
	STA	ADDEND		;LOW, THEN HIGH.
	DEY
	LDADY	LOWTR		;PUT [LOWTR,Y,Y+1] IN FASTER MEMORY.
UMULTD: STA	ADDEND+1
	LDAI	16
	STA	DECCNT
	LDXI	0		;CLR THE ACCS.
	LDYI	0		;RESULT INITIALLY ZERO.
UMULTC: TXA
	ASL	A,		;MULTIPLY BY TWO.
	TAX
	TYA
	ROL	A,
	TAY
	BCS	OMERR1		;TWO MUCH !
	ASL	CURTOL
	ROL	CURTOL+1
	BCC	UMLCNT		;NOTHING IN THIS POSITION TO MULTIPLY.
	CLC
	TXA
	ADC	ADDEND
	TAX
	TYA
	ADC	ADDEND+1
	TAY
	BCS	OMERR1		;MAN, JUST TOO MUCH !
UMLCNT: DEC	DECCNT		;DONE?
	BNE	UMULTC		;KEEP IT UP.
UMLRTS: RTS			;YES, ALL DONE.
PAGE
SUBTTL	FRE FUNCTION AND INTEGER TO FLOATING ROUTINES.
FRE:	LDA	VALTYP
	BEQ	NOFREF
	JSR	FREFAC
NOFREF: JSR	GARBA2
	SEC
	LDA	FRETOP		;WE WANT
	SBC	STREND		;[FRETOP]-[STREND].
	TAY
	LDA	FRETOP+1
	SBC	STREND+1

GIVAYF: LDXI	0
	STX	VALTYP
	STWD	FACHO
	LDXI	144		;SET EXPONENT TO 2^16.
	JMP	FLOATS		;TURN IT TO A FLOATING PNT #.

POS:	LDY	TRMPOS		;GET POSITION.
SNGFLT: LDAI	0
	BEQA	GIVAYF		;FLOAT IT.
PAGE
SUBTTL	SIMPLE-USER-DEFINED-FUNCTION CODE.
;
; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS
; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM:
;	DEF FNA(X)=X^2+X-2
; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS.
;
; IDEA: CREATE A SIMPLE VARIABLE ENTRY
; WHOSE FIRST CHARACTER HAS THE 200 BIT SET.
; THE VALUE WILL BE:
;
;	A TEXT PNTR TO THE FORMULA.
;	A PNTR TO THE ARGUMENT VARIABLE.
;
; FUNCTION NAMES CAN BE LIKE "FNA4".
;
;
; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE.
; AND COMPLAIN IF SO.
;
ERRDIR: LDX	CURLIN+1	;DIR MODE HAS [CURLIN]=0,255
	INX			;SO NOW, IS RESULT ZERO?
	BNE	DIMRTS		;YES.
	LDXI	ERRID		;INPUT DIRECT ERROR CODE.
	SKIP2
ERRGUF: LDXI	ERRUF		;USER DEFINED FUNCTION NEVER DEFINED
ERRGO1: JMP	ERROR

DEF:	JSR	GETFNM		;GET A PNTR TO THE FUNCTION.
	JSR	ERRDIR
	JSR	CHKOPN		;MUST HAVE "(".
	LDAI	128
	STA	SUBFLG		;PROHIBIT SUBSCRIPTED VARIABLES.
	JSR	PTRGET		;GET PNTR TO ARGUMENT.
	JSR	CHKNUM		;IS IT A NUMBER?
	JSR	CHKCLS		;MUST HAVE ")"
	SYNCHK	EQULTK		;MUST HAVE "=".
IFN	ADDPRC,<PHA>		;PUT CRAZY BYTE ON.
	PSHWD	VARPNT
	PSHWD	TXTPTR
	JSR	DATA
	JMP	DEFFIN
;
; SUBROUTINE TO GET A PNTR TO A FUNCTION NAME.
;
GETFNM: SYNCHK	FNTK		;MUST START WITH FN.
	ORAI	128		;PUT FUNCTION BIT ON.
	STA	SUBFLG
	JSR	PTRGT2		;GET POINTER TO FUNCTION OR CREATE ANEW.
	STWD	DEFPNT
	JMP	CHKNUM		;MAKE SURE IT'S NOT A STRING AND RETURN.

FNDOER: JSR	GETFNM		;GET THE FUNCTION'S NAME.
	PSHWD	DEFPNT
	JSR	PARCHK		;EVALUATE PARAMETER.
	JSR	CHKNUM
	PULWD	DEFPNT
	LDYI	2
	LDADY	DEFPNT		;GET POINTER TO VARIABLE.
	STA	VARPNT		;SAVE VARIABLE POINTER.
	TAX
	INY
	LDADY	DEFPNT
	BEQ	ERRGUF
	STA	VARPNT+1
IFN	ADDPRC,<INY>		;SINCE DEF USES ONLY 4.
DEFSTF: LDADY	VARPNT
	PHA			;PUSH IT ALL ON STACK.
	DEY			;SINCE WE ARE RECURSING MAYBE.
	BPL	DEFSTF
	LDY	VARPNT+1
	JSR	MOVMF		;PUT CURRENT FAC INTO OUR ARG VARIABLE.
	PSHWD	TXTPTR		;SAVE TEXT POINTER.
	LDADY	DEFPNT		;PNTR TO FUNCTION.
	STA	TXTPTR
	INY
	LDADY	DEFPNT
	STA	TXTPTR+1
	PSHWD	VARPNT		;SAVE VARIABLE POINTER.
	JSR	FRMNUM		;EVALUATE FORMULA AND CHECK NUMERIC.
	PULWD	DEFPNT
	JSR	CHRGOT
	JNE	SNERR		;IT DIDN'T TERMINATE. HUH?
	PULWD	TXTPTR		;RESTORE TEXT PNTR.
DEFFIN: LDYI	0
	PLA			;GET OLD ARG VALUE OFF STACK
	STADY	DEFPNT		;AND PUT IT BACK IN VARIABLE.
	PLA
	INY
	STADY	DEFPNT
	PLA
	INY
	STADY	DEFPNT
	PLA
	INY
	STADY	DEFPNT
IFN	ADDPRC,<
	PLA
	INY	
	STADY	DEFPNT>
DEFRTS: RTS
	PAGE
SUBTTL	STRING FUNCTIONS.
;
; THE STR$ FUNCTION TAKES A NUMBER AND GIVES A STRING
; WITH THE CHARACTERS THE OUTPUT OF THE NUMBER
; WOULD HAVE GIVEN.
;
STR:	JSR	CHKNUM		;ARG HAS TO BE NUMERIC.
	LDYI	0
	JSR	FOUTC		;DO ITS OUTPUT.
	PLA
	PLA
TIMSTR: LDWDI	LOFBUF
	BEQA	STRLIT		;SCAN IT AND TURN IT INTO A STRING.
;
; "STRINI" GET STRING SPACE FOR THE CREATION OF A STRING AND
; CREATES A DESCRIPTOR FOR IT IN "DSCTMP".
;
STRINI: LDXY	FACMO		;GET FACMO TO STORE IN DSCPNT.
	STXY	DSCPNT		;RETAIN THE DESCRIPTOR POINTER.
STRSPA: JSR	GETSPA		;GET STRING SPACE.
	STXY	DSCTMP+1	;SAVE LOCATION.
	STA	DSCTMP		;SAVE LENGTH.
	RTS			;ALL DONE.
;
; "STRLT2" TAKES THE STRING LITERAL WHOSE FIRST CHARACTER
; IS POINTED TO BY [Y,A] AND BUILDS A DESCRIPTOR FOR IT.
; THE DESCRIPTOR IS INITIALLY BUILT IN "DSCTMP", BUT "PUTNEW"
; TRANSFERS IT INTO A TEMPORARY AND LEAVES A POINTER
; AT THE TEMPORARY IN FACMO&LO. THE CHARACTERS OTHER THAN
; ZERO THAT TERMINATE THE STRING SHOULD BE SET UP IN "CHARAC"
; AND "ENDCHR". IF THE TERMINATOR IS A QUOTE, THE QUOTE IS SKIPPED
; OVER. LEADING QUOTES SHOULD BE SKIPPED BEFORE JSR. ON RETURN
; THE CHARACTER AFTER THE STRING LITERAL IS POINTED TO
; BY [STRNG2].
;
STRLIT: LDXI	34		;ASSUME STRING ENDS ON QUOTE.
	STX	CHARAC
	STX	ENDCHR
STRLT2: STWD	STRNG1		;SAVE POINTER TO STRING.
	STWD	DSCTMP+1	;IN CASE NO STRCPY.
	LDYI	255		;INITIALIZE CHARACTER COUNT.
STRGET: INY
	LDADY	STRNG1		;GET CHARACTER.
	BEQ	STRFI1		;IF ZERO.
	CMP	CHARAC		;THIS TERMINATOR?
	BEQ	STRFIN		;YES.
	CMP	ENDCHR
	BNE	STRGET		;LOOK FURTHER.
STRFIN: CMPI	34		;QUOTE?
	BEQ	STRFI2
STRFI1: CLC			;NO, BACK UP.
STRFI2: STY	DSCTMP		;RETAIN COUNT.
	TYA
	ADC	STRNG1		;WISHING TO SET [TXTPTR].
	STA	STRNG2
	LDX	STRNG1+1
	BCC	STRST2
	INX
STRST2: STX	STRNG2+1
	LDA	STRNG1+1	;IF PAGE 0, COPY SINCE IT IS EITHER
				;A STRING CONSTANT IN BUF OR A STR$
				;RESULT IN LOFBUF
IFN	BUFPAG,<
	BEQ	STRCP
	CMPI	BUFPAG>
	BNE	PUTNEW
STRCP:	TYA
	JSR	STRINI
	LDXY	STRNG1
	JSR	MOVSTR		;MOVE STRING.
;
; SOME STRING FUNCTION IS RETURNING A RESULT IN DSCTMP.
; SETUP A TEMP DESCRIPTOR WITH DSCTMP IN IT.
; PUT A POINTER TO THE DESCRIPTOR IN FACMO&LO AND FLAG THE
; RESULT AS TYPE STRING.
;
PUTNEW: LDX	TEMPPT		;POINTER TO FIRST FREE TEMP.
	CPXI	TEMPST+STRSIZ*NUMTMP
	BNE	PUTNW1
	LDXI	ERRST		;STRING TEMPORARY ERROR.
ERRGO2: JMP	ERROR		;GO TELL HIM.
PUTNW1: LDA	DSCTMP
	STA	0,X
	LDA	DSCTMP+1
	STA	1,X
	LDA	DSCTMP+2
	STA	2,X
	LDYI	0
	STXY	FACMO
	STY	FACOV
	DEY
	STY	VALTYP		;TYPE IS "STRING".
	STX	LASTPT		;SET POINTER TO LAST-USED TEMP.
	INX
	INX
	INX			;POINT FURTHER.
	STX	TEMPPT		;SAVE POINTER TO NEXT TEMP IF ANY.
	RTS			;ALL DONE.

;
; GETSPA - GET SPACE FOR CHARACTER STRING.
; MAY FORCE GARBAGE COLLECTION.
;
; # OF CHARACTERS (BYTES) IN ACCA.
; RETURNS WITH POINTER IN [Y,X]. OTHERWISE (IF CAN'T GET
; SPACE) BLOWS OFF TO "OUT OF STRING SPACE" TYPE ERROR.
; ALSO PRESERVES [ACCA] AND SETS [FRESPC]=[Y,X]=PNTR AT SPACE.
;
GETSPA: LSR	GARBFL		;SIGNAL NO GARBAGE COLLECTION YET.
TRYAG2: PHA			;SAVE FOR LATER.
	EORI	255
	SEC			;ADD ONE TO COMPLETE NEGATION.
	ADC	FRETOP
	LDY	FRETOP+1
	BCS	TRYAG3
	DEY
TRYAG3: CPY	STREND+1	;COMPARE HIGH ORDERS.
	BCC	GARBAG		;MAKE ROOM FOR MORE.
	BNE	STRFRE		;SAVE NEW FRETOP.
	CMP	STREND		;COMPARE LOW ORDERS.
	BCC	GARBAG		;CLEAN UP.
STRFRE: STWD	FRETOP		;SAVE NEW [FRETOP].
	STWD	FRESPC		;PUT IT THERE OLD MAN.
	TAX			;PRESERVE A IN X.
	PLA			;GET COUNT BACK IN ACCA.
	RTS			;ALL DONE.
GARBAG: LDXI	ERROM		;"OUT OF STRING SPACE"
	LDA	GARBFL
	BMI	ERRGO2
	JSR	GARBA2
	LDAI	128
	STA	GARBFL
	PLA			;GET BACK STRING LENGTH.
	BNE	TRYAG2		;ALWAYS BRANCHES.
GARBA2:				;START FROM TOP DOWN.
IFE	REALIO!DISKO,<
	LDAI	7		;TYPE "BELL".
	JSR	OUTDO>
	LDX	MEMSIZ
	LDA	MEMSIZ+1
FNDVAR: STX	FRETOP		;LIKE SO.
	STA	FRETOP+1
	LDYI	0
	STY	GRBPNT+1
	STY	GRBPNT		;BOTH BYTES SET TO ZERO (FIX BUG)
	LDWX	STREND
	STWX	GRBTOP
	LDWXI	TEMPST
	STWX	INDEX1
TVAR:	CMP	TEMPPT		;DONE WITH TEMPS?
	BEQ	SVARS		;YEP.
	JSR	DVAR
	BEQ	TVAR		;LOOP.
SVARS:	LDAI	6+ADDPRC
	STA	FOUR6
	LDWX	VARTAB		;GET START OF SIMPLE VARIABLES.
	STWX	INDEX1
SVAR:	CPX	ARYTAB+1	;DONE WITH SIMPLE VARIABLES?
	BNE	SVARGO		;NO.
	CMP	ARYTAB
	BEQ	ARYVAR		;YEP.
SVARGO: JSR	DVARS		;DO IT , AGAIN.
	BEQ	SVAR		;LOOP.
ARYVAR: STWX	ARYPNT		;SAVE FOR ADDITION.
	LDAI	STRSIZ
	STA	FOUR6
ARYVA2: LDWX	ARYPNT		;GET THE POINTER TO VARIABLE.
ARYVA3: CPX	STREND+1	;DONE WITH ARRAYS?
	BNE	ARYVGO		;NO.
	CMP	STREND
	JEQ	GRBPAS		;YES, GO FINISH UP.
ARYVGO: STWX	INDEX1
	LDYI	1-ADDPRC
IFN	ADDPRC,<
	LDADY	INDEX1
	TAX
	INY>
	LDADY	INDEX1
	PHP
	INY
	LDADY	INDEX1
	ADC	ARYPNT
	STA	ARYPNT		;FORM POINTER TO NEXT ARRAY VAR.
	INY
	LDADY	INDEX1
	ADC	ARYPNT+1
	STA	ARYPNT+1
	PLP
	BPL	ARYVA2
IFN	ADDPRC,<
	TXA
	BMI	ARYVA2>
	INY
	LDADY	INDEX1
	LDYI	0		;RESET INDEX Y.
	ASL	A,
	ADCI	5		;CARRY IS OFF AND OFF AFTER ADD.
	ADC	INDEX1
	STA	INDEX1
	BCC	ARYGET
	INC	INDEX1+1
ARYGET: LDX	INDEX1+1
ARYSTR: CPX	ARYPNT+1	;END OF THE ARRAY?
	BNE	GOGO
	CMP	ARYPNT
	BEQ	ARYVA3		;YES.
GOGO:	JSR	DVAR
	BEQ	ARYSTR		;CYCLE.
DVARS:
IFN	INTPRC,<
	LDADY	INDEX1
	BMI	DVARTS>
	INY
	LDADY	INDEX1
	BPL	DVARTS
	INY
DVAR:	LDADY	INDEX1		;IS LENGTH=0?
	BEQ	DVARTS		;YES, RETURN.
	INY
	LDADY	INDEX1		;GET LOW(ADR).
	TAX
	INY
	LDADY	INDEX1
	CMP	FRETOP+1	;COMPARE HIGHS.
	BCC	DVAR2		;IF THIS STRING'S PNTR .GE. [FRETOP]
	BNE	DVARTS		;NO NEED TO MESS WITH IT FURTHER.
	CPX	FRETOP		;COMPARE LOWS.
	BCS	DVARTS
DVAR2:	CMP	GRBTOP+1
	BCC	DVARTS		;IF THIS STRING IS BELOW PREVIOUS,
				;FORGET IT.
	BNE	DVAR3
	CPX	GRBTOP		;COMPARE LOW ORDERS.
	BCC	DVARTS		;[X,A] .LE. [GRBTOP].
DVAR3:	STX	GRBTOP
	STA	GRBTOP+1
	LDWX	INDEX1
	STWX	GRBPNT
	LDA	FOUR6
	STA	SIZE
DVARTS: LDA	FOUR6
	CLC
	ADC	INDEX1
	STA	INDEX1
	BCC	GRBRTS
	INC	INDEX1+1
GRBRTS: LDX	INDEX1+1
	LDYI	0
	RTS			;DONE.
;
; HERE WHEN MADE ONE COMPLETE PASS THROUGH STRING VARIABLES.
;
GRBPAS: LDA	GRBPNT+1	;VARIABLE POINTER.
	ORA	GRBPNT
	BEQ	GRBRTS		;ALL DONE.
	LDA	SIZE
	ANDI	4		;LEAVES C OFF.
	LSR	A,
	TAY
	STA	SIZE
	LDADY	GRBPNT
				;NOTE: GRBTOP=LOWTR SO NO NEED TO SET LOWTR.
	ADC	LOWTR
	STA	HIGHTR
	LDA	LOWTR+1
	ADCI	0
	STA	HIGHTR+1
	LDWX	FRETOP
	STWX	HIGHDS		;WHERE IT ALL GOES.
	JSR	BLTUC
	LDY	SIZE
	INY
	LDA	HIGHDS		;GET POSITION OF START OF RESULT.
	STADY	GRBPNT
	TAX
	INC	HIGHDS+1
	LDA	HIGHDS+1
	INY
	STADY	GRBPNT		;CHANGE ADDR OF STRING IN VAR.
	JMP	FNDVAR		;GO TO FNDVAR WITH SOMETHING FOR
				;[FRETOP].
;
; THE FOLLOWING ROUTINE CONCATENATES TWO STRINGS.
; THE FAC CONTAINS THE FIRST ONE AT THIS POINT.
; [TXTPTR] POINTS TO THE + SIGN.
;
CAT:	LDA	FACLO		;PSH HIGH ORDER ONTO STACK.
	PHA
	LDA	FACMO		;AND THE LOW.
	PHA
	JSR	EVAL		;CAN COME BACK HERE SINCE
				;OPERATOR IS KNOWN.
	JSR	CHKSTR		;RESULT MUST BE STRING.
	PLA
	STA	STRNG1		;GET HIGH ORDER OF OLD DESC.
	PLA
	STA	STRNG1+1
	LDYI	0
	LDADY	STRNG1		;GET LENGTH OF OLD STRING.
	CLC
	ADCDY	FACMO
	BCC	SIZEOK		;RESULT IS LESS THAN 256.
	LDXI	ERRLS		;ERROR "LONG STRING".
	JMP	ERROR
SIZEOK: JSR	STRINI		;INITIALIZE STRING.
	JSR	MOVINS		;MOVE IT.
	LDWD	DSCPNT		;GET POINTER TO SECOND.
	JSR	FRETMP		;FREE IT.
	JSR	MOVDO
	LDWD	STRNG1
	JSR	FRETMP
	JSR	PUTNEW
	JMP	TSTOP		;"CAT" REENTERS FORM EVAL AT TSTOP.

MOVINS: LDYI	0		;GET ADDR OF STRING.
	LDADY	STRNG1
	PHA
	INY
	LDADY	STRNG1
	TAX
	INY
	LDADY	STRNG1
	TAY
	PLA
MOVSTR: STXY	INDEX
MOVDO:	TAY
	BEQ	MVDONE
	PHA
MOVLP:	DEY
	LDADY	INDEX
	STADY	FRESPC
QMOVE:	TYA
	BNE	MOVLP
	PLA
MVDONE: CLC
	ADC	FRESPC
	STA	FRESPC
	BCC	MVSTRT
	INC	FRESPC+1
MVSTRT: RTS
;
; "FRETMP" IS PASSED A STRING DESCRIPTOR PNTR IN [Y,A].
; A CHECK IS MADE TO SEE IF THE STRING DESCRIPTOR POINTS TO THE LAST
; TEMPORARY DESCRIPTOR ALLOCATED BY PUTNEW.
; IF SO, THE TEMPORARY IS FREED UP BY THE UPDATING OF [TEMPPT].
; IF A TEMP IS FREED UP, A FURTHER CHECK SEES IF THE STRING DATA THAT
; THAT STRING TEMP PNT'D TO IS THE LOWEST PART OF STRING SPACE IN USE.
; IF SO, [FRETOP] IS UPDATED TO REFLECT THE FACT THE FACT THAT THE SPACE
; IS NO LONGER IN USE.
; THE ADDR OF THE ACTUAL STRING IS RETURNED IN [Y,X] AND
; ITS LENGTH IN ACCA.
;
FRESTR: JSR	CHKSTR		;MAKE SURE ITS A STRING.
FREFAC: LDWD	FACMO		;FREE UP STR PNT'D TO BY FAC.
FRETMP: STWD	INDEX		;GET LENGTH FOR LATER.
	JSR	FRETMS		;FREE UP THE TEMPORARY DESC.
	PHP			;SAVE CODES.
	LDYI	0		;PREP TO GET STUFF.
	LDADY	INDEX		;GET COUNT AND
	PHA			;SAVE IT.
	INY
	LDADY	INDEX
	TAX			;SAVE LOW ORDER.
	INY
	LDADY	INDEX
	TAY			;SAVE HIGH ORDER.
	PLA
	PLP			;RETURN STATUS.
	BNE	FRETRT
	CPY	FRETOP+1	;STRING IS LAST ONE IN?
	BNE	FRETRT
	CPX	FRETOP
	BNE	FRETRT
	PHA
	CLC
	ADC	FRETOP
	STA	FRETOP
	BCC	FREPLA
	INC	FRETOP+1
FREPLA: PLA			;GET COUNT BACK.
FRETRT: STXY	INDEX		;SAVE FOR LATER USE.
	RTS
FRETMS: CPY	LASTPT+1	;LAST ENTRY TO TEMP? 
	BNE	FRERTS
	CMP	LASTPT
	BNE	FRERTS
	STA	TEMPPT
	SBCI	STRSIZ		;POINT TO LAST ONE.
	STA	LASTPT		;UPDATE TEMP PNTR.
	LDYI	0		;ALSO CLEARS ZFLG SO WE DO REST OF FRETMP.
FRERTS: RTS			;ALL DONE.
;
; CHR$(#) CREATES A STRING WHICH CONTAINS AS ITS ONLY
; CHARACTER THE ASCII EQUIVALENT OF THE INTEGER ARGUMENT (#)
; WHICH MUST BE .LT. 255.
;
CHR:	JSR	CONINT		;GET INTEGER IN RANGE.
	TXA
	PHA
	LDAI	1		;ONE-CHARACTER STRING.
	JSR	STRSPA		;GET SPACE FOR STRING.
	PLA
	LDYI	0
	STADY	DSCTMP+1
	PLA			;GET RID OF "CHKNUM" RETURN ADDR.
	PLA
RLZRET: JMP	PUTNEW		;SETUP FAC TO POINT TO DESC.
;
; THE FOLLOWING IS THE LEFT$($,#) FUNCTION.
; IT TAKES THE LEFTMOST # CHARACTERS OF THE STRING.
; IF # .GT. THE LEN OF THE STRING, IT RETURNS THE WHOLE STRING.
;
LEFT:	JSR	PREAM		;TEST PARAMETERS.
	CMPDY	DSCPNT
	TYA
RLEFT:	BCC	RLEFT1
	LDADY	DSCPNT
	TAX			;PUT LENGTH INTO X.
	TYA			;ZERO A, THE OFFSET.
RLEFT1: PHA			;SAVE OFFSET.
RLEFT2: TXA
RLEFT3: PHA			;SAVE LENGTH.
	JSR	STRSPA		;GET SPACE.
	LDWD	DSCPNT
	JSR	FRETMP
	PLA
	TAY
	PLA
	CLC
	ADC	INDEX		;COMPUTE WHERE TO COPY.
	STA	INDEX
	BCC	PULMOR
	INC	INDEX+1
PULMOR: TYA
	JSR	MOVDO		;GO MOVE IT.
	JMP	PUTNEW
RIGHT:	JSR	PREAM
	CLC			;[LENGTH DES'D]-[LENGTH]-1.
	SBCDY	DSCPNT
	EORI	255		;NEGATE.
	JMP	RLEFT
;
; MID ($,#) RETURNS STRING WITH CHARS FROM # POSITION
; ONWARD. IF # .GT. LEN ($) THEN RETURN NULL STRING.
; MID ($,#,#) RETURNS STRING WITH CHARACTERS FROM
; # POSITION FOR #2 CHARACTERS. IF #2 GOES PAST END OF STRING
; RETURN AS MUCH AS POSSIBLE.
;
MID:	LDAI	255		;DEFAULT.
	STA	FACLO		;SAVE FOR LATER COMPARE.
	JSR	CHRGOT		;GET CURRENT CHARACTER.
	CMPI	41		;IS IT A RIGHT PAREN )?
	BEQ	MID2		;NO THIRD PARAM.
	JSR	CHKCOM		;MUST HAVE COMMA.
	JSR	GETBYT		;GET THE LENGTH INTO "FACLO".
MID2:	JSR	PREAM		;CHECK IT OUT.
	BEQ	GOFUC		;THERE IS NO POSTION 0
	DEX			;COMPUTE OFFSET.
	TXA
	PHA			;PRSERVE AWHILE.
	CLC
	LDXI	0
	SBCDY	DSCPNT		;GET LENGTH OF WHAT'S LEFT.
	BCS	RLEFT2		;GIVE NULL STRING.
	EORI	255		;IN SUB C WAS 0 SO JUST COMPLEMENT.
	CMP	FACLO		;GREATER THAN WHAT'S DESIRED?
	BCC	RLEFT3		;NO, COPY THAT MUCH.
	LDA	FACLO		;GET LENGTH OF WHAT'S DESIRED.
	BCS	RLEFT3		;COPY IT.

;
; USED BY RIGHT$, LEFT$, MID$ FOR PARAMETER CHECKING AND SETUP.
;
PREAM:	JSR	CHKCLS		;PARAM LIST SHOULD END.
	PLA			;GET THE RETURN ADDRESS INTO
	TAY			;[JMPER+1,Y]
	PLA
	STA	JMPER+1
	PLA			;GET RID OF FINGO'S JSR RET ADDR.
	PLA
	PLA			;GET LENGTH.
	TAX
	PULWD	DSCPNT
	LDA	JMPER+1		;PUT RETURN ADDRESS BACK ON
	PHA
	TYA
	PHA
	LDYI	0
	TXA
	RTS
;
; THE FUNCTION LEN($) RETURNS THE LENGTH OF THE STRING
; PASSED AS AN ARGUMENT.
;
LEN:	JSR	LEN1
	JMP	SNGFLT
LEN1:	JSR	FRESTR		;FREE UP STRING.
	LDXI	0
	STX	VALTYP		;FORCE NUMERIC.
	TAY			;SET CODES ON LENGTH.
	RTS			;DONE.
;
; THE FOLLOWING IS THE ASC($) FUNCTION. IT RETURNS
; AN INTEGER WHICH IS THE DECIMAL ASCII EQUIVALENT.
;
ASC:	JSR	LEN1
	BEQ	GOFUC		;NULL STRING, BAD ARG.
	LDYI	0
	LDADY	INDEX1		;GET CHARACTER.
	TAY
	JMP	SNGFLT
GOFUC:	JMP	FCERR		;YES.

GTBYTC: JSR	CHRGET
GETBYT: JSR	FRMNUM		;READ FORMULA INTO FAC.
CONINT: JSR	POSINT		;CONVERT THE FAC TO A SINGLE BYTE INT.
	LDX	FACMO
	BNE	GOFUC		;RESULT MUST BE .LE. 255.
	LDX	FACLO
CHRGO2: JMP	CHRGOT		;SET CONDITION CODES ON TERMINATOR.
;
; THE "VAL" FUNCTION TAKES A STRING AND TURNS IT INTO
; A NUMBER BY INTERPRETING THE ASCII DIGITS ETCQ
; EXCEPT FOR THE PROBLEM THAT A TERMINATOR MUST BE SUPPLIED
; BY REPLACING THE CHARACTER BEYOND THE STRING, VAL IS MERELY
; A CALL TO FLOATING POINT INPUT ("FIN").
;
VAL:	JSR	LEN1		;DO SETUP. SET RESULT=NUMERIC.
	JEQ	ZEROFC		;ZERO THE FAC ON A NULL STRING
	LDXY	TXTPTR
	STXY	STRNG2		;SAVE FOR LATER.
	LDX	INDEX1
	STX	TXTPTR
	CLC
	ADC	INDEX1
	STA	INDEX2
	LDX	INDEX1+1
	STX	TXTPTR+1
	BCC	VAL2		;NO CARRY, NO INC.
	INX
VAL2:	STX	INDEX2+1
	LDYI	0
	LDADY	INDEX2		;PRESERVE CHARACTER.
	PHA
	LDAI	0		;SET A TERMINATOR.
	STADY	INDEX2
	JSR	CHRGOT		;GET CHARACTER PNT'D TO AND SET FLAGS.
	JSR	FIN
	PLA			;GET PRES'D CHARACTER.
	LDYI	0
	STADY	INDEX2		;STUFF IT BACK.
ST2TXT: LDXY	STRNG2
	STXY	TXTPTR
VALRTS: RTS			;ALL DONE WITH STRINGS.
PAGE
SUBTTL	PEEK, POKE, AND FNWAIT.

GETNUM: JSR	FRMNUM		;GET ADDRESS.
	JSR	GETADR		;GET THAT LOCATION.
COMBYT: JSR	CHKCOM		;CHECK FOR A COMMA.
	JMP	GETBYT		;GET SOMETHING TO STORE AND RETURN.
GETADR: LDA	FACSGN		;EXAMINE SIGN.
	BMI	GOFUC		;FUNCTION CALL ERROR.
	LDA	FACEXP		;EXAMINE EXPONENT.
	CMPI	145
	BCS	GOFUC		;FUNCTION CALL ERROR.
	JSR	QINT		;INTEGERIZE IT.
	LDWD	FACMO
	STY	POKER
	STA	POKER+1
	RTS			;IT'S DONE !.

PEEK:	PSHWD	POKER
	JSR	GETADR
	LDYI	0
IFE	REALIO-3,<
	CMPI	ROMLOC/256	;IF WITHIN BASIC,
	BCC	GETCON
	CMPI	LASTWR/256
	BCC	DOSGFL>		;GIVE HIM ZERO FOR AN ANSWER.
GETCON: LDADY	POKER		;GET THAT BYTE.
	TAY
DOSGFL: PULWD	POKER
	JMP	SNGFLT		;FLOAT IT.

POKE:	JSR	GETNUM
	TXA
	LDYI	0
	STADY	POKER		;STORE VALUE AWAY.
	RTS			;SCANNED  EVERYTHING.

; THE WAIT LOCATION,MASK1,MASK2 STATEMENT WAITS UNTIL THE CONTENTS
; OF LOCATION IS NONZERO WHEN XORED WITH MASK2
; AND THEN ANDED WITH MASK1. IF MASK2 IS NOT PRESENT, IT
; IS ASSUMED TO BE ZERO.

FNWAIT: JSR	GETNUM
	STX	ANDMSK
	LDXI	0
	JSR	CHRGOT
	BEQ	ZSTORDO
	JSR	COMBYT		;GET MASK2.
STORDO: STX	EORMSK
	LDYI	0
WAITER: LDADY	POKER
	EOR	EORMSK
	AND	ANDMSK
	BEQ	WAITER
ZERRTS: RTS			;GOT A NONZERO.
SUBTTL FLOATING POINT MATH PACKAGE CONFIGURATION.

RADIX	8			;!!!! ALERT !!!!
				;THROUGHOUT THE MATH PACKAGE.
COMMENT %
THE FLOATING POINT FORMAT IS AS FOLLOWS:

THE SIGN IS THE FIRST BIT OF THE MANTISSA.
THE MANTISSA IS 24 BITS LONG.
THE BINARY POINT IS TO THE LEFT OF THE MSB.
NUMBER = MANTISSA * 2 ^ EXPONENT.
THE MANTISSA IS POSITIVE WITH A ONE ASSUMED TO BE WHERE THE SIGN BIT IS.
THE SIGN OF THE EXPONENT IS THE FIRST BIT OF THE EXPONENT.
THE EXPONENT IS STORED IN EXCESS 200, I.E. WITH A BIAS OF +200.
SO, THE EXPONENT IS A SIGNED 8-BIT NUMBER WITH 200 ADDED TO IT.
AN EXPONENT OF ZERO MEANS THE NUMBER IS ZERO.
THE OTHER BYTES MAY NOT BE ASSUMED TO BE ZERO.
TO KEEP THE SAME NUMBER IN THE FAC WHILE SHIFTING,
	TO SHIFT RIGHT, EXP:=EXP+1
	TO SHIFT LEFT,	EXP:=EXP-1

IN MEMORY THE NUMBER LOOKS LIKE THIS:
	[THE EXPONENT AS A SIGNED NUMBER +200]
	[THE SIGN BIT IN 7, BITS 2-8 OF MANTISSA ARE IN BITS 6-0].
		(REMEMBER BIT 1 OF MANTISSA IS ALWAYS A ONE.)
	[BITS 9-16 OF THE MANTISSA]
	[BITS 17-24] OF THE MANTISSA]

ARITHMETIC ROUTINE CALLING CONVENTIONS:

FOR ONE ARGUMENT FUNCTIONS:
	THE ARGUMENT IS IN THE FAC.
	THE RESULT IS LEFT IN THE FAC.
FOR TWO ARGUMENT OPERATIONS:
	THE FIRST ARGUMENT IS IN ARG (ARGEXP,HO,MO,LO AND ARGSGN).
	THE SECOND ARGUMENT IS IN THE FAC.
	THE RESULT IS LEFT IN THE FAC.

THE "T" ENTRY POINTS TO THE TWO-ARGUMENT OPERATIONS HAVE BOTH ARGUMENTS
SETUP IN THE RESPECTIVE REGISTERS. BEFORE CALLING ARG MAY HAVE BEEN
POPPED OFF THE STACK AND INTO ARG, FOR EXAMPLE.
THE OTHER ENTRY POINT ASSUMES [Y,A] POINTS TO THE ARGUMENT
SOMEWHERE IN MEMORY. IT IS UNPACKED INTO ARG BY "CONUPK".

ON THE STACK, THE SGN IS PUSHED ON FIRST, THE LO,MO,HO AND FINALLY EXP.
NOTE ALL THINGS ARE KEPT UNPACKED IN ARG, FAC AND ON THE STACK.

IT IS ONLY WHEN SOMETHING IS STORED AWAY THAT IT IS PACKED TO FOUR
BYTES. THE UNPACKED FORMAT HAS A SGN BYTE REFLECTING THE SIGN OF THE
NUMBER (POSITIVE=0, NEGATIVE=-1) A HO,MO AND LO WITH THE HIGH BIT
OF THE HO TURNED ON. THE EXP IS THE SAME AS STORED FORMAT.
THIS IS DONE FOR SPEED OF OPERATION.
%
PAGE
SUBTTL	FLOATING POINT ADDITION AND SUBTRACTION.
FADDH:	LDWDI	FHALF		;ENTRY TO ADD 1/2.
	JMP	FADD		;UNPACK AND GO ADD IT.
FSUB:	JSR	CONUPK		;UNPACK ARGUMENT INTO ARG.
FSUBT:	LDA	FACSGN
	EORI	377		;COMPLEMENT IT.
	STA	FACSGN
	EOR	ARGSGN		;COMPLEMENT ARISGN.
	STA	ARISGN
	LDA	FACEXP		;SET CODES ON FACEXP.
	JMP	FADDT		;[Y]=ARGEXP..
	XLIST
.XCREF
IFN	REALIO-3,<ZSTORDO=STORDO>
IFE	REALIO-3,<
ZSTORD:!	LDA	POKER
	CMPI	146
	BNE	STORDO
	LDA	POKER+1
	SBCI	31
	BNE	STORDO
	STA	POKER
	TAY
	LDAI	200
	STA	POKER+1
MRCHKR: LDXI	12
IF1,<
MRCHR:	LDA	60000,X,>
IF2,<
MRCHR:	LDA	SINCON+36,X,>
	ANDI	77
	STADY	POKER
	INY
	BNE	PKINC
	INC	POKER+1
PKINC:	DEX
	BNE	MRCHR
	DEC	ANDMSK
	BNE	MRCHKR
	RTS
IF2,<PURGE ZSTORD>>
.CREF
	LIST
FADD5:	JSR	SHIFTR		;DO A LONG SHIFT.
	BCC	FADD4		;CONTINUE WITH ADDITION.
FADD:	JSR	CONUPK
FADDT:	JEQ	MOVFA		;IF FAC=0, RESULT IS IN ARG.
	LDX	FACOV
	STX	OLDOV
	LDXI	ARGEXP		;DEFAULT IS SHIFT ARGUMENT.
	LDA	ARGEXP		;IF ARG=0, FAC IS RESULT.
FADDC:	TAY			;ALSO COPY ACCA INTO ACCY.
	BEQ	ZERRTS		;RETURN.
	SEC
	SBC	FACEXP
	BEQ	FADD4		;NO SHIFTING.
	BCC	FADDA		;BR IF ARGEXP.LT.FACEXP.
	STY	FACEXP		;RESULTING EXPONENT.
	LDY	ARGSGN		;SINCE ARG IS BIGGER, IT'S
	STY	FACSGN		;SIGN IS SIGN OF RESULT.
	EORI	377		;SHIFT A NEGATIVE NUMBER OF PLACES.
	ADCI	0		;COMPLETE NEGATION. W/ C=1.
	LDYI	0		;ZERO OLDOV.
	STY	OLDOV
	LDXI	FAC		;SHIFT THE FAC INSTEAD.
	BNE	FADD1
FADDA:	LDYI	0
	STY	FACOV
FADD1:	CMPI	^D256-7		;FOR SPEED AND NECESSITY.  GETS
				;MOST LIKELY CASE TO SHIFTR FASTEST
				;AND ALLOWS SHIFTING OF NEG NUMS
				;BY "QINT".
	BMI	FADD5		;SHIFT BIG.
	TAY
	LDA	FACOV		;SET FACOV.
	LSR	1,X,		;GETS 0 IN MOST SIG BIT.
	JSR	ROLSHF		;DO THE ROLLING.
FADD4:	BIT	ARISGN		;GET RESULTING SIGN.
	BPL	FADD2		;IF POSITIVE, ADD.
				;CARRY IS CLEAR.
FADD3:	LDYI	FACEXP
	CPXI	ARGEXP		;FAC IS BIGGER.
	BEQ	SUBIT
	LDYI	ARGEXP		;ARG IS BIGGER.
SUBIT:	SEC
	EORI	377
	ADC	OLDOV
	STA	FACOV
	LDA	3+ADDPRC,Y
	SBC	3+ADDPRC,X
	STA	FACLO
	LDA	2+ADDPRC,Y
	SBC	2+ADDPRC,X
	STA	FACMO
IFN	ADDPRC,<
	LDA	2,Y
	SBC	2,X
	STA	FACMOH>
	LDA	1,Y
	SBC	1,X
	STA	FACHO
FADFLT: BCS	NORMAL		;HERE IF SIGNS DIFFER. IF CARRY,
				;FAC IS SET OK.
	JSR	NEGFAC		;NEGATE [FAC].
NORMAL: LDYI	0
	TYA
	CLC
NORM3:	LDX	FACHO
	BNE	NORM1
	LDX	FACHO+1		;SHIFT 8 BITS AT A TIME FOR SPEED.
	STX	FACHO
IFN	ADDPRC,<
	LDX	FACMOH+1
	STX	FACMOH>
	LDX	FACMO+1
	STX	FACMO
	LDX	FACOV
	STX	FACLO
	STY	FACOV
	ADCI	10
	CMPI	10*ADDPRC+30
	BNE	NORM3
ZEROFC: LDAI	0		;NOT NEED BY NORMAL BUT BY OTHERS.
ZEROF1: STA	FACEXP		;NUMBER MUST BE ZERO.
ZEROML: STA	FACSGN		;MAKE SIGN POSITIVE.
	RTS			;ALL DONE.
FADD2:	ADC	OLDOV
	STA	FACOV
	LDA	FACLO
	ADC	ARGLO
	STA	FACLO
	LDA	FACMO
	ADC	ARGMO
	STA	FACMO
IFN	ADDPRC,<
	LDA	FACMOH
	ADC	ARGMOH
	STA	FACMOH>
	LDA	FACHO
	ADC	ARGHO
	STA	FACHO
	JMP	SQUEEZ		;GO ROUND IF SIGNS SAME.

NORM2:	ADCI	1		;DECREMENT SHIFT COUNT.
	ASL	FACOV		;SHIFT ALL LEFT ONE BIT.
	ROL	FACLO
	ROL	FACMO
IFN	ADDPRC,<
	ROL	FACMOH>
	ROL	FACHO
NORM1:	BPL	NORM2		;IF MSB=0 SHIFT AGAIN.
	SEC
	SBC	FACEXP
	BCS	ZEROFC
	EORI	377
	ADCI	1		;COMPLEMENT.
	STA	FACEXP
SQUEEZ: BCC	RNDRTS		;BITS TO SHIFT?
RNDSHF: INC	FACEXP
	BEQ	OVERR
	ROR	FACHO
IFN	ADDPRC,<
	ROR	FACMOH>
	ROR	FACMO
	ROR	FACLO
	ROR	FACOV
RNDRTS: RTS			;ALL DONE ADDING.

NEGFAC: COM	FACSGN		;COMPLEMENT FAC	 ENTIRELY.
NEGFCH: COM	FACHO		;COMPLEMENT JUST THE NUMBER.
IFN	ADDPRC,<
	COM	FACMOH>
	COM	FACMO
	COM	FACLO
	COM	FACOV
	INC	FACOV
	BNE	INCFRT
INCFAC: INC	FACLO
	BNE	INCFRT
	INC	FACMO
	BNE	INCFRT		;IF NO CARRY, RETURN.
IFN	ADDPRC,<
	INC	FACMOH
	BNE	INCFRT>
	INC	FACHO		;CARRY INCREMENT.
INCFRT: RTS

OVERR:	LDXI	ERROV
	JMP	ERROR		;TELL USER.
;
; "SHIFTR" SHIFTS [X+1:X+3] [-ACCA]  BITS RIGHT.
; SHIFTS BYTES TO START WITH IF POSSIBLE.
;
MULSHF: LDXI	RESHO-1		;ENTRY POINT FOR MULTIPLIER.
SHFTR2: LDY	3+ADDPRC,X,	;SHIFT BYTES FIRST.
	STY	FACOV
IFN	ADDPRC,<
	LDY	3,X
	STY	4,X>
	LDY	2,X,		;GET MO.
	STY	3,X,		;STORE LO.
	LDY	1,X,		;GET HO.
	STY	2,X,		;STORE MO.
	LDY	BITS
	STY	1,X,		;STORE HO.
SHIFTR: ADCI	10
	BMI	SHFTR2
	BEQ	SHFTR2
	SBCI	10		;C CAN BE EITHER 1,0 AND IT WORKS.
	TAY
	LDA	FACOV
	BCS	SHFTRT		;EQUIV TO BEQ HERE.
IFN	RORSW,<
SHFTR3: ASL	1,X
	BCC	SHFTR4
	INC	1,X
SHFTR4: ROR	1,X
	ROR	1,X>		;YES, TWO OF THEM.
IFE	RORSW,<
SHFTR3: PHA
	LDA	1,X
	ANDI	200
	LSR	1,X
	ORA	1,X
	STA	1,X
	SKIP1>
ROLSHF:
IFN	RORSW,<
	ROR	2,X
	ROR	3,X
IFN	ADDPRC,<	ROR	4,X>	;ONE MO TIME.
>
IFE	RORSW,<
	PHA
	LDAI	0
	BCC	SHFTR5
	LDAI	200
SHFTR5: LSR	2,X
	ORA	2,X
	STA	2,X
	LDAI	0
	BCC	SHFTR6
	LDAI	200
SHFTR6: LSR	3,X
	ORA	3,X
	STA	3,X
IFN	ADDPRC,<
	LDAI	0
	BCC	SHFT6A
	LDAI	200
SHFT6A: LSR	4,X
	ORA	4,X
	STA	4,X>>
IFN	RORSW,<ROR	A,>	;ROTATE ARGUMENT 1 BIT RIGHT.
IFE	RORSW,<
	PLA
	PHP
	LSR	A,
	PLP
	BCC	SHFTR7
	ORAI	200>
SHFTR7: INY
	BNE	SHFTR3		;$$$ ( MOST EXPENSIVE ! )
SHFTRT: CLC			;CLEAR OUTPUT OF FACOV.
	RTS
PAGE
SUBTTL	NATURAL LOG FUNCTION.
;
; CALCULATION IS BY:
; LN(F*2^N)=(N+LOG2(F))*LN(2)
; AN APPROXIMATION POLYNOMIAL IS USED TO CALCULATE LOG2(F).
;  CONSTANTS USED BY LOG:
FONE:	201	; 1.0
	000
	000
	000
IFN	ADDPRC,<0>
IFE	ADDPRC,<
LOGCN2: 2	; DEGREE-1
	200	; 0.59897437
	031
	126
	142
	200	; 0.96147080
	166
	042
	363
	202	; 2.88539129
	070
	252
	100>

IFN	ADDPRC,<
LOGCN2: 3	;DEGREE-1
	177	;.43425594188
	136
	126
	313
	171
	200	; .57658454134
	023
	233
	013
	144
	200	; .96180075921
	166
	070
	223
	026
	202	; 2.8853900728
	070
	252
	073
	040>
SQRHLF: 200	; SQR(0.5)
	065
	004
	363
IFN	ADDPRC,<064>
SQRTWO: 201	; SQR(2.0)
	065
	004
	363
IFN	ADDPRC,<064>
NEGHLF: 200	; -1/2
	200
	000
	000
IFN	ADDPRC,<0>
LOG2:	200	; LN(2)
	061
	162
IFE	ADDPRC,<030>
IFN	ADDPRC,<027
	370>

LOG:	JSR	SIGN		;IS IT POSITIVE?
	BEQ	LOGERR
	BPL	LOG1
LOGERR: JMP	FCERR		;CAN'T TOLERATE NEG OR ZERO.
LOG1:	LDA	FACEXP		;GET EXPONENT INTO ACCA.
	SBCI	177		;REMOVE BIAS. (CARRY IS OFF)
	PHA			;SAVE AWHILE.
	LDAI	200
	STA	FACEXP		;RESULT IS FAC IN RANGE [0.5,1].
	LDWDI	SQRHLF		;GET POINTER TO SQR(0.5).

; CALCULATE (F-SQR(.5))/(F+SQR(.5))

	JSR	FADD		;ADD TO FAC.
	LDWDI	SQRTWO		;GET SQR(2.).
	JSR	FDIV
	LDWDI	FONE
	JSR	FSUB
	LDWDI	LOGCN2
	JSR	POLYX		;EVALUATE APPROXIMATION POLYNOMIAL.
	LDWDI	NEGHLF		;ADD IN LAST CONSTANT.
	JSR	FADD
	PLA			;GET EXPONENT BACK.
	JSR	FINLOG		;ADD IT IN.
MULLN2: LDWDI	LOG2		;MULTIPLY RESULT BY LOG(2.0).
;	JMP	FMULT		;MULTIPLY TOGETHER.
PAGE
SUBTTL	FLOATING MULTIPLICATION AND DIVISION.
	;MULTIPLICATION		FAC:=ARG*FAC.
FMULT:	JSR	CONUPK		;UNPACK THE CONSTANT INTO ARG FOR USE.
FMULTT: JEQ	MULTRT		;IF FAC=0, RETURN. FAC IS SET.
	JSR	MULDIV		;FIX UP THE EXPONENTS.
	LDAI	0		;TO CLEAR RESULT.
	STA	RESHO
IFN	ADDPRC,<
	STA	RESMOH>
	STA	RESMO
	STA	RESLO
	LDA	FACOV
	JSR	MLTPLY
	LDA	FACLO		;MLTPLY ARG BY FACLO.
	JSR	MLTPLY
	LDA	FACMO		;MLTPLY ARG BY FACMO.
	JSR	MLTPLY
IFN	ADDPRC,<
	LDA	FACMOH
	JSR	MLTPLY>
	LDA	FACHO		;MLTPLY ARG BY FACHO.
	JSR	MLTPL1
	JMP	MOVFR		;MOVE RESULT INTO FAC,
				;NORMALIZE RESULT, AND RETURN.
MLTPLY: JEQ	MULSHF		;SHIFT RESULT RIGHT 1 BYTE.
MLTPL1: LSR	A,
	ORAI	200
MLTPL2: TAY
	BCC	MLTPL3		;IT MULT BIT=0, JUST SHIFT.
	CLC
	LDA	RESLO
	ADC	ARGLO
	STA	RESLO
	LDA	RESMO
	ADC	ARGMO
	STA	RESMO
IFN	ADDPRC,<
	LDA	RESMOH
	ADC	ARGMOH
	STA	RESMOH>
	LDA	RESHO
	ADC	ARGHO
	STA	RESHO
MLTPL3: ROR	RESHO
IFN	ADDPRC,<
	ROR	RESMOH>
	ROR	RESMO
	ROR	RESLO
	ROR	FACOV		;SAVE FOR ROUNDING.
	TYA
	LSR	A,		;CLEAR MSB SO WE GET A CLOSER TO 0.
	BNE	MLTPL2		;SLOW AS A TURTLE !
MULTRT: RTS

	;ROUTINE TO UNPACK MEMORY INTO ARG.
CONUPK: STWD	INDEX1
	LDYI	3+ADDPRC
	LDADY	INDEX1
	STA	ARGLO
	DEY
	LDADY	INDEX1
	STA	ARGMO
	DEY
IFN	ADDPRC,<
	LDADY	INDEX1
	STA	ARGMOH
	DEY>
	LDADY	INDEX1
	STA	ARGSGN
	EOR	FACSGN
	STA	ARISGN
	LDA	ARGSGN
	ORAI	200
	STA	ARGHO
	DEY
	LDADY	INDEX1
	STA	ARGEXP
	LDA	FACEXP		;SET CODES OF FACEXP.
	RTS

	;CHECK SPECIAL CASES AND ADD EXPONENTS FOR FMULT, FDIV.
MULDIV: LDA	ARGEXP		;EXP OF ARG=0?
MLDEXP: BEQ	ZEREMV		;SO WE GET ZERO EXPONENT.
	CLC
	ADC	FACEXP		;RESULT IS IN ACCA.
	BCC	TRYOFF		;FIND [C] XOR [N].
	BMI	GOOVER		;OVERFLOW IF BITS MATCH.
	CLC
	SKIP2
TRYOFF: BPL	ZEREMV		;UNDERFLOW.
	ADCI	200		;ADD BIAS.
	STA	FACEXP
	JEQ	ZEROML		;ZERO THE REST OF IT.
	LDA	ARISGN
	STA	FACSGN		;ARISGN IS RESULT'S SIGN.
	RTS			;DONE.
MLDVEX: LDA	FACSGN		;GET SIGN.
	EORI	377		;COMPLEMENT IT.
	BMI	GOOVER
ZEREMV: PLA			;GET ADDR OFF STACK.
	PLA	
	JMP	ZEROFC		;UNDERFLOW.
GOOVER: JMP	OVERR		;OVERFLOW.

	;MULTIPLY FAC BY 10.
MUL10:	JSR	MOVAF		;COPY FAC INTO ARG.
	TAX
	BEQ	MUL10R		;IF [FAC]=0, GOT ANSWER.
	CLC
	ADCI	2		;AUGMENT EXP BY 2.
	BCS	GOOVER		;OVERFLOW.
FINML6: LDXI	0
	STX	ARISGN		;SIGNS ARE SAME.
	JSR	FADDC		;ADD TOGETHER.
	INC	FACEXP		;MULTIPLY BY TWO.
	BEQ	GOOVER		;OVERFLOW.
MUL10R: RTS

	; DIVIDE FAC BY 10.
TENZC:	204
	040
	000
	000
IFN	ADDPRC,<0>
DIV10:	JSR	MOVAF		;MOVE FAC TO ARG.
	LDWDI	TENZC		;POINT TO CONSTANT OF 10.0
	LDXI	0		;SIGNS ARE BOTH POSITIVE.
FDIVF:	STX	ARISGN
	JSR	MOVFM		;PUT IT INTO FAC.
	JMP	FDIVT		;SKIP OVER NEXT TWO BYTES.
FDIV:	JSR	CONUPK		;UNPACK CONSTANT.
FDIVT:	BEQ	DV0ERR		;CAN'T DIVIDE BY ZERO !
				;(NOT ENOUGH ROOM TO STORE RESULT.)
	JSR	ROUND		;TAKE FACOV INTO ACCT IN FAC.
	LDAI	0		;NEGATE FACEXP.
	SEC
	SBC	FACEXP
	STA	FACEXP
	JSR	MULDIV		;FIX UP EXPONENTS.
	INC	FACEXP		;SCALE IT RIGHT.
	BEQ	GOOVER		;OVERFLOW.
	LDXI	^D256-3-ADDPRC	;SETUP PROCEDURE.
	LDAI	1
DIVIDE:				;THIS IS THE BEST CODE IN THE WHOLE PILE.
	LDY	ARGHO		;SEE WHAT RELATION HOLDS.
	CPY	FACHO
	BNE	SAVQUO		;[C]=0,1. N(C=0)=0.
IFN	ADDPRC,<
	LDY	ARGMOH
	CPY	FACMOH
	BNE	SAVQUO>
	LDY	ARGMO
	CPY	FACMO
	BNE	SAVQUO
	LDY	ARGLO
	CPY	FACLO
SAVQUO: PHP
	ROL	A,		;SAVE RESULT.
	BCC	QSHFT		;IF NOT DONE, CONTINUE.
	INX
	STA	RESLO,X
	BEQ	LD100
	BPL	DIVNRM		;NOTE THIS REQ 1 MO RAM THEN NECESS.
	LDAI	1
QSHFT:	PLP			;RETURN CONDITION CODES.
	BCS	DIVSUB		;FAC .LE. ARG.
SHFARG: ASL	ARGLO		;SHIFT ARG ONE PLACE LEFT.
	ROL	ARGMO
IFN	ADDPRC,<
	ROL	ARGMOH>
	ROL	ARGHO
	BCS	SAVQUO		;SAVE A RESULT OF ONE FOR THIS POSITION
				;AND DIVIDE.
	BMI	DIVIDE		;IF MSB ON, GO DECIDE WHETHER TO SUB.
	BPL	SAVQUO
DIVSUB: TAY			;NOTICE C MUST BE ON HERE.
	LDA	ARGLO
	SBC	FACLO
	STA	ARGLO
	LDA	ARGMO
	SBC	FACMO
	STA	ARGMO
IFN	ADDPRC,<
	LDA	ARGMOH
	SBC	FACMOH
	STA	ARGMOH>
	LDA	ARGHO
	SBC	FACHO
	STA	ARGHO
	TYA
	JMP	SHFARG
LD100:	LDAI	100		;ONLY WANT TWO MORE BITS.
	BNE	QSHFT		;ALWAYS BRANCHES.
DIVNRM: REPEAT	6,<ASL	A>	;GET LAST TWO BITS INTO MSB AND B6.
	STA	FACOV
	PLP			;TO GET GARBAGE OFF STACK.
	JMP	MOVFR		;MOVE RESULT INTO FAC, THEN
				;NORMALIZE RESULT AND RETURN.
DV0ERR: LDXI	ERRDV0
	JMP	ERROR
PAGE
SUBTTL	FLOATING POINT MOVEMENT ROUTINES.
	;MOVE RESULT TO FAC.
MOVFR:	LDA	RESHO
	STA	FACHO
IFN	ADDPRC,<
	LDA	RESMOH
	STA	FACMOH>
	LDA	RESMO
	STA	FACMO
	LDA	RESLO		;MOVE LO AND SGN.
	STA	FACLO
	JMP	NORMAL		;ALL DONE.

	;MOVE MEMORY INTO FAC (UNPACKED).
MOVFM:	STWD	INDEX1
	LDYI	3+ADDPRC
	LDADY	INDEX1
	STA	FACLO
	DEY
	LDADY	INDEX1
	STA	FACMO
	DEY
IFN	ADDPRC,<
	LDADY	INDEX1
	STA	FACMOH
	DEY>
	LDADY	INDEX1
	STA	FACSGN
	ORAI	200
	STA	FACHO
	DEY
	LDADY	INDEX1
	STA	FACEXP		;LEAVE SWITCHES SET ON EXP.
	STY	FACOV
	RTS

	;MOVE NUMBER FROM FAC TO MEMORY.
MOV2F:	LDXI	TEMPF2
	SKIP2
MOV1F:	LDXI	TEMPF1
MOVML:	LDYI	0
	BEQ	MOVMF		;ALWAYS BRANCHES.
MOVVF:	LDXY	FORPNT
MOVMF:	JSR	ROUND
	STXY	INDEX1
	LDYI	3+ADDPRC
	LDA	FACLO
	STADY	INDEX
	DEY
	LDA	FACMO
	STADY	INDEX
	DEY
IFN	ADDPRC,<
	LDA	FACMOH
	STADY	INDEX
	DEY>
	LDA	FACSGN		;INCLUDE SIGN IN HO.
	ORAI	177
	AND	FACHO
	STADY	INDEX
	DEY
	LDA	FACEXP
	STADY	INDEX
	STY	FACOV		;ZERO IT SINCE ROUNDED.
	RTS			;[Y]=0.

	;MOVE ARG INTO FAC.
MOVFA:	LDA	ARGSGN
MOVFA1: STA	FACSGN
	LDXI	4+ADDPRC
MOVFAL: LDA	ARGEXP-1,X
	STA	FACEXP-1,X
	DEX
	BNE	MOVFAL
	STX	FACOV
	RTS

	;MOVE FAC INTO ARG.
MOVAF:	JSR	ROUND
MOVEF:	LDXI	5+ADDPRC
MOVAFL: LDA	FACEXP-1,X
	STA	ARGEXP-1,X
	DEX
	BNE	MOVAFL
	STX	FACOV		;ZERO IT SINCE ROUNDED.
MOVRTS: RTS

ROUND:	LDA	FACEXP		;ZERO?
	BEQ	MOVRTS		;YES. DONE ROUNDING.
	ASL	FACOV		;ROUND?
	BCC	MOVRTS		;NO. MSB OFF.
INCRND: JSR	INCFAC		;YES, ADD ONE TO LSB(FAC).
	BNE	MOVRTS		;NO CARRY MEANS DONE.
	JMP	RNDSHF		;SQUEEZ MSB IN AND RTS.
				;NOTE [C]=1 SINCE INCFAC DOESNT TOUCH C.
PAGE
SUBTTL	SIGN, SGN, FLOAT, NEG, ABS.

	;PUT SIGN OF FAC IN ACCA.
SIGN:	LDA	FACEXP
	BEQ	SIGNRT		;IF NUMBER IS ZERO, SO IS RESULT.
FCSIGN: LDA	FACSGN
FCOMPS: ROL	A
	LDAI	^O377		;ASSUME NEGATIVE.
	BCS	SIGNRT
	LDAI	1		;GET +1.
SIGNRT: RTS

	;SGN FUNCTION.
SGN:	JSR	SIGN

	;FLOAT THE SIGNED INTEGER IN ACCA.
FLOAT:	STA	FACHO		;PUT [ACCA] IN HIGH ORDER.
	LDAI	0
	STA	FACHO+1
	LDXI	210		;GET THE EXPONENT.

	;FLOAT THE SIGNED NUMBER IN FAC.
FLOATS: LDA	FACHO
	EORI	377
	ROL	A,		;GET COMP OF SIGN IN CARRY.
FLOATC: LDAI	0		;ZERO [ACCA] BUT NOT CARRY.
	STA	FACLO
IFN	ADDPRC,<
	STA	FACMO>
FLOATB: STX	FACEXP
	STA	FACOV
	STA	FACSGN
	JMP	FADFLT

	;ABSOLUTE VALUE OF FAC.
ABS:	LSR	FACSGN
	RTS

PAGE
SUBTTL	COMPARE TWO NUMBERS.
	;A=1 IF ARG .LT. FAC.
	;A=0 IF ARG=FAC.
	;A=-1 IF ARG .GT. FAC.
FCOMP:	STA	INDEX2
FCOMPN: STY	INDEX2+1
	LDYI	0
	LDADY	INDEX2		;HAS ARGEXP.
	INY			;BUMP PNTR UP.
	TAX			;SAVE A IN X AND RESET CODES.
	BEQ	SIGN
	LDADY	INDEX2
	EOR	FACSGN		;SIGNS THE SAME.
	BMI	FCSIGN		;SIGNS DIFFER SO RESULT IS
				;SIGN OF FAC AGAIN.
FOUTCP: CPX	FACEXP
	BNE	FCOMPC
	LDADY	INDEX2
	ORAI	200
	CMP	FACHO
	BNE	FCOMPC
	INY
IFN	ADDPRC,<
	LDADY	INDEX2
	CMP	FACMOH
	BNE	FCOMPC
	INY>
	LDADY	INDEX2
	CMP	FACMO
	BNE	FCOMPC
	INY
	LDAI	177
	CMP	FACOV
	LDADY	INDEX2
	SBC	FACLO		;GET ZERO IF EQUAL.
	BEQ	QINTRT
FCOMPC: LDA	FACSGN
	BCC	FCOMPD
	EORI	377
FCOMPD: JMP	FCOMPS		;A PART OF SIGN SETS ACCA UP.

PAGE
SUBTTL	GREATEST INTEGER FUNCTION.
	;QUICK GREATEST INTEGER FUNCTION.
	;LEAVES INT(FAC) IN FACHO&MO&LO SIGNED.
	;ASSUMES FAC .LT. 2^23 = 8388608
QINT:	LDA	FACEXP
	BEQ	CLRFAC		;IF ZERO, GOT IT.
	SEC
	SBCI	8*ADDPRC+230	;GET NUMBER OF PLACES TO SHIFT.
	BIT	FACSGN
	BPL	QISHFT
	TAX
	LDAI	377
	STA	BITS		;PUT 377 IN WHEN SHFTR SHIFTS BYTES.
	JSR	NEGFCH		;TRULY NEGATE QUANTITY IN FAC.
	TXA
QISHFT: LDXI	FAC
	CMPI	^D256-7
	BPL	QINT1		;IF NUMBER OF PLACES .GE. 7
				;SHIFT 1 PLACE AT A TIME.
	JSR	SHIFTR		;START SHIFTING BYTES, THEN BITS.
	STY	BITS		;ZERO BITS SINCE ADDER WANTS ZERO.
QINTRT: RTS
QINT1:	TAY			;PUT COUNT IN COUNTER.
	LDA	FACSGN
	ANDI	200		;GET SIGN BIT.
	LSR	FACHO		;SAVE FIRST SHIFTED BYTE.
	ORA	FACHO
	STA	FACHO
	JSR	ROLSHF		;SHIFT THE REST.
	STY	BITS		;ZERO [BITS].
	RTS

	;GREATEST INTEGER FUNCTION.
INT:	LDA	FACEXP
	CMPI	8*ADDPRC+230
	BCS	INTRTS		;FORGET IT.
	JSR	QINT
	STY	FACOV		;CLR OVERFLOW BYTE.
	LDA	FACSGN
	STY	FACSGN		;MAKE FAC LOOK POSITIVE.
	EORI	200		;GET COMPLEMENT OF SIGN IN CARRY.
	ROL	A,
	LDAI	8*ADDPRC+230
	STA	FACEXP
	LDA	FACLO
	STA	INTEGR
	JMP	FADFLT
CLRFAC: STA	FACHO		;MAKE IT REALLY ZERO.
IFN	ADDPRC,<STA FACMOH>
	STA	FACMO
	STA	FACLO
	TAY
INTRTS: RTS
PAGE
SUBTTL	FLOATING POINT INPUT ROUTINE.
	;NUMBER INPUT IS LEFT IN FAC.
	;AT ENTRY [TXTPTR] POINTS TO THE FIRST CHARACTER IN A TEXT BUFFER.
	;THE FIRST CHARACTER IS ALSO IN ACCA. FIN PACKS THE DIGITS
	;INTO THE FAC AS AN INTEGER AND KEEPS TRACK OF WHERE THE
	;DECIMAL POINT IS. [DPTFLG] TELL WHETHER A DP HAS BEEN
	;SEEN. [DECCNT] IS THE NUMBER OF DIGITS AFTER THE DP.
	;AT THE END [DECCNT] AND THE EXPONENT ARE USED TO
	;DETERMINE HOW MANY TIMES TO MULTIPLY OR DIVIDE BY TEN
	;TO GET THE CORRECT NUMBER.
FIN:	LDYI	0		;ZERO FACSGN&SGNFLG.
	LDXI	11+ADDPRC	;ZERO EXP AND HO (AND MOH).
FINZLP: STY	DECCNT,X	;ZERO MO AND LO.
	DEX			;ZERO TENEXP AND EXPSGN
	BPL	FINZLP		;ZERO DECCNT, DPTFLG.
	BCC	FINDGQ		;FLAGS STILL SET FROM CHRGET.
	CMPI	"-"		;A NEGATIVE SIGN?
	BNE	QPLUS		;NO, TRY PLUS SIGN.
	STX	SGNFLG		;IT'S NEGATIVE. (X=377).
	BEQ	FINC		;ALWAYS BRANCHES.
QPLUS:	CMPI	"+"		;PLUS SIGN?
	BNE	FIN1		;YES, SKIP IT.
FINC:	JSR	CHRGET
FINDGQ: BCC	FINDIG
FIN1:	CMPI	"."		;THE DP?
	BEQ	FINDP		;NO KIDDING.
	CMPI	"E"		;EXPONENT FOLLOWS.
	BNE	FINE		;NO.
	;HERE TO CHECK FOR SIGN OF EXP.
	JSR	CHRGET		;YES. GET ANOTHER.
	BCC	FNEDG1		;IT IS A DIGIT. (EASIER THAN
				;BACKING UP POINTER.)
	CMPI	MINUTK		;MINUS?
	BEQ	FINEC1		;NEGATE.
	CMPI	"-"		;MINUS SIGN?
	BEQ	FINEC1
	CMPI	PLUSTK		;PLUS?
	BEQ	FINEC
	CMPI	"+"		;PLUS SIGN?
	BEQ	FINEC
	BNE	FINEC2
FINEC1: ROR	EXPSGN		;TURN IT ON.
FINEC:	JSR	CHRGET		;GET ANOTHER.
FNEDG1: BCC	FINEDG		;IT IS A DIGIT.
FINEC2: BIT	EXPSGN
	BPL	FINE
	LDAI	0
	SEC
	SBC	TENEXP
	JMP	FINE1
FINDP:	ROR	DPTFLG
	BIT	DPTFLG
	BVC	FINC
FINE:	LDA	TENEXP
FINE1:	SEC
	SBC	DECCNT		;GET NUMBER OF PLACES TO SHIFT.
	STA	TENEXP
	BEQ	FINQNG		;NEGATE?
	BPL	FINMUL		;POSITIVE SO MULTIPLY.
FINDIV: JSR	DIV10
	INC	TENEXP		;DONE?
	BNE	FINDIV		;NO.
	BEQ	FINQNG		;YES.
FINMUL: JSR	MUL10
	DEC	TENEXP		;DONE?
	BNE	FINMUL		;NO
FINQNG: LDA	SGNFLG
	BMI	NEGXQS		;IF POSITIVE, RETURN.
	RTS
NEGXQS: JMP	NEGOP		;OTHERWISE, NEGATE AND RETURN.

FINDIG: PHA
	BIT	DPTFLG
	BPL	FINDG1
	INC	DECCNT
FINDG1: JSR	MUL10
	PLA			;GET IT BACK.
	SEC
	SBCI	"0"
	JSR	FINLOG		;ADD IT IN.
	JMP	FINC

FINLOG: PHA
	JSR	MOVAF		;SAVE FAC FOR LATER.
	PLA
	JSR	FLOAT		;FLOAT THE VALUE IN ACCA.
	LDA	ARGSGN
	EOR	FACSGN
	STA	ARISGN		;RESULTANT SIGN.
	LDX	FACEXP		;SET SIGNS ON THING TO ADD.
	JMP	FADDT		;ADD TOGETHER AND RETURN.

	;HERE PACK IN THE NEXT DIGIT OF THE EXPONENT.
	;MULTIPLY THE OLD EXP BY 10 AND ADD IN THE NEXT
	;DIGIT. NOTE: EXP OVERFLOW IS NOT CHECKED FOR.
FINEDG: LDA	TENEXP		;GET EXP SO FAR.
	CMPI	12		;WILL RESULT BE .GE. 100?
	BCC	MLEX10	
	LDAI	144		;GET 100.
	BIT	EXPSGN
	BMI	MLEXMI		;IF NEG EXP, NO CHK FOR OVERR.
	JMP	OVERR
MLEX10: ASL	A,		;MULT BY 2 TWICE
	ASL	A
	CLC			;POSSIBLE SHIFT OUT OF HIGH.
	ADC	TENEXP		;LIKE MULTIPLYING BY FIVE.
	ASL	A,		;AND NOW BY TEN.
	CLC
	LDYI	0
	ADCDY	TXTPTR
	SEC
	SBCI	"0"
MLEXMI: STA	TENEXP		;SAVE RESULT.
	JMP	FINEC
PAGE
SUBTTL	FLOATING POINT OUTPUT ROUTINE.

IFE	ADDPRC,<
NZ0999: 221	; 99999.9499
	103
	117
	370
NZ9999: 224	; 999999.499
	164
	043
	367
NZMIL:	224	; 10^6.
	164
	044
	000>
IFN	ADDPRC,<
NZ0999: 233	; 99999999.9499
	076
	274
	037
	375
NZ9999: 236	; 999999999.499
	156
	153
	047
	375
NZMIL:	236	; 10^9
	156
	153
	050
	000>
	;ENTRY TO LINPRT.
INPRT:	LDWDI	INTXT
	JSR	STROU2
	LDA	CURLIN+1
	LDX	CURLIN
LINPRT: STWX	FACHO
	LDXI	220		;EXPONENT OF 16.
	SEC			;NUMBER IS POSITIVE.
	JSR	FLOATC
	JSR	FOUT
STROU2: JMP	STROUT		;PRINT AND RETURN.

FOUT:	LDYI	1
FOUTC:	LDAI	" "		;PRINT SPACE IF POSITIVE.
	BIT	FACSGN
	BPL	FOUT1
	LDAI	"-"
FOUT1:	STA	FBUFFR-1,Y,	;STORE THE CHARACTER.
	STA	FACSGN		;MAKE FAC POS FOR QINT.
	STY	FBUFPT		;SAVE FOR LATER.
	INY
	LDAI	"0"		;GET ZERO TO TYPE IF FAC=0.
	LDX	FACEXP
	JEQ	FOUT19
	LDAI	 0
	CPXI	200		;IS NUMBER .LT. 1.0 ?
	BEQ	FOUT37		;NO.
	BCS	FOUT7
FOUT37: LDWDI	NZMIL		;MULTIPLY BY 10^6.
	JSR	FMULT
	LDAI	^D256-3*ADDPRC-6
FOUT7:	STA	DECCNT		;SAVE COUNT OR ZERO IT.
FOUT4:	LDWDI	NZ9999
	JSR	FCOMP		;IS NUMBER .GT. 999999.499 ?
				;OR 999999999.499?
	BEQ	BIGGES
	BPL	FOUT9		;YES. MAKE IT SMALLER.
FOUT3:	LDWDI	NZ0999
	JSR	FCOMP		;IS NUMBER .GT. 99999.9499 ?
				; OR 99999999.9499?
	BEQ	FOUT38
	BPL	FOUT5		;YES. DONE MULTIPLYING.
FOUT38: JSR	MUL10		;MAKE IT BIGGER.
	DEC	DECCNT
	BNE	FOUT3		;SEE IF THAT DOES IT.
				;THIS ALWAYS GOES.
FOUT9:	JSR	DIV10		;MAKE IT SMALLER.
	INC	DECCNT
	BNE	FOUT4		;SEE IF THAT DOES IT.
				;THIS ALWAYS GOES.

FOUT5:	JSR	FADDH		;ADD A HALF TO ROUND UP.
BIGGES: JSR	QINT
	LDXI	1		;DECIMAL POINT COUNT.
	LDA	DECCNT
	CLC
	ADCI	3*ADDPRC+7	;SHOULD NUMBER BE PRINTED IN E NOTATION?
				;IE, IS NUMBER .LT. .01 ?
	BMI	FOUTPI		;YES.
	CMPI	3*ADDPRC+10	;IS IT .GT. 999999 (999999999)?
	BCS	FOUT6		;YES. USE E NOTATION.
	ADCI	^O377		;NUMBER OF PLACES BEFORE DECIMAL POINT.
	TAX			;PUT INTO ACCX.
	LDAI	2		;NO E NOTATION.
FOUTPI: SEC
FOUT6:	SBCI	2		;EFFECTIVELY ADD 5 TO ORIG EXP.
	STA	TENEXP		;THAT IS THE EXPONENT TO PRINT.
	STX	DECCNT		;NUMBER OF DECIMAL PLACES.
	TXA
	BEQ	FOUT39
	BPL	FOUT8		;SOME PLACES BEFORE DEC PNT.
FOUT39: LDY	FBUFPT		;GET POINTER TO OUTPUT.
	LDAI	"."		;PUT IN "."
	INY
	STA	FBUFFR-1,Y
	TXA
	BEQ	FOUT16
	LDAI	"0"		;GET THE ENSUING ZERO.
	INY
	STA	FBUFFR-1,Y
FOUT16: STY	FBUFPT		;SAVE FOR LATER.
FOUT8:	LDYI	0
FOUTIM: LDXI	200		;FIRST PASS THRU, ACCX HAS MSB SET.
FOUT2:	LDA	FACLO
	CLC
	ADC	FOUTBL+2+ADDPRC,Y
	STA	FACLO
	LDA	FACMO
	ADC	FOUTBL+1+ADDPRC,Y
	STA	FACMO
IFN	ADDPRC,<
	LDA	FACMOH
	ADC	FOUTBL+1,Y
	STA	FACMOH>
	LDA	FACHO
	ADC	FOUTBL,Y
	STA	FACHO
	INX			;IT WAS DONE YET ANOTHER TIME.
	BCS	FOUT41
	BPL	FOUT2
	BMI	FOUT40
FOUT41: BMI	FOUT2
FOUT40: TXA
	BCC	FOUTYP		;CAN USE ACCA AS IS.
	EORI	377		;FIND 11.-[A].
	ADCI	12		;C IS STILL ON TO COMPLETE NEGATION.
				;AND WILL ALWAYS BE ON AFTER.
FOUTYP: ADCI	"0"-1		;GET A CHARACTER TO PRINT.
	REPEAT	3+ADDPRC,<INY>	;BUMP POINTER UP.
	STY	FDECPT
	LDY	FBUFPT
	INY			;POINT TO PLACE TO STORE OUTPUT.
	TAX
	ANDI	177		;GET RID OF MSB.
	STA	FBUFFR-1,Y
	DEC	DECCNT
	BNE	STXBUF		;NOT TIME FOR DP YET.
	LDAI	"."
	INY
	STA	FBUFFR-1,Y,	;STORE DP.
STXBUF: STY	FBUFPT		;STORE PNTR FOR LATER.
	LDY	FDECPT
FOUTCM: TXA			;COMPLEMENT ACCX
	EORI	377		;COMPLEMENT ACCA.
	ANDI	200		;SAVE ONLY MSB.
	TAX
	CPYI	FDCEND-FOUTBL
IFN	TIME,<
	BEQ	FOULDY
	CPYI	TIMEND-FOUTBL>
	BNE	FOUT2		;CONTINUE WITH OUTPUT.
FOULDY: LDY	FBUFPT		;GET BACK OUTPUT PNTR.
FOUT11: LDA	FBUFFR-1,Y,	;REMOVE TRAILING ZEROES.
	DEY
	CMPI	"0"
	BEQ	FOUT11
	CMPI	"."
	BEQ	FOUT12		;RUN INTO DP. STOP.
	INY			;SOMETHING ELSE. SAVE IT.
FOUT12: LDAI	"+"
	LDX	TENEXP
	BEQ	FOUT17		;NO EXPONENT TO OUTPUT.
	BPL	FOUT14
	LDAI	0
	SEC
	SBC	TENEXP
	TAX
	LDAI	"-"		;EXPONENT IS NEGATIVE.
FOUT14: STA	FBUFFR-1+2,Y,	;STORE SIGN OF EXP
	LDAI	"E"
	STA	FBUFFR-1+1,Y,	;STORE THE "E" CHARACTER.
	TXA
	LDXI	"0"-1
	SEC
FOUT15: INX			;MOVE CLOSER TO OUTPUT VALUE.
	SBCI	12		;SUBTRACT 10.
	BCS	FOUT15		;NOT NEGATIVE YET.
	ADCI	"0"+12		;GET SECOND OUTPUT CHARACTER.
	STA	FBUFFR-1+4,Y,	;STORE HIGH DIGIT.
	TXA
	STA	FBUFFR-1+3,Y,	;STORE	LOW DIGIT.
	LDAI	0		;PUT IN TERMINATOR.
	STA	FBUFFR-1+5,Y,
	BEQA	FOUT20		;RETURN. (ALWAYS BRANCHES).
FOUT19: STA	FBUFFR-1,Y,	;STORE THE CHARACTER.
FOUT17: LDAI	0		;A TERMINATOR.
	STA	FBUFFR-1+1,Y
FOUT20: LDWDI	FBUFFR
FPWRRT: RTS			;ALL DONE.
FHALF:	200	;1/2
	000
ZERO:	000
	000
IFN	ADDPRC,<0>

;POWER OF TEN TABLE
IFE	ADDPRC,<
FOUTBL: 376	;-100000
	171
	140
	000	;10000
	047
	020
	377	;-1000
	374
	030
	000	;100
	000
	144
	377	;-10
	377
	366
	000	;1
	000
	001>

IFN	ADDPRC,<
FOUTBL: 372	;-100,000,000
	012
	037
	000
	000	;10,000,000
	230
	226
	200
	377	;-1,000,000
	360
	275
	300
	000	;100,000
	001
	206
	240
	377	;-10,000
	377
	330
	360
	000	;1000
	000
	003
	350
	377	;-100
	377
	377
	234
	000	;10
	000
	000
	012
	377	;-1
	377
	377
	377>
FDCEND:
IFN	TIME,<
	377	; -2160000 FOR TIME CONVERTER.
	337
	012
	200
	000	; 216000
	003
	113
	300
	377	; -36000
	377
	163
	140
	000	; 3600
	000
	016
	020
	377	; -600
	377
	375
	250
	000	; 60
	000
	000
	074
TIMEND:>

PAGE
SUBTTL	EXPONENTIATION AND SQUARE ROOT FUNCTION.
	;SQUARE ROOT FUNCTION --- SQR(A)
	;USE SQR(X)=X^.5
SQR:	JSR	MOVAF		;MOVE FAC INTO ARG.
	LDWDI	FHALF
	JSR	MOVFM		;PUT MEMORY INTO FAC.
				;LAST THING FETCHED IS FACEXP. INTO ACCX.
;	JMP	FPWRT		;FALL INTO FPWRT.

	;EXPONENTIATION ---  X^Y.
	;N.B.  0^0=1
	;FIRST CHECK IF Y=0. IF SO, THE RESULT IS 1.
	;NEXT CHECK IF X=0. IF SO THE RESULT IS 0.
	;THEN CHECK IF X.GT.0. IF NOT CHECK THAT Y IS AN INTEGER.
	;IF SO, NEGATE X, SO THAT LOG DOESN'T GIVE FCERR.
	;IF X IS NEGATIVE AND Y IS ODD, NEGATE THE RESULT
	;RETURNED BY EXP.
	;TO COMPUTE THE RESULT USE X^Y=EXP((Y*LOG(X)).
FPWRT:	BEQ	EXP		;IF FAC=0, JUST EXPONENTIATE THAT.
	LDA	ARGEXP		;IS X=0?
	BNE	FPWRT1
	JMP	ZEROF1		;ZERO FAC.
FPWRT1: LDXYI	TEMPF3		;SAVE FOR LATER IN A TEMP.
	JSR	MOVMF
	;Y=0 ALREADY. GOOD IN CASE NO ONE CALLS INT.
	LDA	ARGSGN
	BPL	FPWR1		;NO PROBLEMS IF X.GT.0.
	JSR	INT		;INTEGERIZE THE FAC.
	LDWDI	TEMPF3		;GET ADDR OF COMPERAND.
	JSR	FCOMP		;EQUAL?
	BNE	FPWR1		;LEAVE X NEG. LOG WILL BLOW HIM OUT.
				;A=-1 AND Y IS IRRELEVANT.
	TYA			;NEGATE X. MAKE POSITIVE.
	LDY	INTEGR		;GET EVENNESS.
FPWR1:	JSR	MOVFA1		;ALTERNATE ENTRY POINT.
	TYA
	PHA			;SAVE EVENNESS FOR LATER.
	JSR	LOG		;FIND LOG.
	LDWDI	TEMPF3		;MULTIPLY FAC TIMES LOG(X).
	JSR	FMULT
	JSR	EXP		;EXPONENTIATE THE FAC.
	PLA
	LSR	A,		;IS IT EVEN?
	BCC	NEGRTS		;YES. OR X.GT.0.
	;NEGATE THE NUMBER IN FAC.
NEGOP:	LDA	FACEXP
	BEQ	NEGRTS
	COM	FACSGN
NEGRTS: RTS

PAGE
SUBTTL	EXPONENTIATION FUNCTION.
	;FIRST SAVE THE ORIGINAL ARGUMENT AND MULTIPLY THE FAC BY
	;LOG2(E). THE RESULT IS USED TO DETERMINE IF OVERFLOW
	;WILL OCCUR SINCE EXP(X)=2^(X*LOG2(E)) WHERE
	;LOG2(E)=LOG(E) BASE 2. THEN SAVE THE INTEGER PART OF
	;THIS TO SCALE THE ANSWER AT THE END. SINCE
	;2^Y=2^INT(Y)*2^(Y-INT(Y)) AND 2^INT(Y) IS EASY TO COMPUTE.
	;NOW COMPUTE 2^(X*LOG2(E)-INT(X*LOG2(E)) BY
	;P(LN(2)*(INT(X*LOG2(E))+1)-X) WHERE P IS AN APPROXIMATION
	;POLYNOMIAL. THE RESULT IS THEN SCALED BY THE POWER OF 2
	;PREVIOUSLY SAVED.

LOGEB2: 201			;LOG(E) BASE 2.
	070
	252
	073
IFN	ADDPRC,<051>

ife	addprc,<
expcon: 6	; degree -1.
	164	; .00021702255
	143
	220
	214
	167	; .0012439688
	043
	014
	253
	172	; .0096788410
	036
	224
	000
	174	; .055483342
	143
	102
	200
	176	; .24022984
	165
	376
	320
	200	; .69314698
	061
	162
	025
	201	; 1.0
	000
	000
	000>


IFN	ADDPRC,<
EXPCON: 7	;DEGREE-1
	161	; .000021498763697
	064
	130
	076
	126
	164	; .00014352314036
	026
	176
	263
	033
	167	; .0013422634824
	057
	356
	343
	205
	172	; .0096140170119
	035
	204
	034
	052
	174	; .055505126860
	143
	131
	130
	012
	176	; .24022638462
	165
	375
	347
	306
	200	; .69314718608
	061
	162
	030
	020
	201	; 1.0
	000
	000
	000
	000>

EXP:
	LDWDI	LOGEB2		;MULTIPLY BY LOG(E) BASE 2.
	JSR	FMULT
	LDA	FACOV
	ADCI	120
	BCC	STOLD
	JSR	INCRND
STOLD:	STA	OLDOV
	JSR	MOVEF		;TO SAVE IN ARG WITHOUT ROUND.
	LDA	FACEXP
	CMPI	210		;IF ABS(FAC) .GE. 128, TOO BIG.
	BCC	EXP1
GOMLDV: JSR	MLDVEX		;OVERFLOW OR OVERFLOW.
EXP1:	JSR	INT
	LDA	INTEGR	;GET LOW PART.
	CLC
	ADCI	201
	BEQ	GOMLDV		;OVERFLOW OR OVERFLOW !!
	SEC
	SBCI	1		;SUBTRACT 1.
	PHA			;SAVE A WHILE.
	LDXI	4+ADDPRC	;PREP TO SWAP FAC AND ARG.
SWAPLP: LDA	ARGEXP,X
	LDY	FACEXP,X
	STA	FACEXP,X
	STY	ARGEXP,X
	DEX
	BPL	SWAPLP
	LDA	OLDOV
	STA	FACOV
	JSR	FSUBT
	JSR	NEGOP		;NEGATE FAC.
	LDWDI	EXPCON
	JSR	POLY
	CLR	ARISGN		;MULTIPLY BY POSITIVE 1.0.
	PLA			;GET SCALE FACTOR.
	JSR	MLDEXP		;MODIFY FACEXP AND CHECK FOR OVERFLOW.
	RTS			;HAS TO DO JSR DUE TO PULAS IN MULDIV.


PAGE
SUBTTL	POLYNOMIAL EVALUATOR AND THE RANDOM NUMBER GENERATOR.
	;EVALUATE P(X^2)*X
	;POINTER TO DEGREE IS IN [Y,A].
	;THE CONSTANTS FOLLOW THE DEGREE.
	;FOR X=FAC, COMPUTE:
	; C0*X+C1*X^3+C2*X^5+C3*X^7+...+C(N)*X^(2*N+1)
POLYX:	STWD	POLYPT		;RETAIN POLYNOMIAL POINTER FOR LATER.
	JSR	MOV1F		;SAVE FAC IN FACTMP.
	LDAI	TEMPF1
	JSR	FMULT		;COMPUTE X^2.
	JSR	POLY1		;COMPUTE P(X^2).
	LDWDI	TEMPF1
	JMP	FMULT		;MULTIPLY BY FAC AGAIN.

	;POLYNOMIAL EVALUATOR.
	;POINTER TO DEGREE IS IN [Y,A].
	;COMPUTE:
	; C0+C1*X+C2*X^2+C3*X^3+C4*X^4+...+C(N-1)*X^(N-1)+C(N)*X^N.
POLY:	STWD	POLYPT
POLY1:	JSR	MOV2F		;SAVE FAC.
	LDADY	POLYPT
	STA	DEGREE
	LDY	POLYPT
	INY
	TYA
	BNE	POLY3
	INC	POLYPT+1
POLY3:	STA	POLYPT
	LDY	POLYPT+1
POLY2:	JSR	FMULT
	LDWD	POLYPT		;GET CURRENT POINTER.
	CLC
	ADCI	4+ADDPRC
	BCC	POLY4
	INY
POLY4:	STWD	POLYPT
	JSR	FADD		;ADD IN CONSTANT.
	LDWDI	TEMPF2		;MULTIPLY THE ORIGINAL FAC.
	DEC	DEGREE		;DONE?
	BNE	POLY2
RANDRT: RTS			;YES.

	;PSUEDO-RANDOM NUMBER GENERATOR.
	;IF ARG=0, THE LAST RANDOM NUMBER GENERATED IS RETURNED.
	;IF ARG .LT. 0, A NEW SEQUENCE OF RANDOM NUMBERS IS
	;STARTED USING THE ARGUMENT.
	;   TO FORM THE NEXT RANDOM NUMBER IN THE SEQUENCE,
	;MULTIPLY THE PREVIOUS RANDOM NUMBER BY A RANDOM CONSTANT
	;AND ADD IN ANOTHER RANDOM CONSTANT. THE THEN HO
	;AND LO BYTES ARE SWITCHED, THE EXPONENT IS PUT WHERE
	;IT WILL BE SHIFTED IN BY NORMAL, AND THE EXPONENT IN THE FAC
	;IS SET TO 200 SO THE RESULT WILL BE LESS THAN 1. THIS
	;IS THEN NORMALIZED AND SAVED FOR THE NEXT TIME.
	;THE HO AND LOW BYTES WERE SWITCHED SO THERE WILL BE A
	;RANDOM CHANCE OF GETTING A NUMBER LESS THAN OR GREATER
	;THAN .5 .

RMULZC: 230
	065
	104
	172
RADDZC: 150
	050
	261
	106

RND:	JSR	SIGN		;GET SIGN INTO ACCX.
IFN	REALIO-3,<
	TAX>			;GET INTO ACCX, SINCE "MOVFM" USES ACCX.
	BMI	RND1		;START NEW SEQUENCE IF NEGATIVE.
IFE	REALIO-3,<
	BNE	QSETNR
		;TIMERS ARE AT 9044(L0),45(HI),48(LO),49(HI) HEX.
		;FIRST TWO ARE ALWAYS FREE RUNNING.
		;SECOND PAIR IS NOT. LO IS FREER THAN HI THEN.
		;SO ORDER IN FAC IS 44,48,45,49.
	LDA	CQHTIM
	STA	FACHO
	LDA	CQHTIM+4
	STA	FACMOH
	LDA	CQHTIM+1
	STA	FACMO
	LDA	CQHTIM+5
	STA	FACLO
	JMP	STRNEX>
QSETNR: LDWDI	RNDX		;GET LAST ONE INTO FAC.
	JSR	MOVFM
IFN	REALIO-3,<
	TXA			;FAC WAS ZERO?
	BEQ	RANDRT>		;RESTORE LAST ONE.
	LDWDI	RMULZC		;MULTIPLY BY RANDOM CONSTANT.
	JSR	FMULT
	LDWDI	RADDZC
	JSR	FADD		;ADD RANDOM CONSTANT.
RND1:	LDX	FACLO
	LDA	FACHO
	STA	FACLO
	STX	FACHO		;REVERSE HO AND LO.
IFE	REALIO-3,<
	LDX	FACMOH
	LDA	FACMO
	STA	FACMOH
	STX	FACMO>
STRNEX: CLR	FACSGN		;MAKE NUMBER POSITIVE.
	LDA	FACEXP		;PUT EXP WHERE IT WILL
	STA	FACOV		;BE SHIFTED IN BY NORMAL.
	LDAI	200
	STA	FACEXP		;MAKE RESULT BETWEEN 0 AND 1.
	JSR	NORMAL		;NORMALIZE.
	LDXYI	RNDX
GMOVMF: JMP	MOVMF		;PUT NEW ONE INTO MEMORY.

PAGE
SUBTTL	SINE, COSINE AND TANGENT FUNCTIONS.
IFE	KIMROM,<
	;COSINE FUNCTION.
	;USE COS(X)=SIN(X+PI/2)
COS:	LDWDI	PI2		;PNTR TO PI/2.
	JSR	FADD		;ADD IT IN.
				;FALL INTO SIN.


	;SINE FUNCTION.
	;USE IDENTITIES TO GET FAC IN QUADRANTS I OR IV.
	;THE FAC IS DIVIDED BY 2*PI AND THE INTEGER PART IS IGNORED
	;BECAUSE SIN(X+2*PI)=SIN(X). THEN THE ARGUMENT CAN BE COMPARED
	;WITH PI/2 BY COMPARING THE RESULT OF THE DIVISION
	;WITH PI/2/(2*PI)=1/4.
	;IDENTITIES ARE THEN USED TO GET THE RESULT IN QUADRANTS
	;I OR IV. AN APPROXIMATION POLYNOMIAL IS THEN USED TO
	;COMPUTE SIN(X).
SIN:	JSR	MOVAF
	LDWDI	TWOPI		;GET PNTR TO DIVISOR.
	LDX	ARGSGN		;GET SIGN OF RESULT.
	JSR	FDIVF
	JSR	MOVAF		;GET RESULT INTO ARG.
	JSR	INT		;INTEGERIZE FAC.
	CLR	ARISGN		;ALWAYS HAVE THE SAME SIGN.
	JSR	FSUBT		;KEEP ONLY THE FRACTIONAL PART.
	LDWDI	FR4		;GET PNTR TO 1/4.
	JSR	FSUB		;COMPUTE 1/4-FAC.
	LDA	FACSGN		;SAVE SIGN FOR LATER.
	PHA
	BPL	SIN1		;FIRST QUADRANT.
	JSR	FADDH		;ADD 1/2 TO FAC.
	LDA	FACSGN		;SIGN IS NEGATIVE?
	BMI	SIN2
	COM	TANSGN		;QUADRANTS II AND III COME HERE.
SIN1:	JSR	NEGOP		;IF POSITIVE, NEGATE IT.
SIN2:	LDWDI	FR4		;POINTER TO 1/4.
	JSR	FADD		;ADD IT IN.
	PLA			;GET ORIGINAL QUADRANT.
	BPL	SIN3
	JSR	NEGOP		;IF NEGATIVE, NEGATE RESULT.
SIN3:	LDWDI	SINCON
GPOLYX: JMP	POLYX		;DO APPROXIMATION POLYNOMIAL.


	;TANGENT FUNCTION.
TAN:	JSR	MOV1F		;MOVE FAC INTO TEMPORARY.
	CLR	TANSGN		;REMEMBER WHETHER TO NEGATE.
	JSR	SIN		;COMPUTE THE SIN.
	LDXYI	TEMPF3
	JSR	GMOVMF		;PUT SIGN INTO OTHER TEMP.
	LDWDI	TEMPF1
	JSR	MOVFM		;PUT THIS MEMORY LOC INTO FAC.
	CLR	FACSGN		;START OFF POSITIVE.
	LDA	TANSGN
	JSR	COSC		;COMPUTE COSINE.
	LDWDI	TEMPF3		;ADDRESS OF SINE VALUE.
GFDIV:	JMP	FDIV		;DIVIDE SINE BY COSINE AND RETURN.
COSC:	PHA
	JMP	SIN1

PI2:	201	;PI/2
	111
	017
	333-ADDPRC
IFN	ADDPRC,<242>
TWOPI:	203	;2*PI.
	111
	017
	333-ADDPRC
IFN	ADDPRC,<242>
FR4:	177	;1/4
	000
	000
	0000
IFN	ADDPRC,<0>
IFE ADDPRC,<SINCON:	4	;DEGREE-1.
	206	;39.710899
	036
	327
	373
	207	;-76.574956
	231
	046
	145
	207	;81.602231
	043
	064
	130
	206	;-41.341677
	245
	135
	341
	203	;6.2831853
	111
	017
	333>

IFN	ADDPRC,<
SINCON: 5		;DEGREE-1.
	204	; -14.381383816
	346
	032
	055
	033
	206	; 42.07777095
	050
	007
	373
	370
	207	; -76.704133676
	231
	150
	211
	001
	207	; 81.605223690
	043
	065
	337
	341
	206	; -41.34170209
	245
	135
	347
	050
	203	; 6.2831853070
	111
	017
	332
	242
	241	; 7.2362932E7
	124
	106
	217
	23
	217	; 73276.2515
	122
	103
	211
	315>
PAGE
SUBTTL	ARCTANGENT FUNCTION.
	;USE IDENTITIES TO GET ARG BETWEEN 0 AND 1 AND THEN USE AN
	;APPROXIMATION POLYNOMIAL TO COMPUTE ARCTAN(X).
ATN:	LDA	FACSGN		;WHAT IS SIGN?
	PHA			;(MEANWHILE SAVE FOR LATER.)
	BPL	ATN1
	JSR	NEGOP		;IF NEGATIVE, NEGATE FAC.
				;USE ARCTAN(X)=-ARCTAN(-X) .
ATN1:	LDA	FACEXP
	PHA			;SAVE THIS TOO FOR LATER.
	CMPI	201		;SEE IF FAC .GE. 1.0 .
	BCC	ATN2		;IT IS LESS THAN 1.
	LDWDI	FONE		;GET PNTR TO 1.0 .
	JSR	FDIV		;COMPUTE RECIPROCAL.
				;USE ARCTAN(X)=PI/2-ARCTAN(1/X) .
ATN2:	LDWDI	ATNCON		;PNTR TO ARCTAN CONSTANTS.
	JSR	POLYX
	PLA
	CMPI	201		;WAS ORIGINAL ARGUMENT .LT. 1 ?
	BCC	ATN3		;YES.
	LDWDI	PI2
	JSR	FSUB		;SUBTRACT ARCTAGN FROM PI/2.
ATN3:	PLA			;WAS ORIGINAL ARGUMENT POSITIVE?
	BPL	ATN4		;YES.
	JMP	NEGOP		;IF NEGATIVE, NEGATE RESULT.
ATN4:	RTS			;ALL DONE.

IFE	ADDPRC,<
ATNCON:	 10	;DEGREE-1.
	170	;.0028498896
	072
	305
	067
	173	;-.016068629
	203
	242
	134
	174	;.042691519
	056
	335
	115
	175	;-.075042945
	231
	260
	036
	175	;.10640934
	131
	355
	044
	176	;-.14203644
	221
	162
	000
	176	;.19992619
	114
	271
	163
	177	;.-33333073
	252
	252
	123
	201	;1.0
	000
	000
	000>

IFN	ADDPRC,<
ATNCON: 13	;DEGREE-1.
	166	; -.0006847939119
	263
	203
	275
	323
	171	; .004850942156
	036
	364
	246
	365
	173	; -.01611170184
	203
	374
	260
	020
	174	; .03420963805
	014
	037
	147
	312
	174	; -.05427913276
	336
	123
	313
	301
	175	; .07245719654
	024
	144
	160
	114
	175	; -.08980239538
	267
	352
	121
	172
	175	; .1109324134
	143
	060
	210
	176
	176	; -.1428398077
	222
	104
	231
	072
	176	; .1999991205
	114
	314
	221
	307
	177	; -.3333333157
	252
	252
	252
	023
	201	; 1.0
	000
	000
	000
	000>>
PAGE
SUBTTL	SYSTEM INITIALIZATION CODE.
RADIX	10		;IN ALL NON-MATH-PACKAGE CODE.
; THIS INITIALIZES THE BASIC INTERPRETER FOR THE M6502 AND SHOULD BE
; LOCATED WHERE IT WILL BE WIPED OUT IN RAM IF CODE IS ALL IN RAM.

IFE	ROMSW,<
	BLOCK	1>		;SO ZEROING AT TXTTAB DOESN'T PREVENT
				;RESTARTING INIT
INITAT: INC	CHRGET+7	;INCREMENT THE WHOLE TXTPTR.
	BNE	CHZGOT
	INC	CHRGET+8
CHZGOT: LDA	60000		;A LOAD WITH AN EXT ADDR.
	CMPI	":"		;IS IT A ":"?
	BCS	CHZRTS		;IT IS .GE. ":"
	CMPI	" "		;SKIP SPACES.
	BEQ	INITAT
	SEC
	SBCI	"0"		;ALL CHARS .GT. "9" HAVE RET'D SO
	SEC
	SBCI	^D256-"0"		;SEE IF NUMERIC.
				;TURN CARRY ON IF NUMERIC.
				;ALSO, SETZ IF NULL.
CHZRTS: RTS			;RETURN TO CALLER.

	128			;LOADED OR FROM ROM.
	79			;THE INITIAL RANDOM NUMBER.
	199
	82
IFN	ADDPRC,<88>
IFN REALIO-3,<
IFE	KIMROM,<
TYPAUT: LDWDI	AUTTXT
	JSR	STROUT>>
INIT:
IFN	REALIO-3,<
	LDXI	255		;MAKE IT LOOK DIRECT IN CASE OF
	STX	CURLIN+1>	;ERROR MESSAGE.
IFN	STKEND-511,<
	LDXI	STKEND-256>
	TXS
IFN	REALIO-3,<
	LDWDI	INIT		;ALLOW RESTART.
	STWD	START+1
	STWD	RDYJSR+1	;RTS HERE ON ERRORS.
	LDWDI	AYINT
	STWD	ADRAYI
	LDWDI	GIVAYF
	STWD	ADRGAY>
	LDAI	76		;JMP INSTRUCTION.
IFE	REALIO,<HRLI 1,^O1000>	;MAKE AN INST.
IFN	REALIO-3,<
	STA	START
	STA	RDYJSR>
	STA	JMPER
IFN	ROMSW,<
	STA	USRPOK
	LDWDI	FCERR
	STWD	USRPOK+1>
	LDAI	LINLEN		;THESE MUST BE NON-ZERO SO CHEAD WILL
	STA	LINWID		;WORK AFTER MOVING A NEW LINE IN BUF
				;INTO THE PROGRAM
	LDAI	NCMPOS
	STA	NCMWID
	LDXI	RNDX+4-CHRGET
MOVCHG: LDA	INITAT-1,X,
	STA	CHRGET-1,X,	;MOVE TO RAM.
	DEX
	BNE	MOVCHG
	LDAI	STRSIZ
	STA	FOUR6
	TXA			;SET CONST IN RAM.
	STA	BITS
IFN EXTIO,<
	STA	CHANNL>
	STA	LASTPT+1
IFN	NULCMD,<
	STA	NULCNT>
	PHA			;PUT ZERO AT THE END OF THE STACK
				;SO FNDFOR WILL STOP
IFN	REALIO,<
	STA	CNTWFL>		;BE TALKATIVE.
IFN	BUFPAG,<
	INX			;MAKE [X]=1
	STX	BUF-3		;SET PRE-BUF BYTES NON-ZERO FOR CHEAD
	STX	BUF-4>
IFN	REALIO-3,<
	JSR	CRDO>		;TYPE A CR.
	LDXI	TEMPST
	STX	TEMPPT		;SET UP STRING TEMPORARIES.
IFN	REALIO!LONGI,<
IFN	REALIO-3,<
	LDWDI	MEMORY
	JSR	STROUT
	JSR	QINLIN		;GET A LINE OF INPUT.
	STXY	TXTPTR		;READ THIS !
	JSR	CHRGET		;GET THE FIRST CHARACTER.
IFE	KIMROM,<
	CMPI	"A"		;IS IT AN "A"?
	BEQ	TYPAUT>		;YES TYPE AUTHOR'S NAME.
	TAY			;NULL INPUT?
	BNE	USEDE9>		;NO.
IFE	REALIO-3,<
	LDYI	RAMLOC/^D256>
IFN	REALIO-3,<
IFE	ROMSW,<
	LDWDI	LASTWR>		;YES GET PNTR TO LAST WORD.
IFN	ROMSW,<
	LDWDI	RAMLOC>>
IFN	ROMSW,<
	STWD	TXTTAB>		;SET UP START OF PROGRAM LOCATION
	STWD	LINNUM
IFE	REALIO-3,<
	TAY>
IFN	REALIO-3,<
	LDYI	0>
LOOPMM: INC	LINNUM
	BNE	LOOPM1
	INC	LINNUM+1
IFE	REALIO-3,<
	BMI	USEDEC>
LOOPM1: LDAI	85		;PUT RANDOM INFO INTO MEM.
	STADY	LINNUM
	CMPDY	LINNUM		;WAS IT SAVED?
	BNE	USEDEC		;NO. THAT IS END OF MEMORY.
	ASL	A,		;LOOKS LIKE IT. TRY ANOTHER.
	STADY	LINNUM
	CMPDY	LINNUM		;WAS IT SAVED?
IFN	REALIO-3,<
	BNE	USEDEC>		;NO. THIS IS THE END.
IFN	REALIO-2,<
	BEQ	LOOPMM>
IFE	REALIO-2,<
	BNE	USEDEC
	CMP	0		;SEE IF HITTING PAGE 0
	BNE	LOOPMM
	LDAI	76
	STA	0
	BNEA	USEDEC>
IFN	REALIO-3,<
USEDE9: JSR	CHRGOT		;GET CURRENT CHARACTER.
	JSR	LINGET		;GET DECIMAL ARGUMENT.
	TAY			;MAKE SURE A TERMINATOR EXISTS.
	BEQ	USEDEC		;IT DOES.
	JMP	SNERR>		;IT DOESN'T.
USEDEC: LDWD	LINNUM		;GET SIZE OF MEMORY INPUT.
USEDEF: >			;HIGHEST ADDRESS.
IFE	REALIO!LONGI,<
	LDWDI	16190>		;A STRANGE NUMBER.
	STWD	MEMSIZ		;THIS IS THE SIZE OF MEMORY.
	STWD	FRETOP		;TOP OF STRINGS TOO.
TTYW:
IFN	REALIO-3,<
IFN	REALIO!LONGI,<
	LDWDI	TTYWID
	JSR	STROUT
	JSR	QINLIN		;GET LINE OF INPUT.
	STXY	TXTPTR		;READ THIS !
	JSR	CHRGET		;GET FIRST CHARACTER.
	TAY			;TEST ACCA BUT DON'T AFFECT CARRY.
	BEQ	ASKAGN
	JSR	LINGET		;GET ARGUMENT.
	LDA	LINNUM+1
	BNE	TTYW		;WIDTH MUST BE .LT. 256.
	LDA	LINNUM
	CMPI	16		;WIDTH MUST BE GREATER THAN 16.
	BCC	TTYW
	STA	LINWID		;THAT IS THE LINE WIDTH.
MORCPS: SBCI	CLMWID		;COMPUTE POSITION BEYOND WHICH
	BCS	MORCPS		;THERE ARE NO MORE FIELDS.
	EORI	255
	SBCI	CLMWID-2
	CLC
	ADC	LINWID
	STA	NCMWID>
ASKAGN:
IFE	ROMSW,<
IFN	REALIO!LONGI,<
	LDWDI	FNS
	JSR	STROUT
	JSR	QINLIN
	STXY	TXTPTR		;READ THIS !
	JSR	CHRGET
	LDXYI	INITAT		;DEFAULT.
	CMPI	"Y"
	BEQ	HAVFNS		;SAVE ALL FUNCTIONS.
	CMPI	"A"
	BEQ	OKCHAR		;SAVE ALL BUT ATN.
	CMPI	"N"
	BNE	ASKAGN		;BAD INPUT.
				;SAVE NOTHING.
OKCHAR: LDXYI	FCERR
	STXY	ATNFIX		;GET RID OF ATN FUNCTION.
	LDXYI	ATN		;UNTIL WE KNOW THAT WE SHOULD DEL MORE.
	CMPI	"A"
	BEQ	HAVFNS		;JUST GET RID OF ATN.
	LDXYI	FCERR
	STXY	COSFIX		;GET RID OF THE REST.
	STXY	TANFIX
	STXY	SINFIX
	LDXYI	COS		;AND GET RID OF ALL BACK TO "COS".
HAVFNS:>
IFE	REALIO!LONGI,<
	LDXYI	INITAT-1>>>	;GET RID OF ALL UP TO "INITAT".
IFN	ROMSW,<
	LDXYI	RAMLOC
	STXY	TXTTAB>
	LDYI	0
	TYA
	STADY	TXTTAB		;SET UP TEXT TABLE.
	INC	TXTTAB
IFN	REALIO-3,<
	BNE	QROOM
	INC	TXTTAB+1>
QROOM:	LDWD	TXTTAB		;PREPARE TO USE "REASON".
	JSR	REASON
IFE	REALIO-3,<
	LDWDI	FREMES
	JSR	STROUT>
IFN	REALIO-3,<
	JSR	CRDO>
	LDA	MEMSIZ		;COMPUTE [MEMSIZ]-[VARTAB].
	SEC
	SBC	TXTTAB
	TAX
	LDA	MEMSIZ+1
	SBC	TXTTAB+1
	JSR	LINPRT		;TYPE THIS VALUE.
	LDWDI	WORDS		;MORE BULLSHIT.
	JSR	STROUT
	JSR	SCRTCH		;SET UP EVERYTHING ELSE.
IFE	REALIO-3,<
	JMP	READY>
IFN	REALIO-3,<
	LDWDI	STROUT
	STWD	RDYJSR+1
	LDWDI	READY
	STWD	START+1
	JMPD	START+1

IFE	ROMSW,<
FNS:	DT"WANT SIN-COS-TAN-ATN"
	0>
IFE	KIMROM,<
AUTTXT: ACRLF
	12			;ANOTHER LINE FEED.
	DT"WRITTEN "
	DT"BY WEILAND & GATES"
	ACRLF
	0>
MEMORY: DT"MEMORY SIZE"
	0
TTYWID:
IFE	KIMROM,<
	DT"TERMINAL ">
	DT"WIDTH"
	0>
WORDS:	DT" BYTES FREE"
IFN	REALIO-3,<
	ACRLF
	ACRLF>
IFE	REALIO-3,<
	EXP	^O15
	0
FREMES: >
IFE REALIO,<	DT"SIMULATED BASIC FOR THE 6502 V1.1">
IFE REALIO-1,<	DT"KIM BASIC V1.1">
IFE REALIO-2,<	DT"OSI 6502 BASIC VERSION 1.1">
IFE REALIO-3,<	DT"### COMMODORE BASIC ###"
	EXP	^O15
	EXP	^O15>
IFE	REALIO-4,<DT"APPLE BASIC V1.1">
IFE	REALIO-5,<DT"STM BASIC V1.1">
IFN	REALIO-3,<
	ACRLF
	DT"COPYRIGHT 1978 MICROSOFT"
	ACRLF>
	0
LASTWR::
	BLOCK	100		;SPACE FOR TEMP STACK.
IFE REALIO,<
TSTACK::BLOCK	13600>

IF2,<
	PURGE	A,X,Y>
IFNDEF	START,<START==0>
	END	$Z+START