w9TLUwJg

1TITLE	BASIC M6502 8K VER 1.1 BY MICRO-SOFT
2SEARCH	M6502
3SALL
4RADIX 10			;THROUGHOUT ALL BUT MATH-PAK.
5
6$Z::				;STARTING POINT FOR M6502 SIMULATOR
7	ORG	0		;START OFF AT LOCATION ZERO.
8SUBTTL	SWITCHES,MACROS.
9
10REALIO=4			;5=STM
11				;4=APPLE.
12				;3=COMMODORE.
13				;2=OSI
14				;1=MOS TECH,KIM
15				;0=PDP-10 SIMULATING 6502
16INTPRC==1			;INTEGER ARRAYS.
17ADDPRC==1			;FOR ADDITIONAL PRECISION.
18LNGERR==0			;LONG ERROR MESSAGES.
19TIME==	0			;CAPABILITY TO SET AND READ A CLK.
20EXTIO== 0			;EXTERNAL I/O.
21DISKO== 0			;SAVE AND LOAD COMMANDS
22NULCMD==1			;FOR THE "NULL" COMMAND
23GETCMD==1
24RORSW==1
25ROMSW==1			;TELLS IF THIS IS ON ROM.
26CLMWID==14
27LONGI==1			;LONG INITIALIZATION SWITCH.
28STKEND=511
29BUFPAG==0
30LINLEN==72			;TERMINAL LINE LENGTH.
31BUFLEN==72			;INPUT BUFFER SIZE.
32ROMLOC= ^O20000			;ADDRESS OF START OF PURE SEGMENT.
33KIMROM=1
34IFE	ROMSW,<KIMROM==0>
35IFN	REALIO-1,<KIMROM==0>
36IFN	ROMSW,<
37RAMLOC= ^O40000			;USED ONLY IF ROMSW=1
38IFE	REALIO,<ROMLOC= ^O20000 ;START AT 8K.
39	RAMLOC=^O1400>>
40IFE	REALIO-3,<
41	DISKO==1
42	RAMLOC==^O2000
43	ROMLOC=^O140000
44	NULCMD==0
45	GETCMD==1
46	linlen==40
47	BUFLEN==81
48	CQOPEN=^O177700
49	CQCLOS=^O177703
50	CQOIN= ^O177706		;OPEN CHANNEL FOR INPUT
51	CQOOUT=^O177711		;FILL FOR COMMO.
52	CQCCHN=^O177714
53	CQINCH=^O177717		;INCHR'S CALL TO GET A CHARACTER
54	OUTCH= ^O177722
55	CQLOAD=^O177725
56	CQSAVE=^O177730
57	CQVERF=^O177733
58	CQSYS= ^O177736
59	ISCNTC=^O177741
60	CZGETL=^O177744		;CALL POINT FOR "GET"
61	CQCALL=^O177747		;CLOSE ALL CHANNELS
62	CQTIMR=^O215
63	BUFPAG==2
64	BUF==256*BUFPAG
65	STKEND==507
66	CQSTAT=^O226
67	CQHTIM=^O164104
68	EXTIO==1
69	TIME==1
70	GETCMD==1
71	CLMWID==10
72	PI=255				;VALUE OF PI CHARACTER FOR COMMODORE.
73	ROMSW==1
74	RORSW==1
75	TRMPOS=^O306>
76IFE	REALIO-1,<GETCMD==1
77	DISKO==1
78	OUTCH=^O17240			;1EA0
79	ROMLOC==^O20000
80	RORSW==0
81	CZGETL=^O17132>
82IFE	REALIO-2,<
83	RORSW==0
84	RAMLOC==^O1000
85IFN	ROMSW,<
86	RORSW==0
87	RAMLOC==^O100000>
88	OUTCH==^O177013>
89IFE	REALIO-4,<
90	RORSW==1
91	NULCMD==0
92	GETCMD==1
93	CQINLN==^O176547
94	CQPRMP==^O63
95	CQINCH==^O176414
96	CQCOUT==^O177315
97	CQCSIN==^O177375
98	BUFPAG==2
99	BUF=BUFPAG*256
100	ROMLOC=^O4000
101	RAMLOC=^O25000			;PAGE 2A
102	OUTCH=^O176755
103	CZGETL=^O176414
104	LINLEN==40
105	BUFLEN==240
106	RORSW==1
107	STKEND=507>
108IFE	RORSW,<
109DEFINE	ROR (WD),<
110	LDAI	0
111	BCC	.+4
112	LDAI	^O200
113	LSR	WD
114	ORA	WD
115	STA	WD>>
116
117DEFINE ACRLF,<
118	13
119	10>
120DEFINE	SYNCHK	(Q),<
121	LDAI	<Q>
122	JSR	SYNCHR>
123DEFINE	DT(Q),<
124IRPC	Q,<IFDIF <Q><">,<EXP "Q">>>
125DEFINE	LDWD	(WD),<
126	LDA	WD
127	LDY	<WD>+1>
128DEFINE	LDWDI	(WD),<
129	LDAI	<<WD>&^O377>
130	LDYI	<<WD>/^O400>>
131DEFINE	LDWX	(WD),<
132	LDA	WD
133	LDX	<WD>+1>
134DEFINE	LDWXI	(WD),<
135	LDAI	<<WD>&^O377>
136	LDXI	<<WD>/^O400>>
137DEFINE	LDXY	(WD),<
138	LDX	WD
139	LDY	<WD>+1>
140DEFINE	LDXYI	(WD),<
141	LDXI	<<WD>&^O377>
142	LDYI	<<WD>/^O400>>
143DEFINE	STWD	(WD),<
144	STA	WD
145	STY	<WD>+1>
146DEFINE	STWX	(WD),<
147	STA	WD
148	STX	<WD>+1>
149DEFINE	STXY	(WD),<
150	STX	WD
151	STY	<WD>+1>
152DEFINE	CLR	(WD),<
153	LDAI	0
154	STA	WD>
155DEFINE	COM	(WD),<
156	LDA	WD
157	EORI	^O377
158	STA	WD>
159DEFINE	PULWD	(WD),<
160	PLA
161	STA	WD
162	PLA
163	STA	<WD>+1>
164DEFINE	PSHWD	(WD),<
165	LDA	<WD>+1
166	PHA
167	LDA	WD
168	PHA>
169DEFINE	JEQ	(WD),<
170	BNE	.+5
171	JMP	WD>
172DEFINE	JNE	(WD),<
173	BEQ	.+5
174	JMP	WD>
175DEFINE	BCCA(Q),<	BCC	Q>	;BRANCHES THAT ALWAYS BRANCH
176DEFINE	BCSA(Q),<	BCS	Q>	;THESE ARE USED ON THE 6502 BECAUSE
177DEFINE	BEQA(Q),<	BEQ	Q>	;THERE IS NO UNCONDITIONAL BRANCH
178DEFINE	BNEA(Q),<	BNE	Q>
179DEFINE	BMIA(Q),<	BMI	Q>
180DEFINE	BPLA(Q),<	BPL	Q>
181DEFINE	BVCA(Q),<	BVC	Q>
182DEFINE	BVSA(Q),<	BVS	Q>
183DEFINE	INCW(R),<
184	INC	R
185	BNE	%Q
186	INC	R+1
187%Q:>
188DEFINE	SKIP1,	<XWD ^O1000,^O044>	;BIT ZERO PAGE TRICK.
189DEFINE	SKIP2,	<XWD ^O1000,^O054>	;BIT ABS TRICK.
190IF1,<
191IFE	REALIO,<PRINTX/SIMULATE/>
192IFE	REALIO-1,<PRINTX KIM>
193IFE	REALIO-2,<PRINTX OSI>
194IFE	REALIO-3,<PRINTX COMMODORE>
195IFE	REALIO-4,<PRINTX APPLE>
196IFE	REALIO-5,<PRINTX STM>
197IFN	ADDPRC,<PRINTX ADDITIONAL PRECISION>
198IFN	INTPRC,<PRINTX INTEGER ARRAYS>
199IFN	LNGERR,<PRINTX LONG ERRORS>
200IFN	DISKO,<PRINTX SAVE AND LOAD>
201IFE	ROMSW,<PRINTX RAM>
202IFN	ROMSW,<PRINTX ROM>
203IFE	RORSW,<PRINTX NO ROR>
204IFN	RORSW,<PRINTX ROR ASSUMED>>
205PAGE
206SUBTTL	INTRODUCTION AND COMPILATION PARAMETERS.
207COMMENT *
208
209--------- ---- -- ---------
210COPYRIGHT 1976 BY MICROSOFT
211--------- ---- -- ---------
2127/27/78 FIXED BUG WHERE FOR VARIABLE AT BYTE FF MATCHED RETURN SEARCHING
213	FOR GOSUB ENTRY ON STACK IN FNDFOR CALL BY CHANGING STA FORPNT
214	TO STA FORPNT+1. THIS IS A SERIOUS BUG IN ALL VERSIONS.
2157/27/78 FIXED BUG AT NEWSTT UNDER IFN BUFPAG WHEN CHECK OF CURLIN
216	WAS DONE BEFORE CURLIN SET UP SO INPUT RETRIES OF FIRST STATEMENT
217	WAS GIVING SYNTAX ERROR INSTEAD OF REDO FROM START (CODE WAS 12/1/77 FIX)
2187/1/78	SAVED A FEW BYTES IN INIT FOR COMMODORE (14)
2197/1/78 FIXED BUG WHERE REPLACING A LINE OVERFLOWING MEMORY LEFT LINKS
220	IN A BAD STATE. (CODE AT NODEL AND FINI) BUG#4
2217/1/78 FIXED BUG WHERE GARBAGE COLLECTION NEVER(!) COLLECTS TEMPS
222	(STY GRBPNT  AT FNDVAR, LDA GRBPNT ORA GRBPNT+1 AT GRBPAS)
223	THIS WAS COMMODORE BUG #2
2247/1/78 FIXED BUG WHERE DELETE/INSERT OF LINE COULD CAUSE A GARBAGE COLLECTION WITH BAD VARTAB IF OUT OF MEMORY
225	 (LDWD MEMSIZ STWD FRETOP=JSR RUNC CLC ALSO AT NODEL)
2263/9/78 EDIT TO FIX COMMO TRMPOS AND CHANGE LEFT$ AND RIGHT$ TO ALLOW A SECOND ARGUMENT OF 0 AND RETURN A NULL STRING
2272/25/78 FIXED BUG THAT INPFLG WAS SET WRONG WHEN BUFPAG.NE.0
228	INCREASED NUMLEV FROM 19 TO 23
2292/11/78 DISALLOWED SPACES IN RESERVED WORDS. PUT IN SPECIAL CHECK FOR "GO TO"
2302/11/78 FIXED BUG WHERE ROUNDING OF THE FAC BEFORE PUSHING COULD CAUSE A STRING POINTER
231	IN THE FAC TO BE INCREMENTED
2321/24/78 fixed problem where user defined function undefined check fix was smashing error number in [x]
23312/1/77 FIXED PROBLEM WHERE PEEK WAS SMASHING (POKER) CAUSING POKE OF PEEK TO FAIL
23412/1/77 FIXED PROBLEM WHERE PROBLEM WITH VARTXT=LINNUM=BUF-2 CAUSING BUF-1 COMMA TO DISAPPEAR
23512/1/77 FIXED BUFPAG.NE.0 PROBLEM AT NEWSTT AND STOP : CODE WAS STILL
236	ASSUMING TXTPTR+1.EQ.0 IFF STATEMENT WAS DIRECT
237*
238NUMLEV==23			;NUMBER OF STACK LEVELS RESERVED
239				;BY AN EXPLICIT CALL TO "GETSTK".
240STRSIZ==3			;# OF LOCS PER STRING DESCRIPTOR.
241NUMTMP==3			;NUMBER OF STRING TEMPORARIES.
242CONTW==15			;CHARACTER TO SUPPRESS OUTPUT.
243
244PAGE
245SUBTTL	SOME EXPLANATION.
246COMMENT *
247
248M6502 BASIC CONFIGURES BASIC AS FOLLOWS
249
250LOW LOCATIONS
251	PAGE	ZERO
252
253		STARTUP:
254		INITIALLY A JMP TO INITIALIZATION CODE BUT
255		CHANGED TO A JMP TO "READY".
256		RESTARTING THE MACHINE AT LOC 0 DURING PROGRAM
257		EXECUTION CAN LEAVE THINGS MESSED UP.
258
259		LOC OF FAC TO INTEGER AND INTEGER TO FAC 
260		ROUTINES.
261
262		"DIRECT" MEMORY:
263		THESE ARE THE MOST COMMONLY USED LOCATIONS.
264		THEY HOLD BOOKKEEPING INFO AND ALL OTHER
265		FREQUENTLY USED INFORMATION.
266		ALL TEMPORARIES, FLAGS, POINTERS, THE BUFFER AREA,
267		THE FLOATING ACCUMULATOR, AND ANYTHING ELSE THAT
268		IS USED TO STORE A CHANGING VALUE SHOULD BE LOCATED
269		IN THIS AREA. CARE MUST BE MADE IN MOVING LOCATIONS
270		IN THIS AREA SINCE THE JUXTAPOSITION OF TWO LOCATIONS
271		IS OFTEN DEPENDED UPON.
272
273		STILL IN RAM WE HAVE THE BEGINNING OF THE "CHRGET"
274		SUBROUTINE. IT IS HERE SO [TXTPTR] CAN BE THE
275		EXTENDED ADDRESS OF A LOAD INSTRUCTION.
276		THIS SAVES HAVING TO BOTHER ANY REGISTERS.
277
278	PAGE	ONE
279		THE STACK.
280
281	STORAGE PAGE TWO AND ON
282		IN RAM VERSIONS THESE DATA STRUCTURES COME AT THE
283		END OF BASIC. IN ROM VERSON THEY ARE AT RAMLOC WHICH
284		CAN EITHER BE ABOVE OR BELOW ROMLOC, WHICH IS WHERE
285		BASIC ITSELF RESIDES.
286
287				A ZERO.
288		[TXTTAB]	POINTER TO NEXT LINE'S POINTER.
289				LINE # OF THIS LINE (2 BYTES).
290				CHARACTERS ON THIS LINE.
291				ZERO.
292				POINTER AT NEXT LINE'S POINTER
293					(POINTED TO BY THE ABOVE POINTER).
294				... REPEATS ...
295		LAST LINE:	POINTER AT ZERO POINTER.
296				LINE # OF THIS LINE.
297				CHARACTERS ON THIS LINE.
298				ZERO.
299				DOUBLE ZERO (POINTED TO BY THE ABOVE POINTER).
300		[VARTAB]	SIMPLE VARIABLES. 6 BYTES PER VALUE.
301				2 BYTES GIVE THE NAME, 4 BYTES THE VALUE.
302				... REPEATS ...
303		[ARYTAB]	ARRAY VARIABLES. 2 BYTES NAME, 2 BYTE
304				LENGTH, NUMBER OF DIMENSIONS , EXTENT OF
305				EACH DIMENSION (2BYTES/), VALUES
306				... REPEATS ...
307		[STREND]	FREE SPACE.
308				... REPEATS ...
309		[FRETOP]	STRING SPACE IN USE.
310				... REPEATS ...
311		[MEMSIZ]	HIGHEST MACHINE LOCATION.
312				UNUSED EXCEPT BY THE VAL FUNCTION.
313
314		ROM -- CONSTANTS AND CODE.
315
316	FUNCTION DISPATCH ADDRESSES (AT ROMLOC)
317		"FUNDSP" CONTAINS THE ADDRESSES OF THE
318		FUNCTION ROUTINES IN THE ORDER OF THE
319		FUNCTION NAMES IN THE CRUNCH LIST.
320		THE FUNCTIONS THAT TAKE MORE THAN ONE ARGUMENT
321		ARE AT THE END. SEE THE EXPLANATION AT "ISFUN".
322
323	THE OPERATOR LIST
324		THE "OPTAB" LIST CONTAINS AN OPERATOR'S PRECEDENCE
325		FOLLOWED BY THE ADDRESS OF THE ROUTINE TO PERFORM
326		THE OPERATION. THE INDEX INTO THE
327		OPERATOR LIST IS MADE BY SUBTRACTING OFF THE CRUNCH VALUE
328		OF THE LOWEST NUMBERED OPERATOR. THE ORDER
329		OF OPERATORS IN THE CRUNCH LIST AND IN "OPTAB" IS IDENTICAL.
330		THE PRECEDENCES ARE ARBITRARY EXCEPT FOR THEIR
331		COMPARATIVE SIZES. NOTE THAT THE PRECEDENCE FOR
332		UNARY OPERATORS SUCH AS "NOT" AND NEGATION ARE
333		SETUP SPECIALLY WITHOUT USING THE LIST.
334
335	THE RESERVED WORD OR CRUNCH LIST
336		WHEN A COMMAND OR PROGRAM LINE IS TYPED IN
337		IT IS STORED IN "BUF". AS SOON AS THE WHOLE LINE
338		HAS BEEN TYPED IN ("INLIN" RETURNS) "CRUNCH" IS
339		CALLED TO CONVERT ALL RESERVED WORDS TO THEIR
340		CRUNCHED VALUES. THIS REDUCES THE SIZE OF THE 
341		PROGRAM AND SPEEDS UP EXECUTION BY ALLOWING
342		LIST DISPATCHES TO PERFORM FUNCTIONS, STATEMENTS,
343		AND OPERATIONS. THIS IS BECAUSE ALL THE STATEMENT
344		NAMES ARE STORED CONSECUTIVELY IN THE CRUNCH LIST.
345		WHEN A MATCH IS FOUND BETWEEN A STRING
346		OF CHARACTERS AND A WORD IN THE CRUNCH LIST
347		THE ENTIRE TEXT OF THE MATCHED WORD IS TAKEN OUT OF
348		THE INPUT LINE AND A RESERVED WORD TOKEN IS PUT
349		IN ITS PLACE. A RESERVED WORD TOKEN IS ALWAYS EQUAL
350		TO OCTAL 200 PLUS THE POSITION OF THE MATCHED WORD
351		IN THE CRUNCH LIST.
352
353	STATEMENT DISPATCH ADDRESSES
354		WHEN A STATEMENT IS TO BE EXECUTED, THE FIRST
355		CHARACTER OF THE STATEMENT IS EXAMINED
356		TO SEE IF IT IS LESS THAN THE RESERVED
357		WORD TOKEN FOR THE LOWEST NUMBERED STATEMENT NAME.
358		IF SO, THE "LET" CODE IS CALLED TO
359		TREAT THE STATEMENT AS AN ASSIGNMENT STATEMENT.
360		OTHERWISE A CHECK IS MADE TO MAKE SURE THE
361		RESERVED WORD NUMBER IS NOT TOO LARGE TO BE A
362		STATEMENT TYPE NUMBER. IF NOT THE ADDRESS
363		TO DISPATCH TO IS FETCHED FROM "STMDSP" (THE STATEMENT
364		DISPATCH LIST) USING THE RESERVED WORD
365		NUMBER FOR THE STATEMENT TO CALCULATE AN INDEX INTO
366		THE LIST.
367
368	ERROR MESSAGES
369		WHEN AN ERROR CONDITION IS DETECTED,
370		[ACCX] MUST BE SET UP TO INDICATE WHICH ERROR
371		MESSAGE IS APPROPRIATE AND A BRANCH MUST BE MADE
372		TO "ERROR". THE STACK WILL BE RESET AND ALL
373		PROGRAM CONTEXT WILL BE LOST. VARIABLES
374		VALUES AND THE ACTUAL PROGRAM REMAIN INTACT.
375		ONLY THE VALUE OF [ACCX] IS IMPORTANT WHEN
376		THE BRANCH IS MADE TO ERROR. [ACCX] IS USED AS AN
377		INDEX INTO "ERRTAB" WHICH GIVES THE TWO
378		CHARACTER ERROR MESSAGE THAT WILL BE PRINTED ON THE
379		USER'S TERMINAL.
380
381
382	TEXTUAL MESSAGES
383		CONSTANT MESSAGES ARE STORED HERE. UNLESS
384		THE CODE TO CHECK IF A STRING MUST BE COPIED
385		IS CHANGED THESE STRINGS MUST BE STORED ABOVE
386		PAGE ZERO, OR ELSE THEY WILL BE COPIED BEFORE
387		THEY ARE PRINTED.
388
389	FNDFOR	
390		MOST SMALL ROUTINES ARE FAIRLY SIMPLE
391		AND ARE DOCUMENTED IN PLACE. "FNDFOR" IS
392		USED FOR FINDING "FOR" ENTRIES ON
393		THE STACK. WHENEVER A "FOR" IS EXECUTED, A
394		16-BYTE ENTRY IS PUSHED ONTO THE STACK.
395		BEFORE THIS IS DONE, HOWEVER, A CHECK
396		MUST BE MADE TO SEE IF THERE
397		ARE ANY "FOR" ENTRIES ALREADY ON THE STACK
398		FOR THE SAME LOOP VARIABLE. IF SO, THAT "FOR" ENTRY
399		AND ALL OTHER "FOR" ENTRIES THAT WERE MADE AFTER IT
400		ARE ELIMINATED FROM THE STACK. THIS IS SO A
401		PROGRAM THAT JUMPS OUT OF THE MIDDLE
402		OF A "FOR" LOOP AND THEN RESTARTS THE LOOP AGAIN
403		AND AGAIN WON'T USE UP 18 BYTES OF STACK
404		SPACE EVERY TIME. THE "NEXT" CODE ALSO
405		CALLS "FNDFOR" TO SEARCH FOR A "FOR" ENTRY WITH
406		THE LOOP VARIABLE IN
407		THE "NEXT". AT WHATEVER POINT A MATCH IS FOUND
408		THE STACK IS RESET. IF NO MATCH IS FOUND A
409		"NEXT WITHOUT FOR"  ERROR OCCURS. GOSUB EXECUTION
410		ALSO PUTS A 5-BYTE ENTRY ON STACK.
411		WHEN A RETURN IS EXECUTED "FNDFOR" IS
412		CALLED WITH A VARIABLE POINTER THAT CAN'T
413		BE MATCHED. WHEN "FNDFOR" HAS RUN
414		THROUGH ALL THE "FOR" ENTRIES ON THE STACK  
415		IT RETURNS AND THE RETURN CODE MAKES
416		SURE THE ENTRY THAT WAS STOPPED
417		ON IS A GOSUB ENTRY. THIS ASSURES THAT
418		IF YOU GOSUB TO A SECTION OF CODE
419		IN WHICH A FOR LOOP IS ENTERED BUT NEVER
420		EXITED THE RETURN WILL STILL BE
421		ABLE TO FIND THE MOST RECENT
422		GOSUB ENTRY. THE "RETURN" CODE ELIMINATES THE
423		"GOSUB" ENTRY AND ALL "FOR" ENTRIES MADE AFTER
424		THE GOSUB ENTRY.
425
426	NON-RUNTIME STUFF
427		THE CODE TO INPUT A LINE, CRUNCH IT, GIVE ERRORS,
428		FIND A SPECIFIC LINE IN THE PROGRAM,
429		PERFORM A "NEW", "CLEAR", AND "LIST" ARE
430		ALL IN THIS AREA. GIVEN THE EXPLANATION OF
431		PROGRAM STORAGE SET FORTH ABOVE, THESE ARE
432		ALL STRAIGHTFORWARD.
433
434	NEWSTT
435		WHENEVER A STATEMENT FINISHES EXECUTION IT
436		DOES A "RTS" WHICH TAKES
437		EXECUTION BACK TO "NEWSTT". STATEMENTS THAT
438		CREATE OR LOOK AT SEMI-PERMANENT STACK ENTRIES
439		MUST GET RID OF THE RETURN ADDRESS OF "NEWSTT" AND
440		JMP TO "NEWSTT" WHEN DONE. "NEWSTT" ALWAYS
441		CHRGETS THE FIRST CHARACTER AFTER THE STATEMENT
442		NAME BEFORE DISPATCHING. WHEN RETURNING
443		BACK TO "NEWSTT" THE ONLY THING THAT
444		MUST BE SET UP IS THE TEXT POINTER IN
445		"TXTPTR". "NEWSTT" WILL CHECK TO MAKE SURE
446		"TXTPTR" IS POINTING TO A STATEMENT TERMINATOR.
447		IF A STATEMENT SHOULDN'T BE PERFORMED UNLESS
448		IT IS PROPERLY FORMATTED (I.E. "NEW") IT CAN
449		SIMPLY DO A RETURN AFTER READING ALL OF
450		ITS ARGUMENTS. SINCE THE ZERO FLAG
451		BEING OFF INDICATES THERE IS NOT
452		A STATEMENT TERMINATOR "NEWSTT" WILL
453		DO THE JMP TO THE "SYNTAX ERROR"
454		ROUTINE. IF A STATEMENT SHOULD BE STARTED
455		OVER IT CAN DO LDWD OLDTXT, STWD TXTPTR RTS SINCE THE TEXT PNTR
456		AT "NEWSTT" IS ALWAYS STORED IN "OLDTXT".
457		THE ^C CODE STORES [CURLIN] (THE
458		CURRENT LINE NUMBER) IN "OLDLIN" SINCE THE ^C CHECK
459		IS MADE BEFORE THE STATEMENT POINTED TO IS
460		EXECUTED. "STOP" AND "END" STORE THE TEXT POINTER
461		FROM "TXTPTR", WHICH POINTS AT THEIR TERMINATING
462		CHARACTER, IN "OLDTXT".
463
464	STATEMENT CODE
465		THE INDIVIDUAL STATEMENT CODE COMES
466		NEXT. THE APPROACH USED IN EXECUTING EACH
467		STATEMENT IS DOCUMENTED IN THE STATEMENT CODE
468		ITSELF.
469
470	FRMEVL, THE FORMULA EVALUATOR
471		GIVEN A TEXT POINTER POINTING TO THE STARTING
472		CHARACTER OF A FORMULA, "FRMEVL"
473		EVALUATES THE FORMULA AND LEAVES
474		THE VALUE IN THE FLOATING ACCUMULATOR (FAC).
475		"TXTPTR" IS RETURNED POINTING TO THE FIRST CHARACTER
476		THAT COULD NOT BE INTERPRETED AS PART OF THE
477		FORMULA. THE ALGORITHM USES THE STACK
478		TO STORE TEMPORARY RESULTS:
479
480			0. PUT A DUMMY PRECEDENCE OF ZERO ON
481				THE STACK.
482			1. READ LEXEME (CONSTANT,FUNCTION,
483				VARIABLE,FORMULA IN PARENS)
484				AND TAKE THE LAST PRECEDENCE VALUE
485				OFF THE STACK.
486			2. SEE IF THE NEXT CHARACTER IS AN OPERATOR.
487				IF NOT, CHECK PREVIOUS ONE. THIS MAY CAUSE
488				OPERATOR APPLICATION OR AN ACTUAL
489				RETURN FROM "FRMEVL".
490			3. IF IT IS, SEE WHAT PRECEDENCE IT HAS
491				AND COMPARE IT TO THE PRECEDENCE
492				OF THE LAST OPERATOR ON THE STACK.
493			4. IF = OR LESS REMEMBER THE OPERATOR
494				POINTER OF THIS OPERATOR
495				AND BRANCH TO "QCHNUM" TO CAUSE
496				APPLICATION OF THE LAST OPERATOR.
497				EVENTUALLY RETURN TO STEP 2
498				BY RETURNING TO JUST AFTER "DOPREC".
499			5. IF GREATER PUT THE LAST PRECEDENCE
500				BACK ON, SAVE THE OPERATOR ADDRESS,
501				CURRENT TEMPORARY RESULT,
502				AND PRECEDENCE AND RETURN TO STEP 1.
503
504		RELATIONAL OPERATORS ARE ALL HANDLED THROUGH
505		A COMMON ROUTINE. SPECIAL
506		CARE IS TAKEN TO DETECT TYPE MISMATCHES SUCH AS 3+"F".
507
508	EVAL -- THE ROUTINE TO READ A LEXEME
509		"EVAL" CHECKS FOR THE DIFFERENT TYPES OF
510		ENTITIES IT IS SUPPOSED TO DETECT.
511		LEADING PLUSES ARE IGNORED,
512		DIGITS AND "." CAUSE "FIN" (FLOATING INPUT)
513		TO BE CALLED. FUNCTION NAMES CAUSE THE
514		FORMULA INSIDE THE PARENTHESES TO BE EVALUATED
515		AND THE FUNCTION ROUTINE TO BE CALLED. VARIABLE
516		NAMES CAUSE "PTRGET" TO BE CALLED TO GET A POINTER
517		TO THE VALUE, AND THEN THE VALUE IS PUT INTO
518		THE FAC. AN OPEN PARENTHESIS CAUSES "FRMEVL"
519		TO BE CALLED (RECURSIVELY), AND THE ")" TO
520		BE CHECKED FOR. UNARY OPERATORS (NOT AND
521		NEGATION)  PUT THEIR PRECEDENCE ON THE STACK
522		AND ENTER FORMULA EVALUATION AT STEP 1, SO
523		THAT EVERYTHING UP TO AN OPERATOR GREATER THAN
524		THEIR PRECEDENCE OR THE END OF THE FORMULA
525		WILL BE EVALUATED.
526
527	DIMENSION AND VARIABLE SEARCHING
528		SPACE IS ALLOCATED FOR VARIABLES AS THEY ARE
529		ENCOUNTERED. THUS "DIM" STATEMENTS MUST BE
530		EXECUTED TO HAVE EFFECT. 6 BYTES ARE ALLOCATED
531		FOR EACH SIMPLE VARIABLE, WHETHER IT IS A STRING,
532		NUMBER OR USER DEFINED FUNCTION. THE FIRST TWO
533		BYTES GIVE THE NAME OF THE VARIABLE AND THE LAST FOUR
534		GIVE ITS VALUE. [VARTAB] GIVES THE FIRST LOCATION
535		WHERE A SIMPLE VARIABLE NAME IS FOUND AND [ARYTAB]
536		GIVES THE LOCATION TO STOP SEARCHING FOR SIMPLE
537		VARIABLES. A "FOR" ENTRY HAS A TEXT POINTER
538		AND A POINTER TO A VARIABLE VALUE SO NEITHER
539		THE PROGRAM OR THE SIMPLE VARIABLES CAN BE
540		MOVED WHILE THERE ARE ACTIVE "FOR" ENTRIES ON THE STACK.
541		USER DEFINED FUNCTION VALUES ALSO CONTAIN
542		POINTERS INTO SIMPLE VARIABLE SPACE SO NO USER-DEFINED
543		FUNCTION VALUES CAN BE RETAINED IF SIMPLE VARIABLES
544		ARE MOVED. ADDING A SIMPLE VARIABLE IS JUST
545		ADDING SIX TO [ARYTAB] AND [STREND], BLOCK TRANSFERING
546		THE ARRAY VARIABLES UP BY SIX AND MAKING SURE THE
547		NEW [STREND] IS NOT TOO CLOSE TO THE STRINGS.
548		THIS MOVEMENT OF ARRAY VARIABLES MEANS
549		THAT NO POINTER TO AN ARRAY WILL STAY VALID WHEN
550		NEW SIMPLE VARIABLES CAN BE ENCOUNTERED. THIS IS
551		WHY ARRAY VARIABLES ARE NOT ALLOWED FOR "FOR"
552		LOOP VARIABLES. SETTING UP A NEW ARRAY VARIABLE
553		MERELY INVOLVES BUILDING THE DESCRIPTOR,
554		UPDATING [STREND], AND MAKING SURE THERE IS
555		STILL ENOUGH ROOM BETWEEN [STREND] AND STRING SPACE.
556		"PTRGET", THE ROUTINE WHICH RETURNS A POINTER
557		TO A VARIABLE VALUE, HAS TWO IMPORTANT FLAGS. ONE IS
558		"DIMFLG" WHICH INDICATES WHETHER "DIM" CALLED "PTRGET"
559		OR NOT. IF SO, NO PRIOR ENTRY FOR THE VARIABLE IN
560		QUESTION SHOULD BE FOUND, AND THE INDEX INDICATES
561		HOW MUCH SPACE TO SET ASIDE. SIMPLE VARIABLES CAN
562		BE "DIMENSIONED", BUT THE ONLY EFFECT WILL BE TO
563		SET ASIDE SPACE FOR THE VARIABLE IF IT HASN'T BEEN
564		ENCOUNTERED YET. THE OTHER IMPORTANT FLAG IS "SUBFLG"
565		WHICH INDICATES WHETHER A SUBSCRIPTED VARIABLE SHOULD BE
566		ALLOWED IN THE CURRENT CONTEXT. IF [SUBFLG] IS NON-ZERO
567		THE OPEN PARENTHESIS FOR A SUBSCRIPTED VARIABLE
568		WILL NOT BE SCANNED BY "PTRGET", AND "PTRGET" WILL RETURN
569		WITH A TEXT POINTER POINTING TO THE "(", IF
570		THERE WAS ONE.
571	STRINGS
572		IN THE VARIABLE TABLES STRINGS ARE STORED JUST LIKE
573		NUMERIC VARIABLES. SIMPLE STRINGS HAVE THREE VALUE
574		BYTES WHICH ARE INITIALIZED TO ALL ZEROS (WHICH
575		REPRESENTS THE NULL STRING). THE ONLY DIFFERENCE
576		IN HANDLING IS THAT WHEN "PTRGET" SEES A "$" AFTER THE
577		NAME OF A VARIABLE, "PTRGET" SETS [VALTYP]
578		TO NEGATIVE ONE AND TURNS
579		ON THE MSB (MOST-SIGNIFIGANT-BIT) OF THE VALUE OF
580		THE FIRST CHARACTER OF THE VARIABLE NAME.
581		HAVING THIS BIT ON IN THE NAME OF THE VARIABLE ENSURES
582		THAT THE SEARCH ROUTINE WILL NOT MATCH
583		'A' WITH 'A$' OR 'A$' WITH 'A'. THE MEANING OF
584		THE THREE VALUE BYTES ARE:
585			LOW
586				LENGTH OF THE STRING
587				LOW 8 BITS
588				HIGH 8 BITS  OF THE ADDRESS
589					OF THE CHARACTERS IN THE
590					STRING IF LENGTH.NE.0.
591					MEANINGLESS OTHERWISE.
592			HIGH
593		THE VALUE OF A STRING VARIABLE (THESE 3 BYTES)
594		IS CALLED THE STRING DESCRIPTOR TO DISTINGUISH
595		IT FROM THE ACTUAL STRING DATA. WHENEVER A
596		STRING CONSTANT IS ENCOUNTERED IN A FORMULA OR AS
597		PART OF AN INPUT STRING, OR AS PART OF DATA, "STRLIT"
598		IS CALLED, CAUSING A DESCRIPTOR TO BE BUILT FOR
599		THE STRING. WHEN ASSIGNMENT IS MADE TO A STRING POINTING INTO
600		"BUF" THE VALUE IS COPIED INTO STRING SPACE SINCE [BUF]
601		IS ALWAYS CHANGING.
602
603		STRING FUNCTIONS AND THE ONE STRING OPERATOR "+"
604		ALWAYS RETURN THEIR VALUES IN STRING SPACE.
605		ASSIGNING A STRING A CONSTANT VALUE IN A PROGRAM
606		THROUGH A "READ" OR ASSIGNMENT STATEMENT
607		WILL NOT USE ANY STRING SPACE SINCE
608		THE STRING DESCRIPTOR  WILL POINT INTO THE
609		PROGRAM ITSELF. IN GENERAL, COPYING IS DONE
610		WHEN A STRING VALUE IS IN "BUF", OR IT IS IN STRING
611		SPACE AND THERE IS AN ACTIVE POINTER TO IT.
612		THUS F$=G$ WILL CAUSE COPYING IF G$ HAS ITS
613		STRING DATA IN STRING SPACE. F$=CHR$(7)
614		WILL USE ONE BYTE OF STRING SPACE TO STORE THE
615		NEW ONE CHARACTER STRING CREATED BY "CHR$", BUT
616		THE ASSIGNMENT ITSELF WILL CAUSE NO COPYING SINCE
617		THE ONLY POINTER AT THE NEW STRING IS A
618		TEMPORARY DESCRIPTOR CREATED BY "FRMEVL" WHICH WILL
619		GO AWAY AS SOON AS THE ASSIGNMENT IS DONE.
620		IT IS THE NATURE OF GARBAGE COLLECTION THAT
621		DISALLOWS HAVING TWO STRING DESCRIPTORS POINT TO THE SAME
622		AREA IN STRING SPACE. STRING FUNCTIONS AND OPERATORS
623		MUST PROCEED AS FOLLOWS:
624			1) FIGURE OUT THE LENGTH OF THEIR RESULT.
625
626			2) CALL "GETSPA" TO FIND SPACE FOR THEIR
627			RESULT. THE ARGUMENTS TO THE FUNCTION
628			OR OPERATOR MAY CHANGE SINCE GARBAGE COLLECTION
629			MAY BE INVOKED. THE ONLY THING THAT CAN
630			BE SAVED DURING THE CALL TO "GETSPA" IS A POINTER
631			TO THE DESCRIPTORS OF THE ARGUMENTS.
632			3) CONSTRUCT THE RESULT DESCRIPTOR IN "DSCTMP".
633			"GETSPA" RETURNS THE LOCATION OF THE AVAILABLE
634			SPACE.
635			4) CREATE THE NEW VALUE BY COPYING PARTS
636			OF THE ARGUMENTS OR WHATEVER.
637			5) FREE UP THE ARGUMENTS BY CALLING "FRETMP".
638			6) JUMP TO "PUTNEW" TO GET THE DESCRIPTOR IN
639			"DSCTMP" TRANSFERRED INTO A NEW STRING TEMPORARY.
640
641		THE REASON FOR STRING TEMPORARIES IS THAT GARBAGE
642		COLLECTION HAS TO KNOW ABOUT ALL ACTIVE STRING DESCRIPTORS
643		SO IT KNOWS WHAT IS AND ISN'T IN USE. STRING TEMPORARIES ARE
644		USED TO STORE THE DESCRIPTORS OF STRING EXPRESSIONS.
645		
646		INSTEAD OF HAVING AN ACTUAL VALUE STORED IN THE
647		FAC, AND HAVING THE VALUE OF A TEMPORARY RESULT
648		BEING SAVED ON THE STACK, AS HAPPENS WITH NUMERIC
649		VARIABLES, STRINGS HAVE THE POINTER TO A STRING DESCRIPTOR
650		STORED IN THE FAC, AND IT IS THIS POINTER
651		THAT GETS SAVED ON THE STACK BY FORMULA EVALUATION.
652		STRING FUNCTIONS CANNOT FREE THEIR ARGUMENTS UP RIGHT
653		AWAY SINCE "GETSPA" MAY FORCE
654		GARBAGE COLLECTION AND THE ARGUMENT STRINGS
655		MAY BE OVER-WRITTEN SINCE GARBAGE COLLECTION
656		WILL NOT BE ABLE TO FIND AN ACTIVE POINTER TO
657		THEM. FUNCTION AND OPERATOR RESULTS ARE BUILT IN
658		"DSCTMP" SINCE STRING TEMPORARIES ARE ALLOCATED
659		(PUTNEW) AND DEALLOCATED (FRETMP) IN A FIFO ORDERING
660		(I.E. A STACK) SO THE NEW TEMPORARY CANNOT
661		BE SET UP UNTIL THE OLD ONE(S) ARE FREED. TRYING
662		TO BUILD A RESULT IN A TEMPORARY AFTER
663		FREEING UP THE ARGUMENT TEMPORARIES COULD RESULT
664		IN ONE OF THE ARGUMENT TEMPORARIES BEING OVERWRITTEN
665		TOO SOON BY THE NEW RESULT.
666
667		STRING SPACE IS ALLOCATED AT THE VERY TOP
668		OF MEMORY. "MEMSIZ" POINTS BEYOND THE LAST LOCATION OF
669		STRING SPACE. STRINGS ARE STORED IN HIGH LOCATIONS
670		FIRST. WHENEVER STRING SPACE IS ALLOCATED (GETSPA).
671		[FRETOP], WHICH IS INITIALIZED TO [MEMSIZ], IS UPDATED
672		TO GIVE THE HIGHEST LOCATION IN STRING SPACE
673		THAT IS NOT IN USE. THE RESULT IS THAT
674		[FRETOP] GETS SMALLER AND SMALLER, UNTIL SOME
675		ALLOCATION WOULD MAKE [FRETOP] LESS THAN OR EQUAL TO
676		[STREND]. THIS MEANS STRING SPACE HAS RUN INTO THE
677		THE ARRAYS AND THAT GARBAGE COLLECTION MUST BE CALLED.
678
679		GARBAGE COLLECTION:
680			0. [MINPTR]=[STREND] [FRETOP]=[MEMSIZ]
681			1. [REMMIN]=0
682			2. FOR EACH STRING DESCRIPTOR
683			(TEMPORARIES, SIMPLE STRINGS, STRING ARRAYS)
684			IF THE STRING IS NOT NULL AND ITS POINTER IS
685			.GT.MINPTR AND .LT.FRETOP,
686			[MINPTR]=THIS STRING DESCRIPTOR'S POINTER,
687			[REMMIN]=POINTER AT THIS STRING DESCRIPTOR.
688			END.
689			3. IF REMMIN.NE.0 (WE FOUND AN UNCOLLECTED STRING),
690			BLOCK TRANSFER THE STRING DATA POINTED
691			TO IN THE STRING DESCRIPTOR POINTED TO BY "REMMIN"
692			SO THAT THE LAST BYTE OF STRING DATA IS AT
693			[FRETOP]. UPDATE [FRETOP] SO THAT IT
694			POINTS TO THE LOCATION JUST BELOW THE ONE
695			THE STRING DATA WAS MOVED INTO. UPDATE
696			THE POINTER IN THE DESCRIPTOR SO IT POINTS
697			TO THE NEW LOCATION OF THE STRING DATA.
698			GO TO STEP 1.
699
700		AFTER CALLING GARBAGE COLLECTION "GETSPA" AGAIN CHECKS
701		TO SEE IF [ACCA] CHARACTERS ARE AVAILABLE BETWEEN
702		[STREND] AND [FRETOP]; IF NOT, AN "OUT OF STRING"
703		ERROR IS INVOKED.
704
705	MATH PACKAGE
706		THE MATH PACKAGE CONTAINS FLOATING INPUT (FIN),
707		FLOATING OUTPUT (FOUT), FLOATING COMPARE (FCOMP)
708		... AND ALL THE NUMERIC OPERATORS AND FUNCTIONS.
709		THE FORMATS, CONVENTIONS AND ENTRY POINTS ARE ALL
710		DESCRIBED IN THE MATH PACKAGE ITSELF.
711
712	INIT -- THE INITIALIZATION ROUTINE
713		THE AMOUNT OF MEMORY,
714		TERMINAL WIDTH, AND WHICH FUNCTIONS TO BE RETAINED
715		ARE ASCERTAINED FROM THE USER. A ZERO IS PUT DOWN
716		AT THE FIRST LOCATION NOT USED BY THE MATH-PACKAGE
717		AND [TXTTAB] IS SET UP TO POINT AT THE NEXT LOCATION.
718		THIS DETERMINES WHERE PROGRAM STORAGE WILL START.
719		SPECIAL CHECKS ARE MADE TO MAKE SURE
720		ALL QUESTIONS IN "INIT" ARE ANSWERED REASONABLY, SINCE
721		ONCE "INIT" FINISHES, THE LOCATIONS IT USES ARE
722		USED FOR PROGRAM STORAGE. THE LAST THING "INIT" DOES IS
723		CHANGE LOCATION ZERO TO BE A JUMP TO "READY" INSTEAD
724		OF "INIT". ONCE THIS IS DONE THERE IS NO WAY TO RESTART
725		"INIT".
726HIGH LOCATIONS
727
728*
729PAGE
730SUBTTL	PAGE ZERO.
731IFN	REALIO-3,<
732START:	JMP	INIT		;INITIALIZE - SETUP CERTAIN LOCATIONS
733				;AND DELETE FUNCTIONS IF NOT NEEDED,
734				;AND CHANGE THIS TO "JMP READY"
735				;IN CASE USER RESTARTS AT LOC ZERO.
736RDYJSR: JMP	INIT		;CHANGED TO "JMP STROUT" BY "INIT"
737				;TO HANDLE ERRORS.
738ADRAYI: ADR(AYINT)		;STORE HERE THE ADDR OF THE
739				;ROUTINE TO TURN THE FAC INTO A 
740				;TWO BYTE SIGNED INTEGER IN [Y,A]
741ADRGAY: ADR(GIVAYF)>		;STORE HERE THE ADDR OF THE
742				;ROUTINE TO CONVERT [Y,A] TO A FLOATING
743				;POINT NUMBER IN THE FAC.
744IFN	ROMSW,<
745USRPOK: JMP	FCERR>		;SET UP ORIG BY INIT.
746;
747; THIS IS THE "VOLATILE" STORAGE AREA AND NONE OF IT
748; CAN BE KEPT IN ROM. ANY CONSTANTS IN THIS AREA CANNOT
749; BE KEPT IN A ROM, BUT MUST BE LOADED IN BY THE 
750; PROGRAM INSTRUCTIONS IN ROM.
751;
752; --- GENERAL RAM ---:
753CHARAC: BLOCK	1		;A DELIMITING CHARACTER.
754INTEGR= CHARAC			;A ONE-BYTE INTEGER FROM "QINT".
755ENDCHR: BLOCK	1		;THE OTHER DELIMITING CHARACTER.
756COUNT:	BLOCK	1		;A GENERAL COUNTER.
757
758; --- FLAGS ---:
759DIMFLG: BLOCK	1		;IN GETTING A POINTER TO A VARIABLE
760				;IT IS IMPORTANT TO REMEMBER WHETHER IT
761				;IS BEING DONE FOR "DIM" OR NOT.
762				;DIMFLG AND VALTYP MUST BE
763				;CONSECUTIVE LOCATIONS.
764KIMY=	DIMFLG			;PLACE TO PRESERVE Y DURING OUT.
765VALTYP: BLOCK	1		;THE TYPE INDICATOR.
766				;0=NUMERIC 1=STRING.
767IFN	INTPRC,<
768INTFLG: BLOCK	1>		;TELLS IF INTEGER.
769DORES:	BLOCK	1		;WHETHER CAN OR CAN'T CRUNCH RES'D WORDS.
770				;TURNED ON WHEN "DATA"
771				;BEING SCANNED BY CRUNCH SO UNQUOTED
772				;STRINGS WON'T BE CRUNCHED.
773GARBFL= DORES			;WHETHER TO DO GARBAGE COLLECTION.
774SUBFLG: BLOCK	1		;FLAG WHETHER SUB'D VARIABLE ALLOWED.
775				;"FOR" AND USER-DEFINED FUNCTION
776				;POINTER FETCHING TURN
777				;THIS ON BEFORE CALLING "PTRGET"
778				;SO ARRAYS WON'T BE DETECTED.
779				;"STKINI" AND "PTRGET" CLEAR IT.
780				;ALSO DISALLOWS INTEGERS THERE.
781INPFLG: BLOCK	1		;FLAGS WHETHER WE ARE DOING "INPUT"
782				;OR "READ".
783TANSGN: BLOCK	1		;USED IN DETERMINING SIGN OF TANGENT.
784IFN	REALIO,<
785CNTWFL: BLOCK	1>		;SUPPRESS OUTPUT FLAG.
786				;NON-ZERO MEANS SUPPRESS.
787				;RESET BY "INPUT", READY AND ERRORS.
788				;COMPLEMENTED BY INPUT OF ^O.
789
790IFE	REALIO-4,<ORG	80>	;ROOM FOR APPLE PAGE 0 STUFF.
791; --- RAM DEALING WITH TERMINAL HANDLING ---:
792IFN	EXTIO,<
793CHANNL: BLOCK	1>		;HOLDS CHANNEL NUMBER.
794IFN	NULCMD,<
795NULCNT: 0>			;NUMBER OF NULLS TO PRINT.
796IFN	REALIO-3,<
797TRMPOS: BLOCK	1>		;POSITION OF TERMINAL CARRIAGE.
798LINWID: LINLEN			;LENGTH OF LINE (WIDTH).
799NCMWID: NCMPOS			;POSITION BEYOND WHICH THERE ARE
800				;NO MORE FIELDS.
801LINNUM: 0			;LOCATION TO STORE LINE NUMBER BEFORE BUF
802				;SO THAT "BLTUC" CAN STORE IT ALL AWAY AT ONCE.
803	44			;A COMMA (PRELOAD OR FROM ROM)
804				;USED BY INPUT STATEMENT SINCE THE
805				;DATA POINTER ALWAYS STARTS ON A
806				;COMMA OR TERMINATOR.
807IFE	BUFPAG,<
808BUF:	BLOCK	BUFLEN>		;TYPE IN STORED HERE.
809				;DIRECT STATEMENTS EXECUTE OUT OF
810				;HERE. REMEMBER "INPUT" SMASHES BUF.
811				;MUST BE ON PAGE ZERO
812				;OR ASSIGNMENT OF STRING
813				;VALUES IN DIRECT STATEMENTS WON'T COPY
814				;INTO STRING SPACE -- WHICH IT MUST.
815				;N.B. TWO NONZERO BYTES MUST PRECEDE "BUFLNM".
816
817; --- STORAGE FOR TEMPORARY THINGS ---:
818TEMPPT: BLOCK	1		;POINTER AT FIRST FREE TEMP DESCRIPTOR.
819				;INITIALIZED TO POINT TO TEMPST.
820LASTPT: BLOCK	2		;POINTER TO LAST-USED STRING TEMPORARY.
821TEMPST: BLOCK	STRSIZ*NUMTMP	;STORAGE FOR NUMTMP TEMP DESCRIPTORS.
822INDEX1: BLOCK	2		;INDEXES.
823INDEX=	INDEX1
824INDEX2: BLOCK	2
825RESHO:	BLOCK	1		;RESULT OF MULTIPLIER AND DIVIDER.
826IFN	ADDPRC,<
827RESMOH: BLOCK	1>		;ONE MORE BYTE.
828RESMO:	BLOCK	1
829RESLO:	BLOCK	1
830ADDEND= RESMO			;TEMPORARY USED BY "UMULT".
831	0			;OVERFLOW FOR RES.
832
833; --- POINTERS INTO DYNAMIC DATA STRUCTURES ---;
834TXTTAB: BLOCK	2		;POINTER TO BEGINNING OF TEXT.
835				;DOESN'T CHANGE AFTER BEING
836				;SETUP BY "INIT".
837VARTAB: BLOCK	2		;POINTER TO START OF SIMPLE
838				;VARIABLE SPACE.
839				;UPDATED WHENEVER THE SIZE OF THE
840				;PROGRAM CHANGES, SET TO [TXTTAB]
841				;BY "SCRATCH" ("NEW").
842ARYTAB: BLOCK	2		;POINTER TO BEGINNING OF ARRAY
843				;TABLE.
844				;INCREMENTED BY 6 WHENEVER
845				;A NEW SIMPLE VARIABLE IS FOUND, AND
846				;SET TO [VARTAB] BY "CLEARC".
847STREND: BLOCK	2		;END OF STORAGE IN USE.
848				;INCREASED WHENEVER A NEW ARRAY
849				;OR SIMPLE VARIABLE IS ENCOUNTERED.
850				;SET TO [VARTAB] BY "CLEARC".
851FRETOP: BLOCK	2		;TOP OF STRING FREE SPACE.
852FRESPC: BLOCK	2		;POINTER TO NEW STRING.
853MEMSIZ: BLOCK	2		;HIGHEST LOCATION IN MEMORY.
854
855; --- LINE NUMBERS AND TEXTUAL POINTERS ---:
856CURLIN: BLOCK	2		;CURRENT LINE #.
857				;SET TO 0,255 FOR DIRECT STATEMENTS.
858OLDLIN: BLOCK	2		;OLD LINE NUMBER (SETUP BY ^C,"STOP"
859				;OR "END" IN A PROGRAM).
860POKER=	LINNUM			;SET UP LOCATION USED BY POKE.
861				;TEMPORARY FOR INPUT AND READ CODE
862OLDTXT: BLOCK	2		;OLD TEXT POINTER.
863				;POINTS AT STATEMENT TO BE EXEC'D NEXT.
864DATLIN: BLOCK	2		;DATA LINE # -- REMEMBER FOR ERRORS.
865DATPTR: BLOCK	2		;POINTER TO DATA. INITIALIZED TO POINT
866				;AT THE ZERO IN FRONT OF [TXTTAB]
867				;BY "RESTORE" WHICH IS CALLED BY "CLEARC".
868				;UPDATED BY EXECUTION OF A "READ".
869INPPTR: BLOCK	2		;THIS REMEMBERS WHERE INPUT IS COMING FROM.
870
871; --- STUFF USED IN EVALUATIONS ---:
872VARNAM: BLOCK	2		;VARIABLE'S NAME IS STORED HERE.
873VARPNT: BLOCK	2		;POINTER TO VARIABLE IN MEMORY.
874FDECPT= VARPNT			;POINTER INTO POWER OF TENS OF "FOUT".
875FORPNT: BLOCK	2		;A VARIABLE'S POINTER FOR "FOR" LOOPS
876				;AND "LET" STATEMENTS.
877LSTPNT= FORPNT			;PNTR TO LIST STRING.
878ANDMSK= FORPNT			;THE MASK USED BY WAIT FOR ANDING.
879EORMSK= FORPNT+1		;THE MASK FOR EORING IN WAIT.
880OPPTR:	BLOCK	2		;POINTER TO CURRENT OP'S ENTRY IN "OPTAB".
881VARTXT= OPPTR			;POINTER INTO LIST OF VARIABLES.
882OPMASK: BLOCK	1		;MASK CREATED BY CURRENT OPERATOR.
883DOMASK=TANSGN			;MASK IN USE BY RELATION OPERATIONS.
884DEFPNT: BLOCK	2		;POINTER USED IN FUNCTION DEFINITION.
885GRBPNT= DEFPNT			;ANOTHER USED IN GARBAGE COLLECTION.
886DSCPNT: BLOCK	2		;POINTER TO A STRING DESCRIPTOR.
887IFN	ADDPRC,<BLOCK	1>	;FOR TEMPF3.
888FOUR6:	EXP	STRSIZ		;VARIABLE CONSTANT USED BY GARB COLLECT.
889
890; --- ET CETERA ---:
891JMPER:	JMP	60000
892SIZE=	JMPER+1
893OLDOV=	JMPER+2			;THE OLD OVERFLOW.
894TEMPF3= DEFPNT			;A THIRD FAC TEMPORARY (4 BYTES).
895TEMPF1:
896IFN	ADDPRC,<0>		;FOR TEMPF1S EXTRA BYTE.
897HIGHDS: BLOCK	2		;DESINATION OF HIGHEST ELEMENT IN BLT.
898HIGHTR: BLOCK	2		;SOURCE OF HIGHEST ELEMENT TO MOVE.
899TEMPF2:
900IFN	ADDPRC,<0>		;FOR TEMPF2S EXTRA BYTE.
901LOWDS:	BLOCK	2		;LOCATION OF LAST BYTE TRANSFERRED INTO.
902LOWTR:	BLOCK	2		;LAST THING TO MOVE IN BLT.
903ARYPNT= HIGHDS			;A POINTER USED IN ARRAY BUILDING.
904GRBTOP= LOWTR			;A POINTER USED IN GARBAGE COLLECTION.
905DECCNT= LOWDS			;NUMBER OF PLACES BEFORE DECIMAL POINT.
906TENEXP= LOWDS+1			;HAS A DPT BEEN INPUT?
907DPTFLG= LOWTR			;BASE TEN EXPONENT.
908EXPSGN= LOWTR+1			;SIGN OF BASE TEN EXPONENT.
909
910; --- THE FLOATING ACCUMULATOR ---:
911FAC:
912FACEXP: 0
913FACHO:	0			;MOST SIGNIFICANT BYTE OF MANTISSA.
914IFN	ADDPRC,<
915FACMOH: 0>			;ONE MORE.
916FACMO:	0			;MIDDLE ORDER OF MANTISSA.
917FACLO:	0			;LEAST SIG BYTE OF MANTISSA.
918FACSGN: 0			;SIGN OF FAC (0 OR -1) WHEN UNPACKED.
919SGNFLG: 0			;SIGN OF FAC IS PRESERVED BERE BY "FIN".
920DEGREE= SGNFLG			;A COUNT USED BY POLYNOMIALS.
921DSCTMP= FAC			;THIS IS WHERE TEMP DESCS ARE BUILT.
922INDICE= FACMO			;INDICE IS SET UP HERE BY "QINT".
923BITS:	0			;SOMETHING FOR "SHIFTR" TO USE.
924
925; --- THE FLOATING ARGUMENT (UNPACKED) ---:
926ARGEXP: 0
927ARGHO:	0
928IFN	ADDPRC,<ARGMOH: 0>
929ARGMO:	0
930ARGLO:	0
931ARGSGN: 0
932
933ARISGN: 0			;A SIGN REFLECTING THE RESULT.
934FACOV:	0			;OVERFLOW BYTE OF THE FAC.
935STRNG1= ARISGN			;POINTER TO A STRING OR DESCRIPTOR.
936
937FBUFPT: BLOCK	2		;POINTER INTO FBUFFR USED BY FOUT.
938BUFPTR= FBUFPT			;POINTER TO BUF USED BY "CRUNCH".
939STRNG2= FBUFPT			;POINTER TO STRING OR DESC.
940POLYPT= FBUFPT			;POINTER INTO POLYNOMIAL COEFFICIENTS.
941CURTOL= FBUFPT			;ABSOLUTE LINEAR INDEX IS FORMED HERE.
942PAGE
943SUBTTL	RAM CODE.
944; THIS CODE GETS CHANGED THROUGHOUT EXECUTION.
945; IT IS MADE TO BE FAST THIS WAY.
946; ALSO, [X] AND [Y] ARE NOT DISTURBED
947;
948; "CHRGET" USING [TXTPTR] AS THE CURRENT TEXT PNTR
949; FETCHES A NEW CHARACTER INTO ACCA AFTER INCREMENTING [TXTPTR]
950; AND SETS CONDITION CODES ACCORDING TO WHAT'S IN ACCA.
951;	NOT C=	NUMERIC	  ("0" THRU "9")
952;	Z=	":" OR END-OF-LINE (A NULL)
953;
954; [ACCA] = NEW CHAR.
955; [TXTPTR]=[TXTPTR]+1
956;
957; THE FOLLOWING EXISTS IN ROM IF ROM EXISTS AND IS LOADED
958; DOWN HERE BY INIT. OTHERWISE IT IS JUST LOADED INTO THIS
959; RAM LIKE ALL THE REST OF RAM IS LOADED.
960;
961CHRGET: INC	CHRGET+7	;INCREMENT THE WHOLE TXTPTR.
962	BNE	CHRGOT
963	INC	CHRGET+8
964CHRGOT: LDA	60000		;A LOAD WITH AN EXT ADDR.
965TXTPTR= CHRGOT+1
966	CMPI	" "		;SKIP SPACES.
967	BEQ	CHRGET
968QNUM:	CMPI	":"		;IS IT A ":"?
969	BCS	CHRRTS		;IT IS .GE. ":"
970	SEC
971	SBCI	"0"		;ALL CHARS .GT. "9" HAVE RET'D SO
972	SEC
973	SBCI	256-"0"		;SEE IF NUMERIC.
974				;TURN CARRY ON IF NUMERIC.
975				;ALSO, SETZ IF NULL.
976CHRRTS: RTS			;RETURN TO CALLER.
977
978RNDX:	128			;LOADED OR FROM ROM.
979	79			;THE INITIAL RANDOM NUMBER.
980	199
981	82
982IFN	ADDPRC,<89>		;ONE MORE BYTE.
983
984ORG	255			;PAGE 1 STUFF COMING UP.
985LOFBUF: BLOCK	1		;THE LOW FAC BUFFER. COPYABLE.
986;---  PAGE ZERO/ONE BOUNDARY ---.
987				;MUST HAVE 13 CONTIGUOUS BYTES.
988FBUFFR: BLOCK	3*ADDPRC+13	;BUFFER FOR "FOUT".
989				;ON PAGE 1 SO THAT STRING IS NOT COPIED.
990
991;STACK IS LOCATED HERE. IE FROM THE END OF FBUFFR TO STKEND.
992PAGE
993SUBTTL	DISPATCH TABLES, RESERVED WORDS, AND ERROR TEXTS.
994
995	ORG	ROMLOC
996
997STMDSP: ADR(END-1)
998	ADR(FOR-1)
999	ADR(NEXT-1)
1000	ADR(DATA-1)
1001IFN	EXTIO,<
1002	ADR(INPUTN-1)>
1003	ADR(INPUT-1)
1004	ADR(DIM-1)
1005	ADR(READ-1)
1006	ADR(LET-1)
1007	ADR(GOTO-1)
1008	ADR(RUN-1)
1009	ADR(IF-1)
1010	ADR(RESTORE-1)
1011	ADR(GOSUB-1)
1012	ADR(RETURN-1)
1013	ADR(REM-1)
1014	ADR(STOP-1)
1015	ADR(ONGOTO-1)
1016IFN	NULCMD,<
1017	ADR(NULL-1)>
1018	ADR(FNWAIT-1)
1019IFN	DISKO,<
1020IFE	REALIO-3,<
1021	ADR(CQLOAD-1)
1022	ADR(CQSAVE-1)
1023	ADR(CQVERF-1)>
1024IFN	REALIO,<
1025IFN	REALIO-2,<
1026IFN	REALIO-3,<
1027IFN	REALIO-5,<
1028	ADR(LOAD-1)
1029	ADR(SAVE-1)>>>>
1030IFN	REALIO-1,<
1031IFN	REALIO-3,<
1032IFN	REALIO-4,<
1033	ADR(511)		;ADDRESS OF LOAD
1034	ADR(511)>>>>		;ADDRESS OF SAVE
1035	ADR(DEF-1)
1036	ADR(POKE-1)
1037IFN	EXTIO,<
1038	ADR(PRINTN-1)>
1039	ADR(PRINT-1)
1040	ADR(CONT-1)
1041IFE	REALIO,<
1042	ADR(DDT-1)>
1043	ADR(LIST-1)
1044	ADR(CLEAR-1)
1045IFN	EXTIO,<
1046	ADR(CMD-1)
1047	ADR(CQSYS-1)
1048	ADR(CQOPEN-1)
1049	ADR(CQCLOS-1)>
1050IFN	GETCMD,<
1051	ADR(GET-1)>		;FILL W/ GET ADDR.
1052	ADR(SCRATH-1)
1053
1054FUNDSP: ADR(SGN)
1055	ADR(INT)
1056	ADR(ABS)
1057IFE	ROMSW,<
1058USRLOC: ADR(FCERR)>		;INITIALLY NO USER ROUTINE.
1059IFN	ROMSW,<
1060USRLOC: ADR(USRPOK)>
1061	ADR(FRE)
1062	ADR(POS)
1063	ADR(SQR)
1064	ADR(RND)
1065	ADR(LOG)
1066	ADR(EXP)
1067IFN	KIMROM,<
1068REPEAT	4,<
1069	ADR(FCERR)>>
1070IFE	KIMROM,<
1071COSFIX: ADR(COS)
1072SINFIX: ADR(SIN)
1073TANFIX: ADR(TAN)
1074ATNFIX: ADR(ATN)>
1075	ADR(PEEK)
1076	ADR(LEN)
1077	ADR(STR)
1078	ADR(VAL)
1079	ADR(ASC)
1080	ADR(CHR)
1081	ADR(LEFT)
1082	ADR(RIGHT)
1083	ADR(MID)
1084OPTAB:	121
1085	ADR(FADDT-1)
1086	121
1087	ADR(FSUBT-1)
1088	123
1089	ADR(FMULTT-1)
1090	123
1091	ADR(FDIVT-1)
1092	127
1093	ADR(FPWRT-1)
1094	80
1095	ADR(ANDOP-1)
1096	70
1097	ADR(OROP-1)
1098NEGTAB: 125
1099	ADR(NEGOP-1)
1100NOTTAB: 90
1101	ADR(NOTOP-1)
1102PTDORL: 100			;PRECEDENCE.
1103	ADR	(DOREL-1)	;OPERATOR ADDRESS.
1104;
1105; TOKENS FOR RESERVED WORDS ALWAYS HAVE THE MOST
1106; SIGNIFICANT BIT ON.
1107; THE LIST OF RESERVED WORDS:
1108;
1109Q=128-1
1110DEFINE	DCI(A),<Q=Q+1
1111	DC(A)>
1112RESLST: DCI"END"
1113	ENDTK==Q
1114	DCI"FOR"
1115	FORTK==Q
1116	DCI"NEXT"
1117	DCI"DATA"
1118	DATATK==Q
1119IFN	EXTIO,<
1120	DCI"INPUT#">
1121	DCI"INPUT"
1122	DCI"DIM"
1123	DCI"READ"
1124	DCI"LET"
1125	DCI"GOTO"
1126	GOTOTK==Q
1127	DCI"RUN"
1128	DCI"IF"
1129	DCI"RESTORE"
1130	DCI"GOSUB"
1131	GOSUTK=Q
1132	DCI"RETURN"
1133	DCI"REM"
1134	REMTK=Q
1135	DCI"STOP"
1136	DCI"ON"
1137IFN	NULCMD,<
1138	DCI"NULL">
1139	DCI"WAIT"
1140IFN	DISKO,<
1141	DCI"LOAD"
1142	DCI"SAVE"
1143IFE	REALIO-3,<
1144	DCI"VERIFY">>
1145	DCI"DEF"
1146	DCI"POKE"
1147IFN	EXTIO,<
1148	DCI"PRINT#">
1149	DCI"PRINT"
1150	PRINTK==Q
1151	DCI"CONT"
1152IFE	REALIO,<
1153	DCI"DDT">
1154	DCI"LIST"
1155IFN	REALIO-3,<
1156	DCI"CLEAR">
1157IFE	REALIO-3,<
1158	DCI"CLR">
1159IFN	EXTIO,<
1160	DCI"CMD"
1161	DCI"SYS"
1162	DCI"OPEN"
1163	DCI"CLOSE">
1164IFN	GETCMD,<
1165	DCI"GET">
1166	DCI"NEW"
1167	SCRATK=Q
1168; END OF COMMAND LIST.
1169	"T"
1170	"A"
1171	"B"
1172	"("+128
1173	Q=Q+1
1174	TABTK=Q
1175	DCI"TO"
1176	TOTK==Q
1177	DCI"FN"
1178	FNTK==Q
1179	"S"
1180	"P"
1181	"C"
1182	"("+128			;MACRO DOESNT LIKE ('S IN ARGUMENTS.
1183	Q=Q+1
1184	SPCTK==Q
1185	DCI"THEN"
1186	THENTK=Q
1187	DCI"NOT"
1188	NOTTK==Q
1189	DCI"STEP"
1190	STEPTK=Q
1191	DCI"+"
1192	PLUSTK=Q
1193	DCI"-"
1194	MINUTK=Q
1195	DCI"*"
1196	DCI"/"
1197	DCI"^"
1198	DCI"AND"
1199	DCI"OR"
1200	190			;A GREATER THAN SIGN
1201	Q=Q+1
1202	GREATK=Q
1203	DCI"="
1204	EQULTK=Q
1205	188
1206	Q=Q+1			;A LESS THAN SIGN
1207	LESSTK=Q
1208;
1209; NOTE DANGER OF ONE RESERVED WORD BEING A PART
1210; OF ANOTHER:
1211; IE . . IF 2 GREATER THAN F OR T=5 THEN...
1212; WILL NOT WORK!!! SINCE "FOR" WILL BE CRUNCHED!!
1213; IN ANY CASE MAKE SURE THE SMALLER WORD APPEARS
1214; SECOND IN THE RESERVED WORD TABLE ("INP" AND "INPUT")
1215; ANOTHER EXAMPLE: IF T OR Q THEN ... "TO" IS CRUNCHED
1216;
1217	DCI"SGN"
1218	ONEFUN=Q
1219	DCI"INT"
1220	DCI"ABS"
1221	DCI"USR"
1222	DCI"FRE"
1223	DCI"POS"
1224	DCI"SQR"
1225	DCI"RND"
1226	DCI"LOG"
1227	DCI"EXP"
1228	DCI"COS"
1229	DCI"SIN"
1230	DCI"TAN"
1231	DCI"ATN"
1232	DCI"PEEK"
1233	DCI"LEN"
1234	DCI"STR$"
1235	DCI"VAL"
1236	DCI"ASC"
1237	DCI"CHR$"
1238LASNUM==Q			;NUMBER OF LAST FUNCTION
1239				;THAT TAKES ONE ARG
1240	DCI"LEFT$"
1241	DCI"RIGHT$"
1242	DCI"MID$"
1243	DCI"GO"
1244GOTK==Q
1245	0			;MARKS END OF RESERVED WORD LIST
1246
1247IFE LNGERR,<
1248Q=0-2
1249DEFINE	DCE(X),<Q=Q+2
1250	DC(X)>
1251ERRTAB: DCE"NF"
1252	ERRNF==Q		;NEXT WITHOUT FOR.
1253	DCE"SN"
1254	ERRSN==Q		;SYNTAX
1255	DCE"RG"
1256	ERRRG==Q		;RETURN WITHOUT GOSUB.
1257	DCE"OD"
1258	ERROD==Q		;OUT OF DATA.
1259	DCE"FC"
1260	ERRFC==Q		;ILLEGAL QUANTITY.
1261	DCE"OV"
1262	ERROV==Q		;OVERFLOW.
1263	DCE"OM"
1264	ERROM==Q		;OUT OF MEMORY.
1265	DCE"US"
1266	ERRUS==Q		;UNDEFINED STATEMENT.
1267	DCE"BS"
1268	ERRBS==Q		;BAD SUBSCRIPT.
1269	DCE"DD"
1270	ERRDD==Q		;REDIMENSIONED ARRAY.
1271	DCE"/0"
1272	ERRDV0==Q		;DIVISION BY ZERO.
1273	DCE"ID"
1274	ERRID==Q		;ILLEGAL DIRECT.
1275	DCE"TM"
1276	ERRTM==Q		;TYPE MISMATCH.
1277	DCE"LS"
1278	ERRLS==Q		;STRING TOO LONG.
1279IFN	EXTIO,<
1280	DCE"FD"			;FILE DATA.
1281	ERRBD==Q>
1282	DCE"ST"
1283	ERRST==Q		;STRING FORMULA TOO COMPLEX.
1284	DCE"CN"
1285	ERRCN==Q		;CAN'T CONTINUE.
1286	DCE"UF"
1287	ERRUF==Q>		;UNDEFINED FUNCTION.
1288
1289IFN LNGERR,<
1290Q=0
1291; NOTE: THIS ERROR COUNT TECHNIQUE WILL NOT WORK IF THERE ARE MORE
1292; THAN 256 CHARACTERS OF ERROR MESSAGES
1293ERRTAB: DC"NEXT WITHOUT FOR"
1294	ERRNF==Q
1295	Q=Q+16
1296	DC"SYNTAX"
1297	ERRSN==Q
1298	Q=Q+6
1299	DC"RETURN WITHOUT GOSUB"
1300	ERRRG==Q
1301	Q=Q+20
1302	DC"OUT OF DATA"
1303	ERROD==Q
1304	Q=Q+11
1305	DC"ILLEGAL QUANTITY"
1306	ERRFC==Q
1307	Q=Q+16
1308	DC"OVERFLOW"
1309	ERROV==Q
1310	Q=Q+8
1311	DC"OUT OF MEMORY"
1312	ERROM==Q
1313	Q=Q+13
1314	DC"UNDEF'D STATEMENT"
1315	ERRUS==Q
1316	Q=Q+17
1317	DC"BAD SUBSCRIPT"
1318	ERRBS==Q
1319	Q=Q+13
1320	DC"REDIM'D ARRAY"
1321	ERRDD==Q
1322	Q=Q+13
1323	DC"DIVISION BY ZERO"
1324	ERRDV0==Q
1325	Q=Q+16
1326	DC"ILLEGAL DIRECT"
1327	ERRID==Q
1328	Q=Q+14
1329	DC"TYPE MISMATCH"
1330	ERRTM==Q
1331	Q=Q+13
1332	DC"STRING TOO LONG"
1333	ERRLS==Q
1334	Q=Q+15
1335IFN	EXTIO,<
1336	DC"FILE DATA"
1337	ERRBD==Q
1338	Q=Q+9>
1339	DC"FORMULA TOO COMPLEX"
1340	ERRST==Q
1341	Q=Q+19
1342	DC"CAN'T CONTINUE"
1343	ERRCN==Q
1344	Q=Q+14
1345	DC"UNDEF'D FUNCTION"
1346	ERRUF==Q>
1347
1348;
1349; NEEDED FOR MESSAGES IN ALL VERSIONS.
1350;
1351ERR:	DT" ERROR"
1352	0
1353INTXT:	DT" IN "
1354	0
1355REDDY:	ACRLF
1356IFE REALIO-3,<
1357	DT"READY.">
1358IFN REALIO-3,<
1359	DT"OK">
1360	ACRLF
1361	0
1362BRKTXT: ACRLF
1363	DT"BREAK"
1364	0
1365PAGE
1366SUBTTL	GENERAL STORAGE MANAGEMENT ROUTINES.
1367;
1368; FIND A "FOR" ENTRY ON THE STACK VIA "VARPNT".
1369;
1370FORSIZ==2*ADDPRC+16
1371FNDFOR: TSX			;LOAD XREG WITH STK PNTR.
1372	REPEAT	4,<INX>		;IGNORE ADR(NEWSTT) AND RTS ADDR.
1373FFLOOP: LDA	257,X		;GET STACK ENTRY.
1374	CMPI	FORTK		;IS IT A "FOR" TOKEN?
1375	BNE	FFRTS		;NO, NO "FOR" LOOPS WITH THIS PNTR.
1376	LDA	FORPNT+1	;GET HIGH.
1377	BNE	CMPFOR
1378	LDA	258,X		;PNTR IS ZERO, SO ASSUME THIS ONE.
1379	STA	FORPNT
1380	LDA	259,X
1381	STA	FORPNT+1
1382CMPFOR: CMP	259,X
1383	BNE	ADDFRS		;NOT THIS ONE.
1384	LDA	FORPNT		;GET DOWN.
1385	CMP	258,X
1386	BEQ	FFRTS		;WE GOT IT! WE GOT IT!
1387ADDFRS: TXA
1388	CLC			;ADD 16 TO X.
1389	ADCI	FORSIZ
1390	TAX			;RESULT BACK INTO X.
1391	BNE	FFLOOP
1392FFRTS:	RTS			;RETURN TO CALLER.
1393
1394;
1395; THIS IS THE BLOCK TRANSFER ROUTINE.
1396; IT MAKES SPACE BY SHOVING EVERYTHING FORWARD.
1397;
1398; ON ENTRY:
1399; [Y,A]=[HIGHDS]    (FOR REASON).
1400; [HIGHDS]= DESTINATION OF [HIGH ADDRESS].
1401; [LOWTR]= LOWEST ADDR TO BE TRANSFERRED.
1402; [HIGHTR]= HIGHEST ADDR TO BE TRANSFERRED.
1403;
1404; A CHECK IS MADE TO ASCERTAIN THAT A REASONABLE
1405; AMOUNT OF SPACE REMAINS BETWEEN THE BOTTOM
1406; OF THE STRINGS AND THE HIGHEST LOCATION TRANSFERRED INTO.
1407;
1408; ON EXIT:
1409; [LOWTR] ARE UNCHANGED.
1410; [HIGHTR]=[LOWTR]-200 OCTAL.
1411; [HIGHDS]=LOWEST ADDR TRANSFERRED INTO MINUS 200 OCTAL.
1412;
1413BLTU:	JSR	REASON		;ASCERTAIN THAT STRING SPACE WON'T
1414				;BE OVERRUN.
1415	STWD	STREND
1416BLTUC:	SEC			;PREPARE TO SUBTRACT.
1417	LDA	HIGHTR
1418	SBC	LOWTR		;COMPUTE NUMBER OF THINGS TO MOVE.
1419	STA	INDEX		;SAVE FOR LATER.
1420	TAY
1421	LDA	HIGHTR+1
1422	SBC	LOWTR+1
1423	TAX			;PUT IT IN A COUNTER REGISTER.
1424	INX			;SO THAT COUNTER ALGORITHM WORKS.
1425	TYA			;SEE IF LOW PART OF COUNT IS ZERO.
1426	BEQ	DECBLT		;YES, GO START MOVING BLOCKS.
1427	LDA	HIGHTR		;NO, MUST MODIFY BASE ADDR.
1428	SEC
1429	SBC	INDEX		;BORROW IS OFF SINCE [HIGHTR].GT.[LOWTR].
1430	STA	HIGHTR		;SAVE MODIFIED BASE ADDR.
1431	BCS	BLT1		;IF NO BORROW, GO SHOVE IT.
1432	DEC	HIGHTR+1	;BORROW IMPLIES SUB 1 FROM HIGH ORDER.
1433	SEC
1434BLT1:	LDA	HIGHDS		;MOD BASE OF DEST ADDR.
1435	SBC	INDEX
1436	STA	HIGHDS
1437	BCS	MOREN1		;NO BORROW.
1438	DEC	HIGHDS+1	;DECREMENT HIGH ORDER BYTE.
1439	BCC	MOREN1		;ALWAYS SKIP.
1440BLTLP:	LDADY	HIGHTR		;FETCH BYTE TO MOVE
1441	STADY	HIGHDS		;MOVE IT IN, MOVE IT OUT.
1442MOREN1: DEY
1443	BNE	BLTLP
1444	LDADY	HIGHTR		;MOVE LAST OF THE BLOCK.
1445	STADY	HIGHDS
1446DECBLT: DEC	HIGHTR+1
1447	DEC	HIGHDS+1	;START ON NEW BLOCKS.
1448	DEX
1449	BNE	MOREN1
1450	RTS			;RETURN TO CALLER.
1451
1452;
1453; THIS ROUTINE IS USED TO ASCERTAIN THAT A GIVEN
1454; NUMBER OF LOCS REMAIN AVAILABLE FOR THE STACK.
1455;    THE CALL IS:
1456;	LDAI	NUMBER OF 2-BYTE ENTRIES NEEDED.
1457;	JSR	GETSTK
1458;
1459; THIS ROUTINE MUST BE CALLED BY ANY ROUTINE WHICH PUTS
1460; AN ARBITRARY AMOUNT OF STUFF ON THE STACK,
1461; I.E., ANY RECURSIVE ROUTINE LIKE "FRMEVL".
1462; IT IS ALSO CALLED BY ROUTINES SUCH AS "GOSUB" AND "FOR"
1463; WHICH MAKE PERMANENT ENTRIES ON THE STACK.
1464;
1465; ROUTINES WHICH MERELY USE AND FREE UP THE GUARANTEED
1466; NUMLEV LOCATIONS NEED NOT CALL THIS.
1467;
1468;
1469; ON EXIT:
1470;    [A] AND [X] HAVE BEEN MODIFIED.
1471;
1472GETSTK: ASL	A,		;MULT [A] BY 2. NB, CLEARS C BIT.
1473	ADCI	2*NUMLEV+<3*ADDPRC>+13	;MAKE SURE 2*NUMLEV+13 LOCS
1474				;(13 BECAUSE OF FBUFFR)
1475	BCS	OMERR		;WILL REMAIN IN STACK.
1476	STA	INDEX
1477	TSX			;GET STACKED.
1478	CPX	INDEX		;COMPARE.
1479	BCC	OMERR		;IF STACK.LE.INDEX1, OM.
1480	RTS
1481
1482;
1483; [Y,A] IS A CERTAIN ADDRESS. "REASON" MAKES SURE
1484; IT IS LESS THAN [FRETOP].
1485;
1486REASON: CPY	FRETOP+1
1487	BCC	REARTS
1488	BNE	TRYMOR		;GO GARB COLLECT.
1489	CMP	FRETOP
1490	BCC	REARTS
1491TRYMOR: PHA
1492	LDXI	8+ADDPRC	;IF TEMPF2 HAS ZERO IN BETWEEN.
1493	TYA
1494REASAV: PHA
1495	LDA	HIGHDS-1,X	;SAVE HIGHDS ON STACK.
1496	DEX
1497	BPL	REASAV		;PUT 8 OF THEM ON STK.
1498	JSR	GARBA2		;GO GARB COLLECT.
1499	LDXI	256-8-ADDPRC
1500REASTO: PLA
1501	STA	HIGHDS+8+ADDPRC,X	;RESTORE AFTER GARB COLLECT.
1502	INX
1503	BMI	REASTO
1504	PLA
1505	TAY
1506	PLA			;RESTORE A AND Y.
1507	CPY	FRETOP+1	;COMPARE HIGHS
1508	BCC	REARTS
1509	BNE	OMERR		;HIGHER IS BAD.
1510	CMP	FRETOP		;AND THE LOWS.
1511	BCS	OMERR
1512REARTS: RTS
1513
1514PAGE
1515SUBTTL	ERROR HANDLER, READY, TERMINAL INPUT, COMPACTIFY, NEW, REINIT.
1516OMERR:	LDXI	ERROM
1517ERROR:
1518IFN	REALIO,<
1519	LSR	CNTWFL>		;FORCE OUTPUT.
1520IFN	EXTIO,<
1521	LDA	CHANNL		;CLOSE NON-TERMINAL CHANNEL.
1522	BEQ	ERRCRD
1523	JSR	CQCCHN		;CLOSE IT.
1524	LDAI	0
1525	STA	CHANNL>
1526ERRCRD: JSR	CRDO		;OUTPUT CRLF.
1527	JSR	OUTQST		;PRINT A QUESTION MARK
1528IFE LNGERR,<
1529	LDA	ERRTAB,X,	;GET FIRST CHR OF ERR MSG.
1530	JSR	OUTDO		;OUTPUT IT.
1531	LDA	ERRTAB+1,X,	;GET SECOND CHR.
1532	JSR	OUTDO>		;OUTPUT IT.
1533IFN LNGERR,<
1534GETERR: LDA	ERRTAB,X
1535	PHA
1536	ANDI	127		;GET RID OF HIGH BIT.
1537	JSR	OUTDO		;OUTPUT IT.
1538	INX
1539	PLA			;LAST CHAR OF MESSAGE?
1540	BPL	GETERR>		;NO. GO GET NEXT AND OUTPUT IT.
1541TYPERR: JSR	STKINI		;RESET THE STACK AND FLAGS.
1542	LDWDI	ERR		;GET PNTR TO " ERROR".
1543ERRFIN: JSR	STROUT		;OUTPUT IT.
1544	LDY	CURLIN+1
1545	INY			;WAS NUMBER 64000?
1546	BEQ	READY		;YES, DON'T TYPE LINE NUMBER.
1547	JSR	INPRT
1548READY:
1549IFN	REALIO,<
1550	LSR	CNTWFL>		;TURN OUTPUT BACK ON IF SUPRESSED
1551	LDWDI	REDDY		;SAY "OK".
1552IFN	REALIO-3,<
1553	JSR	RDYJSR>		;OR GO TO INIT IF INIT ERROR.
1554IFE	REALIO-3,<
1555	JSR	STROUT>		;NO INIT ERRORS POSSIBLE.
1556MAIN:	JSR	INLIN		;GET A LINE FROM TERMINAL.
1557	STXY	TXTPTR
1558	JSR	CHRGET
1559	TAX			;SET ZERO FLAG BASED ON [A]
1560				;THIS DISTINGUISHES ":" AND 0
1561	BEQ	MAIN		;IF BLANK LINE, GET ANOTHER.
1562	LDXI	255		;SET DIRECT LINE NUMBER.
1563	STX	CURLIN+1
1564	BCC	MAIN1		;IS A LINE NUMBER. NOT DIRECT.
1565	JSR	CRUNCH		;COMPACTIFY.
1566	JMP	GONE		;EXECUTE IT.
1567MAIN1:	JSR	LINGET		;READ LINE NUMBER INTO "LINNUM".
1568	JSR	CRUNCH
1569	STY	COUNT		;RETAIN CHARACTER COUNT.
1570	JSR	FNDLIN
1571	BCC	NODEL		;NO MATCH, SO DON'T DELETE.
1572	LDYI	1
1573	LDADY	LOWTR
1574	STA	INDEX1+1
1575	LDA	VARTAB
1576	STA	INDEX1
1577	LDA	LOWTR+1		;SET TRANSFER TO.
1578	STA	INDEX2+1
1579	LDA	LOWTR
1580	DEY
1581	SBCDY	LOWTR		;COMPUTE NEGATIVE LENGTH.
1582	CLC
1583	ADC	VARTAB		;COMPUTE NEW VARTAB.
1584	STA	VARTAB
1585	STA	INDEX2		;SET LOW OF TRANS TO.
1586	LDA	VARTAB+1
1587	ADCI	255
1588	STA	VARTAB+1	;COMPUTE HIGH OF VARTAB.
1589	SBC	LOWTR+1		;COMPUTE NUMBER OF BLOCKS TO MOVE.
1590	TAX
1591	SEC
1592	LDA	LOWTR
1593	SBC	VARTAB		;COMPUTE OFFSET.
1594	TAY
1595	BCS	QDECT1		;IF VARTAB.LE.LOWTR,
1596	INX			;DECR DUE TO CARRY, AND
1597	DEC	INDEX2+1	;DECREMENT STORE SO CARRY WORKS.
1598QDECT1: CLC
1599	ADC	INDEX1
1600	BCC	MLOOP
1601	DEC	INDEX1+1
1602	CLC			;FOR LATER ADCQ
1603MLOOP:	LDADY	INDEX1
1604	STADY	INDEX2
1605	INY
1606	BNE	MLOOP		;BLOCK DONE?
1607	INC	INDEX1+1
1608	INC	INDEX2+1
1609	DEX
1610	BNE	MLOOP		;DO ANOTHER BLOCK. ALWAYS.
1611NODEL:	JSR	RUNC		;RESET ALL VARIABLE INFO SO GARBAGE
1612				;COLLECTION CAUSED BY REASON WILL WORK
1613	JSR	LNKPRG		;FIX UP THE LINKS
1614	LDA	BUF		;SEE IF ANYTHNG THERE
1615	BEQ	MAIN
1616	CLC
1617	LDA	VARTAB
1618	STA	HIGHTR		;SETUP HIGHTR.
1619	ADC	COUNT		;ADD LENGTH OF LINE TO INSERT.
1620	STA	HIGHDS		;THIS GIVES DEST ADDR.
1621	LDY	VARTAB+1
1622	STY	HIGHTR+1	;SAME FOR HIGH ORDERS.
1623	BCC	NODELC
1624	INY
1625NODELC: STY	HIGHDS+1
1626	JSR	BLTU
1627IFN	BUFPAG,<
1628	LDWD	LINNUM		;POSITION THE BINARY LINE NUMBER
1629	STWD	BUF-2>		;IN FRONT OF BUF
1630	LDWD	STREND
1631	STWD	VARTAB
1632	LDY	COUNT
1633	DEY
1634STOLOP: LDA	BUF-4,Y
1635	STADY	LOWTR
1636	DEY
1637	BPL	STOLOP
1638FINI:	JSR	RUNC		;DO CLEAR & SET UP STACK.
1639				;AND SET [TXTPTR] TO [TXTTAB]-1.
1640	JSR	LNKPRG		;FIX UP PROGRAM LINKS
1641	JMP	MAIN
1642LNKPRG: LDWD	TXTTAB		;SET [INDEX] TO [TXTTAB].
1643	STWD	INDEX
1644	CLC
1645;
1646; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES
1647; UP ALL THE LINKS. THE END OF EACH LINE IS FOUND
1648; BY SEARCHING FOR THE ZERO AT THE END.
1649; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM.
1650;
1651CHEAD:	LDYI	1
1652	LDADY	INDEX		;ARRIVED AT DOUBLE ZEROES?
1653	BEQ	LNKRTS
1654	LDYI	4
1655CZLOOP: INY			;THERE IS AT LEAST ONE BYTE.
1656	LDADY	INDEX
1657	BNE	CZLOOP		;NO, CONTINUE SEARCHING.
1658	INY			;GO ONE BEYOND.
1659	TYA
1660	ADC	INDEX
1661	TAX
1662	LDYI	0
1663	STADY	INDEX
1664	LDA	INDEX+1
1665	ADCI	0
1666	INY
1667	STADY	INDEX
1668	STX	INDEX
1669	STA	INDEX+1
1670	BCCA	CHEAD		;ALWAYS BRANCHES.
1671LNKRTS: RTS
1672;
1673; THIS IS THE LINE INPUT ROUTINE.
1674; IT READS CHARACTERS INTO BUF USING BACKARROW (UNDERSCORE, OR
1675; SHIFT O) AS THE DELETE CHARACTER AND @ AS THE 
1676; LINE DELETE CHARACTER. IF MORE THAN BUFLEN CHARACTERS
1677; ARE TYPED, NO ECHOING IS DONE UNTIL A BACKARROW OR @ OR CR
1678; IS TYPED. CONTROL-G WILL BE TYPED FOR EACH EXTRA CHARACTER.
1679; THE ROUTINE IS ENTERED AT INLIN.
1680;
1681IFE	REALIO-4,<
1682INLIN:	LDXI	128		;NO PROMPT CHARACTER
1683	STX	CQPRMP
1684	JSR	CQINLN		;GET A LINE ONTO PAGE 2
1685	CPXI	BUFLEN-1
1686	BCS	GDBUFS		;NOT TOO MANY CHARACTERS
1687	LDXI	BUFLEN-1
1688GDBUFS: LDAI	0		;PUT A ZERO AT THE END
1689	STA	BUF,X
1690	TXA
1691	BEQ	NOCHR
1692LOPBHT: LDA	BUF-1,X
1693	ANDI	127
1694	STA	BUF-1,X
1695	DEX
1696	BNE	LOPBHT
1697NOCHR:	LDAI	0
1698	LDXYI	<BUF-1>		;POINT AT THE BEGINNING
1699	RTS>
1700IFN	REALIO-4,<
1701IFN	REALIO-3,<
1702LINLIN: IFE	REALIO-2,<
1703	JSR	OUTDO>		;ECHO IT.
1704	DEX			;BACKARROW SO BACKUP PNTR AND
1705	BPL	INLINC		;GET ANOTHER IF COUNT IS POSITIVE.
1706INLINN: IFE	REALIO-2,<
1707	JSR	OUTDO>		;PRINT THE @ OR A SECOND BACKARROW
1708				;IF THERE WERE TOO MANY.
1709	JSR	CRDO>
1710INLIN:	LDXI	0
1711INLINC: JSR	INCHR		;GET A CHARACTER.
1712IFN REALIO-3,<
1713	CMPI	7		;IS IT BOB ALBRECHT RINGING THE BELL
1714				;FOR SCHOOL KIDS?
1715	BEQ	GOODCH>
1716	CMPI	13		;CARRIAGE RETURN?
1717	BEQ	FININ1		;YES, FINISH UP.
1718IFN	REALIO-3,<
1719	CMPI	32		;CHECK FOR FUNNY CHARACTERS.
1720	BCC	INLINC
1721	CMPI	125		;IS IT TILDA OR DELETE?
1722	BCS	INLINC		;BIG BAD ONES TOO.
1723	CMPI	"@"		;LINE DELETE?
1724	BEQ	INLINN		;YES.
1725	CMPI	"_"		;CHARACTER DELETE?
1726	BEQ	LINLIN>		;YES.
1727GOODCH:
1728IFN	REALIO-3,<
1729	CPXI	BUFLEN-1	;LEAVE ROOM FOR NULL.
1730			;COMMO ASSURES US NEVER MORE THAN BUFLEN.
1731	BCS	OUTBEL>
1732	STA	BUF,X
1733	INX
1734IFE	REALIO-2,<SKIP2>
1735IFN	REALIO-2,<BNE INLINC>
1736IFN REALIO-3,<
1737OUTBEL: LDAI	7
1738IFN	REALIO,<
1739	JSR	OUTDO>		;ECHO IT.
1740	BNE	INLINC>		;CYCLE ALWAYS.
1741FININ1: JMP	FININL>		;GO TO FININL FAR, FAR AWAY.
1742INCHR:	
1743IFE	REALIO-3,<
1744	JSR	CQINCH>		;FOR COMMODORE.
1745IFE	REALIO-2,<
1746INCHRL: LDA	^O176000
1747	REPEAT	4,<NOP>
1748	LSR	A,
1749	BCC	INCHRL
1750	LDA	^O176001	;GET THE CHARACTER.
1751	REPEAT	4,<NOP>
1752	ANDI	127>
1753IFE	REALIO-1,<
1754	JSR	^O17132>	;1E5A FOR MOS TECH.
1755IFE	REALIO-4,<
1756	JSR	CQINCH		;FD0C FOR APPLE COMPUTER.
1757	ANDI	127>
1758IFE	REALIO,<
1759	TJSR	INSIM##>	;GET A CHARACTER FROM SIMULATOR
1760
1761IFN	REALIO,<
1762IFN	EXTIO,<
1763	LDY	CHANNL		;CNT-O HAS NO EFFECT IF NOT FROM TERM.
1764	BNE	INCRTS>
1765	CMPI	CONTW		;SUPPRESS OUTPUT CHARACTER (^W).
1766	BNE	INCRTS		;NO, RETURN.
1767	PHA
1768	COM	CNTWFL		;COMPLEMENT ITS STATE.
1769	PLA>
1770INCRTS: RTS			;END OF INCHR.
1771	
1772;
1773; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE
1774; BYTES WITH THE MSB ON. THIS SAVES SPACE AND TIME 
1775; BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION.
1776; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE
1777; RESERVED WORD LIST IN THE SAME ORDER THEY
1778; APPEAR IN STMDSP.
1779;
1780BUFOFS=0			;THE AMOUNT TO OFFSET THE LOW BYTE
1781				;OF THE TEXT POINTER TO GET TO BUF
1782				;AFTER TXTPTR HAS BEEN SETUP TO POINT INTO BUF
1783IFN	BUFPAG,<
1784BUFOFS=<BUF/256>*256>
1785CRUNCH: LDX	TXTPTR		;SET SOURCE POINTER.
1786	LDYI	4		;SET DESTINATION OFFSET.
1787	STY	DORES		;ALLOW CRUNCHING.
1788KLOOP:	LDA	BUFOFS,X
1789IFE	REALIO-3,<
1790	BPL	CMPSPC		;GO LOOK AT SPACES.
1791	CMPI	PI		;PI??
1792	BEQ	STUFFH		;GO SAVE IT.
1793	INX			;SKIP NO PRINTING.
1794	BNE	KLOOP>		;ALWAYS GOES.
1795CMPSPC: CMPI	" "		;IS IT A SPACE TO SAVE?
1796	BEQ	STUFFH		;YES, GO SAVE IT.
1797	STA	ENDCHR		;IF IT'S A QUOTE, THIS WILL
1798				;STOP LOOP WHEN OTHER QUOTE APPEARS.
1799	CMPI	34		;QUOTE SIGN?
1800	BEQ	STRNG		;YES, DO SPECIAL STRING HANDLING.
1801	BIT	DORES		;TEST FLAG.
1802	BVS	STUFFH		;NO CRUNCH, JUST STORE.
1803	CMPI	"?"		;A QMARK?
1804	BNE	KLOOP1
1805	LDAI	PRINTK		;YES, STUFF A "PRINT" TOKEN.
1806	BNE	STUFFH		;ALWAYS GO TO STUFFH.
1807KLOOP1: CMPI	"0"		;SKIP NUMERICS.
1808	BCC	MUSTCR
1809	CMPI	60		;":" AND ";" ARE ENTERED STRAIGHTAWAY.
1810	BCC	STUFFH
1811MUSTCR: STY	BUFPTR		;SAVE BUFFER POINTER.
1812	LDYI	0		;LOAD RESLST POINTER.
1813	STY	COUNT		;ALSO CLEAR COUNT.
1814	DEY
1815	STX	TXTPTR		;SAVE TEXT POINTER FOR LATER USE.
1816	DEX
1817RESER:	INY
1818RESPUL: INX
1819RESCON: LDA	BUFOFS,X
1820	SEC			;PREPARE TO SUBSTARCT.
1821	SBC	RESLST,Y	;CHARACTERS EQUAL?
1822	BEQ	RESER		;YES, CONTINUE SEARCH.
1823	CMPI	128		;NO BUT MAYBE THE END IS HERE.
1824	BNE	NTHIS		;NO, TRULY UNEQUAL.
1825	ORA	COUNT
1826GETBPT: LDY	BUFPTR		;GET BUFFER PNTR.
1827STUFFH: INX
1828	INY
1829	STA	BUF-5,Y
1830	LDA	BUF-5,Y
1831	BEQ	CRDONE		;NULL IMPLIES END OF LINE.
1832	SEC			;PREPARE TO SUBSTARCT.
1833	SBCI	":"		;IS IT A ":"?
1834	BEQ	COLIS		;YES, ALLOW CRUNCHING AGAIN.
1835	CMPI	DATATK-":"	;IS IT A DATATK?
1836	BNE	NODATT		;NO, SEE IF IT IS REM TOKEN.
1837COLIS:	STA	DORES		;SETUP FLAG.
1838NODATT: SEC			;PREP TO SBCQ
1839	SBCI	REMTK-":"	;REM ONLY STOPS ON NULL.
1840	BNE	KLOOP		;NO, CONTINUE CRUNCHING.
1841	STA	ENDCHR		;REM STOPS ONLY ON NULL, NOT : OR ".
1842STR1:	LDA	BUFOFS,X
1843	BEQ	STUFFH		;YES, END OF LINE, SO DONE.
1844	CMP	ENDCHR		;END OF GOBBLE?
1845	BEQ	STUFFH		;YES, DONE WITH STRING.
1846STRNG:	INY			;INCREMENT BUFFER POINTER.
1847	STA	BUF-5,Y
1848	INX
1849	BNE	STR1		;PROCESS NEXT CHARACTER.
1850NTHIS:	LDX	TXTPTR		;RESTORE TEXT POINTER.
1851	INC	COUNT		;INCREMENT RES WORD COUNT.
1852NTHIS1: INY
1853	LDA	RESLST-1,Y,	;GET RES CHARACTER.
1854	BPL	NTHIS1		;END OF ENTRY?
1855	LDA	RESLST,Y,	;YES. IS IT THE END?
1856	BNE	RESCON		;NO, TRY THE NEXT WORD.
1857	LDA	BUFOFS,X	;YES, END OF TABLE. GET 1ST CHR.
1858	BPL	GETBPT		;STORE IT AWAY (ALWAYS BRANCHES).
1859CRDONE: STA	BUF-3,Y,	;SO THAT IF THIS IS A DIR STATEMENT
1860				;ITS END WILL LOOK LIKE END OF PROGRAM.
1861IFN	<<BUF+BUFLEN>/256>-<<BUF-1>/256>,<
1862	DEC	TXTPTR+1>
1863	LDAI	<BUF&255>-1	;MAKE TXTPTR POINT TO
1864	STA	TXTPTR		;CRUNCHED LINE.
1865LISTRT: RTS			;RETURN TO CALLER.
1866;
1867; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE
1868; WHOSE NUMBER IS PASSED IN "LINNUM".
1869; THERE ARE TWO POSSIBLE RETURNS:
1870;
1871;	1) CARRY SET.
1872;	   LOWTR POINTS TO THE LINK FIELD IN THE LINE
1873;	   WHICH IS THE ONE SEARCHED FOR.
1874;
1875;	2) CARRY NOT SET.
1876;	   LINE NOT FOUND. [LOWTR] POINTS TO THE LINE IN THE
1877;	   PROGRAM GREATER THAN THE ONE SOUGHT AFTER.
1878;
1879FNDLIN: LDWX	TXTTAB		;LOAD [X,A] WITH [TXTTAB]
1880FNDLNC: LDYI	1
1881	STWX	LOWTR		;STORE [X,A] INTO LOWTR
1882	LDADY	LOWTR		;SEE IF LINK IS 0
1883	BEQ	FLINRT
1884	INY
1885	INY
1886	LDA	LINNUM+1	;COMP HIGH ORDERS OF LINE NUMBERS.
1887	CMPDY	LOWTR
1888	BCC	FLNRTS		;NO SUCH LINE NUMBER.
1889	BEQ	FNDLO1
1890	DEY
1891	BNE	AFFRTS		;ALWAYS BRANCH.
1892FNDLO1: LDA	LINNUM
1893	DEY
1894	CMPDY	LOWTR		;COMPARE LOW ORDERS.
1895	BCC	FLNRTS		;NO SUCH NUMBER.
1896	BEQ	FLNRTS		;GO TIT.
1897AFFRTS: DEY
1898	LDADY	LOWTR		;FETCH LINK.
1899	TAX
1900	DEY
1901	LDADY	LOWTR
1902	BCS	FNDLNC		;ALWAYS BRANCHES.
1903FLINRT: CLC			;C MAY BE HIGH.
1904FLNRTS: RTS			;RETURN TO CALLER.
1905;
1906; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL
1907; AS VARIABLE SPACE.
1908;
1909SCRATH: BNE	FLNRTS		;MAKE SURE THERE IS A TERMINATOR.
1910SCRTCH: LDAI	0		;GET A CLEARER.
1911	TAY			;SET UP INDEX.
1912	STADY	TXTTAB		;CLEAR	FIRST LINK.
1913	INY
1914	STADY	TXTTAB
1915	LDA	TXTTAB
1916	CLC
1917	ADCI	2
1918	STA	VARTAB		;SETUP [VARTAB].
1919	LDA	TXTTAB+1
1920	ADCI	0
1921	STA	VARTAB+1
1922RUNC:	JSR	STXTPT
1923	LDAI	0		;SET ZERO FLAG
1924;
1925; THIS CODE IS FOR THE CLEAR COMMAND.
1926;
1927CLEAR:	BNE	STKRTS		;SYNTAX ERROR IF NO TERMINATOR.
1928;
1929; CLEAR INITIALIZES THE VARIABLE AND
1930; ARRAY SPACE BY RESETING ARYTAB (THE END OF SIMPLE VARIABLE SPACE)
1931; AND STREND (THE END OF ARRAY STORAGE). IT FALLS INTO "STKINI"
1932; WHICH RESETS THE STACK. 
1933;
1934CLEARC: LDWD	MEMSIZ		;FREE UP STRING SPACE.
1935	STWD	FRETOP
1936IFN	EXTIO,<
1937	JSR	CQCALL>		;CLOSE ALL OPEN FILES.
1938	LDWD	VARTAB		;LIBERATE THE
1939	STWD	ARYTAB		;VARIABLES AND
1940	STWD	STREND		;ARRAYS.
1941FLOAD:	JSR	RESTOR		;RESTORE DATA.
1942;
1943; STKINI RESETS THE STACK POINTER ELIMINATING
1944; GOSUB AND FOR CONTEXT. STRING TEMPORARIES ARE FREED
1945; UP, SUBFLG IS RESET. CONTINUING IS PROHIBITED.
1946; AND A DUMMY ENTRY IS LEFT AT THE BOTTOM OF THE STACK SO "FNDFOR" WILL ALWAYS
1947; FIND A NON-"FOR" ENTRY AT THE BOTTOM OF THE STACK.
1948;
1949STKINI: LDXI	TEMPST		;INITIALIZE STRING TEMPORARIES.
1950	STX	TEMPPT
1951	PLA			;SETUP RETURN ADDRESS.
1952	TAY
1953	PLA
1954	LDXI	STKEND-257
1955	TXS
1956	PHA
1957	TYA
1958	PHA
1959	LDAI	0
1960	STA	OLDTXT+1	;DISALLOWING CONTINUING
1961	STA	SUBFLG		;ALLOW SUBSCRIPTS.
1962STKRTS: RTS
1963
1964STXTPT: CLC
1965	LDA	TXTTAB
1966	ADCI	255
1967	STA	TXTPTR
1968	LDA	TXTTAB+1
1969	ADCI	255
1970	STA	TXTPTR+1	;SETUP TEXT POINTER.
1971	RTS
1972PAGE
1973SUBTTL	THE "LIST" COMMAND.
1974
1975LIST:	BCC	GOLST		;IT IS A DIGIT.
1976	BEQ	GOLST		;IT IS A TERMINATOR.
1977	CMPI	MINUTK		;DASH PRECEDING?
1978	BNE	STKRTS		;NO, SO SYNTAX ERROR.
1979GOLST:	JSR	LINGET		;GET LINE NUMBER INTO NUMLIN.
1980	JSR	FNDLIN		;FIND LINE .GE. [NUMLIN].
1981	JSR	CHRGOT		;GET LAST CHARACTER.
1982	BEQ	LSTEND		;IF END OF LINE, # IS THE END.
1983	CMPI	MINUTK		;DASH?
1984	BNE	FLNRTS		;IF NOT, SYNTAX ERROR.
1985	JSR	CHRGET		;GET NEXT CHAR.
1986	JSR	LINGET		;GET END #.
1987	BNE	FLNRTS		;IF NOT TERMINATOR, ERROR.
1988LSTEND: PLA
1989	PLA			;GET RID OF "NEWSTT" RTS ADDR.
1990	LDA	LINNUM		;SEE IF IT WAS EXISTENT.
1991	ORA	LINNUM+1
1992	BNE	LIST4		;IT WAS TYPED.
1993	LDAI	255
1994	STA	LINNUM
1995	STA	LINNUM+1	;MAKE IT HUGE.
1996LIST4:	LDYI	1
1997IFE	REALIO-3,<
1998	STY	DORES>
1999	LDADY	LOWTR		;IS LINK ZERO?
2000	BEQ	GRODY		;YES, GO TO READY.
2001IFN	REALIO,<
2002	JSR	ISCNTC>		;LISTEN FOR CONT-C.
2003	JSR	CRDO		;PRINT CRLF TO START WITH.
2004	INY
2005	LDADY	LOWTR
2006	TAX
2007	INY
2008	LDADY	LOWTR		;GET LINE NUMBER.
2009	CMP	LINNUM+1	;SEE IF BEYOND LAST.
2010	BNE	TSTDUN		;GO DETERMINE RELATION.
2011	CPX	LINNUM		;WAS EQUAL SO TEST LOW ORDER.
2012	BEQ	TYPLIN		;EQUAL, SO LIST IT.
2013TSTDUN: BCS	GRODY		;IF LINE IS GR THAN LAST, THEN DUNE.
2014TYPLIN: STY	LSTPNT
2015	JSR	LINPRT		;PRINT AS INT WITHOUT LEADING SPACE.
2016	LDAI	" "		;ALWAYS PRINT SPACE AFTER NUMBER.
2017PRIT4:	LDY	LSTPNT		;GET POINTER TO LINE BACK.
2018	ANDI	127
2019PLOOP:	JSR	OUTDO		;PRINT CHAR.
2020IFE	REALIO-3,<
2021	CMPI	34
2022	BNE	PLOOP1
2023	COM	DORES>		;IF QUOTE, COMPLEMENT FLAG.
2024PLOOP1: INY
2025	BEQ	GRODY		;IF WE HAVE PRINTED 256 CHARACTERS
2026				;THE PROGRAM MUST BE MISFORMATED IN
2027				;MEMORY DUE TO A BAD LOAD OR BAD
2028				;HARDWARE. LET THE GUY RECOVER
2029	LDADY	LOWTR		;GET NEXT CHAR. IS IT ZERO?
2030	BNE	QPLOP		;YES. END OF LINE.
2031	TAY
2032	LDADY	LOWTR
2033	TAX
2034	INY
2035	LDADY	LOWTR
2036	STX	LOWTR
2037	STA	LOWTR+1
2038	BNE	LIST4		;BRANCH IF SOMETHING TO LIST.
2039GRODY:	JMP	READY
2040				;IS IT A TOKEN?
2041QPLOP:	BPL	PLOOP		;NO, HEAD FOR PRINTER.
2042IFE	REALIO-3,<
2043	CMPI	PI
2044	BEQ	PLOOP
2045	BIT	DORES		;INSIDE QUOTE MARKS?
2046	BMI	PLOOP>		;YES, JUST TYPE THE CHARACTER.
2047	SEC
2048	SBCI	127		;GET RID OF SIGN BIT AND ADD 1.
2049	TAX			;MAKE IT A COUNTER.
2050	STY	LSTPNT		;SAVE POINTER TO LINE.
2051	LDYI	255		;LOOK AT RES'D WORD LIST.
2052RESRCH: DEX			;IS THIS THE RES'D WORD?
2053	BEQ	PRIT3		;YES, GO TOSS IT UP..
2054RESCR1: INY
2055	LDA	RESLST,Y,	;END OF ENTRY?
2056	BPL	RESCR1		;NO, CONTINUE PASSING.
2057	BMI	RESRCH
2058PRIT3:	INY
2059	LDA	RESLST,Y
2060	BMI	PRIT4		;END OF RESERVED WORD.
2061	JSR	OUTDO		;PRINT IT.
2062	BNE	PRIT3		;END OF ENTRY? NO, TYPE REST.
2063PAGE
2064SUBTTL THE "FOR" STATEMENT.
2065;
2066; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
2067;
2068; LOW ADDRESS
2069;	TOKEN (FORTK) 1 BYTE
2070;	A POINTER TO THE LOOP VARIABLE 2 BYTES
2071;	THE STEP 4+ADDPRC BYTES
2072;	A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
2073;	THE UPPER VALUE 4+ADDPRC BYTES
2074;	THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
2075;	A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
2076; HIGH ADDRESS
2077;
2078; TOTAL 16+2*ADDPRC BYTES.
2079;
2080
2081FOR:	LDAI	128		;DON'T RECOGNIZE
2082	STA	SUBFLG		;SUBSCRIPTED VARIABLES.
2083	JSR	LET		;READ THE VARIABLE AND ASSIGN IT
2084				;THE CORRECT INITIAL VALUE AND STORE
2085				;A POINTER TO THE VARIABLE IN VARPNT.
2086	JSR	FNDFOR		;PNTR IS IN VARPNT, AND FORPNT.
2087	BNE	NOTOL		;IF NO MATCH, DON'T ELIMINATE ANYTHING.
2088	TXA			;MAKE IT ARITHMETICAL.
2089	ADCI	FORSIZ-3	;ELIMINATE ALMOST ALL.
2090	TAX			;NOTE C=1, THEN PLA, PLA.
2091	TXS			;MANIFEST.
2092NOTOL:	PLA			;GET RID OF NEWSTT RETURN ADDRESS
2093	PLA			;IN CASE THIS IS A TOTALLY NEW ENTRY.
2094	LDAI	8+ADDPRC
2095	JSR	GETSTK		;MAKE SURE 16 BYTES ARE AVAILABLE.
2096	JSR	DATAN		;GET A COUNT IN [Y] OF THE NUMBER OF
2097				;CHACRACTERS LEFT IN THE "FOR" STATEMENT
2098				;[TXTPTR] IS UNAFFECTED.
2099	CLC			;PREP TO ADD.
2100	TYA			;SAVE IT FOR PUSHING.
2101	ADC	TXTPTR
2102	PHA
2103	LDA	TXTPTR+1
2104	ADCI	0
2105	PHA
2106	PSHWD	CURLIN		;PUT LINE NUMBER ON STACK.
2107	SYNCHK	TOTK		;"TO" IS NECESSARY.
2108	JSR	CHKNUM		;VALUE MUST BE A NUMBER.
2109	JSR	FRMNUM		;GET UPPER VALUE INTO FAC.
2110	LDA	FACSGN		;PACK FAC.
2111	ORAI	127
2112	AND	FACHO
2113	STA	FACHO		;SET PACKED SIGN BIT.
2114	LDWDI	LDFONE
2115	STWD	INDEX1
2116	JMP	FORPSH		;PUT FAC ONTO STACK, PACKED.
2117LDFONE: LDWDI	FONE		;PUT 1.0 INTO FAC.
2118	JSR	MOVFM
2119	JSR	CHRGOT
2120	CMPI	STEPTK		;A STEP IS GIVEN?
2121	BNE	ONEON		;NO. ASSUME 1.0.
2122	JSR	CHRGET		;YES. ADVANCE POINTER.
2123	JSR	FRMNUM		;READ THE STEP.
2124ONEON:	JSR	SIGN		;GET SIGN IN ACCA.
2125	JSR	PUSHF		;PUSH FAC ONTO STACK (THRU A).
2126	PSHWD	FORPNT		;PUT PNTR TO VARIABLE ON STACK.
2127NXTCON: LDAI	FORTK		;PUT A FORTK ONTO STACK.
2128	PHA
2129;	BNEA	NEWSTT		;SIMULATE BNE TO NEWSTT. JUST FALL IN.
2130PAGE
2131SUBTTL	NEW STATEMENT FETCHER.
2132;
2133; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY TXTPTR
2134; IS ":" OR END-OF-LINE. THE ADDRESS OF THIS LOC IS LEFT
2135; ON THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
2136; IT CAN MERELY DO A RTS WHEN IT IS DONE.
2137;
2138NEWSTT: IFN	REALIO,<
2139	JSR	ISCNTC>		;LISTEN FOR CONTROL-C.
2140	LDWD	TXTPTR		;LOOK AT CURRENT CHARACTER.
2141IFN	BUFPAG,<
2142	CPYI	BUFPAG>		;SEE IF IT WAS DIRECT BY CHECK FOR BUF'S PAGE NUMBER
2143	BEQ	DIRCON
2144	STWD	OLDTXT		;SAVE IN CASE OF RESTART BY INPUT.
2145IFN	BUFPAG,<DIRCON:>
2146	LDYI	0
2147IFE	BUFPAG,<DIRCON:>
2148	LDADY	TXTPTR
2149	BNE	MORSTS		;NOT NULL -- CHECK WHAT IT IS
2150	LDYI	2		;LOOK AT LINK.
2151	LDADY	TXTPTR		;IS LINK 0?
2152	CLC		;CLEAR CARRY FOR ENDCON AND MATH THAT FOLLOWS
2153	JEQ	ENDCON		;YES - RAN OFF THE END.
2154	INY			;PUT LINE NUMBER IN CURLIN.
2155	LDADY	TXTPTR
2156	STA	CURLIN
2157	INY
2158	LDADY	TXTPTR
2159	STA	CURLIN+1
2160	TYA
2161	ADC	TXTPTR
2162	STA	TXTPTR
2163	BCC	GONE
2164	INC	TXTPTR+1
2165GONE:	JSR	CHRGET		;GET THE STATEMENT TYPE.
2166	JSR	GONE3
2167	JMP	NEWSTT
2168GONE3:	BEQ	ISCRTS		;IF TERMINATOR, TRY AGAIN.
2169				;NO NEED TO SET UP CARRY SINCE IT WILL
2170				;BE ON IF NON-NUMERIC AND NUMERICS
2171				;WILL CAUSE A SYNTAX ERROR LIKE THEY SHOULD
2172GONE2:	SBCI	ENDTK		;" ON ... GOTO AND GOSUB" COME HERE.
2173	BCC	GLET
2174	CMPI	SCRATK-ENDTK+1
2175	BCS	SNERRX		;SOME RES'D WORD BUT NOT
2176				;A STATEMENT RES'D WORD.
2177	ASL	A,		;MULTIPLY BY TWO.
2178	TAY			;MAKE AN INDEX.
2179	LDA	STMDSP+1,Y
2180	PHA
2181	LDA	STMDSP,Y
2182	PHA			;PUT DISP ADDR ONTO STACK.
2183	JMP	CHRGET
2184GLET:	JMP	LET		;MUST BE A LET
2185MORSTS: CMPI	":"
2186	BEQ	GONE		;IF A ":" CONTINUE STATEMENT
2187SNERR1: JMP	SNERR		;NEITHER 0 OR ":" SO SYNTAX ERROR
2188SNERRX: CMPI	GOTK-ENDTK
2189	BNE	SNERR1
2190	JSR	CHRGET		;READ IN THE CHARACTER AFTER "GO "
2191	SYNCHK	TOTK
2192	JMP	GOTO
2193PAGE
2194SUBTTL	RESTORE,STOP,END,CONTINUE,NULL,CLEAR.
2195
2196RESTOR: SEC
2197	LDA	TXTTAB
2198	SBCI	1
2199	LDY	TXTTAB+1
2200	BCS	RESFIN
2201	DEY
2202RESFIN: STWD	DATPTR		;READ FINISHES COME TO "RESFIN".
2203ISCRTS: RTS
2204
2205IFE	REALIO-1,<
2206ISCNTC: LDAI	1
2207	BIT	^O13500
2208	BMI	ISCRTS
2209	LDXI	8
2210	LDAI	3
2211	CMPI	3>
2212IFE	REALIO-2,<
2213ISCNTC: LDA	^O176000
2214	REPEAT	4,<NOP>
2215	LSR	A,
2216	BCC	ISCRTS
2217	JSR	INCHR		;EAT CHAR THAT WAS TYPED
2218	CMPI	3>		;WAS IT A CONTROL-C??
2219
2220IFE	REALIO-4,<
2221ISCNTC: LDA	^O140000	;CHECK THE CHARACTER
2222	CMPI	^O203
2223	BEQ	ISCCAP
2224	RTS
2225ISCCAP: JSR	INCHR
2226	CMPI	^O203>
2227STOP:	BCS	STOPC		;MAKE [C] NONZERO AS A FLAG.
2228END:	CLC
2229STOPC:	BNE	CONTRT		;RETURN IF NOT CONT-C OR
2230				;IF NO TERMINATOR FOR STOP OR END.
2231				;[C]=0 SO WILL NOT PRINT "BREAK".
2232	LDWD	TXTPTR
2233IFN	BUFPAG,<
2234	LDX	CURLIN+1
2235	INX>
2236	BEQ	DIRIS
2237	STWD	OLDTXT
2238STPEND: LDWD	CURLIN
2239	STWD	OLDLIN
2240DIRIS:	PLA			;POP OFF NEWSTT ADDR.
2241	PLA
2242ENDCON: LDWDI	BRKTXT
2243IFN	REALIO,<
2244	LDXI	0
2245	STX	CNTWFL>
2246	BCC	GORDY		;CARRY CLEAR SO DON'T PRINT "BREAK".
2247	JMP	ERRFIN
2248GORDY:	JMP	READY		;TYPE "READY".
2249
2250IFE	REALIO,<
2251DDT:	PLA			;GET RID OF NEWSTT RETURN.
2252	PLA
2253	HRRZ	14,.JBDDT##
2254	JRST	0(14)>
2255CONT:	BNE	CONTRT		;MAKE SURE THERE IS A TERMINATOR.
2256	LDXI	ERRCN		;CONTINUE ERROR.
2257	LDY	OLDTXT+1	;A STORED TXTPTR OF ZERO IS SETUP
2258				;BY STKINI AND INDICATES THERE IS
2259				;NOTHING TO CONTINUE.
2260	JEQ	ERROR		;"STOP", "END", TYPING CRLF TO 
2261				;"INPUT" AND  ^C SETUP OLDTXT.
2262	LDA	OLDTXT
2263	STWD	TXTPTR
2264	LDWD	OLDLIN
2265	STWD	CURLIN
2266CONTRT: RTS			;RETURN TO CALLER.
2267
2268IFN	NULCMD,<
2269NULL:	JSR	GETBYT
2270	BNE	CONTRT		;MAKE SURE THERE IS TERMINATOR.
2271	INX
2272	CPXI	240		;IS THE NUMBER REASONABLE?
2273	BCS	FCERR1		;"FUNCTION CALL" ERROR.
2274	DEX			;BACK -1
2275	STX	NULCNT
2276	RTS
2277FCERR1: JMP	FCERR>
2278PAGE
2279SUBTTL	LOAD AND SAVE SUBROUTINES.
2280
2281IFE	REALIO-1,<		;KIM CASSETTE I/O
2282SAVE:	TSX			;SAVE STACK POINTER
2283	STX	INPFLG
2284	LDAI	STKEND-256-200
2285	STA	^O362		;SETUP DUMMY STACK FOR KIM MONITOR
2286	LDAI	254		;MAKE ID BYTE EQUAL TO FF HEX
2287	STA	^O13771		;STORE INTO KIM ID
2288	LDWD	TXTTAB		;START DUMPING FROM TXTTAB
2289	STWD	^O13765		;SETUP SAL,SAH
2290	LDWD	VARTAB		;STOP AT VARTAB
2291	STWD	^O13767		;SETUP EAL,EAH
2292	JMP	^O14000
2293RETSAV: LDX	INPFLG		;RESORE THE REAL STACK POINTER
2294	TXS
2295	LDWDI	TAPMES		;SAY IT WAS DONE
2296	JMP	STROUT
2297GLOAD:	DT"LOADED"
2298	0
2299TAPMES: DT"SAVED"
2300	ACRLF
2301	0
2302PATSAV: BLOCK 20
2303LOAD:	LDWD	TXTTAB		;START DUMPING IN AT TXTTAB
2304	STWD	^O13765		;SETUP SAL,SAH
2305	LDAI	255
2306	STA	^O13771
2307	LDWDI	RTLOAD
2308	STWD	^O1		;SET UP RETURN ADDRESS FOR LOAD
2309	JMP	^O14163		;GO READ THE DATA IN
2310RTLOAD: LDXI	STKEND-256		;RESET THE STACK
2311	TXS
2312	LDWDI	READY
2313	STWD	^O1
2314	LDWDI	GLOAD		;TELL HIM IT WORKED
2315	JSR	STROUT
2316	LDXY	^O13755		;GET LAST LOCATION
2317	TXA			;ITS ONE TOO BIG
2318	BNE	DECVRT		;DECREMENT [X,Y]
2319	NOP
2320DECVRT: NOP
2321	STXY	VARTAB		;SETUP NEW VARIABLE LOCATION
2322	JMP	FINI>		;RELINK THE PROGRAM
2323IFE	REALIO-4,<
2324SAVE:	SEC			;CALCLUATE PROGRAM SIZE IN POKER
2325	LDA	VARTAB
2326	SBC	TXTTAB
2327	STA	POKER
2328	LDA	VARTAB+1
2329	SBC	TXTTAB+1
2330	STA	POKER+1
2331	JSR	VARTIO
2332	JSR	CQCOUT		;WRITE PROGRAM SIZE [POKER]
2333	JSR	PROGIO
2334	JMP	CQCOUT		;WRITE PROGRAM.
2335
2336LOAD:	JSR	VARTIO
2337	JSR	CQCSIN		;READ SIZE OF PROGRAM INTO POKER
2338	CLC
2339	LDA	TXTTAB		;CALCULATE VARTAB FROM SIZE AND
2340	ADC	POKER		;TXTTAB
2341	STA	VARTAB
2342	LDA	TXTTAB+1
2343	ADC	POKER+1
2344	STA	VARTAB+1
2345	JSR	PROGIO
2346	JSR	CQCSIN		;READ PROGRAM.
2347	LDWDI	TPDONE
2348	JSR	STROUT
2349	JMP	FINI
2350
2351TPDONE: DT"LOADED"
2352	0
2353
2354VARTIO: LDWDI	POKER
2355	STWD	^O74
2356	LDAI	POKER+2
2357	STWD	^O76
2358	RTS
2359PROGIO: LDWD	TXTTAB
2360	STWD	^O74
2361	LDWD	VARTAB
2362	STWD	^O76
2363	RTS>
2364PAGE
2365SUBTTL	RUN,GOTO,GOSUB,RETURN.
2366RUN:	JEQ	RUNC		;IF NO LINE # ARGUMENT.
2367	JSR	CLEARC		;CLEAN UP -- RESET THE STACK.
2368	JMP	RUNC2		;MUST REPLACE RTS ADDR.
2369;
2370; A GOSUB ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
2371;
2372; LOW ADDRESS:
2373;	THE GOSUTK ONE BYTE
2374;	THE LINE NUMBER OF THE GOSUB STATEMENT TWO BYTES
2375;	A POINTER INTO THE TEXT OF THE GOSUB TWO BYTES
2376;
2377; HIGH ADDRESS.
2378;
2379; TOTAL FIVE BYTES.
2380;
2381GOSUB:	LDAI	3
2382	JSR	GETSTK		;MAKE SURE THERE IS ROOM.
2383	PSHWD	TXTPTR		;PUSH ON THE TEXT POINTER.
2384	PSHWD	CURLIN		;PUSH ON THE CURRENT LINE NUMBER.
2385	LDAI	GOSUTK
2386	PHA			;PUSH ON A GOSUB TOKEN.
2387RUNC2:	JSR	CHRGOT		;GET CHARACTER AND SET CODES FOR LINGET.
2388	JSR	GOTO		;USE RTS SCHEME TO "NEWSTT".
2389	JMP	NEWSTT
2390
2391GOTO:	JSR	LINGET		;PICK UP THE LINE NUMBER IN "LINNUM".
2392	JSR	REMN		;SKIP TO END OF LINE.
2393	LDA	CURLIN+1
2394	CMP	LINNUM+1
2395	BCS	LUK4IT
2396	TYA
2397	SEC
2398	ADC	TXTPTR
2399	LDX	TXTPTR+1
2400	BCC	LUKALL
2401	INX
2402	BCSA	LUKALL		;ALWAYS GOES.
2403LUK4IT: LDWX	TXTTAB
2404LUKALL: JSR	FNDLNC		;[X,A] ARE ALL SET UP.
2405QFOUND: BCC	USERR		;GOTO LINE IS NONEXISTANT.
2406	LDA	LOWTR
2407	SBCI	1
2408	STA	TXTPTR
2409	LDA	LOWTR+1
2410	SBCI	0
2411	STA	TXTPTR+1
2412GORTS:	RTS			;PROCESS THE STATEMENT.
2413;
2414; "RETURN" RESTORES THE LINE NUMBER AND TEXT PNTR FROM THE STACK
2415; AND ELIMINATES ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB" ENTRY.
2416;
2417RETURN: BNE	GORTS		;NO TERMINATOR=BLOW HIM UP.
2418	LDAI	255
2419	STA	FORPNT+1	;MAKE SURE THE VARIABLE'S PNTR
2420				;NEVER GETS MATCHED.
2421	JSR	FNDFOR		;GO PAST ALL THE "FOR" ENTRIES.
2422	TXS
2423	CMPI	GOSUTK		;RETURN WITHOUT GOSUB?
2424	BEQ	RETU1
2425	LDXI	ERRRG
2426	SKIP2
2427USERR:	LDXI	ERRUS		;NO MATCH SO "US" ERROR.
2428	JMP	ERROR		;YES.
2429SNERR2: JMP	SNERR
2430RETU1:	PLA			;REMOVE GOSUTK.
2431	PULWD	CURLIN		;GET LINE NUMBER "GOSUB" WAS FROM.
2432	PULWD	TXTPTR		;GET TEXT PNTR FROM "GOSUB".
2433DATA:	JSR	DATAN		;SKIP TO END OF STATEMENT, 
2434				;SINCE WHEN "GOSUB" STUCK THE TEXT  PNTR
2435				;ONTO THE STACK, THE LINE NUMBER ARG
2436				;HADN'T BEEN READ YET.
2437ADDON:	TYA
2438	CLC
2439	ADC	TXTPTR
2440	STA	TXTPTR
2441	BCC	REMRTS
2442	INC	TXTPTR+1
2443REMRTS: RTS			;"NEWSTT" RTS ADDR IS STILL THERE.
2444
2445DATAN:	LDXI	":"		;"DATA" TERMINATES ON ":" AND NULL.
2446	SKIP2
2447REMN:	LDXI	0		;THE ONLY TERMINATOR IS NULL.
2448	STX	CHARAC		;PRESERVE IT.
2449	LDYI	0		;THIS MAKES CHARAC=0 AFTER SWAP.
2450	STY	ENDCHR
2451EXCHQT: LDA	ENDCHR
2452	LDX	CHARAC
2453	STA	CHARAC
2454	STX	ENDCHR
2455REMER:	LDADY	TXTPTR
2456	BEQ	REMRTS		;NULL ALWAYS TERMINATES.
2457	CMP	ENDCHR		;IS IT THE OTHER TERMINATOR?
2458	BEQ	REMRTS		;YES, IT'S FINISHED.
2459	INY			;PROGRESS TO NEXT CHARACTER.
2460	CMPI	34		;IS IT A QUOTE?
2461	BNE	REMER		;NO, JUST CONTINUE.
2462	BEQA	EXCHQT		;YES, TIME TO TRADE.
2463PAGE
2464SUBTTL	"IF ... THEN" CODE.
2465IF:	JSR	FRMEVL		;EVALUATE A FORMULA.
2466	JSR	CHRGOT		;GET CURRENT CHARACTER.
2467	CMPI	GOTOTK		;IS TERMINATING CHARACTER A GOTOTK?
2468	BEQ	OKGOTO		;YES.
2469	SYNCHK	THENTK		;NO, IT MUST BE "THEN".
2470OKGOTO: LDA	FACEXP		;0=FALSE. ALL OTHERS TRUE.
2471	BNE	DOCOND		;TRUE !
2472REM:	JSR	REMN		;SKIP REST OF STATEMENT.
2473	BEQA	ADDON		;WILL ALWAYS BRANCH.
2474DOCOND: JSR	CHRGOT		;TEST CURRENT CHARACTER.
2475	BCS	DOCO		;IF A NUMBER, GOTO IT.
2476	JMP	GOTO
2477DOCO:	JMP	GONE3		;INTERPRET NEW STATEMENT.
2478PAGE
2479SUBTTL	"ON ... GO TO ..." CODE.
2480ONGOTO: JSR	GETBYT		;GET VALUE IN FACLO.
2481	PHA			;SAVE FOR LATER.
2482	CMPI	GOSUTK		;AN "ON ... GOSUB" PERHAPS?
2483	BEQ	ONGLOP		;YES.
2484SNERR3: CMPI	GOTOTK		;MUST BE "GOTOTK".
2485	BNE	SNERR2
2486ONGLOP: DEC	FACLO
2487	BNE	ONGLP1		;SKIP ANOTHER LINE NUMBER.
2488	PLA			;GET DISPATCH CHARACTER.
2489	JMP	GONE2
2490ONGLP1: JSR	CHRGET		;ADVANCE AND SET CODES.
2491	JSR	LINGET
2492	CMPI	44		;IS IT A COMMA?
2493	BEQ	ONGLOP
2494	PLA			;REMOVE STACK ENTRY (TOKEN).
2495ONGRTS: RTS			;EITHER END-OF-LINE OR SYNTAX ERROR.
2496PAGE
2497SUBTTL	LINGET -- READ A LINE NUMBER INTO LINNUM
2498;
2499; "LINGET" READS A LINE NUMBER FROM THE CURRENT TEXT POSITION.
2500;
2501; LINE NUMBERS RANGE FROM 0 TO 64000-1.
2502;
2503; THE ANSWER IS RETURNED IN "LINNUM".
2504; "TXTPTR" IS UPDATED TO POINT TO THE TERMINATING CHARCTER
2505; AND [A] = THE TERMINATING CHARACTER WITH CONDITION
2506; CODES SET UP TO REFLECT ITS VALUE.
2507;
2508LINGET: LDXI	0
2509	STX	LINNUM		;INITIALIZE LINE NUMBER TO ZERO.
2510	STX	LINNUM+1
2511MORLIN: BCS	ONGRTS		;IT IS NOT A DIGIT.
2512	SBCI	"0"-1		;-1 SINCE C=0.
2513	STA	CHARAC		;SAVE CHARACTER.
2514	LDA	LINNUM+1
2515	STA	INDEX
2516	CMPI	25		;LINE NUMBER WILL BE .LT. 64000?
2517	BCS	SNERR3
2518	LDA	LINNUM
2519	ASL	A,		;MULTIPLY BY 10.
2520	ROL	INDEX
2521	ASL	A
2522	ROL	INDEX
2523	ADC	LINNUM
2524	STA	LINNUM
2525	LDA	INDEX
2526	ADC	LINNUM+1
2527	STA	LINNUM+1
2528	ASL	LINNUM
2529	ROL	LINNUM+1
2530	LDA	LINNUM
2531	ADC	CHARAC		;ADD IN DIGIT.
2532	STA	LINNUM
2533	BCC	NXTLGC
2534	INC	LINNUM+1
2535NXTLGC: JSR	CHRGET
2536	JMP	MORLIN
2537
2538PAGE
2539SUBTTL	"LET" CODE.
2540LET:	JSR	PTRGET		;GET PNTR TO VARIABLE INTO "VARPNT".
2541	STWD	FORPNT		;PRESERVE POINTER.
2542	SYNCHK	EQULTK		;"=" IS NECESSARY.
2543IFN	INTPRC,<
2544	LDA	INTFLG		;SAVE FOR LATER.
2545	PHA>
2546	LDA	VALTYP		;RETAIN THE VARIABLE'S VALUE TYPE.
2547	PHA
2548	JSR	FRMEVL		;GET VALUE OF FORMULA INTO "FAC".
2549	PLA
2550	ROL	A,		;CARRY SET FOR STRING, OFF FOR
2551				;NUMERIC.
2552	JSR	CHKVAL		;MAKE SURE "VALTYP" MATCHES CARRY.
2553				;AND SET ZERO FLAG FOR NUMERIC.
2554	BNE	COPSTR		;IF NUMERIC, COPY IT.
2555COPNUM:
2556IFN	INTPRC,<
2557	PLA			;GET NUMBER TYPE.
2558QINTGR: BPL	COPFLT		;STORE A FLTING NUMBER.
2559	JSR	ROUND		;ROUND INTEGER.
2560	JSR	AYINT		;MAKE 2-BYTE NUMBER.
2561	LDYI	0
2562	LDA	FACMO		;GET HIGH.
2563	STADY	FORPNT		;STORE IT.
2564	INY
2565	LDA	FACLO		;GET LOW.
2566	STADY	FORPNT
2567	RTS>
2568COPFLT: JMP	MOVVF		;PUT NUMBER @FORPNT.
2569
2570COPSTR:
2571IFN	INTPRC,<PLA>		;IF STRING, NO INTFLG.
2572INPCOM:
2573IFN	TIME,<
2574	LDY	FORPNT+1	;TI$?
2575	CPYI	ZERO/256	;ONLY TI$ CAN BE THIS ON ASSIG.
2576	BNE	GETSPT		; WAS NOT TI$.
2577	JSR	FREFAC		;WE WONT NEEDIT.
2578	CMPI	6		;LENGTH CORRECT?
2579	BNE	FCERR2
2580	LDYI	0		;YES. DO SETUP.
2581	STY	FACEXP		;ZERO FAC TO START WITH.
2582	STY	FACSGN
2583TIMELP: STY	FBUFPT		;SAVE POSOTION.
2584	JSR	TIMNUM		;GET A DIGIT.
2585	JSR	MUL10		;WHOLE QTY BY 10.
2586	INC	FBUFPT
2587	LDY	FBUFPT
2588	JSR	TIMNUM
2589	JSR	MOVAF
2590	TAX			;IF NUM=0 THEN NO MULT.
2591	BEQ	NOML6		;IF =0, GO TIT.
2592	INX			;MULT BY TWO.
2593	TXA
2594	JSR	FINML6		;ADD IN AND MULT BY 2 GIVES *6.
2595NOML6:	LDY	FBUFPT
2596	INY
2597	CPYI	6		;DONE ALL SIX?
2598	BNE	TIMELP
2599	JSR	MUL10		;ONE LAST TIME.
2600	JSR	QINT		;SHIFT IT OVER TO THE RIGHT.
2601	LDXI	2
2602	SEI			;DISALLOW INTERRUPTS.
2603TIMEST: LDA	FACMOH,X
2604	STA	CQTIMR,X
2605	DEX
2606	BPL	TIMEST		;LOOP 3 TIMES.
2607	CLI			;TURN ON INTS AGAIN.
2608	RTS
2609TIMNUM: LDADY	INDEX		;INDEX SET UP BY FREFAC.
2610	JSR	QNUM
2611	BCC	GOTNUM
2612FCERR2: JMP	FCERR		;MUST BE NUMERIC STRING.
2613GOTNUM: SBCI	"0"-1		;C IS OFF.
2614	JMP	FINLOG>		;ADD IN DIGIT TO FAC.
2615
2616GETSPT: LDYI	2		;GET PNTR TO DESCRIPTOR.
2617	LDADY	FACMO
2618	CMP	FRETOP+1	;SEE IF IT POINTS INTO STRING SPACE.
2619	BCC	DNTCPY		;IF [FRETOP],GT.[2&3,FACMO], DON'T COPY.
2620	BNE	QVARIA		;IT IS LESS.
2621	DEY
2622	LDADY	FACMO
2623	CMP	FRETOP		;COMPARE LOW ORDERS.
2624	BCC	DNTCPY
2625QVARIA: LDY	FACLO
2626	CPY	VARTAB+1	;IF [VARTAB].GT.[FACMO], DON'T COPY.
2627	BCC	DNTCPY
2628	BNE	COPY		;IT IS LESS.
2629	LDA	FACMO
2630	CMP	VARTAB		;COMPARE LOW ORDERS.
2631	BCS	COPY
2632DNTCPY: LDWD	FACMO
2633	JMP	COPYZC
2634COPY:	LDYI	0
2635	LDADY	FACMO
2636	JSR	STRINI		;GET ROOM TO COPY STRING INTO.
2637	LDWD	DSCPNT		;GET POINTER TO OLD DESCRIPTOR, SO 
2638	STWD	STRNG1		;MOVINS CAN FIND STRING.
2639	JSR	MOVINS		;COPY IT.
2640	LDWDI	DSCTMP		;GET POINTER TO OLD DESCRIPTOR.
2641COPYZC: STWD	DSCPNT		;REMEMBER POINTER TO DESCRIPTOR.
2642	JSR	FRETMS		;FREE UP THE TEMPORARY WITHOUT
2643				;FREEING UP ANY STRING SPACE.
2644	LDYI	0
2645	LDADY	DSCPNT
2646	STADY	FORPNT
2647	INY			;POINT TO STRING PNTR.
2648	LDADY	DSCPNT
2649	STADY	FORPNT
2650	INY
2651	LDADY	DSCPNT
2652	STADY	FORPNT
2653	RTS
2654PAGE
2655SUBTTL	PRINT CODE.
2656IFN	EXTIO,<
2657PRINTN: JSR	CMD		;DOCMD
2658	JMP	IODONE		;RELEASE CHANNEL.
2659CMD:	JSR	GETBYT
2660	BEQ	SAVEIT
2661	SYNCHK	44		;COMMA?
2662SAVEIT: PHP
2663	JSR	CQOOUT		;CHECK AND OPEN OUTPUT CHANNL.
2664	STX	CHANNL		;CHANNL TO OUTPUT ON.
2665	PLP			;GET STATUS BACK.
2666	JMP	PRINT>
2667STRDON: JSR	STRPRT
2668NEWCHR: JSR	CHRGOT		;REGET LAST CHARACTER.
2669PRINT:	BEQ	CRDO		;TERMINATOR SO TYPE CRLF.
2670PRINTC: BEQ	PRTRTS		;HERE AFTER SEEING TAB(X) OR , OR ;
2671				;IN WHICH CASE A TERMINATOR DOES NOT
2672				;MEAN TYPE A CRLF BUT JUST RTS.
2673	CMPI	TABTK		;TAB FUNCTION?
2674	BEQ	TABER		;YES.
2675	CMPI	SPCTK		;SPACE FUNCTION?
2676	CLC
2677	BEQ	TABER
2678	CMPI	44		;A COMMA?
2679	BEQ	COMPRT		;YES.
2680	CMPI	59		;A SEMICOLON?
2681	BEQ	NOTABR		;YES.
2682	JSR	FRMEVL		;EVALUATE THE FORMULA.
2683	BIT	VALTYP		;A STRING?
2684	BMI	STRDON		;YES.
2685	JSR	FOUT
2686	JSR	STRLIT		;BUILD DESCRIPTOR.
2687IFN	REALIO-3,<
2688	LDYI	0		;GET THE POINTER.
2689	LDADY	FACMO
2690	CLC
2691	ADC	TRMPOS		;MAKE SURE LEN+POS.LT.WIDTH.
2692	CMP	LINWID		;GREATER THAN LINE LENGTH?
2693				;REMEMBER SPACE PRINTED AFTER NUMBER.
2694	BCC	LINCHK		;GO TYPE.
2695	JSR	CRDO>		;YES, TYPE CRLF FIRST.
2696LINCHK: JSR	STRPRT		;PRINT THE NUMBER.
2697	JSR	OUTSPC		;PRINT A SPACE
2698	BNEA	NEWCHR		;ALWAYS GOES.
2699IFN	REALIO-4,<
2700IFN	BUFPAG,<
2701FININL: LDAI	0
2702	STA	BUF,X
2703	LDXYI	BUF-1>
2704IFE	BUFPAG,<
2705FININL: LDYI	0		;PUT A ZERO AT END OF BUF.
2706	STY	BUF,X
2707	LDXI	BUF-1>		;SETUP POINTER.
2708IFN	EXTIO,<
2709	LDA	CHANNL		;NO CRDO IF NOT TERMINAL.
2710	BNE	PRTRTS>>
2711CRDO:
2712IFE	EXTIO,<
2713	LDAI	13		;MAKE TRMPOS LESS THAN LINE LENGTH.
2714	STA	TRMPOS>
2715IFN	EXTIO,<
2716IFN	REALIO-3,<
2717	LDA	CHANNL
2718	BNE	GOCR
2719	STA	TRMPOS>
2720GOCR:	LDAI	13>		;X AND Y MUST BE PRESERVED.
2721	JSR	OUTDO
2722	LDAI	10
2723	JSR	OUTDO
2724CRFIN:
2725IFN	EXTIO,<
2726IFN	REALIO-3,<
2727	LDA	CHANNL
2728	BNE	PRTRTS>>
2729IFE	NULCMD,<
2730IFN	REALIO-3,<
2731	LDAI	0
2732	STA	TRMPOS>
2733	EORI	255>
2734IFN	NULCMD,<
2735	TXA			;PRESERVE [ACCX]. SOME NEED IT.
2736	PHA
2737	LDX	NULCNT		;GET NUMBER OF NULLS.
2738	BEQ	CLRPOS
2739	LDAI	0
2740PRTNUL: JSR	OUTDO
2741	DEX			;DONE WITH NULLS?
2742	BNE	PRTNUL
2743CLRPOS: STX	TRMPOS
2744	PLA
2745	TAX>
2746PRTRTS: RTS
2747
2748COMPRT: LDA	TRMPOS
2749NCMPOS==<<<LINLEN/CLMWID>-1>*CLMWID>	;CLMWID BEYOND WHICH THERE ARE
2750IFN	REALIO-3,<
2751				;NO MORE COMMA FIELDS.
2752	CMP	NCMWID		;SO ALL COMMA DOES IS "CRDO".
2753
2754	BCC	MORCOM
2755	JSR	CRDO		;TYPE CRLF.
2756	JMP	NOTABR>		;AND QUIT IF BEYOND LAST FIELD.
2757MORCOM: SEC
2758MORCO1: SBCI	CLMWID		;GET [A] MODULUS CLMWID.
2759	BCS	MORCO1
2760	EORI	255		;FILL PRINT POS OUT TO EVEN CLMWID SO
2761	ADCI	1
2762	BNE	ASPAC		;PRINT [A] SPACES.
2763
2764TABER:	PHP			;REMEMBER IF SPC OR TAB FUNCTION.
2765	JSR	GTBYTC		;GET VALUE INTO ACCX.
2766	CMPI	41
2767	BNE	SNERR4
2768	PLP
2769	BCC	XSPAC		;PRINT [X] SPACES.
2770	TXA
2771	SBC	TRMPOS
2772	BCC	NOTABR		;NEGATIVE, DON'T PRINT ANY.
2773ASPAC:	TAX
2774XSPAC:	INX
2775XSPAC2: DEX			;DECREMENT THE COUNT.
2776	BNE	XSPAC1
2777NOTABR: JSR	CHRGET		;REGET LAST CHARACTER.
2778	JMP	PRINTC		;DON'T CALL CRDO.
2779XSPAC1: JSR	OUTSPC
2780	BNEA	XSPAC2
2781;
2782; PRINT THE STRING POINTED TO BY [Y,A] WHICH ENDS WITH A ZERO.
2783; IF THE STRING IS BELOW DSCTMP IT WILL BE COPIED INTO STRING SPACE.
2784;
2785STROUT: JSR	STRLIT		;GET A STRING LITERAL.
2786;
2787; PRINT THE STRING WHOSE DESCRIPTOR IS POINTED TO BY FACMO.
2788;
2789STRPRT: JSR	FREFAC		;RETURN TEMP POINTER.
2790	TAX			;PUT COUNT INTO COUNTER.
2791	LDYI	0
2792	INX			;MOVE ONE AHEAD.
2793STRPR2: DEX
2794	BEQ	PRTRTS		;ALL DONE.
2795	LDADY	INDEX		;PNTR TO ACT STRNG SET BY FREFAC.
2796	JSR	OUTDO
2797	INY
2798	CMPI	13
2799	BNE	STRPR2
2800	JSR	CRFIN		;TYPE REST OF CARRIAGE RETURN.
2801	JMP	STRPR2		;AND ON AND ON.
2802;
2803; OUTDO OUTPUTS THE CHARACTER IN ACCA, USING CNTWFL
2804; (SUPPRESS OR NOT), TRMPOS (PRINT HEAD POSITION),
2805; TIMING, ETCQ. NO REGISTERS ARE CHANGED.
2806;
2807OUTSPC:
2808IFN	REALIO-3,<
2809	LDAI	" ">
2810IFE	REALIO-3,<
2811	LDA	CHANNL
2812	BEQ	CRTSKP
2813	LDAI	" "
2814	SKIP2
2815CRTSKP: LDAI	29>		;COMMODORE'S SKIP CHARACTER.
2816	SKIP2
2817OUTQST: LDAI	"?"
2818OUTDO:	IFN	REALIO,<
2819	BIT	CNTWFL		;SHOULDN'T AFFECT CHANNEL I/O!
2820	BMI	OUTRTS>
2821IFN	REALIO-3,<
2822	PHA
2823	CMPI	32		;IS THIS A PRINTING CHAR?
2824	BCC	TRYOUT		;NO, DON'T INCLUDE IT IN TRMPOS.
2825	LDA	TRMPOS
2826	CMP	LINWID		;LENGTH = TERMINAL WIDTH?
2827	BNE	OUTDO1
2828	JSR	CRDO		;YES, TYPE CRLF
2829OUTDO1:
2830IFN EXTIO,<
2831	LDA	CHANNL
2832	BNE	TRYOUT>
2833INCTRM: INC	TRMPOS		;INCREMENT COUNT.
2834TRYOUT: PLA>			;RESTORE THE A REGISTER
2835
2836IFE	REALIO-1,<
2837	STY	KIMY>		;PRESERVE Y.
2838IFE	REALIO-4,<ORAI	^O200>	;TURN ON B7 FOR APPLE.
2839IFN	REALIO,<
2840OUTLOC: JSR	OUTCH>		;OUTPUT THE CHARACTER.
2841IFE	REALIO-1,<
2842	LDY	KIMY>		;GET Y BACK.
2843IFE	REALIO-2,<REPEAT	4,<NOP>>
2844IFE	REALIO-4,<ANDI	^O177>	;GET [A] BACK FROM APPLE.
2845
2846IFE	REALIO,<
2847	TJSR	OUTSIM##>	;CALL SIMULATOR OUTPUT ROUTINE
2848OUTRTS: ANDI	255		;SET Z=0.
2849GETRTS: RTS
2850
2851PAGE
2852SUBTTL	INPUT AND READ CODE.
2853;
2854; HERE WHEN THE DATA THAT WAS TYPED IN OR IN "DATA" STATEMENTS
2855; IS IMPROPERLY FORMATTED. FOR "INPUT" WE START AGAIN.
2856; FOR "READ" WE GIVE A SYNTAX ERROR AT THE DATA LINE.
2857;
2858TRMNOK: LDA	INPFLG
2859	BEQ	TRMNO1		;IF INPUT TRY AGAIN.
2860IFN	GETCMD,<
2861	BMI	GETDTL
2862	LDYI	255		;MAKE IT LOOK DIRECT.
2863	BNEA	STCURL		;ALWAYS GOES.
2864GETDTL:>
2865	LDWD	DATLIN		;GET DATA LINE NUMBER.
2866STCURL: STWD	CURLIN		;MAKE IT CURRENT LINE.
2867SNERR4: JMP	SNERR
2868TRMNO1:
2869IFN	EXTIO,<
2870	LDA	CHANNL		;IF NOT TERMINAL, GIVE BAD DATA.
2871	BEQ	DOAGIN
2872	LDXI	ERRBD
2873	JMP	ERROR>
2874DOAGIN: LDWDI	TRYAGN
2875	JSR	STROUT		;PRINT "?REDO FROM START".
2876	LDWD	OLDTXT		;POINT AT START
2877	STWD	TXTPTR		;OF THIS CURRENT LINE.
2878	RTS			;GO TO "NEWSTT".
2879IFN	GETCMD,<
2880GET:	JSR	ERRDIR		;DIRECT IS NOT OK.
2881IFN	EXTIO,<
2882	CMPI	"#"		;SEE IF "GET#".
2883	BNE	GETTTY		;NO, JUST GET TTY INPUT.
2884	JSR	CHRGET		;MOVE UP TO NEXT BYTE.
2885	JSR	GETBYT		;GET CHANNEL INTO X
2886	SYNCHK	44		;COMMA?
2887	JSR	CQOIN		;GET CHANNEL OPEN FOR INPUT.
2888	STX	CHANNL>
2889GETTTY: LDXYI	BUF+1		;POINT TO 0.
2890IFN	BUFPAG,<
2891	LDAI	0		;TO STUFF AND TO POINT.
2892	STA	BUF+1>
2893IFE	BUFPAG,<
2894	STY	BUF+1>		;ZERO IT.
2895	LDAI	64		;TURN ON V-BIT.
2896	JSR	INPCO1		;DO THE GET.
2897IFN	EXTIO,<
2898	LDX	CHANNL
2899	BNE	IORELE>		;RELEASE.
2900	RTS>
2901
2902IFN	EXTIO,<
2903INPUTN: JSR	GETBYT		;GET CHANNEL NUMBER.
2904	SYNCHK	44		;A COMMA?
2905	JSR	CQOIN		;GO WHERE COMMODORE CHECKS IN OPEN.
2906	STX	CHANNL
2907	JSR	NOTQTI		;DO INPUT TO VARIABLES.
2908IODONE: LDA	CHANNL		;RELEASE CHANNEL.
2909IORELE: JSR	CQCCHN
2910	LDXI	0		;RESET CHANNEL TO TERMINAL.
2911	STX	CHANNL
2912	RTS>
2913INPUT:	IFN	REALIO,<
2914	LSR	CNTWFL>		;BE TALKATIVE.
2915	CMPI	34		;A QUOTE?
2916	BNE	NOTQTI		;NO MESSAGE.
2917	JSR	STRTXT		;LITERALIZE THE STRING IN TEXT
2918	SYNCHK	59		;MUST END WITH SEMICOLON.
2919	JSR	STRPRT		;PRINT IT OUT.
2920NOTQTI: JSR	ERRDIR		;USE COMMON ROUTINE SINCE DEF DIRECT
2921	LDAI	44		;GET COMMA.
2922	STA	BUF-1
2923				;IS ALSO ILLEGAL.
2924GETAGN: JSR	QINLIN		;TYPE "?" AND INPUT A LINE OF TEXT.
2925IFN	EXTIO,<
2926	LDA	CHANNL
2927	BEQ	BUFFUL
2928	LDA	CQSTAT		;GET STATUS BYTE.
2929	ANDI	2
2930	BEQ	BUFFUL		;A-OK.
2931	JSR	IODONE		;BAD. CLOSE CHANNEL.
2932	JMP	DATA		;SKIP REST OF INPUT.
2933BUFFUL:>
2934	LDA	BUF		;ANYTHING INPUT?
2935	BNE	INPCON		;YES, CONTINUE.
2936IFN	EXTIO,<
2937	LDA	CHANNL		;BLANK LINE MEANS GET ANOTHER.
2938	BNE	GETAGN>		;IF NOT TERMINAL.
2939	CLC			;MAKE SURE DONT PRINT BREAK
2940	JMP	STPEND		;NO, STOP.
2941QINLIN:
2942IFN	EXTIO,<
2943	LDA	CHANNL
2944	BNE	GINLIN>
2945	JSR	OUTQST
2946	JSR	OUTSPC
2947GINLIN: JMP	INLIN
2948READ:	LDXY	DATPTR		;GET LAST DATA LOCATION.
2949	XWD	^O1000,^O251	;LDAI TYA TO MAKE IT NONZERO.
2950IFE	BUFPAG,<
2951INPCON: >
2952	TYA
2953IFN	BUFPAG,<
2954	SKIP2
2955INPCON: LDAI	0>		;SET FLAG THAT THIS IS INPUT
2956INPCO1: STA	INPFLG		;STORE THE FLAG.
2957;
2958; IN THE PROCESSING OF DATA AND READ STATEMENTS:
2959; ONE POINTER POINTS TO THE DATA (IE, THE NUMBERS BEING FETCHED)
2960; AND ANOTHER POINTS TO THE LIST OF VARIABLES.
2961;
2962; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A
2963; TERMINATOR -- A , : OR END-OF-LINE.
2964;
2965; AT THIS POINT TXTPTR POINTS TO LIST OF VARIABLES AND
2966; [Y,X] POINTS TO DATA OR INPUT LINE.
2967;
2968	STXY	INPPTR
2969INLOOP: JSR	PTRGET		;READ VARIABLE LIST.
2970	STWD	FORPNT		;SAVE POINTER FOR "LET" STRING STUFFING.
2971				;RETURNS PNTR TOP VAR IN VARPNT.
2972	LDWD	TXTPTR		;SAVE TEXT PNTR.
2973	STWD	VARTXT
2974	LDXY	INPPTR
2975	STXY	TXTPTR
2976	JSR	CHRGOT		;GET IT AND SET Z IF TERM.
2977	BNE	DATBK1
2978	BIT	INPFLG
2979IFN	GETCMD,<
2980	BVC	QDATA
2981	JSR	CZGETL		;DON'T WANT INCHR. JUST ONE.
2982IFE	REALIO-4,<
2983	ANDI	127>
2984	STA	BUF		;MAKE IT FIRST CHARACTER.
2985	LDXYI	<BUF-1>		;POINT JUST BEFORE IT.
2986IFE	BUFPAG,<
2987	BEQA	DATBK>
2988IFN	BUFPAG,<
2989	BNEA	DATBK>>		;GO PROCESS.
2990QDATA:	BMI	DATLOP		;SEARCH FOR ANOTHER DATA STATEMENT.
2991IFN	EXTIO,<
2992	LDA	CHANNL
2993	BNE	GETNTH>
2994	JSR	OUTQST
2995GETNTH: JSR	QINLIN		;GET ANOTHER LINE.
2996DATBK:	STXY	TXTPTR		;SET FOR "CHRGET".
2997DATBK1: JSR	CHRGET
2998	BIT	VALTYP		;GET VALUE TYPE.
2999	BPL	NUMINS		;INPUT A NUMBER IF NUMERIC.
3000IFN	GETCMD,<
3001	BIT	INPFLG		;GET?
3002	BVC	SETQUT		;NO, GO SET QUOTE.
3003	INX
3004	STX	TXTPTR
3005	LDAI	0		;ZERO TERMINATORS.
3006	STA	CHARAC
3007	BEQA	RESETC>
3008SETQUT: STA	CHARAC		;ASSUME QUOTED STRING.
3009	CMPI	34		;TERMINATORS OK?
3010	BEQ	NOWGET		;YES.
3011	LDAI	":"		;SET TERMINATORS TO ":" AND
3012	STA	CHARAC
3013	LDAI	44		;COMMA.
3014RESETC: CLC
3015NOWGET: STA	ENDCHR
3016	LDWD	TXTPTR
3017	ADCI	0		;C IS SET PROPERLY ABOVE.
3018	BCC	NOWGE1
3019	INY
3020NOWGE1: JSR	STRLT2		;MAKE A STRING DESCRIPTOR FOR THE VALUE
3021				;AND COPY IF NECESSARY.
3022	JSR	ST2TXT		;SET TEXT POINTER.
3023	JSR	INPCOM		;DO ASSIGNMENT.
3024	JMP	STRDN2
3025NUMINS: JSR	FIN
3026IFE	INTPRC,<
3027	JSR	MOVVF>
3028IFN	INTPRC,<
3029	LDA	INTFLG		;SET CODES ON FLAG.
3030	JSR	QINTGR>		;GO DECIDE ON FLOAT.
3031STRDN2: JSR	CHRGOT		;READ LAST CHARACTER.
3032	BEQ	TRMOK		;":" OR EOL IS OK.
3033	CMPI	44		;A COMMA?
3034	JNE	TRMNOK
3035TRMOK:	LDWD	TXTPTR
3036	STWD	INPPTR		;SAVE FOR MORE READS.
3037	LDWD	VARTXT
3038	STWD	TXTPTR		;POINT TO VARIABLE LIST.
3039	JSR	CHRGOT		;LOOK AT LAST VARIABLE LIST CHARACTER.
3040	BEQ	VAREND		;THAT'S THE END OF THE LIST.
3041	JSR	CHKCOM		;NOT END. CHECK FOR COMMA.
3042	JMP	INLOOP
3043;
3044; SUBROUTINE TO FIND DATA
3045; THE SEARCH IS MADE BY USING THE EXECUTION CODE FOR DATA TO
3046; SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT
3047; IS COMPARED WITH "DATATK". EACH NEW LINE NUMBER
3048; IS STORED IN "DATLIN" SO THAT IF AN ERROR OCCURS
3049; WHILE READING DATA THE ERROR MESSAGE CAN GIVE THE LINE
3050; NUMBER OF THE ILL-FORMATTED DATA.
3051;
3052DATLOP: JSR	DATAN		;SKIP SOME TEXT.
3053	INY
3054	TAX			;END OF LINE?
3055	BNE	NOWLIN		;SHO AIN'T.
3056	LDXI	ERROD		;YES = "NO DATA" ERROR.
3057	INY
3058	LDADY	TXTPTR
3059	BEQ	ERRGO5
3060	INY
3061	LDADY	TXTPTR		;GET HIGH BYTE OF LINE NUMBER.
3062	STA	DATLIN
3063	INY
3064	LDADY	TXTPTR		;GET LOW BYTE.
3065	INY
3066	STA	DATLIN+1
3067NOWLIN: LDADY	TXTPTR		;HOW IS IT?
3068	TAX
3069	JSR	ADDON		;ADD [Y] TO [TXTPTR].
3070	CPXI	DATATK		;IS IT A "DATA" STATEMENT.
3071	BNE	DATLOP		;NOT QUITE RIGHT. KEEP LOOKING.
3072	JMP	DATBK1		;THIS IS THE ONE !
3073VAREND: LDWD	INPPTR		;PUT AWAY A NEW DATA PNTR MAYBE.
3074	LDX	INPFLG
3075	BPL	VARY0
3076	JMP	RESFIN
3077VARY0:	LDYI	0
3078	LDADY	INPPTR		;LAST DATA CHR COULD HAVE BEEN
3079				;COMMA OR COLON BUT SHOULD BE NULL.
3080	BEQ	INPRTS		;IT IS NULL.
3081IFN	EXTIO,<
3082	LDA	CHANNL		;IF NOT TERMINAL, NO TYPE.
3083	BNE	INPRTS>
3084	LDWDI	EXIGNT
3085	JMP	STROUT		;TYPE "?EXTRA IGNORED"
3086INPRTS: RTS			;DO NEXT STATEMENT.
3087EXIGNT: DT"?EXTRA IGNORED"
3088	ACRLF
3089	0
3090TRYAGN: DT"?REDO FROM START"
3091	ACRLF
3092	0
3093PAGE
3094SUBTTL	THE NEXT CODE IS THE "NEXT CODE"
3095;
3096; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
3097;
3098; LOW ADDRESS
3099;	TOKEN (FORTK) 1 BYTE
3100;	A POINTER TO THE LOOP VARIABLE 2 BYTES
3101;	THE STEP 4+ADDPRC BYTES
3102;	A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
3103;	THE UPPER VALUE (PACKED) 4+ADDPRC BYTES
3104;	THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
3105;	A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
3106; HIGH ADDRESS
3107;
3108; TOTAL 16+2*ADDPRC BYTES.
3109;
3110NEXT:	BNE	GETFOR
3111	LDYI	0		;WITHOUT ARG CALL "FNDFOR" WITH
3112	BEQA	STXFOR		;[FORPNT]=0.
3113GETFOR: JSR	PTRGET		;GET A POINTER TO LOOP VARIABLE
3114STXFOR: STWD	FORPNT		;INTO "FORPNT".
3115	JSR	FNDFOR		;FIND THE MATCHING ENTRY IF ANY.
3116	BEQ	HAVFOR
3117	LDXI	ERRNF		;"NEXT WITHOUT FOR".
3118ERRGO5: BEQ	ERRGO4
3119HAVFOR: TXS			;SETUP STACK. CHOP FIRST.
3120	TXA
3121	CLC
3122	ADCI	4		;POINT TO INCREMENT
3123	PHA			;SAVE THIS POINTER TO RESTORE TO [A]
3124	ADCI	5+ADDPRC	;POINT TO UPPER LIMIT
3125	STA	INDEX2		;SAVE AS INDEX
3126	PLA			;RESTORE POINTER TO INCREMENT
3127	LDYI	1		;SET HI ADDR OF THING TO MOVE.
3128	JSR	MOVFM		;GET QUANTITY INTO THE FAC.
3129	TSX
3130	LDA	257+7+ADDPRC,X, ;SET SIGN CORRECTLY.
3131	STA	FACSGN
3132	LDWD	FORPNT
3133	JSR	FADD		;ADD INC TO LOOP VARIABLE.
3134	JSR	MOVVF		;PACK THE FAC INTO MEMORY.
3135	LDYI	1
3136	JSR	FCOMPN		;COMPARE FAC WITH UPPER VALUE.
3137	TSX
3138	SEC
3139	SBC	257+7+ADDPRC,X, ;SUBTRACT SIGN OF INC FROM SIGN OF
3140				;OF (CURRENT VALUE-FINAL VALUE).
3141	BEQ	LOOPDN		;IF SIGN (FINAL-CURRENT)-SIGN STEP=0
3142				;THEN LOOP IS DONE.
3143	LDA	2*ADDPRC+12+257,X
3144	STA	CURLIN		;STORE LINE NUMBER OF "FOR" STATEMENT.
3145	LDA	257+13+<2*ADDPRC>,X
3146	STA	CURLIN+1
3147	LDA	2*ADDPRC+15+257,X
3148	STA	TXTPTR		;STORE TEXT PNTR INTO "FOR" STATEMENT.
3149	LDA	2*ADDPRC+14+257,X
3150	STA	TXTPTR+1
3151NEWSGO: JMP	NEWSTT		;PROCESS NEXT STATEMENT.
3152LOOPDN: TXA
3153	ADCI	2*ADDPRC+15		;ADDS 16 WITH CARRY.
3154	TAX
3155	TXS			;NEW STACK PNTR.
3156	JSR	CHRGOT
3157	CMPI	44		;COMMA AT END?
3158	BNE	NEWSGO
3159	JSR	CHRGET
3160	JSR	GETFOR		;DO NEXT BUT DON'T ALLOW BLANK VARIABLE
3161				;PNTR. [VARPNT] IS THE STK PNTR WHICH
3162				;NEVER MATCHES ANY POINTER.
3163				;JSR TO PUT ON DUMMY NEWSTT ADDR.
3164SUBTTL FORMULA EVALUATION CODE.
3165;
3166; THESE ROUTINES CHECK FOR CERTAIN "VALTYP".
3167; [C] IS NOT PRESERVED.
3168;
3169FRMNUM: JSR	FRMEVL
3170CHKNUM: CLC
3171	SKIP1
3172CHKSTR: SEC			;SET CARRY.
3173CHKVAL: BIT	VALTYP		;WILL NOT F UP "VALTYP".
3174	BMI	DOCSTR
3175	BCS	CHKERR
3176CHKOK:	RTS
3177DOCSTR: BCS	CHKOK
3178CHKERR: LDXI	ERRTM
3179ERRGO4: JMP	ERROR
3180;
3181; THE FORMULA EVALUATOR STARTS WITH
3182; [TXTPTR] POINTING TO THE FIRST CHARACTER OF THE FORMULA.
3183; AT THE END [TXTPTR] POINTS TO THE TERMINATOR.
3184; THE RESULT IS LEFT IN THE FAC.
3185; ON RETURN [A] DOES NOT REFLECT THE TERMINATOR.
3186;
3187; THE FORMULA EVALUATOR USES THE OPERATOR LIST (OPTAB)
3188; TO DETERMINE PRECEDENCE AND DISPATCH ADDRESSES FOR 
3189; EACH OPERATOR.
3190; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT.
3191;	THE ADDRESS OF THE OPERATOR ROUTINE.
3192;	THE FLOATING POINT TEMPORARY RESULT.
3193;	THE PRECEDENCE OF THE OPERATOR.
3194;
3195FRMEVL: LDX	TXTPTR
3196	BNE	FRMEV1
3197	DEC	TXTPTR+1
3198FRMEV1: DEC	TXTPTR
3199	LDXI	0		;INITIAL DUMMY PRECEDENCE IS 0.
3200	SKIP1
3201LPOPER: PHA			;SAVE LOW PRECEDENCE. (MASK.)
3202	TXA
3203	PHA			;SAVE HIGH PRECEDENCE.
3204	LDAI	1
3205	JSR	GETSTK		;MAKE SURE THERE IS ROOM FOR
3206				;RECURSIVE CALLS.
3207	JSR	EVAL		;EVALUATE SOMETHING.
3208	CLR	OPMASK		;PREPARE TO BUILD MASK MAYBE.
3209TSTOP:	JSR	CHRGOT		;REGET LAST CHARACTER.
3210LOPREL: SEC			;PREP TO SUBTRACT.
3211	SBCI	GREATK		;IS CURRENT CHARACTER A RELATION?
3212	BCC	ENDREL		;NO. RELATIONS ALL THROUGH.
3213	CMPI	LESSTK-GREATK+1 ;REALLY RELATIONAL?
3214	BCS	ENDREL		;NO -- JUST BIG.
3215	CMPI	1		;RESET CARRY FOR ZERO ONLY.
3216	ROL	A,		;0 TO 1, 1 TO 2, 2 TO 4.
3217	EORI	1
3218	EOR	OPMASK		;BRING IN THE OLD BITS.
3219	CMP	OPMASK		;MAKE SURE THE NEW MASK IS BIGGER.
3220	BCC	SNERR5		;SYNTAX ERROR. BECAUSE TWO OF THE SAME.
3221	STA	OPMASK		;SAVE MASK.
3222	JSR	CHRGET
3223	JMP	LOPREL		;GET THE NEXT CANDIDATE.
3224ENDREL: LDX	OPMASK		;WERE THERE ANY?
3225	BNE	FINREL		;YES, HANDLE AS SPECIAL OP.
3226	BCS	QOP		;NOT AN OPERATOR.
3227	ADCI	GREATK-PLUSTK
3228	BCC	QOP		;NOT AN OPERATOR.
3229	ADC	VALTYP		;[C]=1.
3230	JEQ	CAT		;ONLY IF [A]=0 AND [VALTYP]=-1 (A STR).
3231	ADCI	^O377		;GET BACK ORIGINAL [A].
3232	STA	INDEX1
3233	ASL	A,		;MULTIPLY BY 2.
3234	ADC	INDEX1		;BY THREE.
3235	TAY			;SET UP FOR LATER.
3236QPREC:	PLA			;GET PREVIOUS PRECEDENCE.
3237	CMP	OPTAB,Y		;IS OLD PRECEDENCE GREATER OR EQUAL?
3238	BCS	QCHNUM		;YES, GO OPERATE.
3239	JSR	CHKNUM		;CAN'T BE STRING HERE.
3240DOPREC: PHA			;SAVE OLD PRECEDENCE.
3241NEGPRC: JSR	DOPRE1		;SET A RETURN ADDRESS FOR OP.
3242	PLA			;PULL OFF PREVIOUS PRECEDENCE.
3243	LDY	OPPTR		;GET POINTER TO OP.
3244	BPL	QPREC1		;THAT'S A REAL OPERATOR.
3245	TAX			;DONE ?
3246	BEQ	QOPGO		;DONE !
3247	BNE	PULSTK
3248FINREL: LSR	VALTYP		;GET VALUE TYPE INTO "C".
3249	TXA
3250	ROL	A,		;PUT VALTYP INTO LOW ORDER BIT OF MASK.
3251	LDX	TXTPTR		;DECREMENT TEXT POINTER.
3252	BNE	FINRE2
3253	DEC	TXTPTR+1
3254FINRE2: DEC	TXTPTR
3255	LDYI	PTDORL-OPTAB	;MAKE [YREG] POINT AT OPERATOR ENTRY.
3256	STA	OPMASK		;SAVE THE OPERATION MASK.
3257	BNE	QPREC		;SAVE IT ALL. BR ALWAYS.
3258				;NOTE B7(VALTYP)=0 SO CHKNUM CALL IS OK.
3259QPREC1: CMP	OPTAB,Y		;LAST PRECEDENCE IS GREATER?
3260	BCS	PULSTK		;YES, GO OPERATE.
3261	BCC	DOPREC		;NO SAVE ARGUMENT AND GET OTHER OPERAND.
3262DOPRE1: LDA	OPTAB+2,Y
3263	PHA			;DISP ADDR GOES ONTO STACK.
3264	LDA	OPTAB+1,Y
3265	PHA
3266	JSR	PUSHF1		;SAVE FAC ON STACK UNPACKED.
3267	LDA	OPMASK		;[ACCA] MAY BE MASK FOR REL.
3268	JMP	LPOPER
3269SNERR5: JMP	SNERR		;GO TO AN ERROR.
3270PUSHF1: LDA	FACSGN
3271	LDX	OPTAB,Y,	;GET HIGH PRECEDENCE.
3272PUSHF:	TAY			;GET POINTER INTO STACK.
3273	PLA
3274	STA	INDEX1
3275	INC	INDEX1
3276	PLA
3277	STA	INDEX1+1
3278	TYA
3279				;STORE FAC ON STACK UNPACKED.
3280	PHA			;START WITH SIGN SET UP.
3281FORPSH: JSR	ROUND		;PUT ROUNDED FAC ON STACK.
3282	LDA	FACLO		;ENTRY POINT TO SKIP STORING SIGN.
3283	PHA
3284	LDA	FACMO
3285	PHA
3286IFN	ADDPRC,<
3287	LDA	FACMOH
3288	PHA>
3289	LDA	FACHO
3290	PHA
3291	LDA	FACEXP
3292	PHA
3293	JMPD	INDEX1		;RETURN.
3294QOP:	LDYI	255
3295	PLA			;GET HIGH PRECEDENCE OF LAST OP.
3296QOPGO:	BEQ	QOPRTS		;DONE !
3297QCHNUM: CMPI	100		;RELATIONAL OPERATOR?
3298	BEQ	UNPSTK		;YES, DON'T CHECK OPERAND.
3299	JSR	CHKNUM		;MUST BE NUMBER.
3300UNPSTK: STY	OPPTR		;SAVE OPERATOR'S POINTER FOR NEXT TIME.
3301PULSTK: PLA			;GET MASK FOR REL OP IF IT IS ONE.
3302	LSR	A,		;SETUP [C] FOR DOREL'S "CHKVAL".
3303	STA	DOMASK		;SAVE FOR "DOCMP".
3304	PLA			;UNPACK STACK INTO ARG.
3305	STA	ARGEXP
3306	PLA
3307	STA	ARGHO
3308IFN	ADDPRC,<
3309	PLA
3310	STA	ARGMOH>
3311	PLA
3312	STA	ARGMO
3313	PLA
3314	STA	ARGLO
3315	PLA
3316	STA	ARGSGN
3317	EOR	FACSGN		;GET PROBABLE RESULT SIGN.
3318	STA	ARISGN		;ARITHMETIC SIGN. USED BY
3319				;ADD, SUB, MULT, DIV.
3320QOPRTS: LDA	FACEXP		;GET IT AND SET CODES.
3321UNPRTS: RTS			;RETURN.
3322
3323EVAL:	CLR	VALTYP		;ASSUME VALUE WILL BE NUMERIC.
3324EVAL0:	JSR	CHRGET		;GET A CHARACTER.
3325	BCS	EVAL2
3326EVAL1:	JMP	FIN		;IT IS A NUMBER.
3327EVAL2:	JSR	ISLETC		;VARIABLE NAME?
3328	BCS	ISVAR		;YES.
3329IFE	REALIO-3,<
3330	CMPI	PI
3331	BNE	QDOT
3332	LDWDI	PIVAL
3333	JSR	MOVFM		;PUT VALUE IN FOR PI.
3334	JMP	CHRGET
3335PIVAL:	^O202
3336	^O111
3337	^O017
3338	^O332
3339	^O241>
3340QDOT:	CMPI	"."		;LEADING CHARACTER OF CONSTANT?
3341	BEQ	EVAL1
3342	CMPI	MINUTK		;NEGATION?
3343	BEQ	DOMIN		;SHO IS.
3344	CMPI	PLUSTK
3345	BEQ	EVAL0
3346	CMPI	34		;A QUOTE? A STRING?
3347	BNE	EVAL3
3348STRTXT: LDWD	TXTPTR
3349	ADCI	0		;TO INC, ADD C=1.
3350	BCC	STRTX2
3351	INY
3352STRTX2: JSR	STRLIT		;YES. GO PROCESS IT.
3353	JMP	ST2TXT
3354EVAL3:	CMPI	NOTTK		;CHECK FOR "NOT" OPERATOR.
3355	BNE	EVAL4
3356	LDYI	NOTTAB-OPTAB		;"NOT" HAS PRECEDENCE 90.
3357	BNE	GONPRC		;GO DO ITS EVALUATION.
3358NOTOP:	JSR	AYINT		;INTEGERIZE.
3359	LDA	FACLO		;GET THE ARGUMENT.
3360	EORI	255
3361	TAY
3362	LDA	FACMO
3363	EORI	255
3364	JMP	GIVAYF		;FLOAT [Y,A] AS RESULT IN FAC.
3365				;AND RETURN.
3366EVAL4:	CMPI	FNTK		;USER-DEFINED FUNCTION?
3367	JEQ	FNDOER
3368	CMPI	ONEFUN		;A FUNCTION NAME?
3369	BCC	PARCHK		;FUNCTIONS ARE THE HIGHEST NUMBERED
3370	JMP	ISFUN		;CHARACTERS SO NO NEED TO CHECK
3371				;AN UPPER-BOUND.
3372PARCHK: JSR	CHKOPN		;ONLY POSSIBILITY LEFT IS
3373	JSR	FRMEVL		;A FORMULA IN PARENTHESIS.
3374				;RECURSIVELY EVALUATE THE FORMULA.
3375CHKCLS: LDAI	41		;CHECK FOR A RIGHT PARENTHESE
3376	SKIP2
3377CHKOPN: LDAI	40
3378	SKIP2
3379CHKCOM: LDAI	44
3380;
3381; "SYNCHK" LOOKS AT THE CURRENT CHARACTER TO MAKE SURE IT
3382; IS THE SPECIFIC THING LOADED INTO ACCA JUST BEFORE THE CALL TO
3383; "SYNCHK". IF NOT, IT CALLS THE "SYNTAX ERROR" ROUTINE.
3384; OTHERWISE IT GOBBLES THE NEXT CHAR AND RETURNS,
3385;
3386; [A]=NEW CHAR AND TXTPTR IS ADVANCED BY "CHRGET".
3387;
3388SYNCHR: LDYI	0
3389	CMPDY	TXTPTR		;CHARACTERS EQUAL?
3390	BNE	SNERR
3391CHRGO5: JMP	CHRGET
3392SNERR:	LDXI	ERRSN		;"SYNTAX ERROR"
3393	JMP	ERROR
3394DOMIN:	LDYI	NEGTAB-OPTAB	;A PRECEDENCE BELOW "^".
3395GONPRC: PLA			;GET RID OF RTS ADDR.
3396	PLA
3397	JMP	NEGPRC		;EVALUTE FOR NEGATION.
3398
3399ISVAR:	JSR	PTRGET		;GET A PNTR TO VARIABLE.
3400ISVRET: STWD	FACMO
3401IFN	TIME!EXTIO,<
3402	LDWD	VARNAM>		;CHECK TIME,TIME$,STATUS.
3403	LDX	VALTYP
3404	BEQ	GOOO		;THE STRING IS SET UP.
3405	LDXI	0
3406	STX	FACOV
3407IFN	TIME,<
3408	BIT	FACLO		;AN ARRAY?
3409	BPL	STRRTS		;YES.
3410	CMPI	"T"		;TI$?
3411	BNE	STRRTS
3412	CPYI	"I"+128
3413	BNE	STRRTS
3414	JSR	GETTIM		;YES. PUT TIME IN FACMOH-LO.
3415	STY	TENEXP		;Y=0.
3416	DEY
3417	STY	FBUFPT
3418	LDYI	6		;SIX	DIGITS TO PRINT.
3419	STY	DECCNT
3420	LDYI	FDCEND-FOUTBL
3421	JSR	FOUTIM		;CONVERT TO ASCII.
3422	JMP	TIMSTR>
3423STRRTS: RTS
3424GOOO:
3425IFN	INTPRC,<
3426	LDX	INTFLG
3427	BPL	GOOOOO
3428	LDYI	0
3429	LDADY	FACMO		;FETCH HIGH.
3430	TAX
3431	INY
3432	LDADY	FACMO
3433	TAY			;PUT LOW IN Y.
3434	TXA			;GET HIGH IN A.
3435	JMP	GIVAYF>		;FLOAT AND RETURN.
3436GOOOOO:
3437IFN	TIME,<
3438	BIT	FACLO		;AN ARRAY?
3439	BPL	GOMOVF		;YES.
3440	CMPI	"T"
3441	BNE	QSTATV
3442	CPYI	"I"
3443	BNE	GOMOVF
3444	JSR	GETTIM
3445	TYA			;FOR FLOATB.
3446	LDXI	160		;SET EXPONNENT.
3447	JMP	FLOATB
3448GETTIM: LDWDI	<CQTIMR-2>
3449	SEI			;TURN OF INT SYS.
3450	JSR	MOVFM
3451	CLI			;BACK ON.
3452	STY	FACHO		;ZERO HIGHEST.
3453	RTS>
3454QSTATV:
3455IFN	EXTIO,<
3456	CMPI	"S"
3457	BNE	GOMOVF
3458	CPYI	"T"
3459	BNE	GOMOVF
3460	LDA	CQSTAT
3461	JMP	FLOAT
3462GOMOVF:>
3463IFN	TIME!EXTIO,<
3464	LDWD	FACMO>
3465	JMP	MOVFM		;MOVE ACTUAL VALUE IN.
3466				;AND RETURN.
3467
3468ISFUN:	ASL	A,		;MULTIPLY BY TWO.
3469	PHA
3470	TAX
3471	JSR	CHRGET		;SET UP FOR SYNCHK.
3472	CPXI	2*LASNUM-256+1	;IS IT PAST "LASNUM"?
3473	BCC	OKNORM		;NO, MUST BE NORMAL FUNCTION.
3474;
3475; MOST FUNCTIONS TAKE A SINGLE ARGUMENT.
3476; THE RETURN ADDRESS OF THESE FUNCTIONS IS "CHKNUM"
3477; WHICH ASCERTAINS THAT [VALTYP]=0  (NUMERIC).
3478; NORMAL FUNCTIONS THAT RETURN STRING RESULTS
3479; (E.G., CHR$) MUST POP OFF THAT RETURN ADDR AND
3480; RETURN DIRECTLY TO "FRMEVL".
3481;
3482; THE SO-CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT,
3483; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH
3484; MUST BE A NUMBER BETWEEN 0 AND 255.
3485; THE CLOSED PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY
3486; TO "FRMEVL" WITH THE TEXT PNTR POINTING BEYOND THE ")".
3487; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT
3488; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE
3489; INTEGER ARGUMENT.
3490;
3491	JSR	CHKOPN		;CHECK FOR AN OPEN PARENTHESE
3492	JSR	FRMEVL		;EAT OPEN PAREN AND FIRST ARG.
3493	JSR	CHKCOM		;TWO ARGS SO COMMA MUST DELIMIT.
3494	JSR	CHKSTR		;MAKE SURE FIRST WAS STRING.
3495	PLA			;GET FUNCTION NUMBER.
3496	TAX
3497	PSHWD	FACMO		;SAVE POINTER AT STRING DESCRIPTOR
3498	TXA
3499	PHA			;RESAVE FUNCTION NUMBER.
3500				;THIS MUST BE ON STACK SINCE RECURSIVE.
3501	JSR	GETBYT		;[X]=VALUE OF FORMULA.
3502	PLA			;GET FUNCTION NUMBER.
3503	TAY
3504	TXA
3505	PHA
3506	JMP	FINGO		;DISPATCH TO FUNCTION.
3507OKNORM: JSR	PARCHK		;READ A FORMULA SURROUNDED BY PARENS.
3508	PLA			;GET DISPATCH FUNCTION.
3509	TAY
3510FINGO:	LDA	FUNDSP-2*ONEFUN+256,Y,	;MODIFY DISPATCH ADDRESS.
3511	STA	JMPER+1
3512	LDA	FUNDSP-2*ONEFUN+257,Y
3513	STA	JMPER+2
3514	JSR	JMPER		;DISPATCH!
3515				;STRING FUNCTIONS REMOVE THIS RET ADDR.
3516	JMP	CHKNUM		;CHECK IT FOR NUMERICNESS AND RETURN.
3517
3518OROP:	LDYI	255		;MUST ALWAYS COMPLEMENT..
3519	SKIP2
3520ANDOP:	LDYI	0
3521	STY	COUNT		;OPERATOR.
3522	JSR	AYINT		;[FACMO&LO]=INT VALUE AND CHECK SIZE.
3523	LDA	FACMO		;USE DEMORGAN'S LAW ON HIGH
3524	EOR	COUNT
3525	STA	INTEGR
3526	LDA	FACLO		;AND LOW.
3527	EOR	COUNT
3528	STA	INTEGR+1
3529	JSR	MOVFA
3530	JSR	AYINT		;[FACMO&LO]=INT OF ARG.
3531	LDA	FACLO
3532	EOR	COUNT
3533	AND	INTEGR+1
3534	EOR	COUNT		;FINISH OUT DEMORGAN.
3535	TAY			;SAVE HIGH.
3536	LDA	FACMO
3537	EOR	COUNT
3538	AND	INTEGR
3539	EOR	COUNT
3540	JMP	GIVAYF		;FLOAT [A.Y] AND RET TO USER.
3541
3542;
3543; TIME TO PERFORM A RELATIONAL OPERATOR.
3544; [DOMASK] CONTAINS THE BITS AS TO WHICH RELATIONAL
3545; OPERATOR IT WAS. CARRY BIT ON=STRING COMPARE.
3546;
3547DOREL:	JSR	CHKVAL		;CHECK FOR MATCH.
3548	BCS	STRCMP		;IT IS A STRING.
3549	LDA	ARGSGN		;PACK ARG FOR FCOMP.
3550	ORAI	127
3551	AND	ARGHO
3552	STA	ARGHO
3553	LDWDI	ARGEXP
3554	JSR	FCOMP
3555	TAX
3556	JMP	QCOMP
3557STRCMP: CLR	VALTYP		;RESULT WILL BE NUMERIC.
3558	DEC	OPMASK		;TURN OFF VALTYP WHICH WAS STRING.
3559	JSR	FREFAC		;FREE THE FACLO STRING.
3560	STA	DSCTMP		;SAVE FOR LATER.
3561	STXY	DSCTMP+1
3562	LDWD	ARGMO		;GET POINTER TO OTHER STRING.
3563	JSR	FRETMP		;FREES FIRST DESC POINTER.
3564	STXY	ARGMO
3565	TAX			;COPY COUNT INTO X.
3566	SEC
3567	SBC	DSCTMP		;WHICH IS GREATER. IF 0, ALL SET UP.
3568	BEQ	STASGN		;JUST PUT SIGN OF DIFFERENCE AWAY.
3569	LDAI	1
3570	BCC	STASGN		;SIGN IS POSITIVE.
3571	LDX	DSCTMP		;LENGTH OF FAC IS SHORTER.
3572	LDAI	^O377		;GET A MINUS 1 FOR NEGATIVES.
3573STASGN: STA	FACSGN		;KEEP FOR LATER.
3574	LDYI	255		;SET POINTER TO FIRST STRING. (ARG.)
3575	INX			;TO LOOP PROPERLY.
3576NXTCMP: INY
3577	DEX			;ANY CHARACTERS LEFT TO COMPARE?
3578	BNE	GETCMP		;NOT DONE YET.
3579	LDX	FACSGN		;USE SIGN OF LENGTH DIFFERENCE
3580				;SINCE ALL CHARACTERS ARE THE SAME.
3581QCOMP:	BMI	DOCMP		;C IS ALWAYS SET THEN.
3582	CLC
3583	BCC	DOCMP		;ALWAYS BRANCH.
3584GETCMP: LDADY	ARGMO		;GET NEXT CHAR TO COMPARE.
3585	CMPDY	DSCTMP+1	;SAME?
3586	BEQ	NXTCMP		;YEP. TRY FURTHER.
3587	LDXI	^O377		;SET A POSITIVE DIFFERENCE.
3588	BCS	DOCMP		;PUT STACK BACK TOGETHER.
3589	LDXI	1		;SET A NEGATIVE DIFFERENCE.
3590DOCMP:	INX			;-1 TO 1, 0 TO 2, 1 TO 4.
3591	TXA
3592	ROL	A
3593	AND	DOMASK
3594	BEQ	GOFLOT
3595	LDAI	^O377		;MAP 0 TO 0. ALL OTHERS TO -1.
3596GOFLOT: JMP	FLOAT		;FLOAT THE ONE-BYTE RESULT INTO FAC.
3597
3598PAGE
3599SUBTTL	DIMENSION AND VARIABLE SEARCHING.
3600;
3601; THE "DIM" CODE SETS [DIMFLG] AND THEN FALLS INTO THE VARIABLE SEARCH
3602; ROUTINE, WHICH LOOKS AT DIMFLG AT THREE DIFFERENT POINTS.
3603;	1) IF AN ENTRY IS FOUND, "DIMFLG" BEING ON INDICATES
3604;		A "DOUBLY" DIMENSIONED VARIABLE.
3605;	2) WHEN A NEW ENTRY IS BEING BUILT "DIMFLG" BEING ON
3606;		INDICTAES THE INDICES SHOULD BE USED FOR THE
3607;		SIZE OF EACH INDEX. OTHERWISE THE DEFAULT OF TEN
3608;		IS USED.
3609;	3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF "DIMFLG" IS OFF
3610;		WILL INDEXING BE DONE.
3611;
3612DIM3:	JSR	CHKCOM		;MUST BE A COMMA
3613DIM:	TAX			;SET [ACCX] NONZERO.
3614				;[ACCA] MUST BE NONZERO TO WORK RIGHT.
3615DIM1:	JSR	PTRGT1
3616DIMCON: JSR	CHRGOT		;GET LAST CHARACTER.
3617	BNE	DIM3
3618	RTS
3619;
3620; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION
3621; AND  PUT A POINTER TO ITS VALUE IN VARPNT. [TXTPTR]
3622; POINTS TO THE TERMINATING CHARCTER.. NOT THAT EVALUATING SUBSCRIPTS
3623; IN A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO "PTRGET" SO AT
3624; THAT POINT ALL VALUES MUST BE STORED ON THE STACK.
3625;
3626PTRGET: LDXI	0		;MAKE [ACCX]=0.
3627	JSR	CHRGOT		;RETRIEVE LAST CHARACTER.
3628PTRGT1: STX	DIMFLG		;STORE FLAG AWAY.
3629PTRGT2: STA	VARNAM
3630	JSR	CHRGOT		;GET CURRENT CHARACTER
3631				;MAYBE WITH FUNCTION BIT OFF.
3632	JSR	ISLETC		;CHECK FOR LETTER.
3633	BCS	PTRGT3		;MUST HAVE A LETTER.
3634INTERR: JMP	SNERR
3635PTRGT3: LDXI	0		;ASSUME NO SECOND CHARACTER.
3636	STX	VALTYP		;DEFAULT IS NUMERIC.
3637IFN	INTPRC,<
3638	STX	INTFLG>		;ASSUME FLOATING.
3639	JSR	CHRGET		;GET FOLLOWING CHARACTER.
3640	BCC	ISSEC		;CARRY RESET BY CHRGET IF NUMERIC.
3641	JSR	ISLETC		;SET CARRY IF NOT ALPHABETIC.
3642	BCC	NOSEC		;ALLOW ALPHABETICS.
3643ISSEC:	TAX			;IT IS A NUMBER -- SAVE IN ACCX.
3644EATEM:	JSR	CHRGET		;LOOK AT NEXT CHARACTER.
3645	BCC	EATEM		;SKIP NUMERICS.
3646	JSR	ISLETC
3647	BCS	EATEM		;SKIP ALPHABETICS.
3648NOSEC:	CMPI	"$"		;IS IT A STRING?
3649	BNE	NOTSTR		;IF NOT, [VALTYP]=0.
3650	LDAI	^O377		;SET [VALTYP]=255 (STRING !).
3651	STA	VALTYP
3652IFN	INTPRC,<
3653	BNEA	TURNON		;ALWAYS GOES.
3654NOTSTR: CMPI	"%"		;INTEGER VARIABLE?
3655	BNE	STRNAM		;NO.
3656	LDA	SUBFLG
3657	BNE	INTERR
3658	LDAI	128
3659	STA	INTFLG		;SET FLAG.
3660	ORA	VARNAM		;TURN ON BOTH HIGH BITS.
3661	STA	VARNAM>
3662TURNON: TXA
3663	ORAI	128		;TURN ON MSB OF SECOND CHARACTER.
3664	TAX
3665	JSR	CHRGET		;GET CHARACTER AFTER $.
3666IFE	INTPRC,<
3667NOTSTR:>
3668STRNAM: STX	VARNAM+1	;STORE AWAY SECOND CHARACTER.
3669	SEC
3670	ORA	SUBFLG		;ADD FLAG WHETHER TO ALLOW ARRAYS.
3671	SBCI	40		;(CHECK FOR "(") WON'T MATCH IF SUBFLG SET. 
3672	JEQ	ISARY		;IT IS!
3673	CLR	SUBFLG		;ALLOW SUBSCRIPTS AGAIN.
3674	LDA	VARTAB		;PLACE TO START SEARCH.
3675	LDX	VARTAB+1
3676	LDYI	0
3677STXFND: STX	LOWTR+1
3678LOPFND: STA	LOWTR
3679	CPX	ARYTAB+1	;AT END OF TABLE YET?
3680	BNE	LOPFN
3681	CMP	ARYTAB
3682	BEQ	NOTFNS		;YES. WE COULDN'T FIND IT.
3683LOPFN:	LDA	VARNAM
3684	CMPDY	LOWTR		;COMPARE HIGH ORDERS.
3685	BNE	NOTIT		;NO COMPARISON.
3686	LDA	VARNAM+1
3687	INY
3688	CMPDY	LOWTR		;AND THE LOW PART?
3689	BEQ	FINPTR		;THAT'S IT ! THAT'S IT !
3690	DEY
3691NOTIT:	CLC
3692	LDA	LOWTR
3693	ADCI	6+ADDPRC	;MAKES NO DIF AMONG TYPES.
3694	BCC	LOPFND
3695	INX
3696	BNEA	STXFND		;ALWAYS BRANCHES.
3697
3698;
3699; TEST FOR A LETTER.	/ CARRY OFF= NOT A LETTER.
3700;			  CARRY ON= A LETTER.
3701;
3702ISLETC: CMPI	"A"
3703	BCC	ISLRTS		;IF LESS THAN "A", RET.
3704	SBCI	"Z"+1
3705	SEC
3706	SBCI	256-"Z"-1	;RESET CARRY IF [A] .GT. "Z".
3707ISLRTS: RTS			;RETURN TO CALLER.
3708
3709NOTFNS: PLA			;CHECK WHO'S CALLING.
3710	PHA			;RESTORE IT.
3711	CMPI	ISVRET-1-<ISVRET-1>/256*256	;IS EVAL CALLING?
3712	BNE	NOTEVL		;NO, CARRY ON.
3713IFN	REALIO-3,<
3714	TSX
3715	LDA	258,X
3716	CMPI	<<ISVRET-1>/256>
3717	BNE	NOTEVL>
3718LDZR:	LDWDI	ZERO		;SET UP PNTR TO SIMULATED ZERO.
3719	RTS			;FOR STRINGS OR NUMERIC.
3720				;AND FOR INTEGERS TOO.
3721NOTEVL:
3722IFN	TIME!EXTIO,<
3723	LDWD	VARNAM>
3724IFN	TIME,<
3725	CMPI	"T"
3726	BNE	QSTAVR
3727	CPYI	"I"+128
3728	BEQ	LDZR
3729	CPYI	"I"
3730	BNE	QSTAVR>
3731IFN	EXTIO!TIME,<
3732GOBADV: JMP	SNERR>
3733QSTAVR:
3734IFN	EXTIO,<
3735	CMPI	"S"
3736	BNE	VAROK
3737	CPYI	"T"
3738	BEQ	GOBADV>
3739VAROK:	LDWD	ARYTAB
3740	STWD	LOWTR		;LOWEST THING TO MOVE.
3741	LDWD	STREND		;GET HIGHEST ADDR TO MOVE.
3742	STWD	HIGHTR
3743	CLC
3744	ADCI	6+ADDPRC
3745	BCC	NOTEVE
3746	INY
3747NOTEVE: STWD	HIGHDS		;PLACE TO STUFF IT.
3748	JSR	BLTU		;MOVE IT ALL.
3749				;NOTE [Y,A] HAS [HIGHDS] FOR REASON.
3750	LDWD	HIGHDS		;AND SET UP
3751	INY
3752	STWD	ARYTAB		;NEW START OF ARRAY TABLE.
3753	LDYI	0		;GET ADDR OF VARIABLE ENTRY.
3754	LDA	VARNAM
3755	STADY	LOWTR
3756	INY
3757	LDA	VARNAM+1
3758	STADY	LOWTR		;STORE NAME OF VARIABLE.
3759	LDAI	0
3760	INY
3761	STADY	LOWTR
3762	INY
3763	STADY	LOWTR
3764	INY
3765	STADY	LOWTR
3766	INY
3767	STADY	LOWTR		;FOURTH ZERO FOR DEF FUNC.
3768IFN	ADDPRC,<
3769	INY
3770	STADY	LOWTR>
3771FINPTR: LDA	LOWTR
3772	CLC
3773	ADCI	2
3774	LDY	LOWTR+1
3775	BCC	FINNOW
3776	INY
3777FINNOW: STWD	VARPNT		;THIS IS IT.
3778	RTS
3779PAGE
3780SUBTTL	MULTIPLE DIMENSION CODE.
3781FMAPTR: LDA	COUNT
3782	ASL	A,
3783	ADCI	5		;POINT TO ENTRIES. C CLR'D BY ASL.
3784	ADC	LOWTR
3785	LDY	LOWTR+1
3786	BCC	JSRGM
3787	INY
3788JSRGM:	STWD	ARYPNT
3789	RTS
3790
3791N32768: EXP	144,128,0,0	;-32768.
3792
3793;
3794; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND
3795; TURNS IT INTO A POSITIVE INTEGER
3796; LEAVING THE RESULT IN FACMO&LO. NEGATIVE ARGUMENTS
3797; ARE NOT ALLOWED.
3798;
3799INTIDX: JSR	CHRGET
3800	JSR	FRMEVL		;GET A NUMBER
3801POSINT: JSR	CHKNUM
3802	LDA	FACSGN
3803	BMI	NONONO		;IF NEGATIVE, BLOW HIM OUT.
3804AYINT:	LDA	FACEXP
3805	CMPI	144		;FAC .GT. 32767?
3806	BCC	QINTGO
3807	LDWDI	N32768		;GET ADDR OF -32768.
3808	JSR	FCOMP		;SEE IF FAC=[[Y,A]].
3809NONONO: BNE	FCERR		;NO, FAC IS TOO BIG.
3810QINTGO: JMP	QINT		;GO TO QINT AND SHOVE IT.
3811;
3812; FORMAT OF ARRAYS IN CORE.
3813;
3814; DESCRIPTOR:
3815;	LOWBYTE = FIRST CHARACTER.
3816;	HIGHBYTE = SECOND CHARACTER (200 BIT IS STRING FLAG).
3817; LENGTH OF ARRAY IN CORE IN BYTES (INCLUDES EVERYTHING).
3818; NUMBER OF DIMENSIONS.
3819; FOR EACH DIMENSION STARTING WITH THE FIRST A LIST
3820; (2 BYTES EACH) OF THE MAX INDICE+1
3821; THE VALUES
3822;
3823ISARY:	LDA	DIMFLG
3824IFN	INTPRC,<
3825	ORA	INTFLG>
3826	PHA			;SAVE [DIMFLG] FOR RECURSION.
3827	LDA	VALTYP
3828	PHA			;SAVE [VALTYP] FOR RECURSION.
3829	LDYI	0		;SET NUMBER OF DIMENSIONS TO ZERO.
3830INDLOP: TYA			;SAVE NUMBER OF DIMS.
3831	PHA
3832	PSHWD	VARNAM		;SAVE LOOKS.
3833	JSR	INTIDX		;EVALUATE INDICE INTO FACMO&LO.
3834	PULWD	VARNAM		;GET BACK ALL... WE'RE HOME.
3835	PLA			;(# OF DIMS).
3836	TAY
3837	TSX
3838	LDA	258,X
3839	PHA			;PUSH DIMFLG AND VALTYP FURTHER.
3840	LDA	257,X
3841	PHA
3842	LDA	INDICE		;PUT INDICE ONTO STACK.
3843	STA	258,X,		;UNDER DIMFLG AND VALTYP.
3844	LDA	INDICE+1
3845	STA	257,X
3846	INY			;INCREMENT # OF DIMS.
3847	JSR	CHRGOT		;GET TERMINATING CHARACTER.
3848	CMPI	44		;A COMMA?
3849	BEQ	INDLOP		;YES.
3850	STY	COUNT		;SAVE COUNT OF DIMS.
3851	JSR	CHKCLS		;MUST BE CLOSED PAREN.
3852	PLA
3853	STA	VALTYP		;GET VALTYP AND
3854	PLA
3855IFN	INTPRC,<
3856	STA	INTFLG
3857	ANDI	127>
3858	STA	DIMFLG		;DIMFLG OFF STACK.
3859	LDX	ARYTAB		;PLACE TO START SEARCH.
3860	LDA	ARYTAB+1
3861LOPFDA: STX	LOWTR
3862	STA	LOWTR+1
3863	CMP	STREND+1	;END OF ARRAYS?
3864	BNE	LOPFDV
3865	CPX	STREND
3866	BEQ	NOTFDD		;A FINE THING! NO ARRAY!.
3867LOPFDV: LDYI	0
3868	LDADY	LOWTR
3869	INY
3870	CMP	VARNAM		;COMPARE HIGH ORDERS.
3871	BNE	NMARY1		;NO WAY IS IT THIS. GET OUT OF HERE.
3872	LDA	VARNAM+1
3873	CMPDY	LOWTR		;LOW ORDERS?
3874	BEQ	GOTARY		;WELL, HERE IT IS !!
3875NMARY1: INY
3876	LDADY	LOWTR		;GET LENGTH.
3877	CLC
3878	ADC	LOWTR
3879	TAX
3880	INY
3881	LDADY	LOWTR
3882	ADC	LOWTR+1
3883	BCC	LOPFDA		;ALWAYS BRANCHES.
3884BSERR:	LDXI	ERRBS		;GET BAD SUB ERROR NUMBER.
3885	SKIP2
3886FCERR:	LDXI	ERRFC		;TOO BIG. "FUNCTION CALL" ERROR.
3887ERRGO3: JMP	ERROR
3888GOTARY: LDXI	ERRDD		;PERHAPS A "RE-DIMENSION" ERROR
3889	LDA	DIMFLG		;TEST THE DIMFLG
3890	BNE	ERRGO3
3891	JSR	FMAPTR
3892	LDA	COUNT		;GET NUMBER OF DIMS INPUT.
3893	LDYI	4
3894	CMPDY	LOWTR		;# OF DIMS THE SAME?
3895	BNE	BSERR		;SAME SO GO GET DEFINITION.
3896	JMP	GETDEF
3897
3898;
3899; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE.
3900;
3901; BUILDING AN ENTRY.
3902;
3903;	PUT DOWN THE DESCRIPTOR.
3904;	SETUP NUMBER OF DIMENSIONS.
3905;	MAKE SURE THERE IS ROOM FOR THE NEW ENTRY.
3906;	REMEMBER "VARPNT".
3907;	TALLY=4.
3908;	SKIP 2 LOCS FOR LATER FILL IN OF SIZE.
3909; LOOP: GET AN INDICE
3910;	PUT DOWN NUMBER+1 AND INCREMENT VARPTR.
3911;	TALLY=TALLY*NUMBER+1.
3912;	DECREMENT NUMBER-DIMS.
3913;	BNE LOOP
3914;	CALL "REASON" WITH [Y,A] REFLECTING LAST LOC OF VARIABLE.
3915;	UPDATE STREND.
3916;	ZERO ALL.
3917;	MAKE TALLY INCLUDE MAXDIMS AND DESCRIPTOR.
3918;	PUT DOWN TALLY.
3919;	IF CALLED BY DIMENSION, RETURN.
3920;	OTHERWISE INDEX INTO THE VARIABLE AS IF IT
3921;	 WERE FOUND ON THE INITIAL SEARCH.
3922;
3923NOTFDD: JSR	FMAPTR		;FORM ARYPNT.
3924	JSR	REASON
3925	LDAI	0
3926	TAY
3927	STA	CURTOL+1
3928IFE	ADDPRC,<
3929	LDXI	4>
3930IFN	ADDPRC,<
3931	LDXI	5>
3932	LDA	VARNAM		;THIS CODE ONLY WORKS FOR INTPRC=1
3933	STADY	LOWTR		;IF ADDPRC=1.
3934IFN	ADDPRC,<
3935	BPL	NOTFLT
3936	DEX>
3937NOTFLT: INY
3938	LDA	VARNAM+1
3939	STADY	LOWTR
3940	BPL	STOMLT
3941	DEX
3942IFN	ADDPRC,<
3943	DEX>
3944STOMLT: STX	CURTOL
3945	LDA	COUNT
3946	REPEAT	3,<INY>
3947	STADY	LOWTR		;SAVE NUMBER OF DIMENSIONS.
3948LOPPTA: LDXI	11		;DEFAULT SIZE.
3949	LDAI	0
3950	BIT	DIMFLG
3951	BVC	NOTDIM		;NOT IN A DIM STATEMENT.
3952	PLA			;GET LOW ORDER OF INDICE.
3953	CLC
3954	ADCI	1
3955	TAX
3956	PLA			;GET HIGH PART OF INDICE.
3957	ADCI	0
3958NOTDIM: INY
3959	STADY	LOWTR		;STORE HIGH PART OF INDICE.
3960	INY
3961	TXA
3962	STADY	LOWTR		;STORE LOW ORDER OF INDICE.
3963	JSR	UMULT		;[X,A]=[CURTOL]*[LOWTR,Y]
3964	STX	CURTOL		;SAVE NEW TALLY.
3965	STA	CURTOL+1
3966	LDY	INDEX
3967	DEC	COUNT		;ANY MORE INDICES LEFT?
3968	BNE	LOPPTA		;YES.
3969	ADC	ARYPNT+1
3970	BCS	OMERR1		;OVERFLOW.
3971	STA	ARYPNT+1	;COMPUTE WHERE TO ZERO.
3972	TAY
3973	TXA
3974	ADC	ARYPNT
3975	BCC	GREASE
3976	INY
3977	BEQ	OMERR1
3978GREASE: JSR	REASON		;GET ROOM.
3979	STWD	STREND		;NEW END OF STORAGE.
3980	LDAI	0		;STORING [ACCA] IS FASTER THAN CLEAR.
3981	INC	CURTOL+1
3982	LDY	CURTOL
3983	BEQ	DECCUR
3984ZERITA: DEY
3985	STADY	ARYPNT
3986	BNE	ZERITA		;NO. CONTINUE.
3987DECCUR: DEC	ARYPNT+1
3988	DEC	CURTOL+1
3989	BNE	ZERITA		;DO ANOTHER BLOCK.
3990	INC	ARYPNT+1	;BUMP BACK UP. WILL USE LATER.
3991	SEC
3992	LDA	STREND		;RESTORE [ACCA].
3993	SBC	LOWTR		;DETERMINE LENGTH.
3994	LDYI	2
3995	STADY	LOWTR		;LOW.
3996	LDA	STREND+1
3997	INY
3998	SBC	LOWTR+1
3999	STADY	LOWTR		;HIGH.
4000	LDA	DIMFLG
4001	BNE	DIMRTS		;BYE.
4002	INY
4003;
4004; AT THIS POINT [LOWTR,Y] POINTS BEYOND THE SIZE TO THE NUMBER OF
4005; DIMENSIONS. STRATEGY:
4006;	NUMDIM=NUMBER OF DIMENSIONS.
4007;	CURTOL=0.
4008; INLPNM:GET A NEW INDICE.
4009;	MAKE SURE INDICE IS NOT TOO BIG.
4010;	MULTIPLY CURTOL BY CURMAX.
4011;	ADD INDICE TO CURTOL.
4012;	NUMDIM=NUMDIM-1.
4013;	BNE	INLPNM.
4014;	USE [CURTOL]*4 AS OFFSET.
4015;
4016GETDEF: LDADY	LOWTR
4017	STA	COUNT		;SAVE A COUNTER.
4018	LDAI	0		;ZERO [CURTOL].
4019	STA	CURTOL
4020INLPNM: STA	CURTOL+1
4021	INY
4022	PLA			;GET LOW INDICE.
4023	TAX
4024	STA	INDICE
4025	PLA			;AND THE HIGH PART
4026	STA	INDICE+1
4027	CMPDY	LOWTR		;COMPARE WITH MAX INDICE.
4028	BCC	INLPN2
4029	BNE	BSERR7		;IF GREATER, "BAD SUBSCRIPT" ERROR.
4030	INY
4031	TXA
4032	CMPDY	LOWTR
4033	BCC	INLPN1
4034BSERR7: JMP	BSERR
4035OMERR1: JMP	OMERR
4036INLPN2: INY
4037INLPN1: LDA	CURTOL+1	;DON'T MULTIPLY IF CURTOL=0.
4038	ORA	CURTOL
4039	CLC			;PREPARE TO GET INDICE BACK.
4040	BEQ	ADDIND		;GET HIGH PART OF INDICE BACK.
4041	JSR	UMULT		;MULTIPLY [CURTOL] BY [LOWTR,Y,Y+1].
4042	TXA
4043	ADC	INDICE		;ADD IN [INDICE].
4044	TAX
4045	TYA
4046	LDY	INDEX1
4047ADDIND: ADC	INDICE+1
4048	STX	CURTOL
4049	DEC	COUNT		;ANY MORE?
4050	BNE	INLPNM		;YES.
4051	STA	CURTOL+1	;FIX ARRAY BUG ****
4052IFE	ADDPRC,<
4053	LDXI	4>
4054IFN	ADDPRC,<
4055	LDXI	5		;THIS CODE ONLY WORKS FOR INTPRC=1
4056	LDA	VARNAM		;IF ADDPRC=1.
4057	BPL	NOTFL1
4058	DEX>
4059NOTFL1: LDA	VARNAM+1
4060	BPL	STOML1
4061	DEX
4062IFN	ADDPRC,<
4063	DEX>
4064STOML1: STX	ADDEND
4065	LDAI	0
4066	JSR	UMULTD		;ON RTS, A&Y=HI . X=LO.
4067	TXA
4068	ADC	ARYPNT
4069	STA	VARPNT
4070	TYA
4071	ADC	ARYPNT+1
4072	STA	VARPNT+1
4073	TAY
4074	LDA	VARPNT
4075DIMRTS: RTS			;RETURN TO CALLER.
4076SUBTTL	INTEGER ARITHMETIC ROUTINES.
4077	;TWO BYTE UNSIGNED INTEGER MULTIPLY.
4078	;THIS IS FOR MULTIPLY DIMENSIONED ARRAYS.
4079	; [X,Y]=[X,A]=[CURTOL]*[LOWTR,Y,Y+1].
4080UMULT:	STY	INDEX
4081	LDADY	LOWTR
4082	STA	ADDEND		;LOW, THEN HIGH.
4083	DEY
4084	LDADY	LOWTR		;PUT [LOWTR,Y,Y+1] IN FASTER MEMORY.
4085UMULTD: STA	ADDEND+1
4086	LDAI	16
4087	STA	DECCNT
4088	LDXI	0		;CLR THE ACCS.
4089	LDYI	0		;RESULT INITIALLY ZERO.
4090UMULTC: TXA
4091	ASL	A,		;MULTIPLY BY TWO.
4092	TAX
4093	TYA
4094	ROL	A,
4095	TAY
4096	BCS	OMERR1		;TWO MUCH !
4097	ASL	CURTOL
4098	ROL	CURTOL+1
4099	BCC	UMLCNT		;NOTHING IN THIS POSITION TO MULTIPLY.
4100	CLC
4101	TXA
4102	ADC	ADDEND
4103	TAX
4104	TYA
4105	ADC	ADDEND+1
4106	TAY
4107	BCS	OMERR1		;MAN, JUST TOO MUCH !
4108UMLCNT: DEC	DECCNT		;DONE?
4109	BNE	UMULTC		;KEEP IT UP.
4110UMLRTS: RTS			;YES, ALL DONE.
4111PAGE
4112SUBTTL	FRE FUNCTION AND INTEGER TO FLOATING ROUTINES.
4113FRE:	LDA	VALTYP
4114	BEQ	NOFREF
4115	JSR	FREFAC
4116NOFREF: JSR	GARBA2
4117	SEC
4118	LDA	FRETOP		;WE WANT
4119	SBC	STREND		;[FRETOP]-[STREND].
4120	TAY
4121	LDA	FRETOP+1
4122	SBC	STREND+1
4123
4124GIVAYF: LDXI	0
4125	STX	VALTYP
4126	STWD	FACHO
4127	LDXI	144		;SET EXPONENT TO 2^16.
4128	JMP	FLOATS		;TURN IT TO A FLOATING PNT #.
4129
4130POS:	LDY	TRMPOS		;GET POSITION.
4131SNGFLT: LDAI	0
4132	BEQA	GIVAYF		;FLOAT IT.
4133PAGE
4134SUBTTL	SIMPLE-USER-DEFINED-FUNCTION CODE.
4135;
4136; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS
4137; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM:
4138;	DEF FNA(X)=X^2+X-2
4139; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS.
4140;
4141; IDEA: CREATE A SIMPLE VARIABLE ENTRY
4142; WHOSE FIRST CHARACTER HAS THE 200 BIT SET.
4143; THE VALUE WILL BE:
4144;
4145;	A TEXT PNTR TO THE FORMULA.
4146;	A PNTR TO THE ARGUMENT VARIABLE.
4147;
4148; FUNCTION NAMES CAN BE LIKE "FNA4".
4149;
4150;
4151; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE.
4152; AND COMPLAIN IF SO.
4153;
4154ERRDIR: LDX	CURLIN+1	;DIR MODE HAS [CURLIN]=0,255
4155	INX			;SO NOW, IS RESULT ZERO?
4156	BNE	DIMRTS		;YES.
4157	LDXI	ERRID		;INPUT DIRECT ERROR CODE.
4158	SKIP2
4159ERRGUF: LDXI	ERRUF		;USER DEFINED FUNCTION NEVER DEFINED
4160ERRGO1: JMP	ERROR
4161
4162DEF:	JSR	GETFNM		;GET A PNTR TO THE FUNCTION.
4163	JSR	ERRDIR
4164	JSR	CHKOPN		;MUST HAVE "(".
4165	LDAI	128
4166	STA	SUBFLG		;PROHIBIT SUBSCRIPTED VARIABLES.
4167	JSR	PTRGET		;GET PNTR TO ARGUMENT.
4168	JSR	CHKNUM		;IS IT A NUMBER?
4169	JSR	CHKCLS		;MUST HAVE ")"
4170	SYNCHK	EQULTK		;MUST HAVE "=".
4171IFN	ADDPRC,<PHA>		;PUT CRAZY BYTE ON.
4172	PSHWD	VARPNT
4173	PSHWD	TXTPTR
4174	JSR	DATA
4175	JMP	DEFFIN
4176;
4177; SUBROUTINE TO GET A PNTR TO A FUNCTION NAME.
4178;
4179GETFNM: SYNCHK	FNTK		;MUST START WITH FN.
4180	ORAI	128		;PUT FUNCTION BIT ON.
4181	STA	SUBFLG
4182	JSR	PTRGT2		;GET POINTER TO FUNCTION OR CREATE ANEW.
4183	STWD	DEFPNT
4184	JMP	CHKNUM		;MAKE SURE IT'S NOT A STRING AND RETURN.
4185
4186FNDOER: JSR	GETFNM		;GET THE FUNCTION'S NAME.
4187	PSHWD	DEFPNT
4188	JSR	PARCHK		;EVALUATE PARAMETER.
4189	JSR	CHKNUM
4190	PULWD	DEFPNT
4191	LDYI	2
4192	LDADY	DEFPNT		;GET POINTER TO VARIABLE.
4193	STA	VARPNT		;SAVE VARIABLE POINTER.
4194	TAX
4195	INY
4196	LDADY	DEFPNT
4197	BEQ	ERRGUF
4198	STA	VARPNT+1
4199IFN	ADDPRC,<INY>		;SINCE DEF USES ONLY 4.
4200DEFSTF: LDADY	VARPNT
4201	PHA			;PUSH IT ALL ON STACK.
4202	DEY			;SINCE WE ARE RECURSING MAYBE.
4203	BPL	DEFSTF
4204	LDY	VARPNT+1
4205	JSR	MOVMF		;PUT CURRENT FAC INTO OUR ARG VARIABLE.
4206	PSHWD	TXTPTR		;SAVE TEXT POINTER.
4207	LDADY	DEFPNT		;PNTR TO FUNCTION.
4208	STA	TXTPTR
4209	INY
4210	LDADY	DEFPNT
4211	STA	TXTPTR+1
4212	PSHWD	VARPNT		;SAVE VARIABLE POINTER.
4213	JSR	FRMNUM		;EVALUATE FORMULA AND CHECK NUMERIC.
4214	PULWD	DEFPNT
4215	JSR	CHRGOT
4216	JNE	SNERR		;IT DIDN'T TERMINATE. HUH?
4217	PULWD	TXTPTR		;RESTORE TEXT PNTR.
4218DEFFIN: LDYI	0
4219	PLA			;GET OLD ARG VALUE OFF STACK
4220	STADY	DEFPNT		;AND PUT IT BACK IN VARIABLE.
4221	PLA
4222	INY
4223	STADY	DEFPNT
4224	PLA
4225	INY
4226	STADY	DEFPNT
4227	PLA
4228	INY
4229	STADY	DEFPNT
4230IFN	ADDPRC,<
4231	PLA
4232	INY	
4233	STADY	DEFPNT>
4234DEFRTS: RTS
4235	PAGE
4236SUBTTL	STRING FUNCTIONS.
4237;
4238; THE STR$ FUNCTION TAKES A NUMBER AND GIVES A STRING
4239; WITH THE CHARACTERS THE OUTPUT OF THE NUMBER
4240; WOULD HAVE GIVEN.
4241;
4242STR:	JSR	CHKNUM		;ARG HAS TO BE NUMERIC.
4243	LDYI	0
4244	JSR	FOUTC		;DO ITS OUTPUT.
4245	PLA
4246	PLA
4247TIMSTR: LDWDI	LOFBUF
4248	BEQA	STRLIT		;SCAN IT AND TURN IT INTO A STRING.
4249;
4250; "STRINI" GET STRING SPACE FOR THE CREATION OF A STRING AND
4251; CREATES A DESCRIPTOR FOR IT IN "DSCTMP".
4252;
4253STRINI: LDXY	FACMO		;GET FACMO TO STORE IN DSCPNT.
4254	STXY	DSCPNT		;RETAIN THE DESCRIPTOR POINTER.
4255STRSPA: JSR	GETSPA		;GET STRING SPACE.
4256	STXY	DSCTMP+1	;SAVE LOCATION.
4257	STA	DSCTMP		;SAVE LENGTH.
4258	RTS			;ALL DONE.
4259;
4260; "STRLT2" TAKES THE STRING LITERAL WHOSE FIRST CHARACTER
4261; IS POINTED TO BY [Y,A] AND BUILDS A DESCRIPTOR FOR IT.
4262; THE DESCRIPTOR IS INITIALLY BUILT IN "DSCTMP", BUT "PUTNEW"
4263; TRANSFERS IT INTO A TEMPORARY AND LEAVES A POINTER
4264; AT THE TEMPORARY IN FACMO&LO. THE CHARACTERS OTHER THAN
4265; ZERO THAT TERMINATE THE STRING SHOULD BE SET UP IN "CHARAC"
4266; AND "ENDCHR". IF THE TERMINATOR IS A QUOTE, THE QUOTE IS SKIPPED
4267; OVER. LEADING QUOTES SHOULD BE SKIPPED BEFORE JSR. ON RETURN
4268; THE CHARACTER AFTER THE STRING LITERAL IS POINTED TO
4269; BY [STRNG2].
4270;
4271STRLIT: LDXI	34		;ASSUME STRING ENDS ON QUOTE.
4272	STX	CHARAC
4273	STX	ENDCHR
4274STRLT2: STWD	STRNG1		;SAVE POINTER TO STRING.
4275	STWD	DSCTMP+1	;IN CASE NO STRCPY.
4276	LDYI	255		;INITIALIZE CHARACTER COUNT.
4277STRGET: INY
4278	LDADY	STRNG1		;GET CHARACTER.
4279	BEQ	STRFI1		;IF ZERO.
4280	CMP	CHARAC		;THIS TERMINATOR?
4281	BEQ	STRFIN		;YES.
4282	CMP	ENDCHR
4283	BNE	STRGET		;LOOK FURTHER.
4284STRFIN: CMPI	34		;QUOTE?
4285	BEQ	STRFI2
4286STRFI1: CLC			;NO, BACK UP.
4287STRFI2: STY	DSCTMP		;RETAIN COUNT.
4288	TYA
4289	ADC	STRNG1		;WISHING TO SET [TXTPTR].
4290	STA	STRNG2
4291	LDX	STRNG1+1
4292	BCC	STRST2
4293	INX
4294STRST2: STX	STRNG2+1
4295	LDA	STRNG1+1	;IF PAGE 0, COPY SINCE IT IS EITHER
4296				;A STRING CONSTANT IN BUF OR A STR$
4297				;RESULT IN LOFBUF
4298IFN	BUFPAG,<
4299	BEQ	STRCP
4300	CMPI	BUFPAG>
4301	BNE	PUTNEW
4302STRCP:	TYA
4303	JSR	STRINI
4304	LDXY	STRNG1
4305	JSR	MOVSTR		;MOVE STRING.
4306;
4307; SOME STRING FUNCTION IS RETURNING A RESULT IN DSCTMP.
4308; SETUP A TEMP DESCRIPTOR WITH DSCTMP IN IT.
4309; PUT A POINTER TO THE DESCRIPTOR IN FACMO&LO AND FLAG THE
4310; RESULT AS TYPE STRING.
4311;
4312PUTNEW: LDX	TEMPPT		;POINTER TO FIRST FREE TEMP.
4313	CPXI	TEMPST+STRSIZ*NUMTMP
4314	BNE	PUTNW1
4315	LDXI	ERRST		;STRING TEMPORARY ERROR.
4316ERRGO2: JMP	ERROR		;GO TELL HIM.
4317PUTNW1: LDA	DSCTMP
4318	STA	0,X
4319	LDA	DSCTMP+1
4320	STA	1,X
4321	LDA	DSCTMP+2
4322	STA	2,X
4323	LDYI	0
4324	STXY	FACMO
4325	STY	FACOV
4326	DEY
4327	STY	VALTYP		;TYPE IS "STRING".
4328	STX	LASTPT		;SET POINTER TO LAST-USED TEMP.
4329	INX
4330	INX
4331	INX			;POINT FURTHER.
4332	STX	TEMPPT		;SAVE POINTER TO NEXT TEMP IF ANY.
4333	RTS			;ALL DONE.
4334
4335;
4336; GETSPA - GET SPACE FOR CHARACTER STRING.
4337; MAY FORCE GARBAGE COLLECTION.
4338;
4339; # OF CHARACTERS (BYTES) IN ACCA.
4340; RETURNS WITH POINTER IN [Y,X]. OTHERWISE (IF CAN'T GET
4341; SPACE) BLOWS OFF TO "OUT OF STRING SPACE" TYPE ERROR.
4342; ALSO PRESERVES [ACCA] AND SETS [FRESPC]=[Y,X]=PNTR AT SPACE.
4343;
4344GETSPA: LSR	GARBFL		;SIGNAL NO GARBAGE COLLECTION YET.
4345TRYAG2: PHA			;SAVE FOR LATER.
4346	EORI	255
4347	SEC			;ADD ONE TO COMPLETE NEGATION.
4348	ADC	FRETOP
4349	LDY	FRETOP+1
4350	BCS	TRYAG3
4351	DEY
4352TRYAG3: CPY	STREND+1	;COMPARE HIGH ORDERS.
4353	BCC	GARBAG		;MAKE ROOM FOR MORE.
4354	BNE	STRFRE		;SAVE NEW FRETOP.
4355	CMP	STREND		;COMPARE LOW ORDERS.
4356	BCC	GARBAG		;CLEAN UP.
4357STRFRE: STWD	FRETOP		;SAVE NEW [FRETOP].
4358	STWD	FRESPC		;PUT IT THERE OLD MAN.
4359	TAX			;PRESERVE A IN X.
4360	PLA			;GET COUNT BACK IN ACCA.
4361	RTS			;ALL DONE.
4362GARBAG: LDXI	ERROM		;"OUT OF STRING SPACE"
4363	LDA	GARBFL
4364	BMI	ERRGO2
4365	JSR	GARBA2
4366	LDAI	128
4367	STA	GARBFL
4368	PLA			;GET BACK STRING LENGTH.
4369	BNE	TRYAG2		;ALWAYS BRANCHES.
4370GARBA2:				;START FROM TOP DOWN.
4371IFE	REALIO!DISKO,<
4372	LDAI	7		;TYPE "BELL".
4373	JSR	OUTDO>
4374	LDX	MEMSIZ
4375	LDA	MEMSIZ+1
4376FNDVAR: STX	FRETOP		;LIKE SO.
4377	STA	FRETOP+1
4378	LDYI	0
4379	STY	GRBPNT+1
4380	STY	GRBPNT		;BOTH BYTES SET TO ZERO (FIX BUG)
4381	LDWX	STREND
4382	STWX	GRBTOP
4383	LDWXI	TEMPST
4384	STWX	INDEX1
4385TVAR:	CMP	TEMPPT		;DONE WITH TEMPS?
4386	BEQ	SVARS		;YEP.
4387	JSR	DVAR
4388	BEQ	TVAR		;LOOP.
4389SVARS:	LDAI	6+ADDPRC
4390	STA	FOUR6
4391	LDWX	VARTAB		;GET START OF SIMPLE VARIABLES.
4392	STWX	INDEX1
4393SVAR:	CPX	ARYTAB+1	;DONE WITH SIMPLE VARIABLES?
4394	BNE	SVARGO		;NO.
4395	CMP	ARYTAB
4396	BEQ	ARYVAR		;YEP.
4397SVARGO: JSR	DVARS		;DO IT , AGAIN.
4398	BEQ	SVAR		;LOOP.
4399ARYVAR: STWX	ARYPNT		;SAVE FOR ADDITION.
4400	LDAI	STRSIZ
4401	STA	FOUR6
4402ARYVA2: LDWX	ARYPNT		;GET THE POINTER TO VARIABLE.
4403ARYVA3: CPX	STREND+1	;DONE WITH ARRAYS?
4404	BNE	ARYVGO		;NO.
4405	CMP	STREND
4406	JEQ	GRBPAS		;YES, GO FINISH UP.
4407ARYVGO: STWX	INDEX1
4408	LDYI	1-ADDPRC
4409IFN	ADDPRC,<
4410	LDADY	INDEX1
4411	TAX
4412	INY>
4413	LDADY	INDEX1
4414	PHP
4415	INY
4416	LDADY	INDEX1
4417	ADC	ARYPNT
4418	STA	ARYPNT		;FORM POINTER TO NEXT ARRAY VAR.
4419	INY
4420	LDADY	INDEX1
4421	ADC	ARYPNT+1
4422	STA	ARYPNT+1
4423	PLP
4424	BPL	ARYVA2
4425IFN	ADDPRC,<
4426	TXA
4427	BMI	ARYVA2>
4428	INY
4429	LDADY	INDEX1
4430	LDYI	0		;RESET INDEX Y.
4431	ASL	A,
4432	ADCI	5		;CARRY IS OFF AND OFF AFTER ADD.
4433	ADC	INDEX1
4434	STA	INDEX1
4435	BCC	ARYGET
4436	INC	INDEX1+1
4437ARYGET: LDX	INDEX1+1
4438ARYSTR: CPX	ARYPNT+1	;END OF THE ARRAY?
4439	BNE	GOGO
4440	CMP	ARYPNT
4441	BEQ	ARYVA3		;YES.
4442GOGO:	JSR	DVAR
4443	BEQ	ARYSTR		;CYCLE.
4444DVARS:
4445IFN	INTPRC,<
4446	LDADY	INDEX1
4447	BMI	DVARTS>
4448	INY
4449	LDADY	INDEX1
4450	BPL	DVARTS
4451	INY
4452DVAR:	LDADY	INDEX1		;IS LENGTH=0?
4453	BEQ	DVARTS		;YES, RETURN.
4454	INY
4455	LDADY	INDEX1		;GET LOW(ADR).
4456	TAX
4457	INY
4458	LDADY	INDEX1
4459	CMP	FRETOP+1	;COMPARE HIGHS.
4460	BCC	DVAR2		;IF THIS STRING'S PNTR .GE. [FRETOP]
4461	BNE	DVARTS		;NO NEED TO MESS WITH IT FURTHER.
4462	CPX	FRETOP		;COMPARE LOWS.
4463	BCS	DVARTS
4464DVAR2:	CMP	GRBTOP+1
4465	BCC	DVARTS		;IF THIS STRING IS BELOW PREVIOUS,
4466				;FORGET IT.
4467	BNE	DVAR3
4468	CPX	GRBTOP		;COMPARE LOW ORDERS.
4469	BCC	DVARTS		;[X,A] .LE. [GRBTOP].
4470DVAR3:	STX	GRBTOP
4471	STA	GRBTOP+1
4472	LDWX	INDEX1
4473	STWX	GRBPNT
4474	LDA	FOUR6
4475	STA	SIZE
4476DVARTS: LDA	FOUR6
4477	CLC
4478	ADC	INDEX1
4479	STA	INDEX1
4480	BCC	GRBRTS
4481	INC	INDEX1+1
4482GRBRTS: LDX	INDEX1+1
4483	LDYI	0
4484	RTS			;DONE.
4485;
4486; HERE WHEN MADE ONE COMPLETE PASS THROUGH STRING VARIABLES.
4487;
4488GRBPAS: LDA	GRBPNT+1	;VARIABLE POINTER.
4489	ORA	GRBPNT
4490	BEQ	GRBRTS		;ALL DONE.
4491	LDA	SIZE
4492	ANDI	4		;LEAVES C OFF.
4493	LSR	A,
4494	TAY
4495	STA	SIZE
4496	LDADY	GRBPNT
4497				;NOTE: GRBTOP=LOWTR SO NO NEED TO SET LOWTR.
4498	ADC	LOWTR
4499	STA	HIGHTR
4500	LDA	LOWTR+1
4501	ADCI	0
4502	STA	HIGHTR+1
4503	LDWX	FRETOP
4504	STWX	HIGHDS		;WHERE IT ALL GOES.
4505	JSR	BLTUC
4506	LDY	SIZE
4507	INY
4508	LDA	HIGHDS		;GET POSITION OF START OF RESULT.
4509	STADY	GRBPNT
4510	TAX
4511	INC	HIGHDS+1
4512	LDA	HIGHDS+1
4513	INY
4514	STADY	GRBPNT		;CHANGE ADDR OF STRING IN VAR.
4515	JMP	FNDVAR		;GO TO FNDVAR WITH SOMETHING FOR
4516				;[FRETOP].
4517;
4518; THE FOLLOWING ROUTINE CONCATENATES TWO STRINGS.
4519; THE FAC CONTAINS THE FIRST ONE AT THIS POINT.
4520; [TXTPTR] POINTS TO THE + SIGN.
4521;
4522CAT:	LDA	FACLO		;PSH HIGH ORDER ONTO STACK.
4523	PHA
4524	LDA	FACMO		;AND THE LOW.
4525	PHA
4526	JSR	EVAL		;CAN COME BACK HERE SINCE
4527				;OPERATOR IS KNOWN.
4528	JSR	CHKSTR		;RESULT MUST BE STRING.
4529	PLA
4530	STA	STRNG1		;GET HIGH ORDER OF OLD DESC.
4531	PLA
4532	STA	STRNG1+1
4533	LDYI	0
4534	LDADY	STRNG1		;GET LENGTH OF OLD STRING.
4535	CLC
4536	ADCDY	FACMO
4537	BCC	SIZEOK		;RESULT IS LESS THAN 256.
4538	LDXI	ERRLS		;ERROR "LONG STRING".
4539	JMP	ERROR
4540SIZEOK: JSR	STRINI		;INITIALIZE STRING.
4541	JSR	MOVINS		;MOVE IT.
4542	LDWD	DSCPNT		;GET POINTER TO SECOND.
4543	JSR	FRETMP		;FREE IT.
4544	JSR	MOVDO
4545	LDWD	STRNG1
4546	JSR	FRETMP
4547	JSR	PUTNEW
4548	JMP	TSTOP		;"CAT" REENTERS FORM EVAL AT TSTOP.
4549
4550MOVINS: LDYI	0		;GET ADDR OF STRING.
4551	LDADY	STRNG1
4552	PHA
4553	INY
4554	LDADY	STRNG1
4555	TAX
4556	INY
4557	LDADY	STRNG1
4558	TAY
4559	PLA
4560MOVSTR: STXY	INDEX
4561MOVDO:	TAY
4562	BEQ	MVDONE
4563	PHA
4564MOVLP:	DEY
4565	LDADY	INDEX
4566	STADY	FRESPC
4567QMOVE:	TYA
4568	BNE	MOVLP
4569	PLA
4570MVDONE: CLC
4571	ADC	FRESPC
4572	STA	FRESPC
4573	BCC	MVSTRT
4574	INC	FRESPC+1
4575MVSTRT: RTS
4576;
4577; "FRETMP" IS PASSED A STRING DESCRIPTOR PNTR IN [Y,A].
4578; A CHECK IS MADE TO SEE IF THE STRING DESCRIPTOR POINTS TO THE LAST
4579; TEMPORARY DESCRIPTOR ALLOCATED BY PUTNEW.
4580; IF SO, THE TEMPORARY IS FREED UP BY THE UPDATING OF [TEMPPT].
4581; IF A TEMP IS FREED UP, A FURTHER CHECK SEES IF THE STRING DATA THAT
4582; THAT STRING TEMP PNT'D TO IS THE LOWEST PART OF STRING SPACE IN USE.
4583; IF SO, [FRETOP] IS UPDATED TO REFLECT THE FACT THE FACT THAT THE SPACE
4584; IS NO LONGER IN USE.
4585; THE ADDR OF THE ACTUAL STRING IS RETURNED IN [Y,X] AND
4586; ITS LENGTH IN ACCA.
4587;
4588FRESTR: JSR	CHKSTR		;MAKE SURE ITS A STRING.
4589FREFAC: LDWD	FACMO		;FREE UP STR PNT'D TO BY FAC.
4590FRETMP: STWD	INDEX		;GET LENGTH FOR LATER.
4591	JSR	FRETMS		;FREE UP THE TEMPORARY DESC.
4592	PHP			;SAVE CODES.
4593	LDYI	0		;PREP TO GET STUFF.
4594	LDADY	INDEX		;GET COUNT AND
4595	PHA			;SAVE IT.
4596	INY
4597	LDADY	INDEX
4598	TAX			;SAVE LOW ORDER.
4599	INY
4600	LDADY	INDEX
4601	TAY			;SAVE HIGH ORDER.
4602	PLA
4603	PLP			;RETURN STATUS.
4604	BNE	FRETRT
4605	CPY	FRETOP+1	;STRING IS LAST ONE IN?
4606	BNE	FRETRT
4607	CPX	FRETOP
4608	BNE	FRETRT
4609	PHA
4610	CLC
4611	ADC	FRETOP
4612	STA	FRETOP
4613	BCC	FREPLA
4614	INC	FRETOP+1
4615FREPLA: PLA			;GET COUNT BACK.
4616FRETRT: STXY	INDEX		;SAVE FOR LATER USE.
4617	RTS
4618FRETMS: CPY	LASTPT+1	;LAST ENTRY TO TEMP? 
4619	BNE	FRERTS
4620	CMP	LASTPT
4621	BNE	FRERTS
4622	STA	TEMPPT
4623	SBCI	STRSIZ		;POINT TO LAST ONE.
4624	STA	LASTPT		;UPDATE TEMP PNTR.
4625	LDYI	0		;ALSO CLEARS ZFLG SO WE DO REST OF FRETMP.
4626FRERTS: RTS			;ALL DONE.
4627;
4628; CHR$(#) CREATES A STRING WHICH CONTAINS AS ITS ONLY
4629; CHARACTER THE ASCII EQUIVALENT OF THE INTEGER ARGUMENT (#)
4630; WHICH MUST BE .LT. 255.
4631;
4632CHR:	JSR	CONINT		;GET INTEGER IN RANGE.
4633	TXA
4634	PHA
4635	LDAI	1		;ONE-CHARACTER STRING.
4636	JSR	STRSPA		;GET SPACE FOR STRING.
4637	PLA
4638	LDYI	0
4639	STADY	DSCTMP+1
4640	PLA			;GET RID OF "CHKNUM" RETURN ADDR.
4641	PLA
4642RLZRET: JMP	PUTNEW		;SETUP FAC TO POINT TO DESC.
4643;
4644; THE FOLLOWING IS THE LEFT$($,#) FUNCTION.
4645; IT TAKES THE LEFTMOST # CHARACTERS OF THE STRING.
4646; IF # .GT. THE LEN OF THE STRING, IT RETURNS THE WHOLE STRING.
4647;
4648LEFT:	JSR	PREAM		;TEST PARAMETERS.
4649	CMPDY	DSCPNT
4650	TYA
4651RLEFT:	BCC	RLEFT1
4652	LDADY	DSCPNT
4653	TAX			;PUT LENGTH INTO X.
4654	TYA			;ZERO A, THE OFFSET.
4655RLEFT1: PHA			;SAVE OFFSET.
4656RLEFT2: TXA
4657RLEFT3: PHA			;SAVE LENGTH.
4658	JSR	STRSPA		;GET SPACE.
4659	LDWD	DSCPNT
4660	JSR	FRETMP
4661	PLA
4662	TAY
4663	PLA
4664	CLC
4665	ADC	INDEX		;COMPUTE WHERE TO COPY.
4666	STA	INDEX
4667	BCC	PULMOR
4668	INC	INDEX+1
4669PULMOR: TYA
4670	JSR	MOVDO		;GO MOVE IT.
4671	JMP	PUTNEW
4672RIGHT:	JSR	PREAM
4673	CLC			;[LENGTH DES'D]-[LENGTH]-1.
4674	SBCDY	DSCPNT
4675	EORI	255		;NEGATE.
4676	JMP	RLEFT
4677;
4678; MID ($,#) RETURNS STRING WITH CHARS FROM # POSITION
4679; ONWARD. IF # .GT. LEN ($) THEN RETURN NULL STRING.
4680; MID ($,#,#) RETURNS STRING WITH CHARACTERS FROM
4681; # POSITION FOR #2 CHARACTERS. IF #2 GOES PAST END OF STRING
4682; RETURN AS MUCH AS POSSIBLE.
4683;
4684MID:	LDAI	255		;DEFAULT.
4685	STA	FACLO		;SAVE FOR LATER COMPARE.
4686	JSR	CHRGOT		;GET CURRENT CHARACTER.
4687	CMPI	41		;IS IT A RIGHT PAREN )?
4688	BEQ	MID2		;NO THIRD PARAM.
4689	JSR	CHKCOM		;MUST HAVE COMMA.
4690	JSR	GETBYT		;GET THE LENGTH INTO "FACLO".
4691MID2:	JSR	PREAM		;CHECK IT OUT.
4692	BEQ	GOFUC		;THERE IS NO POSTION 0
4693	DEX			;COMPUTE OFFSET.
4694	TXA
4695	PHA			;PRSERVE AWHILE.
4696	CLC
4697	LDXI	0
4698	SBCDY	DSCPNT		;GET LENGTH OF WHAT'S LEFT.
4699	BCS	RLEFT2		;GIVE NULL STRING.
4700	EORI	255		;IN SUB C WAS 0 SO JUST COMPLEMENT.
4701	CMP	FACLO		;GREATER THAN WHAT'S DESIRED?
4702	BCC	RLEFT3		;NO, COPY THAT MUCH.
4703	LDA	FACLO		;GET LENGTH OF WHAT'S DESIRED.
4704	BCS	RLEFT3		;COPY IT.
4705
4706;
4707; USED BY RIGHT$, LEFT$, MID$ FOR PARAMETER CHECKING AND SETUP.
4708;
4709PREAM:	JSR	CHKCLS		;PARAM LIST SHOULD END.
4710	PLA			;GET THE RETURN ADDRESS INTO
4711	TAY			;[JMPER+1,Y]
4712	PLA
4713	STA	JMPER+1
4714	PLA			;GET RID OF FINGO'S JSR RET ADDR.
4715	PLA
4716	PLA			;GET LENGTH.
4717	TAX
4718	PULWD	DSCPNT
4719	LDA	JMPER+1		;PUT RETURN ADDRESS BACK ON
4720	PHA
4721	TYA
4722	PHA
4723	LDYI	0
4724	TXA
4725	RTS
4726;
4727; THE FUNCTION LEN($) RETURNS THE LENGTH OF THE STRING
4728; PASSED AS AN ARGUMENT.
4729;
4730LEN:	JSR	LEN1
4731	JMP	SNGFLT
4732LEN1:	JSR	FRESTR		;FREE UP STRING.
4733	LDXI	0
4734	STX	VALTYP		;FORCE NUMERIC.
4735	TAY			;SET CODES ON LENGTH.
4736	RTS			;DONE.
4737;
4738; THE FOLLOWING IS THE ASC($) FUNCTION. IT RETURNS
4739; AN INTEGER WHICH IS THE DECIMAL ASCII EQUIVALENT.
4740;
4741ASC:	JSR	LEN1
4742	BEQ	GOFUC		;NULL STRING, BAD ARG.
4743	LDYI	0
4744	LDADY	INDEX1		;GET CHARACTER.
4745	TAY
4746	JMP	SNGFLT
4747GOFUC:	JMP	FCERR		;YES.
4748
4749GTBYTC: JSR	CHRGET
4750GETBYT: JSR	FRMNUM		;READ FORMULA INTO FAC.
4751CONINT: JSR	POSINT		;CONVERT THE FAC TO A SINGLE BYTE INT.
4752	LDX	FACMO
4753	BNE	GOFUC		;RESULT MUST BE .LE. 255.
4754	LDX	FACLO
4755CHRGO2: JMP	CHRGOT		;SET CONDITION CODES ON TERMINATOR.
4756;
4757; THE "VAL" FUNCTION TAKES A STRING AND TURNS IT INTO
4758; A NUMBER BY INTERPRETING THE ASCII DIGITS ETCQ
4759; EXCEPT FOR THE PROBLEM THAT A TERMINATOR MUST BE SUPPLIED
4760; BY REPLACING THE CHARACTER BEYOND THE STRING, VAL IS MERELY
4761; A CALL TO FLOATING POINT INPUT ("FIN").
4762;
4763VAL:	JSR	LEN1		;DO SETUP. SET RESULT=NUMERIC.
4764	JEQ	ZEROFC		;ZERO THE FAC ON A NULL STRING
4765	LDXY	TXTPTR
4766	STXY	STRNG2		;SAVE FOR LATER.
4767	LDX	INDEX1
4768	STX	TXTPTR
4769	CLC
4770	ADC	INDEX1
4771	STA	INDEX2
4772	LDX	INDEX1+1
4773	STX	TXTPTR+1
4774	BCC	VAL2		;NO CARRY, NO INC.
4775	INX
4776VAL2:	STX	INDEX2+1
4777	LDYI	0
4778	LDADY	INDEX2		;PRESERVE CHARACTER.
4779	PHA
4780	LDAI	0		;SET A TERMINATOR.
4781	STADY	INDEX2
4782	JSR	CHRGOT		;GET CHARACTER PNT'D TO AND SET FLAGS.
4783	JSR	FIN
4784	PLA			;GET PRES'D CHARACTER.
4785	LDYI	0
4786	STADY	INDEX2		;STUFF IT BACK.
4787ST2TXT: LDXY	STRNG2
4788	STXY	TXTPTR
4789VALRTS: RTS			;ALL DONE WITH STRINGS.
4790PAGE
4791SUBTTL	PEEK, POKE, AND FNWAIT.
4792
4793GETNUM: JSR	FRMNUM		;GET ADDRESS.
4794	JSR	GETADR		;GET THAT LOCATION.
4795COMBYT: JSR	CHKCOM		;CHECK FOR A COMMA.
4796	JMP	GETBYT		;GET SOMETHING TO STORE AND RETURN.
4797GETADR: LDA	FACSGN		;EXAMINE SIGN.
4798	BMI	GOFUC		;FUNCTION CALL ERROR.
4799	LDA	FACEXP		;EXAMINE EXPONENT.
4800	CMPI	145
4801	BCS	GOFUC		;FUNCTION CALL ERROR.
4802	JSR	QINT		;INTEGERIZE IT.
4803	LDWD	FACMO
4804	STY	POKER
4805	STA	POKER+1
4806	RTS			;IT'S DONE !.
4807
4808PEEK:	PSHWD	POKER
4809	JSR	GETADR
4810	LDYI	0
4811IFE	REALIO-3,<
4812	CMPI	ROMLOC/256	;IF WITHIN BASIC,
4813	BCC	GETCON
4814	CMPI	LASTWR/256
4815	BCC	DOSGFL>		;GIVE HIM ZERO FOR AN ANSWER.
4816GETCON: LDADY	POKER		;GET THAT BYTE.
4817	TAY
4818DOSGFL: PULWD	POKER
4819	JMP	SNGFLT		;FLOAT IT.
4820
4821POKE:	JSR	GETNUM
4822	TXA
4823	LDYI	0
4824	STADY	POKER		;STORE VALUE AWAY.
4825	RTS			;SCANNED  EVERYTHING.
4826
4827; THE WAIT LOCATION,MASK1,MASK2 STATEMENT WAITS UNTIL THE CONTENTS
4828; OF LOCATION IS NONZERO WHEN XORED WITH MASK2
4829; AND THEN ANDED WITH MASK1. IF MASK2 IS NOT PRESENT, IT
4830; IS ASSUMED TO BE ZERO.
4831
4832FNWAIT: JSR	GETNUM
4833	STX	ANDMSK
4834	LDXI	0
4835	JSR	CHRGOT
4836	BEQ	ZSTORDO
4837	JSR	COMBYT		;GET MASK2.
4838STORDO: STX	EORMSK
4839	LDYI	0
4840WAITER: LDADY	POKER
4841	EOR	EORMSK
4842	AND	ANDMSK
4843	BEQ	WAITER
4844ZERRTS: RTS			;GOT A NONZERO.
4845SUBTTL FLOATING POINT MATH PACKAGE CONFIGURATION.
4846
4847RADIX	8			;!!!! ALERT !!!!
4848				;THROUGHOUT THE MATH PACKAGE.
4849COMMENT %
4850THE FLOATING POINT FORMAT IS AS FOLLOWS:
4851
4852THE SIGN IS THE FIRST BIT OF THE MANTISSA.
4853THE MANTISSA IS 24 BITS LONG.
4854THE BINARY POINT IS TO THE LEFT OF THE MSB.
4855NUMBER = MANTISSA * 2 ^ EXPONENT.
4856THE MANTISSA IS POSITIVE WITH A ONE ASSUMED TO BE WHERE THE SIGN BIT IS.
4857THE SIGN OF THE EXPONENT IS THE FIRST BIT OF THE EXPONENT.
4858THE EXPONENT IS STORED IN EXCESS 200, I.E. WITH A BIAS OF +200.
4859SO, THE EXPONENT IS A SIGNED 8-BIT NUMBER WITH 200 ADDED TO IT.
4860AN EXPONENT OF ZERO MEANS THE NUMBER IS ZERO.
4861THE OTHER BYTES MAY NOT BE ASSUMED TO BE ZERO.
4862TO KEEP THE SAME NUMBER IN THE FAC WHILE SHIFTING,
4863	TO SHIFT RIGHT, EXP:=EXP+1
4864	TO SHIFT LEFT,	EXP:=EXP-1
4865
4866IN MEMORY THE NUMBER LOOKS LIKE THIS:
4867	[THE EXPONENT AS A SIGNED NUMBER +200]
4868	[THE SIGN BIT IN 7, BITS 2-8 OF MANTISSA ARE IN BITS 6-0].
4869		(REMEMBER BIT 1 OF MANTISSA IS ALWAYS A ONE.)
4870	[BITS 9-16 OF THE MANTISSA]
4871	[BITS 17-24] OF THE MANTISSA]
4872
4873ARITHMETIC ROUTINE CALLING CONVENTIONS:
4874
4875FOR ONE ARGUMENT FUNCTIONS:
4876	THE ARGUMENT IS IN THE FAC.
4877	THE RESULT IS LEFT IN THE FAC.
4878FOR TWO ARGUMENT OPERATIONS:
4879	THE FIRST ARGUMENT IS IN ARG (ARGEXP,HO,MO,LO AND ARGSGN).
4880	THE SECOND ARGUMENT IS IN THE FAC.
4881	THE RESULT IS LEFT IN THE FAC.
4882
4883THE "T" ENTRY POINTS TO THE TWO-ARGUMENT OPERATIONS HAVE BOTH ARGUMENTS
4884SETUP IN THE RESPECTIVE REGISTERS. BEFORE CALLING ARG MAY HAVE BEEN
4885POPPED OFF THE STACK AND INTO ARG, FOR EXAMPLE.
4886THE OTHER ENTRY POINT ASSUMES [Y,A] POINTS TO THE ARGUMENT
4887SOMEWHERE IN MEMORY. IT IS UNPACKED INTO ARG BY "CONUPK".
4888
4889ON THE STACK, THE SGN IS PUSHED ON FIRST, THE LO,MO,HO AND FINALLY EXP.
4890NOTE ALL THINGS ARE KEPT UNPACKED IN ARG, FAC AND ON THE STACK.
4891
4892IT IS ONLY WHEN SOMETHING IS STORED AWAY THAT IT IS PACKED TO FOUR
4893BYTES. THE UNPACKED FORMAT HAS A SGN BYTE REFLECTING THE SIGN OF THE
4894NUMBER (POSITIVE=0, NEGATIVE=-1) A HO,MO AND LO WITH THE HIGH BIT
4895OF THE HO TURNED ON. THE EXP IS THE SAME AS STORED FORMAT.
4896THIS IS DONE FOR SPEED OF OPERATION.
4897%
4898PAGE
4899SUBTTL	FLOATING POINT ADDITION AND SUBTRACTION.
4900FADDH:	LDWDI	FHALF		;ENTRY TO ADD 1/2.
4901	JMP	FADD		;UNPACK AND GO ADD IT.
4902FSUB:	JSR	CONUPK		;UNPACK ARGUMENT INTO ARG.
4903FSUBT:	LDA	FACSGN
4904	EORI	377		;COMPLEMENT IT.
4905	STA	FACSGN
4906	EOR	ARGSGN		;COMPLEMENT ARISGN.
4907	STA	ARISGN
4908	LDA	FACEXP		;SET CODES ON FACEXP.
4909	JMP	FADDT		;[Y]=ARGEXP..
4910	XLIST
4911.XCREF
4912IFN	REALIO-3,<ZSTORDO=STORDO>
4913IFE	REALIO-3,<
4914ZSTORD:!	LDA	POKER
4915	CMPI	146
4916	BNE	STORDO
4917	LDA	POKER+1
4918	SBCI	31
4919	BNE	STORDO
4920	STA	POKER
4921	TAY
4922	LDAI	200
4923	STA	POKER+1
4924MRCHKR: LDXI	12
4925IF1,<
4926MRCHR:	LDA	60000,X,>
4927IF2,<
4928MRCHR:	LDA	SINCON+36,X,>
4929	ANDI	77
4930	STADY	POKER
4931	INY
4932	BNE	PKINC
4933	INC	POKER+1
4934PKINC:	DEX
4935	BNE	MRCHR
4936	DEC	ANDMSK
4937	BNE	MRCHKR
4938	RTS
4939IF2,<PURGE ZSTORD>>
4940.CREF
4941	LIST
4942FADD5:	JSR	SHIFTR		;DO A LONG SHIFT.
4943	BCC	FADD4		;CONTINUE WITH ADDITION.
4944FADD:	JSR	CONUPK
4945FADDT:	JEQ	MOVFA		;IF FAC=0, RESULT IS IN ARG.
4946	LDX	FACOV
4947	STX	OLDOV
4948	LDXI	ARGEXP		;DEFAULT IS SHIFT ARGUMENT.
4949	LDA	ARGEXP		;IF ARG=0, FAC IS RESULT.
4950FADDC:	TAY			;ALSO COPY ACCA INTO ACCY.
4951	BEQ	ZERRTS		;RETURN.
4952	SEC
4953	SBC	FACEXP
4954	BEQ	FADD4		;NO SHIFTING.
4955	BCC	FADDA		;BR IF ARGEXP.LT.FACEXP.
4956	STY	FACEXP		;RESULTING EXPONENT.
4957	LDY	ARGSGN		;SINCE ARG IS BIGGER, IT'S
4958	STY	FACSGN		;SIGN IS SIGN OF RESULT.
4959	EORI	377		;SHIFT A NEGATIVE NUMBER OF PLACES.
4960	ADCI	0		;COMPLETE NEGATION. W/ C=1.
4961	LDYI	0		;ZERO OLDOV.
4962	STY	OLDOV
4963	LDXI	FAC		;SHIFT THE FAC INSTEAD.
4964	BNE	FADD1
4965FADDA:	LDYI	0
4966	STY	FACOV
4967FADD1:	CMPI	^D256-7		;FOR SPEED AND NECESSITY.  GETS
4968				;MOST LIKELY CASE TO SHIFTR FASTEST
4969				;AND ALLOWS SHIFTING OF NEG NUMS
4970				;BY "QINT".
4971	BMI	FADD5		;SHIFT BIG.
4972	TAY
4973	LDA	FACOV		;SET FACOV.
4974	LSR	1,X,		;GETS 0 IN MOST SIG BIT.
4975	JSR	ROLSHF		;DO THE ROLLING.
4976FADD4:	BIT	ARISGN		;GET RESULTING SIGN.
4977	BPL	FADD2		;IF POSITIVE, ADD.
4978				;CARRY IS CLEAR.
4979FADD3:	LDYI	FACEXP
4980	CPXI	ARGEXP		;FAC IS BIGGER.
4981	BEQ	SUBIT
4982	LDYI	ARGEXP		;ARG IS BIGGER.
4983SUBIT:	SEC
4984	EORI	377
4985	ADC	OLDOV
4986	STA	FACOV
4987	LDA	3+ADDPRC,Y
4988	SBC	3+ADDPRC,X
4989	STA	FACLO
4990	LDA	2+ADDPRC,Y
4991	SBC	2+ADDPRC,X
4992	STA	FACMO
4993IFN	ADDPRC,<
4994	LDA	2,Y
4995	SBC	2,X
4996	STA	FACMOH>
4997	LDA	1,Y
4998	SBC	1,X
4999	STA	FACHO
5000FADFLT: BCS	NORMAL		;HERE IF SIGNS DIFFER. IF CARRY,
5001				;FAC IS SET OK.
5002	JSR	NEGFAC		;NEGATE [FAC].
5003NORMAL: LDYI	0
5004	TYA
5005	CLC
5006NORM3:	LDX	FACHO
5007	BNE	NORM1
5008	LDX	FACHO+1		;SHIFT 8 BITS AT A TIME FOR SPEED.
5009	STX	FACHO
5010IFN	ADDPRC,<
5011	LDX	FACMOH+1
5012	STX	FACMOH>
5013	LDX	FACMO+1
5014	STX	FACMO
5015	LDX	FACOV
5016	STX	FACLO
5017	STY	FACOV
5018	ADCI	10
5019	CMPI	10*ADDPRC+30
5020	BNE	NORM3
5021ZEROFC: LDAI	0		;NOT NEED BY NORMAL BUT BY OTHERS.
5022ZEROF1: STA	FACEXP		;NUMBER MUST BE ZERO.
5023ZEROML: STA	FACSGN		;MAKE SIGN POSITIVE.
5024	RTS			;ALL DONE.
5025FADD2:	ADC	OLDOV
5026	STA	FACOV
5027	LDA	FACLO
5028	ADC	ARGLO
5029	STA	FACLO
5030	LDA	FACMO
5031	ADC	ARGMO
5032	STA	FACMO
5033IFN	ADDPRC,<
5034	LDA	FACMOH
5035	ADC	ARGMOH
5036	STA	FACMOH>
5037	LDA	FACHO
5038	ADC	ARGHO
5039	STA	FACHO
5040	JMP	SQUEEZ		;GO ROUND IF SIGNS SAME.
5041
5042NORM2:	ADCI	1		;DECREMENT SHIFT COUNT.
5043	ASL	FACOV		;SHIFT ALL LEFT ONE BIT.
5044	ROL	FACLO
5045	ROL	FACMO
5046IFN	ADDPRC,<
5047	ROL	FACMOH>
5048	ROL	FACHO
5049NORM1:	BPL	NORM2		;IF MSB=0 SHIFT AGAIN.
5050	SEC
5051	SBC	FACEXP
5052	BCS	ZEROFC
5053	EORI	377
5054	ADCI	1		;COMPLEMENT.
5055	STA	FACEXP
5056SQUEEZ: BCC	RNDRTS		;BITS TO SHIFT?
5057RNDSHF: INC	FACEXP
5058	BEQ	OVERR
5059	ROR	FACHO
5060IFN	ADDPRC,<
5061	ROR	FACMOH>
5062	ROR	FACMO
5063	ROR	FACLO
5064	ROR	FACOV
5065RNDRTS: RTS			;ALL DONE ADDING.
5066
5067NEGFAC: COM	FACSGN		;COMPLEMENT FAC	 ENTIRELY.
5068NEGFCH: COM	FACHO		;COMPLEMENT JUST THE NUMBER.
5069IFN	ADDPRC,<
5070	COM	FACMOH>
5071	COM	FACMO
5072	COM	FACLO
5073	COM	FACOV
5074	INC	FACOV
5075	BNE	INCFRT
5076INCFAC: INC	FACLO
5077	BNE	INCFRT
5078	INC	FACMO
5079	BNE	INCFRT		;IF NO CARRY, RETURN.
5080IFN	ADDPRC,<
5081	INC	FACMOH
5082	BNE	INCFRT>
5083	INC	FACHO		;CARRY INCREMENT.
5084INCFRT: RTS
5085
5086OVERR:	LDXI	ERROV
5087	JMP	ERROR		;TELL USER.
5088;
5089; "SHIFTR" SHIFTS [X+1:X+3] [-ACCA]  BITS RIGHT.
5090; SHIFTS BYTES TO START WITH IF POSSIBLE.
5091;
5092MULSHF: LDXI	RESHO-1		;ENTRY POINT FOR MULTIPLIER.
5093SHFTR2: LDY	3+ADDPRC,X,	;SHIFT BYTES FIRST.
5094	STY	FACOV
5095IFN	ADDPRC,<
5096	LDY	3,X
5097	STY	4,X>
5098	LDY	2,X,		;GET MO.
5099	STY	3,X,		;STORE LO.
5100	LDY	1,X,		;GET HO.
5101	STY	2,X,		;STORE MO.
5102	LDY	BITS
5103	STY	1,X,		;STORE HO.
5104SHIFTR: ADCI	10
5105	BMI	SHFTR2
5106	BEQ	SHFTR2
5107	SBCI	10		;C CAN BE EITHER 1,0 AND IT WORKS.
5108	TAY
5109	LDA	FACOV
5110	BCS	SHFTRT		;EQUIV TO BEQ HERE.
5111IFN	RORSW,<
5112SHFTR3: ASL	1,X
5113	BCC	SHFTR4
5114	INC	1,X
5115SHFTR4: ROR	1,X
5116	ROR	1,X>		;YES, TWO OF THEM.
5117IFE	RORSW,<
5118SHFTR3: PHA
5119	LDA	1,X
5120	ANDI	200
5121	LSR	1,X
5122	ORA	1,X
5123	STA	1,X
5124	SKIP1>
5125ROLSHF:
5126IFN	RORSW,<
5127	ROR	2,X
5128	ROR	3,X
5129IFN	ADDPRC,<	ROR	4,X>	;ONE MO TIME.
5130>
5131IFE	RORSW,<
5132	PHA
5133	LDAI	0
5134	BCC	SHFTR5
5135	LDAI	200
5136SHFTR5: LSR	2,X
5137	ORA	2,X
5138	STA	2,X
5139	LDAI	0
5140	BCC	SHFTR6
5141	LDAI	200
5142SHFTR6: LSR	3,X
5143	ORA	3,X
5144	STA	3,X
5145IFN	ADDPRC,<
5146	LDAI	0
5147	BCC	SHFT6A
5148	LDAI	200
5149SHFT6A: LSR	4,X
5150	ORA	4,X
5151	STA	4,X>>
5152IFN	RORSW,<ROR	A,>	;ROTATE ARGUMENT 1 BIT RIGHT.
5153IFE	RORSW,<
5154	PLA
5155	PHP
5156	LSR	A,
5157	PLP
5158	BCC	SHFTR7
5159	ORAI	200>
5160SHFTR7: INY
5161	BNE	SHFTR3		;$$$ ( MOST EXPENSIVE ! )
5162SHFTRT: CLC			;CLEAR OUTPUT OF FACOV.
5163	RTS
5164PAGE
5165SUBTTL	NATURAL LOG FUNCTION.
5166;
5167; CALCULATION IS BY:
5168; LN(F*2^N)=(N+LOG2(F))*LN(2)
5169; AN APPROXIMATION POLYNOMIAL IS USED TO CALCULATE LOG2(F).
5170;  CONSTANTS USED BY LOG:
5171FONE:	201	; 1.0
5172	000
5173	000
5174	000
5175IFN	ADDPRC,<0>
5176IFE	ADDPRC,<
5177LOGCN2: 2	; DEGREE-1
5178	200	; 0.59897437
5179	031
5180	126
5181	142
5182	200	; 0.96147080
5183	166
5184	042
5185	363
5186	202	; 2.88539129
5187	070
5188	252
5189	100>
5190
5191IFN	ADDPRC,<
5192LOGCN2: 3	;DEGREE-1
5193	177	;.43425594188
5194	136
5195	126
5196	313
5197	171
5198	200	; .57658454134
5199	023
5200	233
5201	013
5202	144
5203	200	; .96180075921
5204	166
5205	070
5206	223
5207	026
5208	202	; 2.8853900728
5209	070
5210	252
5211	073
5212	040>
5213SQRHLF: 200	; SQR(0.5)
5214	065
5215	004
5216	363
5217IFN	ADDPRC,<064>
5218SQRTWO: 201	; SQR(2.0)
5219	065
5220	004
5221	363
5222IFN	ADDPRC,<064>
5223NEGHLF: 200	; -1/2
5224	200
5225	000
5226	000
5227IFN	ADDPRC,<0>
5228LOG2:	200	; LN(2)
5229	061
5230	162
5231IFE	ADDPRC,<030>
5232IFN	ADDPRC,<027
5233	370>
5234
5235LOG:	JSR	SIGN		;IS IT POSITIVE?
5236	BEQ	LOGERR
5237	BPL	LOG1
5238LOGERR: JMP	FCERR		;CAN'T TOLERATE NEG OR ZERO.
5239LOG1:	LDA	FACEXP		;GET EXPONENT INTO ACCA.
5240	SBCI	177		;REMOVE BIAS. (CARRY IS OFF)
5241	PHA			;SAVE AWHILE.
5242	LDAI	200
5243	STA	FACEXP		;RESULT IS FAC IN RANGE [0.5,1].
5244	LDWDI	SQRHLF		;GET POINTER TO SQR(0.5).
5245
5246; CALCULATE (F-SQR(.5))/(F+SQR(.5))
5247
5248	JSR	FADD		;ADD TO FAC.
5249	LDWDI	SQRTWO		;GET SQR(2.).
5250	JSR	FDIV
5251	LDWDI	FONE
5252	JSR	FSUB
5253	LDWDI	LOGCN2
5254	JSR	POLYX		;EVALUATE APPROXIMATION POLYNOMIAL.
5255	LDWDI	NEGHLF		;ADD IN LAST CONSTANT.
5256	JSR	FADD
5257	PLA			;GET EXPONENT BACK.
5258	JSR	FINLOG		;ADD IT IN.
5259MULLN2: LDWDI	LOG2		;MULTIPLY RESULT BY LOG(2.0).
5260;	JMP	FMULT		;MULTIPLY TOGETHER.
5261PAGE
5262SUBTTL	FLOATING MULTIPLICATION AND DIVISION.
5263	;MULTIPLICATION		FAC:=ARG*FAC.
5264FMULT:	JSR	CONUPK		;UNPACK THE CONSTANT INTO ARG FOR USE.
5265FMULTT: JEQ	MULTRT		;IF FAC=0, RETURN. FAC IS SET.
5266	JSR	MULDIV		;FIX UP THE EXPONENTS.
5267	LDAI	0		;TO CLEAR RESULT.
5268	STA	RESHO
5269IFN	ADDPRC,<
5270	STA	RESMOH>
5271	STA	RESMO
5272	STA	RESLO
5273	LDA	FACOV
5274	JSR	MLTPLY
5275	LDA	FACLO		;MLTPLY ARG BY FACLO.
5276	JSR	MLTPLY
5277	LDA	FACMO		;MLTPLY ARG BY FACMO.
5278	JSR	MLTPLY
5279IFN	ADDPRC,<
5280	LDA	FACMOH
5281	JSR	MLTPLY>
5282	LDA	FACHO		;MLTPLY ARG BY FACHO.
5283	JSR	MLTPL1
5284	JMP	MOVFR		;MOVE RESULT INTO FAC,
5285				;NORMALIZE RESULT, AND RETURN.
5286MLTPLY: JEQ	MULSHF		;SHIFT RESULT RIGHT 1 BYTE.
5287MLTPL1: LSR	A,
5288	ORAI	200
5289MLTPL2: TAY
5290	BCC	MLTPL3		;IT MULT BIT=0, JUST SHIFT.
5291	CLC
5292	LDA	RESLO
5293	ADC	ARGLO
5294	STA	RESLO
5295	LDA	RESMO
5296	ADC	ARGMO
5297	STA	RESMO
5298IFN	ADDPRC,<
5299	LDA	RESMOH
5300	ADC	ARGMOH
5301	STA	RESMOH>
5302	LDA	RESHO
5303	ADC	ARGHO
5304	STA	RESHO
5305MLTPL3: ROR	RESHO
5306IFN	ADDPRC,<
5307	ROR	RESMOH>
5308	ROR	RESMO
5309	ROR	RESLO
5310	ROR	FACOV		;SAVE FOR ROUNDING.
5311	TYA
5312	LSR	A,		;CLEAR MSB SO WE GET A CLOSER TO 0.
5313	BNE	MLTPL2		;SLOW AS A TURTLE !
5314MULTRT: RTS
5315
5316	;ROUTINE TO UNPACK MEMORY INTO ARG.
5317CONUPK: STWD	INDEX1
5318	LDYI	3+ADDPRC
5319	LDADY	INDEX1
5320	STA	ARGLO
5321	DEY
5322	LDADY	INDEX1
5323	STA	ARGMO
5324	DEY
5325IFN	ADDPRC,<
5326	LDADY	INDEX1
5327	STA	ARGMOH
5328	DEY>
5329	LDADY	INDEX1
5330	STA	ARGSGN
5331	EOR	FACSGN
5332	STA	ARISGN
5333	LDA	ARGSGN
5334	ORAI	200
5335	STA	ARGHO
5336	DEY
5337	LDADY	INDEX1
5338	STA	ARGEXP
5339	LDA	FACEXP		;SET CODES OF FACEXP.
5340	RTS
5341
5342	;CHECK SPECIAL CASES AND ADD EXPONENTS FOR FMULT, FDIV.
5343MULDIV: LDA	ARGEXP		;EXP OF ARG=0?
5344MLDEXP: BEQ	ZEREMV		;SO WE GET ZERO EXPONENT.
5345	CLC
5346	ADC	FACEXP		;RESULT IS IN ACCA.
5347	BCC	TRYOFF		;FIND [C] XOR [N].
5348	BMI	GOOVER		;OVERFLOW IF BITS MATCH.
5349	CLC
5350	SKIP2
5351TRYOFF: BPL	ZEREMV		;UNDERFLOW.
5352	ADCI	200		;ADD BIAS.
5353	STA	FACEXP
5354	JEQ	ZEROML		;ZERO THE REST OF IT.
5355	LDA	ARISGN
5356	STA	FACSGN		;ARISGN IS RESULT'S SIGN.
5357	RTS			;DONE.
5358MLDVEX: LDA	FACSGN		;GET SIGN.
5359	EORI	377		;COMPLEMENT IT.
5360	BMI	GOOVER
5361ZEREMV: PLA			;GET ADDR OFF STACK.
5362	PLA	
5363	JMP	ZEROFC		;UNDERFLOW.
5364GOOVER: JMP	OVERR		;OVERFLOW.
5365
5366	;MULTIPLY FAC BY 10.
5367MUL10:	JSR	MOVAF		;COPY FAC INTO ARG.
5368	TAX
5369	BEQ	MUL10R		;IF [FAC]=0, GOT ANSWER.
5370	CLC
5371	ADCI	2		;AUGMENT EXP BY 2.
5372	BCS	GOOVER		;OVERFLOW.
5373FINML6: LDXI	0
5374	STX	ARISGN		;SIGNS ARE SAME.
5375	JSR	FADDC		;ADD TOGETHER.
5376	INC	FACEXP		;MULTIPLY BY TWO.
5377	BEQ	GOOVER		;OVERFLOW.
5378MUL10R: RTS
5379
5380	; DIVIDE FAC BY 10.
5381TENZC:	204
5382	040
5383	000
5384	000
5385IFN	ADDPRC,<0>
5386DIV10:	JSR	MOVAF		;MOVE FAC TO ARG.
5387	LDWDI	TENZC		;POINT TO CONSTANT OF 10.0
5388	LDXI	0		;SIGNS ARE BOTH POSITIVE.
5389FDIVF:	STX	ARISGN
5390	JSR	MOVFM		;PUT IT INTO FAC.
5391	JMP	FDIVT		;SKIP OVER NEXT TWO BYTES.
5392FDIV:	JSR	CONUPK		;UNPACK CONSTANT.
5393FDIVT:	BEQ	DV0ERR		;CAN'T DIVIDE BY ZERO !
5394				;(NOT ENOUGH ROOM TO STORE RESULT.)
5395	JSR	ROUND		;TAKE FACOV INTO ACCT IN FAC.
5396	LDAI	0		;NEGATE FACEXP.
5397	SEC
5398	SBC	FACEXP
5399	STA	FACEXP
5400	JSR	MULDIV		;FIX UP EXPONENTS.
5401	INC	FACEXP		;SCALE IT RIGHT.
5402	BEQ	GOOVER		;OVERFLOW.
5403	LDXI	^D256-3-ADDPRC	;SETUP PROCEDURE.
5404	LDAI	1
5405DIVIDE:				;THIS IS THE BEST CODE IN THE WHOLE PILE.
5406	LDY	ARGHO		;SEE WHAT RELATION HOLDS.
5407	CPY	FACHO
5408	BNE	SAVQUO		;[C]=0,1. N(C=0)=0.
5409IFN	ADDPRC,<
5410	LDY	ARGMOH
5411	CPY	FACMOH
5412	BNE	SAVQUO>
5413	LDY	ARGMO
5414	CPY	FACMO
5415	BNE	SAVQUO
5416	LDY	ARGLO
5417	CPY	FACLO
5418SAVQUO: PHP
5419	ROL	A,		;SAVE RESULT.
5420	BCC	QSHFT		;IF NOT DONE, CONTINUE.
5421	INX
5422	STA	RESLO,X
5423	BEQ	LD100
5424	BPL	DIVNRM		;NOTE THIS REQ 1 MO RAM THEN NECESS.
5425	LDAI	1
5426QSHFT:	PLP			;RETURN CONDITION CODES.
5427	BCS	DIVSUB		;FAC .LE. ARG.
5428SHFARG: ASL	ARGLO		;SHIFT ARG ONE PLACE LEFT.
5429	ROL	ARGMO
5430IFN	ADDPRC,<
5431	ROL	ARGMOH>
5432	ROL	ARGHO
5433	BCS	SAVQUO		;SAVE A RESULT OF ONE FOR THIS POSITION
5434				;AND DIVIDE.
5435	BMI	DIVIDE		;IF MSB ON, GO DECIDE WHETHER TO SUB.
5436	BPL	SAVQUO
5437DIVSUB: TAY			;NOTICE C MUST BE ON HERE.
5438	LDA	ARGLO
5439	SBC	FACLO
5440	STA	ARGLO
5441	LDA	ARGMO
5442	SBC	FACMO
5443	STA	ARGMO
5444IFN	ADDPRC,<
5445	LDA	ARGMOH
5446	SBC	FACMOH
5447	STA	ARGMOH>
5448	LDA	ARGHO
5449	SBC	FACHO
5450	STA	ARGHO
5451	TYA
5452	JMP	SHFARG
5453LD100:	LDAI	100		;ONLY WANT TWO MORE BITS.
5454	BNE	QSHFT		;ALWAYS BRANCHES.
5455DIVNRM: REPEAT	6,<ASL	A>	;GET LAST TWO BITS INTO MSB AND B6.
5456	STA	FACOV
5457	PLP			;TO GET GARBAGE OFF STACK.
5458	JMP	MOVFR		;MOVE RESULT INTO FAC, THEN
5459				;NORMALIZE RESULT AND RETURN.
5460DV0ERR: LDXI	ERRDV0
5461	JMP	ERROR
5462PAGE
5463SUBTTL	FLOATING POINT MOVEMENT ROUTINES.
5464	;MOVE RESULT TO FAC.
5465MOVFR:	LDA	RESHO
5466	STA	FACHO
5467IFN	ADDPRC,<
5468	LDA	RESMOH
5469	STA	FACMOH>
5470	LDA	RESMO
5471	STA	FACMO
5472	LDA	RESLO		;MOVE LO AND SGN.
5473	STA	FACLO
5474	JMP	NORMAL		;ALL DONE.
5475
5476	;MOVE MEMORY INTO FAC (UNPACKED).
5477MOVFM:	STWD	INDEX1
5478	LDYI	3+ADDPRC
5479	LDADY	INDEX1
5480	STA	FACLO
5481	DEY
5482	LDADY	INDEX1
5483	STA	FACMO
5484	DEY
5485IFN	ADDPRC,<
5486	LDADY	INDEX1
5487	STA	FACMOH
5488	DEY>
5489	LDADY	INDEX1
5490	STA	FACSGN
5491	ORAI	200
5492	STA	FACHO
5493	DEY
5494	LDADY	INDEX1
5495	STA	FACEXP		;LEAVE SWITCHES SET ON EXP.
5496	STY	FACOV
5497	RTS
5498
5499	;MOVE NUMBER FROM FAC TO MEMORY.
5500MOV2F:	LDXI	TEMPF2
5501	SKIP2
5502MOV1F:	LDXI	TEMPF1
5503MOVML:	LDYI	0
5504	BEQ	MOVMF		;ALWAYS BRANCHES.
5505MOVVF:	LDXY	FORPNT
5506MOVMF:	JSR	ROUND
5507	STXY	INDEX1
5508	LDYI	3+ADDPRC
5509	LDA	FACLO
5510	STADY	INDEX
5511	DEY
5512	LDA	FACMO
5513	STADY	INDEX
5514	DEY
5515IFN	ADDPRC,<
5516	LDA	FACMOH
5517	STADY	INDEX
5518	DEY>
5519	LDA	FACSGN		;INCLUDE SIGN IN HO.
5520	ORAI	177
5521	AND	FACHO
5522	STADY	INDEX
5523	DEY
5524	LDA	FACEXP
5525	STADY	INDEX
5526	STY	FACOV		;ZERO IT SINCE ROUNDED.
5527	RTS			;[Y]=0.
5528
5529	;MOVE ARG INTO FAC.
5530MOVFA:	LDA	ARGSGN
5531MOVFA1: STA	FACSGN
5532	LDXI	4+ADDPRC
5533MOVFAL: LDA	ARGEXP-1,X
5534	STA	FACEXP-1,X
5535	DEX
5536	BNE	MOVFAL
5537	STX	FACOV
5538	RTS
5539
5540	;MOVE FAC INTO ARG.
5541MOVAF:	JSR	ROUND
5542MOVEF:	LDXI	5+ADDPRC
5543MOVAFL: LDA	FACEXP-1,X
5544	STA	ARGEXP-1,X
5545	DEX
5546	BNE	MOVAFL
5547	STX	FACOV		;ZERO IT SINCE ROUNDED.
5548MOVRTS: RTS
5549
5550ROUND:	LDA	FACEXP		;ZERO?
5551	BEQ	MOVRTS		;YES. DONE ROUNDING.
5552	ASL	FACOV		;ROUND?
5553	BCC	MOVRTS		;NO. MSB OFF.
5554INCRND: JSR	INCFAC		;YES, ADD ONE TO LSB(FAC).
5555	BNE	MOVRTS		;NO CARRY MEANS DONE.
5556	JMP	RNDSHF		;SQUEEZ MSB IN AND RTS.
5557				;NOTE [C]=1 SINCE INCFAC DOESNT TOUCH C.
5558PAGE
5559SUBTTL	SIGN, SGN, FLOAT, NEG, ABS.
5560
5561	;PUT SIGN OF FAC IN ACCA.
5562SIGN:	LDA	FACEXP
5563	BEQ	SIGNRT		;IF NUMBER IS ZERO, SO IS RESULT.
5564FCSIGN: LDA	FACSGN
5565FCOMPS: ROL	A
5566	LDAI	^O377		;ASSUME NEGATIVE.
5567	BCS	SIGNRT
5568	LDAI	1		;GET +1.
5569SIGNRT: RTS
5570
5571	;SGN FUNCTION.
5572SGN:	JSR	SIGN
5573
5574	;FLOAT THE SIGNED INTEGER IN ACCA.
5575FLOAT:	STA	FACHO		;PUT [ACCA] IN HIGH ORDER.
5576	LDAI	0
5577	STA	FACHO+1
5578	LDXI	210		;GET THE EXPONENT.
5579
5580	;FLOAT THE SIGNED NUMBER IN FAC.
5581FLOATS: LDA	FACHO
5582	EORI	377
5583	ROL	A,		;GET COMP OF SIGN IN CARRY.
5584FLOATC: LDAI	0		;ZERO [ACCA] BUT NOT CARRY.
5585	STA	FACLO
5586IFN	ADDPRC,<
5587	STA	FACMO>
5588FLOATB: STX	FACEXP
5589	STA	FACOV
5590	STA	FACSGN
5591	JMP	FADFLT
5592
5593	;ABSOLUTE VALUE OF FAC.
5594ABS:	LSR	FACSGN
5595	RTS
5596
5597PAGE
5598SUBTTL	COMPARE TWO NUMBERS.
5599	;A=1 IF ARG .LT. FAC.
5600	;A=0 IF ARG=FAC.
5601	;A=-1 IF ARG .GT. FAC.
5602FCOMP:	STA	INDEX2
5603FCOMPN: STY	INDEX2+1
5604	LDYI	0
5605	LDADY	INDEX2		;HAS ARGEXP.
5606	INY			;BUMP PNTR UP.
5607	TAX			;SAVE A IN X AND RESET CODES.
5608	BEQ	SIGN
5609	LDADY	INDEX2
5610	EOR	FACSGN		;SIGNS THE SAME.
5611	BMI	FCSIGN		;SIGNS DIFFER SO RESULT IS
5612				;SIGN OF FAC AGAIN.
5613FOUTCP: CPX	FACEXP
5614	BNE	FCOMPC
5615	LDADY	INDEX2
5616	ORAI	200
5617	CMP	FACHO
5618	BNE	FCOMPC
5619	INY
5620IFN	ADDPRC,<
5621	LDADY	INDEX2
5622	CMP	FACMOH
5623	BNE	FCOMPC
5624	INY>
5625	LDADY	INDEX2
5626	CMP	FACMO
5627	BNE	FCOMPC
5628	INY
5629	LDAI	177
5630	CMP	FACOV
5631	LDADY	INDEX2
5632	SBC	FACLO		;GET ZERO IF EQUAL.
5633	BEQ	QINTRT
5634FCOMPC: LDA	FACSGN
5635	BCC	FCOMPD
5636	EORI	377
5637FCOMPD: JMP	FCOMPS		;A PART OF SIGN SETS ACCA UP.
5638
5639PAGE
5640SUBTTL	GREATEST INTEGER FUNCTION.
5641	;QUICK GREATEST INTEGER FUNCTION.
5642	;LEAVES INT(FAC) IN FACHO&MO&LO SIGNED.
5643	;ASSUMES FAC .LT. 2^23 = 8388608
5644QINT:	LDA	FACEXP
5645	BEQ	CLRFAC		;IF ZERO, GOT IT.
5646	SEC
5647	SBCI	8*ADDPRC+230	;GET NUMBER OF PLACES TO SHIFT.
5648	BIT	FACSGN
5649	BPL	QISHFT
5650	TAX
5651	LDAI	377
5652	STA	BITS		;PUT 377 IN WHEN SHFTR SHIFTS BYTES.
5653	JSR	NEGFCH		;TRULY NEGATE QUANTITY IN FAC.
5654	TXA
5655QISHFT: LDXI	FAC
5656	CMPI	^D256-7
5657	BPL	QINT1		;IF NUMBER OF PLACES .GE. 7
5658				;SHIFT 1 PLACE AT A TIME.
5659	JSR	SHIFTR		;START SHIFTING BYTES, THEN BITS.
5660	STY	BITS		;ZERO BITS SINCE ADDER WANTS ZERO.
5661QINTRT: RTS
5662QINT1:	TAY			;PUT COUNT IN COUNTER.
5663	LDA	FACSGN
5664	ANDI	200		;GET SIGN BIT.
5665	LSR	FACHO		;SAVE FIRST SHIFTED BYTE.
5666	ORA	FACHO
5667	STA	FACHO
5668	JSR	ROLSHF		;SHIFT THE REST.
5669	STY	BITS		;ZERO [BITS].
5670	RTS
5671
5672	;GREATEST INTEGER FUNCTION.
5673INT:	LDA	FACEXP
5674	CMPI	8*ADDPRC+230
5675	BCS	INTRTS		;FORGET IT.
5676	JSR	QINT
5677	STY	FACOV		;CLR OVERFLOW BYTE.
5678	LDA	FACSGN
5679	STY	FACSGN		;MAKE FAC LOOK POSITIVE.
5680	EORI	200		;GET COMPLEMENT OF SIGN IN CARRY.
5681	ROL	A,
5682	LDAI	8*ADDPRC+230
5683	STA	FACEXP
5684	LDA	FACLO
5685	STA	INTEGR
5686	JMP	FADFLT
5687CLRFAC: STA	FACHO		;MAKE IT REALLY ZERO.
5688IFN	ADDPRC,<STA FACMOH>
5689	STA	FACMO
5690	STA	FACLO
5691	TAY
5692INTRTS: RTS
5693PAGE
5694SUBTTL	FLOATING POINT INPUT ROUTINE.
5695	;NUMBER INPUT IS LEFT IN FAC.
5696	;AT ENTRY [TXTPTR] POINTS TO THE FIRST CHARACTER IN A TEXT BUFFER.
5697	;THE FIRST CHARACTER IS ALSO IN ACCA. FIN PACKS THE DIGITS
5698	;INTO THE FAC AS AN INTEGER AND KEEPS TRACK OF WHERE THE
5699	;DECIMAL POINT IS. [DPTFLG] TELL WHETHER A DP HAS BEEN
5700	;SEEN. [DECCNT] IS THE NUMBER OF DIGITS AFTER THE DP.
5701	;AT THE END [DECCNT] AND THE EXPONENT ARE USED TO
5702	;DETERMINE HOW MANY TIMES TO MULTIPLY OR DIVIDE BY TEN
5703	;TO GET THE CORRECT NUMBER.
5704FIN:	LDYI	0		;ZERO FACSGN&SGNFLG.
5705	LDXI	11+ADDPRC	;ZERO EXP AND HO (AND MOH).
5706FINZLP: STY	DECCNT,X	;ZERO MO AND LO.
5707	DEX			;ZERO TENEXP AND EXPSGN
5708	BPL	FINZLP		;ZERO DECCNT, DPTFLG.
5709	BCC	FINDGQ		;FLAGS STILL SET FROM CHRGET.
5710	CMPI	"-"		;A NEGATIVE SIGN?
5711	BNE	QPLUS		;NO, TRY PLUS SIGN.
5712	STX	SGNFLG		;IT'S NEGATIVE. (X=377).
5713	BEQ	FINC		;ALWAYS BRANCHES.
5714QPLUS:	CMPI	"+"		;PLUS SIGN?
5715	BNE	FIN1		;YES, SKIP IT.
5716FINC:	JSR	CHRGET
5717FINDGQ: BCC	FINDIG
5718FIN1:	CMPI	"."		;THE DP?
5719	BEQ	FINDP		;NO KIDDING.
5720	CMPI	"E"		;EXPONENT FOLLOWS.
5721	BNE	FINE		;NO.
5722	;HERE TO CHECK FOR SIGN OF EXP.
5723	JSR	CHRGET		;YES. GET ANOTHER.
5724	BCC	FNEDG1		;IT IS A DIGIT. (EASIER THAN
5725				;BACKING UP POINTER.)
5726	CMPI	MINUTK		;MINUS?
5727	BEQ	FINEC1		;NEGATE.
5728	CMPI	"-"		;MINUS SIGN?
5729	BEQ	FINEC1
5730	CMPI	PLUSTK		;PLUS?
5731	BEQ	FINEC
5732	CMPI	"+"		;PLUS SIGN?
5733	BEQ	FINEC
5734	BNE	FINEC2
5735FINEC1: ROR	EXPSGN		;TURN IT ON.
5736FINEC:	JSR	CHRGET		;GET ANOTHER.
5737FNEDG1: BCC	FINEDG		;IT IS A DIGIT.
5738FINEC2: BIT	EXPSGN
5739	BPL	FINE
5740	LDAI	0
5741	SEC
5742	SBC	TENEXP
5743	JMP	FINE1
5744FINDP:	ROR	DPTFLG
5745	BIT	DPTFLG
5746	BVC	FINC
5747FINE:	LDA	TENEXP
5748FINE1:	SEC
5749	SBC	DECCNT		;GET NUMBER OF PLACES TO SHIFT.
5750	STA	TENEXP
5751	BEQ	FINQNG		;NEGATE?
5752	BPL	FINMUL		;POSITIVE SO MULTIPLY.
5753FINDIV: JSR	DIV10
5754	INC	TENEXP		;DONE?
5755	BNE	FINDIV		;NO.
5756	BEQ	FINQNG		;YES.
5757FINMUL: JSR	MUL10
5758	DEC	TENEXP		;DONE?
5759	BNE	FINMUL		;NO
5760FINQNG: LDA	SGNFLG
5761	BMI	NEGXQS		;IF POSITIVE, RETURN.
5762	RTS
5763NEGXQS: JMP	NEGOP		;OTHERWISE, NEGATE AND RETURN.
5764
5765FINDIG: PHA
5766	BIT	DPTFLG
5767	BPL	FINDG1
5768	INC	DECCNT
5769FINDG1: JSR	MUL10
5770	PLA			;GET IT BACK.
5771	SEC
5772	SBCI	"0"
5773	JSR	FINLOG		;ADD IT IN.
5774	JMP	FINC
5775
5776FINLOG: PHA
5777	JSR	MOVAF		;SAVE FAC FOR LATER.
5778	PLA
5779	JSR	FLOAT		;FLOAT THE VALUE IN ACCA.
5780	LDA	ARGSGN
5781	EOR	FACSGN
5782	STA	ARISGN		;RESULTANT SIGN.
5783	LDX	FACEXP		;SET SIGNS ON THING TO ADD.
5784	JMP	FADDT		;ADD TOGETHER AND RETURN.
5785
5786	;HERE PACK IN THE NEXT DIGIT OF THE EXPONENT.
5787	;MULTIPLY THE OLD EXP BY 10 AND ADD IN THE NEXT
5788	;DIGIT. NOTE: EXP OVERFLOW IS NOT CHECKED FOR.
5789FINEDG: LDA	TENEXP		;GET EXP SO FAR.
5790	CMPI	12		;WILL RESULT BE .GE. 100?
5791	BCC	MLEX10	
5792	LDAI	144		;GET 100.
5793	BIT	EXPSGN
5794	BMI	MLEXMI		;IF NEG EXP, NO CHK FOR OVERR.
5795	JMP	OVERR
5796MLEX10: ASL	A,		;MULT BY 2 TWICE
5797	ASL	A
5798	CLC			;POSSIBLE SHIFT OUT OF HIGH.
5799	ADC	TENEXP		;LIKE MULTIPLYING BY FIVE.
5800	ASL	A,		;AND NOW BY TEN.
5801	CLC
5802	LDYI	0
5803	ADCDY	TXTPTR
5804	SEC
5805	SBCI	"0"
5806MLEXMI: STA	TENEXP		;SAVE RESULT.
5807	JMP	FINEC
5808PAGE
5809SUBTTL	FLOATING POINT OUTPUT ROUTINE.
5810
5811IFE	ADDPRC,<
5812NZ0999: 221	; 99999.9499
5813	103
5814	117
5815	370
5816NZ9999: 224	; 999999.499
5817	164
5818	043
5819	367
5820NZMIL:	224	; 10^6.
5821	164
5822	044
5823	000>
5824IFN	ADDPRC,<
5825NZ0999: 233	; 99999999.9499
5826	076
5827	274
5828	037
5829	375
5830NZ9999: 236	; 999999999.499
5831	156
5832	153
5833	047
5834	375
5835NZMIL:	236	; 10^9
5836	156
5837	153
5838	050
5839	000>
5840	;ENTRY TO LINPRT.
5841INPRT:	LDWDI	INTXT
5842	JSR	STROU2
5843	LDA	CURLIN+1
5844	LDX	CURLIN
5845LINPRT: STWX	FACHO
5846	LDXI	220		;EXPONENT OF 16.
5847	SEC			;NUMBER IS POSITIVE.
5848	JSR	FLOATC
5849	JSR	FOUT
5850STROU2: JMP	STROUT		;PRINT AND RETURN.
5851
5852FOUT:	LDYI	1
5853FOUTC:	LDAI	" "		;PRINT SPACE IF POSITIVE.
5854	BIT	FACSGN
5855	BPL	FOUT1
5856	LDAI	"-"
5857FOUT1:	STA	FBUFFR-1,Y,	;STORE THE CHARACTER.
5858	STA	FACSGN		;MAKE FAC POS FOR QINT.
5859	STY	FBUFPT		;SAVE FOR LATER.
5860	INY
5861	LDAI	"0"		;GET ZERO TO TYPE IF FAC=0.
5862	LDX	FACEXP
5863	JEQ	FOUT19
5864	LDAI	 0
5865	CPXI	200		;IS NUMBER .LT. 1.0 ?
5866	BEQ	FOUT37		;NO.
5867	BCS	FOUT7
5868FOUT37: LDWDI	NZMIL		;MULTIPLY BY 10^6.
5869	JSR	FMULT
5870	LDAI	^D256-3*ADDPRC-6
5871FOUT7:	STA	DECCNT		;SAVE COUNT OR ZERO IT.
5872FOUT4:	LDWDI	NZ9999
5873	JSR	FCOMP		;IS NUMBER .GT. 999999.499 ?
5874				;OR 999999999.499?
5875	BEQ	BIGGES
5876	BPL	FOUT9		;YES. MAKE IT SMALLER.
5877FOUT3:	LDWDI	NZ0999
5878	JSR	FCOMP		;IS NUMBER .GT. 99999.9499 ?
5879				; OR 99999999.9499?
5880	BEQ	FOUT38
5881	BPL	FOUT5		;YES. DONE MULTIPLYING.
5882FOUT38: JSR	MUL10		;MAKE IT BIGGER.
5883	DEC	DECCNT
5884	BNE	FOUT3		;SEE IF THAT DOES IT.
5885				;THIS ALWAYS GOES.
5886FOUT9:	JSR	DIV10		;MAKE IT SMALLER.
5887	INC	DECCNT
5888	BNE	FOUT4		;SEE IF THAT DOES IT.
5889				;THIS ALWAYS GOES.
5890
5891FOUT5:	JSR	FADDH		;ADD A HALF TO ROUND UP.
5892BIGGES: JSR	QINT
5893	LDXI	1		;DECIMAL POINT COUNT.
5894	LDA	DECCNT
5895	CLC
5896	ADCI	3*ADDPRC+7	;SHOULD NUMBER BE PRINTED IN E NOTATION?
5897				;IE, IS NUMBER .LT. .01 ?
5898	BMI	FOUTPI		;YES.
5899	CMPI	3*ADDPRC+10	;IS IT .GT. 999999 (999999999)?
5900	BCS	FOUT6		;YES. USE E NOTATION.
5901	ADCI	^O377		;NUMBER OF PLACES BEFORE DECIMAL POINT.
5902	TAX			;PUT INTO ACCX.
5903	LDAI	2		;NO E NOTATION.
5904FOUTPI: SEC
5905FOUT6:	SBCI	2		;EFFECTIVELY ADD 5 TO ORIG EXP.
5906	STA	TENEXP		;THAT IS THE EXPONENT TO PRINT.
5907	STX	DECCNT		;NUMBER OF DECIMAL PLACES.
5908	TXA
5909	BEQ	FOUT39
5910	BPL	FOUT8		;SOME PLACES BEFORE DEC PNT.
5911FOUT39: LDY	FBUFPT		;GET POINTER TO OUTPUT.
5912	LDAI	"."		;PUT IN "."
5913	INY
5914	STA	FBUFFR-1,Y
5915	TXA
5916	BEQ	FOUT16
5917	LDAI	"0"		;GET THE ENSUING ZERO.
5918	INY
5919	STA	FBUFFR-1,Y
5920FOUT16: STY	FBUFPT		;SAVE FOR LATER.
5921FOUT8:	LDYI	0
5922FOUTIM: LDXI	200		;FIRST PASS THRU, ACCX HAS MSB SET.
5923FOUT2:	LDA	FACLO
5924	CLC
5925	ADC	FOUTBL+2+ADDPRC,Y
5926	STA	FACLO
5927	LDA	FACMO
5928	ADC	FOUTBL+1+ADDPRC,Y
5929	STA	FACMO
5930IFN	ADDPRC,<
5931	LDA	FACMOH
5932	ADC	FOUTBL+1,Y
5933	STA	FACMOH>
5934	LDA	FACHO
5935	ADC	FOUTBL,Y
5936	STA	FACHO
5937	INX			;IT WAS DONE YET ANOTHER TIME.
5938	BCS	FOUT41
5939	BPL	FOUT2
5940	BMI	FOUT40
5941FOUT41: BMI	FOUT2
5942FOUT40: TXA
5943	BCC	FOUTYP		;CAN USE ACCA AS IS.
5944	EORI	377		;FIND 11.-[A].
5945	ADCI	12		;C IS STILL ON TO COMPLETE NEGATION.
5946				;AND WILL ALWAYS BE ON AFTER.
5947FOUTYP: ADCI	"0"-1		;GET A CHARACTER TO PRINT.
5948	REPEAT	3+ADDPRC,<INY>	;BUMP POINTER UP.
5949	STY	FDECPT
5950	LDY	FBUFPT
5951	INY			;POINT TO PLACE TO STORE OUTPUT.
5952	TAX
5953	ANDI	177		;GET RID OF MSB.
5954	STA	FBUFFR-1,Y
5955	DEC	DECCNT
5956	BNE	STXBUF		;NOT TIME FOR DP YET.
5957	LDAI	"."
5958	INY
5959	STA	FBUFFR-1,Y,	;STORE DP.
5960STXBUF: STY	FBUFPT		;STORE PNTR FOR LATER.
5961	LDY	FDECPT
5962FOUTCM: TXA			;COMPLEMENT ACCX
5963	EORI	377		;COMPLEMENT ACCA.
5964	ANDI	200		;SAVE ONLY MSB.
5965	TAX
5966	CPYI	FDCEND-FOUTBL
5967IFN	TIME,<
5968	BEQ	FOULDY
5969	CPYI	TIMEND-FOUTBL>
5970	BNE	FOUT2		;CONTINUE WITH OUTPUT.
5971FOULDY: LDY	FBUFPT		;GET BACK OUTPUT PNTR.
5972FOUT11: LDA	FBUFFR-1,Y,	;REMOVE TRAILING ZEROES.
5973	DEY
5974	CMPI	"0"
5975	BEQ	FOUT11
5976	CMPI	"."
5977	BEQ	FOUT12		;RUN INTO DP. STOP.
5978	INY			;SOMETHING ELSE. SAVE IT.
5979FOUT12: LDAI	"+"
5980	LDX	TENEXP
5981	BEQ	FOUT17		;NO EXPONENT TO OUTPUT.
5982	BPL	FOUT14
5983	LDAI	0
5984	SEC
5985	SBC	TENEXP
5986	TAX
5987	LDAI	"-"		;EXPONENT IS NEGATIVE.
5988FOUT14: STA	FBUFFR-1+2,Y,	;STORE SIGN OF EXP
5989	LDAI	"E"
5990	STA	FBUFFR-1+1,Y,	;STORE THE "E" CHARACTER.
5991	TXA
5992	LDXI	"0"-1
5993	SEC
5994FOUT15: INX			;MOVE CLOSER TO OUTPUT VALUE.
5995	SBCI	12		;SUBTRACT 10.
5996	BCS	FOUT15		;NOT NEGATIVE YET.
5997	ADCI	"0"+12		;GET SECOND OUTPUT CHARACTER.
5998	STA	FBUFFR-1+4,Y,	;STORE HIGH DIGIT.
5999	TXA
6000	STA	FBUFFR-1+3,Y,	;STORE	LOW DIGIT.
6001	LDAI	0		;PUT IN TERMINATOR.
6002	STA	FBUFFR-1+5,Y,
6003	BEQA	FOUT20		;RETURN. (ALWAYS BRANCHES).
6004FOUT19: STA	FBUFFR-1,Y,	;STORE THE CHARACTER.
6005FOUT17: LDAI	0		;A TERMINATOR.
6006	STA	FBUFFR-1+1,Y
6007FOUT20: LDWDI	FBUFFR
6008FPWRRT: RTS			;ALL DONE.
6009FHALF:	200	;1/2
6010	000
6011ZERO:	000
6012	000
6013IFN	ADDPRC,<0>
6014
6015;POWER OF TEN TABLE
6016IFE	ADDPRC,<
6017FOUTBL: 376	;-100000
6018	171
6019	140
6020	000	;10000
6021	047
6022	020
6023	377	;-1000
6024	374
6025	030
6026	000	;100
6027	000
6028	144
6029	377	;-10
6030	377
6031	366
6032	000	;1
6033	000
6034	001>
6035
6036IFN	ADDPRC,<
6037FOUTBL: 372	;-100,000,000
6038	012
6039	037
6040	000
6041	000	;10,000,000
6042	230
6043	226
6044	200
6045	377	;-1,000,000
6046	360
6047	275
6048	300
6049	000	;100,000
6050	001
6051	206
6052	240
6053	377	;-10,000
6054	377
6055	330
6056	360
6057	000	;1000
6058	000
6059	003
6060	350
6061	377	;-100
6062	377
6063	377
6064	234
6065	000	;10
6066	000
6067	000
6068	012
6069	377	;-1
6070	377
6071	377
6072	377>
6073FDCEND:
6074IFN	TIME,<
6075	377	; -2160000 FOR TIME CONVERTER.
6076	337
6077	012
6078	200
6079	000	; 216000
6080	003
6081	113
6082	300
6083	377	; -36000
6084	377
6085	163
6086	140
6087	000	; 3600
6088	000
6089	016
6090	020
6091	377	; -600
6092	377
6093	375
6094	250
6095	000	; 60
6096	000
6097	000
6098	074
6099TIMEND:>
6100
6101PAGE
6102SUBTTL	EXPONENTIATION AND SQUARE ROOT FUNCTION.
6103	;SQUARE ROOT FUNCTION --- SQR(A)
6104	;USE SQR(X)=X^.5
6105SQR:	JSR	MOVAF		;MOVE FAC INTO ARG.
6106	LDWDI	FHALF
6107	JSR	MOVFM		;PUT MEMORY INTO FAC.
6108				;LAST THING FETCHED IS FACEXP. INTO ACCX.
6109;	JMP	FPWRT		;FALL INTO FPWRT.
6110
6111	;EXPONENTIATION ---  X^Y.
6112	;N.B.  0^0=1
6113	;FIRST CHECK IF Y=0. IF SO, THE RESULT IS 1.
6114	;NEXT CHECK IF X=0. IF SO THE RESULT IS 0.
6115	;THEN CHECK IF X.GT.0. IF NOT CHECK THAT Y IS AN INTEGER.
6116	;IF SO, NEGATE X, SO THAT LOG DOESN'T GIVE FCERR.
6117	;IF X IS NEGATIVE AND Y IS ODD, NEGATE THE RESULT
6118	;RETURNED BY EXP.
6119	;TO COMPUTE THE RESULT USE X^Y=EXP((Y*LOG(X)).
6120FPWRT:	BEQ	EXP		;IF FAC=0, JUST EXPONENTIATE THAT.
6121	LDA	ARGEXP		;IS X=0?
6122	BNE	FPWRT1
6123	JMP	ZEROF1		;ZERO FAC.
6124FPWRT1: LDXYI	TEMPF3		;SAVE FOR LATER IN A TEMP.
6125	JSR	MOVMF
6126	;Y=0 ALREADY. GOOD IN CASE NO ONE CALLS INT.
6127	LDA	ARGSGN
6128	BPL	FPWR1		;NO PROBLEMS IF X.GT.0.
6129	JSR	INT		;INTEGERIZE THE FAC.
6130	LDWDI	TEMPF3		;GET ADDR OF COMPERAND.
6131	JSR	FCOMP		;EQUAL?
6132	BNE	FPWR1		;LEAVE X NEG. LOG WILL BLOW HIM OUT.
6133				;A=-1 AND Y IS IRRELEVANT.
6134	TYA			;NEGATE X. MAKE POSITIVE.
6135	LDY	INTEGR		;GET EVENNESS.
6136FPWR1:	JSR	MOVFA1		;ALTERNATE ENTRY POINT.
6137	TYA
6138	PHA			;SAVE EVENNESS FOR LATER.
6139	JSR	LOG		;FIND LOG.
6140	LDWDI	TEMPF3		;MULTIPLY FAC TIMES LOG(X).
6141	JSR	FMULT
6142	JSR	EXP		;EXPONENTIATE THE FAC.
6143	PLA
6144	LSR	A,		;IS IT EVEN?
6145	BCC	NEGRTS		;YES. OR X.GT.0.
6146	;NEGATE THE NUMBER IN FAC.
6147NEGOP:	LDA	FACEXP
6148	BEQ	NEGRTS
6149	COM	FACSGN
6150NEGRTS: RTS
6151
6152PAGE
6153SUBTTL	EXPONENTIATION FUNCTION.
6154	;FIRST SAVE THE ORIGINAL ARGUMENT AND MULTIPLY THE FAC BY
6155	;LOG2(E). THE RESULT IS USED TO DETERMINE IF OVERFLOW
6156	;WILL OCCUR SINCE EXP(X)=2^(X*LOG2(E)) WHERE
6157	;LOG2(E)=LOG(E) BASE 2. THEN SAVE THE INTEGER PART OF
6158	;THIS TO SCALE THE ANSWER AT THE END. SINCE
6159	;2^Y=2^INT(Y)*2^(Y-INT(Y)) AND 2^INT(Y) IS EASY TO COMPUTE.
6160	;NOW COMPUTE 2^(X*LOG2(E)-INT(X*LOG2(E)) BY
6161	;P(LN(2)*(INT(X*LOG2(E))+1)-X) WHERE P IS AN APPROXIMATION
6162	;POLYNOMIAL. THE RESULT IS THEN SCALED BY THE POWER OF 2
6163	;PREVIOUSLY SAVED.
6164
6165LOGEB2: 201			;LOG(E) BASE 2.
6166	070
6167	252
6168	073
6169IFN	ADDPRC,<051>
6170
6171ife	addprc,<
6172expcon: 6	; degree -1.
6173	164	; .00021702255
6174	143
6175	220
6176	214
6177	167	; .0012439688
6178	043
6179	014
6180	253
6181	172	; .0096788410
6182	036
6183	224
6184	000
6185	174	; .055483342
6186	143
6187	102
6188	200
6189	176	; .24022984
6190	165
6191	376
6192	320
6193	200	; .69314698
6194	061
6195	162
6196	025
6197	201	; 1.0
6198	000
6199	000
6200	000>
6201
6202
6203IFN	ADDPRC,<
6204EXPCON: 7	;DEGREE-1
6205	161	; .000021498763697
6206	064
6207	130
6208	076
6209	126
6210	164	; .00014352314036
6211	026
6212	176
6213	263
6214	033
6215	167	; .0013422634824
6216	057
6217	356
6218	343
6219	205
6220	172	; .0096140170119
6221	035
6222	204
6223	034
6224	052
6225	174	; .055505126860
6226	143
6227	131
6228	130
6229	012
6230	176	; .24022638462
6231	165
6232	375
6233	347
6234	306
6235	200	; .69314718608
6236	061
6237	162
6238	030
6239	020
6240	201	; 1.0
6241	000
6242	000
6243	000
6244	000>
6245
6246EXP:
6247	LDWDI	LOGEB2		;MULTIPLY BY LOG(E) BASE 2.
6248	JSR	FMULT
6249	LDA	FACOV
6250	ADCI	120
6251	BCC	STOLD
6252	JSR	INCRND
6253STOLD:	STA	OLDOV
6254	JSR	MOVEF		;TO SAVE IN ARG WITHOUT ROUND.
6255	LDA	FACEXP
6256	CMPI	210		;IF ABS(FAC) .GE. 128, TOO BIG.
6257	BCC	EXP1
6258GOMLDV: JSR	MLDVEX		;OVERFLOW OR OVERFLOW.
6259EXP1:	JSR	INT
6260	LDA	INTEGR	;GET LOW PART.
6261	CLC
6262	ADCI	201
6263	BEQ	GOMLDV		;OVERFLOW OR OVERFLOW !!
6264	SEC
6265	SBCI	1		;SUBTRACT 1.
6266	PHA			;SAVE A WHILE.
6267	LDXI	4+ADDPRC	;PREP TO SWAP FAC AND ARG.
6268SWAPLP: LDA	ARGEXP,X
6269	LDY	FACEXP,X
6270	STA	FACEXP,X
6271	STY	ARGEXP,X
6272	DEX
6273	BPL	SWAPLP
6274	LDA	OLDOV
6275	STA	FACOV
6276	JSR	FSUBT
6277	JSR	NEGOP		;NEGATE FAC.
6278	LDWDI	EXPCON
6279	JSR	POLY
6280	CLR	ARISGN		;MULTIPLY BY POSITIVE 1.0.
6281	PLA			;GET SCALE FACTOR.
6282	JSR	MLDEXP		;MODIFY FACEXP AND CHECK FOR OVERFLOW.
6283	RTS			;HAS TO DO JSR DUE TO PULAS IN MULDIV.
6284
6285
6286PAGE
6287SUBTTL	POLYNOMIAL EVALUATOR AND THE RANDOM NUMBER GENERATOR.
6288	;EVALUATE P(X^2)*X
6289	;POINTER TO DEGREE IS IN [Y,A].
6290	;THE CONSTANTS FOLLOW THE DEGREE.
6291	;FOR X=FAC, COMPUTE:
6292	; C0*X+C1*X^3+C2*X^5+C3*X^7+...+C(N)*X^(2*N+1)
6293POLYX:	STWD	POLYPT		;RETAIN POLYNOMIAL POINTER FOR LATER.
6294	JSR	MOV1F		;SAVE FAC IN FACTMP.
6295	LDAI	TEMPF1
6296	JSR	FMULT		;COMPUTE X^2.
6297	JSR	POLY1		;COMPUTE P(X^2).
6298	LDWDI	TEMPF1
6299	JMP	FMULT		;MULTIPLY BY FAC AGAIN.
6300
6301	;POLYNOMIAL EVALUATOR.
6302	;POINTER TO DEGREE IS IN [Y,A].
6303	;COMPUTE:
6304	; C0+C1*X+C2*X^2+C3*X^3+C4*X^4+...+C(N-1)*X^(N-1)+C(N)*X^N.
6305POLY:	STWD	POLYPT
6306POLY1:	JSR	MOV2F		;SAVE FAC.
6307	LDADY	POLYPT
6308	STA	DEGREE
6309	LDY	POLYPT
6310	INY
6311	TYA
6312	BNE	POLY3
6313	INC	POLYPT+1
6314POLY3:	STA	POLYPT
6315	LDY	POLYPT+1
6316POLY2:	JSR	FMULT
6317	LDWD	POLYPT		;GET CURRENT POINTER.
6318	CLC
6319	ADCI	4+ADDPRC
6320	BCC	POLY4
6321	INY
6322POLY4:	STWD	POLYPT
6323	JSR	FADD		;ADD IN CONSTANT.
6324	LDWDI	TEMPF2		;MULTIPLY THE ORIGINAL FAC.
6325	DEC	DEGREE		;DONE?
6326	BNE	POLY2
6327RANDRT: RTS			;YES.
6328
6329	;PSUEDO-RANDOM NUMBER GENERATOR.
6330	;IF ARG=0, THE LAST RANDOM NUMBER GENERATED IS RETURNED.
6331	;IF ARG .LT. 0, A NEW SEQUENCE OF RANDOM NUMBERS IS
6332	;STARTED USING THE ARGUMENT.
6333	;   TO FORM THE NEXT RANDOM NUMBER IN THE SEQUENCE,
6334	;MULTIPLY THE PREVIOUS RANDOM NUMBER BY A RANDOM CONSTANT
6335	;AND ADD IN ANOTHER RANDOM CONSTANT. THE THEN HO
6336	;AND LO BYTES ARE SWITCHED, THE EXPONENT IS PUT WHERE
6337	;IT WILL BE SHIFTED IN BY NORMAL, AND THE EXPONENT IN THE FAC
6338	;IS SET TO 200 SO THE RESULT WILL BE LESS THAN 1. THIS
6339	;IS THEN NORMALIZED AND SAVED FOR THE NEXT TIME.
6340	;THE HO AND LOW BYTES WERE SWITCHED SO THERE WILL BE A
6341	;RANDOM CHANCE OF GETTING A NUMBER LESS THAN OR GREATER
6342	;THAN .5 .
6343
6344RMULZC: 230
6345	065
6346	104
6347	172
6348RADDZC: 150
6349	050
6350	261
6351	106
6352
6353RND:	JSR	SIGN		;GET SIGN INTO ACCX.
6354IFN	REALIO-3,<
6355	TAX>			;GET INTO ACCX, SINCE "MOVFM" USES ACCX.
6356	BMI	RND1		;START NEW SEQUENCE IF NEGATIVE.
6357IFE	REALIO-3,<
6358	BNE	QSETNR
6359		;TIMERS ARE AT 9044(L0),45(HI),48(LO),49(HI) HEX.
6360		;FIRST TWO ARE ALWAYS FREE RUNNING.
6361		;SECOND PAIR IS NOT. LO IS FREER THAN HI THEN.
6362		;SO ORDER IN FAC IS 44,48,45,49.
6363	LDA	CQHTIM
6364	STA	FACHO
6365	LDA	CQHTIM+4
6366	STA	FACMOH
6367	LDA	CQHTIM+1
6368	STA	FACMO
6369	LDA	CQHTIM+5
6370	STA	FACLO
6371	JMP	STRNEX>
6372QSETNR: LDWDI	RNDX		;GET LAST ONE INTO FAC.
6373	JSR	MOVFM
6374IFN	REALIO-3,<
6375	TXA			;FAC WAS ZERO?
6376	BEQ	RANDRT>		;RESTORE LAST ONE.
6377	LDWDI	RMULZC		;MULTIPLY BY RANDOM CONSTANT.
6378	JSR	FMULT
6379	LDWDI	RADDZC
6380	JSR	FADD		;ADD RANDOM CONSTANT.
6381RND1:	LDX	FACLO
6382	LDA	FACHO
6383	STA	FACLO
6384	STX	FACHO		;REVERSE HO AND LO.
6385IFE	REALIO-3,<
6386	LDX	FACMOH
6387	LDA	FACMO
6388	STA	FACMOH
6389	STX	FACMO>
6390STRNEX: CLR	FACSGN		;MAKE NUMBER POSITIVE.
6391	LDA	FACEXP		;PUT EXP WHERE IT WILL
6392	STA	FACOV		;BE SHIFTED IN BY NORMAL.
6393	LDAI	200
6394	STA	FACEXP		;MAKE RESULT BETWEEN 0 AND 1.
6395	JSR	NORMAL		;NORMALIZE.
6396	LDXYI	RNDX
6397GMOVMF: JMP	MOVMF		;PUT NEW ONE INTO MEMORY.
6398
6399PAGE
6400SUBTTL	SINE, COSINE AND TANGENT FUNCTIONS.
6401IFE	KIMROM,<
6402	;COSINE FUNCTION.
6403	;USE COS(X)=SIN(X+PI/2)
6404COS:	LDWDI	PI2		;PNTR TO PI/2.
6405	JSR	FADD		;ADD IT IN.
6406				;FALL INTO SIN.
6407
6408
6409	;SINE FUNCTION.
6410	;USE IDENTITIES TO GET FAC IN QUADRANTS I OR IV.
6411	;THE FAC IS DIVIDED BY 2*PI AND THE INTEGER PART IS IGNORED
6412	;BECAUSE SIN(X+2*PI)=SIN(X). THEN THE ARGUMENT CAN BE COMPARED
6413	;WITH PI/2 BY COMPARING THE RESULT OF THE DIVISION
6414	;WITH PI/2/(2*PI)=1/4.
6415	;IDENTITIES ARE THEN USED TO GET THE RESULT IN QUADRANTS
6416	;I OR IV. AN APPROXIMATION POLYNOMIAL IS THEN USED TO
6417	;COMPUTE SIN(X).
6418SIN:	JSR	MOVAF
6419	LDWDI	TWOPI		;GET PNTR TO DIVISOR.
6420	LDX	ARGSGN		;GET SIGN OF RESULT.
6421	JSR	FDIVF
6422	JSR	MOVAF		;GET RESULT INTO ARG.
6423	JSR	INT		;INTEGERIZE FAC.
6424	CLR	ARISGN		;ALWAYS HAVE THE SAME SIGN.
6425	JSR	FSUBT		;KEEP ONLY THE FRACTIONAL PART.
6426	LDWDI	FR4		;GET PNTR TO 1/4.
6427	JSR	FSUB		;COMPUTE 1/4-FAC.
6428	LDA	FACSGN		;SAVE SIGN FOR LATER.
6429	PHA
6430	BPL	SIN1		;FIRST QUADRANT.
6431	JSR	FADDH		;ADD 1/2 TO FAC.
6432	LDA	FACSGN		;SIGN IS NEGATIVE?
6433	BMI	SIN2
6434	COM	TANSGN		;QUADRANTS II AND III COME HERE.
6435SIN1:	JSR	NEGOP		;IF POSITIVE, NEGATE IT.
6436SIN2:	LDWDI	FR4		;POINTER TO 1/4.
6437	JSR	FADD		;ADD IT IN.
6438	PLA			;GET ORIGINAL QUADRANT.
6439	BPL	SIN3
6440	JSR	NEGOP		;IF NEGATIVE, NEGATE RESULT.
6441SIN3:	LDWDI	SINCON
6442GPOLYX: JMP	POLYX		;DO APPROXIMATION POLYNOMIAL.
6443
6444
6445	;TANGENT FUNCTION.
6446TAN:	JSR	MOV1F		;MOVE FAC INTO TEMPORARY.
6447	CLR	TANSGN		;REMEMBER WHETHER TO NEGATE.
6448	JSR	SIN		;COMPUTE THE SIN.
6449	LDXYI	TEMPF3
6450	JSR	GMOVMF		;PUT SIGN INTO OTHER TEMP.
6451	LDWDI	TEMPF1
6452	JSR	MOVFM		;PUT THIS MEMORY LOC INTO FAC.
6453	CLR	FACSGN		;START OFF POSITIVE.
6454	LDA	TANSGN
6455	JSR	COSC		;COMPUTE COSINE.
6456	LDWDI	TEMPF3		;ADDRESS OF SINE VALUE.
6457GFDIV:	JMP	FDIV		;DIVIDE SINE BY COSINE AND RETURN.
6458COSC:	PHA
6459	JMP	SIN1
6460
6461PI2:	201	;PI/2
6462	111
6463	017
6464	333-ADDPRC
6465IFN	ADDPRC,<242>
6466TWOPI:	203	;2*PI.
6467	111
6468	017
6469	333-ADDPRC
6470IFN	ADDPRC,<242>
6471FR4:	177	;1/4
6472	000
6473	000
6474	0000
6475IFN	ADDPRC,<0>
6476IFE ADDPRC,<SINCON:	4	;DEGREE-1.
6477	206	;39.710899
6478	036
6479	327
6480	373
6481	207	;-76.574956
6482	231
6483	046
6484	145
6485	207	;81.602231
6486	043
6487	064
6488	130
6489	206	;-41.341677
6490	245
6491	135
6492	341
6493	203	;6.2831853
6494	111
6495	017
6496	333>
6497
6498IFN	ADDPRC,<
6499SINCON: 5		;DEGREE-1.
6500	204	; -14.381383816
6501	346
6502	032
6503	055
6504	033
6505	206	; 42.07777095
6506	050
6507	007
6508	373
6509	370
6510	207	; -76.704133676
6511	231
6512	150
6513	211
6514	001
6515	207	; 81.605223690
6516	043
6517	065
6518	337
6519	341
6520	206	; -41.34170209
6521	245
6522	135
6523	347
6524	050
6525	203	; 6.2831853070
6526	111
6527	017
6528	332
6529	242
6530	241	; 7.2362932E7
6531	124
6532	106
6533	217
6534	23
6535	217	; 73276.2515
6536	122
6537	103
6538	211
6539	315>
6540PAGE
6541SUBTTL	ARCTANGENT FUNCTION.
6542	;USE IDENTITIES TO GET ARG BETWEEN 0 AND 1 AND THEN USE AN
6543	;APPROXIMATION POLYNOMIAL TO COMPUTE ARCTAN(X).
6544ATN:	LDA	FACSGN		;WHAT IS SIGN?
6545	PHA			;(MEANWHILE SAVE FOR LATER.)
6546	BPL	ATN1
6547	JSR	NEGOP		;IF NEGATIVE, NEGATE FAC.
6548				;USE ARCTAN(X)=-ARCTAN(-X) .
6549ATN1:	LDA	FACEXP
6550	PHA			;SAVE THIS TOO FOR LATER.
6551	CMPI	201		;SEE IF FAC .GE. 1.0 .
6552	BCC	ATN2		;IT IS LESS THAN 1.
6553	LDWDI	FONE		;GET PNTR TO 1.0 .
6554	JSR	FDIV		;COMPUTE RECIPROCAL.
6555				;USE ARCTAN(X)=PI/2-ARCTAN(1/X) .
6556ATN2:	LDWDI	ATNCON		;PNTR TO ARCTAN CONSTANTS.
6557	JSR	POLYX
6558	PLA
6559	CMPI	201		;WAS ORIGINAL ARGUMENT .LT. 1 ?
6560	BCC	ATN3		;YES.
6561	LDWDI	PI2
6562	JSR	FSUB		;SUBTRACT ARCTAGN FROM PI/2.
6563ATN3:	PLA			;WAS ORIGINAL ARGUMENT POSITIVE?
6564	BPL	ATN4		;YES.
6565	JMP	NEGOP		;IF NEGATIVE, NEGATE RESULT.
6566ATN4:	RTS			;ALL DONE.
6567
6568IFE	ADDPRC,<
6569ATNCON:	 10	;DEGREE-1.
6570	170	;.0028498896
6571	072
6572	305
6573	067
6574	173	;-.016068629
6575	203
6576	242
6577	134
6578	174	;.042691519
6579	056
6580	335
6581	115
6582	175	;-.075042945
6583	231
6584	260
6585	036
6586	175	;.10640934
6587	131
6588	355
6589	044
6590	176	;-.14203644
6591	221
6592	162
6593	000
6594	176	;.19992619
6595	114
6596	271
6597	163
6598	177	;.-33333073
6599	252
6600	252
6601	123
6602	201	;1.0
6603	000
6604	000
6605	000>
6606
6607IFN	ADDPRC,<
6608ATNCON: 13	;DEGREE-1.
6609	166	; -.0006847939119
6610	263
6611	203
6612	275
6613	323
6614	171	; .004850942156
6615	036
6616	364
6617	246
6618	365
6619	173	; -.01611170184
6620	203
6621	374
6622	260
6623	020
6624	174	; .03420963805
6625	014
6626	037
6627	147
6628	312
6629	174	; -.05427913276
6630	336
6631	123
6632	313
6633	301
6634	175	; .07245719654
6635	024
6636	144
6637	160
6638	114
6639	175	; -.08980239538
6640	267
6641	352
6642	121
6643	172
6644	175	; .1109324134
6645	143
6646	060
6647	210
6648	176
6649	176	; -.1428398077
6650	222
6651	104
6652	231
6653	072
6654	176	; .1999991205
6655	114
6656	314
6657	221
6658	307
6659	177	; -.3333333157
6660	252
6661	252
6662	252
6663	023
6664	201	; 1.0
6665	000
6666	000
6667	000
6668	000>>
6669PAGE
6670SUBTTL	SYSTEM INITIALIZATION CODE.
6671RADIX	10		;IN ALL NON-MATH-PACKAGE CODE.
6672; THIS INITIALIZES THE BASIC INTERPRETER FOR THE M6502 AND SHOULD BE
6673; LOCATED WHERE IT WILL BE WIPED OUT IN RAM IF CODE IS ALL IN RAM.
6674
6675IFE	ROMSW,<
6676	BLOCK	1>		;SO ZEROING AT TXTTAB DOESN'T PREVENT
6677				;RESTARTING INIT
6678INITAT: INC	CHRGET+7	;INCREMENT THE WHOLE TXTPTR.
6679	BNE	CHZGOT
6680	INC	CHRGET+8
6681CHZGOT: LDA	60000		;A LOAD WITH AN EXT ADDR.
6682	CMPI	":"		;IS IT A ":"?
6683	BCS	CHZRTS		;IT IS .GE. ":"
6684	CMPI	" "		;SKIP SPACES.
6685	BEQ	INITAT
6686	SEC
6687	SBCI	"0"		;ALL CHARS .GT. "9" HAVE RET'D SO
6688	SEC
6689	SBCI	^D256-"0"		;SEE IF NUMERIC.
6690				;TURN CARRY ON IF NUMERIC.
6691				;ALSO, SETZ IF NULL.
6692CHZRTS: RTS			;RETURN TO CALLER.
6693
6694	128			;LOADED OR FROM ROM.
6695	79			;THE INITIAL RANDOM NUMBER.
6696	199
6697	82
6698IFN	ADDPRC,<88>
6699IFN REALIO-3,<
6700IFE	KIMROM,<
6701TYPAUT: LDWDI	AUTTXT
6702	JSR	STROUT>>
6703INIT:
6704IFN	REALIO-3,<
6705	LDXI	255		;MAKE IT LOOK DIRECT IN CASE OF
6706	STX	CURLIN+1>	;ERROR MESSAGE.
6707IFN	STKEND-511,<
6708	LDXI	STKEND-256>
6709	TXS
6710IFN	REALIO-3,<
6711	LDWDI	INIT		;ALLOW RESTART.
6712	STWD	START+1
6713	STWD	RDYJSR+1	;RTS HERE ON ERRORS.
6714	LDWDI	AYINT
6715	STWD	ADRAYI
6716	LDWDI	GIVAYF
6717	STWD	ADRGAY>
6718	LDAI	76		;JMP INSTRUCTION.
6719IFE	REALIO,<HRLI 1,^O1000>	;MAKE AN INST.
6720IFN	REALIO-3,<
6721	STA	START
6722	STA	RDYJSR>
6723	STA	JMPER
6724IFN	ROMSW,<
6725	STA	USRPOK
6726	LDWDI	FCERR
6727	STWD	USRPOK+1>
6728	LDAI	LINLEN		;THESE MUST BE NON-ZERO SO CHEAD WILL
6729	STA	LINWID		;WORK AFTER MOVING A NEW LINE IN BUF
6730				;INTO THE PROGRAM
6731	LDAI	NCMPOS
6732	STA	NCMWID
6733	LDXI	RNDX+4-CHRGET
6734MOVCHG: LDA	INITAT-1,X,
6735	STA	CHRGET-1,X,	;MOVE TO RAM.
6736	DEX
6737	BNE	MOVCHG
6738	LDAI	STRSIZ
6739	STA	FOUR6
6740	TXA			;SET CONST IN RAM.
6741	STA	BITS
6742IFN EXTIO,<
6743	STA	CHANNL>
6744	STA	LASTPT+1
6745IFN	NULCMD,<
6746	STA	NULCNT>
6747	PHA			;PUT ZERO AT THE END OF THE STACK
6748				;SO FNDFOR WILL STOP
6749IFN	REALIO,<
6750	STA	CNTWFL>		;BE TALKATIVE.
6751IFN	BUFPAG,<
6752	INX			;MAKE [X]=1
6753	STX	BUF-3		;SET PRE-BUF BYTES NON-ZERO FOR CHEAD
6754	STX	BUF-4>
6755IFN	REALIO-3,<
6756	JSR	CRDO>		;TYPE A CR.
6757	LDXI	TEMPST
6758	STX	TEMPPT		;SET UP STRING TEMPORARIES.
6759IFN	REALIO!LONGI,<
6760IFN	REALIO-3,<
6761	LDWDI	MEMORY
6762	JSR	STROUT
6763	JSR	QINLIN		;GET A LINE OF INPUT.
6764	STXY	TXTPTR		;READ THIS !
6765	JSR	CHRGET		;GET THE FIRST CHARACTER.
6766IFE	KIMROM,<
6767	CMPI	"A"		;IS IT AN "A"?
6768	BEQ	TYPAUT>		;YES TYPE AUTHOR'S NAME.
6769	TAY			;NULL INPUT?
6770	BNE	USEDE9>		;NO.
6771IFE	REALIO-3,<
6772	LDYI	RAMLOC/^D256>
6773IFN	REALIO-3,<
6774IFE	ROMSW,<
6775	LDWDI	LASTWR>		;YES GET PNTR TO LAST WORD.
6776IFN	ROMSW,<
6777	LDWDI	RAMLOC>>
6778IFN	ROMSW,<
6779	STWD	TXTTAB>		;SET UP START OF PROGRAM LOCATION
6780	STWD	LINNUM
6781IFE	REALIO-3,<
6782	TAY>
6783IFN	REALIO-3,<
6784	LDYI	0>
6785LOOPMM: INC	LINNUM
6786	BNE	LOOPM1
6787	INC	LINNUM+1
6788IFE	REALIO-3,<
6789	BMI	USEDEC>
6790LOOPM1: LDAI	85		;PUT RANDOM INFO INTO MEM.
6791	STADY	LINNUM
6792	CMPDY	LINNUM		;WAS IT SAVED?
6793	BNE	USEDEC		;NO. THAT IS END OF MEMORY.
6794	ASL	A,		;LOOKS LIKE IT. TRY ANOTHER.
6795	STADY	LINNUM
6796	CMPDY	LINNUM		;WAS IT SAVED?
6797IFN	REALIO-3,<
6798	BNE	USEDEC>		;NO. THIS IS THE END.
6799IFN	REALIO-2,<
6800	BEQ	LOOPMM>
6801IFE	REALIO-2,<
6802	BNE	USEDEC
6803	CMP	0		;SEE IF HITTING PAGE 0
6804	BNE	LOOPMM
6805	LDAI	76
6806	STA	0
6807	BNEA	USEDEC>
6808IFN	REALIO-3,<
6809USEDE9: JSR	CHRGOT		;GET CURRENT CHARACTER.
6810	JSR	LINGET		;GET DECIMAL ARGUMENT.
6811	TAY			;MAKE SURE A TERMINATOR EXISTS.
6812	BEQ	USEDEC		;IT DOES.
6813	JMP	SNERR>		;IT DOESN'T.
6814USEDEC: LDWD	LINNUM		;GET SIZE OF MEMORY INPUT.
6815USEDEF: >			;HIGHEST ADDRESS.
6816IFE	REALIO!LONGI,<
6817	LDWDI	16190>		;A STRANGE NUMBER.
6818	STWD	MEMSIZ		;THIS IS THE SIZE OF MEMORY.
6819	STWD	FRETOP		;TOP OF STRINGS TOO.
6820TTYW:
6821IFN	REALIO-3,<
6822IFN	REALIO!LONGI,<
6823	LDWDI	TTYWID
6824	JSR	STROUT
6825	JSR	QINLIN		;GET LINE OF INPUT.
6826	STXY	TXTPTR		;READ THIS !
6827	JSR	CHRGET		;GET FIRST CHARACTER.
6828	TAY			;TEST ACCA BUT DON'T AFFECT CARRY.
6829	BEQ	ASKAGN
6830	JSR	LINGET		;GET ARGUMENT.
6831	LDA	LINNUM+1
6832	BNE	TTYW		;WIDTH MUST BE .LT. 256.
6833	LDA	LINNUM
6834	CMPI	16		;WIDTH MUST BE GREATER THAN 16.
6835	BCC	TTYW
6836	STA	LINWID		;THAT IS THE LINE WIDTH.
6837MORCPS: SBCI	CLMWID		;COMPUTE POSITION BEYOND WHICH
6838	BCS	MORCPS		;THERE ARE NO MORE FIELDS.
6839	EORI	255
6840	SBCI	CLMWID-2
6841	CLC
6842	ADC	LINWID
6843	STA	NCMWID>
6844ASKAGN:
6845IFE	ROMSW,<
6846IFN	REALIO!LONGI,<
6847	LDWDI	FNS
6848	JSR	STROUT
6849	JSR	QINLIN
6850	STXY	TXTPTR		;READ THIS !
6851	JSR	CHRGET
6852	LDXYI	INITAT		;DEFAULT.
6853	CMPI	"Y"
6854	BEQ	HAVFNS		;SAVE ALL FUNCTIONS.
6855	CMPI	"A"
6856	BEQ	OKCHAR		;SAVE ALL BUT ATN.
6857	CMPI	"N"
6858	BNE	ASKAGN		;BAD INPUT.
6859				;SAVE NOTHING.
6860OKCHAR: LDXYI	FCERR
6861	STXY	ATNFIX		;GET RID OF ATN FUNCTION.
6862	LDXYI	ATN		;UNTIL WE KNOW THAT WE SHOULD DEL MORE.
6863	CMPI	"A"
6864	BEQ	HAVFNS		;JUST GET RID OF ATN.
6865	LDXYI	FCERR
6866	STXY	COSFIX		;GET RID OF THE REST.
6867	STXY	TANFIX
6868	STXY	SINFIX
6869	LDXYI	COS		;AND GET RID OF ALL BACK TO "COS".
6870HAVFNS:>
6871IFE	REALIO!LONGI,<
6872	LDXYI	INITAT-1>>>	;GET RID OF ALL UP TO "INITAT".
6873IFN	ROMSW,<
6874	LDXYI	RAMLOC
6875	STXY	TXTTAB>
6876	LDYI	0
6877	TYA
6878	STADY	TXTTAB		;SET UP TEXT TABLE.
6879	INC	TXTTAB
6880IFN	REALIO-3,<
6881	BNE	QROOM
6882	INC	TXTTAB+1>
6883QROOM:	LDWD	TXTTAB		;PREPARE TO USE "REASON".
6884	JSR	REASON
6885IFE	REALIO-3,<
6886	LDWDI	FREMES
6887	JSR	STROUT>
6888IFN	REALIO-3,<
6889	JSR	CRDO>
6890	LDA	MEMSIZ		;COMPUTE [MEMSIZ]-[VARTAB].
6891	SEC
6892	SBC	TXTTAB
6893	TAX
6894	LDA	MEMSIZ+1
6895	SBC	TXTTAB+1
6896	JSR	LINPRT		;TYPE THIS VALUE.
6897	LDWDI	WORDS		;MORE BULLSHIT.
6898	JSR	STROUT
6899	JSR	SCRTCH		;SET UP EVERYTHING ELSE.
6900IFE	REALIO-3,<
6901	JMP	READY>
6902IFN	REALIO-3,<
6903	LDWDI	STROUT
6904	STWD	RDYJSR+1
6905	LDWDI	READY
6906	STWD	START+1
6907	JMPD	START+1
6908
6909IFE	ROMSW,<
6910FNS:	DT"WANT SIN-COS-TAN-ATN"
6911	0>
6912IFE	KIMROM,<
6913AUTTXT: ACRLF
6914	12			;ANOTHER LINE FEED.
6915	DT"WRITTEN "
6916	DT"BY WEILAND & GATES"
6917	ACRLF
6918	0>
6919MEMORY: DT"MEMORY SIZE"
6920	0
6921TTYWID:
6922IFE	KIMROM,<
6923	DT"TERMINAL ">
6924	DT"WIDTH"
6925	0>
6926WORDS:	DT" BYTES FREE"
6927IFN	REALIO-3,<
6928	ACRLF
6929	ACRLF>
6930IFE	REALIO-3,<
6931	EXP	^O15
6932	0
6933FREMES: >
6934IFE REALIO,<	DT"SIMULATED BASIC FOR THE 6502 V1.1">
6935IFE REALIO-1,<	DT"KIM BASIC V1.1">
6936IFE REALIO-2,<	DT"OSI 6502 BASIC VERSION 1.1">
6937IFE REALIO-3,<	DT"### COMMODORE BASIC ###"
6938	EXP	^O15
6939	EXP	^O15>
6940IFE	REALIO-4,<DT"APPLE BASIC V1.1">
6941IFE	REALIO-5,<DT"STM BASIC V1.1">
6942IFN	REALIO-3,<
6943	ACRLF
6944	DT"COPYRIGHT 1978 MICROSOFT"
6945	ACRLF>
6946	0
6947LASTWR::
6948	BLOCK	100		;SPACE FOR TEMP STACK.
6949IFE REALIO,<
6950TSTACK::BLOCK	13600>
6951
6952IF2,<
6953	PURGE	A,X,Y>
6954IFNDEF	START,<START==0>
6955	END	$Z+START