0000001: PAG 0000002: ***************************** 0000003: * * 0000004: * Applesoft - Part A * 0000005: * * 0000006: * Copywrite Apple Computer, * 0000007: * Inc. and Microsoft, Inc.; * 0000008: * not for publication or * 0000009: * distribution. * 0000010: * * 0000011: ***************************** 0000012: * * 0000013: * Input parsing, * 0000014: * Routine addressing, * 0000015: * For-next loops, etc. * 0000016: * * 0000017: * $D000 - $DD66 * 0000018: * * 0000019: ***************************** 0000020: 0000021: * Equates for all parts: 0000022: 0000023: * Applesoft tokens: 0000024: 0000025: for = $81 0000026: data = $83 0000027: pop = $A1 0000028: goto = $AB 0000029: gosub = $B0 0000030: rem = $B2 0000031: print = $BA 0000032: tab = $C0 0000033: to = $C1 0000034: fn = $C2 0000035: spc = $C3 0000036: then = $C4 0000037: at = $C5 0000038: not = $C6 0000039: step = $C7 0000040: plus = $C8 0000041: minus = $C9 0000042: equal = $D0 0000043: sgn = $D2 0000044: scrn = $D7 0000045: leftstr = $E8 0000046: 0000047: * Zero page locations: 0000048: 0000049: GOWARM = 0 ;Set up by cold start 0000050: GOSTROUT = 3 ; but not used anywhere. 0000051: USR = $A 0000052: CHARAC = $D 0000053: ENDCHR = $E 0000054: PNTR = $F 0000055: NUMDIM = $F ;Used in array rtns 0000056: DIMFLG = $10 0000057: VALTYP = $11 ;$FF for string, 0 if numeric 0000058: INTFLG = $12 ;- for int var 0000059: DATAFLG = $13 ;Used in PARSE 0000060: GARFLG = DATAFLG ;Used in GARBAG 0000061: SUBFLG = $14 0000062: INPUTFLG = $15 ;Has $40 for GET, $98 for READ 0000063: CPRMASK = $16 ;Receives CPRTYP in FRMEVL 0000064: SIGNFLG = $16 ;Flags sign in TAN 0000065: SHAPEL = $1A 0000066: SHAPEH = $1B 0000067: HCOLOR1 = $1C 0000068: COUNTH = $1D 0000069: WNDWDTH = $21 0000070: CH = $24 0000071: GBASL = $26 0000072: GBASH = $27 0000073: H2 = $2C 0000074: V2 = $2D 0000075: MASK = $2E ;Used by //c only 0000076: HMASK = $30 0000077: INVFLG = $32 0000078: PROMPT = $33 0000079: A1L = $3C 0000080: A1H = $3D 0000081: A2L = $3E 0000082: A2H = $3F 0000083: LINNUM = $50 0000084: TEMPPT = $52 0000085: LASTPT = $53 0000086: TEMPST = $55 0000087: INDEX = $5E 0000088: DEST = $60 0000089: RESULT = $62 0000090: TXTTAB = $67 0000091: VARTAB = $69 0000092: ARYTAB = $6B 0000093: STREND = $6D 0000094: FRETOP = $6F 0000095: FRESPC = $71 0000096: MEMSIZ = $73 0000097: CURLIN = $75 0000098: OLDLIN = $77 0000099: OLDTEXT = $79 0000100: DATLIN = $7B 0000101: DATPTR = $7D 0000102: INPTR = $7F 0000103: VARNAM = $81 ;$:+-, %:--, real:++, fnc:-+ 0000104: VARPNT = $83 0000105: FORPNT = $85 0000106: TXPSV = $87 ;Used in INPUT 0000107: LASTOP = $87 ;Scratch flag used in FRMEVL 0000108: CPRTYP = $89 ;>,=,< flag in FRMEVL 0000109: FNCNAM = $8A 0000110: DSCPTR = $8C 0000111: DSCLEN = $8F ;Used in GARBAG 0000112: JMPADRS = $90 0000113: LENGTH = $91 ;Used in GARBAG 0000114: ARYPNT = $94 ;Used in GARBAG 0000115: HIGHDS = $94 0000116: HIGHTR = $96 0000117: INDX = $99 ;Used by array rtns 0000118: LOWTR = $9B 0000119: DSCTMP = $9D 0000120: VPNT = $A0 ;Temp var ptr 0000121: EXTRASV = $92 ;FP extra precision 0000122: TEMP1 = $93 ;Save areas for FAC 0000123: TEMP2 = $98 0000124: TEMP3 = $8A 0000125: TMPEXP = $99 ;Used in FIN (EVAL) 0000126: EXPON = $9A ; " 0000127: DPFLG = $9B ;Flags dec pnt in FIN 0000128: EXPSGN = $9C ; " sign of exp in FIN 0000129: FAC = $9D ;Primary floating pnt acc 0000130: SERLEN = $A3 ;Holds length of series-1 0000131: FPGEN = $A4 0000132: ARG = $A5 ;Secondary fp acc 0000133: FACSGN = FAC+5 ;Holds unpacked sign 0000134: ARGSGN = ARG+5 0000135: SGNCPR = $AB ;Flags opp sign in FP rout. 0000136: EXTRAFAC = $AC ;FP precision 0000137: SERPNT = $AD ;Pntr to series data in FP 0000138: STRNG1 = $AB 0000139: STRNG2 = $AD 0000140: PRGEND = $AF 0000141: CHRGET = $B1 0000142: CHRGOT = $B7 0000143: TXTPTR = $B8 0000144: RNDSEED = $C9 0000145: DXL = $D0 0000146: DXH = $D1 0000147: DY = $D2 0000148: QDRNT = $D3 0000149: EL = $D4 0000150: EH = $D5 0000151: LOCK = $D6 ;Prevents user access if - 0000152: ERRFLG = $D8 0000153: ERRLIN = $DA 0000154: ERRPOS = $DC 0000155: ERRNUM = $DE 0000156: ERRSTK = $DF 0000157: X0L = $E0 0000158: X0H = $E1 0000159: Y0 = $E2 0000160: HCOLORZ = $E4 0000161: HNDX = $E5 0000162: HPAG = $E6 0000163: SCALEZ = $E7 0000164: SHAPEPNT = $E8 0000165: COLCOUNT = $EA 0000166: FIRST = $F0 0000167: SPEEDZ = $F1 ;Output speed 0000168: TRCFLG = $F2 0000169: ORMASK = $F3 ;Has $40 for flash 0000170: TXTPSV = $F4 0000171: CURLSV = $F6 0000172: REMSTK = $F8 0000173: ROTZ = $F9 0000174: * $FF is also used by the string out rtns. 0000175: 0000176: * Apple stuff: 0000177: 0000178: STACK = $100 0000179: IN = $200 0000180: AMPER = $3F5 0000181: OURCH = $57B ;New roms & //c 0000182: KEY = $C000 0000183: SLOTROM = $C006 ;Used only by new 0000184: INTROM = $C007 ; //e roms 0000185: RD80ST = $C018 0000186: RD80COL = $C01F 0000187: TXTCLR = $C050 0000188: MIXCLR = $C052 0000189: MIXSET = $C053 0000190: LOWSCR = $C054 0000191: HISCR = $C055 0000192: LORES = $C056 0000193: HIRES = $C057 0000194: RDDOUBHG = $C079 0000195: MONPLOT = $F800 0000196: PLOT1 = $F80E ;//c roms only 0000197: HLINE = $F819 0000198: PREAD = $FB1E 0000199: VLINE = $F828 0000200: GBASCALC = $F847 ; " 0000201: SETCOL = $F864 0000202: SCRN = $F871 0000203: SETTXT = $FB39 0000204: SETGR = $FB40 0000205: SETWND = $FB4B ; " 0000206: TABV = $FB5B 0000207: HOME = $FC58 0000208: MONWAIT = $FCA8 0000209: RD2BIT = $FCFA 0000210: RDKEY = $FD0C 0000211: GETLN = $FD6A 0000212: COUT = $FDED 0000213: INPORT = $FE8B 0000214: OUTPORT = $FE95 0000215: WRITE = $FECD 0000216: MONREAD = $FEFD 0000217: MONREAD2 = $FF02 0000218: 0000219: DO APPLEC 0000220: SHLOAD = AMPER 0000221: RECALL = AMPER 0000222: STORE = AMPER 0000223: LOAD = AMPER 0000224: SAVE = AMPER 0000225: FIN 0000226: 0000227: CMDTABL DA END-1 0000228: DA FOR-1 0000229: DA NEXT-1 0000230: DA DATA-1 0000231: DA INPUT-1 0000232: DA DEL-1 0000233: DA DIM-1 0000234: DA READ-1 0000235: DA GR-1 0000236: DA TEXT-1 0000237: DA PRNU-1 0000238: DA INNU-1 0000239: DA CALL-1 0000240: DA PLOT-1 0000241: DA HLIN-1 0000242: DA VLIN-1 0000243: DA HGR2-1 0000244: DA HGR-1 0000245: DA HCOLOR-1 0000246: DA HPLOT-1 0000247: DA DRAW-1 0000248: DA XDRAW-1 0000249: DA HTAB-1 0000250: DA HOME-1 0000251: DA ROT-1 0000252: DA SCALE-1 0000253: DA SHLOAD-1 0000254: DA TRACE-1 0000255: DA NOTRACE-1 0000256: DA NORMAL-1 0000257: DA INVERSE-1 0000258: DA FLASH-1 0000259: DA COLOR-1 0000260: DA POP-1 0000261: DA VTAB-1 0000262: DA HIMEM-1 0000263: DA LOMEM-1 0000264: DA ONERR-1 0000265: DA RESUME-1 0000266: DA RECALL-1 0000267: DA STORE-1 0000268: DA SPEED-1 0000269: DA LET-1 0000270: DA GOTO-1 0000271: DA RUN-1 0000272: DA IF-1 0000273: DA RESTORE-1 0000274: DA AMPER-1 0000275: DA GOSUB-1 0000276: DA POP-1 ;RETURN 0000277: DA REM-1 0000278: DA STOP-1 0000279: DA ONGOTO-1 0000280: DA WAIT-1 0000281: DA LOAD-1 0000282: DA SAVE-1 0000283: DA DEF-1 0000284: DA POKE-1 0000285: DA PRINT-1 0000286: DA CONT-1 0000287: DA LIST-1 0000288: DA CLEAR-1 0000289: DA GET-1 0000290: DA NEW-1 0000291: UNFNC DA SGN 0000292: DA INT 0000293: DA ABS 0000294: DA USR 0000295: DA FRE 0000296: DA ERROR ;SCRN done special 0000297: DA PDL 0000298: DA POS 0000299: DA SQR 0000300: DA RND 0000301: DA LOG 0000302: DA EXP 0000303: DA COS 0000304: DA SIN 0000305: DA TAN 0000306: DA ATN 0000307: DA PEEK 0000308: DA LEN 0000309: DA STR 0000310: DA VAL 0000311: DA ASC 0000312: DA CHRSTR 0000313: DA LEFTSTR 0000314: DA RIGHTSTR 0000315: DA MIDSTR 0000316: 0000317: * The hex #s are for preference testing: 0000318: 0000319: MATHTBL HEX 79 0000320: DA FADDT-1 0000321: HEX 79 0000322: DA FSUBT-1 0000323: HEX 7B 0000324: DA FMULTT-1 0000325: HEX 7B 0000326: DA FDIVT-1 0000327: HEX 7D 0000328: DA FPWRT-1 0000329: HEX 50 0000330: DA AND-1 0000331: HEX 46 0000332: DA OR-1 0000333: MINUS HEX 7F 0000334: DA NEGOP-1 ;Unary minus 0000335: UNOT HEX 7F 0000336: DA EQUOP-1 ;Unary NOT 0000337: PLUS HEX 64 0000338: DA POSOP-1 ;Used by <=> 0000339: 0000340: TOKTABL DCI 'END' 0000341: DCI 'FOR' 0000342: DCI 'NEXT' 0000343: DCI 'DATA' 0000344: DCI 'INPUT' 0000345: DCI 'DEL' 0000346: DCI 'DIM' 0000347: DCI 'READ' 0000348: DCI 'GR' 0000349: DCI 'TEXT' 0000350: DCI 'PR#' 0000351: DCI 'IN#' 0000352: DCI 'CALL' 0000353: DCI 'PLOT' 0000354: DCI 'HLIN' 0000355: DCI 'VLIN' 0000356: DCI 'HGR2' 0000357: DCI 'HGR' 0000358: DCI 'HCOLOR=' 0000359: DCI 'HPLOT' 0000360: DCI 'DRAW' 0000361: DCI 'XDRAW' 0000362: DCI 'HTAB' 0000363: DCI 'HOME' 0000364: DCI 'ROT=' 0000365: DCI 'SCALE=' 0000366: DCI 'SHLOAD' 0000367: DCI 'TRACE' 0000368: DCI 'NOTRACE' 0000369: DCI 'NORMAL' 0000370: DCI 'INVERSE' 0000371: DCI 'FLASH' 0000372: DCI 'COLOR=' 0000373: DCI 'POP' 0000374: DCI 'VTAB' 0000375: DCI 'HIMEM:' 0000376: DCI 'LOMEM:' 0000377: DCI 'ONERR' 0000378: DCI 'RESUME' 0000379: DCI 'RECALL' 0000380: DCI 'STORE' 0000381: DCI 'SPEED=' 0000382: DCI 'LET' 0000383: DCI 'GOTO' 0000384: DCI 'RUN' 0000385: DCI 'IF' 0000386: DCI 'RESTORE' 0000387: ASC "&" 0000388: DCI 'GOSUB' 0000389: DCI 'RETURN' 0000390: DCI 'REM' 0000391: DCI 'STOP' 0000392: DCI 'ON' 0000393: DCI 'WAIT' 0000394: DCI 'LOAD' 0000395: DCI 'SAVE' 0000396: DCI 'DEF' 0000397: DCI 'POKE' 0000398: DCI 'PRINT' 0000399: DCI 'CONT' 0000400: DCI 'LIST' 0000401: DCI 'CLEAR' 0000402: DCI 'GET' 0000403: DCI 'NEW' 0000404: DCI 'TAB(' 0000405: DCI 'TO' 0000406: DCI 'FN' 0000407: DCI 'SPC(' 0000408: DCI 'THEN' 0000409: DCI 'AT' 0000410: DCI 'NOT' 0000411: DCI 'STEP' 0000412: ASC "+" 0000413: ASC "-" 0000414: ASC "*" 0000415: ASC "/" 0000416: ASC "^" 0000417: DCI 'AND' 0000418: DCI 'OR' 0000419: ASC ">" 0000420: ASC "=" 0000421: ASC "<" 0000422: DCI 'SGN' 0000423: DCI 'INT' 0000424: DCI 'ABS' 0000425: DCI 'USR' 0000426: DCI 'FRE' 0000427: DCI 'SCRN(' 0000428: DCI 'PDL' 0000429: DCI 'POS' 0000430: DCI 'SQR' 0000431: DCI 'RND' 0000432: DCI 'LOG' 0000433: DCI 'EXP' 0000434: DCI 'COS' 0000435: DCI 'SIN' 0000436: DCI 'TAN' 0000437: DCI 'ATN' 0000438: DCI 'PEEK' 0000439: DCI 'LEN' 0000440: DCI 'STR$' 0000441: DCI 'VAL' 0000442: DCI 'ASC' 0000443: DCI 'CHR$' 0000444: DCI 'LEFT$' 0000445: DCI 'RIGHT$' 0000446: DCI 'MID$' 0000447: BRK 0000448: 0000449: ERRMSG 0000450: NXwoFOR DCI 'NEXT WITHOUT FOR' 0000451: SYNTXERR DCI 'SYNTAX' 0000452: RTNwoGSB DCI 'RETURN WITHOUT GOSUB' 0000453: OofDATA DCI 'OUT OF DATA' 0000454: ILLQUAN DCI 'ILLEGAL QUANTITY' 0000455: OVFLOW DCI 'OVERFLOW' 0000456: OofMEM DCI 'OUT OF MEMORY' 0000457: UNDSTAT DCI *UNDEF'D STATEMENT* 0000458: BADSUBS DCI 'BAD SUBSCRIPT' 0000459: REdimARR DCI *REDIM'D ARRAY* 0000460: DIVbyZRO DCI 'DIVISION BY ZERO' 0000461: ILLDIR DCI 'ILLEGAL DIRECT' 0000462: TYPEMISS DCI 'TYPE MISMATCH' 0000463: STRtoLNG DCI 'STRING TOO LONG' 0000464: FORMtoCX DCI 'FORMULA TOO COMPLEX' 0000465: CANTCON DCI *CAN'T CONTINUE* 0000466: UNDFUNC DCI *UNDEF'D FUNCTION* 0000467: 0000468: ERRIN ASC 'ERROR'0700 0000469: INMSG ASC 'IN '00 0000470: BREAKIN HEX 0D 0000471: ASC 'BREAK'0700 0000472: 0000473: GTFORPNT TSX ;Search through stack 0000474: LUP 4 ; for FOR data 0000475: INX 0000476: --^ 0000477: :L LDA STACK+1,X 0000478: CMP #for 0000479: BNE RET1 0000480: LDA FORPNT+1 0000481: BNE :SAME ;Taken if var specified 0000482: LDA STACK+2,X ;Get FOR var pointer 0000483: STA FORPNT 0000484: LDA STACK+3,X 0000485: STA FORPNT+1 0000486: :SAME CMP STACK+3,X ;Compare FOR var adrs 0000487: BNE :NX ;Branch if not same 0000488: LDA FORPNT 0000489: CMP STACK+2,X 0000490: BEQ RET1 0000491: :NX TXA ;Not correct FOR, 0000492: CLC ; set up to look at next. 0000493: ADC #$12 0000494: TAX 0000495: BNE :L 0000496: RET1 RTS 0000497: 0000498: BLTU JSR REASON ;Is there room? 0000499: STA STREND ;Set top of array storage to A,Y 0000500: STY STREND+1 0000501: 0000502: * Set up to move upwards LOWTR through HIGHTR-1 0000503: * to just below HIGHDS: 0000504: 0000505: BLTU2 SEC 0000506: SB HIGHTR;LOWTR;INDEX 0000507: TAY 0000508: LDA HIGHTR+1 0000509: SBC LOWTR+1 0000510: TAX 0000511: INX 0000512: TYA 0000513: BEQ :NXP ;Taken if no partial page 0000514: LDA HIGHTR ;Prepare to move partial page 0000515: SEC ; first to maximize speed 0000516: SBC INDEX 0000517: STA HIGHTR 0000518: BCS :OV 0000519: DEC HIGHTR+1 0000520: SEC 0000521: :OV SB HIGHDS;INDEX;HIGHDS 0000522: BCS :NXB 0000523: DEC HIGHDS+1 0000524: BCC :NXB 0000525: :BL LDA (HIGHTR),Y ;Now do the move 0000526: STA (HIGHDS),Y 0000527: :NXB DEY 0000528: BNE :BL 0000529: LDA (HIGHTR),Y 0000530: STA (HIGHDS),Y 0000531: :NXP DEC HIGHTR+1 0000532: DEC HIGHDS+1 0000533: DEX ;Another page to move? 0000534: BNE :NXB 0000535: RTS 0000536: 0000537: * Stack memory check used by FOR, GOSUB, FRMEVL: 0000538: 0000539: CHKMEM ASL ;Entered with A=1, 3, or 9 0000540: ADC #$36 0000541: BCS MEMERR ;Never taken 0000542: STA INDEX 0000543: TSX 0000544: CPX INDEX 0000545: BCC MEMERR 0000546: RTS 0000547: 0000548: REASON CPY FRETOP+1 ;Check that A,Y < FRETOP 0000549: BCC :RET ;Return if so. 0000550: BNE :R1 ;Clean shop if not. 0000551: CMP FRETOP 0000552: BCC :RET 0000553: :R1 PHA ;Save A,Y and TEMP1 & TEMP2 0000554: LDX #FAC-TEMP1-1 0000555: TYA 0000556: :R2 PHA 0000557: LDA TEMP1,X 0000558: DEX 0000559: BPL :R2 0000560: JSR GARBAG ;Collection time 0000561: LDX #TEMP1-FAC+1 0000562: :R3 PLA ;Restore TEMP1 & 2 and A,Y. 0000563: STA FAC,X 0000564: INX 0000565: BMI :R3 0000566: PLA 0000567: TAY 0000568: PLA ;Is there room now? 0000569: CPY FRETOP+1 0000570: BCC :RET ;Return if so 0000571: BNE MEMERR ;Memory error if not. 0000572: CMP FRETOP 0000573: BCS MEMERR 0000574: :RET RTS 0000575: 0000576: MEMERR LDX #OofMEM-ERRMSG 0000577: ERROR BIT ERRFLG ;ONERR active? 0000578: BPL DOERRMSG ;Branch if not 0000579: JMP HANDLERR 0000580: 0000581: DOERRMSG JSR CRDO 0000582: JSR OUTQUES 0000583: :EL LDA ERRMSG,X 0000584: PHA 0000585: JSR OUTDO 0000586: INX 0000587: PLA 0000588: BPL :EL 0000589: JSR STKINI 0000590: LDA #ERRIN 0000591: LDY #>ERRIN 0000592: PRNTIN? JSR STROUT 0000593: LDY CURLIN+1 ;Direct mode? 0000594: INY 0000595: BEQ RESTART ;Branch if so 0000596: JSR INPRT 0000597: 0000598: RESTART JSR CRDO 0000599: LDX #"]" 0000600: JSR INLIN2 ;Get direct input 0000601: STX TXTPTR ;Point to input buff 0000602: STY TXTPTR+1 0000603: LSR ERRFLG ;Defeat ONERR 0000604: JSR CHRGET 0000605: TAX 0000606: BEQ RESTART ;If no input 0000607: LDX #$FF ;Set direct mode flag 0000608: STX CURLIN+1 ; = high byte of CURLIN. 0000609: BCC NXLIN ;Branch if line # given 0000610: JSR GETIN ;Otherwise parse 0000611: JMP TRACE? ;and act on command. 0000612: NXLIN TRX PRGEND;VARTAB 0000613: JSR LINGET ;Get line # 0000614: JSR GETIN ;and parse input 0000615: STY PNTR ;Save index to input buffer 0000616: JSR FNDLIN ;Is line there now? 0000617: BCC :NEWLN ;Branch if not 0000618: LDY #1 ;If line is there, delete it. 0000619: LDA (LOWTR),Y ;Get link high 0000620: STA INDEX+1 0000621: MOV VARTAB;INDEX 0000622: MOV LOWTR+1;DEST+1 0000623: LDA LOWTR 0000624: DEY 0000625: SBC (LOWTR),Y ;Line-link 0000626: CLC 0000627: ADC VARTAB 0000628: STA VARTAB ;New prog end 0000629: STA DEST 0000630: LDA VARTAB+1 0000631: ADC #$FF 0000632: STA VARTAB+1 0000633: SBC LOWTR+1 0000634: TAX 0000635: SEC 0000636: LDA LOWTR 0000637: SBC VARTAB 0000638: TAY ;Index to move partial page 0000639: BCS :OV 0000640: INX 0000641: DEC DEST+1 0000642: :OV CLC 0000643: ADC INDEX 0000644: BCC :MD 0000645: DEC INDEX+1 0000646: CLC 0000647: :MD LDA (INDEX),Y ;Move rest of program 0000648: STA (DEST),Y ;to deleted line's place. 0000649: INY 0000650: BNE :MD 0000651: INC INDEX+1 0000652: INC DEST+1 0000653: DEX ;Another page to move? 0000654: BNE :MD 0000655: :NEWLN LDA IN ;Line # alone? 0000656: BEQ LINKSET ;Skip to LINKSET if so. 0000657: TRAY MEMSIZ;FRETOP 0000658: LDA VARTAB ;Set up memory move to 0000659: STA HIGHTR ;insert new line. 0000660: ADC PNTR 0000661: STA HIGHDS 0000662: LDY VARTAB+1 0000663: STY HIGHTR+1 0000664: BCC :MVPROG 0000665: INY 0000666: :MVPROG STY HIGHDS+1 0000667: JSR BLTU ;Do the move 0000668: TRAY LINNUM;IN-2 0000669: TRAY STREND;VARTAB 0000670: LDY PNTR 0000671: :INSRT LDA IN-5,Y ;Insert new line 0000672: DEY 0000673: STA (LOWTR),Y 0000674: BNE :INSRT 0000675: ;Note LINKSET can be called 0000676: LINKSET JSR SETPTRS ;by typing 0[RTN] 0000677: TRAY TXTTAB;INDEX 0000678: CLC 0000679: :NXLNK LDY #1 0000680: LDA (INDEX),Y 0000681: BNE :PUTLNK 0000682: MOVD VARTAB;PRGEND 0000683: JMP RESTART 0000684: :PUTLNK LDY #4 ;Set up links 0000685: :FNDEOL INY 0000686: LDA (INDEX),Y 0000687: BNE :FNDEOL 0000688: INY 0000689: TYA 0000690: ADC INDEX 0000691: TAX 0000692: LDY #0 0000693: STA (INDEX),Y 0000694: LDA INDEX+1 0000695: ADC #0 0000696: INY 0000697: STA (INDEX),Y 0000698: STX INDEX 0000699: STA INDEX+1 0000700: BCC :NXLNK 0000701: 0000702: INLIN LDX #$80 0000703: INLIN2 STX PROMPT 0000704: JSR GETLN 0000705: CPX #$EF 0000706: BCC GDBUFS 0000707: LDX #$EF ;Terminate line at $EF chrs 0000708: GDBUFS LDA #0 ;Set up eol marker 0000709: STA IN,X 0000710: TXA 0000711: BEQ :NI 0000712: :STRIP LDA IN-1,X ;Convert to + ascii 0000713: AND #$7F 0000714: STA IN-1,X 0000715: DEX 0000716: BNE :STRIP 0000717: :NI LDA #0 0000718: LDX #IN-1 0000719: LDY #>IN-1 0000720: RTS 0000721: 0000722: INCHR JSR RDKEY 0000723: AND #$7F 0000724: RTS 0000725: 0000726: GETIN LDX TXTPTR 0000727: DEX 0000728: LDY #4 0000729: STY DATAFLG 0000730: BIT LOCK ;Program protected? 0000731: BPL PARSE 0000732: PLA ;If so, ignore input 0000733: PLA ;and run program again. 0000734: JSR SETPTRS 0000735: JMP NEWSTT 0000736: 0000737: PARSE INX 0000738: NXCHR 0000739: DO NEWROMS 0000740: JSR GETUPC 0000741: ELSE 0000742: LDA IN,X 0000743: FIN 0000744: BIT DATAFLG 0000745: BVS :SE ;Branch if DATA stmnt 0000746: CMP #' ' 0000747: BEQ PARSE 0000748: :SE STA ENDCHR 0000749: CMP #'"' 0000750: BEQ :SIN 0000751: BVS :PUTIN ;Branch if DATA stmnt 0000752: CMP #'?' 0000753: BNE :TOK 0000754: LDA #print 0000755: BNE :PUTIN ;Always 0000756: :TOK CMP #'0' 0000757: BLT :ISTOK 0000758: CMP #'<' 0000759: BLT :PUTIN 0000760: :ISTOK STY STRNG2 0000761: LDA #TOKTABL-$100 0000762: STA FAC 0000763: LDA #>TOKTABL-$100 0000764: STA FAC+1 0000765: LDY #0 0000766: STY PNTR ;Holds current token-$80 0000767: DEY 0000768: STX TXTPTR 0000769: DEX 0000770: :NY INY 0000771: BNE :NX 0000772: INC FAC+1 0000773: :NX INX 0000774: :LIN 0000775: DO NEWROMS 0000776: JSR GETUPC 0000777: ELSE 0000778: LDA IN,X 0000779: FIN 0000780: CMP #' ' ;Skip spaces 0000781: BEQ :NX 0000782: SEC 0000783: SBC (FAC),Y ;Does it match keyword? 0000784: BEQ :NY ;Next chr if so 0000785: CMP #$80 ;Match last keyword chr? 0000786: BNE :SKIPTOK ;Skip to next token if not 0000787: ORA PNTR ;Get token 0000788: CMP #at 0000789: BNE :PUTTOK 0000790: DO NEWROMS 0000791: JSR GETUPC0 0000792: ELSE 0000793: LDA IN+1,X 0000794: FIN 0000795: CMP #'N' ;Preferance to ATN 0000796: BEQ :SKIPTOK 0000797: CMP #'O' ;Preferance to TO 0000798: BEQ :SKIPTOK 0000799: LDA #at 0000800: :PUTTOK LDY STRNG2 0000801: :PUTIN INX 0000802: INY 0000803: STA IN-5,Y 0000804: LDA IN-5,Y 0000805: BEQ :DONE 0000806: SEC 0000807: SBC #':' 0000808: BEQ :SD ;Reset DATAFLG at stmnt end 0000809: CMP #data-':' 0000810: BNE :REM? 0000811: :SD STA DATAFLG 0000812: :REM? SEC 0000813: SBC #rem-':' 0000814: BNE NXCHR 0000815: STA ENDCHR ;Clear literal flag 0000816: :SFTIN 0000817: DO NEWROMS 0000818: JSR GETUPC 0000819: ELSE 0000820: LDA IN,X 0000821: FIN 0000822: BEQ :PUTIN 0000823: CMP ENDCHR 0000824: BEQ :PUTIN 0000825: :SIN INY 0000826: STA IN-5,Y 0000827: INX 0000828: BNE :SFTIN ;Loop till literal done 0000829: :SKIPTOK LDX TXTPTR 0000830: INC PNTR ;Next token 0000831: :SK LDA (FAC),Y ;Skip over current keyword 0000832: INY 0000833: BNE :OV 0000834: INC FAC+1 0000835: :OV ASL 0000836: BCC :SK ;Loop till keyword skipped 0000837: LDA (FAC),Y 0000838: BNE :LIN ;Loop till keyword table done 0000839: DO NEWROMS 0000840: JSR INUPC 0000841: ELSE 0000842: LDA IN,X ;Not keyword 0000843: FIN 0000844: BPL :PUTTOK ;Always 0000845: :DONE STA IN-3,Y ;EOL in case in direct mode 0000846: DEC TXTPTR+1 ;Point TXTPTR to IN-1 0000847: LDA #$FF 0000848: STA TXTPTR 0000849: RTS 0000850: 0000851: * Search program for line whose # is now in LINNUM. 0000852: * On exit: carry is set if found, clear if not, 0000853: * LOWTR points to line if found, to next one if not. 0000854: 0000855: FNDLIN LDA TXTTAB ;Start search at prog start 0000856: LDX TXTTAB+1 0000857: FL1 LDY #1 ;Start search at A,X 0000858: STA LOWTR 0000859: STX LOWTR+1 0000860: LDA (LOWTR),Y ;Get link high 0000861: BEQ :EOP ;Branch if end of program 0000862: INY 0000863: INY 0000864: LDA LINNUM+1 0000865: CMP (LOWTR),Y ;Compare line # high 0000866: BCC RET3 ;If not found 0000867: BEQ :OV 0000868: DEY 0000869: BNE :GETLNK ;Always - get next line 0000870: :OV LDA LINNUM 0000871: DEY 0000872: CMP (LOWTR),Y ;Line # low 0000873: BCC RET3 ;Past line, not found 0000874: BEQ RET3 ;If found 0000875: :GETLNK DEY 0000876: LDA (LOWTR),Y ;Get next link high 0000877: TAX 0000878: DEY 0000879: LDA (LOWTR),Y ; and low 0000880: BCS FL1 ;Always 0000881: :EOP CLC 0000882: RET3 RTS 0000883: 0000884: NEW BNE RET3 ;Branch if syntax error 0000885: SCRTCH LDA #0 0000886: STA LOCK ;Enable user commands 0000887: TAY 0000888: STA (TXTTAB),Y 0000889: INY 0000890: STA (TXTTAB),Y 0000891: LDA TXTTAB 0000892: ADC #2 ;Carry is indeterminate 0000893: STA VARTAB 0000894: STA PRGEND 0000895: LDA TXTTAB+1 0000896: ADC #0 0000897: STA VARTAB+1 0000898: STA PRGEND+1 0000899: SETPTRS JSR STXTPT 0000900: LDA #0 0000901: CLEAR BNE RET4 0000902: CLEARC TRAY MEMSIZ;FRETOP 0000903: TRAY VARTAB;ARYTAB 0000904: STA STREND 0000905: STY STREND+1 0000906: JSR RESTORE 0000907: STKINI LDX #TEMPST 0000908: STX TEMPPT 0000909: PLA 0000910: TAY 0000911: PLA 0000912: LDX #$F8 ;Keep top of stack for 0000913: TXS ; link and line # 0000914: PHA ; (Could have used $FB here) 0000915: TYA 0000916: PHA 0000917: LDA #0 0000918: STA OLDTEXT+1 ;Defeat CONT 0000919: STA SUBFLG 0000920: RET4 RTS 0000921: 0000922: STXTPT CLC 0000923: AD TXTTAB;#$FF;TXTPTR 0000924: AD TXTTAB+1;#$FF;TXTPTR+1 0000925: RTS 0000926: 0000927: LIST BCC STRTRNG ;Line # specified? 0000928: BEQ STRTRNG ;No 0000929: CMP #minus ;Start range at 0 if so 0000930: BEQ STRTRNG 0000931: CMP #',' 0000932: BNE RET4 0000933: STRTRNG JSR LINGET ;Set LINNUM to start of rng 0000934: JSR FNDLIN ;Point LOWTR to 1st line 0000935: JSR CHRGOT ;Range specified? 0000936: BEQ MAINLST ;Branch if not 0000937: CMP #minus 0000938: BEQ ENDRNG 0000939: CMP #',' 0000940: BNE RET3 0000941: ENDRNG JSR CHRGET ;Update TXTPTR 0000942: JSR LINGET ;Set LINNUM to end rng 0000943: BNE RET4 ;Branch if syntax err 0000944: MAINLST PLA ;Pop rtn adrs 0000945: PLA 0000946: LDA LINNUM 0000947: ORA LINNUM+1 0000948: BNE :NXL 0000949: LDA #$FF ;Max end range 0000950: STA LINNUM 0000951: STA LINNUM+1 0000952: :NXL LDY #1 0000953: LDA (LOWTR),Y ;High byte of link 0000954: BEQ :LISTED 0000955: JSR ISCNTC ;Check for control C 0000956: JSR CRDO 0000957: INY 0000958: LDA (LOWTR),Y ;Get line number 0000959: TAX 0000960: INY 0000961: LDA (LOWTR),Y 0000962: CMP LINNUM+1 0000963: BNE :LSTD 0000964: CPX LINNUM 0000965: BEQ :LST1 0000966: :LSTD BCS :LISTED 0000967: :LST1 STY FORPNT 0000968: DO NEWROMS 0000969: JSR SPCLIN 0000970: ELSE 0000971: JSR LINPRT ;Print X,A 0000972: FIN 0000973: LDA #' ' 0000974: :LL LDY FORPNT 0000975: AND #$7F 0000976: :SNDCHR JSR OUTDO 0000977: DO NEWROMS 0000978: JSR GETCH 0000979: NOP 0000980: ELSE 0000981: LDA CH 0000982: CMP #33 ;If over 33, do CR 0000983: FIN 0000984: BCC :NCR 0000985: JSR CRDO 0000986: LDA #5 ; and tab over 5 0000987: STA CH 0000988: :NCR INY 0000989: LDA (LOWTR),Y 0000990: BNE :TOKEN? 0000991: TAY ;At end of line, get link 0000992: LDA (LOWTR),Y 0000993: TAX 0000994: INY 0000995: LDA (LOWTR),Y 0000996: STX LOWTR ;Point to next line 0000997: STA LOWTR+1 0000998: BNE :NXL 0000999: :LISTED LDA #$D ;CR and out 0001000: JSR OUTDO 0001001: JMP NEWSTT 0001002: 0001003: :GETCHR INY ;Pick up chr from table 0001004: BNE :GC 0001005: INC FAC+1 0001006: :GC LDA (FAC),Y 0001007: RTS 0001008: 0001009: :TOKEN? BPL :SNDCHR ;Branch if not token 0001010: SEC 0001011: SBC #$7F ;Make index to table 0001012: TAX 0001013: STY FORPNT ;Save line pointer 0001014: LDY #TOKTABL-$100 0001015: STY FAC ;Point FAC to table 0001016: LDY #>TOKTABL-$100 0001017: STY FAC+1 0001018: LDY #$FF 0001019: :SKPTK DEX ;Count tokens versa X 0001020: BEQ :PT 0001021: :TOKL JSR :GETCHR 0001022: BPL :TOKL 0001023: BMI :SKPTK 0001024: :PT LDA #' ' ;Token found, send space 0001025: JSR OUTDO 0001026: :TOKLP JSR :GETCHR ; then token 0001027: BMI :TOKDON 0001028: JSR OUTDO 0001029: BNE :TOKLP 0001030: :TOKDON JSR OUTDO ;Send last chr of token 0001031: LDA #' ' ;Send end space 0001032: BNE :LL ;Back to actual line 0001033: 0001034: * FOR places following 18 bytes on stack: 0001035: * TXTPTR 0001036: * Line number 0001037: * TO value (5 byte FP #) 0001038: * STEP sign 0001039: * STEP value (5 byte) 0001040: * FORPNT (pointer to varl) 0001041: * FOR token 0001042: 0001043: FOR LDA #$80 0001044: STA SUBFLG ;Subscripts not allowed 0001045: JSR LET 0001046: JSR GTFORPNT ;Is this FOR varl active? 0001047: BNE FOR2 ;Branch if not 0001048: TXA ;If so, cancel it and 0001049: ADC #$F ; all subsequent ones. 0001050: TAX 0001051: TXS 0001052: FOR2 PLA 0001053: PLA 0001054: LDA #9 0001055: JSR CHKMEM ;Check stack ptr >= $48 0001056: JSR DATAN ;Point to next statement 0001057: CLC ; and push this address. 0001058: TYA 0001059: ADC TXTPTR 0001060: PHA 0001061: LDA TXTPTR+1 0001062: ADC #0 0001063: PHA 0001064: PUSH CURLIN 0001065: LDA #to 0001066: JSR SYNCHR 0001067: JSR CHKNUM 0001068: JSR FRMNUM 0001069: LDA FACSGN 0001070: ORA #$7F 0001071: AND FAC+1 0001072: STA FAC+1 ;Pack FAC 0001073: LDA #STEP ;Set up for return 0001074: LDY #>STEP ; to STEP 0001075: STA INDEX 0001076: STY INDEX+1 0001077: JMP PUSHFAC ;Returns to STEP 0001078: 0001079: * BUG: Note that this TO value has been packed 0001080: * BEFORE it is rounded (by PUSHFAC). This can 0001081: * result in a positive number being converted into 0001082: * a negative one. For example: FOR I=0 TO 2^35-1 0001083: * executes only once! 0001084: 0001085: STEP LDA #ONE ;STEP default=1 0001086: LDY #>ONE 0001087: JSR MOVFM 0001088: JSR CHRGOT 0001089: CMP #step 0001090: BNE ONESTEP 0001091: JSR CHRGET ;Step specified, get it 0001092: JSR FRMNUM 0001093: ONESTEP JSR SIGN 0001094: JSR PSHFACX 0001095: PUSH FORPNT 0001096: LDA #for 0001097: PHA 0001098: NEWSTT TSX ;Execute new statement 0001099: STX REMSTK 0001100: JSR ISCNTC 0001101: LDA TXTPTR 0001102: LDY TXTPTR+1 0001103: LDX CURLIN+1 ;Direct mode 0001104: INX 0001105: BEQ :DIR ;Branch if so 0001106: STA OLDTEXT ;Save TXTPTR if in program 0001107: STY OLDTEXT+1 ; for possible CONT 0001108: :DIR LDY #0 0001109: LDA (TXTPTR),Y ;At eol? 0001110: BNE COLON? ;If not, is it a colon? 0001111: LDY #2 ;If so, is link 0? 0001112: LDA (TXTPTR),Y 0001113: CLC 0001114: BEQ GOEND ;Done if link 0 0001115: INY 0001116: LDA (TXTPTR),Y 0001117: STA CURLIN ;If not done, save line # 0001118: INY 0001119: LDA (TXTPTR),Y 0001120: STA CURLIN+1 0001121: TYA 0001122: BUMP TXTPTR ;And set up txtptr 0001123: TRACE? BIT TRCFLG ;Trace requested? 0001124: BPL EXECUTE ;Branch if not 0001125: LDX CURLIN+1 0001126: INX 0001127: BEQ EXECUTE ;Skip if direct command 0001128: LDA #'#' ;Print "#" 0001129: JSR OUTDO 0001130: LDX CURLIN 0001131: LDA CURLIN+1 0001132: JSR LINPRT ;and the number 0001133: JSR OUTSP 0001134: EXECUTE JSR CHRGET ;Get first chr of statement 0001135: JSR GOCMD ;and start processing 0001136: JMP NEWSTT ;Back for more 0001137: 0001138: GOEND BEQ END4 0001139: GOCMD BEQ RET5 0001140: GOCMD2 SBC #$80 ;A token? 0001141: BCC :NOTOK ;Branch if not 0001142: CMP #$40 ;"Routine" type token? 0001143: BCS JSY ;Syntax error if not 0001144: ASL ;If a routine token, 0001145: TAY ;then place routine address 0001146: LDA CMDTABL+1,Y 0001147: PHA ;on stack, 0001148: LDA CMDTABL,Y 0001149: PHA 0001150: JMP CHRGET ;Get next chr & RTS to routine. 0001151: :NOTOK JMP LET ;Must be a variable assignment 0001152: COLON? CMP #':' 0001153: BEQ TRACE? 0001154: JSY JMP SYNERR 0001155: 0001156: RESTORE SEC 0001157: LDA TXTTAB 0001158: SBC #1 0001159: LDY TXTTAB+1 0001160: BCS SETDA 0001161: DEY 0001162: SETDA STA DATPTR 0001163: STY DATPTR+1 0001164: RET5 RTS 0001165: 0001166: ISCNTC LDA KEY 0001167: CMP #$83 0001168: BEQ :GK 0001169: RTS 0001170: :GK JSR INCHR 0001171: ERFLG? LDX #$FF ;Control C attempted 0001172: BIT ERRFLG 0001173: BPL :CTRC 0001174: JMP HANDLERR 0001175: :CTRC CMP #3 0001176: 0001177: STOP BCS END2 0001178: 0001179: END CLC 0001180: END2 BNE RET6 0001181: LDA TXTPTR 0001182: LDY TXTPTR+1 0001183: LDX CURLIN+1 ;Direct mode? 0001184: INX 0001185: BEQ END3 ;Branch if so 0001186: STA OLDTEXT 0001187: STY OLDTEXT+1 0001188: TRAY CURLIN;OLDLIN 0001189: END3 PLA 0001190: PLA 0001191: END4 LDA #BREAKIN 0001192: LDY #>BREAKIN 0001193: BCC GOSTART 0001194: JMP PRNTIN? 0001195: GOSTART JMP RESTART 0001196: 0001197: CONT BNE RET6 0001198: LDX #CANTCON-ERRMSG 0001199: LDY OLDTEXT+1 0001200: BNE :C 0001201: JMP ERROR 0001202: :C LDA OLDTEXT 0001203: STA TXTPTR 0001204: STY TXTPTR+1 0001205: TRAY OLDLIN;CURLIN 0001206: RET6 RTS 0001207: 0001208: DO APPLEC 0001209: 0001210: GETUPC0 LDA IN+1,X 0001211: BPL CNVUPC ;Always 0001212: GETUPC LDA ENDCHR 0001213: BEQ NOCNV ;Don't convert if REM 0001214: CMP #'"' 0001215: BEQ NOCNV ; or literal 0001216: LDA DATAFLG 0001217: CMP #data-':' 0001218: BEQ NOCNV ; or DATA 0001219: INUPC LDA IN,X 0001220: CNVUPC PHP 0001221: CMP #'a' 0001222: BLT :PP 0001223: AND #%01011111 ;Convert to upper case 0001224: :PP PLP 0001225: RTS 0001226: NOCNV LDA IN,X 0001227: RTS 0001228: 0001229: SPCLIN PHA 0001230: LDA #' ' 0001231: JSR OUTDO ;Precede line # with space 0001232: PLA ; to ease editing 0001233: JMP LINPRT 0001234: 0001235: GETCH LDA CH 0001236: CMP #40-7 0001237: BIT RD80COL ;80 col mode? 0001238: BPL :X ;Exit if not 0001239: LDA OURCH 0001240: CMP #80-7 0001241: :X RTS 0001242: 0001243: GRPATCH LDA TXTCLR 0001244: JSR GRCLEAR 0001245: LDA #20 0001246: JMP SETWND ;Set mixed mode 0001247: 0001248: GRCLEAR LDY #39 0001249: STY V2 0001250: JSR IS80 ;Double gr enabled? 0001251: LDA #39 0001252: BCC :N80 ;Branch if 40 col 0001253: ROL ;Times 2 0001254: :N80 TAY 0001255: :CLR LDA #0 ;Clear lores screen 0001256: STA HMASK 0001257: JSR NEWVLIN1 0001258: DEY 0001259: BPL :CLR 0001260: RTS 0001261: ERR \$D912 0001262: DS $D912-* ;Fill with 0's 0001263: 0001264: ELSE 0001265: 0001266: SAVE SUB PRGEND;TXTTAB;LINNUM 0001267: JSR VARTIO 0001268: JSR WRITE 0001269: JSR PROGIO 0001270: JMP WRITE 0001271: LOAD JSR VARTIO 0001272: JSR MONREAD 0001273: ADD TXTTAB;LINNUM;VARTAB 0001274: MOV TEMPPT;LOCK 0001275: JSR PROGIO 0001276: JSR MONREAD 0001277: BIT LOCK ;If neg byte read from tape 0001278: BPL :LNK 0001279: JMP SETPTRS ; then do auto run 0001280: :LNK JMP LINKSET 0001281: 0001282: VARTIO LDA #LINNUM 0001283: LDY #0 0001284: STA A1L 0001285: STY A1H 0001286: LDA #TEMPPT 0001287: STA A2L 0001288: STY A2H 0001289: STY LOCK 0001290: RTS 0001291: 0001292: PROGIO TRAY TXTTAB;A1L 0001293: TRAY VARTAB;A2L 0001294: RTS 0001295: 0001296: FIN 0001297: 0001298: RUN PHP 0001299: DEC CURLIN+1 0001300: PLP 0001301: BNE :RUNLIN ;Branch if line given 0001302: JMP SETPTRS ;"Specify" program start 0001303: :RUNLIN JSR CLEARC ;Clear varls 0001304: JMP GOLINE ;Go to line specified 0001305: 0001306: * GOSUB leaves following on stack: 0001307: * Return address (NEWSTT) 0001308: * TXTPTR 0001309: * line number 0001310: * GOSUB token 0001311: 0001312: GOSUB LDA #3 0001313: JSR CHKMEM ;Check stack ptr >= $3C 0001314: PUSH TXTPTR 0001315: PUSH CURLIN 0001316: LDA #gosub 0001317: PHA 0001318: GOLINE JSR CHRGOT 0001319: JSR GOTO 0001320: JMP NEWSTT 0001321: 0001322: GOTO JSR LINGET ;Get GOTO line 0001323: JSR REMN ;Point Y to eol 0001324: LDA CURLIN+1 ;Is current page < GOTO page? 0001325: CMP LINNUM+1 0001326: BCS :G1 ;Search from prog start if not 0001327: TYA ;Otherwise search from next line 0001328: SEC 0001329: ADC TXTPTR 0001330: LDX TXTPTR+1 0001331: BCC :G2 0001332: INX 0001333: BCS :G2 0001334: :G1 LDA TXTTAB ;Get program beginning 0001335: LDX TXTTAB+1 0001336: :G2 JSR FL1 ;Search for GOTO line 0001337: BCC UNDERR ;Error if not there 0001338: ;Point TXTPTR to GOTO line 0001339: SB LOWTR;#1;TXTPTR 0001340: SB LOWTR+1;#0;TXTPTR+1 0001341: RET7 RTS ;Return to NEWSTT or GOSUB 0001342: 0001343: POP BNE RET7 0001344: LDA #$FF 0001345: STA FORPNT ;Bug: should be FORPNT+1 0001346: JSR GTFORPNT ;To cancel FOR/NEXT in sub 0001347: TXS 0001348: CMP #gosub ;Last GOSUB found? 0001349: BEQ RETURN 0001350: LDX #RTNwoGSB-ERRMSG 0001351: HEX 2C ;Trick to skip next line 0001352: UNDERR LDX #UNDSTAT-ERRMSG 0001353: JMP ERROR 0001354: 0001355: GSYNER JMP SYNERR 0001356: 0001357: RETURN PLA 0001358: PLA 0001359: CPY #pop*2 0001360: BEQ PULL3 ;Branch if a POP 0001361: STA CURLIN ;Retrieve line # 0001362: PLA 0001363: STA CURLIN+1 0001364: PULL TXTPTR ;and TXTPTR 0001365: DATA JSR DATAN ;Move to next statement 0001366: ADDON TYA 0001367: CLC 0001368: BUMP TXTPTR 0001369: RET8 RTS 0001370: 0001371: DATAN LDX #':' ;Get offset in Y to eol or ":" 0001372: HEX 2C ;Trick to skip next line 0001373: REMN LDX #0 ; " to eol only. 0001374: STX CHARAC 0001375: LDY #0 0001376: STY ENDCHR 0001377: :R1 LDA ENDCHR ;Trick to count quote parity 0001378: LDX CHARAC 0001379: STA CHARAC 0001380: STX ENDCHR 0001381: :R2 LDA (TXTPTR),Y 0001382: BEQ RET8 ;If eol or 0001383: CMP ENDCHR ; specified endchr 0001384: BEQ RET8 ; then exit with Y=offset 0001385: INY 0001386: CMP #'"' 0001387: BNE :R2 ;If not quote then continue 0001388: BEQ :R1 ;Switch parity & continue 0001389: 0001390: PULL3 PLA 0001391: PLA 0001392: PLA 0001393: RTS 0001394: 0001395: IF JSR FRMEVL 0001396: JSR CHRGOT 0001397: CMP #goto 0001398: BEQ TRUE? 0001399: LDA #then 0001400: JSR SYNCHR 0001401: TRUE? LDA FAC ;Condition true or false? 0001402: BNE IFTRUE ;Branch if true 0001403: REM JSR REMN ;Skip rest of line 0001404: BEQ ADDON ;Always taken 0001405: 0001406: IFTRUE JSR CHRGOT ;Command or number? 0001407: BCS JGOCMD ;Branch if command 0001408: JMP GOTO ;Go if # 0001409: JGOCMD JMP GOCMD ;Act on command 0001410: 0001411: ONGOTO JSR GETBYT ;Get specified # in FAC+4 0001412: PHA 0001413: CMP #gosub 0001414: BEQ ONCNT 0001415: GOTO? CMP #goto 0001416: BNE GSYNER 0001417: ONCNT DEC FAC+4 ;Counted to right one yet? 0001418: BNE :NXN ;No, keep looking 0001419: PLA ;Yes, retrieve cmd 0001420: JMP GOCMD2 ;and go. 0001421: :NXN JSR CHRGET 0001422: JSR LINGET 0001423: CMP #',' 0001424: BEQ ONCNT 0001425: PLA ;Not found, so ignore 0001426: RET9 RTS 0001427: 0001428: LINGET LDX #0 ;ASC # to HEX address 0001429: STX LINNUM ;in LINNUM. 0001430: STX LINNUM+1 0001431: ASCHEX BCS RET9 ;Exit routine on 1st non # 0001432: SBC #'0'-1 0001433: STA CHARAC 0001434: LDA LINNUM+1 0001435: STA INDEX 0001436: CMP #$FA/10 ;Line # too large? 0001437: BCS GOTO? ;Get error if so. 0001438: ;(Note that GOTO xxxxxy 0001439: ; where xxxxx is between 0001440: ; 43776 and 44031 causes 0001441: ; a jump to $22DA. GOSUBs etc 0001442: ; jump to other locations.) 0001443: LDA LINNUM 0001444: LUP 2 0001445: ASL 0001446: ROL INDEX 0001447: --^ 0001448: ADC LINNUM 0001449: STA LINNUM 0001450: AD INDEX;LINNUM+1;LINNUM+1 0001451: ASL LINNUM ;Previous # times 10 0001452: ROL LINNUM+1 0001453: AD LINNUM;CHARAC;LINNUM 0001454: BCC NXDIG 0001455: INC LINNUM+1 ; plus new digit 0001456: NXDIG JSR CHRGET 0001457: JMP ASCHEX 0001458: 0001459: LET JSR PTRGET 0001460: STA FORPNT 0001461: STY FORPNT+1 0001462: LDA #equal 0001463: JSR SYNCHR 0001464: PUSH VALTYP 0001465: JSR FRMEVL 0001466: PLA 0001467: ROL ;Rot VALTYP sign to carry 0001468: JSR CHKVAL 0001469: BNE LETSTR ;If a string 0001470: PLA 0001471: LET2 BPL LETREAL 0001472: JSR RNDB ;Integer var 0001473: JSR AYINT 0001474: LDY #0 0001475: LDA VPNT 0001476: STA (FORPNT),Y 0001477: INY 0001478: LDA VPNT+1 0001479: STA (FORPNT),Y 0001480: RTS 0001481: LETREAL JMP SETFOR 0001482: LETSTR PLA 0001483: PUTSTR LDY #2 0001484: LDA (VPNT),Y 0001485: CMP FRETOP+1 0001486: BCC :COPS ;Branch if not in str space 0001487: BNE :DSC 0001488: DEY 0001489: LDA (VPNT),Y 0001490: CMP FRETOP 0001491: BCC :COPS 0001492: :DSC LDY VPNT+1 ;Descriptor exist? 0001493: CPY VARTAB+1 0001494: BCC :COPS ;Copy if so 0001495: BNE :NEWDSC 0001496: LDA VPNT 0001497: CMP VARTAB 0001498: BCS :NEWDSC 0001499: :COPS LDA VPNT ;Just copy descriptor 0001500: LDY VPNT+1 0001501: JMP COPY 0001502: :NEWDSC LDY #0 ;Make new descriptor 0001503: LDA (VPNT),Y 0001504: JSR STRINI 0001505: TRAY DSCPTR;STRNG1 0001506: JSR MOVINS 0001507: LDA #FAC 0001508: LDY #0 0001509: COPY STA DSCPTR 0001510: STY DSCPTR+1 0001511: JSR FRETMS 0001512: LDY #0 0001513: LUP 2 0001514: LDA (DSCPTR),Y 0001515: STA (FORPNT),Y 0001516: INY 0001517: --^ 0001518: LDA (DSCPTR),Y 0001519: STA (FORPNT),Y 0001520: RTS 0001521: 0001522: PRSTRING JSR STRPRT 0001523: JSR CHRGOT 0001524: PRINT BEQ CRDO ;Branch if end of statement 0001525: PRINT2 BEQ RET10 0001526: CMP #tab 0001527: BEQ TABWHERE 0001528: CMP #spc 0001529: CLC 0001530: BEQ TABWHERE 0001531: CMP #',' 0001532: CLC ;No purpose to this 0001533: BEQ TAB 0001534: CMP #';' 0001535: BEQ NEXTCHR 0001536: JSR FRMEVL ;Evalute formula 0001537: BIT VALTYP 0001538: BMI PRSTRING ;Branch if string 0001539: JSR FOUT ;Convert # in FAC to string 0001540: JSR STRLIT ;Create temp descriptor 0001541: JMP PRSTRING ;Print it 0001542: 0001543: CRDO LDA #$D 0001544: JSR OUTDO 0001545: NEGATE EOR #$FF 0001546: RET10 RTS 0001547: 0001548: TAB 0001549: DO NEWROMS 0001550: JSR GETCH 0001551: BMI :NXC ;Branch if 80 col & 0001552: ; not near edge 0001553: ELSE 0001554: LDA CH 0001555: FIN 0001556: CMP #$18 ;This should be $20 (bug) 0001557: BCC :NXC 0001558: JSR CRDO 0001559: BNE NEXTCHR ;Always 0001560: :NXC ADC #$10 0001561: AND #$F0 ;Tabs 16, 32 0001562: DO NEWROMS 0001563: TAX 0001564: SEC 0001565: BCS SBCH 0001566: ELSE 0001567: STA CH 0001568: BCC NEXTCHR ;Always 0001569: FIN 0001570: 0001571: TABWHERE PHP ;Remember SPC or TAB 0001572: JSR GTBYTC 0001573: CMP #')' 0001574: DO NEWROMS 0001575: BNE JSYNER 0001576: ELSE 0001577: BEQ :SPC? 0001578: JMP SYNERR 0001579: FIN ;Addresses now normal 0001580: :SPC? PLP 0001581: BCC TABIT ;Branch if SPC 0001582: DEX 0001583: DO NEWROMS 0001584: SBCH JSR SUBCH 0001585: ELSE 0001586: TXA 0001587: SBC CH ;Compute # of spcs to send 0001588: FIN 0001589: BCC NEXTCHR ;Branch if negative 0001590: TAX 0001591: TABIT INX 0001592: NXSPC DEX 0001593: BNE DOSPC 0001594: NEXTCHR JSR CHRGET ;Check for end of statement 0001595: JMP PRINT2 0001596: DOSPC JSR OUTSP 0001597: BNE NXSPC ;Always 0001598: 0001599: STROUT JSR STRLIT ;Print string at (A,Y) 0001600: STRPRT JSR FREFAC ;Get pointer to string 0001601: TAX ;Length 0001602: LDY #0 0001603: INX 0001604: NXCHAR DEX 0001605: BEQ RET10 ;Exit if string done 0001606: LDA (INDEX),Y 0001607: JSR OUTDO 0001608: INY 0001609: CMP #$D 0001610: BNE NXCHAR 0001611: JSR NEGATE ;Why? 0001612: JMP NXCHAR 0001613: 0001614: * Note: POKE 243,32 ($20 in $F3) will convert 0001615: * output to lower case. This can be cancelled 0001616: * by NORMAL, INVERSE, or FLASH or POKE 243,0. 0001617: 0001618: OUTSP LDA #' ' 0001619: HEX 2C ;Trick to skip next line 0001620: OUTQUES LDA #'?' 0001621: OUTDO ORA #$80 0001622: CMP #" " ;Control chr? 0001623: BLT :OV ;Skip if so 0001624: ORA ORMASK ;Convert to flash or no change 0001625: :OV JSR COUT 0001626: AND #$7F 0001627: PHA 0001628: LDA SPEEDZ 0001629: JSR MONWAIT 0001630: PLA 0001631: RTS 0001632: 0001633: INPUTERR LDA INPUTFLG 0001634: BEQ RESPERR ;Taken if INPUT 0001635: BMI READERR ;Taken if READ 0001636: LDY #$FF ;From a GET 0001637: BNE ERLIN 0001638: READERR LDA DATLIN 0001639: LDY DATLIN+1 0001640: ERLIN STA CURLIN 0001641: STY CURLIN+1 0001642: JSYNER JMP SYNERR 0001643: INPERR PLA 0001644: RESPERR BIT ERRFLG 0001645: BPL DOREENT 0001646: LDX #$FE ;Bad responce 0001647: JMP HANDLERR 0001648: DOREENT LDA #REENT 0001649: LDY #>REENT 0001650: JSR STROUT 0001651: TRAY OLDTEXT;TXTPTR 0001652: RTS 0001653: 0001654: GET JSR ERRDIR 0001655: LDX #IN+1 ;Simulate input 0001656: LDY #>IN+1 0001657: LDA #0 0001658: STA IN+1 0001659: LDA #$40 ;Set up INPUTFLG 0001660: JSR MAININP 0001661: RTS 0001662: 0001663: INPUT CMP #'"' ;Check for optional 0001664: BNE QOUT ;input string. 0001665: JSR STRTXT 0001666: LDA #';' 0001667: JSR SYNCHR 0001668: JSR STRPRT 0001669: JMP DIR? 0001670: QOUT JSR OUTQUES ;No string, print "?" 0001671: DIR? JSR ERRDIR 0001672: LDA #',' 0001673: STA IN-1 0001674: JSR INLIN 0001675: LDA IN 0001676: CMP #3 ;Control C? 0001677: BNE ZF 0001678: JMP ERFLG? 0001679: 0001680: NXIN JSR OUTQUES 0001681: JMP INLIN 0001682: READ LDX DATPTR 0001683: LDY DATPTR+1 0001684: LDA #$98 0001685: HEX 2C ;Trick to branch to MAININP 0001686: ZF LDA #0 0001687: MAININP STA INPUTFLG 0001688: STX INPTR 0001689: STY INPTR+1 0001690: NXINP JSR PTRGET 0001691: STA FORPNT 0001692: STY FORPNT+1 0001693: TRAY TXTPTR;TXPSV 0001694: TRXY INPTR;TXTPTR 0001695: JSR CHRGOT 0001696: BNE INSTART 0001697: BIT INPUTFLG 0001698: BVC SNDQ? ;Branch if not GET 0001699: JSR RDKEY ;GET it 0001700: AND #$7F 0001701: STA IN 0001702: LDX #IN-1 0001703: LDY #>IN-1 0001704: BNE STXP 0001705: 0001706: SNDQ? BMI FINDATA 0001707: JSR OUTQUES 0001708: JSR NXIN 0001709: STXP STX TXTPTR 0001710: STY TXTPTR+1 0001711: INSTART JSR CHRGET 0001712: BIT VALTYP 0001713: BPL NUMIN 0001714: BIT INPUTFLG 0001715: BVC PUTCHR ;Branch if not GET 0001716: INX 0001717: STX TXTPTR 0001718: LDA #0 0001719: STA CHARAC 0001720: BEQ PENCHR 0001721: PUTCHR STA CHARAC 0001722: CMP #'"' 0001723: BEQ PECHR 0001724: LDA #':' 0001725: STA CHARAC 0001726: LDA #',' 0001727: PENCHR CLC 0001728: PECHR STA ENDCHR 0001729: LDA TXTPTR 0001730: LDY TXTPTR+1 0001731: ADC #0 ;Skip quote, if there 0001732: BCC :OV 0001733: INY 0001734: :OV JSR STRLT2 0001735: JSR POINT 0001736: JSR PUTSTR 0001737: JMP WNX 0001738: NUMIN PHA 0001739: LDA IN ;From DATA? 0001740: BEQ INPFIN ;Branch if so 0001741: DATIN PLA 0001742: JSR FIN ;Get FP number at TXTPNT 0001743: LDA INTFLG 0001744: JSR LET2 ;Put in varl 0001745: WNX JSR CHRGOT 0001746: BEQ SWPNT ;Branch if input done? 0001747: CMP #',' ;Comma in input? 0001748: BEQ SWPNT 0001749: JMP INPUTERR ;Nothing else will do 0001750: SWPNT TRAY TXTPTR;INPTR 0001751: TRAY TXPSV;TXTPTR 0001752: JSR CHRGOT 0001753: BEQ INPDONE ;If statement not done 0001754: JSR CHKCOM ; program must have comma. 0001755: JMP NXINP ;Get next input 0001756: INPFIN LDA INPUTFLG 0001757: BNE DATIN 0001758: JMP INPERR 0001759: 0001760: FINDATA JSR DATAN ;Get offset to next statement 0001761: INY 0001762: TAX ;End of line? 0001763: BNE NXS ;Branch if ":" 0001764: LDX #OofDATA-ERRMSG 0001765: INY 0001766: LDA (TXTPTR),Y ;End of program? 0001767: BEQ GERR ;Error if so 0001768: INY 0001769: LDA (TXTPTR),Y ;Get next line # 0001770: STA DATLIN 0001771: INY 0001772: LDA (TXTPTR),Y 0001773: INY 0001774: STA DATLIN+1 0001775: NXS LDA (TXTPTR),Y ;Get 1st token of statement 0001776: TAX 0001777: JSR ADDON ;Update TXTPTR 0001778: CPX #data 0001779: BNE FINDATA ;Loop till DATA found 0001780: JMP INSTART ;Found DATA token 0001781: INPDONE LDA INPTR ;No more input requested 0001782: LDY INPTR+1 0001783: LDX INPUTFLG 0001784: BPL :OV 0001785: JMP SETDA ;If from DATA 0001786: :OV LDY #0 0001787: LDA (INPTR),Y ;Extra input? 0001788: BEQ RET11 0001789: LDA #EXIG ;Error if so 0001790: LDY #>EXIG 0001791: JMP STROUT 0001792: RET11 RTS 0001793: 0001794: EXIG ASC '?EXTRA IGNORED'0D00 0001795: 0001796: REENT ASC '?REENTER'0D00 0001797: 0001798: NEXT BNE VARNXT ;Branch if var specified 0001799: LDY #0 0001800: BEQ SKPV 0001801: VARNXT JSR PTRGET ;Find var pointer 0001802: SKPV STA FORPNT 0001803: STY FORPNT+1 0001804: JSR GTFORPNT ;Find FOR data on stack 0001805: BEQ GOTFOR 0001806: LDX #NXwoFOR-ERRMSG 0001807: GERR BEQ JERROR ;Always 0001808: GOTFOR TXS ;Set stack ptr to point 0001809: ; at FOR data. 0001810: LUP 4 0001811: INX 0001812: --^ 0001813: TXA ;Low byte of adrs of STEP value 0001814: LUP 6 0001815: INX 0001816: --^ 0001817: STX DEST ;Low byte adrs of TO value 0001818: LDY #1 0001819: JSR MOVFM ;STEP to FAC 0001820: TSX 0001821: LDA STACK+9,X 0001822: STA FACSGN ;-1,0,1 as STEP -,0,+ 0001823: LDA FORPNT 0001824: LDY FORPNT+1 0001825: JSR FADD ;Add to FOR value 0001826: JSR SETFOR ;Put new value back 0001827: LDY #1 0001828: JSR FCOMP2 ;Compare to end value 0001829: TSX 0001830: SEC ;A=1,0,-1 as TO <=> current 0001831: SBC STACK+9,X ; FOR variable 0001832: BEQ ENDFOR ;Branch if FOR complete 0001833: LDA STACK+$F,X ;Otherwise set up 0001834: STA CURLIN ; FOR line # 0001835: LDA STACK+$10,X 0001836: STA CURLIN+1 0001837: LDA STACK+$12,X ; and set TXTPTR to just 0001838: STA TXTPTR ; after FOR statement 0001839: LDA STACK+$11,X 0001840: STA TXTPTR+1 0001841: GONEWST JMP NEWSTT 0001842: ENDFOR TXA 0001843: ADC #$11 ;Carry is set 0001844: TAX ;Cancel FOR by bumping 0001845: TXS ; stack pointer by $12. 0001846: JSR CHRGOT 0001847: CMP #',' ;Another var in NEXT? 0001848: BNE GONEWST 0001849: JSR CHRGET 0001850: JSR VARNXT ;Does not return