,,, * ,,, ; OPT NOL ,,, * ,,, HC11 EQU 1 ,,, * ,,, #Include 'DEFINES.Asm' ,,, * title DEFINES ,,, ,,, $IFDEF HC11 ,,, ,,, */***** HC11EVB defines *****/ ,,, ,,, ROMBEG: EQU $E000 ,,, ROMSIZE: EQU $2000 ,,, ACIAST: EQU $9800 ,,, ACIADT: EQU ACIAST+1 ,,, DFLOP: EQU $4000 ,,, SWPRE: EQU 02 ; SOFTWARE PRESCALER VALUE. ,,, * ,,, * ,,, * ,,, SBASBEG: equ 0 ,,, SBASEND: equ 2 ,,, SVARBEG: equ 4 ,,, SVAREND: equ 6 ,,, SHILINE: equ 8 ,,, AUTOSTF: equ 10 ,,, SSTART: equ 11 ,,, ,,, $ENDIF ,,, ,,, */***** hc11 (device dependant) defines *****/ ,,, ,,, EEPBASAD: EQU $B600 ; /* EEPROM base address */ ,,, MAXEESUB: EQU 255 ; /* maximum EEP subscript */ ,,, * ,,, * I/O Register Offsets From The Base Address ,,, * ,,, PPROG: EQU $3B ; /* EEPROM programing control register */ ,,, ADCTL: EQU $30 ; /* A-TO-D control/status register */ ,,, ADR1: EQU $31 ; /* A/D result register 1 */ ,,, ADR2: EQU $32 ; /* A/D result register 2 */ ,,, ADR3: EQU $33 ; /* A/D result register 3 */ ,,, ADR4: EQU $34 ; /* A/D result register 4 */ ,,, PORTAIO: EQU $00 ; /* PORTA I/O register */ ,,, PORTBIO: EQU $04 ; /* PORTB I/O register */ ,,, PORTCIO: EQU $03 ; /* PORTC I/O register */ ,,, DDRC: EQU $07 ; Portc direction register ,,, PORTDIO: EQU $08 ; /* PORTD I/O register */ ,,, PORTEIO: EQU $0A ; /* PORTE I/O register */ ,,, TCNT: EQU $0E ; /* TIMER/COUNTER register */ ,,, TOC1REG: EQU $16 ; /* TIMER Output Compare 1 register */ ,,, TFLAG1: EQU $23 ; /* TIMER Flag #1 register */ ,,, TMSK1: EQU $22 ; /* TIMER Mask #1 register */ ,,, TMSK2: EQU $24 ; /* TIMER Mask #2 register */ ,,, OPTION: EQU $39 ; /* OPTION select register */ ,,, BAUD: EQU $2B ; /* SCI baud rate select register */ ,,, SCCR1: EQU $2C ; /* SCI control register #1 */ ,,, SCCR2: EQU $2D ; /* SCI control register #2 */ ,,, SCSR: EQU $2E ; /* SCI status register */ ,,, SCDR: EQU $2F ; /* SCI transmit/recieve data register */ ,,, PACNT: EQU $27 ; /* PACC count register */ ,,, PACTL: EQU $26 ; /* PACC control register */ ,,, TFLG2: EQU $25 ; /* TIMER Flag #2 register */ ,,, INIT: EQU $3D ; /* INIT (Base address of RAM & I/O Regs) Register */ ,,, ,,, */***** misc. defines *****/ ,,, ,,, EOL: EQU 13 ; /* end of line marker */ ,,, CR: EQU 13 ; /* same as EOL */ ,,, LF: EQU 10 ; /* linefeed character */ ,,, BS: EQU 8 ; /* backspace character */ ,,, SPC: EQU 32 ; /* space character */ ,,, MIDEOL: EQU ':' ; /* mid EOL character */ ,,, COMMA: EQU ',' ; /* comma */ ,,, SEMI: EQU ';' ; /* semicolin */ ,,, NUM: EQU 1 ; /* getvar return flag */ ,,, STRING: EQU 2 ; /* getvar return flag */ ,,, NULL: EQU 0 ; /* null value */ ,,, CNTRLC: EQU 3 ; /* control-c (break character) */ ,,, * ,,, * ,,, IBUFLEN: EQU 80 ; /* input buffer max length */ ,,, TBUFLEN: EQU 128 ; /* token buffer max length */ ,,, SWSTKSize: EQU 592 ,,, * ,,, OPSLEN: EQU 30 ; /* operator stack length */ ,,, NUMSLEN: EQU 60 ; /* operand stack length */ ,,, FORSLEN: EQU 80 ; /* FOR..NEXT stack length */ ,,, WHSLEN: EQU 16 ; /* WHILE..ENDWH stack length */ ,,, GOSLEN: EQU 16 ; /* GOSUB stack length */ ,,, * ,,, */***** define error codes *****/ ,,, ,,, LINRANG: EQU 1 ; /* line number range error */ ,,, SYTXERR: EQU 2 ; /* syntax error */ ,,, IVEXPERR: EQU 3 ; /* invalid expression error */ ,,, UPARNERR: EQU 4 ; /* unbalanced parentheses error */ ,,, DTMISERR: EQU 5 ; /* data type mismatch error */ ,,, OPRTRERR: EQU 6 ; /* illegal operator error */ ,,, ILVARERR: EQU 7 ; /* illegal variable error */ ,,, ILTOKERR: EQU 8 ; /* illegal token error */ ,,, OMEMERR: EQU 9 ; /* out of memory error */ ,,, INTOVERR: EQU 10 ; /* integer overflow error */ ,,, IVHEXERR: EQU 11 ; /* invalid hex digit error */ ,,, HEXOVERR: EQU 12 ; /* hex number overflow */ ,,, MISQUERR: EQU 13 ; /* missing quote error */ ,,, MPARNERR: EQU 14 ; /* missing open or closing parenthisis */ ,,, IONSYERR: EQU 15 ; /* "ON" syntax error */ ,,, MTHENERR: EQU 16 ; /* missing "THEN" in "IF" statement */ ,,, MTOERR: EQU 17 ; /* missing "TO" in "FOR" statement */ ,,, LINENERR: EQU 18 ; /* line number error */ ,,, IDTYERR: EQU 19 ; /* illegal data type error */ ,,, EXPCXERR: EQU 20 ; /* expression too complex (xlator token buff ovf.) */ ,,, MCOMAERR: EQU 21 ; /* missing comma */ ,,, MCMSMERR: EQU 22 ; /* missing comma or semicolin */ ,,, MSTKOERR: EQU 23 ; /* math stack overflow error */ ,,, UNDIMERR: EQU 24 ; /* undimentioned array error */ ,,, SUBORERR: EQU 25 ; /* subscript out of range error */ ,,, ZDIVERR: EQU 26 ; /* divide by zero error */ ,,, LNFERR: EQU 27 ; /* line not found error */ ,,, GOSOVERR: EQU 28 ; /* too many nested GOSUB's */ ,,, RWOGERR: EQU 29 ; /* RETURN w/o GOSUB error */ ,,, WHSOVERR: EQU 30 ; /* too many active WHILE's */ ,,, ENDWHERR: EQU 31 ; /* ENDWH statement w/o WHILE */ ,,, ONARGERR: EQU 32 ; /* ON argument is negative, zero, or too large */ ,,, NOSUBERR: EQU 33 ; /* non-subscriptable variable found in DIM statem. */ ,,, REDIMERR: EQU 34 ; /* variable has already been DIMensioned */ ,,, FORNXERR: EQU 35 ; /* too many active FOR -- NEXT loops active */ ,,, MFRNXERR: EQU 36 ; /* mismatched FOR -- NEXT statements. */ ,,, CNTCNERR: EQU 37 ; /* can't continue */ ,,, ODRDERR: EQU 38 ; /* out of data in read or restore statement */ ,,, NEGSUBER: EQU 39 ; /* negative subscripts not allowed */ ,,, EESUBERR: EQU 40 ; /* EEP() subscript negative or > 200 */ ,,, PRFUNERR: EQU 41 ; /* function only allowed in print statement */ ,,, TABARGER: EQU 42 ; /* argument <0 or >255 in TAB() function */ ,,, CHRARGER: EQU 43 ; /* argument <0 or >255 in CHR$() function */ ,,, OVDV0ERR: EQU 44 ; /* overflow or /0 error in FDIV() function */ ,,, INVCHERR: EQU 45 ; /* invalid channel number in ADC() function */ ,,, PRTASERR: EQU 46 ; /* tried to assign a value <0 or >255 to PORT(X) */ ,,, ILPRTERR: EQU 47 ; /* illegal port error */ ,,, ILLIOERR: EQU 48 ; /* illegal I/O vector number <0 or >7 */ ,,, UNINIERR: EQU 49 ; /* uninitalized I/O vector */ ,,, HEX2AERR: EQU 50 ; /* argument <0 or >255 in HEX2 function */ ,,, NOTALERR: EQU 51 ; /* statement not allowed in direct mode */ ,,, NOTINTER: EQU 52 ; /* an RETI statement executed when not in interrupt */ ,,, PACCARGE: EQU 53 ; /* tried to assign a value of <0 or >255 to PACC */ ,,, INTMODER: EQU 54 ; /* interrupt or count mode error in ONPACC */ ,,, EETOSMAL: EQU 55 ; /* program storage EEPROM is Too Small */ ,,, ,,, */* mathematical operator tokens */ ,,, ,,, OPARNTOK: EQU $10 ; /* '(' */ ,,, CPARNTOK: EQU $11 ; /* ')' */ ,,, ANDTOK: EQU $20 ; /* 'AND' */ ,,, ORTOK: EQU $21 ; /* 'OR' */ ,,, EORTOK: EQU $22 ; /* 'EOR' */ ,,, LTTOK: EQU $30 ; /* '<' */ ,,, GTTOK: EQU $31 ; /* '> */ ,,, LTEQTOK: EQU $32 ; /* '<=' */ ,,, GTEQTOK: EQU $33 ; /* '>=' */ ,,, EQTOK: EQU $34 ; /* '=' */ ,,, NOTEQTOK: EQU $35 ; /* '<>' */ ,,, PLUSTOK: EQU $40 ; /* '+' */ ,,, MINUSTOK: EQU $41 ; /* '-' */ ,,, SPLUSTOK: EQU $42 ; /* '+' */ ,,, MULTTOK: EQU $50 ; /* '*' */ ,,, DIVTOK: EQU $51 ; /* '/' */ ,,, MODTOK: EQU $52 ; /* '%' */ ,,, PWRTOK: EQU $60 ; /* '^' */ ,,, INDIRTOK: EQU $70 ; /* '@' */ ,,, NOTTOK: EQU $71 ; /* 'NOT' */ ,,, NEGTOK: EQU $72 ; /* '-' (uniary minus) */ ,,, ,,, */* keyword tokens */ ,,, ,,, LETTOK: EQU $01 ; /* LET */ ,,, IMLETTOK: EQU $02 ; /* implied LET */ ,,, PRINTTOK: EQU $03 ; /* PRINT */ ,,, FORTOK: EQU $04 ; /* FOR */ ,,, NEXTTOK: EQU $05 ; /* NEXT */ ,,, TRONTOK: EQU $06 ; /* TRON */ ,,, TROFFTOK: EQU $07 ; /* TROFF */ ,,, POKETOK: EQU $08 ; /* POKE */ ,,, DIMTOK: EQU $09 ; /* DIM */ ,,, REMTOK: EQU $0A ; /* REM */ ,,, PACCTOK: EQU $0B ; /* PACC */ ,,, DATATOK: EQU $0C ; /* DATA */ ,,, READTOK: EQU $0D ; /* READ */ ,,, RESTRTOK: EQU $0E ; /* RESTORE */ ,,, GOSUBTOK: EQU $0F ; /* GOSUB */ ,,, GOTOTOK: EQU $12 ; /* GOTO */ ,,, ONTOK: EQU $13 ; /* ON */ ,,, RETNTOK: EQU $14 ; /* RETURN */ ,,, IFTOK: EQU $15 ; /* IF */ ,,, INPUTTOK: EQU $16 ; /* INPUT */ ,,, STOPTOK: EQU $17 ; /* STOP */ ,,, ENDTOK: EQU $18 ; /* END */ ,,, WHILETOK: EQU $19 ; /* WHILE */ ,,, ENDWHTOK: EQU $1A ; /* ENDWH */ ,,, EEPTOK: EQU $1B ; /* EEP */ ,,, PORTATOK: EQU $1C ; /* PORTA */ ,,, PORTBTOK: EQU $1D ; /* PORTB */ ,,, PORTCTOK: EQU $1E ; /* PORTC */ ,,, PORTDTOK: EQU $1F ; /* PORTD */ ,,, INBYTTOK: EQU $23 ; /* INBYTE */ ,,, TIMETOK: EQU $24 ; /* TIME */ ,,, ONTIMTOK: EQU $25 ; /* ONTIME */ ,,, ONIRQTOK: EQU $26 ; /* ONIRQ */ ,,, RETITOK: EQU $27 ; /* RETI */ ,,, ONPACTOK: EQU $28 ; /* ONPACC */ ,,, SLEEPTOK: EQU $29 ; /* SLEEP */ ,,, RTIMETOK: EQU $2A ; /* RTIME */ ,,, FUNCTFLG: EQU $36 ; /* function flag byte */ ,,, TOTOK: EQU $37 ; /* TO */ ,,, THENTOK: EQU $38 ; /* THEN */ ,,, ELSETOK: EQU $39 ; /* ELSE */ ,,, STEPTOK: EQU $3A ; /* STEP */ ,,, ,,, */* function tokens */ ,,, ,,, FDIVTOK: EQU $01 ; /* FDIV */ ,,, CHRTOK: EQU $02 ; /* CHR$ */ ,,, ADCTOK: EQU $03 ; /* ADC */ ,,, ABSTOK: EQU $04 ; /* ABS */ ,,, RNDTOK: EQU $05 ; /* RND */ ,,, SGNTOK: EQU $06 ; /* SGN */ ,,, TABTOK: EQU $07 ; /* TAB */ ,,, CALLTOK: EQU $08 ; /* CALL */ ,,, PEEKTOK: EQU $09 ; /* PEEK */ ,,, FEEPTOK: EQU $0A ; /* EEP */ ,,, HEXTOK: EQU $0B ; /* HEX */ ,,, FPRTATOK: EQU $0C ; /* PORTA */ ,,, FPRTBTOK: EQU $0D ; /* PORTB */ ,,, FPRTCTOK: EQU $0E ; /* PORTC */ ,,, FPRTDTOK: EQU $0F ; /* PORTD */ ,,, FPRTETOK: EQU $10 ; /* PORTE */ ,,, FTIMETOK: EQU $11 ; /* TIME */ ,,, HEX2TOK: EQU $12 ; /* HEX2 */ ,,, FPACCTOK: EQU $13 ; /* PACC */ ,,, ,,, */* numerical/variable tokens */ ,,, ,,, FVARTOK: EQU $81 ; /* floating point variable address */ ,,, SVARTOK: EQU $82 ; /* string variable address */ ,,, IVARTOK: EQU $84 ; /* integer variable address */ ,,, ,,, FAVARTOK: EQU $91 ; /* floating point array */ ,,, SAVARTOK: EQU $92 ; /* string array */ ,,, IAVARTOK: EQU $94 ; /* integer array */ ,,, ,,, FCONTOK: EQU $A1 ; /* floating point constant */ ,,, SCONTOK: EQU $A2 ; /* string constant */ ,,, LCONTOK: EQU $A8 ; /* line # constant */ ,,, ICONTOK: EQU $A4 ; /* integer constant */ ,,, ,,, ISIZ: EQU 2 ; /* number of bytes in integer variable */ ,,, SSIZ: EQU 3 ; /* number of bytes in string variable */ ,,, FSIZ: EQU 5 ; /* number of bytes in f.p. variable */ ,,, ASIZ: EQU 2 ; /* number of bytes for array variable in dictionary */ ,,, */* misc. tokens */ ,,, ,,, MSCNTOK: EQU $7F ; /* multiple space count token */ ,,, SSCNTOK: EQU $7E ; /* single space token */ ,,, EOLTOK: EQU $7D ; /* end of line token */ ,,, COMMATOK: EQU $7C ; /* , */ ,,, SEMITOK: EQU $7B ; /* ; */ ,,, MEOLTOK: EQU $7A ; /* : */ ,,, EQUALTOK: EQU $79 ; /* '=' */ ,,, PNUMTOK: EQU $78 ; /* '#' */ ,,, * ,,, * ,,, JMPOP: EQU $7E ; OP-CODE FOR "JMP" (USED TO INITALIZE INTERRUPT TABLE) ,,, ,,, * /*********** define variables ***********/ ,,, ,,, ORG $0000 ,,, * ,,, * char ,,, * 0000,00 02,IBUFPTR:, IBUFPTR: RMB 2 ; /* input buffer pointer */ 0002,00 02,TBUFPTR:, TBUFPTR: RMB 2 ; /* token buffer pointer */ ,,, * ,,, * the next 5 variables must remain grouped togeather ,,, * 0004,00 02,BASBEG:, BASBEG: RMB 2 ; /* start of basic program area */ 0006,00 02,BASEND:, BASEND: RMB 2 ; /* end of basic program */ 0008,00 02,VARBEGIN:, VARBEGIN: RMB 2 ; /* start of variable storage area */ 000A,00 02,VAREND:, VAREND: RMB 2 ; /* end of variable storage area */ 000C,00 02,HILINE:, HILINE: RMB 2 ; /* highest line number in program buffer */ ,,, * ,,, * ,,, * 000E,00 02,BASMEND:, BASMEND: RMB 2 ; /* physical end of basic program memory */ 0010,00 02,VARMEND:, VARMEND: RMB 2 ; /* physical end of variable memory */ ,,, * ,,, * int ,,, * 0012,00 02,FIRSTLIN:, FIRSTLIN: RMB 2 ; /* first line to list */ 0014,00 02,LASTLIN:, LASTLIN: RMB 2 ; /* last line to list */ 0016,00 02,INTPTR:, INTPTR: RMB 2 ; /* integer pointer */ ,,, * ,,, * short ,,, * 0018,00 01,ERRCODE:, ERRCODE: RMB 1 ; /* error code status byte */ 0019,00 01,IMMID:, IMMID: RMB 1 ; /* immidiate mode flag */ ,,, BREAKCNT: EQU * ; /* also use for break check count */ ,,, COUNT: EQU * ; /* count used in ESAVE & ELOAD routines */ 001A,00 01,IFWHFLAG:, IFWHFLAG: RMB 1 ; /* translating IF flag */ 001B,00 01,TRFLAG:, TRFLAG: RMB 1 ; /* trace mode flag */ 001C,00 01,CONTFLAG:, CONTFLAG: RMB 1 ; /* continue flag */ 001D,00 01,RUNFLAG:, RUNFLAG: RMB 1 ; /* indicates we are in the run mode */ 001E,00 01,PRINTPOS:, PRINTPOS: RMB 1 ; /* current print position */ 001F,00 02,NUMSTACK:, NUMSTACK: RMB 2 ; /* numeric operand stack pointer */ 0021,00 02,OPSTACK:, OPSTACK: RMB 2 ; /* operator stack pointer */ 0023,00 02,FORSTACK:, FORSTACK: RMB 2 ; /* FOR stack pointer */ 0025,00 02,WHSTACK:, WHSTACK: RMB 2 ; /* WHILE stack pointer */ 0027,00 02,GOSTACK:, GOSTACK: RMB 2 ; /* GOSUB stack pointer */ 0029,00 02,CURLINE:, CURLINE: RMB 2 ; /* line # that we are currently interpreting */ 002B,00 02,ADRNXLIN:, ADRNXLIN: RMB 2 ; /* address of the next line */ 002D,00 02,STRASTG:, STRASTG: RMB 2 ; /* dynamic string/array pool pointer */ 002F,00 02,FENCE:, FENCE: RMB 2 ; /* varend fence in case of an error in xlation */ 0031,00 02,IPSAVE:, IPSAVE: RMB 2 ; /* interpretive pointer save for "BREAK" */ 0033,00 02,DATAPTR:, DATAPTR: RMB 2 ; /* pointer to data for read statement */ 0035,00 02,RANDOM:, RANDOM: RMB 2 ; /* random number/seed */ 0037,00 01,DEVNUM:, DEVNUM: RMB 1 ; /* I/O device number */ 0038,00 02,TIMEREG:, TIMEREG: RMB 2 ; /* TIME register */ 003A,00 02,TIMECMP:, TIMECMP: RMB 2 ; /* TIME compare register */ 003C,00 01,TIMEPRE:, TIMEPRE: RMB 1 ; /* software prescaler for TIME */ 003D,00 02,ONTIMLIN:, ONTIMLIN: RMB 2 ; /* ONTIME line number to goto */ 003F,00 02,ONIRQLIN:, ONIRQLIN: RMB 2 ; /* ONIRQ line number to goto */ 0041,00 02,ONPACLIN:, ONPACLIN: RMB 2 ; /* ONPACC line number to goto */ 0043,00 01,XONCH:, XONCH: RMB 1 ; /* XON character for printer */ 0044,00 01,XOFFCH:, XOFFCH: RMB 1 ; /* XOFF character for printer */ 0045,00 02,SCURLINE:, SCURLINE: RMB 2 ; /* used to save CURLINE during int. processing */ 0047,00 02,SADRNXLN:, SADRNXLN: RMB 2 ; /* used to save ADRNXLIN during int. processing */ 0049,00 02,INBUFFS:, INBUFFS: rmb 2 ; /* pointer to the start of the input buffer */ 004B,00 02,TKNBUFS:, TKNBUFS: rmb 2 ; /* pointer to the start of the token buffer */ ,,, * 004D,00 02,EOPSTK:, EOPSTK: RMB 2 ; /* end of operator stack */ 004F,00 02,STOPS:, STOPS: RMB 2 ; /* start of operator stack */ 0051,00 02,ENUMSTK:, ENUMSTK: RMB 2 ; /* end of operand stack */ 0053,00 02,STNUMS:, STNUMS: RMB 2 ; /* start of operand stack */ 0055,00 02,EFORSTK:, EFORSTK: RMB 2 ; /* end of FOR - NEXT stack */ 0057,00 02,STFORSTK:, STFORSTK: RMB 2 ; /* start of FOR - NEXT stack */ 0059,00 02,EWHSTK:, EWHSTK: RMB 2 ; /* end of WHILE stack */ 005B,00 02,STWHSTK:, STWHSTK: RMB 2 ; /* start of WHILE stack */ 005D,00 02,EGOSTK:, EGOSTK: RMB 2 ; /* end of GOSUB stack */ 005F,00 02,STGOSTK:, STGOSTK: RMB 2 ; /* start of GOSUB stack */ 0061,00 02,IOBaseV:, IOBaseV: RMB 2 ; /* Address vector for I/O Registers */ 0063,00 03,DNAME:, DNAME: RMB 3 ; /* Place to put the variable name when doing a dump command */ 0066,00 02,SUBMAX:, SUBMAX: RMB 2 ; /* */ 0068,00 02,SUBCNT:, SUBCNT: RMB 2 ; /* */ 006A,00 02,TOKPTR:, TOKPTR: rmb 2 ; /* token pointer (used for list command) */ 006C,00 02,VarSize:, VarSize: rmb 2 ; /* used by the line editor. size of the variable table */ ,,, * ,,, * ,,, $if * > $9E ,,, $endif ,,, * ,,, * ,,, * ,,, ORG $009E ,,, * 009E,00 03,CONSTAT:, CONSTAT: RMB 3 ; GET CONSOLE STATUS FOR BREAK ROUTINE. 00A1,00 03,INCONNE:, INCONNE: RMB 3 ; GET BYTE DIRECTLY FROM CONSOLE FOR BREAK ROUTINE. ,,, * ,,, ORG $00A4 ,,, * 00A4,00 10,INTABLE:, INTABLE: RMB 16 ; RESERVE SPACE FOR 8 DIFFERENT INPUT ROUTINES. 00B4,00 10,OUTABLE:, OUTABLE: RMB 16 ; RESERVE SPACE FOR 8 DIFFERENT OUTPUT ROUTINES. ,,, * ,,, * ,,, * ,,, * ,,, ORG $00C4 ; START OF RAM INTERRUPT VECTORS. ,,, * ,,, RAMVECTS: EQU * 00C4,00 03,SCISS:, SCISS: RMB 3 ; SCI SERIAL SYSTEM. 00C7,00 03,SPITC:, SPITC: RMB 3 ; SPI TRANSFER COMPLETE. 00CA,00 03,PACCIE:, PACCIE: RMB 3 ; PULSE ACCUMULATOR INPUT EDGE. 00CD,00 03,PACCOVF:, PACCOVF: RMB 3 ; PULSE ACCUMULATOR OVERFLOW. 00D0,00 03,TIMEROVF:, TIMEROVF: RMB 3 ; TIMER OVERFLOW. 00D3,00 03,TOC5:, TOC5: RMB 3 ; TIMER OUTPUT COMPARE 5. 00D6,00 03,TOC4:, TOC4: RMB 3 ; TIMER OUTPUT COMPARE 4. 00D9,00 03,TOC3:, TOC3: RMB 3 ; TIMER OUTPUT COMPARE 3. 00DC,00 03,TOC2:, TOC2: RMB 3 ; TIMER OUTPUT COMPARE 2. 00DF,00 03,TOC1:, TOC1: RMB 3 ; TIMER OUTPUT COMPARE 1. 00E2,00 03,TIC3:, TIC3: RMB 3 ; TIMER INPUT CAPTURE 3. 00E5,00 03,TIC2:, TIC2: RMB 3 ; TIMER INPUT CAPTURE 2. 00E8,00 03,TIC1:, TIC1: RMB 3 ; TIMER INPUT CAPTURE 1. 00EB,00 03,REALTIMI:, REALTIMI: RMB 3 ; REAL TIME INTERRUPT. 00EE,00 03,IRQI:, IRQI: RMB 3 ; IRQ INTERRUPT. 00F1,00 03,XIRQ:, XIRQ: RMB 3 ; XIRQ INTERRUPT. 00F4,00 03,SWII:, SWII: RMB 3 ; SOFTWARE INTERRUPT. 00F7,00 03,ILLOP:, ILLOP: RMB 3 ; ILLEGAL OPCODE TRAP. 00FA,00 03,COP:, COP: RMB 3 ; WATCH DOG TIMER FAIL. 00FD,00 03,CMF:, CMF: RMB 3 ; CLOCK MONITOR FAIL. ,,, * ,,, * ,,, #Include 'BASICLB1.Asm' ,,, ORG ROMBEG ,,, * title BASICLB1 ,,, ****************************************************************************** ,,, * * ,,, * MC68HC11 BASIC INTERPRETER * ,,, * * ,,, * WRITTEN BY: * ,,, * * ,,, * GORDON DOUGHMAN * ,,, * * ,,, * COPYRIGHT 1985-1990 BY * ,,, * * ,,, * GORDON DOUGHMAN * ,,, * * ,,, ****************************************************************************** ,,, * ,,, * ,,, */ ,,, * include "1.DEFINES.C" ,,, * ,,, *main() ,,, *{ ,,, * initvars(); /* initalize all variables & pointers */ ,,, * outheader(); /* send startup message to console */ ,,, * outrdy(); /* output ready message */ ,,, * E000,7E ED 72,, JMP POWERUP ,,, MAIN: EQU * E003,BD EC FA,MAINC:, MAINC: JSR INITVARS ; INITALIZE ALL INTERNAL VARIABLES. E006,FE FF C4,, LDX EEStart E009,A6 0A,, LDAA AUTOSTF,X ; get the auto start flag. E00B,81 55,, CMPA #$55 E00D,26 04,, BNE MAIN9 E00F,0E,, CLI ; ALLOW ALL INTERRUPTS TO BE SERVICED. E010,BD F1 59,, JSR CRUN E013,BD E0 68,MAIN9:, MAIN9: JSR OUTHEADR ; PRINT HEADER. ,,, MAINW: EQU * E016,FC FF C0,MAIN2:, MAIN2: LDD RAMStart ; RESET STACK VALUE. E019,F3 FF C2,, ADDD RAMSize E01C,8F,, XGDX E01D,35,, TXS E01E,0E,, CLI ; (J.I.C.) E01F,4F,, CLRA ; CLEAR D. E020,5F,, CLRB E021,DD 3A,, STD TIMECMP ; DON'T ALLOW "ONTIME" INTERRUPTS TO OCCUR. E023,DD 3F,, STD ONIRQLIN ; DON'T ALLOW "ONIRQ" INTERRUPTS TO OCCUR. E025,DD 41,, STD ONPACLIN ; DON'T ALLOW "PACC" INTERRUPTS TO OCCUR. E027,BD E0 AB,, JSR OUTRDY ; PRINT READY MESSAGE. ,,, * ,,, * while(1) /* do forever */ ,,, * { ,,, * outprmpt(); /* output prompt */ ,,, * getline(); /* getline from console */ ,,, * skipspcs(); /* ignore leading spaces in input buffer */ ,,, * if(chckcmds()) continue; /* check for commands */ ,,, * parse(); /* translate/execute line */ ,,, * if(errcode) rpterr(); /* if an error occured somewhere, report it. */ ,,, * errcode=0; /* clear error status */ ,,, * } ,,, *} ,,, * ,,, MAIN1: EQU * E02A,7F 00 19,, CLR IMMID ; CLEAR THE IMMIDIATE MODE FLAG. E02D,7F 00 18,, CLR ERRCODE ; CLEAR THE ERROR CODE BYTE. E030,7F 00 1D,, CLR RUNFLAG ; CLEAR THE RUN MODE FLAG. E033,BD E1 05,, JSR OUTPRMPT ; SEND PROMPT TO CONSOLE. E036,BD E0 BB,, JSR GETLINE ; GO GET LINE FROM OPERATOR. E039,BD E0 5B,, JSR SKIPSPCS ; SKIP ANY LEADING SPACES. E03C,BD EE 48,, JSR CHCKCMDS ; GO CHECK FOR ANY COMMANDS. E03F,1A 83 00 00,, CPD #0 ; WERE THERE ANY? E043,26 D1,, BNE MAIN2 ; YES. CONTINUE. E045,DE 0A,, LDX VAREND ; SAVE CURRENT END OF VARIABLE AREA IN CASE LINE E047,DF 2F,, STX FENCE ; HAS AN ERROR IN IT. (SO NO SPURIOUS VARIABLES ,,, * ; ARE ALLOCATED) E049,BD E1 27,, JSR PARSE E04C,7D 00 19,, TST IMMID ; DID WE EXECUTE IN IMMIDATE MODE? E04F,26 C5,, BNE MAIN2 ; YES. PRINT READY MESSAGE. E051,20 D7,, BRA MAIN1 ; NO. JUST PRINT PROMPT. ,,, * ,,, * E053,DE 2F,MAIN3:, MAIN3: LDX FENCE ; GET THE VAREND FENCE. E055,6F 00,, CLR 0,X ; MARK "OLD" END OF VARIABLE AREA IN CASE ANY ,,, * ; VARIABLES WERE ALLOCATED. E057,DF 0A,, STX VAREND ; RESTORE THE POINTER. E059,20 BB,, BRA MAIN2 ; CONTINUE AFTER ERROR. ,,, * ,,, * /***** skipspcs() *****/ ,,, ,,, *skipspcs() ,,, *{ ,,, * while(*ibufptr==SPC) ++ibufptr; ,,, * return; ,,, *} ,,, * ,,, SKIPSPCS: EQU * E05B,BD E3 C3,SKIPSPC1:, SKIPSPC1: JSR GETCHR E05E,81 20,, CMPA #SPC E060,26 05,, BNE SKIPSPC2 E062,BD E3 CC,, JSR INCIBP E065,20 F4,, BRA SKIPSPC1 E067,39,SKIPSPC2:, SKIPSPC2: RTS ,,, * ,,, ,,, * /***** outheader *****/ ,,, ,,, *outheader() ,,, *{ ,,, * pl("BASIC11 v1.1"); ,,, * nl(); ,,, * nl(); ,,, * pl("Written by Gordon Doughman"); ,,, * nl(); ,,, *} ,,, * ,,, OUTHEADR: EQU * E068,CE E0 6E,, LDX #HEADER E06B,7E E1 1C,, JMP PL ,,, * ,,, HEADER: EQU * E06E,0D,, FCB $0D,$0A,$0D,$0A E06F,0A,, E070,0D,, E071,0A,, E072,42 41 53 49 43 31,, FCC "BASIC11 v1.55" ,,, FCC "BASIC11 v1.55" ,,, FCC "BASIC11 v1.55" E07F,0D,, FCB $0D,$0A E080,0A,, E081,43 6F 70 79 72 69,, FCC "Copyright 1985-1990 by" ,,, FCC "Copyright 1985-1990 by" ,,, FCC "Copyright 1985-1990 by" ,,, FCC "Copyright 1985-1990 by" E097,0D,, FCB $0D,$0A E098,0A,, E099,47 6F 72 64 6F 6E,, FCC "Gordon Doughman" ,,, FCC "Gordon Doughman" ,,, FCC "Gordon Doughman" E0A8,0D,, FCB $0D,$0A,0 E0A9,0A,, E0AA,00,, ,,, * ,,, * ,,, * /***** outrdy() *****/ ,,, ,,, *outrdy() ,,, *{ ,,, * nl(); ,,, * pl("READY"); ,,, * return; ,,, *} ,,, * ,,, OUTRDY: EQU * E0AB,CE E0 B1,, LDX #READY E0AE,7E E1 1C,, JMP PL ,,, * ,,, READY: EQU * E0B1,0D,, FCB $0D,$0A E0B2,0A,, E0B3,52 45 41 44 59,, FCC "READY" E0B8,0D,, FCB $0D,$0A,0 E0B9,0A,, E0BA,00,, ,,, * ,,, * ,,, * /***** getline() *****/ ,,, ,,, *getline() ,,, *{ ,,, * short chrcnt; ,,, * char c; ,,, * chrcnt=IBUFLEN; ,,, * ibufptr=inbuff; ,,, * ,,, GETLINE: EQU * E0BB,C6 4F,, LDAB #IBUFLEN-1 E0BD,DE 49,, LDX INBUFFS ,,, * ,,, * while((c=inbyte())!=EOL && (chrcnt>0)) ,,, * { ,,, * E0BF,BD FE EA,GETLINE3:, GETLINE3: JSR INBYTE E0C2,81 0D,, CMPA #EOL E0C4,27 2B,, BEQ GETLINE1 E0C6,5D,, TSTB E0C7,27 28,, BEQ GETLINE1 ,,, * ,,, * if(c==BS) ,,, * { ,,, * if(ibufptr!=inbuff) ,,, * { ,,, * ibufptr-=1; /* point to previous buffer location */ ,,, * outbyte(SPC); /* erase character on screen */ ,,, * outbyte(BS); /* back cursor up */ ,,, * chrcnt+=1; ,,, * } ,,, * else ,,, * continue; ,,, * } ,,, * ,,, * E0C9,81 08,, CMPA #BS E0CB,26 10,, BNE GETLINE2 E0CD,C1 4F,, CMPB #IBUFLEN-1 E0CF,27 20,, BEQ GETLINE1 E0D1,09,, DEX E0D2,86 20,, LDAA #SPC E0D4,BD FE CD,, JSR OUTBYTE E0D7,86 08,, LDAA #BS E0D9,BD FE CD,, JSR OUTBYTE E0DC,5C,, INCB ,,, * ,,, * if(c < SPC) continue; /* ignore all other control characters */ ,,, * ,,, GETLINE2: EQU * E0DD,81 03,, CMPA #CNTRLC ; IS IT A "BREAK"? E0DF,26 06,, BNE GETLINE4 ; NO. GO PROCESS THE CHARACTER. E0E1,7C 00 1C,, INC CONTFLAG ; DONT ALLOW A "CONT". E0E4,7E F2 6F,, JMP CHCKBRK2 ; GO DO A BREAK. E0E7,81 20,GETLINE4:, GETLINE4: CMPA #SPC E0E9,25 D4,, BLO GETLINE3 ,,, * ,,, * *ibufptr=c; /* save character in input buffer */ ,,, * ibufptr+=1; /* point to next location */ ,,, * chrcnt-=1; ,,, * } E0EB,A7 00,, STAA 0,X E0ED,08,, INX E0EE,5A,, DECB E0EF,26 CE,, BNE GETLINE3 ,,, * ,,, * *ibufptr=EOL; /* put EOL in input buffer */ ,,, * ibufptr=inbuff; /* initalize the input buffer pointer */ ,,, * return; ,,, *} ,,, * ,,, GETLINE1: EQU * E0F1,86 0D,, LDAA #EOL E0F3,A7 00,, STAA 0,X E0F5,DE 49,, LDX INBUFFS E0F7,DF 00,, STX IBUFPTR E0F9,39,, RTS ,,, * ,,, ToUpper: EQU * E0FA,81 61,, cmpa #'a' ; is the character less than a lower case 'a'? E0FC,25 06,, blo ToUpper1 E0FE,81 7A,, cmpa #'z' E100,22 02,, bhi ToUpper1 E102,84 DF,, anda #$df E104,39,ToUpper1:, ToUpper1: rts ,,, ,,, * /***** outprmpt() *****/ ,,, ,,, *outprmpt() ,,, *{ ,,, * nl(); /* go to new line */ ,,, * outbyte('#'); /* send prompt to console */ ,,, * return; ,,, *} ,,, * ,,, OUTPRMPT: EQU * E105,CE E1 0A,, LDX #PRMPTSTR E108,20 12,, BRA PL ,,, * ,,, PRMPTSTR: EQU * E10A,0D,, FCB $0D,$0A E10B,0A,, E10C,3E,, FCC ">" E10D,00,, FCB 0 ,,, * ,,, * /***** nl() *****/ ,,, ,,, * nl() /* send CR/LF to console */ ,,, *{ ,,, * outbyte(CR); ,,, * outbyte(LF); ,,, * return; ,,, *} ,,, * ,,, * E10E,8D 00,NL2:, NL2: BSR NL ,,, NL: EQU * E110,CE E1 19,, LDX #CRLFSTR E113,8D 07,, BSR PL E115,7F 00 1E,, CLR PRINTPOS ; SET THE CURRENT PRINT POSITION TO 0. E118,39,, RTS ,,, * E119,0A,CRLFSTR:, CRLFSTR: FCB $0A,$0D,$00 E11A,0D,, E11B,00,, ,,, * ,,, * /***** pl() *****/ ,,, ,,, *pl(ptr) /* send line to console */ ,,, *char *ptr; ,,, *{ ,,, * int k; char c; ,,, * k=0; ,,, * while(c=ptr[k++]) outbyte(c); ,,, * return; ,,, *} ,,, * ,,, PL: EQU * E11C,A6 00,PL1:, PL1: LDAA 0,X E11E,27 06,, BEQ PL2 E120,BD FE CD,, JSR OUTBYTE E123,08,, INX E124,20 F6,, BRA PL1 E126,39,PL2:, PL2: RTS ,,, * ,,, ,,, * /***** parse() *****/ ,,, ,,, *parse() ,,, *{ ,,, * int num; ,,, * tbufptr=tknbuf; /* initalize the token buffer pointer */ ,,, * ,,, PARSE: EQU * E127,DE 4B,, LDX TKNBUFS ; Get the start of the token buffer E129,DF 02,, STX TBUFPTR ,,, * ,,, * if(num=getlinum()) /* get line number if present */ ,,, * { ,,, * if(*ibufptr==EOL) /* was line # followed by CR? */ ,,, * { /* yes. */ ,,, * delline(num); /* go delete the line from the prog buffer */ ,,, * return; ,,, * } ,,, * immid=0; /* flag as not immidiate */ ,,, * putlinum(num); /* put line number in buffer */ ,,, * } ,,, * else immid=1; /* if no line # flag as immidiate*/ ,,, * E12B,8D 3F,, BSR GETLINUM E12D,24 19,, BCC PARSE2 E12F,36,, PSHA E130,BD E3 C3,, JSR GETCHR E133,81 0D,, CMPA #EOL E135,32,, PULA E136,26 09,, BNE PARSE1 E138,BD EB A1,, JSR DELLINE E13B,DE 0A,, LDX VAREND E13D,08,, INX E13E,DF 2D,, STX STRASTG E140,39,PARSE7:, PARSE7: RTS E141,7F 00 19,PARSE1:, PARSE1: CLR IMMID E144,8D 6E,PARSE8:, PARSE8: BSR PUTLINUM E146,20 10,, BRA PARSE3 E148,BD E3 C3,PARSE2:, PARSE2: JSR GETCHR E14B,81 0D,, CMPA #EOL E14D,27 F1,, BEQ PARSE7 E14F,86 01,, LDAA #1 E151,97 19,, STAA IMMID E153,CC 00 00,, LDD #0 E156,20 EC,, BRA PARSE8 ,,, * ,,, * if(errcode) return; /* if line number error, return */ ,,, * xlate(); /* if translation error, return */ ,,, * if(errcode) return; ,,, * if(immid) runline(); /* if immidiate mode run 1 line */ ,,, * else storlin(); /* if not store pgm line */ ,,, * return; /* go get next line */ ,,, *} ,,, * E158,BD E1 E2,PARSE3:, PARSE3: JSR XLATE E15B,7D 00 19,, TST IMMID E15E,27 03,, BEQ PARSE5 E160,7E F2 2E,, JMP RUNLINE ; GO RUN THE LINE & RETURN. E163,BD EB 7A,PARSE5:, PARSE5: JSR STORLIN ; GO STORE LINE & RETURN. E166,DE 0A,, LDX VAREND E168,08,, INX E169,DF 2D,, STX STRASTG E16B,39,, RTS ,,, * ,,, ,,, * /***** getlinum *****/ ,,, ,,, *getlinum() ,,, *{ ,,, * int num; ,,, * num=0; ,,, * ,,, GETLINUM: EQU * ,,, * ,,, * E16C,18 3C,, PSHY E16E,4F,, CLRA E16F,36,, PSHA E170,36,, PSHA E171,18 30,, TSY ,,, * ,,, * if(numeric(*ibufptr)==0) return(0); /* if 1st char not numeric, rtn 0 */ ,,, * E173,DE 00,, LDX IBUFPTR E175,A6 00,, LDAA 0,X E177,8D 42,, BSR NUMERIC E179,24 10,, BCC GTLNUM4 ,,, * ,,, * while(numeric(*ibufptr)) /* while *ibufptr is numeric */ ,,, * { ,,, * num=num*10+(*ibufptr-'0'); /* get a digit */ ,,, * ibufptr++; /* advance input buffer pointer */ ,,, * if(num<=0) { errcode=LINRANG; return(0); } ,,, * } ,,, * return(num); ,,, *} ,,, * E17B,A6 00,GTLNUM2:, GTLNUM2: LDAA 0,X E17D,8D 3C,, BSR NUMERIC E17F,25 11,, BCS GTLNUM3 E181,0D,, SEC E182,18 EC 00,GTLNUM1:, GTLNUM1: LDD 0,Y E185,26 04,, BNE GTLNUM4 E187,86 12,, LDAA #LINENERR E189,20 0D,, BRA GTLNUM5 E18B,31,GTLNUM4:, GTLNUM4: INS E18C,31,, INS E18D,18 38,, PULY E18F,DF 00,, STX IBUFPTR E191,39,, RTS E192,8D 07,GTLNUM3:, GTLNUM3: BSR ADDDIG E194,2A E5,, BPL GTLNUM2 E196,86 01,, LDAA #LINRANG E198,7E EA 98,GTLNUM5:, GTLNUM5: JMP RPTERR ,,, * ,,, * ,,, ADDDIG: EQU * E19B,18 EC 00,, LDD 0,Y E19E,05,, ASLD E19F,05,, ASLD E1A0,18 E3 00,, ADDD 0,Y E1A3,05,, ASLD E1A4,18 ED 00,, STD 0,Y E1A7,E6 00,, LDAB 0,X E1A9,08,, INX E1AA,C0 30,, SUBB #'0' E1AC,4F,, CLRA E1AD,18 E3 00,, ADDD 0,Y E1B0,18 ED 00,, STD 0,Y E1B3,39,, RTS ,,, * ,,, * ,,, * /***** putlinum *****/ ,,, ,,, *putlinum(lnum) ,,, *int lnum; ,,, *{ ,,, * putint(lnum); /* put line # in token buffer */ ,,, * *tbufptr++=0; /* hold place for length of line */ ,,, * return; ,,, *} ,,, * ,,, PUTLINUM: EQU * E1B4,BD E3 D4,, JSR PUTDTOK E1B7,4F,, CLRA E1B8,7E E3 D7,, JMP PUTTOK ,,, * ,,, * /***** numeric() *****/ ,,, ,,, *numeric(c) ,,, *char c; ,,, *{ ,,, * c=c&127; ,,, * return((c>='0')&(c<='9')); ,,, *} ,,, * ,,, NUMERIC: EQU * E1BB,81 30,, CMPA #'0' E1BD,25 06,, BLO NUMERIC1 E1BF,81 39,, CMPA #'9' E1C1,22 02,, BHI NUMERIC1 E1C3,0D,, SEC E1C4,39,, RTS E1C5,0C,NUMERIC1:, NUMERIC1: CLC E1C6,39,, RTS ,,, ,,, * /***** alpha() *****/ ,,, ,,, *alpha(c) ,,, *char c; ,,, *{ ,,, * c=c&127; ,,, * return((c>='A')&(c<='Z')); ,,, *} ,,, * ,,, ALPHA: EQU * E1C7,81 41,, CMPA #'A' E1C9,25 0E,, BLO ALPHA1 E1CB,81 5A,, CMPA #'Z' E1CD,23 08,, BLS ALPHA2 E1CF,81 61,, CMPA #'a' E1D1,25 06,, BLO ALPHA1 E1D3,81 7A,, CMPA #'z' E1D5,22 02,, BHI ALPHA1 E1D7,0D,ALPHA2:, ALPHA2: SEC E1D8,39,, RTS E1D9,0C,ALPHA1:, ALPHA1: CLC E1DA,39,, RTS ,,, ,,, * /***** alphanum *****/ ,,, ,,, *alphanum(c) ,,, *char c; ,,, *{ return ((alpha(c)) | (numeric(c))); } ,,, * ,,, ALPHANUM: EQU * E1DB,8D EA,, BSR ALPHA E1DD,24 01,, BCC ALPHANU1 E1DF,39,, RTS E1E0,20 D9,ALPHANU1:, ALPHANU1: BRA NUMERIC ,,, * ,,, */***************************************** ,,, * xlate() ,,, * translate the input buffer into tokenized ,,, * form placing the results into tknbuf ,,, ******************************************/ ,,, * ,,, *xlate() ,,, *{ ,,, * while(*ibufptr!=EOL) ,,, * { ,,, * ifwhflag=0; /* set IF flag to zero */ ,,, * blanks(); /* skip all blanks */ ,,, * if(match("DATA")) xdata(); ,,, * else if(match("LET")) xlet(); ,,, * else if(match("READ")) xread(); ,,, * else if(match("RESTORE")) xrestore(); ,,, * else if(match("GOSUB")) xgosub(); ,,, * else if(match("GOTO")) xgoto(); ,,, * else if(match("ON")) xon(); ,,, * else if(match("RETURN")) xreturn(); ,,, * else if(match("IF")) xif(); ,,, * else if(match("INPUT")) xinput(); ,,, * else if(match("PRINT")) xprint(); ,,, * else if(match("FOR")) xfor(); ,,, * else if(match("NEXT")) xnext(); ,,, * else if(match("STOP")) xstop(); ,,, * else if(match("ENDWH")) xendwh(); ,,, * else if(match("END")) xend(); ,,, * else if(match("REM")) xrem(); ,,, */*else if(match("SWAP")) xswap();*/ ,,, * else if(match("TRON")) xtron(); ,,, * else if(match("TROFF")) xtroff(); ,,, * else if(match("WHILE")) xwhile(); ,,, */*else if(match("ONIRQ")) xonirq();*/ ,,, * else ximplet(); /* if no keyword, assume implied LET */ ,,, * if(errcode) return; ,,, * blanks(); ,,, * if(*ibufptr==MIDEOL) { xmideol(); continue; } ,,, * if(*ibufptr!=EOL) { errcode=SYTXERR; return; } ,,, * } ,,, * *tbufptr=EOLTOK; /* put token eol in token buffer */ ,,, * tknbuf[2]=tbufptr-tknbuf+1; /* put line length into tokenized line */ ,,, * return; ,,, *} ,,, * ,,, XLATE: EQU * E1E2,BD E3 C3,, JSR GETCHR ; GET NEXT CHAR. E1E5,81 0D,, CMPA #EOL ; AT THE END OF THE LINE? E1E7,27 4F,, BEQ XLATE1 ; YES. E1E9,7F 00 1A,, CLR IFWHFLAG ; NOT XLATING "IF" OR "WHILE" E1EC,BD E3 7A,, JSR BLANKS ; SKIP BLANKS. E1EF,CE E2 46,, LDX #KEYWORDS ; POINT TO KEYWORD TABLE. E1F2,BD E3 A5,XLATE4:, XLATE4: JSR STREQ ; IS KEYWORD IS IN THE INPUT BUFFER? E1F5,25 13,, BCS XLATE2 ; YES GO PROCESS IT. E1F7,08,XLATE3:, XLATE3: INX ; NO. POINT TO NEXT CHAR. E1F8,A6 00,, LDAA 0,X ; AT THE END OF THIS KEYWORD? E1FA,26 FB,, BNE XLATE3 ; NO. E1FC,C6 04,, LDAB #4 ; NUMBER OF BYTES TO SKIP. E1FE,3A,, ABX E1FF,6D 00,, TST 0,X ; AT THE END OF THE TABLE? E201,26 EF,, BNE XLATE4 ; NO. CHCK FOR NEXT KEYWORD. E203,86 02,, LDAA #IMLETTOK ; ASSUME AN IMPLIED LET. ,,, * JSR PUTTOK ; PUT TOKEN IN BUFFER. E205,CE E4 1C,, LDX #XIMPLET ; GET ADDR OF XLATION ROUTINE. ,,, * JSR 0,X ; GO DO IT. ,,, * BRA XLATE6 ; GO FINISH UP. E208,20 04,, BRA XLATE9 E20A,A6 01,XLATE2:, XLATE2: LDAA 1,X ; GET KEYWORD TOKEN. E20C,EE 02,, LDX 2,X ; GET ADDR OF XLATION ROUTINE. E20E,BD E3 D7,XLATE9:, XLATE9: JSR PUTTOK ; PUT TOKEN IN BUFFER. E211,81 0C,, CMPA #DATATOK ; SPECIAL CASE, DONT SKIP BLANKS AFTER KEYWORD. E213,27 07,, BEQ XLATE5 E215,81 0A,, CMPA #REMTOK ; SAME SPECIAL CASE AS FOR DATA. E217,27 03,, BEQ XLATE5 E219,BD E3 7A,, JSR BLANKS ; SKIP BLANKS BETWEEN KEYWORD & NEXT OBJECT. E21C,AD 00,XLATE5:, XLATE5: JSR 0,X ; GO DO IT. E21E,BD E3 7A,XLATE6:, XLATE6: JSR BLANKS ; SKIP BLANKS. E221,BD E3 CA,, JSR GETNXCHR ; GET NEXT CHAR. E224,81 3A,, CMPA #MIDEOL ; IS IT A MID EOL? E226,26 07,, BNE XLATE7 ; NO. CHCK FOR EOL. E228,86 7A,, LDAA #MEOLTOK ; GET MID EOL TOKEN. E22A,BD E3 D7,, JSR PUTTOK ; PUT IT IN BUFFER. E22D,20 B3,, BRA XLATE ; CONTINUE. E22F,81 0D,XLATE7:, XLATE7: CMPA #EOL ; EOL? E231,27 05,, BEQ XLATE1 ; YES. FINISH UP. E233,86 02,, LDAA #SYTXERR ; NO. SYNTAX ERROR. E235,7E EA 98,, JMP RPTERR ; REPORT XLATION ERROR. E238,86 7D,XLATE1:, XLATE1: LDAA #EOLTOK ; GET EOL TOKEN. E23A,BD E3 D7,, JSR PUTTOK ; PUT IT IN BUFFER. E23D,DC 02,, LDD TBUFPTR ; GET TOKEN BUFFER POINTER. E23F,93 4B,, SUBD TKNBUFS ; Compute the TOKEN BUFFER LENGTH. E241,DE 4B,, LDX TKNBUFS ; POINT TO BUFFER. E243,E7 02,, STAB 2,X ; STORE LENGTH. E245,39,, RTS ; RETURN. ,,, * ,,, * ,,, * KEYWORD LOOK UP TABLE ,,, * ,,, * ,,, KEYWORDS: EQU * E246,44 41 54 41,DATA:, DATA: FCC "DATA" E24A,00,, FCB 0 E24B,0C,, FCB DATATOK E24C,E3 FC,, FDB XDATA E24E,4C 45 54,LET:, LET: FCC "LET" E251,00,, FCB 0 E252,01,, FCB LETTOK E253,E4 1C,, FDB XLET E255,52 45 41 44,READ:, READ: FCC "READ" E259,00,, FCB 0 E25A,0D,, FCB READTOK E25B,EA 58,, FDB XREAD E25D,52 45 53 54 4F 52,RESTORE:, RESTORE: FCC "RESTORE" ,,, RESTORE: FCC "RESTORE" E264,00,, FCB 0 E265,0E,, FCB RESTRTOK E266,E3 FB,, FDB XRESTORE E268,47 4F 53 55 42,GOSUB:, GOSUB: FCC "GOSUB" E26D,00,, FCB 0 E26E,0F,, FCB GOSUBTOK E26F,E3 F2,, FDB XGOSUB E271,47 4F 54 4F,GOTO:, GOTO: FCC "GOTO" E275,00,, FCB 0 E276,12,, FCB GOTOTOK E277,E3 F2,, FDB XGOTO E279,4F 4E 54 49 4D 45,ONTIME:, ONTIME: FCC "ONTIME" E27F,00,, FCB 0 E280,25,, FCB ONTIMTOK E281,E8 D3,, FDB XONTIME E283,4F 4E 49 52 51,ONIRQ:, ONIRQ: FCC "ONIRQ" E288,00,, FCB 0 E289,26,, FCB ONIRQTOK E28A,E8 D3,, FDB XONIRQ E28C,4F 4E 50 41 43 43,ONPACC:, ONPACC: FCC "ONPACC" E292,00,, FCB 0 E293,28,, FCB ONPACTOK E294,E8 F3,, FDB XONPACC E296,4F 4E,ON:, ON: FCC "ON" E298,00,, FCB 0 E299,13,, FCB ONTOK E29A,E8 85,, FDB XON E29C,52 45 54 55 52 4E,RETURN:, RETURN: FCC "RETURN" E2A2,00,, FCB 0 E2A3,14,, FCB RETNTOK E2A4,E3 FB,, FDB XRETURN E2A6,49 46,IIF:, IIF: FCC "IF" E2A8,00,, FCB 0 E2A9,15,, FCB IFTOK E2AA,E9 07,, FDB XIF E2AC,49 4E 50 55 54,INPUT:, INPUT: FCC "INPUT" E2B1,00,, FCB 0 E2B2,16,, FCB INPUTTOK E2B3,EA 40,, FDB XINPUT E2B5,50 52 49 4E 54,PRINT:, PRINT: FCC "PRINT" E2BA,00,, FCB 0 E2BB,03,, FCB PRINTTOK E2BC,E9 D8,, FDB XPRINT E2BE,3F,, FCC "?" E2BF,00,, FCB 0 E2C0,03,, FCB PRINTTOK E2C1,E9 D8,, FDB XPRINT E2C3,46 4F 52,FOR:, FOR: FCC "FOR" E2C6,00,, FCB 0 E2C7,04,, FCB FORTOK E2C8,E9 70,, FDB XFOR E2CA,4E 45 58 54,NEXT:, NEXT: FCC "NEXT" E2CE,00,, FCB 0 E2CF,05,, FCB NEXTTOK E2D0,E9 CB,, FDB XNEXT E2D2,53 54 4F 50,STOPSS:, STOPSS: FCC "STOP" E2D6,00,, FCB 0 E2D7,17,, FCB STOPTOK E2D8,E3 FB,, FDB XSTOP E2DA,45 4E 44 57 48,ENDWH:, ENDWH: FCC "ENDWH" E2DF,00,, FCB 0 E2E0,1A,, FCB ENDWHTOK E2E1,E3 FB,, FDB XENDWH E2E3,45 4E 44,ENDS:, ENDS: FCC "END" E2E6,00,, FCB 0 E2E7,18,, FCB ENDTOK E2E8,E3 FB,, FDB XEND E2EA,52 45 4D,REM:, REM: FCC "REM" E2ED,00,, FCB 0 E2EE,0A,, FCB REMTOK E2EF,E3 FC,, FDB XREM E2F1,54 52 4F 4E,TRON:, TRON: FCC "TRON" E2F5,00,, FCB 0 E2F6,06,, FCB TRONTOK E2F7,E3 FB,, FDB XTRON E2F9,54 52 4F 46 46,TROFF:, TROFF: FCC "TROFF" E2FE,00,, FCB 0 E2FF,07,, FCB TROFFTOK E300,E3 FB,, FDB XTROFF E302,57 48 49 4C 45,WHILE:, WHILE: FCC "WHILE" E307,00,, FCB 0 E308,19,, FCB WHILETOK E309,EA 8B,, FDB XWHILE E30B,50 4F 4B 45,POKE:, POKE: FCC "POKE" E30F,00,, FCB 0 E310,08,, FCB POKETOK E311,E7 FA,, FDB XPOKE E313,44 49 4D,DIM:, DIM: FCC "DIM" E316,00,, FCB 0 E317,09,, FCB DIMTOK E318,EA 58,, FDB XDIM E31A,45 45 50,EEP:, EEP: FCC "EEP" E31D,00,, FCB 0 E31E,1B,, FCB EEPTOK E31F,E8 13,, FDB XEEP E321,50 4F 52 54 41,PORTA:, PORTA: FCC "PORTA" E326,00,, FCB 0 E327,1C,, FCB PORTATOK E328,E4 18,, FDB XPORTA E32A,50 4F 52 54 42,PORTB:, PORTB: FCC "PORTB" E32F,00,, FCB 0 E330,1D,, FCB PORTBTOK E331,E4 18,, FDB XPORTB E333,50 4F 52 54 43,PORTC:, PORTC: FCC "PORTC" E338,00,, FCB 0 E339,1E,, FCB PORTCTOK E33A,E4 18,, FDB XPORTC E33C,50 4F 52 54 44,PORTD:, PORTD: FCC "PORTD" E341,00,, FCB 0 E342,1F,, FCB PORTDTOK E343,E4 18,, FDB XPORTD E345,49 4E 42 59 54 45,INBYTES:, INBYTES: FCC "INBYTE" E34B,00,, FCB 0 E34C,23,, FCB INBYTTOK E34D,EA 83,, FDB XINBYTE E34F,54 49 4D 45,TIME:, TIME: FCC "TIME" E353,00,, FCB 0 E354,24,, FCB TIMETOK E355,EA 93,, FDB XTIME E357,52 45 54 49,RETI:, RETI: FCC "RETI" E35B,00,, FCB 0 E35C,27,, FCB RETITOK E35D,E3 FB,, FDB XRETI E35F,50 41 43 43,PACC:, PACC: FCC "PACC" E363,00,, FCB 0 E364,0B,, FCB PACCTOK E365,EA 93,, FDB XPACC E367,53 4C 45 45 50,SLEEP:, SLEEP: FCC "SLEEP" E36C,00,, FCB 0 E36D,29,, FCB SLEEPTOK E36E,E3 FB,, FDB XSLEEP E370,52 54 49 4D 45,RTIMES:, RTIMES: FCC "RTIME" E375,00,, FCB 0 E376,2A,, FCB RTIMETOK E377,E3 FB,, FDB XRTIME E379,00,, FCB 0 ; END OF TABLE MARKER. ,,, ,,, *blanks() ,,, *{ ,,, * short spcnt; ,,, * spcnt=0; ,,, * while(*ibufptr==SPC) { ibufptr++; spcnt++; } ,,, * ,,, BLANKS: EQU * E37A,3C,, PSHX E37B,DE 00,, LDX IBUFPTR E37D,5F,, CLRB E37E,A6 00,BLANKS1:, BLANKS1: LDAA 0,X E380,81 20,, CMPA #SPC E382,26 04,, BNE BLANKS2 E384,5C,, INCB E385,08,, INX E386,20 F6,, BRA BLANKS1 ,,, * ,,, * if(spcnt==0) return; ,,, * E388,5D,BLANKS2:, BLANKS2: TSTB E389,26 02,, BNE BLANKS3 E38B,38,, PULX E38C,39,, RTS ,,, * ,,, * if(spcnt>1) ,,, * { ,,, * *tbufptr++=MSCNTOK; ,,, * *tbufptr++=spcnt; ,,, * } ,,, * E38D,DF 00,BLANKS3:, BLANKS3: STX IBUFPTR E38F,DE 02,, LDX TBUFPTR E391,C1 01,, CMPB #1 E393,27 0C,, BEQ BLANKS4 E395,86 7F,, LDAA #MSCNTOK E397,A7 00,, STAA 0,X E399,08,, INX E39A,E7 00,BLANKS5:, BLANKS5: STAB 0,X E39C,08,, INX E39D,DF 02,, STX TBUFPTR E39F,38,, PULX E3A0,39,, RTS ,,, * ,,, * else ,,, * { ,,, * *tbufptr++=SSCNTOK; ,,, * } ,,, * return; ,,, *} ,,, * E3A1,C6 7E,BLANKS4:, BLANKS4: LDAB #SSCNTOK E3A3,20 F5,, BRA BLANKS5 ,,, * ,,, * ,,, *<><><><><><><> NOTE: THIS FUNCTION NOT NEEDED <><><><><><><> ,,, * ,,, */************************************** ,,, * match() ,,, * try to find match between *lit and ,,, * *ibufptr. if match found, ibufptr is ,,, * advanced to point beyond *lit. the ,,, * string pointed to by lit must be null ,,, * terminated. ,,, ***************************************/ ,,, * ,,, *match(lit) ,,, *char *lit; ,,, *{ ,,, * int k; ,,, * if(k=streq(ibufptr,lit)) ,,, * { ,,, * ibufptr+=k; ,,, * return(1); ,,, * } ,,, * return(0); ,,, *} ,,, ,,, */**************************************** ,,, * streq() ,,, * compare srt1 to str2. str2 must be null ,,, * terminated. ,,, *****************************************/ ,,, * ,,, *streq(str1,str2) ,,, *char *str1,*str2; ,,, *{ ,,, * int k; ,,, * k=0; ,,, * while(str2[k]) /* we're not at the end of string2 */ ,,, * { ,,, * if((str1[k])!=(str2[k])) return(0); ,,, * k++; ,,, * } ,,, * return(k); ,,, *} ,,, * ,,, STREQ: EQU * E3A5,DC 00,, LDD IBUFPTR ; SAVE VALUE OF POINTER. ,,, * PSHD E3A7,37,, PSHB E3A8,36,, PSHA E3A9,A6 00,STREQU4:, STREQU4: LDAA 0,X E3AB,27 12,, BEQ STREQU2 E3AD,8D 1B,STREQU1:, STREQU1: BSR GETNXCHR E3AF,BD E0 FA,, jsr ToUpper ; Make the character upper case. E3B2,A1 00,, CMPA 0,X E3B4,27 06,, BEQ STREQU3 ,,, * PULD E3B6,32,, PULA E3B7,33,, PULB E3B8,DD 00,, STD IBUFPTR E3BA,0C,, CLC E3BB,39,, RTS E3BC,08,STREQU3:, STREQU3: INX E3BD,20 EA,, BRA STREQU4 E3BF,32,STREQU2:, STREQU2: PULA E3C0,33,, PULB E3C1,0D,, SEC E3C2,39,, RTS ,,, * ,,, * ,,, * THIS ROUTINE GETS THE NEXT CHARACTER FROM THE INPUT BUFFER. ,,, * ,,, * E3C3,3C,GETCHR:, GETCHR: PSHX ; SAVE THE X REGISTER. E3C4,DE 00,, LDX IBUFPTR ; GET POINTER. E3C6,A6 00,, LDAA 0,X ; GET A CHARACTER. E3C8,38,, PULX ; RESTORE X. E3C9,39,, RTS ; RETURN. ,,, * ,,, * ,,, * THIS ROUTINE GETS THE NEXT CHARACTER FROM THE INPUT BUFFER ,,, * AND ADVANCES THE POINTER TO POINT TO THE NEXT CHARACTER. ,,, * ,,, * E3CA,8D F7,GETNXCHR:, GETNXCHR: BSR GETCHR ,,, * FALL THROUGH TO INCIBP. ,,, * ,,, * ,,, * THIS ROUTINE JUST INCREMENTS THE INPUT BUFFER POINTER. ,,, * ,,, * E3CC,3C,INCIBP:, INCIBP: PSHX ; SAVE X. E3CD,DE 00,, LDX IBUFPTR ; GET POINTER. E3CF,08,INCIBP1:, INCIBP1: INX ; ADVANCE POINTER. E3D0,DF 00,, STX IBUFPTR ; UPDATE POINTER. E3D2,38,INCIBP2:, INCIBP2: PULX ; RESTORE X E3D3,39,, RTS ; RETURN. ,,, * ,,, * ,,, * THIS ROUTINE PUTS THE WORD IN THE D-REG. INTO THE TOKEN BUFFER ,,, * AND ADVANCES THE TOKEN BUFFER POINTER. ,,, * ,,, * E3D4,8D 01,PUTDTOK:, PUTDTOK: BSR PUTTOK ; PUT THE FIRST BYTE INTO THE TOKEN BUFFER. E3D6,17,, TBA ; PUT THE 2ND BYTE INTO A. ,,, * ; FALL THROUGH TO PUTTOK. ,,, * ,,, * ,,, * THIS ROUTINE PUTS THE CHARACTER IN THE A-REG. INTO THE TOKEN ,,, * BUFFER AND ADVANCES THE TOKEN BUFFER POINTER. ,,, * ,,, * E3D7,3C,PUTTOK:, PUTTOK: PSHX ; SAVE X. E3D8,37,, pshb E3D9,36,, psha ; (9/12/89). E3DA,DE 02,, LDX TBUFPTR ; GET POINTER. E3DC,A7 00,, STAA 0,X ; PUT CHARACTER. E3DE,08,PUTTOK1:, PUTTOK1: INX ; ADVANCE POINTER. E3DF,DF 02,, STX TBUFPTR ; SAVE POINTER. ,,, E3E1,DC 4B,, LDD TKNBUFS ; get the starting address of the token buffer. E3E3,C3 00 80,, ADDD #TBUFLEN ; add the length of the buffer to it. E3E6,1A 93 02,, CPD TBUFPTR ; IS THE TOKEN BUFFER FULL? E3E9,32,, pula ; (9/12/89). E3EA,33,, pulb ; restore the b reg. E3EB,22 E5,, BHI INCIBP2 ; NO. RESTORE X AND RETURN. E3ED,86 14,, LDAA #EXPCXERR ; YES. FLAG THE ERROR. E3EF,7E EA 98,, JMP RPTERR ; GO REPORT IT. ,,, #Include 'BASICLB2.Asm' ,,, * title BASICLB2 ,,, * page ,,, * ,,, * ,,, *<><><><><><> NOTE: FUNCTION PERFORMED IN "XLATE" <><><><><><> ,,, * ,,, */***** xmideol() *****/ ,,, * ,,, *xmideol() ,,, *{ ,,, * *tbufptr++=MEOLTOK; ,,, * ++ibufptr; ,,, * return; ,,, *} ,,, * ,,, * ,,, * ,,, */****** common code for GOSUB and GOTO *****/ ,,, * ,,, *xgo(gotok) ,,, *char gotok; ,,, *{ ,,, * int num; ,,, * *tbufptr++=gotok; /* put GOTO or GOSUB token in buffer */ ,,, * blanks(); /* skip blanks before line number */ ,,, * *tbufptr++=LCONTOK; /* put line number constant token in buffer */ ,,, * num=getlinum(); /* get line number */ ,,, * if(num==0) errcode=LINENERR; /* if 0, line number error */ ,,, * if(errcode) return; /* if error, return */ ,,, * putint(num); /* put line number in buffer */ ,,, * return; ,,, *} ,,, * ,,, XGOSUB: EQU * ,,, XGOTO: EQU * ,,, * JSR BLANKS E3F2,86 A8,, LDAA #LCONTOK E3F4,8D E1,, BSR PUTTOK E3F6,BD E1 6C,, JSR GETLINUM E3F9,20 D9,XGOTO2:, XGOTO2: BRA PUTDTOK ,,, * ,,, * ,,, *<><><><><><> ROUTINE NOT NEEDED <><><><><><> ,,, * ,,, */***** GOSUB *****/ ,,, * ,,, *xgosub() ,,, *{ ,,, * xgo(GOSUBTOK); ,,, * return; ,,, *} ,,, * ,,, * ,,, *<><><><><><> ROUTINE NOT NEEDED <><><><><><> ,,, * ,,, */***** GOTO *****/ ,,, * ,,, *xgoto() ,,, *{ ,,, * xgo(GOTOTOK); ,,, * return; ,,, *} ,,, ,,, */***** RETURN *****/ ,,, * ,,, *xreturn() ,,, *{ ,,, * *tbufptr++=RETNTOK; /* put RETURN token in buffer */ ,,, * return; ,,, *} ,,, * ,,, */***** STOP *****/ ,,, * ,,, *xstop() ,,, *{ ,,, * *tbufptr++=STOPTOK; /* put STOP token in buffer */ ,,, * return; ,,, *} ,,, * ,,, */***** END *****/ ,,, * ,,, *xend() ,,, *{ ,,, * *tbufptr++=ENDTOK; /* put end token in buffer */ ,,, * return; ,,, *} ,,, * ,,, */***** TRON *****/ ,,, * ,,, *xtron() ,,, *{ ,,, * *tbufptr++=TRONTOK; /* put TRON token in buffer */ ,,, * return; ,,, *} ,,, * ,,, */***** TROFF *****/ ,,, * ,,, *xtroff() ,,, *{ ,,, * *tbufptr++=TROFFTOK; /* put TROFF token in buffer */ ,,, * return; ,,, *} ,,, * ,,, XRETURN: EQU * ,,, XSTOP: EQU * ,,, XEND: EQU * ,,, XTRON: EQU * ,,, XTROFF: EQU * ,,, XRESTORE: EQU * ,,, XENDWH: EQU * ,,, XRETI: EQU * ,,, XSLEEP: EQU * ,,, XRTIME: EQU * E3FB,39,, RTS ; NULL FUNCTIONS BECAUSE TOKEN PLACEMENT IS DONE IN ,,, * ; XLATE FUNCTION. ,,, * ,,, ,,, */***** REM *****/ ,,, * ,,, *xrem() ,,, *{ ,,, * char c; ,,, * *tbufptr++=REMTOK; /* put rem token in buffer */ ,,, * while(1) ,,, * { ,,, * if((c=*ibufptr)==EOL) break; ,,, * *tbufptr++=c; ,,, * ++ibufptr; ,,, * } ,,, * return; ,,, *} ,,, * ,,, * ,,, */***** xdata() *****/ ,,, * ,,, *xdata() ,,, *{ ,,, * char c; ,,, * *tbufptr++=DATATOK; /* put DATA token in buffer */ ,,, * while((c=*ibufptr)!=EOL) ,,, * { ,,, * if(c==',') *tbufptr++=COMMATOK; ,,, * else *tbufptr++=c; ,,, * ++ibufptr; ,,, * } ,,, * return; ,,, *} ,,, * ,,, XDATA: EQU * ,,, XREM: EQU * E3FC,DE 02,, LDX TBUFPTR ; GET POINTER TO TOKEN BUFFER. E3FE,3C,, PSHX ; SAVE IT. (POINTER TO LENGTH OF REM OR DATA) E3FF,86 00,, LDAA #0 ; SAVE A BYTE FOR THE LENGTH. E401,8D D4,, BSR PUTTOK E403,C6 02,, LDAB #2 ; INITALIZE LENGTH TO 2 (INCLUDES LENGTH & EOL. E405,8D BC,XREM1:, XREM1: BSR GETCHR E407,81 0D,, CMPA #EOL E409,27 07,, BEQ XREM2 E40B,8D CA,, BSR PUTTOK E40D,8D BD,, BSR INCIBP E40F,5C,, INCB ; UP THE BYTE COUNT. E410,20 F3,, BRA XREM1 E412,8D C3,XREM2:, XREM2: BSR PUTTOK E414,38,, PULX ; GET POINTER TO LENGTH BYTE. E415,E7 00,, STAB 0,X ; PUT IT IN THE TOKEN BUFFER. E417,39,, RTS ,,, * ,,, * ,,, XPORTA: EQU * ,,, XPORTB: EQU * ,,, XPORTC: EQU * ,,, XPORTD: EQU * E418,C6 01,, LDAB #NUM ; WE'RE XLATING A NUMERICAL STATEMENT. E41A,20 04,, BRA ASIGNMT1 ; GO DO IT LIKE AN ASIGNMENT STATEMENT. ,,, * ,,, * ,,, * ,,, * ,,, ,,, */***** LET *****/ ,,, * ,,, *xlet() ,,, *{ ,,, * letcom(LETTOK); /* pass LET token to common code */ ,,, * return; ,,, *} ,,, * ,,, */***** implied LET *****/ ,,, * ,,, *ximplet() ,,, *{ ,,, * letcom(IMLETTOK); ,,, * return; ,,, *} ,,, * ,,, */***** common code for explicit & implicit LET *****/ ,,, * ,,, *letcom(letok) ,,, *short letok; ,,, *{ ,,, * *tbufptr++=letok; /* put LET token in buffer */ ,,, * blanks(); /* skip blanks before assignment statement */ ,,, * if(ibufptr=='@') { *tbufptr++=INDIRTOK; ++ibufptr; } ,,, * asignmt(); /* evaluate expression */ ,,, * return; ,,, *} ,,, * ,,, XLET: EQU * ,,, XIMPLET: EQU * ,,, * JSR BLANKS ,,, *XLET1 JMP ASIGNMT ,,, * ,,, * ,,, ,,, */***** asignmt() *****/ ,,, * ,,, *asignmt() ,,, *{ ,,, *short type; ,,, * if((type=getvar())==0) return; /* get variable & return type */ ,,, * if(errcode) return; ,,, * if(*ibufptr++!='=') { errcode=IVEXPERR; return; } /* invalid expression */ ,,, * *tbufptr++=EQUALTOK; /* put equals token in buffer */ ,,, * xexpres(type); /* build expression in token buffer */ ,,, * return; ,,, *} ,,, * ,,, ASIGNMT: EQU * E41C,BD E5 57,, JSR GETVAR E41F,16,, TAB E420,8D A8,ASIGNMT1:, ASIGNMT1: BSR GETNXCHR E422,81 3D,, CMPA #'=' E424,27 05,, BEQ ASIGNMT2 E426,86 03,, LDAA #IVEXPERR E428,7E EA 98,, JMP RPTERR E42B,86 79,ASIGNMT2:, ASIGNMT2: LDAA #EQUALTOK E42D,8D A8,, BSR PUTTOK E42F,17,, TBA ,,, * FALL THROUGH TO XEXPRES. ,,, * ,,, * ,,, ,,, */***** xexpres() *****/ ,,, * ,,, *xexpres(type) ,,, *short type; ,,, *{ ,,, * char c; ,,, * while(1) ,,, * { ,,, * if(match("-")) *tbufptr++=NEGTOK; ,,, * else if(match("@")) *tbufptr++=INDIRTOK; ,,, * else if(match("NOT")) *tbufptr++=NOTTOK; ,,, XEXPRES: EQU * E430,18 3C,, PSHY E432,36,, PSHA E433,18 30,, TSY E435,CE E5 4E,XEXPRS29:, XEXPRS29: LDX #UINARYOP E438,BD E4 FD,, JSR TBLSRCH E43B,24 02,, BCC XEXPRS30 E43D,8D 98,, BSR PUTTOK ,,, * ,,, * if(*ibufptr=='(') /* open paren? */ ,,, * { ,,, * *tbufptr++=OPARNTOK; /* put in token buffer */ ,,, * ++ibufptr; /* point to next char in input buffer */ ,,, * xexpres(type); /* go get sub expression */ ,,, * if(errcode) return; ,,, * if(*ibufptr!=')') { errcode=UPARNERR; return; } ,,, * *tbufptr++=CPARNTOK; /* put it in the token buffer */ ,,, * ++ibufptr; /* point to the next char in the input buffer */ ,,, * goto chkoprtr; ,,, * } ,,, * E43F,BD E3 C3,XEXPRS30:, XEXPRS30: JSR GETCHR E442,81 28,, CMPA #'(' E444,26 22,, BNE XEXPRS1 E446,BD E3 CC,, JSR INCIBP E449,86 10,, LDAA #OPARNTOK E44B,BD E3 D7,, JSR PUTTOK E44E,18 A6 00,, LDAA 0,Y E451,BD E4 30,, JSR XEXPRES E454,BD E3 CA,XEXPRS2:, XEXPRS2: JSR GETNXCHR E457,81 29,, CMPA #')' E459,27 05,, BEQ XEXPRS3 E45B,86 04,, LDAA #UPARNERR E45D,7E EA 98,, JMP RPTERR E460,86 11,XEXPRS3:, XEXPRS3: LDAA #CPARNTOK E462,BD E3 D7,, JSR PUTTOK E465,7E E4 97,, JMP CHKOPRTR ,,, * ,,, * if((numeric(*ibufptr)) | (*ibufptr=='$') | (*ibufptr=='"')) ,,, * { ,,, * c=getcon(); ,,, * if(errcode) return; ,,, * } ,,, * else if(c=getfun()) ; ,,, * else (c=getvar()) ; ,,, * if(errcode) return; ,,, * if(type==NULL) type=c; ,,, * if(c!=type) { errcode=DTMISERR; return; } ,,, * ,,, XEXPRS1: EQU * E468,BD E1 BB,, JSR NUMERIC E46B,25 08,, BCS XEXPRS4 E46D,81 24,, CMPA #'$' E46F,27 04,, BEQ XEXPRS4 E471,81 22,, CMPA #'"' E473,26 05,, BNE XEXPRS5 E475,BD E6 6C,XEXPRS4:, XEXPRS4: JSR GETCON E478,20 09,, BRA XEXPRS7 E47A,BD E7 67,XEXPRS5:, XEXPRS5: JSR GETFUN E47D,4D,, TSTA E47E,26 03,, BNE XEXPRS7 E480,BD E5 57,, JSR GETVAR E483,18 E6 00,XEXPRS7:, XEXPRS7: LDAB 0,Y E486,C1 00,, CMPB #NULL E488,26 03,, BNE XEXPRS8 E48A,18 A7 00,, STAA 0,Y E48D,18 A1 00,XEXPRS8:, XEXPRS8: CMPA 0,Y E490,27 05,, BEQ XEXPRS9 E492,86 05,, LDAA #DTMISERR E494,7E EA 98,, JMP RPTERR ,,, XEXPRS9: EQU * ,,, * ,,, * ,,, */* now look for operator or end of expression */ ,,, * ,,, * chkoprtr: ,,, * c=*ibufptr; ,,, * if(c==EOL | c==MIDEOL | c==SPC | c==COMMA | c==SEMI | c==')') ,,, * { ,,, * return(c); ,,, * } ,,, * ,,, CHKOPRTR: EQU * E497,BD E3 C3,, JSR GETCHR E49A,81 0D,, CMPA #EOL E49C,27 40,, BEQ XEXPRS24 E49E,81 3A,, CMPA #MIDEOL E4A0,27 3C,, BEQ XEXPRS24 E4A2,81 20,, CMPA #SPC E4A4,27 38,, BEQ XEXPRS24 E4A6,81 2C,, CMPA #COMMA E4A8,27 34,, BEQ XEXPRS24 E4AA,81 3B,, CMPA #SEMI E4AC,27 30,, BEQ XEXPRS24 E4AE,81 29,, CMPA #')' E4B0,27 2C,, BEQ XEXPRS24 ,,, * ,,, * ,,, * if(type==NUM) ,,, * { ,,, * if(c=cknumop()) ; ,,, * else if(c=ckbolop()) ; ,,, * else if(ifwhflag) c=cklogop(); ,,, * else c=NULL; ,,, * } ,,, XEXPRS15: EQU * E4B2,18 A6 00,, LDAA 0,Y E4B5,81 01,, CMPA #NUM E4B7,26 18,, BNE XEXPRS21 E4B9,BD E4 E8,, JSR CKNUMOP E4BC,25 18,, BCS XEXPRS17 E4BE,BD E4 F3,, JSR CKBOLOP E4C1,25 13,, BCS XEXPRS17 E4C3,7D 00 1A,, TST IFWHFLAG E4C6,27 05,, BEQ XEXPRS18 E4C8,BD E4 F8,, JSR CKLOGOP E4CB,20 09,, BRA XEXPRS17 E4CD,86 00,XEXPRS18:, XEXPRS18: LDAA #NULL E4CF,20 05,, BRA XEXPRS17 ,,, * ,,, * ,,, * else { errcode=IDTYERR; return; } ,,, * ,,, XEXPRS21: EQU * E4D1,86 13,, LDAA #IDTYERR E4D3,7E EA 98,, JMP RPTERR ,,, * ,,, * ,,, * if(c==NULL) { errcode=OPRTRERR; return; } ,,, * *tbufptr++=c; ,,, * } ,,, * return; ,,, *} ,,, * ,,, XEXPRS17: EQU * E4D6,4D,, TSTA E4D7,26 09,, BNE XEXPRS23 E4D9,86 06,, LDAA #OPRTRERR E4DB,7E EA 98,, JMP RPTERR E4DE,31,XEXPRS24:, XEXPRS24: INS E4DF,18 38,, PULY E4E1,39,, RTS E4E2,BD E3 D7,XEXPRS23:, XEXPRS23: JSR PUTTOK E4E5,7E E4 35,, JMP XEXPRS29 ,,, * ,,, * ,,, */***** cknumop() *****/ ,,, * ,,, *cknumop() ,,, *{ ,,, * if(match("+")) return(PLUSTOK); ,,, * else if(match("-")) return(MINUSTOK); ,,, * else if(match("*")) return(MULTTOK); ,,, * else if(match("/")) return(DIVTOK); ,,, * else if(match("\\")) return(MODTOK); ,,, * else if(match("^")) return(PWRTOK); ,,, * else return(NULL); ,,, *} ,,, * ,,, CKNUMOP: EQU * E4E8,CE E5 13,, LDX #NUMOPTBL ,,, * E4EB,BD E4 FD,CKOP:, CKOP: JSR TBLSRCH E4EE,25 02,, BCS CKOP1 E4F0,86 00,, LDAA #NULL E4F2,39,CKOP1:, CKOP1: RTS ,,, * ,,, * ,,, ,,, */***** ckbolop() *****/ ,,, * ,,, *ckbolop() ,,, *{ ,,, * if(match("AND")) return(ANDTOK); ,,, * else if(match("OR")) return(ORTOK); ,,, * else if(match("EOR")) return(EORTOK); ,,, * else return(NULL); ,,, *} ,,, * ,,, CKBOLOP: EQU * E4F3,CE E5 23,, LDX #BOLOPTBL E4F6,20 F3,, BRA CKOP ,,, * ,,, * ,,, ,,, */***** cklogop() *****/ ,,, * ,,, *cklogop() ,,, *{ ,,, * if(match("<=")) return(LTEQTOK); ,,, * else if(match(">=")) return(GTEQTOK); ,,, * else if(match("<>")) return(NOTEQTOK); ,,, * else if(match("<")) return(LTTOK); ,,, * else if(match(">")) return(GTTOK); ,,, * else if(match("=")) return(EQTOK); ,,, * else return(NULL); ,,, *} ,,, * ,,, CKLOGOP: EQU * E4F8,CE E5 38,, LDX #LOGOPTBL E4FB,20 EE,, BRA CKOP ,,, * ,,, * ,,, * ,,, * ,,, *<><><><><> NOTE: THIS ROUTINE HAS NO 'C' COUNTER PART <><><><><><> ,,, * ,,, TBLSRCH: EQU * E4FD,BD E3 A5,, JSR STREQ ; SEARCH FOR STRING. E500,25 0D,, BCS TBLSRCH1 ; IF FOUND GO GET TOKEN & RETURN. E502,08,TBLSRCH2:, TBLSRCH2: INX ; BUMP POINTER TO NEXT CHAR. E503,A6 00,, LDAA 0,X ; GET IT. E505,26 FB,, BNE TBLSRCH2 ; KEEP LOOKING FOR END OF ENTRY. E507,08,, INX ; FOUND IT. BUMP POINTER TO NEXT ENTRY. E508,08,, INX E509,A6 00,, LDAA 0,X ; AT THE END OF THE TABLE? E50B,26 F0,, BNE TBLSRCH ; NO. GO CHECK THE NEXT ENTRY. E50D,0C,, CLC ; YES. FLAG AS NOT FOUND. E50E,39,, RTS ; RETURN. E50F,A6 01,TBLSRCH1:, TBLSRCH1: LDAA 1,X ; GET TOKEN. E511,0D,, SEC ; FLAG AS FOUND. E512,39,, RTS ; RETURN. ,,, * ,,, * ,,, NUMOPTBL: EQU * E513,2B,PLUS:, PLUS: FCC "+" E514,00,, FCB 0 E515,40,, FCB PLUSTOK E516,2D,MINUS:, MINUS: FCC "-" E517,00,, FCB 0 E518,41,, FCB MINUSTOK E519,2A,MULT:, MULT: FCC "*" E51A,00,, FCB 0 E51B,50,, FCB MULTTOK E51C,2F,DIV:, DIV: FCC "/" E51D,00,, FCB 0 E51E,51,, FCB DIVTOK E51F,5C,MODS:, MODS: FCB $5C,$00 E520,00,, E521,52,, FCB MODTOK E522,00,, FCB 0 ; END OF TABLE FLAG. ,,, * ,,, BOLOPTBL: EQU * E523,2E 41 4E 44 2E,ANDS:, ANDS: FCC ".AND." E528,00,, FCB 0 E529,20,, FCB ANDTOK E52A,2E 4F 52 2E,ORS:, ORS: FCC ".OR." E52E,00,, FCB 0 E52F,21,, FCB ORTOK E530,2E 45 4F 52 2E,EORS:, EORS: FCC ".EOR." E535,00,, FCB 0 E536,22,, FCB EORTOK E537,00,, FCB 0 ; END OF TABLE FLAG. ,,, * ,,, LOGOPTBL: EQU * E538,3C 3D,LTEQ:, LTEQ: FCC "<=" E53A,00,, FCB 0 E53B,32,, FCB LTEQTOK E53C,3E 3D,GTEQ:, GTEQ: FCC ">=" E53E,00,, FCB 0 E53F,33,, FCB GTEQTOK E540,3C 3E,NOTEQ:, NOTEQ: FCC "<>" E542,00,, FCB 0 E543,35,, FCB NOTEQTOK E544,3C,LT:, LT: FCC "<" E545,00,, FCB 0 E546,30,, FCB LTTOK E547,3E,GT:, GT: FCC ">" E548,00,, FCB 0 E549,31,, FCB GTTOK E54A,3D,EQ:, EQ: FCC "=" E54B,00,, FCB 0 E54C,34,, FCB EQTOK E54D,00,, FCB 0 ; END OF TABLE FLAG. ,,, * ,,, * ,,, UINARYOP: EQU * E54E,2D,NEGS:, NEGS: FCC "-" E54F,00,, FCB 0 E550,72,, FCB NEGTOK E551,4E 4F 54,NOTS:, NOTS: FCC "NOT" E554,00,, FCB 0 E555,71,, FCB NOTTOK E556,00,, FCB 0 ; END OF TABLE MARKER. ,,, * ,,, #Include 'BASICLB3.Asm' ,,, * title BASICLB3 ,,, * page ,,, * ,,, * ,,, */***** getvar *****/ ,,, * ,,, */* tries to make a variable out of what is currently being pointed to by */ ,,, */* 'ibufptr' and places it into the variable symbol table if it is not */ ,,, */* already there */ ,,, * ,,, *getvar() ,,, *{ ,,, * short vartype,cnt; ,,, * char varname[3]; ,,, * int offset; ,,, * for(cnt=0; cnt<=2; cnt++) { varname[cnt]=0; } /* clr out var name */ ,,, * if(alpha(*ibufptr)) { varname[0]=*ibufptr++; } /* is 1st char an alpha? */ ,,, * else { errcode=ILVARERR; return(0); } /* no. error */ ,,, * ,,, GETVAR: EQU * E557,18 3C,, PSHY E559,4F,, CLRA E55A,36,, PSHA E55B,36,, PSHA E55C,36,, PSHA E55D,36,, PSHA E55E,18 30,, TSY E560,BD E3 C3,, JSR GETCHR E563,BD E1 C7,, JSR ALPHA E566,25 05,, BCS GETVAR1 E568,86 07,, LDAA #ILVARERR E56A,7E EA 98,, JMP RPTERR E56D,BD E0 FA,GETVAR1:, GETVAR1: jsr ToUpper E570,18 A7 00,, STAA 0,Y E573,BD E3 CC,, JSR INCIBP ,,, * ,,, * ,,, * if(alphanum(*ibufptr)) { varname[1]=*ibufptr++; } ,,, * if((vartype=chcktyp())==0) { vartype=FVARTOK; } ,,, * else { ++ibufptr; } ,,, * E576,BD E3 C3,, JSR GETCHR E579,BD E1 DB,, JSR ALPHANUM E57C,24 09,, BCC GETVAR2 E57E,BD E0 FA,, jsr ToUpper E581,18 A7 01,, STAA 1,Y E584,BD E3 CC,, JSR INCIBP E587,BD E5 E0,GETVAR2:, GETVAR2: JSR CHCKTYP E58A,18 A7 03,, STAA 3,Y ,,, * ,,, * ,,, * if((offset=findvar(vartype,varname))==-1) /* is var already in table? */ ,,, * { ,,, * if(errcode) return; ,,, * if((offset=putvar(vartype,varname))==-1) return; /* no. put it there */ ,,, * } ,,, * if(errcode) return; ,,, * E58D,BD E5 EE,, JSR FINDVAR E590,1A 83 FF FF,, CPD #-1 E594,26 06,, BNE GETVAR5 E596,18 A6 03,GETVAR4:, GETVAR4: LDAA 3,Y E599,BD E6 26,, JSR PUTVAR ,,, * ,,, * ,,, * *tbufptr++=vartype; /* put variable type byte in token buffer */ ,,, * putint(offset); /* put offset after it */ ,,, * if((vartype==IVARTOK) | (vartype==FVARTOK)) return(NUM); ,,, * return(STRING); ,,, *} ,,, * ,,, GETVAR5: EQU * ,,, * PSHD E59C,37,, PSHB E59D,36,, PSHA E59E,18 A6 03,, LDAA 3,Y E5A1,BD E3 D7,, JSR PUTTOK ,,, * PULD E5A4,32,, PULA E5A5,33,, PULB E5A6,BD E3 D4,, JSR PUTDTOK E5A9,18 A6 03,, LDAA 3,Y ; GET VARIABLE TYPE AGAIN. E5AC,85 10,, BITA #$10 ; IS IT AN ARRAY VARIABLE? E5AE,27 1E,, BEQ GETVAR7 ; NO. CONTINUE. E5B0,BD E3 CC,, JSR INCIBP ; MOVE THE INPUT BUFFER POINTER PAST THE OPEN (. E5B3,86 10,, LDAA #OPARNTOK E5B5,BD E3 D7,, JSR PUTTOK E5B8,86 01,, LDAA #NUM ; YES. SUBSCRIPT EXPRESSION MUST BE NUMERIC. E5BA,BD E4 30,, JSR XEXPRES ; GO GET THE SUBSCRIPT. E5BD,BD E3 CA,, JSR GETNXCHR ; GET THE TERMINATING CHARACTER. E5C0,81 29,, CMPA #')' ; IS IT A CLOSING PAREN? E5C2,27 05,, BEQ GETVAR8 ; YES. GO FINISH UP. E5C4,86 0E,, LDAA #MPARNERR ; NO. ERROR. E5C6,7E EA 98,, JMP RPTERR E5C9,86 11,GETVAR8:, GETVAR8: LDAA #CPARNTOK ; GET CLOSING PAREN TOKEN. E5CB,BD E3 D7,, JSR PUTTOK ; PUT TOKEN IN BUFFER. E5CE,86 01,GETVAR7:, GETVAR7: LDAA #NUM ; NO. RETURN PROPER TYPE. E5D0,18 E6 03,, LDAB 3,Y E5D3,C5 02,, BITB #2 E5D5,27 02,, BEQ GETVAR6 E5D7,86 02,, LDAA #STRING E5D9,31,GETVAR6:, GETVAR6: INS E5DA,31,, INS E5DB,31,, INS E5DC,31,, INS E5DD,18 38,, PULY E5DF,39,, RTS ,,, * ,,, * ,,, * ,,, */***** chcktype *****/ ,,, * ,,, *chcktyp() ,,, *{ ,,, * if(*ibufptr=='%') return(IVARTOK); ,,, * else if(*ibufptr=='$') return(SVARTOK); ,,, * else return(0); ,,, *} ,,, * ,,, CHCKTYP: EQU * E5E0,86 84,, LDAA #IVARTOK ; IN V1.0 ONLY INTEGER VARIABLES ARE SUPPORTED. E5E2,36,, PSHA ; IN V2.0 FLOATING POINT VARIABLES WILL BE E5E3,BD E3 C3,, JSR GETCHR ; SUPPORTED. E5E6,81 28,, CMPA #'(' ; IS A SUBSCRIPT FOLLOWING THE NAME? E5E8,32,, PULA ; RESTORE THE TOKEN TYPE. E5E9,26 02,, BNE CHCKTYP4 ; NO. RETURN. E5EB,8B 10,, ADDA #$10 ; YES. MAKE IT AN ARRAY VARIABLE. E5ED,39,CHCKTYP4:, CHCKTYP4: RTS ; RETURN. ,,, * ,,, */***** findvar *****/ ,,, * ,,, *findvar(vartype,varname) ,,, *short vartype; ,,, *char *varname; ,,, *{ ,,, * char *varptr; ,,, * varptr=varbegin; /* point to the start of the var table */ ,,, * while(*varptr) /* we're not to the end of the table */ ,,, * ,,, FINDVAR: EQU * E5EE,DE 08,, LDX VARBEGIN E5F0,6D 00,FINDVAR1:, FINDVAR1: TST 0,X E5F2,27 2E,, BEQ FINDVAR2 ,,, * ,,, * { ,,, * if(*varptr==vartype) /* is the current var the same type? */ ,,, * { /* yes. */ ,,, * if(streq(varptr+1,varname)) /* is the name the same? */ ,,, * { /* yes. */ ,,, * return(varptr-varbegin); /* return the offset from the table start */ ,,, * } ,,, * } ,,, * E5F4,A1 00,, CMPA 0,X E5F6,26 12,, BNE FINDVAR3 E5F8,E6 01,, LDAB 1,X E5FA,18 E1 00,, CMPB 0,Y E5FD,26 0B,, BNE FINDVAR3 E5FF,E6 02,, LDAB 2,X E601,18 E1 01,, CMPB 1,Y E604,26 04,, BNE FINDVAR3 E606,8F,, XGDX E607,93 08,, SUBD VARBEGIN E609,39,, RTS ,,, * ,,, * /* if not, advance to the next variable in the table */ ,,, * if(*varptr==IVARTOK) varptr=varptr+ISIZ+3; ,,, * else if(*varptr==SVARTOK) varptr=varptr+SSIZ+3; ,,, * else if(*varptr==FVARTOK) varptr=varptr+FSIZ+3; ,,, * else { errcode=ILTOKERR; return(-1); } ,,, * } ,,, * ,,, FINDVAR3: EQU * E60A,E6 00,, LDAB 0,X E60C,C5 10,, BITB #$10 ; IS IT AN ARRAY VARIABLE? E60E,27 04,, BEQ FINDVAR8 ; NO CONTINUE. E610,C6 05,, LDAB #ASIZ+3 ; YES. GET ARRAY SIZE +3. E612,20 06,, BRA FINDVAR7 E614,C1 84,FINDVAR8:, FINDVAR8: CMPB #IVARTOK E616,26 05,, BNE FINDVAR6 E618,C6 05,, LDAB #ISIZ+3 E61A,3A,FINDVAR7:, FINDVAR7: ABX E61B,20 D3,, BRA FINDVAR1 E61D,86 08,FINDVAR6:, FINDVAR6: LDAA #ILTOKERR E61F,7E EA 98,, JMP RPTERR E622,CC FF FF,FINDVAR2:, FINDVAR2: LDD #-1 E625,39,, RTS ,,, * ,,, * return(-1); ,,, *} ,,, * ,,, * ,,, * ,,, */***** putvar *****/ ,,, * ,,, *putvar(vartype,varname) ,,, *short vartype; ,,, *char *varname; ,,, *{ ,,, *short count,n; ,,, *char *varadd; ,,, * varadd=varend; /* save begining addr of var we are storing */ ,,, * *varend++=vartype; /* put token/type in variable symbol table */ ,,, * *varend++=*varname++; /* put variable name in */ ,,, * *varend++=*varname++; ,,, * ,,, PUTVAR: EQU * E626,DE 0A,, LDX VAREND E628,3C,, PSHX E629,A7 00,, STAA 0,X E62B,08,, INX E62C,18 E6 00,, LDAB 0,Y E62F,E7 00,, STAB 0,X E631,08,, INX E632,18 E6 01,, LDAB 1,Y E635,E7 00,, STAB 0,X E637,08,, INX ,,, * ,,, * if(vartype==IVARTOK) count=ISIZ+1; /* determine # of bytes for this */ ,,, * else if(vartype==SVARTOK) count=SSIZ+1;/* variable */ ,,, * else if(vartype==FVARTOK) count=FSIZ+1; ,,, * else { errcode=ILTOKERR; return(-1); } ,,, * for(n=1;n<=count;n++) *varend++=0; /* zero the storage */ ,,, * --varend; ,,, * if(varend > varmend) { errcode=OMEMERR; return(-1); } /* memory overflow? */ ,,, * vmemavil-=count; /* decrement the amt of avail memory */ ,,, * return(varadd-varbegin); /* return offset */ ,,, *} ,,, * E638,8D 18,, BSR CLRVAR E63A,6F 00,, CLR 0,X ; CLEAR 1 BYTE BEYOND THE END OF THE VAR AREA. E63C,DF 0A,, STX VAREND E63E,9C 10,, CPX VARMEND E640,23 04,, BLS PUTVAR5 E642,86 09,, LDAA #OMEMERR E644,20 23,, BRA CLRVAR6 ,,, PUTVAR5: EQU * ,,, * PULD E646,32,, PULA E647,33,, PULB E648,93 08,, SUBD VARBEGIN ,,, * PSHD ; SAVE THE OFFSET TO THIS VARIABLE. E64A,37,, PSHB E64B,36,, PSHA E64C,BD F2 DE,, JSR CCLEAR3 ; CLEAR ALL VARIABLES SINCE WE MAY HAVE TRASHED ,,, * ANY ARRAYS THAT HAD BEEN ALLOCATED. ,,, * PULD RESTORE THE "NEW" VARIABLE OFFSET. E64F,32,, PULA E650,33,, PULB E651,39,, RTS ,,, * ,,, * ,,, CLRVAR: EQU * E652,85 10,, BITA #$10 ; IS IT AN ARRAY VARIABLE? E654,27 04,, BEQ CLRVAR8 ; NO. CONTINUE. E656,C6 02,, LDAB #ASIZ ; YES. GET THE DICTIONARY SIZE+1. E658,20 06,, BRA CLRVAR1 ; PUT THE VARIABLE IN THE DICTIONARY. E65A,81 84,CLRVAR8:, CLRVAR8: CMPA #IVARTOK E65C,26 09,, BNE CLRVAR4 E65E,C6 02,, LDAB #ISIZ ,,, CLRVAR1: EQU * E660,6F 00,, CLR 0,X E662,08,, INX E663,5A,, DECB E664,26 FA,, BNE CLRVAR1 E666,39,, RTS E667,86 08,CLRVAR4:, CLRVAR4: LDAA #ILTOKERR E669,7E EA 98,CLRVAR6:, CLRVAR6: JMP RPTERR ,,, * ,,, * ,,, */***** getcon() *****/ ,,, * ,,, *getcon() ,,, *{ ,,, * int const; ,,, * char *litp; ,,, * short count; ,,, * litp=ibufptr; /* save a pointer to start of constant */ ,,, * if(*ibufptr=='"') { getscon(); return(STRING); } /* if " get strng */ ,,, * ,,, GETCON: EQU * E66C,BD E3 C3,, JSR GETCHR ,,, * ,,, * ,,, * else if(*ibufptr=='$') { ++ibufptr; const=gethex(); } /* if '$' get hex */ ,,, * else const=getdeci(); /* else assume its a decimal constant */ ,,, * if(errcode) return(0); /* if error abort */ ,,, * ,,, GETCON2: EQU * E66F,DE 00,, LDX IBUFPTR E671,3C,, PSHX E672,81 24,, CMPA #'$' E674,26 08,, BNE GETCON3 E676,BD E3 CC,, JSR INCIBP E679,BD E6 CF,, JSR GETHEX E67C,20 03,, BRA GETCON4 E67E,BD E6 A1,GETCON3:, GETCON3: JSR GETDECI ,,, * ,,, * ,,, * *tbufptr++=ICONTOK; /* put integer constant token in buffer */ ,,, * putint(const); /* follow it with the constant */ ,,, * count=ibufptr-litp; /* get number of bytes in source form of const. */ ,,, * *tbufptr++=count; /* put it in the token buffer */ ,,, * while(litp < ibufptr) *tbufptr++=*litp++; /* copy source form into buffer */ ,,, * return(NUM); /* return the constant type */ ,,, * } ,,, * ,,, GETCON4: EQU * E681,36,, PSHA E682,86 A4,, LDAA #ICONTOK E684,BD E3 D7,, JSR PUTTOK E687,32,, PULA E688,BD E3 D4,, JSR PUTDTOK E68B,DC 00,, LDD IBUFPTR E68D,30,, TSX E68E,A3 00,, SUBD 0,X E690,17,, TBA E691,BD E3 D7,, JSR PUTTOK E694,38,, PULX E695,A6 00,GETCON5:, GETCON5: LDAA 0,X E697,BD E3 D7,, JSR PUTTOK E69A,08,, INX E69B,5A,, DECB E69C,26 F7,, BNE GETCON5 E69E,86 01,, LDAA #NUM E6A0,39,, RTS ,,, * ,,, * ,,, */***** getdeci() *****/ ,,, * ,,, *getdeci() ,,, *{ ,,, * char c; ,,, * int num; ,,, * num=0; ,,, * if(numeric(*ibufptr)==0) /* is 1st char numeric? */ ,,, * { errcode=SYTXERR; return; } /* no. flag error & return */ ,,, * while(numeric(c=*ibufptr)) /* yes. while *ibufptr is numeric */ ,,, * { ,,, * num=num*10+(c-'0'); /* build number */ ,,, * if(num < 0) { errcode=INTOVERR; return; } /* if <0 flag error & ret */ ,,, * ++ibufptr; ,,, * } ,,, * return(num); /* return the value */ ,,, *} ,,, * ,,, GETDECI: EQU * E6A1,18 3C,, PSHY E6A3,4F,, CLRA E6A4,36,, PSHA E6A5,36,, PSHA E6A6,18 30,, TSY E6A8,DE 00,, LDX IBUFPTR E6AA,A6 00,, LDAA 0,X E6AC,BD E1 BB,, JSR NUMERIC E6AF,25 04,, BCS GETDECI1 E6B1,86 02,, LDAA #SYTXERR E6B3,20 2C,, BRA CHCKERR E6B5,A6 00,GETDECI1:, GETDECI1: LDAA 0,X E6B7,BD E1 BB,, JSR NUMERIC E6BA,24 09,, BCC GETDECI3 E6BC,BD E1 9B,, JSR ADDDIG E6BF,2A F4,, BPL GETDECI1 E6C1,86 0A,, LDAA #INTOVERR E6C3,20 1C,, BRA CHCKERR E6C5,DF 00,GETDECI3:, GETDECI3: STX IBUFPTR E6C7,18 EC 00,, LDD 0,Y E6CA,31,, INS E6CB,31,, INS E6CC,18 38,, PULY E6CE,39,, RTS ,,, * ,,, * ,,, */***** gethex() *****/ ,,, * ,,, *gethex() ,,, *{ ,,, * char c; ,,, * short count; ,,, * int num; ,,, * num=count=0; ,,, * if(hexdig(*ibufptr)==0) /* is the char a hex digit? */ ,,, * { errcode=IVHEXERR; return; } /* no. flag error & return */ ,,, * ,,, GETHEX: EQU * E6CF,18 3C,, PSHY E6D1,4F,, CLRA E6D2,36,, PSHA E6D3,36,, PSHA E6D4,18 30,, TSY E6D6,DE 00,, LDX IBUFPTR E6D8,A6 00,, LDAA 0,X E6DA,BD E7 21,, JSR HEXDIG E6DD,25 0D,, BCS GETHEX1 E6DF,86 0B,, LDAA #IVHEXERR E6E1,7D 00 1D,CHCKERR:, CHCKERR: TST RUNFLAG E6E4,27 03,, BEQ GETHEX5 E6E6,7E EA EF,, JMP RPTRERR E6E9,7E EA 98,GETHEX5:, GETHEX5: JMP RPTERR ,,, * ,,, * ,,, * while(hexdig(c=*ibufptr)) /* while a hex digit is in the buffer */ ,,, * { ,,, * if(numeric(c)) num=num*16+(c-'0'); /* build the number */ ,,, * else num=num*16+(c-55); ,,, * if(count++ > 4) ,,, * { errcode=HEXOVERR; return; } /* if over 4 digits flag overflow & ret */ ,,, * ++ibufptr; ,,, * } ,,, * return(num); /* return constant value */ ,,, *} ,,, * ,,, GETHEX1: EQU * E6EC,A6 00,, LDAA 0,X E6EE,BD E7 21,, JSR HEXDIG E6F1,24 D2,, BCC GETDECI3 E6F3,18 EC 00,, LDD 0,Y E6F6,05,, LSLD E6F7,25 24,, BCS GETHEX3 E6F9,05,, LSLD E6FA,25 21,, BCS GETHEX3 E6FC,05,, LSLD E6FD,25 1E,, BCS GETHEX3 E6FF,05,, LSLD E700,25 1B,, BCS GETHEX3 E702,18 ED 00,, STD 0,Y E705,A6 00,, LDAA 0,X E707,BD E0 FA,, JSR ToUpper E70A,16,, TAB E70B,08,, INX E70C,C0 30,, SUBB #'0' E70E,C1 09,, CMPB #9 E710,23 02,, BLS GETHEX4 E712,C0 07,, SUBB #7 E714,4F,GETHEX4:, GETHEX4: CLRA E715,18 E3 00,, ADDD 0,Y E718,18 ED 00,, STD 0,Y E71B,20 CF,, BRA GETHEX1 E71D,86 0C,GETHEX3:, GETHEX3: LDAA #HEXOVERR E71F,20 C0,, BRA CHCKERR ,,, * ,,, * ,,, */***** hexdig() *****/ ,,, * ,,, *hexdig(c) ,,, *char c; ,,, *{ ,,, * return(numeric(c) | (c>='A' & c<='F')); /* return true if c is hex */ ,,, *} ,,, * ,,, HEXDIG: EQU * E721,BD E1 BB,, JSR NUMERIC E724,24 01,, BCC HEXDIG1 E726,39,, RTS E727,BD E0 FA,HEXDIG1:, HEXDIG1: JSR ToUpper E72A,81 41,, CMPA #'A' E72C,25 06,, BLO HEXDIG2 E72E,81 46,, CMPA #'F' E730,22 02,, BHI HEXDIG2 E732,0D,, SEC E733,39,, RTS E734,0C,HEXDIG2:, HEXDIG2: CLC E735,39,, RTS ,,, * ,,, * ,,, */***** getscon *****/ ,,, * ,,, *getscon() ,,, *{ ,,, * short count; ,,, * char *bufptr,c; ,,, * count=2; /* initalize byte count to 2 */ ,,, * *tbufptr++=SCONTOK; /* put string constant token in buffer */ ,,, * bufptr=tbufptr++; /* save value of tbufptr, advance to next byte, */ ,,, * /* and reserve a byte for string length */ ,,, * *tbufptr++=*ibufptr++; /* put 1st quote in token buffer */ ,,, * ,,, GETSCON: EQU * E736,C6 02,, LDAB #2 E738,86 A2,, LDAA #SCONTOK E73A,BD E3 D7,, JSR PUTTOK E73D,DE 02,, LDX TBUFPTR E73F,3C,, PSHX E740,4F,, CLRA E741,BD E3 D7,, JSR PUTTOK E744,BD E3 CA,, JSR GETNXCHR ; PUT FIRST QUOTE IN TOKEN BUFFER. E747,BD E3 D7,, JSR PUTTOK ,,, * ,,, * ,,, * while(((c=*ibufptr) != '"')) ,,, * { ,,, * if(c==EOL) /* if we hit EOL */ ,,, * { errcode=MISQUERR; return; } /* flag error & return */ ,,, * *tbufptr++=c; /* if not, put next char in buffer */ ,,, * ++ibufptr; /* advance input buffer pointer */ ,,, * ++count; /* up byte count */ ,,, * } ,,, * ,,, GETSCON1: EQU * E74A,BD E3 CA,, JSR GETNXCHR E74D,81 22,, CMPA #'"' E74F,27 0F,, BEQ GETSCON2 E751,81 0D,, CMPA #EOL E753,26 05,, BNE GETSCON3 E755,86 0D,, LDAA #MISQUERR E757,7E EA 98,, JMP RPTERR E75A,BD E3 D7,GETSCON3:, GETSCON3: JSR PUTTOK E75D,5C,, INCB E75E,20 EA,, BRA GETSCON1 ,,, * ,,, * *tbufptr++=c; /* put closing quote in token buffer */ ,,, * ++ibufptr; /* advance input buffer pointer */ ,,, * *bufptr=count; /* put string byte count in token buffer */ ,,, * return; ,,, *} ,,, * ,,, GETSCON2: EQU * E760,BD E3 D7,, JSR PUTTOK E763,38,GETSCON4:, GETSCON4: PULX E764,E7 00,, STAB 0,X E766,39,, RTS ,,, * ,,, * ,,, #Include 'BASICLB5.Asm' ,,, * title BASICLB5 ,,, * page ,,, * ,,, */***** getfun() *****/ ,,, * ,,, *getfun() ,,, *{ ,,, * short type; ,,, * if(match("FDIV")) type=xfdiv(); ,,, * else if(match("CHR$")) type=xchrs(); ,,, * else if(match("ABS")) type=xabs(); ,,, * else if(match("RND")) type=xrnd(); ,,, * else if(match("SGN")) type=xsgn(); ,,, * else if(match("TAB")) type=xtab(); ,,, * else if(match("ADC")) type=xadc(); ,,, * else if(match("CALL")) type=xcall(); ,,, * else return(0); ,,, * return(type); ,,, *} ,,, * ,,, * ,,, GETFUN: EQU * E767,CE E7 88,, LDX #FUNCTBL E76A,BD E3 A5,GETFUN1:, GETFUN1: JSR STREQ E76D,25 0E,, BCS GETFUN2 E76F,08,GETFUN3:, GETFUN3: INX E770,A6 00,, LDAA 0,X E772,26 FB,, BNE GETFUN3 E774,C6 04,, LDAB #4 E776,3A,, ABX E777,6D 00,, TST 0,X E779,26 EF,, BNE GETFUN1 E77B,4F,, CLRA E77C,39,, RTS E77D,86 36,GETFUN2:, GETFUN2: LDAA #FUNCTFLG E77F,BD E3 D7,, JSR PUTTOK E782,A6 01,, LDAA 1,X E784,EE 02,, LDX 2,X E786,6E 00,, JMP 0,X ,,, * ,,, * ,,, FUNCTBL: EQU * E788,46 44 49 56,FDIVS:, FDIVS: FCC "FDIV" E78C,00,, FCB 0 E78D,01,, FCB FDIVTOK E78E,E8 01,, FDB BNUMFUN E790,43 48 52 24,CHRS:, CHRS: FCC "CHR$" E794,00,, FCB 0 E795,02,, FCB CHRTOK E796,E8 1F,, FDB UNUMFUN E798,41 42 53,ABS:, ABS: FCC "ABS" E79B,00,, FCB 0 E79C,04,, FCB ABSTOK E79D,E8 1F,, FDB UNUMFUN E79F,52 4E 44,RND:, RND: FCC "RND" E7A2,00,, FCB 0 E7A3,05,, FCB RNDTOK E7A4,E8 1F,, FDB UNUMFUN E7A6,53 47 4E,SGN:, SGN: FCC "SGN" E7A9,00,, FCB 0 E7AA,06,, FCB SGNTOK E7AB,E8 1F,, FDB UNUMFUN E7AD,54 41 42,TABS:, TABS: FCC "TAB" E7B0,00,, FCB 0 E7B1,07,, FCB TABTOK E7B2,E8 1F,, FDB UNUMFUN E7B4,41 44 43,ADCS:, ADCS: FCC "ADC" E7B7,00,, FCB 0 E7B8,03,, FCB ADCTOK E7B9,E8 1F,, FDB UNUMFUN E7BB,43 41 4C 4C,CALL:, CALL: FCC "CALL" E7BF,00,, FCB 0 E7C0,08,, FCB CALLTOK E7C1,E8 1F,, FDB UNUMFUN E7C3,50 45 45 4B,PEEK:, PEEK: FCC "PEEK" E7C7,00,, FCB 0 E7C8,09,, FCB PEEKTOK E7C9,E8 1F,, FDB UNUMFUN E7CB,45 45 50,, FCC "EEP" E7CE,00,, FCB 0 E7CF,0A,, FCB FEEPTOK E7D0,E8 1F,, FDB UNUMFUN E7D2,48 45 58 32,HEX2:, HEX2: FCC "HEX2" E7D6,00,, FCB 0 E7D7,12,, FCB HEX2TOK E7D8,E8 1F,, FDB UNUMFUN E7DA,48 45 58,HEX:, HEX: FCC "HEX" E7DD,00,, FCB 0 E7DE,0B,, FCB HEXTOK E7DF,E8 1F,, FDB UNUMFUN E7E1,50 4F 52 54,, FCC "PORT" E7E5,00,, FCB 0 E7E6,0C,, FCB FPRTATOK E7E7,E8 68,, FDB FINDPORT E7E9,54 49 4D 45,, FCC "TIME" E7ED,00,, FCB 0 E7EE,11,, FCB FTIMETOK E7EF,E8 7F,, FDB XTIMEF E7F1,50 41 43 43,, FCC "PACC" E7F5,00,, FCB 0 E7F6,13,, FCB FPACCTOK E7F7,E8 7F,, FDB XPACCF E7F9,00,, FCB 0 ; END OF TABLE MARKER. ,,, * ,,, * ,,, XPOKE: EQU * E7FA,DE 02,, LDX TBUFPTR ; GET TOKEN BUFFER POINTER. E7FC,09,, DEX ; DEC. TO COMPENSATE FOR PUTTOK DONE IN XLATE. E7FD,DF 02,, STX TBUFPTR ; SAVE NEW POINTER VALUE. FALL THROUGH TO BNUMFUN. E7FF,A6 00,, LDAA 0,X ; GET TOKEN BACK INTO THE A-REG. ,,, * ,,, * ,,, */***** xfdiv() *****/ ,,, * ,,, *xfdiv() ,,, *{ ,,, * short type[2]; ,,, * type[0]=type[1]=NUM; /* both arguments must be type NUM */ ,,, * dofunct(FDIVTOK,2,type); ,,, * return(NUM); ,,, *} ,,, * ,,, BNUMFUN: EQU * E801,18 3C,, PSHY E803,C6 01,, LDAB #NUM E805,37,, PSHB E806,37,, PSHB E807,18 30,, TSY E809,C6 02,, LDAB #2 E80B,BD E8 2E,, JSR DOFUNCT ,,, * LDAA #NUM E80E,32,, PULA E80F,32,, PULA E810,18 38,, PULY E812,39,, RTS ,,, * ,,, * ,,, */***** xchrs *****/ ,,, * ,,, *xchrs() ,,, *{ ,,, * return(unumfun(CHRTOK)); ,,, *} ,,, * ,,, */***** xabs() *****/ ,,, * ,,, *xabs() ,,, *{ ,,, * return(unumfun(ABSTOK)); ,,, *} ,,, * ,,, */***** xrnd() *****/ ,,, * ,,, *xrnd() ,,, *{ ,,, * return(unumfun(RNDTOK)); ,,, *} ,,, * ,,, */***** xsgn() *****/ ,,, * ,,, *xsgn() ,,, *{ ,,, * return(unumfun(SGNTOK)); ,,, *} ,,, * ,,, */***** xtab() *****/ ,,, * ,,, *xtab() ,,, *{ ,,, * return(unumfun(TABTOK)); ,,, *} ,,, * ,,, */***** xadc() *****/ ,,, * ,,, *xadc() ,,, *{ ,,, * return(unumfun(ADCTOK)); ,,, *} ,,, * ,,, */***** xcall() *****/ ,,, * ,,, *xcall() ,,, *{ ,,, * return(unumfun(CALLTOK)); ,,, *} ,,, * ,,, */***** unumfun() *****/ ,,, * ,,, *unumfun(token) /* common code for a uinary numerical function */ ,,, *short token; ,,, *{ ,,, * short type[1]; /* setup argument 'type' array */ ,,, * type[0]=NUM; /* set the 1st (only) argument type to NUM */ ,,, * dofunct(token,1,type); /* go do the function */ ,,, * return(NUM); /* return the function type */ ,,, *} ,,, * ,,, XEEP: EQU * ; PROGRAM A WORD OF EEPROM. E813,DE 02,, LDX TBUFPTR ; COMPENSATE FOR TOKEN PLACEMENT BU UNUMFUN E815,09,, DEX ; ROUTINE. E816,DF 02,, STX TBUFPTR ; SAVE POINTER. E818,A6 00,, LDAA 0,X ; GET TOKEN FROM BUFFER. E81A,8D 03,, BSR UNUMFUN ; GO TREAT AS A UNIARY NUMERIC FUNCTION. E81C,7E E4 20,, JMP ASIGNMT1 ; GO USE ASSIGNMENT CODE FOR REST OF FUNCTION. ,,, * ,,, * ,,, * ,,, UNUMFUN: EQU * E81F,18 3C,, PSHY E821,C6 01,, LDAB #NUM E823,37,, PSHB E824,C6 01,, LDAB #1 E826,18 30,, TSY E828,8D 04,, BSR DOFUNCT ,,, * LDAA #NUM E82A,32,, PULA E82B,18 38,, PULY E82D,39,, RTS ,,, * ,,, * ,,, */***** dofunct() *****/ ,,, * ,,, *dofunct(functok,nargs,type) ,,, *short functok,nargs,*type; ,,, *{ ,,, * *tbufptr++=functok; /* put function token in buffer */ ,,, * if(*ibufptr!='(') { errcode=ILFSYERR; return; } ,,, * *tbufptr++=OPARNTOK; /* put open paren in token buffer */ ,,, * ++ibufptr; ,,, * ,,, DOFUNCT: EQU * E82E,BD E3 D7,, JSR PUTTOK E831,BD E3 C3,, JSR GETCHR E834,81 28,, CMPA #'(' E836,27 05,, BEQ DOFUNCT1 E838,86 0E,DOFUNCT5:, DOFUNCT5: LDAA #MPARNERR E83A,7E EA 98,, JMP RPTERR E83D,BD E3 CC,DOFUNCT1:, DOFUNCT1: JSR INCIBP E840,86 10,, LDAA #OPARNTOK E842,BD E3 D7,, JSR PUTTOK ,,, * ,,, * ,,, * while(1) ,,, * { ,,, * xexpres(*type++); /* get the argument/expression */ ,,, * if(errcode) return; /* return if error */ ,,, * if(--nargs==0) break; /* if we have all the arguments, quit */ ,,, * if(*ibufptr!=',') /* if delimiter not present, return */ ,,, * { errcode=ILFSYERR; return; } ,,, * *tbufptr++=COMMATOK; /* if it is, put it in the token buffer */ ,,, * ++ibufptr; /* point to the next character */ ,,, * } ,,, * E845,18 A6 00,DOFUNCT4:, DOFUNCT4: LDAA 0,Y E848,18 08,, INY E84A,37,, PSHB E84B,BD E4 30,, JSR XEXPRES E84E,33,, PULB E84F,5A,, DECB E850,27 07,, BEQ DOFUNCT3 E852,BD EA 2D,, JSR CHKCOMA E855,24 E1,, BCC DOFUNCT5 E857,20 EC,, BRA DOFUNCT4 ,,, * ,,, * ,,, * if(*ibufptr!=')') /* must see closing paren */ ,,, * { ,,, * errcode=ILFSYERR; /* if not, error */ ,,, * return; ,,, * } ,,, * else /* saw closing paren */ ,,, * { ,,, * *tbufptr++=CPARNTOK; /* put it in the token buffer */ ,,, * ++ibufptr; /* advance input buffer pointer */ ,,, * } ,,, * return; ,,, *} ,,, * ,,, DOFUNCT3: EQU * E859,BD E3 C3,, JSR GETCHR E85C,81 29,, CMPA #')' E85E,26 D8,, BNE DOFUNCT5 E860,BD E3 CC,, JSR INCIBP E863,86 11,, LDAA #CPARNTOK E865,7E E3 D7,, JMP PUTTOK ; PUT TOKEN IN BUFFER & RETURN. ,,, * ,,, * ,,, * ,,, FINDPORT: EQU * E868,BD E3 CA,, JSR GETNXCHR ; GO GET PORT "NUMBER". E86B,BD E0 FA,, JSR ToUpper ; Translate the character to upper case. E86E,81 41,, CMPA #'A' ; IS IT AN A OR HIGHER? E870,24 05,, BHS FINDPRT1 ; YES. GO CHECK UPPER LIMIT. E872,86 2F,FINDPRT2:, FINDPRT2: LDAA #ILPRTERR ; NO. ILLEGAL PORT "NUMBER". E874,7E EA 98,, JMP RPTERR ; REPORT ERROR. E877,81 45,FINDPRT1:, FINDPRT1: CMPA #'E' ; IS IT HIGHER THAN AN "E"? E879,22 F7,, BHI FINDPRT2 ; YES. ILLEGAL PORT. E87B,80 41,, SUBA #'A' ; SUBTRACT "BASE" PORT OF A E87D,8B 0C,, ADDA #FPRTATOK ; ADD IN "BASE" TOKEN. ,,, * ,,, * ; STEAL SOME CODE. ,,, XPACCF: EQU * E87F,BD E3 D7,XTIMEF:, XTIMEF: JSR PUTTOK ; PUT TOKEN IN BUFFER. E882,86 01,, LDAA #NUM ; RETURN TYPE "NUM". E884,39,, RTS ; RETURN. ,,, * ,,, * ,,, #Include 'BASICLB4.Asm' ,,, * title BASICLB4 ,,, * page ,,, * ,,, * ,,, */***** xon *****/ ,,, * ,,, *xon() ,,, *{ ,,, * int num; ,,, * *tbufptr++=ONTOK; /* put ON token in buffer */ ,,, * blanks(); /* skip any blanks */ ,,, * xexpres(NUM); /* get the expression */ ,,, * if(errcode) return; /* if error, return */ ,,, * blanks(); /* skip any blanks */ ,,, * if(match("GOTO")) xgoto(); /* check for GOTO */ ,,, * else if(match("GOSUB")) xgosub(); /* check for GOSUB */ ,,, * else errcode=IONSYERR; /* if neither, flag an error */ ,,, * if(errcode) return; /* if error, return */ ,,, * blanks(); /* skip blanks */ ,,, * ,,, * ,,, XON: EQU * ,,, * JSR BLANKS E885,86 01,, LDAA #NUM E887,BD E4 30,, JSR XEXPRES E88A,BD E3 7A,XON1:, XON1: JSR BLANKS E88D,CE E2 71,, LDX #GOTO E890,BD E3 A5,, JSR STREQ E893,24 0D,, BCC XON2 E895,86 12,, LDAA #GOTOTOK E897,BD E3 D7,, JSR PUTTOK E89A,BD E3 7A,, JSR BLANKS E89D,BD E3 F2,, JSR XGOTO E8A0,20 18,, BRA XON5 E8A2,CE E2 68,XON2:, XON2: LDX #GOSUB E8A5,BD E3 A5,, JSR STREQ E8A8,25 05,, BCS XON4 E8AA,86 0F,, LDAA #IONSYERR E8AC,7E EA 98,, JMP RPTERR E8AF,86 0F,XON4:, XON4: LDAA #GOSUBTOK E8B1,BD E3 D7,, JSR PUTTOK E8B4,BD E3 7A,, JSR BLANKS E8B7,BD E3 F2,, JSR XGOSUB E8BA,BD E3 7A,XON5:, XON5: JSR BLANKS ,,, * ,,, * ,,, * while(*ibufptr==',') /* do until EOL */ ,,, * { ,,, * *tbufptr++=COMMATOK; /* put COMMA token in buffer */ ,,, * ++ibufptr; /* advance the input buffer pointer */ ,,, * blanks(); /* skip blanks */ ,,, * *tbufptr++=LCONTOK; /* put line number constant token in buffer */ ,,, * num=getlinum(); /* get line number */ ,,, * if(num==0) errcode=LINENERR; /* if 0, line number error */ ,,, * if(errcode) return; /* if error, return */ ,,, * putint(num); /* put line number in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * } ,,, * return; ,,, *} ,,, * E8BD,BD EA 2D,, JSR CHKCOMA E8C0,25 01,, BCS XON6 E8C2,39,, RTS E8C3,BD E3 7A,XON6:, XON6: JSR BLANKS E8C6,86 A8,, LDAA #LCONTOK E8C8,BD E3 D7,, JSR PUTTOK E8CB,BD E1 6C,, JSR GETLINUM E8CE,BD E3 D4,XON8:, XON8: JSR PUTDTOK E8D1,20 E7,, BRA XON5 ,,, * ,,, * ,,, XONIRQ: EQU * ; "ONIRQ" HAS A FUNCTION CODE & LINE NUMBER. ,,, XONTIME: EQU * E8D3,86 01,, LDAA #NUM ; GO GET THE VALUE OF THE TIMER WE SHOULD GO ON. E8D5,BD E4 30,, JSR XEXPRES E8D8,BD E3 7A,, JSR BLANKS ; SKIP BLANKS. E8DB,BD EA 2D,, JSR CHKCOMA ; GO CHECK FOR A COMMA. E8DE,25 05,, BCS XONTIME1 ; IF PRESENT, IT'S OK. E8E0,86 15,XONTIME2:, XONTIME2: LDAA #MCOMAERR ; IF NOT, REPORT AN ERROR. E8E2,7E EA 98,, JMP RPTERR E8E5,BD E3 7A,XONTIME1:, XONTIME1: JSR BLANKS E8E8,86 A8,, LDAA #LCONTOK ; GET THE LINE CONSTANT TOKEN. E8EA,BD E3 D7,, JSR PUTTOK ; PUT IT IN THE TOKEN BUFFER. E8ED,BD E1 6C,, JSR GETLINUM ; GO GET A LINE NUMBER. E8F0,7E E3 D4,, JMP PUTDTOK ; PUT THE LINE NUMBER IN THE TOKEN BUFFER. ,,, * ,,, * ,,, XONPACC: EQU * E8F3,8D 02,, BSR GETARG ; GET AN ARGUMENT AND A COMMA. E8F5,20 DC,, BRA XONTIME ; GO USE SOME OTHER CODE. ,,, * ,,, * E8F7,86 01,GETARG:, GETARG: LDAA #NUM ; GO GET THE "OPERATING MODE" EXPRESSION. E8F9,BD E4 30,, JSR XEXPRES E8FC,BD E3 7A,, JSR BLANKS ; SKIP BLANKS. E8FF,BD EA 2D,, JSR CHKCOMA ; GO CHECK FOR COMMA. E902,24 DC,, BCC XONTIME2 ; NO COMMA. REPORT ERROR. E904,7E E3 7A,, JMP BLANKS ; SKIP BLANKS AFTER COMMA AND RETURN. ,,, ,,, * ,,, * ,,, * ,,, */***** xif() *****/ ,,, * ,,, *xif() ,,, *{ ,,, *int num; ,,, * *tbufptr++=IFTOK; /* put if token in the buffer */ ,,, * blanks(); /* skip any blanks */ ,,, * ifwhflag=1; /* let xexpres() know we are doing an IF */ ,,, * xexpres(NULL); /* get relational expression */ ,,, * if(errcode) return; /* if error, return */ ,,, * blanks(); /* if not, skip blanks */ ,,, * ,,, * ,,, XIF: EQU * ,,, * JSR BLANKS E907,7C 00 1A,, INC IFWHFLAG E90A,86 01,, LDAA #NUM E90C,BD E4 30,, JSR XEXPRES E90F,BD E3 7A,XIF1:, XIF1: JSR BLANKS ,,, * ,,, * ,,, * if(match("THEN")) /* check for "THEN" clause */ ,,, * { ,,, * *tbufptr++=THENTOK; /* put THEN token in the buffer */ ,,, * blanks(); /* skip any blanks after "THEN" */ ,,, * ,,, * E912,CE E9 66,, LDX #THENS E915,BD E3 A5,, JSR STREQ E918,25 05,, BCS XIF2 E91A,86 10,, LDAA #MTHENERR E91C,7E EA 98,, JMP RPTERR ,,, * ,,, * ,,, * if(numeric(*ibufptr)) /* is a line number present after THEN? */ ,,, * { /* yes */ ,,, * *tbufptr++=LCONTOK; /* put line # const. token in buffer */ ,,, * num=getlinum(); /* get the line # */ ,,, * if(num==0) errcode=LINENERR; ,,, * if(errcode) return; /* if error, return */ ,,, * putint(num); /* put number in buffer */ ,,, * } ,,, * else /* not a line #, check for statement */ ,,, * { ,,, * xlate(); /* try to make a statement out of what follows */ ,,, * if(errcode) return; /* if error, return */ ,,, * } ,,, * } ,,, * ,,, * ,,, XIF2: EQU * E91F,86 38,, LDAA #THENTOK E921,BD E3 D7,, JSR PUTTOK E924,BD E3 7A,, JSR BLANKS E927,BD E3 C3,, JSR GETCHR E92A,BD E1 BB,, JSR NUMERIC E92D,24 27,, BCC XIF9 ,,, * E92F,86 A8,XIF3:, XIF3: LDAA #LCONTOK E931,BD E3 D7,, JSR PUTTOK E934,BD E1 6C,, JSR GETLINUM E937,BD E3 D4,XIF6:, XIF6: JSR PUTDTOK ,,, * ,,, * ,,, * else /* if "THEN" not present */ ,,, * { ,,, * errcode=MTHENERR; /* flag a missing THEN error */ ,,, * return; ,,, * } ,,, * ,,, * ,,, * blanks(); /* skip any blanks after object of THEN */ ,,, * if(match("ELSE")) /* is "ELSE" clause present? */ ,,, * { /* yes */ ,,, * *tbufptr++=ELSETOK; /* put ELSE token in the buffer */ ,,, * blanks(); /* skip any blanks after ELSE */ ,,, * ,,, * ,,, XIF4: EQU * E93A,BD E3 7A,, JSR BLANKS E93D,CE E9 6B,, LDX #ELSES E940,BD E3 A5,, JSR STREQ E943,25 01,, BCS XIF7 E945,39,, RTS E946,86 39,XIF7:, XIF7: LDAA #ELSETOK E948,BD E3 D7,, JSR PUTTOK E94B,BD E3 7A,, JSR BLANKS ,,, * ,,, * ,,, * if(numeric(*ibufptr)) /* is a line # present after ELSE */ ,,, * { /* yes */ ,,, * *tbufptr++=LCONTOK; /* put line # const. token in buffer */ ,,, * num=getlinum(); /* get the line # */ ,,, * if(num==0) errcode=LINENERR; ,,, * if(errcode) return; /* if error, return */ ,,, * putint(num); /* put number in buffer */ ,,, * } ,,, * else /* line # not present, try to xlate a statement */ ,,, * { ,,, * xlate(); ,,, * } ,,, * } ,,, * ,,, * E94E,BD E3 C3,, JSR GETCHR E951,BD E1 BB,, JSR NUMERIC E954,25 05,, BCS XIF8 E956,86 12,XIF9:, XIF9: LDAA #LINENERR E958,7E EA 98,, JMP RPTERR E95B,86 A8,XIF8:, XIF8: LDAA #LCONTOK E95D,BD E3 D7,, JSR PUTTOK E960,BD E1 6C,, JSR GETLINUM E963,7E E3 D4,XIF10:, XIF10: JMP PUTDTOK ,,, * ,,, * return; /* in any case, return */ ,,, *} ,,, * ,,, * E966,54 48 45 4E,THENS:, THENS: FCC "THEN" E96A,00,, FCB 0 E96B,45 4C 53 45,ELSES:, ELSES: FCC "ELSE" E96F,00,, FCB 0 ,,, * ,,, * ,,, */***** xfor() *****/ ,,, * ,,, *xfor() ,,, *{ ,,, * short type; ,,, * *tbufptr++=FORTOK; /* put for token in buffer */ ,,, * blanks(); /* skip blanks between FOR & assignment statement */ ,,, * type=getvar(); /* get variable */ ,,, * if((type!=NUM)|(*ibufptr++!='=')) /* is it a numerical variable? */ ,,, * { errcode=IVEXPERR; return; } /* no. flag error & return */ ,,, * ,,, * ,,, XFOR: EQU * ,,, * JSR BLANKS E970,BD E5 57,, JSR GETVAR E973,81 01,, CMPA #NUM E975,27 05,, BEQ XFOR1 E977,86 03,XFOR2:, XFOR2: LDAA #IVEXPERR E979,7E EA 98,, JMP RPTERR E97C,BD E3 CA,XFOR1:, XFOR1: JSR GETNXCHR E97F,81 3D,, CMPA #'=' E981,26 F4,, BNE XFOR2 ,,, * ,,, * ,,, * *tbufptr++=EQUALTOK; /* put equals token in buffer */ ,,, * xexpres(NUM); /* go get a numerical expression */ ,,, * if(errcode) return; /* if error, return */ ,,, * blanks(); /* skip blanks */ ,,, * ,,, * E983,86 79,, LDAA #EQUALTOK E985,BD E3 D7,, JSR PUTTOK E988,86 01,, LDAA #NUM E98A,BD E4 30,, JSR XEXPRES E98D,BD E3 7A,, JSR BLANKS ,,, * ,,, * ,,, * if(match("TO")) /* is TO present? */ ,,, * { /* yes */ ,,, * *tbufptr++=TOTOK; /* put TO token in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * xexpres(NUM); /* get the "TO" expression */ ,,, * if(errcode) return; /* return if error */ ,,, * } ,,, * else /* "TO" not present */ ,,, * { ,,, * errcode=MTOERR; /* set error flag & return */ ,,, * return; ,,, * } ,,, * ,,, * E990,CE E9 C3,, LDX #TO E993,BD E3 A5,, JSR STREQ E996,25 05,, BCS XFOR4 E998,86 11,, LDAA #MTOERR E99A,7E EA 98,, JMP RPTERR E99D,86 37,XFOR4:, XFOR4: LDAA #TOTOK E99F,BD E3 D7,, JSR PUTTOK E9A2,BD E3 7A,, JSR BLANKS E9A5,86 01,, LDAA #NUM E9A7,BD E4 30,, JSR XEXPRES ,,, * ,,, * ,,, * blanks(); /* skip blanks */ ,,, * if(match("STEP")) /* is optional "STEP" clause present? */ ,,, * { /* yes */ ,,, * *tbufptr++=STEPTOK; /* put STEP token in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * xexpres(NUM); /* get expression */ ,,, * } ,,, * return; ,,, *} ,,, * ,,, * E9AA,BD E3 7A,, JSR BLANKS E9AD,CE E9 C6,, LDX #STEP E9B0,BD E3 A5,, JSR STREQ E9B3,25 01,, BCS XFOR3 E9B5,39,, RTS E9B6,86 3A,XFOR3:, XFOR3: LDAA #STEPTOK E9B8,BD E3 D7,, JSR PUTTOK E9BB,BD E3 7A,, JSR BLANKS E9BE,86 01,, LDAA #NUM E9C0,7E E4 30,, JMP XEXPRES ,,, * ,,, * E9C3,54 4F,TO:, TO: FCC "TO" E9C5,00,, FCB 0 E9C6,53 54 45 50,STEP:, STEP: FCC "STEP" E9CA,00,, FCB 0 ,,, * ,,, * ,,, */***** xnext() *****/ ,,, * ,,, *xnext() ,,, *{ ,,, * *tbufptr++=NEXTTOK; /* put NEXT token in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * if(getvar()!=NUM) errcode=SYTXERR; /* get variable, must be numeric */ ,,, * return; ,,, *} ,,, * ,,, * ,,, XNEXT: EQU * ,,, * JSR BLANKS E9CB,BD E5 57,, JSR GETVAR E9CE,81 01,, CMPA #NUM E9D0,27 05,, BEQ XNEXT1 E9D2,86 02,, LDAA #SYTXERR E9D4,7E EA 98,, JMP RPTERR E9D7,39,XNEXT1:, XNEXT1: RTS ,,, * ,,, * ,,, */***** xprint() *****/ ,,, * ,,, *xprint() ,,, *{ ,,, * *tbufptr++=PRINTTOK; /* put PRINT token in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * ,,, * ,,, XPRINT: EQU * ,,, * JSR BLANKS E9D8,BD E3 C3,, JSR GETCHR E9DB,81 23,, CMPA #'#' ; HAS AN ALTERNATE PORT BEEN SPECIFIED? E9DD,26 0D,, BNE XPRINT9 ; NO. GO PROCESS THE REST OF THE PRINT STATEMENT. E9DF,86 78,, LDAA #PNUMTOK ; YES. PUT THE TOKEN INTO THE BUFFER. E9E1,BD E3 D7,, JSR PUTTOK ; DO IT. E9E4,BD E3 CC,, JSR INCIBP ; POINT PAST THE "#". E9E7,BD E3 7A,, JSR BLANKS ; SKIP SPACES BETWEEN '#' AND EXPRESION. E9EA,20 1B,, BRA XPRINT7 ; GO GET EXPRESSION & CONTINUE. ,,, * ,,, * ,,, ,,, * while((*ibufptr!=EOL)|(*ibufptr!=MIDEOL)) /* do until end of line */ ,,, * { ,,, * xexpres(NULL); /* get expression */ ,,, * if(errcode) return; /* if error, return */ ,,, * blanks(); /* skip blanks */ ,,, * if(*ibufptr==COMMA) *tbufptr=COMMATOK; /* check for comma */ ,,, * else if(*ibufptr==SEMI) *tbufptr=SEMITOK; /* check for semicolin */ ,,, * else return; /* if neither, return */ ,,, * ++ibufptr; /* advance input buffer pointer */ ,,, * ++tbufptr; /* advance token buffer pointer */ ,,, * blanks(); /* skip blanks after delimeter */ ,,, * } ,,, * return; ,,, *} E9EC,BD E3 7A,XPRINT9:, XPRINT9: JSR BLANKS E9EF,BD E3 C3,, JSR GETCHR E9F2,81 0D,, CMPA #EOL E9F4,27 04,, BEQ XPRINT2 E9F6,81 3A,, CMPA #MIDEOL E9F8,26 01,, BNE XPRINT3 E9FA,39,XPRINT2:, XPRINT2: RTS E9FB,BD E3 C3,XPRINT3:, XPRINT3: JSR GETCHR ; GET THE NEXT CHARACTER IN THE BUFFER. E9FE,81 22,, CMPA #'"' ; IS IT A STRING CONSTANT? EA00,26 05,, BNE XPRINT7 EA02,BD E7 36,, JSR GETSCON ; YES. GO GET A STRING CONSTANT. EA05,20 05,, BRA XPRINT8 ; CONTINUE. EA07,86 01,XPRINT7:, XPRINT7: LDAA #NUM EA09,BD E4 30,, JSR XEXPRES EA0C,BD E3 7A,XPRINT8:, XPRINT8: JSR BLANKS EA0F,BD E3 C3,, JSR GETCHR EA12,81 0D,, CMPA #EOL EA14,27 E4,, BEQ XPRINT2 EA16,81 3A,, CMPA #MIDEOL EA18,27 E0,, BEQ XPRINT2 EA1A,8D 11,, BSR CHKCOMA EA1C,25 CE,, BCS XPRINT9 EA1E,81 3B,XPRINT4:, XPRINT4: CMPA #SEMI EA20,27 05,, BEQ XPRINT6 EA22,86 16,, LDAA #MCMSMERR EA24,7E EA 98,, JMP RPTERR EA27,86 7B,XPRINT6:, XPRINT6: LDAA #SEMITOK EA29,8D 0D,, BSR CHKCOMA2 EA2B,20 BF,, BRA XPRINT9 ,,, * ,,, * EA2D,BD E3 C3,CHKCOMA:, CHKCOMA: JSR GETCHR ; GET CHARACTER FROM INPUT BUFFER. EA30,81 2C,, CMPA #COMMA ; IS IT A COMMA? EA32,27 02,, BEQ CHKCOMA1 ; YES. PUT IT IN THE TOKEN BUFFER. EA34,0C,, CLC ; NO. FLAG NO COMMA FOUND. EA35,39,, RTS ; RETURN. EA36,86 7C,CHKCOMA1:, CHKCOMA1: LDAA #COMMATOK ; GET THE COMMA TOKEN. EA38,BD E3 D7,CHKCOMA2:, CHKCOMA2: JSR PUTTOK ; PUT THE TOKEN IN THE BUFFER. EA3B,BD E3 CC,, JSR INCIBP ; BUMP THE INPUT BUFFER POINTER. EA3E,0D,, SEC EA3F,39,, RTS ; RETURN. ,,, * ,,, * ,,, */***** xinput() *****/ ,,, * ,,, *xinput() ,,, *{ ,,, * *tbufptr++=INPUTTOK; /* put INPUT token in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * ,,, * ,,, XINPUT: EQU * ,,, * JSR BLANKS EA40,8D 21,, BSR XCHKDEV ; GO CHECK FOR AN ALTERNATE DEVICE NUMBER. ,,, * ,,, * ,,, * if(*ibufptr=='"') /* is a prompt included? */ ,,, * { /* yes */ ,,, * getscon(); /* get the string constant */ ,,, * if(errcode) return; /* if error, return */ ,,, * if(*ibufptr!=COMMA) { errcode=SYTXERR; return; } ,,, * *tbufptr++=COMMATOK; ,,, * ++ibufptr; ,,, * } ,,, * inreadcm(); /* get the input variable list */ ,,, * return; ,,, *} ,,, * ,,, * EA42,BD E3 7A,XINPUT2:, XINPUT2: JSR BLANKS EA45,BD E3 C3,, JSR GETCHR EA48,81 22,, CMPA #'"' EA4A,26 0C,, BNE INREADCM EA4C,BD E7 36,, JSR GETSCON EA4F,8D DC,, BSR CHKCOMA ; IF COMMA PRESENT, PUT IN TOKEN BUFFER. EA51,25 05,, BCS INREADCM EA53,86 15,XINPUT3:, XINPUT3: LDAA #MCOMAERR EA55,7E EA 98,, JMP RPTERR ,,, * ,,, * ,,, */***** inreadcm() *****/ ,,, * ,,, *inreadcm() ,,, *{ ,,, * while(1) /* do forever */ ,,, * { ,,, * blanks(); /* skip blanks */ ,,, * getvar(); /* get a variable */ ,,, * if(errcode) return; /* if error, return */ ,,, * blanks(); /* skip blanks */ ,,, * if(*ibufptr==COMMA) ,,, * { ,,, * *tbufptr++=COMMATOK; /* put delimiter in buffer */ ,,, * ++ibufptr; /* and point to the next char in the buffer */ ,,, * } ,,, * else return; /* if no delimiter return */ ,,, * } ,,, *} ,,, * ,,, XDIM: EQU * ,,, INREADCM: EQU * ,,, XREAD: EQU * ,,, * JSR BLANKS EA58,BD E5 57,, JSR GETVAR EA5B,BD E3 7A,XREAD1:, XREAD1: JSR BLANKS EA5E,8D CD,, BSR CHKCOMA EA60,25 F6,, BCS XREAD EA62,39,, RTS ,,, * ,,, * ,,, * ,,, XCHKDEV: EQU * EA63,BD E3 C3,, JSR GETCHR EA66,81 23,, CMPA #'#' ; HAS AN ALTERNATE PORT BEEN SPECIFIED? EA68,27 01,, BEQ XCHKDEV1 ; NO. GO PROCESS THE REST OF THE PRINT STATEMENT. EA6A,39,, RTS ; RETURN. EA6B,86 78,XCHKDEV1:, XCHKDEV1: LDAA #PNUMTOK ; YES. PUT THE TOKEN INTO THE BUFFER. EA6D,BD E3 D7,, JSR PUTTOK ; DO IT. EA70,BD E3 CC,, JSR INCIBP ; POINT PAST THE "#". EA73,BD E3 7A,, JSR BLANKS ; SKIP SPACES BETWEEN '#' AND EXPRESION. EA76,86 01,, LDAA #NUM ; EXPRESSION MUST BE NUMERIC. EA78,BD E4 30,, JSR XEXPRES ; GO GET THE EXPRESSION. EA7B,BD E3 7A,, JSR BLANKS ; SKIP SPACES. EA7E,8D AD,, BSR CHKCOMA ; GO GET COMMA THAT MUST FOLLOW THE EXPRESSION. EA80,24 D1,, BCC XINPUT3 ; MISSING COMMA. GO REPORT THE ERROR. EA82,39,, RTS ; IT WAS THERE. GO PROCESS THE REST OF THE STATEMENT. ,,, * ,,, * ,,, * ,,, XINBYTE: EQU * EA83,8D DE,, BSR XCHKDEV ; GO CHECK FOR ALTERNATE DEVICE. EA85,BD E3 7A,, JSR BLANKS ; SKIP BLANKS AFTER COMMA. EA88,7E E5 57,, JMP GETVAR ; GO TRY TO GET A VARIABLE. ,,, * ,,, * ,,, * ,,, * ,,, */***** xread *****/ ,,, * ,,, *xread() ,,, *{ ,,, * *tbufptr++=READTOK; /* put read token in buffer */ ,,, * inreadcm(); /* get the variable list */ ,,, * return; ,,, *} ,,, * ,,, */***** xrestore() *****/ ,,, * ,,, *xrestore() ,,, *{ ,,, * *tbufptr++=RESTRTOK; /* put RESTORE token in buffer */ ,,, * return; ,,, *} ,,, * ,,, */***** xwhile() *****/ ,,, * ,,, *xwhile() ,,, *{ ,,, * *tbufptr++=WHILETOK; /* put WHILE token in buffer */ ,,, * blanks(); /* skip blanks */ ,,, * ifwhflag=1; /* indicate we are going to get a WHILE expression */ ,,, * xexpres(NULL); /* get expression */ ,,, * return; ,,, *} ,,, * ,,, * ,,, XWHILE: EQU * ,,, * JSR BLANKS EA8B,7C 00 1A,, INC IFWHFLAG EA8E,86 00,, LDAA #NULL EA90,7E E4 30,, JMP XEXPRES ,,, * ,,, * ,,, */***** xendwh() *****/ ,,, * ,,, *xendwh() ,,, *{ ,,, * *tbufptr++=ENDWHTOK; /* put ENDWH token in buffer */ ,,, * return; ,,, *} ,,, * ,,, * ,,, XPACC: EQU * ,,, XTIME: EQU * EA93,C6 01,, LDAB #NUM ; SETUP TO USE CODE IN "ASIGNMT". EA95,7E E4 20,, JMP ASIGNMT1 ; GO DO ASSIGNMENT STATEMENT. ,,, * ,,, * ,,, * ,,, */***** rpterr() *****/ ,,, * ,,, *rpterr() ,,, *{ ,,, *char *ptr,c; ,,, * ptr=inbuff; /* point to start of input buffer */ ,,, * nl(); ,,, * nl(); ,,, * while((c=*ptr++)!=EOL) outbyte(c); /* print the input buffer */ ,,, * ,,, * ,,, RPTERR: EQU * EA98,97 18,, STAA ERRCODE EA9A,BD E1 0E,, JSR NL2 EA9D,DE 49,, LDX INBUFFS EA9F,A6 00,RPTERR1:, RPTERR1: LDAA 0,X EAA1,81 0D,, CMPA #EOL EAA3,27 06,, BEQ RPTERR2 EAA5,BD FE CD,, JSR OUTBYTE EAA8,08,, INX EAA9,20 F4,, BRA RPTERR1 ,,, * ,,, * ,,, * nl(); /* go to next line */ ,,, * ptr=inbuff; /* point to begining of input buffer */ ,,, * while(ptr++ < ibufptr-2) outbyte('*'); /* output '*' to point of error */ ,,, * pl("^^^"); /* point to error */ ,,, * nl(); ,,, * ,,, * ,,, RPTERR2: EQU * EAAB,BD E1 10,, JSR NL EAAE,DE 00,, LDX IBUFPTR EAB0,09,, DEX EAB1,09,, DEX EAB2,9C 49,, CPX INBUFFS EAB4,23 0E,, BLS RPTERR4 EAB6,DF 00,, STX IBUFPTR EAB8,DE 49,, LDX INBUFFS EABA,86 2A,, LDAA #'*' EABC,BD FE CD,RPTERR3:, RPTERR3: JSR OUTBYTE EABF,08,, INX EAC0,9C 00,, CPX IBUFPTR EAC2,26 F8,, BNE RPTERR3 EAC4,CE EA E2,RPTERR4:, RPTERR4: LDX #ARROWS EAC7,BD E1 1C,, JSR PL EACA,BD E1 10,, JSR NL EACD,8D 07,, BSR RPTERR5 EACF,86 01,RPTERR6:, RPTERR6: LDAA #1 EAD1,97 1C,, STAA CONTFLAG EAD3,7E E0 53,, JMP MAIN3 ,,, * ,,, * ,,, * pl("ERROR # "); ,,, * outdeci(errcode); ,,, * return; ,,, *} ,,, * ,,, * EAD6,CE EA E6,RPTERR5:, RPTERR5: LDX #ERRORS EAD9,BD E1 1C,, JSR PL EADC,D6 18,, LDAB ERRCODE EADE,4F,, CLRA EADF,7E EB 1A,, JMP OUTDECI ,,, * ,,, * EAE2,5E 5E 5E,ARROWS:, ARROWS: FCC "^^^" EAE5,00,, FCB 0 EAE6,45 52 52 4F 52 20,ERRORS:, ERRORS: FCC "ERROR # " ,,, ERRORS: FCC "ERROR # " EAEE,00,, FCB 0 ,,, * ,,, * ,,, RPTRERR: EQU * ; REPORT A RUN TIME ERROR. EAEF,97 18,, STAA ERRCODE EAF1,BD EA D6,, JSR RPTERR5 EAF4,CE EB 0E,RPTRERR1:, RPTRERR1: LDX #INLINE EAF7,BD E1 1C,, JSR PL EAFA,DC 29,, LDD CURLINE EAFC,BD EB 1A,, JSR OUTDECI EAFF,BD E1 10,, JSR NL EB02,86 01,, LDAA #1 EB04,97 1C,, STAA CONTFLAG EB06,7E E0 16,, JMP MAINW ,,, * ,,, * EB09,42 52 45 41 4B,BREAKS:, BREAKS: FCC "BREAK" EB0E,20 49 4E 20 4C 49,INLINE:, INLINE: FCC " IN LINE # " ,,, INLINE: FCC " IN LINE # " EB19,00,, FCB 0 ,,, $IF HC11 = 0 ,,, $ELSE ,,, * ,,, OUTDECI: EQU * EB1A,1A 83 00 00,, CPD #0 EB1E,26 05,, BNE OUTDECI1 EB20,86 30,, LDAA #'0' EB22,7E FE CD,, JMP OUTBYTE ,,, OUTDECI1: EQU * EB25,18 3C,, PSHY ,,, * PSHD ; SAVE THE NUMBER TO PRINT. EB27,37,, PSHB EB28,36,, PSHA EB29,CC 27 10,, LDD #10000 ; NUMBER TO START DIVIDING BY. ,,, * PSHD EB2C,37,, PSHB EB2D,36,, PSHA EB2E,5F,, CLRB ; SET INITAL VALUE OF LEADING ZERO SUPRESS FLAG. EB2F,37,, PSHB EB30,18 30,, TSY EB32,18 EC 03,, LDD 3,Y ; IS THE NUMBER NEGATIVE? EB35,2A 0D,, BPL OUTDECI2 ; NO. GO PRINT THE NUMBER. EB37,43,, COMA ; YES. MAKE THE NUMBER POSITIVE. EB38,53,, COMB ; (TWO'S COMPLEMENT) EB39,C3 00 01,, ADDD #1 EB3C,18 ED 03,, STD 3,Y ; SAVE THE RESULT. EB3F,86 2D,, LDAA #'-' ; PRINT A MINUS SIGN TO SHOW IT'S NEGATIVE. EB41,BD FE CD,, JSR OUTBYTE EB44,18 EC 03,OUTDECI2:, OUTDECI2: LDD 3,Y ; GET THE DIVIDEND. EB47,CD EE 01,, LDX 1,Y ; GET THE DIVISOR. EB4A,02,, IDIV ; DO THE DIVIDE. EB4B,18 ED 03,, STD 3,Y ; SAVE THE REMAINDER. EB4E,8F,, XGDX ; PUT QUOTIENT IN D. EB4F,1A 83 00 00,, CPD #0 ; IS THE QUOTIENT 0? EB53,26 05,, BNE OUTDECI3 ; NO. GO OUTPUT THE NUMBER. EB55,18 6D 00,, TST 0,Y ; YES. ARE WE STILL SUPRESSING LEADING ZEROS? EB58,27 0B,, BEQ OUTDECI4 ; YES. DON'T PRINT THE NUMBER. EB5A,17,OUTDECI3:, OUTDECI3: TBA ; PUT THE NUMBER IN THE A-REG. EB5B,8B 30,, ADDA #$30 ; MAKE THE NUMBER ASCII. EB5D,C6 01,, LDAB #1 ; MAKE THE ZERO SUPRESS FLAG NON-ZERO. EB5F,18 E7 00,, STAB 0,Y EB62,BD FE CD,, JSR OUTBYTE ; OUTPUT THE NUMBER. EB65,18 EC 01,OUTDECI4:, OUTDECI4: LDD 1,Y ; GET CURRENT DIVISOR. EB68,CE 00 0A,, LDX #10 ; DIVIDE IT BY 10. EB6B,02,, IDIV EB6C,CD EF 01,, STX 1,Y ; SAVE RESULT. ARE WE DONE? EB6F,26 D3,, BNE OUTDECI2 ; NO KEEP GOING. EB71,C6 05,, LDAB #5 ; DEALLOCATE LOCALS. EB73,18 3A,, ABY EB75,18 35,, TYS EB77,18 38,, PULY ; RESTORE Y. EB79,39,, RTS ; RETURN. ,,, * ,,, * ,,, $ENDIF ,,, * ,,, * ,,, #Include 'LEDITOR.Asm' ,,, * title LEDITOR.TXT ,,, * page ,,, */***** storlin() *****/ ,,, * ,,, *storlin() ,,, *{ ,,, * int *numptr,*linum; ,,, * numptr=tknbuf; /* get int pointer into token buffer */ ,,, * if(*numptr>hiline) /* line # larger than current hi line*/ ,,, * { ,,, * apendlin(); /* append it to the end of the buffer */ ,,, * hiline=*numptr; /* make it the current hi line number */ ,,, * return; ,,, * } ,,, * ,,, * ,,, STORLIN: EQU * EB7A,86 01,, LDAA #1 ;set the continue flag. EB7C,97 1C,, STAA CONTFLAG ; we don't allow continues if the program has been altered. EB7E,DE 4B,, LDX TKNBUFS ; point to the start of the token buffer EB80,EC 00,, LDD 0,X ; get the first 2 bytes of the token buffer (the line number). EB82,1A 93 0C,, CPD HILINE ; was the entered lines number higher than the highest so far? EB85,23 0A,, BLS STORLIN1 ; no. go do an insert or replace operation. EB87,BD EC 69,, JSR APENDLIN ; yes. just append the line to the end of the program buffer. EB8A,DE 4B,, LDX TKNBUFS ; point to the start of the token buffer EB8C,EC 00,, LDD 0,X ; get the first 2 bytes of the token buffer (the line number). EB8E,DD 0C,, STD HILINE EB90,39,, RTS ; return. ,,, * ,,, * ,,, * linum=findline(*numptr); /* look for line # in the program buffer */ ,,, * if(*linum==*numptr) /* is it the same line #? */ ,,, * { ,,, * repline(linum); /* yes. replace it with the new line */ ,,, * return; ,,, * } ,,, * insrtlin(linum); /* no. insert the new line in the buffer */ ,,, * return; ,,, *} ,,, * ,,, * ,,, STORLIN1: EQU * EB91,8D 56,, BSR FINDLINE EB93,EC 00,, LDD 0,X EB95,3C,, PSHX EB96,DE 4B,, LDX TKNBUFS EB98,1A A3 00,, CPD 0,X EB9B,38,, PULX EB9C,26 6A,, BNE INSRTLIN EB9E,7E EC 86,, JMP REPLINE ,,, * ,,, * ,,, * /***** delline() *****/ ,,, * ,,, *delline(num) /* delete line from basic buffer */ ,,, *int num; ,,, *{ ,,, * int *linum; ,,, * char *ptr; ,,, * if(num > hiline) return; /* line number can't be there, return */ ,,, * linum=findline(num); /* look for the requested line # */ ,,, * ,,, * ,,, DELLINE: EQU * ,,, * PSHD ; SAVE THE LINE NUMBER TO DELETE. EBA1,37,, PSHB EBA2,36,, PSHA EBA3,18 30,, TSY ; POINT TO THE LINE NUMBER WE SAVED. EBA5,1A 93 0C,, CPD HILINE ; IS IT HIGHER THAN THE HIGHEST LINE ENTERED SO FAR? EBA8,23 07,, BLS DELLINE1 ; NO. GO SEE IF THE LINE EXISTS. EBAA,86 01,DELLINE2:, DELLINE2: LDAA #1 ; YES. THE LINE CANNOT EXIST. EBAC,97 1C,, STAA CONTFLAG ,,, * PULD ; PULL THE LINE NUMBER OFF THE STACK. EBAE,32,, PULA EBAF,33,, PULB EBB0,39,, RTS ; RETURN. EBB1,8D 36,DELLINE1:, DELLINE1: BSR FINDLINE ; GO SEE IF THE LINE EXISTS. ,,, ; RETURN A POINTER TO A LINE NUMBER IN THE BASIC PROGRAM BUFFER. ,,, * ,,, * ,,, * if(*linum!=num) return; /* if the line # doesn't exist, return */ ,,, * ptr=linum; /* make the int pointer a char pointer */ ,,, * closespc(ptr[2],ptr); /* go delete the line */ ,,, * if(num==hiline) hiline=findhiln(); ,,, * return; ,,, *} ,,, * ,,, * EBB3,EC 00,, LDD 0,X ; GET THE LINE NUMBER THAT WAS FOUND. EBB5,CD A3 00,, CPD 0,Y ; WAS THE LINE NUMBER FOUND THE ONE THAT WAS REQUESTED TO BE DELETED. EBB8,26 F0,, BNE DELLINE2 ; NO. THE LINE DOESN'T EXIST. JUST RETURN. EBBA,E6 02,, LDAB 2,X ; YES. GET THE LENGTH OF THE LINE. EBBC,8D 0D,, BSR CLOSESPC ; GO CLOSE THE SPACE IN THE PROGRAM BUFFER. EBBE,DC 0C,, LDD HILINE ; GET THE HIGHEST LINE NUMBER ENTERED. EBC0,CD A3 00,, CPD 0,Y ; DID WE DELETE THE HIGHEST LINE NUMBER? EBC3,26 E5,, BNE DELLINE2 ; NO. JUST RETURN. EBC5,8D 31,, BSR FINDHILN ; YES. GO FIND THE HIGHEST LINE NUMBER. EBC7,DD 0C,, STD HILINE ; SAVE IT. EBC9,20 DF,, BRA DELLINE2 ; RETURN. ,,, * ,,, * ,,, */***** closespc() *****/ /* close up space in the BASIC buffer */ ,,, * ,,, *closespc(bytes,ptr) ,,, *char bytes,*ptr; ,,, *{ ,,, * char *to,*from; /* define the from/to pointers */ ,,, * to=ptr; /* set up destination pointer */ ,,, * from=ptr+bytes; /* setup source pointer */ ,,, * while(frombasmend) /* if out of memory, return an error */ ,,, * { errcode=OMEMERR; return; } ,,, * basend=to; /* set new end of buffer */ ,,, * while(from>=ptr) ,,, * { *to--=*from--; } /* open up area in buffer */ ,,, * return; ,,, *} ,,, * ,,, OPENSPC: EQU * EC14,18 3C,, PSHY EC16,3C,, PSHX EC17,DE 0A,, LDX VAREND EC19,3A,, ABX EC1A,9C 0E,, CPX BASMEND EC1C,22 2B,, BHI OPENSPC4 EC1E,BD EC A3,, JSR MOVEVARSUP EC21,DE 06,, LDX BASEND EC23,3C,, PSHX EC24,3A,, ABX EC25,3C,, PSHX EC26,18 30,, TSY EC28,18 EC 00,, LDD 0,Y EC2B,DD 06,OPENSPC1:, OPENSPC1: STD BASEND EC2D,18 EC 02,OPENSPC3:, OPENSPC3: LDD 2,Y EC30,CD A3 04,, CPD 4,Y EC33,25 19,, BLO OPENSPC2 EC35,CD EE 02,, LDX 2,Y EC38,A6 00,, LDAA 0,X EC3A,09,, DEX EC3B,CD EF 02,, STX 2,Y EC3E,CD EE 00,, LDX 0,Y EC41,A7 00,, STAA 0,X EC43,09,, DEX EC44,CD EF 00,, STX 0,Y EC47,20 E4,, BRA OPENSPC3 EC49,86 09,OPENSPC4:, OPENSPC4: LDAA #OMEMERR EC4B,7E EA 98,, JMP RPTERR EC4E,38,OPENSPC2:, OPENSPC2: PULX EC4F,38,, PULX EC50,38,, PULX EC51,18 38,, PULY EC53,39,, RTS ,,, * ,,, * ,,, */***** putline() *****/ /* move line from token buffer to program ,,, * buffer */ ,,, *putline(cptr) ,,, *char *cptr; ,,, *{ ,,, * short count; ,,, * count=tknbuf[2]; /* get length of line in token buffer */ ,,, * tbufptr=tknbuf; /* point to start of token buffer */ ,,, * while(count) ,,, * { ,,, * *cptr++=*tbufptr++; /* move a byte */ ,,, * --count; /* decrement the byte count */ ,,, * } ,,, * return; ,,, *} ,,, * ,,, * ,,, PUTLINE: EQU * EC54,3C,, PSHX EC55,DE 4B,, LDX TKNBUFS EC57,E6 02,, LDAB 2,X EC59,38,, PULX EC5A,18 DE 4B,, LDY TKNBUFS EC5D,18 A6 00,PUTLINE1:, PUTLINE1: LDAA 0,Y EC60,18 08,, INY EC62,A7 00,, STAA 0,X EC64,08,, INX EC65,5A,, DECB EC66,26 F5,, BNE PUTLINE1 EC68,39,, RTS ,,, * ,,, * ,,, */***** apendlin() *****/ /* appent line to end of program buffer */ ,,, * ,,, *apendlin() ,,, *{ ,,, * if((basend+tknbuf[2])<=basmend) /* do we have enough memory left? */ ,,, * { ,,, * putline(basend); /* move the line */ ,,, * basend+=tknbuf[2]; /* set the new end of basic pointer */ ,,, * } ,,, * else errcode=OMEMERR; /* not enough memory, error */ ,,, * return; ,,, *} ,,, * ,,, * ,,, APENDLIN: EQU * EC69,DE 4B,, LDX TKNBUFS EC6B,E6 02,, LDAB 2,X EC6D,DE 0A,, LDX VAREND EC6F,3A,, ABX EC70,9C 0E,, CPX BASMEND EC72,22 0D,, BHI APENDLN1 ,,, * LDAB TKNBUF+2 EC74,BD EC A3,, JSR MOVEVARSUP EC77,DE 06,, LDX BASEND EC79,3A,, ABX EC7A,8F,, XGDX EC7B,DE 06,, LDX BASEND EC7D,DD 06,, STD BASEND EC7F,20 D3,, BRA PUTLINE EC81,86 09,APENDLN1:, APENDLN1: LDAA #OMEMERR EC83,7E EA 98,, JMP RPTERR ,,, * ,,, * ,,, */***** repline() *****/ /* replace line in buffer */ ,,, * ,,, *repline(ptr) ,,, *char *ptr; ,,, *{ ,,, * short lendif,temp1,temp2; ,,, * temp1=*(ptr+2); /* convert type from char to int */ ,,, * temp2=(tknbuf[2]); ,,, * lendif=temp1-temp2; /* get the difference in line length */ ,,, * if(lendif==0) /* if the same, just write over the old */ ,,, * { ,,, * putline(ptr); ,,, * } ,,, * ,,, * ,,, REPLINE: EQU * EC86,E6 02,, LDAB 2,X EC88,3C,, PSHX EC89,DE 4B,, LDX TKNBUFS EC8B,E0 02,, SUBB 2,X EC8D,38,, PULX EC8E,26 02,, BNE REPLINE1 EC90,20 C2,, BRA PUTLINE ,,, * ,,, * ,,, * else if(lendif<0) /* if line in tknbuf is larger */ ,,, * { ,,, * lendif=-lendif; /* make it a positive number */ ,,, * openspc(lendif,ptr); /* tru to open up a space */ ,,, * if(errcode) return; /* if not enough memory, return */ ,,, * putline(ptr); /* if ok, copy line to program buffer */ ,,, * } ,,, * ,,, * ,,, REPLINE1: EQU * EC92,2A 08,, BPL REPLINE2 EC94,50,, NEGB EC95,3C,, PSHX EC96,BD EC 14,, JSR OPENSPC EC99,38,, PULX EC9A,20 B8,, BRA PUTLINE ,,, * ,,, * ,,, * else /* if line in tknbuf is smaller */ ,,, * { ,,, * closespc(lendif,ptr); /* close up excess space */ ,,, * putline(ptr); /* put new line in program buffer */ ,,, * } ,,, * return; ,,, *} ,,, * ,,, * ,,, REPLINE2: EQU * EC9C,3C,, PSHX EC9D,BD EB CB,, JSR CLOSESPC ECA0,38,, PULX ECA1,20 B1,, BRA PUTLINE ,,, * ,,, * ,,, MoveVarsUp: ECA3,18 3C,, PSHY ; SAVE THE Y REGISTER. ECA5,37,, PSHB ; SAVE THE BYTE COUNT. ECA6,DE 0A,, LDX VAREND ; POINT TO THE END OF THE VARIABLE MEMORY SPACE. ECA8,18 DE 0A,, LDY VAREND ; POINT TO THE END OF VARIABLE MEMORY SPACE. ECAB,3A,, ABX ; ADD THE NUMBER OF BYTES TO MOVE TO THE POINTER. ECAC,DC 0A,, LDD VAREND ; GET THE CURRENT VARIABLE TABLE ENDING ADDRESS. ECAE,DF 0A,, STX VAREND ; SAVE THE NEW END OF VARIABLE TABLE POINTER. ECB0,93 08,, SUBD VARBEGIN ; CALCULATE THE NUMBER OF BYTES TO MOVE. ECB2,27 0F,, BEQ MOVEUP2 ; JUST RETURN IF THERE IS NOTHING TO MOVE. ECB4,DD 6C,, std VarSize ; save the size of the variable table (9/12/89). ECB6,18 A6 00,MOVEUP1:, MOVEUP1: LDAA 0,Y ; GET A BYTE. ECB9,A7 00,, STAA 0,X ; MOVE IT. ECBB,09,, DEX ECBC,18 09,, DEY ECBE,8D 32,, bsr DecCount ; DECREMENT THE BYTE COUNT. ARE WE DONE? (9/12/89). ECC0,2A F4,, BPL MOVEUP1 ; GO TILL WE'RE DONE. ECC2,08,, INX ; ADJUST THE POINTER ECC3,DF 08,MOVEUP2:, MOVEUP2: STX VARBEGIN ; SAVE THE NEW START OF VARIABLE TABLE POINTER. ECC5,33,, PULB ; RESTORE THE BYTE COUNT. ECC6,18 38,, PULY ; RESTORE Y. ECC8,39,, RTS ; RETURN. ,,, * ,,, * ,,, MoveVarsDn: ECC9,18 3C,, PSHY ; SAVE Y. ECCB,37,, PSHB ; SAVE THE BYTE COUNT. ECCC,18 DE 08,, LDY VARBEGIN ; POINT TO THE CURRENT START OF THE VARIABLE TABLE. ECCF,86 FF,, LDAA #$FF ; MAKE THE BYTE COUNT NEGATIVE SO WE CAN JUST ADD. ECD1,50,, NEGB ECD2,D3 08,, ADDD VARBEGIN ; CALCULATE THE NEW START OF THE VARIABLE TABLE. ECD4,8F,, XGDX ; PUT THE NEW STARTING ADDRESS OF THE VARIABLE TABLE INTO X. ECD5,DC 0A,, LDD VAREND ; GET THE OLD TABLE ENDING ADDRESS. ECD7,93 08,, SUBD VARBEGIN ; SUBTRACT THE OLD TABLE STARTING ADDRESS TO GET THE SIZE OF THE TABLE. ECD9,DF 08,, STX VARBEGIN ; SAVE THE POINTER TO THE NEW START OF THE VARIABLE TABLE. ECDB,DD 6C,, std VarSize ; save the size of the variable table (9/12/89). ECDD,27 0D,, BEQ MOVEDN2 ; IF THE SIZE IS 0 (NO VARIABLES ALLOCATED) EXIT. ECDF,18 A6 00,MOVEDN1:, MOVEDN1: LDAA 0,Y ; GET A BYTE. ECE2,A7 00,, STAA 0,X ; MOVE IT. ECE4,08,, INX ; MOVE THE DESTINATION POINTER. ECE5,18 08,, INY ; MOVE THE SOURCE POINTER. ECE7,8D 09,, bsr DecCount ; DECREMENT THE BYTE COUNT. ARE WE DONE? (9/12/89). ECE9,2A F4,, BPL MOVEDN1 ; NO. KEEP MOVIN' THEM BYTES. ECEB,09,, DEX ECEC,DF 0A,MOVEDN2:, MOVEDN2: STX VAREND ; SAVE THE NEW POINTER TO THE END OF THE VARIABLE TABLE. ECEE,33,, PULB ; RESTORE THE BYTE COUNT. ECEF,18 38,, PULY ; RESTORE Y. ECF1,39,, RTS ; RETURN. ,,, * ,,, * ,,, DecCount: ECF2,DC 6C,, ldd VarSize ; get the size of the variable table. ECF4,83 00 01,, subd #1 ; decrement it. ECF7,DD 6C,, std VarSize ; save the new value. ECF9,39,, rts ; return. ,,, #Include 'INITS.Asm' ,,, * title Inits.Asm ,,, * ,,, * ,,, */***** initvars() *****/ ,,, * ,,, *initvars() ,,, *{ ,,, * char *x; ,,, * varbegin=varend=0x7000; ,,, * varmend=0x7FFF; ,,, * for(x=varbegin; x<=varmend; x++) *x=0; ,,, * basbeg=basend=0x4000; ,,, * basmend=0x6FFF; ,,, * for(x=basbeg; x<=basmend; x++) *x=0; ,,, * hiline=0; ,,, * return; ,,, *} ,,, * ,,, * ,,, INITVARS: EQU * ECFA,FE FF C0,, LDX RAMStart ; YES. VARIABLES START AT RAMBEG. ECFD,DF 08,, STX VARBEGIN ; SET POINTERS TO BOTH START AND END OF VARIABLE ECFF,DF 0A,, STX VAREND ; STORAGE. ED01,DF 04,, STX BASBEG ; SET POINTERS TO BOTH THE START AND END OF THE ED03,DF 06,, STX BASEND ; BASIC PROGRAM. ED05,8F,, XGDX ; GET THE START OF RAM INTO D ED06,F3 FF C2,, ADDD RAMSize ; add the size of the RAM to it. ED09,83 02 51,, SUBD #SWSTKSize+1 ; subtract the size of the software stack, token & input buffers. ED0C,DD 10,, STD VARMEND ; SAVE THE POINTER. ED0E,DD 0E,, STD BASMEND ; MAKE IT THE END OF BASIC PROGRAM MEMORY. ED10,C3 00 01,, addd #1 ; Set up a pointer to the input buffer. ED13,DD 49,, std INBUFFS ; Save the pointer. ED15,C3 00 50,, addd #IBUFLEN ; add the length of the input buffer to create a pointer to the token buffer. ED18,DD 4B,, std TKNBUFS ; save the pointer. ED1A,C3 00 80,, addd #TBUFLEN ; add the length of the token buffer to create a pointer to the end of the operand stack. ED1D,DD 4D,, std EOPSTK ; save the pointer to the end of the operator stack. ED1F,C3 00 1E,, addd #OPSLEN ; add the length of the operand stack. ED22,DD 4F,, std STOPS ; save the pointer to the start of the operator stack. ED24,DD 51,, std ENUMSTK ; also make it the end of the operand stack. ED26,C3 00 3C,, addd #NUMSLEN ; add the length of the operand stack. ED29,DD 53,, std STNUMS ; save the result as the start of the operand stack. ED2B,DD 55,, std EFORSTK ; also make it the end of the FOR stack. ED2D,C3 00 50,, addd #FORSLEN ; Add the length of the FOR stack. ED30,DD 57,, std STFORSTK ; save the result as the start of the FOR stack. ED32,DD 59,, std EWHSTK ; also make it the end of the while stack. ED34,C3 00 10,, addd #WHSLEN ; add the length of the while stack. ED37,DD 5B,, std STWHSTK ; save the pointer as the start of the while stack. ED39,DD 5D,, std EGOSTK ; also make it the end of the GOSUB stack. ED3B,C3 00 10,, addd #GOSLEN ; add the length of the GOSUB stack. ED3E,DD 5F,, std STGOSTK ; save it as the start of the GOSUB stack. ED40,DE 04,, LDX BASBEG ; point to the start of the basic program buffer. ED42,6F 00,INIT1:, INIT1: CLR 0,X ; CLEAR THE STORAGE TO ZERO. ED44,08,, INX ; POINT TO THE NEXT LOCATION. ED45,9C 0E,, CPX BASMEND ; ARE WE DONE? ED47,23 F9,, BLS INIT1 ; NO. KEEP CLEARING. ,,, * ; YES. POINT TO THE PHYSICAL END OF MEMORY. ED49,FE FF C4,, ldx EEStart ED4C,A6 0A,, LDAA AUTOSTF,X ; GET THE AUTO START FLAG AGAIN. ED4E,81 55,, CMPA #$55 ; IS THE AUTO START MODE SET? ED50,26 03,, BNE INIT5 ; NO. DO A NORMAL INIT. ,,, * ED52,BD F3 AA,, JSR AUTOLOAD ; GO LOAD the program and VARIABLES INTO RAM. ED55,CC 00 00,INIT5:, INIT5: LDD #0 ; MAKE THE HIGHEST LINE IN THE PROGRAM 0. ED58,DD 0C,, STD HILINE ED5A,DD 29,, STD CURLINE ; MAKE THE CURRENT LINE #0. ED5C,BD F2 86,, JSR RUNINIT ; GO INITALIZE ALL THE SOFTWARE STACKS. ED5F,7F 00 1B,, CLR TRFLAG ; TURN THE TRACE MODE OFF. ED62,86 01,, LDAA #1 ; "CONT" COMMAND NOT ALLOWED. ED64,97 1C,, STAA CONTFLAG ,,, ;JKJ : Not present! ,,, ; LDX DFLOPADR ; point to the D-Flip flop address. ,,, ; STAA 0,X ; CONNECT SCI RX PIN TO THE HOST CONNECTOR. ED66,7F 00 37,, CLR DEVNUM ; MAKE THE DEFAULT DEVICE NUMBER 0 (CONSOLE). ED69,7F 00 19,, clr IMMID ; clear the immediate mode flag (added 9/17/90). ED6C,DE 0A,, LDX VAREND ; GET THE POINTER TO THE END OF VARIABLE STORAGE. ED6E,08,, INX ; BUMP IT BY 1. ED6F,DF 2D,, STX STRASTG ; POINT TO THE DYNAMIC ARRAY STORAGE. ED71,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, POWERUP: EQU * ED72,FC FF C8,, LDD IOBASE ; GET THE BASE ADDRESS OF THE I/O REGISTERS. ED75,DD 61,, STD IOBaseV ED77,44,, LSRA ED78,44,, LSRA ED79,44,, LSRA ED7A,44,, LSRA ED7B,B7 10 3D,, STAA $103D ; remap the I/0 regs to where the user wants them. ED7E,DE 61,, LDX IOBaseV ; point to the I/O Register Base. ED80,86 93,, LDAA #$93 ; TURN ON A/D, USE E CLOCK, SET IRQ LEVEL SENSITIVE ED82,A7 39,, STAA OPTION,X ; DELAY AFTER STOP, DISABLE CLOCK MONITOR, SET COP ,,, * ; TIMMER PREIOD TO MAX. ED84,86 03,, LDAA #$03 ; SET THE TIMER PRESCALER TO /16. ED86,A7 24,, STAA TMSK2,X ,,, * ED88,FC FF C0,, LDD RAMStart ; Get start of RAM. ED8B,F3 FF C2,, ADDD RAMSize ; Add the size of the RAM to it. ED8E,8F,, XGDX ; Put the calculated address into X. ED8F,35,, TXS ; Transfer the address to the stack pointer. ,,, * ED90,CE 00 C4,, LDX #RAMVECTS ; POINT TO THE RAM INTERRUPT VECTOR TABLE. ED93,18 CE ED FB,, LDY #RETII ; GET ADDRESS OF RTI INSTRUCTION. ED97,C6 14,, LDAB #20 ; PUT THE "JMP" OPCODE INTO ALL VECTOR LOCATIONS. ED99,86 7E,, LDAA #JMPOP ; GET THE JMP OPCODE. ED9B,A7 00,POWERUP1:, POWERUP1: STAA 0,X ; STORE IT. ED9D,08,, INX ; POINT TO THE NEXT VECTOR. ED9E,1A EF 00,, STY 0,X ; INITALIZE VECTOR TO "RTI". EDA1,08,, INX EDA2,08,, INX EDA3,5A,, DECB ; DONE? EDA4,26 F5,, BNE POWERUP1 ; NO. INITALIZE ALL VECTORS. EDA6,CE 00 F7,, LDX #ILLOP ; POINT TO THE ILLEGAL OP-CODE VECTOR. EDA9,CC ED 72,, LDD #POWERUP ; GET THE ADDRESS OF THE POWER UP VECTOR. EDAC,ED 01,, STD 1,X ; INITALIZE ILLEGAL OP-CODE VECTOR. EDAE,ED 04,, STD 4,X ; INITALIZE WATCH DOG FAIL VECTOR. EDB0,ED 07,, STD 7,X ; INITALIZE CLOCK MONITOR FAIL VECTOR. ,,, * ,,, * ,,, * EDB2,CE 00 A4,, LDX #INTABLE ; POINT TO THE START OF THE I/O VECTOR TABLE. EDB5,18 CE FF A0,, LDY #IOVects ; point to the default table in ROM. EDB9,C6 20,, LDAB #32 ; GET NUMBER OF BYTES IN THE TABLE. EDBB,18 A6 00,POWERUP2:, POWERUP2: ldaa 0,Y ; Move a byte of the table from ROM into RAM. EDBE,A7 00,, staa 0,X EDC0,08,, INX ; POINT TO THE NEXT BYTE. EDC1,18 08,, INY EDC3,5A,, DECB ; DECREMENT THE COUNT. EDC4,26 F5,, BNE POWERUP2 ; GO TILL WE'RE DONE. ,,, * ,,, * EDC6,CE ED F9,, LDX #TIMEINT ; GET THE ADDRESS OF THE OUTPUT COMPARE 1 ROUTINE. EDC9,DF E0,, STX TOC1+1 ; PUT IT IN THE INTERRUPT VECTOR. EDCB,86 03,, LDAA #SWPRE+1 ; ADD 1 TO NORMAL PRE SCALER. EDCD,97 3C,, STAA TIMEPRE ; SET UP THE SOFTWARE PRESCALER. EDCF,4F,, clra EDD0,5F,, clrb EDD1,DD 38,, std TIMEREG ; ZERO THE TIME REGISTER. EDD3,DD 3A,, std TIMECMP ; zero the time compare register. EDD5,DE 61,, LDX IOBaseV EDD7,8D 23,, BSR TIMINTS ; GO SETUP THE TIMER FOR THE FIRST INTERRUPT. EDD9,86 80,, LDAA #$80 ; ENABLE INTERRUPTS FROM OC1. EDDB,A7 22,, STAA TMSK1,X ,,, EDDD,CE EE 36,, LDX #IRQINT ; GET THE ADDRESS OF THE IRQ SERVICE ROUTINE. EDE0,DF EF,, STX IRQI+1 ; PUT IT IN THE IRQ VECTOR. EDE2,CE EE 3C,, LDX #PACCINT ; GET THE ADDRESS OF THE PACC INT ROUTINE. EDE5,DF CB,, STX PACCIE+1 ; SET ADDRESS IN INPUT EDGE INTERRUPT VECTOR. EDE7,DF CE,, STX PACCOVF+1 ; SET ADDRESS IN PACC OVERFLOW INTERRUPT VECTOR. EDE9,4F,, CLRA EDEA,5F,, CLRB EDEB,DD 3D,, STD ONTIMLIN ; INITALIZE THE LINE POINTERS. EDED,DD 3F,, STD ONIRQLIN EDEF,DD 41,, STD ONPACLIN ,,, * ,,, * ,,, * EDF1,FE FF CC,, LDX UserInit EDF4,AD 00,, JSR 0,X ; INITALIZE THE ACIA & SCI. EDF6,7E E0 03,, JMP MAIN ; GO TO BASIC. ,,, * ,,, * ,,, * EDF9,8D 01,TIMEINT:, TIMEINT: BSR TIMINTS EDFB,3B,RETII:, RETII: RTI ; RETURN FROM ALL INTERRUPT SOURCES. ,,, * ,,, * EDFC,DE 61,TIMINTS:, TIMINTS: LDX IOBaseV ; Point to the I/O Base Address. EDFE,EC 16,, LDD TOC1REG,X ; GET THE VALUE OF THE TIMER/COUNTER. EE00,F3 FF CA,TIMINTS3:, TIMINTS3: ADDD TimeVal ; ADD IN 62500 FOR NEXT COMPARE ( 2 HZ INT.). EE03,ED 16,, STD TOC1REG,X ; PUT IT IN THE OUTPUT COMPARE REGISTER. EE05,86 80,, LDAA #$80 ; SETUP TO CLEAR THE OC1 FLAG. EE07,A7 23,, STAA TFLAG1,X EE09,7A 00 3C,, DEC TIMEPRE ; HAVE TWO OUTPUT COMPARES OCCURED? EE0C,26 27,, BNE TIMINTS1 ; NO. JUST RETURN. EE0E,86 02,, LDAA #SWPRE ; YES. RELOAD THE REGISTER. EE10,97 3C,, STAA TIMEPRE EE12,DC 38,, LDD TIMEREG ; GET THE CURRENT VALUE OF "TIME". EE14,C3 00 01,, ADDD #1 ; ADD 1 SECOND TO THE COUNT. EE17,DD 38,, STD TIMEREG ; UPDATE THE TIME REGISTER. EE19,DC 3A,, LDD TIMECMP ; GET THE VALUE TO COMPARE TO FOR "ONTIME". EE1B,27 18,, BEQ TIMINTS1 ; IF IT'S 0, THE "ONTIME" FUNCTION IS OFF. EE1D,1A 93 38,, CPD TIMEREG ; DOES THE COMPARE VALUE MATCH THE TIME REGISTER? EE20,26 13,, BNE TIMINTS1 ; NO. JUST RETURN. EE22,18 DE 3D,, LDY ONTIMLIN ; MAKE THE POINTER TO THE LINE NUMBER THE NEW IP. EE25,31,, INS ; GET RID OF THE RETURN ADDRESS. EE26,31,, INS EE27,7C 00 19,TIMINTS2:, TIMINTS2: INC IMMID ; FAKE THE GOTO ROUTINE OUT. EE2A,DC 29,, LDD CURLINE ; SAVE THE CURRENT LINE NUMBER IN MAIN PROGRAM. EE2C,DD 45,, STD SCURLINE EE2E,DC 2B,, LDD ADRNXLIN ; SAVE THE ADDRESS OF THE NEXT LINE IN MAIN PROG. EE30,DD 47,, STD SADRNXLN EE32,7E F4 45,, JMP RGOTO3 ; GOTO THE SERVICE ROUTINE. EE35,39,TIMINTS1:, TIMINTS1: RTS ; RETURN. ,,, * ,,, * ,,, * ,,, IRQINT: EQU * EE36,18 DE 3F,, LDY ONIRQLIN ; GET POINTER TO LINE NUMBER OF THE IRQ SERVICE. EE39,26 EC,, BNE TIMINTS2 ; GO DO IT. EE3B,3B,, RTI ; IF IT'S 0, "ONIRQ" HAS NOT BEEN EXECUTED. ,,, * ,,, * ,,, PACCINT: EQU * EE3C,DE 61,, LDX IOBaseV EE3E,86 30,, LDAA #$30 ; RESET BOTH THE TIMER OVERFLOW & INPUT FLAG. EE40,A7 25,, STAA TFLG2,X EE42,18 DE 41,, LDY ONPACLIN ; GET POINTER TO LINE NUMBER OF THE SERVICE ROUT. EE45,26 E0,, BNE TIMINTS2 EE47,3B,, RTI ,,, * ,,, * ,,, #Include 'COMMAND1.Asm' ,,, * title COMMAND1 ,,, * page ,,, */***** chckcmds() *****/ ,,, * ,,, *chckcmds() ,,, *{ ,,, * if(match("LIST")) clist(); ,,, * else if(match("RUN")) crun(); ,,, * else if(match("NEW")) cnew(); ,,, * else if(match("CONT")) ccont(); ,,, * else if(match("CLEAR")) cclear(); ,,, * else return(0); ,,, * return(1); ,,, *} ,,, * ,,, * ,,, CHCKCMDS: EQU * EE48,BD E3 C3,, JSR GETCHR ; GET FIRST CHAR FROM THE INPUT BUFFER. EE4B,81 0D,, CMPA #EOL ; IS IT AN EOL? EE4D,26 04,, BNE CHKCMDS1 ; NO. GO CHECK FOR COMMANDS. EE4F,CC 00 00,CHKCMDS5:, CHKCMDS5: LDD #0 ; YES. JUST RETURN. EE52,39,, RTS EE53,CE EE 71,CHKCMDS1:, CHKCMDS1: LDX #CMDTBL ; POINT TO COMMAND TABLE. EE56,BD E3 A5,CHKCMDS2:, CHKCMDS2: JSR STREQ ; GO CHECK FOR A COMMAND. EE59,25 0E,, BCS CHKCMDS3 ; IF WE FOUND ONE GO EXECUTE IT. EE5B,08,CHKCMDS4:, CHKCMDS4: INX ; ADVANCE POINTER TO NEXT CHAR IN TABLE ENTRY. EE5C,A6 00,, LDAA 0,X ; GET THE CHAR. ARE WE AT THE END OF THIS ENTRY? EE5E,26 FB,, BNE CHKCMDS4 ; NO. KEEP GOING TILL WE ARE PAST IT. EE60,08,, INX ; BYPASS END OF COMMAND MARKER & EXECUTION ADDR. EE61,08,, INX EE62,08,, INX EE63,6D 00,, TST 0,X ; ARE WE AT THE END OF THE TABLE? EE65,26 EF,, BNE CHKCMDS2 ; NO. GO CHECK THE NEXT TABLE ENTRY. EE67,20 E6,, BRA CHKCMDS5 ; YES. RETURN W/ ENTRY NOT FOUND INDICATION. EE69,EE 01,CHKCMDS3:, CHKCMDS3: LDX 1,X ; GET ADDRESS OF COMMAND. EE6B,AD 00,, JSR 0,X ; GO DO IT. EE6D,CC 00 01,, LDD #1 ; SHOW WE EXECUTED A COMMAND. EE70,39,, RTS ; RETURN. ,,, * ,,, * ,,, CMDTBL: EQU * EE71,4C 49 53 54,, FCC "LIST" EE75,00,, FCB 0 EE76,EE C5,, FDB CLIST EE78,52 55 4E,, FCC "RUN" EE7B,00,, FCB 0 EE7C,F1 59,, FDB CRUN EE7E,4E 45 57,, FCC "NEW" EE81,00,, FCB 0 EE82,F2 C7,, FDB CNEW EE84,43 4F 4E 54,, FCC "CONT" EE88,00,, FCB 0 EE89,F2 B2,, FDB CCONT EE8B,43 4C 45 41 52,, FCC "CLEAR" EE90,00,, FCB 0 EE91,F2 DB,, FDB CCLEAR EE93,45 53 41 56 45,, FCC "ESAVE" EE98,00,, FCB 0 EE99,F2 F2,, FDB CESAVE EE9B,45 4C 4F 41 44,, FCC "ELOAD" EEA0,00,, FCB 0 EEA1,F3 56,, FDB CELOAD EEA3,4C 4C 49 53 54,, FCC "LLIST" EEA8,00,, FCB 0 EEA9,F3 90,, FDB CLLIST EEAB,41 55 54 4F 53 54,, FCC "AUTOST" EEB1,00,, FCB 0 EEB2,F3 9B,, FDB CAUTOST EEB4,4E 4F 41 55 54 4F,, FCC "NOAUTO" EEBA,00,, FCB 0 EEBB,F3 A6,, FDB CNOAUTO EEBD,46 52 45 45,, FCC "FREE" EEC1,00,, FCB 0 EEC2,F3 D7,, FDB CFREE EEC4,00,, FCB 0 ;END OF TABLE MARKER. ,,, ,,, ,,, */***** clist() *****/ ,,, * ,,, *clist() ,,, *{ ,,, * int *intptr; ,,, * char token; ,,, * if(basbeg==basend) return; /* if basic buffer empty, return */ ,,, * skipspcs(); /* skip any spaces after "LIST" */ ,,, * ,,, * ,,, CLIST: EQU * EEC5,BD E1 0E,, JSR NL2 EEC8,DC 04,, LDD BASBEG EECA,1A 93 06,, CPD BASEND EECD,26 01,, BNE CLIST1 EECF,39,, RTS EED0,BD E0 5B,CLIST1:, CLIST1: JSR SKIPSPCS ,,, * ,,, * ,,, * if(numeric(getchr())) ,,, * { ,,, * firstlin=getlinum(); ,,, * if(getchr()=='-') ,,, * { ,,, * incibp(); ,,, * lastlin=getlinum; ,,, * } ,,, * } ,,, * else ,,, * { ,,, * intptr=basbeg; ,,, * lastlin=hiline; ,,, * firstlin=*intptr; ,,, * } ,,, * if(firstlin=0x80) ,,, * { ,,, * lvarcon(); ,,, * } ,,, * else ,,, * { ,,, * lkeyword(); ,,, * } ,,, * } ,,, * nl(); ,,, * ++tokptr; ,,, * } ,,, * return; ,,, *} ,,, * ,,, * EF31,DC 6A,CLIST6:, CLIST6: LDD TOKPTR EF33,1A 93 14,, CPD LASTLIN EF36,26 01,, BNE CLIST7 EF38,39,, RTS EF39,DE 6A,CLIST7:, CLIST7: LDX TOKPTR EF3B,EC 00,, LDD 0,X EF3D,08,, INX EF3E,08,, INX EF3F,08,, INX EF40,DF 6A,, STX TOKPTR EF42,BD EB 1A,, JSR OUTDECI EF45,DE 6A,CLIST8:, CLIST8: LDX TOKPTR EF47,A6 00,, LDAA 0,X EF49,81 7D,, CMPA #EOLTOK EF4B,27 0D,, BEQ CLIST9 EF4D,4D,, TSTA EF4E,2B 05,, BMI CLIST10 EF50,BD EF D8,, JSR LKEYWORD EF53,20 F0,, BRA CLIST8 EF55,BD EF 64,CLIST10:, CLIST10: JSR LVARCON EF58,20 EB,, BRA CLIST8 EF5A,BD E1 10,CLIST9:, CLIST9: JSR NL EF5D,DE 6A,, LDX TOKPTR EF5F,08,, INX EF60,DF 6A,, STX TOKPTR EF62,20 CD,, BRA CLIST6 ,,, * ,,, * ,,, */***** lvarcon() *****/ ,,, * ,,, *lvarcon() ,,, *{ ,,, * char tok; ,,, * tok=gettok; ,,, * if(tok<=0x88) ,,, * { ,,, * if(tok==FVARTOK) lfvar(); ,,, * else if(tok==SVARTOK) lsvar(); ,,, * else if(tok==IVARTOK) livar(); ,,, * else { errcode=ILTOKERR; return; } ,,, * } ,,, * ,,, * ,,, * else if(tok<=0xA8) ,,, * { ,,, * if(tok==FCONTOK) lfcon(); ,,, * else if(tok==SCONTOK) lscon(); ,,, * else if(tok==LCONTOK) llcon(); ,,, * else if(tok==ICONTOK) licon(); ,,, * else { errcode=ILTOKERR; return; } ,,, * } ,,, * else { errcode=ILTOKERR; return; } ,,, *} ,,, * ,,, LVARCON: EQU * EF64,DE 6A,, LDX TOKPTR EF66,A6 00,, LDAA 0,X EF68,84 EF,, ANDA #$EF ; MASK OFF ARRAY INDICATOR IF PRESENT. EF6A,CE EF 82,, LDX #VCTOKTBL EF6D,A1 00,LVARCON1:, LVARCON1: CMPA 0,X EF6F,27 0C,, BEQ LVARCON2 EF71,08,, INX EF72,08,, INX EF73,08,, INX EF74,6D 00,, TST 0,X EF76,26 F5,, BNE LVARCON1 EF78,86 08,, LDAA #ILTOKERR EF7A,7E EA 98,, JMP RPTERR EF7D,EE 01,LVARCON2:, LVARCON2: LDX 1,X EF7F,AD 00,, JSR 0,X EF81,39,, RTS ,,, * ,,, * ,,, VCTOKTBL: EQU * EF82,84,, FCB IVARTOK EF83,EF 8F,, FDB LIVAR EF85,A2,, FCB SCONTOK EF86,EF C4,, FDB LSCON EF88,A8,, FCB LCONTOK EF89,EF CB,, FDB LLCON EF8B,A4,, FCB ICONTOK EF8C,EF BD,, FDB LICON EF8E,00,, FCB 0 ; END OF TABLE MARKER. ,,, * ,,, * ,,, * ,,, * ,,, */***** livar() *****/ ,,, * ,,, *livar() ,,, *{ ,,, * lfvar(); ,,, * outbyte('%'); ,,, * return; ,,, *} ,,, * ,,, * ,,, LIVAR: EQU * EF8F,DE 6A,, LDX TOKPTR EF91,08,, INX EF92,EC 00,, LDD 0,X EF94,D3 08,, ADDD VARBEGIN EF96,08,, INX EF97,08,, INX EF98,DF 6A,, STX TOKPTR EF9A,8F,, XGDX EF9B,A6 01,LIVAR2:, LIVAR2: LDAA 1,X EF9D,BD FE CD,, JSR OUTBYTE EFA0,A6 02,, LDAA 2,X EFA2,27 03,, BEQ LIVAR1 EFA4,BD FE CD,, JSR OUTBYTE EFA7,39,LIVAR1:, LIVAR1: RTS ,,, * ,,, * ,,, LFCON: EQU * EFA8,DC 6A,, LDD TOKPTR EFAA,C3 00 06,, ADDD #FSIZ+1 EFAD,8F,LFCON2:, LFCON2: XGDX EFAE,E6 00,, LDAB 0,X EFB0,08,, INX EFB1,A6 00,LFCON1:, LFCON1: LDAA 0,X EFB3,BD FE CD,, JSR OUTBYTE EFB6,08,, INX EFB7,5A,, DECB EFB8,26 F7,, BNE LFCON1 EFBA,DF 6A,, STX TOKPTR EFBC,39,, RTS ,,, * ,,, * ,,, */***** licon() *****/ ,,, * ,,, *licon() ,,, *{ ,,, * int count; ,,, * tokptr=tokptr+ISIZ+1; ,,, * count=*tokptr++; ,,, * while(count--) ,,, * { ,,, * outbyte(*tokptr++); ,,, * } ,,, * return; ,,, *} ,,, * ,,, * ,,, LICON: EQU * EFBD,DC 6A,, LDD TOKPTR EFBF,C3 00 03,, ADDD #ISIZ+1 EFC2,20 E9,, BRA LFCON2 ,,, * ,,, * ,,, */***** lscon() *****/ ,,, * ,,, *lscon() ,,, *{ ,,, * int count; ,,, * ++tokptr; ,,, * count=*tokptr++; ,,, * while(count--) ,,, * { ,,, * outbyte(*tokptr++); ,,, * } ,,, * return; ,,, *} ,,, * ,,, * ,,, LSCON: EQU * EFC4,DC 6A,, LDD TOKPTR EFC6,C3 00 01,, ADDD #1 EFC9,20 E2,, BRA LFCON2 ,,, * ,,, * ,,, */***** llcon *****/ ,,, * ,,, *llcon() ,,, *{ ,,, * int *intptr; ,,, * intptr=++tokptr; ,,, * tokptr+=2; ,,, * outdeci(*intptr); ,,, * return; ,,, *} ,,, * ,,, * ,,, LLCON: EQU * EFCB,DE 6A,, LDX TOKPTR EFCD,08,, INX EFCE,EC 00,, LDD 0,X EFD0,08,, INX EFD1,08,, INX EFD2,DF 6A,, STX TOKPTR EFD4,BD EB 1A,, JSR OUTDECI EFD7,39,, RTS ,,, * ,,, * ,,, */***** lkeyword *****/ ,,, * ,,, *lkeyword() ,,, *{ ,,, * char *charptr,token; ,,, * token=*tokptr++ ,,, * ,,, * ,,, LKEYWORD: EQU * EFD8,DE 6A,, LDX TOKPTR EFDA,A6 00,, LDAA 0,X EFDC,08,, INX EFDD,DF 6A,, STX TOKPTR EFDF,81 7F,, CMPA #MSCNTOK EFE1,26 03,, BNE LKEYWRD3 EFE3,7E F0 1C,, JMP LMSPCS EFE6,81 0A,LKEYWRD3:, LKEYWRD3: CMPA #REMTOK EFE8,26 03,, BNE LKEYWRD4 EFEA,7E F0 34,, JMP LREMLINE EFED,81 0C,LKEYWRD4:, LKEYWRD4: CMPA #DATATOK EFEF,26 03,, BNE LKEYWRD5 EFF1,7E F0 2C,, JMP LDATALIN EFF4,81 36,LKEYWRD5:, LKEYWRD5: CMPA #FUNCTFLG EFF6,26 0C,, BNE LKEYWRD6 EFF8,DE 6A,, LDX TOKPTR EFFA,A6 00,, LDAA 0,X EFFC,08,, INX EFFD,DF 6A,, STX TOKPTR EFFF,CE F1 0B,, LDX #LFUNCTBL F002,20 03,, BRA LKEYWRD1 F004,CE F0 4D,LKEYWRD6:, LKEYWRD6: LDX #TOKTBL F007,A1 00,LKEYWRD1:, LKEYWRD1: CMPA 0,X F009,27 0C,, BEQ LKEYWRD2 F00B,08,, INX F00C,08,, INX F00D,08,, INX F00E,6D 00,, TST 0,X F010,26 F5,, BNE LKEYWRD1 F012,86 08,, LDAA #ILTOKERR F014,7E EA 98,, JMP RPTERR F017,EE 01,LKEYWRD2:, LKEYWRD2: LDX 1,X F019,7E E1 1C,, JMP PL ,,, * ,,, * ,,, LMSPCS: EQU * F01C,DE 6A,, LDX TOKPTR F01E,E6 00,, LDAB 0,X F020,08,, INX F021,DF 6A,, STX TOKPTR F023,86 20,, LDAA #$20 F025,BD FE CD,LMSPCS1:, LMSPCS1: JSR OUTBYTE F028,5A,, DECB F029,26 FA,, BNE LMSPCS1 F02B,39,, RTS ,,, * ,,, * ,,, LDATALIN: EQU * F02C,CE E2 46,, LDX #DATA F02F,BD E1 1C,, JSR PL F032,20 06,, BRA LREM3 ,,, * ,,, * ,,, LREMLINE: EQU * F034,CE E2 EA,, LDX #REM F037,BD E1 1C,, JSR PL F03A,DE 6A,LREM3:, LREM3: LDX TOKPTR F03C,08,, INX ; PUT POINTER PAST LENGTH BYTE. F03D,A6 00,LREM1:, LREM1: LDAA 0,X F03F,81 0D,, CMPA #EOL F041,26 04,, BNE LREM2 F043,08,, INX F044,DF 6A,, STX TOKPTR F046,39,, RTS F047,BD FE CD,LREM2:, LREM2: JSR OUTBYTE F04A,08,, INX F04B,20 F0,, BRA LREM1 ,,, * ,,, * ,,, TOKTBL: EQU * F04D,01,, FCB LETTOK F04E,E2 4E,, FDB LET F050,0D,, FCB READTOK F051,E2 55,, FDB READ F053,0E,, FCB RESTRTOK F054,E2 5D,, FDB RESTORE F056,0F,, FCB GOSUBTOK F057,E2 68,, FDB GOSUB F059,12,, FCB GOTOTOK F05A,E2 71,, FDB GOTO F05C,13,, FCB ONTOK F05D,E2 96,, FDB ON F05F,14,, FCB RETNTOK F060,E2 9C,, FDB RETURN F062,15,, FCB IFTOK F063,E2 A6,, FDB IIF F065,38,, FCB THENTOK F066,E9 66,, FDB THENS F068,39,, FCB ELSETOK F069,E9 6B,, FDB ELSES F06B,16,, FCB INPUTTOK F06C,E2 AC,, FDB INPUT F06E,03,, FCB PRINTTOK F06F,E2 B5,, FDB PRINT F071,04,, FCB FORTOK F072,E2 C3,, FDB FOR F074,05,, FCB NEXTTOK F075,E2 CA,, FDB NEXT F077,17,, FCB STOPTOK F078,E2 D2,, FDB STOPSS F07A,18,, FCB ENDTOK F07B,E2 E3,, FDB ENDS F07D,06,, FCB TRONTOK F07E,E2 F1,, FDB TRON F080,07,, FCB TROFFTOK F081,E2 F9,, FDB TROFF F083,19,, FCB WHILETOK F084,E3 02,, FDB WHILE F086,1A,, FCB ENDWHTOK F087,E2 DA,, FDB ENDWH F089,3A,, FCB STEPTOK F08A,E9 C6,, FDB STEP F08C,37,, FCB TOTOK F08D,E9 C3,, FDB TO F08F,7C,, FCB COMMATOK F090,F1 49,, FDB COMMAC F092,7B,, FCB SEMITOK F093,F1 47,, FDB SEMIC F095,7A,, FCB MEOLTOK F096,F1 45,, FDB COLLINC F098,02,, FCB IMLETTOK F099,F1 44,, FDB IMLET F09B,08,, FCB POKETOK F09C,E3 0B,, FDB POKE F09E,79,, FCB EQUALTOK F09F,E5 4A,, FDB EQ F0A1,10,, FCB OPARNTOK F0A2,F1 4B,, FDB OPARN F0A4,11,, FCB CPARNTOK F0A5,F1 4D,, FDB CPARN F0A7,20,, FCB ANDTOK F0A8,E5 23,, FDB ANDS F0AA,21,, FCB ORTOK F0AB,E5 2A,, FDB ORS F0AD,22,, FCB EORTOK F0AE,E5 30,, FDB EORS F0B0,30,, FCB LTTOK F0B1,E5 44,, FDB LT F0B3,31,, FCB GTTOK F0B4,E5 47,, FDB GT F0B6,32,, FCB LTEQTOK F0B7,E5 38,, FDB LTEQ F0B9,33,, FCB GTEQTOK F0BA,E5 3C,, FDB GTEQ F0BC,34,, FCB EQTOK F0BD,E5 4A,, FDB EQ F0BF,35,, FCB NOTEQTOK F0C0,E5 40,, FDB NOTEQ F0C2,40,, FCB PLUSTOK F0C3,E5 13,, FDB PLUS F0C5,41,, FCB MINUSTOK F0C6,E5 16,, FDB MINUS F0C8,50,, FCB MULTTOK F0C9,E5 19,, FDB MULT F0CB,51,, FCB DIVTOK F0CC,E5 1C,, FDB DIV F0CE,52,, FCB MODTOK F0CF,E5 1F,, FDB MODS F0D1,71,, FCB NOTTOK F0D2,E5 51,, FDB NOTS F0D4,2A,, FCB RTIMETOK F0D5,E3 70,, FDB RTIMES F0D7,72,, FCB NEGTOK F0D8,E5 4E,, FDB NEGS F0DA,7E,, FCB SSCNTOK F0DB,F1 4F,, FDB SPACE F0DD,09,, FCB DIMTOK F0DE,E3 13,, FDB DIM F0E0,1B,, FCB EEPTOK F0E1,E3 1A,, FDB EEP F0E3,1C,, FCB PORTATOK F0E4,E3 21,, FDB PORTA F0E6,1D,, FCB PORTBTOK F0E7,E3 2A,, FDB PORTB F0E9,1E,, FCB PORTCTOK F0EA,E3 33,, FDB PORTC F0EC,1F,, FCB PORTDTOK F0ED,E3 3C,, FDB PORTD F0EF,78,, FCB PNUMTOK F0F0,F1 57,, FDB POUNDSGN F0F2,23,, FCB INBYTTOK F0F3,E3 45,, FDB INBYTES F0F5,24,, FCB TIMETOK F0F6,E3 4F,, FDB TIME F0F8,25,, FCB ONTIMTOK F0F9,E2 79,, FDB ONTIME F0FB,26,, FCB ONIRQTOK F0FC,E2 83,, FDB ONIRQ F0FE,27,, FCB RETITOK F0FF,E3 57,, FDB RETI F101,0B,, FCB PACCTOK F102,E3 5F,, FDB PACC F104,28,, FCB ONPACTOK F105,E2 8C,, FDB ONPACC F107,29,, FCB SLEEPTOK F108,E3 67,, FDB SLEEP F10A,00,, FCB 0 ; END OF TABLE MARKER. ,,, * ,,, * ,,, LFUNCTBL: EQU * F10B,01,, FCB FDIVTOK F10C,E7 88,, FDB FDIVS F10E,02,, FCB CHRTOK F10F,E7 90,, FDB CHRS F111,03,, FCB ADCTOK F112,E7 B4,, FDB ADCS F114,04,, FCB ABSTOK F115,E7 98,, FDB ABS F117,05,, FCB RNDTOK F118,E7 9F,, FDB RND F11A,06,, FCB SGNTOK F11B,E7 A6,, FDB SGN F11D,07,, FCB TABTOK F11E,E7 AD,, FDB TABS F120,08,, FCB CALLTOK F121,E7 BB,, FDB CALL F123,09,, FCB PEEKTOK F124,E7 C3,, FDB PEEK F126,0A,, FCB FEEPTOK F127,E3 1A,, FDB EEP F129,0B,, FCB HEXTOK F12A,E7 DA,, FDB HEX F12C,0C,, FCB FPRTATOK F12D,E3 21,, FDB PORTA F12F,0D,, FCB FPRTBTOK F130,E3 2A,, FDB PORTB F132,0E,, FCB FPRTCTOK F133,E3 33,, FDB PORTC F135,0F,, FCB FPRTDTOK F136,E3 3C,, FDB PORTD F138,10,, FCB FPRTETOK F139,F1 51,, FDB PORTE F13B,11,, FCB FTIMETOK F13C,E3 4F,, FDB TIME F13E,12,, FCB HEX2TOK F13F,E7 D2,, FDB HEX2 F141,13,, FCB FPACCTOK F142,E3 5F,, FDB PACC F144,00,IMLET:, IMLET: FCB 0 ; NO KETWORD TO PRINT FOR AN IMPLIED LET. F145,3A,COLLINC:, COLLINC: FCC ":" F146,00,, FCB 0 F147,3B,SEMIC:, SEMIC: FCC ";" F148,00,, FCB 0 F149,2C,COMMAC:, COMMAC: FCC "," F14A,00,, FCB 0 F14B,28,OPARN:, OPARN: FCC "(" F14C,00,, FCB 0 F14D,29,CPARN:, CPARN: FCC ")" F14E,00,, FCB 0 F14F,20,SPACE:, SPACE: FCC " " F150,00,, FCB 0 F151,50 4F 52 54 45,PORTE:, PORTE: FCC "PORTE" F156,00,, FCB 0 F157,23,POUNDSGN:, POUNDSGN: FCC "#" F158,00,, FCB 0 ,,, * ,,, * ,,, CRUN: EQU * F159,BD E1 0E,, JSR NL2 ; DO 2 CR/LF SEQUENCES. F15C,BD F2 86,, JSR RUNINIT ; INITALIZE RUNTIME VARIABLES. F15F,86 01,, LDAA #1 ; SET THE RUN MODE FLAG. F161,97 1D,, STAA RUNFLAG ,,, * ,,, * END OF POINTER INITIALIZATIONS ,,, * F163,18 DE 04,, LDY BASBEG ; POINT TO THE START OF THE PROGRAM. F166,18 9C 06,, CPY BASEND ; IS THERE A PROGRAM IN MEMORY? F169,26 01,, BNE CRUN5 ; YES. GO RUN IT. F16B,39,, RTS ; NO. RETURN. ,,, * F16C,18 EC 00,CRUN5:, CRUN5: LDD 0,Y ; GET NUMBER OF FIRST/NEXT LINE OF BASIC PROGRAM. F16F,DD 29,, STD CURLINE ; MAKE IT THE CURRENT LINE. F171,7D 00 1B,, TST TRFLAG ; IS THE TRACE MODE TURNED ON? F174,27 12,, BEQ CRUN6 ; NO. CONTINUE. F176,86 5B,, LDAA #'[' ; YES. PRINT THE CURRENT LINE. F178,BD FE CD,, JSR OUTBYTE F17B,DC 29,, LDD CURLINE F17D,BD EB 1A,, JSR OUTDECI F180,86 5D,, LDAA #']' F182,BD FE CD,, JSR OUTBYTE F185,BD E1 10,, JSR NL F188,18 3C,CRUN6:, CRUN6: PSHY ; SAVE POINTER TO START OF NEW LINE. F18A,18 E6 02,, LDAB 2,Y ; GET LENGTH OF LINE. F18D,18 3A,, ABY ; POINT TO START OF NEXT LINE. F18F,18 DF 2B,, STY ADRNXLIN ; SAVE THE ADDRESS OF THE NEXT LINE. F192,18 38,, PULY F194,C6 03,, LDAB #3 ; BYTE COUNT OF LINE NUMBER & LENGTH. F196,18 3A,, ABY ; POINT TO THE FIRST TOKEN. F198,8D 30,CRUN4:, CRUN4: BSR RSKIPSPC ; SKIP SPACES IF PRESENT. F19A,18 E6 00,, LDAB 0,Y ; GET KEYWORD TOKEN. F19D,18 08,, INY ; POINT PAST THE KEYWORD. F19F,8D 29,, BSR RSKIPSPC ; SKIP SPACES AFTER KEYWORD. F1A1,5A,, DECB ; SUBTRACT ONE FOR INDEXING. F1A2,58,, LSLB ; MULTIPLY BY THE # OF BYTES PER ADDRESS. F1A3,CE F1 DA,, LDX #RKEYWORD ; POINT TO RUN TIME ADDRESS TABLE. F1A6,3A,, ABX ; POINT TO ADDRESS F1A7,EE 00,, LDX 0,X ; POINT TO RUNTIME ROUTINE. F1A9,AD 00,, JSR 0,X ; GO DO IT. ,,, * ,,, * F1AB,7A 00 1A,CRUN2:, CRUN2: DEC BREAKCNT ; SHOULD WE CHECK FOR A BREAK YET? F1AE,26 03,, BNE CRUN7 ; NO. CONTINUE. F1B0,BD F2 5F,, JSR CHCKBRK ; CHECK FOR BREAK FROM CONSOLE. ,,, * F1B3,8D 15,CRUN7:, CRUN7: BSR RSKIPSPC ; SKIP ANY SPACES. F1B5,18 A6 00,, LDAA 0,Y ; GET THE NEXT TOKEN IN THE LINE. F1B8,81 7D,, CMPA #EOLTOK ; ARE WE AT THE END OF THE LINE? F1BA,26 0A,, BNE CRUN3 F1BC,18 08,, INY ; YES. POINT TO START OF THE NEXT LINE. F1BE,18 9C 06,CRUN1:, CRUN1: CPY BASEND ; HAVE WE REACHED THE END OF THE BASIC PROGRAM? F1C1,26 A9,, BNE CRUN5 ; NO. GO EXECUTE THE NEXT LINE. F1C3,7E F4 C8,, JMP REND ; GO DO AN "END". F1C6,18 08,CRUN3:, CRUN3: INY ; MUST BE A MID EOL. F1C8,20 CE,, BRA CRUN4 ; GO DO NEXT KEYWORD. ,,, * ,,, * ,,, * F1CA,18 A6 00,RSKIPSPC:, RSKIPSPC: LDAA 0,Y ; GET A CHARACTER. F1CD,2B 0A,, BMI RSKIP2 F1CF,81 7E,, CMPA #SSCNTOK ; IS IT A SINGLE SPACE? F1D1,27 04,, BEQ RSKIP1 ; YES. BUMP IP BY 1. F1D3,25 04,, BLO RSKIP2 F1D5,18 08,, INY ; BUMP IP BY 2 FOR MULTIPLE SPACES. F1D7,18 08,RSKIP1:, RSKIP1: INY ; BUMP IP. F1D9,39,RSKIP2:, RSKIP2: RTS ; RETURN. ,,, * ,,, * ,,, RKEYWORD: EQU * F1DA,F3 EC,, FDB RLET F1DC,F3 EC,, FDB RLET F1DE,F6 14,, FDB RPRINT F1E0,F7 7D,, FDB RFOR F1E2,F7 D4,, FDB RNEXT F1E4,F5 FF,, FDB RTRON F1E6,F6 04,, FDB RTROFF F1E8,F5 B9,, FDB RPOKE F1EA,F7 0C,, FDB RDIM F1EC,F3 E6,, FDB RREM F1EE,FA 4C,, FDB RPACC F1F0,F3 E6,, FDB RDATA F1F2,F8 F4,, FDB RREAD F1F4,F9 17,, FDB RRESTOR F1F6,F4 79,, FDB RGOSUB F1F8,00 00,, FDB 0 F1FA,00 00,, FDB 0 F1FC,F4 36,, FDB RGOTO F1FE,F5 56,, FDB RON F200,F4 A5,, FDB RRETURN F202,F9 51,, FDB RIF F204,F8 14,, FDB RINPUT F206,F4 B8,, FDB RSTOP F208,F4 C8,, FDB REND F20A,F4 EC,, FDB RWHILE F20C,F5 31,, FDB RENDWH F20E,F9 7A,, FDB REEP F210,F5 D9,, FDB RPORTA F212,F5 F3,, FDB RPORTB F214,F5 F7,, FDB RPORTC F216,F5 FB,, FDB RPORTD F218,00 00,, FDB 0 F21A,00 00,, FDB 0 F21C,00 00,, FDB 0 F21E,FA 1D,, FDB RINBYTE F220,FA 2F,, FDB RTIME F222,FA 61,, FDB RONTIME F224,FA 78,, FDB RONIRQ F226,FA 96,, FDB RRETI F228,FA B8,, FDB RONPACC F22A,F6 08,, FDB RSLEEP F22C,FA 3A,, FDB RRTIME ,,, * ,,, * F22E,BD E1 0E,RUNLINE:, RUNLINE: JSR NL2 F231,18 DE 4B,, LDY TKNBUFS ; POINT TO THE TOKEN BUFFER. F234,18 EC 00,, LDD 0,Y ; GET CURRENT LINE NUMBER. F237,DD 29,, STD CURLINE ; MAKE "0" THE CURRENT LINE #. F239,C6 03,, LDAB #3 ; POINT PAST THE LINE NUMBER & LENGTH. F23B,18 3A,, ABY F23D,8D 8B,RUNLINE2:, RUNLINE2: BSR RSKIPSPC ; SKIP SPACES. F23F,18 E6 00,, LDAB 0,Y ; GET KEYWORD. F242,18 08,, INY ; POINT PAST KEYWORD. F244,8D 84,, BSR RSKIPSPC ; SKIP SPACES. F246,5A,, DECB ; SUBTRACT ONE FOR INDEXING. F247,58,, LSLB ; MULT BY THE # OF BYTES/ADDRESS. F248,CE F1 DA,, LDX #RKEYWORD ; POINT TO ADDRESS TABLE. F24B,3A,, ABX ; POINT TO ADDRESS OF RUN TIME ROUTINE. F24C,EE 00,, LDX 0,X ; GET ADDRESS. F24E,AD 00,, JSR 0,X ; GO DO IT. F250,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F253,18 A6 00,, LDAA 0,Y F256,81 7D,, CMPA #EOLTOK ; ARE WE AT THE END OF THE LINE? F258,26 01,, BNE RUNLINE1 F25A,39,, RTS F25B,18 08,RUNLINE1:, RUNLINE1: INY ; MUST BE A MID EOL. F25D,20 DE,, BRA RUNLINE2 ,,, * ,,, * ,,, CHCKBRK: EQU * F25F,86 0A,, LDAA #10 ; RELOAD THE BREAK CHECK COUNT. F261,97 1A,, STAA BREAKCNT F263,9D 9E,, JSR CONSTAT ; GET CONSOLE STATUS. CHARACTER TYPED? F265,26 01,, BNE CHCKBRK1 ; YES. GO CHECK IT OUT. F267,39,, RTS ; NO. RETURN. F268,9D A1,CHCKBRK1:, CHCKBRK1: JSR INCONNE ; GET BYTE FROM CONSOLE BUT DON'T ECHO. F26A,81 03,, CMPA #$03 ; WAS IT A CONTROL-C? F26C,27 01,, BEQ CHCKBRK2 ; YES. GO DO A BREAK. F26E,39,, RTS ; NO. RETURN. F26F,18 DF 31,CHCKBRK2:, CHCKBRK2: STY IPSAVE ; SAVE THE IP POINTER IN CASE OF A CONTINUE. F272,BD E1 10,, JSR NL F275,CE EB 09,, LDX #BREAKS ; POINT TO BREAK STRING. F278,BD E1 1C,, JSR PL F27B,DC 29,, LDD CURLINE F27D,BD EB 1A,, JSR OUTDECI F280,BD E1 10,, JSR NL F283,7E E0 16,, JMP MAINW ,,, * ,,, * ,,, * ,,, * ,,, RUNINIT: EQU * F286,BD F2 DB,, JSR CCLEAR ; GO CLEAR ALL VARIABLE STORAGE. F289,DE 53,RUNINIT1:, RUNINIT1: LDX STNUMS ; GET START OF NUMERIC OPERAND STACK. F28B,DF 1F,, STX NUMSTACK ; INITALIZE THE OPERAND STACK POINTER. F28D,DE 4F,, LDX STOPS ; GET THE START OF THE OPERATOR STACK. F28F,DF 21,, STX OPSTACK ; INITALIZE THE OPREATOR STACK POINTER. F291,DE 57,, LDX STFORSTK ; GET THE START OF THE FOR-NEXT STACK. F293,DF 23,, STX FORSTACK ; INITALIZE THE FOR NEXT STACK POINTER. F295,DE 5B,, LDX STWHSTK ; GET THE START OF THE WHILE STACK. F297,DF 25,, STX WHSTACK ; INITALIZE THE WHILE STACK POINTER. F299,DE 5F,, LDX STGOSTK ; GET THE START OF THE GOSUB STACK. F29B,DF 27,, STX GOSTACK ; SET THE START OF THE GOSUB STACK. F29D,DE 0A,, LDX VAREND ; GET THE VARIABLE END POINTER. F29F,08,, INX ; POINT TO THE NEXT AVAILABLE BYTE. F2A0,DF 2D,, STX STRASTG ; INITALIZE THE STRING/ARRAY STORAGE POINTER. F2A2,7F 00 1E,, CLR PRINTPOS ; SET THE CURRENT PRINT POSITION TO 0. F2A5,86 0A,, LDAA #10 ; SET COUNT FOR BREAK CHECK. F2A7,97 1A,, STAA BREAKCNT F2A9,7F 00 1C,, CLR CONTFLAG ; CLEAR THE CONTINUE FLAG. F2AC,CE 00 00,, LDX #0 ; CLEAR THE DATA POINTER. F2AF,DF 33,, STX DATAPTR F2B1,39,, RTS ,,, * ,,, * ,,, CCONT: EQU * F2B2,BD E1 0E,, JSR NL2 F2B5,7D 00 1C,, TST CONTFLAG F2B8,26 06,, BNE CCONT1 F2BA,18 DE 31,, LDY IPSAVE F2BD,7E F1 B3,, JMP CRUN7 F2C0,86 25,CCONT1:, CCONT1: LDAA #CNTCNERR F2C2,97 18,, STAA ERRCODE F2C4,7E EA D6,, JMP RPTERR5 ,,, * ,,, * ,,, CNEW: EQU * F2C7,FE FF C4,, ldx EEStart F2CA,A6 0A,, LDAA AUTOSTF,X ; GET THE AUTO START FLAG. F2CC,81 55,, CMPA #$55 ; IS IT SET? F2CE,26 07,, BNE CNEW1 ; NO. GO INITIALIZE EVERYTHING. F2D0,86 FF,, LDAA #$FF ; YES. RESET (ERASE) IT. F2D2,A7 0A,, STAA AUTOSTF,X F2D4,BD FA 14,, JSR DLY10MS F2D7,BD EC FA,CNEW1:, CNEW1: JSR INITVARS ; INITIALIZE EVERYTHING. F2DA,39,, RTS ; RETURN. ,,, * ,,, * ,,, CCLEAR: EQU * F2DB,BD F2 89,, JSR RUNINIT1 ; GO INITALIZE ALL STACKS ETC. F2DE,DE 08,CCLEAR3:, CCLEAR3: LDX VARBEGIN F2E0,A6 00,CCLEAR1:, CCLEAR1: LDAA 0,X F2E2,27 08,, BEQ CCLEAR2 F2E4,08,, INX F2E5,08,, INX F2E6,08,, INX F2E7,BD E6 52,, JSR CLRVAR F2EA,20 F4,, BRA CCLEAR1 F2EC,DE 0A,CCLEAR2:, CCLEAR2: LDX VAREND F2EE,08,, INX F2EF,DF 2D,, STX STRASTG F2F1,39,, RTS ,,, * ,,, * ,,, #Include 'COMMAND2.Asm' ,,, * name COMMAND2 ,,, * page ,,, * ,,, * ,,, CESAVE: EQU * F2F2,DC 04,, LDD BASBEG ; GET POINTER TO THE START OF THE BASIC PROGRAM. F2F4,1A 93 06,, CPD BASEND ; IS THERE A PROGRAM IN MEMORY? F2F7,26 01,, BNE CESAVE1 ; YES. GO SAVE IT. F2F9,39,, RTS ; NO. RETURN. F2FA,DC 0A,CESAVE1:, CESAVE1: LDD VAREND F2FC,93 04,, SUBD BASBEG F2FE,1A B3 FF C6,, CPD EESIZE F302,23 05,, BLS CESAVE5 F304,86 37,, LDAA #EETOSMAL F306,7E EA 98,, JMP RPTERR F309,FE FF C4,CESAVE5:, CESAVE5: LDX EEStart ; point to the start of the EEPROM. F30C,18 CE 00 04,, LDY #BASBEG F310,C6 04,, LDAB #4 F312,D7 1A,, STAB COUNT F314,18 EC 00,CESAVE3:, CESAVE3: LDD 0,Y F317,B3 FF C0,, SUBD RAMSTART F31A,A7 00,, STAA 0,X F31C,BD FA 14,, JSR DLY10MS F31F,08,, INX F320,17,, TBA F321,A7 00,, STAA 0,X F323,BD FA 14,, JSR DLY10MS F326,08,, INX F327,18 08,, INY F329,18 08,, INY F32B,7A 00 1A,, DEC COUNT F32E,26 E4,, BNE CESAVE3 ,,, * F330,18 EC 00,, LDD 0,Y F333,A7 00,, STAA 0,X F335,BD FA 14,, JSR DLY10MS F338,08,, INX F339,17,, TBA F33A,A7 00,, STAA 0,X F33C,BD FA 14,, JSR DLY10MS ,,, ,,, * F33F,FE FF C4,, LDX EEStart F342,18 DE 04,, LDY BASBEG F345,18 A6 00,CESAVE4:, CESAVE4: LDAA 0,Y F348,A7 0B,, STAA SSTART,X F34A,BD FA 14,, JSR DLY10MS F34D,08,, INX F34E,18 08,, INY F350,18 9C 0A,, CPY VAREND F353,23 F0,, BLS CESAVE4 F355,39,, RTS ;RETURN. ,,, * ,,, * ,,, CELOAD: EQU * F356,FE FF C4,, LDX EEStart ; point to the start of the program storage EEPROM. F359,18 CE 00 04,, LDY #BASBEG ; point to the start of the program pointer storage area. F35D,C6 04,, LDAB #4 ; number of words to move. F35F,D7 1A,, STAB COUNT ; save the count. F361,EC 00,CELOAD3:, CELOAD3: LDD 0,X ; get the offset that was saved. F363,F3 FF C0,, ADDD RAMSTART ; add the starting address of the RAM to it. F366,18 ED 00,, STD 0,Y ; save the resulting pointer F369,08,, INX ; point to the next offset. F36A,08,, INX F36B,18 08,, INY ; point to the next pointer in RAM F36D,18 08,, INY F36F,7A 00 1A,, DEC COUNT ; have we gotten all the pointers yet? F372,26 ED,, BNE CELOAD3 ; no. keep going. ,,, * F374,EC 00,, LDD 0,X ; yes. get the high line number. F376,18 ED 00,, STD 0,Y ; save it in RAM. ,,, ,,, * ,,, * now load the actual program from EEPROM ,,, * F379,FE FF C4,, LDX EEStart ; point to the start of the EEPROM F37C,18 DE 04,, LDY BASBEG ; point to the start of the BASIC program buffer. F37F,A6 0B,CELOAD4:, CELOAD4: LDAA SSTART,X ; get a byte of the program. F381,18 A7 00,, STAA 0,Y ; put it in the program buffer. F384,08,, INX ; point to the next program byte F385,18 08,, INY ; point to the next buffer location. F387,18 9C 0A,, CPY VAREND ; have we finished loading the program. F38A,23 F3,, BLS CELOAD4 ; no. keep loading. F38C,18 DF 2D,, STY STRASTG ; yes. initialize the array storage area. F38F,39,, RTS ; RETURN. ,,, ,,, * ,,, * ,,, CLLIST: EQU * F390,86 01,, LDAA #$01 ; USE DEVICE #1 FOR HARD COPY LISTING. F392,97 37,, STAA DEVNUM F394,BD EE C5,, JSR CLIST ; GO DO A STANDARD LIST COMMAND. F397,7F 00 37,, CLR DEVNUM F39A,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, CAUTOST: EQU * ; SET AUTO START MODE FOR BASIC PROGRAM. F39B,86 55,, LDAA #$55 ; GET FLAG. F39D,FE FF C4,CAUTOST1:, CAUTOST1: LDX EEStart F3A0,A7 0A,, STAA AUTOSTF,x ; PROGRAM IT INTO THE EEPROM F3A2,BD FA 14,, JSR DLY10MS ; WAIT WHILE IT PROGRAMS. F3A5,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, CNOAUTO: EQU * F3A6,86 FF,, LDAA #$FF F3A8,20 F3,, BRA CAUTOST1 ,,, * ,,, * ,,, * ,,, AUTOLOAD: EQU * F3AA,FE FF C4,, ldx EESTART F3AD,FC FF C4,, LDD EESTART F3B0,C3 00 0B,, ADDD #SSTART F3B3,DD 04,, STD BASBEG F3B5,FC FF C4,, LDD EESTART F3B8,E3 02,, ADDD SBASEND,x F3BA,C3 00 0B,, ADDD #SSTART F3BD,DD 06,, STD BASEND ,,, * F3BF,EC 06,, LDD SVAREND,x F3C1,A3 04,, SUBD SVARBEG,x F3C3,F3 FF C0,, ADDD RAMSTART F3C6,DD 0A,, STD VAREND F3C8,FC FF C0,, LDD RAMSTART F3CB,DD 08,, STD VARBEGIN F3CD,18 8F,, XGDY F3CF,FC FF C4,, LDD EESTART F3D2,E3 04,, ADDD SVARBEG,X F3D4,8F,, XGDX F3D5,20 A8,, BRA CELOAD4 ,,, * ,,, * ,,, CFREE: EQU * F3D7,BD E1 0E,, JSR NL2 F3DA,DC 10,, LDD VARMEND F3DC,93 2D,, SUBD STRASTG F3DE,BD EB 1A,, JSR OUTDECI F3E1,BD E1 10,, JSR NL F3E4,39,, RTS ,,, * ,,, * ,,, CDUMP: EQU * ,,, * JSR NL2 ; PRINT TWO BLANK LINES. ,,, * CLR DNAME+2 ; ZERO THE LAST BYTE OF THE VARIABLE NAME 'ARRAY' ,,, * LDX VARBEGIN ; POINT TO THE START OF THE VARIABLE TABLE. ,,, *CDUMP2 LDAA 0,X ; GET AN ENTRY. IS IT THE END OF THE TABLE? ,,, * BNE CDUMP3 ; YES. WE'RE DONE. F3E5,39,, RTS ,,, *CDUMP3 LDAA 1,X ; NO. GET THE FIRST CHARACTER OF THE NAME. ,,, * STAA DNAME ,,, * LDAA 2,X ,,, * STAA DNAME+1 ,,, * LDX #DNAME ,,, * JSR PL ,,, * LDAA 0,X ; GET THE VARIABLE TOKEN. ,,, * CMPA #IVARTOK ; IS IT AN INTEGER? ,,, * BEQ CDUMP9 ; YES. DUMP ITS VALUE. ,,, ; CMPA #IAVARTOK ; NO. IS IT AN INTEGER ARRAY? ,,, ; BNE CDUMP99 ; NO. ,,, * LDD 3,X ; YES. GET THE POINTER TO THE ARRAY STORAGE. HAS IT BEEN DIMENSIONED? ,,, * BNE CDUMP5 ; YES. GO PRINT ALL THE VALUES. ,,, * LDX #UNDIM ,,, * JSR PL ,,, *CDUMP6 LDAB #5 ,,, * ABX ,,, * BRA CDUMP2 ,,, *CDUMP5 PSHX ; SAVE THE POINTER TO THE VARIABLE TABLE. ,,, * XGDX ; POINT TO THE ARRAY STORAGE AREA. ,,, * LDD 0,X ; GET THE MAXIMUM SUBSCRIPT. ,,, * STD SUBMAX ,,, * CLRA ,,, * CLRB ,,, * STD SUBCNT ,,, *CDUMP77 LDAA #'(' ,,, * JSR OUTBYTE ,,, * LDD SUBCNT ,,, * JSR OUTDECI ,,, * LDX #CPEQ ,,, * JSR PL ,,, * INX ,,, * INX ,,, * LDD 0,X ,,, * JSR OUTDECI ,,, * JSR NL ,,, * LDD SUBCNT ,,, * ADDD #1 ,,, * CMPD SUBMAX ,,, * BHI CDUMP88 ,,, * STD SUBCNT ,,, * LDX #DNAME ,,, * JSR PL ,,, * BRA CDUMP77 ,,, *CDUMP88 PULX ,,, * BRA CDUMP6 ,,, *CDUMP9 LDAA #'=' ,,, * JSR OUTBYTE ,,, * LDD 3,X ,,, * JSR OUTDECI ,,, * JSR NL ,,, * BRA CDUMP6 ,,, * ,,, * ,,, *UNDIM FCB '=[?]',0 ,,, *CPEQ FCB ')=',0 ,,, #Include 'RUNTIME1.Asm' ,,, * title RUNTIME1 ,,, * page ,,, * ,,, * ,,, RREM: EQU * ; NON-EXECUTIBLE STATEMENT JUST SKIP IT. ,,, RDATA: EQU * F3E6,18 E6 00,, LDAB 0,Y ; GET LENGTH OF REMARK OR DATA LINE. F3E9,18 3A,, ABY ; POINT TO THE EOLTOK. F3EB,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, * ,,, RLET: EQU * F3EC,18 A6 00,, LDAA 0,Y ; GET VARIABLE FLAG. F3EF,8D 0E,, BSR RVARPTR ; GET POINTER TO ASIGNMENT VARIABLE. ,,, * PSHD SAVE POINTER TO VARIABLE. F3F1,37,, PSHB F3F2,36,, PSHA F3F3,18 08,, INY ; PUT IP PAST THE "=" TOKEN. F3F5,BD FB 12,, JSR DONEXP ; EVALUATE THE EXPRESSION. F3F8,BD FB B9,, JSR PULNUM ; GET VALUE INTO D. F3FB,38,, PULX ; POINT TO THE DICTIONARY ENTRY. F3FC,ED 00,, STD 0,X ; STORE VALUE. F3FE,39,, RTS ; BACK TO MAIN INTERPRET LOOP. ,,, * ,,, * F3FF,18 A6 00,RVARPTR:, RVARPTR: LDAA 0,Y ; GET VARIABLE FLAG. F402,85 02,, BITA #$02 ; IS IT A STRING VARIABLE? F404,26 1D,, BNE RVARPTR2 ; YES. GO GET POINTER FOR A STRING DESCRIPTOR. F406,85 10,, BITA #$10 ; IS IT A NUMERIC ARRAY VARIABLE? F408,26 0F,, BNE RVARPTR1 ; YES. GO CALCULATE THE SUBSCRIPT. F40A,18 EC 01,RVARPTR3:, RVARPTR3: LDD 1,Y ; GET THE OFFSET TO THE DICTIONARY ENTRY. F40D,D3 08,, ADDD VARBEGIN ; ADD IN THE START ADDRESS OF THE DCTIONARY. F40F,C3 00 03,, ADDD #3 ; MAKE POINTER POINT TO THE ACTUAL STORAGE LOCATION F412,37,, PSHB ; SAVE B. F413,C6 03,, LDAB #3 ; POINT TO THE FIRST ELEMENT PAST THE VARIABLE. F415,18 3A,, ABY F417,33,, PULB ; RESTORE B. F418,39,, RTS ,,, RVARPTR1: EQU * F419,BD FB 90,, JSR CALCSUB ; GO GET BASE ADDR & EVALUATE SUBSCRIPT EXPRESSION. F41C,3C,, PSHX ; PUSH BASE ADDRESS ONTO STACK. F41D,30,, TSX ; POINT TO IT. F41E,05,, LSLD ; MULT THE SUBSCRIPT BY THE # OF BYTES/ELEMENT. F41F,E3 00,RVARPTR4:, RVARPTR4: ADDD 0,X ; GET ADDRESS OF ELEMENT. F421,38,, PULX ; RESTORE X. F422,39,, RTS ; RETURN. ,,, RVARPTR2: EQU * F423,85 10,, BITA #$10 ; IS IT A STRING ARRAY? F425,27 E3,, BEQ RVARPTR3 ; NO. JUST GO GET POINTER TO DESCRIPTOR. F427,BD FB 90,, JSR CALCSUB ; GET BASE ADDR. & CALC SUBSCRIPT. F42A,3C,, PSHX ; SAVE THE BASE ADDRESS. ,,, * PSHD SAVE THE SUBSCRIPT VALUE. F42B,37,, PSHB F42C,36,, PSHA F42D,30,, TSX ; POINT TO THE VALUES. F42E,05,, LSLD ; MULT BY 2. F42F,E3 00,, ADDD 0,X ; MULT BY 3. F431,31,, INS ; GET RID OF SUBSCRIPT VALUE. F432,31,, INS F433,30,, TSX ; POINT TO BASE ADDRESS. F434,20 E9,, BRA RVARPTR4 ,,, * ,,, * ,,, * ,,, * ,,, RGOTO: EQU * F436,7D 00 19,, TST IMMID ; DID WE ENTER HERE FROM THE IMMIDIATE MODE? F439,27 04,, BEQ RGOTO7 ; NO. JUST GO DO A GOTO. F43B,DC 06,, LDD BASEND ; YES. SET ADRNXLIN TO END OF PROGRAM SO THE F43D,DD 2B,, STD ADRNXLIN ; SEARCH STARTS AT THE FIRST LINE. F43F,DE 2B,RGOTO7:, RGOTO7: LDX ADRNXLIN ; POINT TO THE START OF THE NEXT LINE. F441,9C 06,, CPX BASEND ; IS THIS THE LAST LINE OF THE PROGRAM? F443,26 04,, BNE RGOTO1 ; NO. SEARCH STARTING AT THE NEXT LINE. F445,DE 04,RGOTO3:, RGOTO3: LDX BASBEG ; YES. POINT TO THE START OF THE BASIC PROGRAM. F447,20 07,, BRA RGOTO2 F449,EC 00,RGOTO1:, RGOTO1: LDD 0,X ; GET THE NEXT LINE NUMBER IN THE PGM. F44B,CD A3 01,, CPD 1,Y ; IS IT > THE LINE NUMBER WE ARE TO "GOTO"? F44E,22 F5,, BHI RGOTO3 ; YES. START THE SEARCH AT THE BEGINING. F450,EC 00,RGOTO2:, RGOTO2: LDD 0,X ; GET THE NEXT LINE NUMBER INTO D. F452,CD A3 01,, CPD 1,Y ; IS THIS THE CORRECT LINE? F455,27 10,, BEQ RGOTO4 ; YES. "GOTO" THE NEW LINE. F457,25 05,, BLO RGOTO5 ; NO. IS IT LESS THAN THE "TARGET LINE"? F459,86 1B,RGOTO6:, RGOTO6: LDAA #LNFERR ; NO. THE LINE MUST NOT EXIST. F45B,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR & RETURN TO MAIN LOOP. F45E,E6 02,RGOTO5:, RGOTO5: LDAB 2,X ; GET THE LENGTH OF THIS LINE. F460,3A,, ABX ; POINT TO THE START OF THE NEXT LINE. F461,9C 06,, CPX BASEND ; DID WE HIT THE END OF THE PROGRAM? F463,27 F4,, BEQ RGOTO6 ; YES. THE LINE DOESN'T EXIST. F465,20 E9,, BRA RGOTO2 ; NO. GO SEE IF THIS IS THE CORRECT LINE. F467,8F,RGOTO4:, RGOTO4: XGDX ; MAKE IT THE NEW IP. F468,18 8F,, XGDY F46A,7D 00 19,, TST IMMID F46D,27 06,, BEQ RGOTO8 F46F,7F 00 19,, CLR IMMID F472,7E F1 BE,RGOTO9:, RGOTO9: JMP CRUN1 F475,31,RGOTO8:, RGOTO8: INS F476,31,, INS F477,20 F9,, BRA RGOTO9 ,,, * ,,, * ,,, RGOSUB: EQU * F479,18 3C,, PSHY ; SAVE THE I.P. TO THE LINE NUMBER. F47B,7D 00 19,, TST IMMID ; DID WE GET HERE FROM THE IMMIDIATE MODE? F47E,27 07,, BEQ RGOSUB3 ; NO. GO DO A NORMAL GOSUB. F480,18 DE 06,, LDY BASEND ; YES. MAKE RETURN POINT TO THE LAST EOL TOKEN F483,18 09,, DEY ; IN THE PROGRAM. F485,20 04,, BRA RGOSUB2 ; GO PUT IT ON THE ARGUMENT STACK. F487,C6 03,RGOSUB3:, RGOSUB3: LDAB #3 ; BYPASS THE LINE NUMBER. F489,18 3A,, ABY F48B,BD F1 CA,RGOSUB2:, RGOSUB2: JSR RSKIPSPC ; SKIP SPACES AFTER THE LINE NUMBER. F48E,DE 27,, LDX GOSTACK ; GET THE GOSUB STACK POINTER. F490,09,, DEX ; POINT TO THE NEXT ENTRY ON THE STACK. F491,09,, DEX F492,9C 5D,, CPX EGOSTK ; OUT OF STACK SPACE? F494,24 05,, BHS RGOSUB1 ; NO. GO PUSH THE "RETURN ADDRESS" ON THE STACK. F496,86 1C,, LDAA #GOSOVERR ; YES. GET THE ERRCODE. F498,7E EA EF,, JMP RPTRERR ; GO REPORT THE ERROR. F49B,DF 27,RGOSUB1:, RGOSUB1: STX GOSTACK ; SAVE THE "GOSUB" STACK POINTER. F49D,1A EF 00,, STY 0,X ; PUT THE RETURN ADDRESS ON THE STACK. F4A0,18 38,, PULY ; GET THE POINTER TO THE LINE NUMBER. F4A2,7E F4 36,, JMP RGOTO ; GO DO A "GOTO". ,,, * ,,, * ,,, RRETURN: EQU * F4A5,DE 27,, LDX GOSTACK ; GET THE GOSUB STACK POINTER. F4A7,9C 5F,, CPX STGOSTK ; IS THERE A RETURN ADDRESS ON THE GOSUB STACK? F4A9,26 05,, BNE RRETURN1 ; YES. GO RETURN. F4AB,86 1D,, LDAA #RWOGERR ; NO. RETURN W/O GOSUB ERROR. F4AD,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR. F4B0,1A EE 00,RRETURN1:, RRETURN1: LDY 0,X ; GET THE RETURN ADDRESS IN THE IP. F4B3,08,, INX ; REMOVE THE ADDRESS FROM THE STACK. F4B4,08,, INX F4B5,DF 27,, STX GOSTACK ; SAVE THE STACK POINTER. F4B7,39,, RTS ; BACK TO THE MAIN INTERPRET LOOP. ,,, * ,,, * ,,, RSTOP: EQU * F4B8,CE F4 D7,, LDX #STOPSTR F4BB,BD E1 1C,, JSR PL F4BE,DC 29,, LDD CURLINE F4C0,BD EB 1A,, JSR OUTDECI F4C3,18 DF 31,, STY IPSAVE F4C6,20 07,, BRA REND1 ,,, REND: EQU * F4C8,BD E1 10,, JSR NL F4CB,86 01,, LDAA #1 F4CD,97 1C,, STAA CONTFLAG F4CF,CC 00 00,REND1:, REND1: LDD #0 F4D2,DD 29,, STD CURLINE F4D4,7E E0 16,, JMP MAINW ,,, * ,,, * F4D7,0A,STOPSTR:, STOPSTR: FCB $0A,$0D F4D8,0D,, F4D9,53 54 4F 50 50 45,, FCC "STOPPED AT LINE # " ,,, FCC "STOPPED AT LINE # " ,,, FCC "STOPPED AT LINE # " F4EB,00,, FCB 0 ,,, * ,,, * ,,, RWHILE: EQU * F4EC,DE 25,, LDX WHSTACK ; GET THE WHILE STACK POINTER. F4EE,09,, DEX ; POINT TO THE NEXT STACK LOCATION. F4EF,09,, DEX F4F0,9C 59,, CPX EWHSTK ; ARE WE AT THE END OF THE STACK? F4F2,24 05,, BHS RWHILE4 ; NO. GO STACK IT. F4F4,86 1E,, LDAA #WHSOVERR ; YES. WHILE STACK OVER FLOW. F4F6,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR. F4F9,DF 25,RWHILE4:, RWHILE4: STX WHSTACK ; SAVE THE WHILE STACK POINTER. F4FB,1A EF 00,, STY 0,X ; PUT IT ON THE STACK. F4FE,C6 01,, LDAB #$01 ; GET THE WHILE COUNT INTO B. (FOR NESTED WHILE'S) F500,37,RWHILE3:, RWHILE3: PSHB F501,18 DE 2B,, LDY ADRNXLIN ; GET THE ADDRESS OF THE NEXT LINE. F504,26 01,, BNE RWHILE2 F506,39,, RTS F507,18 3C,RWHILE2:, RWHILE2: PSHY ; SAVE THE IP. F509,18 9C 06,, CPY BASEND ; ARE WE AT THE END OF THE PROGRAM? F50C,27 BA,, BEQ REND ; YES. DO AN END. F50E,DE 2B,, LDX ADRNXLIN ; NO. GET THE ADDRESS OF THE NEXT LINE IN X. F510,E6 02,, LDAB 2,X ; GET THE LENGTH OF THIS LINE. F512,3A,, ABX ; POINT TO THE START OF THE NEXT LINE. F513,DF 2B,, STX ADRNXLIN ; SAVE IT. F515,C6 03,, LDAB #3 ; POINT PAST THE LINE NUMBER & LINE LENGTH. F517,18 3A,, ABY F519,BD F1 CA,, JSR RSKIPSPC ; SKIP ANY SPACES. F51C,18 A6 00,, LDAA 0,Y ; GET THE KEYWORD TOKEN. F51F,18 38,, PULY ; RESTORE THE IP. F521,33,, PULB ; GET THE NESTED WHILE COUNT. F522,81 19,, CMPA #WHILETOK ; IS IT ANOTHER WHILE? F524,26 01,, BNE RWHILE1 ; NO. GO CHECK FOR ENDWH. F526,5C,, INCB ; YES. UP THE NESTED WHILE COUNT. F527,81 1A,RWHILE1:, RWHILE1: CMPA #ENDWHTOK ; IS IT THE END WHILE STATEMENT? F529,26 D5,, BNE RWHILE3 ; NO. GO LOOK AT THE NEXT LINE. F52B,5A,, DECB ; YES. IS IT THE CORRECT 'ENDWH'? F52C,26 D2,, BNE RWHILE3 ; NO. LOOK FOR ANOTHER ONE. F52E,7E F4 75,, JMP RGOTO8 ; BACK TO INTERPRET LOOP. ,,, * ,,, * ,,, * ,,, * ,,, RENDWH: EQU * F531,DE 25,, LDX WHSTACK ; GET THE WHILE STACK POINTER. F533,9C 5B,, CPX STWHSTK ; HAS A WHILE STATEMENT BEEN EXECUTED? F535,26 05,, BNE RENDWH1 ; YES. GO GET THE ADDRESS OF THE WHILE STATEMENT. F537,86 1F,, LDAA #ENDWHERR ; NO. GET ENDWHILE ERROR. F539,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR. F53C,18 3C,RENDWH1:, RENDWH1: PSHY ; SAVE THE IP IN CASE THE WHILE TEST FAILS. F53E,1A EE 00,, LDY 0,X ; GET THE IP POINTER TO THE WHILE EXPRESSION. F541,BD FB 12,, JSR DONEXP ; YES. GO EVALUATE A NUMERIC EXPRESSION. F544,BD FB B9,, JSR PULNUM ; GET RESULT OFF NUMERIC STACK. IS IT TRUE? F547,26 0A,, BNE RENDWH3 ; YES. GO EXECUTE CODE BETWEEN WHILE & ENDWH. F549,18 38,, PULY ; NO. GET THE ADDRESS OF THE NEXT LINE/STATEMENT. F54B,DE 25,, LDX WHSTACK ; GET WHILE STACK POINTER. F54D,08,, INX ; TAKE ADDRESS OFF OF WHILE STACK. F54E,08,, INX F54F,DF 25,, STX WHSTACK ; SAVE STACK POINTER. F551,20 02,, BRA RENDWH5 ; GO TO INTERPRET LOOP. F553,31,RENDWH3:, RENDWH3: INS ; REMOVE POINTER TO STATEMENT AFTER "ENDWH" F554,31,, INS ; FROM STACK. F555,39,RENDWH5:, RENDWH5: RTS ; GO EXECUTE LINES TILL "ENDWH". ,,, * ,,, * ,,, RON: EQU * F556,BD FB 12,, JSR DONEXP ; GO EVALUATE THE EXPRESSION. F559,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER EXPRESSION. F55C,18 A6 00,, LDAA 0,Y ; GET EITHER "GOTO" OR "GOSUB" TOKEN. F55F,36,, PSHA ; SAVE IT. F560,18 08,, INY ; POINT TO NEXT TOKEN. F562,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F565,DE 1F,, LDX NUMSTACK ; POINT TO THE OPERAND STACK. F567,EC 00,, LDD 0,X ; GET EXPRESSION VALUE. F569,2A 07,, BPL RON1 ; IS IT NEGATIVE? F56B,26 05,, BNE RON1 ; OR ZERO? F56D,86 20,RON5:, RON5: LDAA #ONARGERR ; YES. REPORT ERROR. F56F,7E EA EF,, JMP RPTRERR F572,EC 00,RON1:, RON1: LDD 0,X ; GET THE EXPRESSION VALUE. F574,83 00 01,, SUBD #1 ; SUBTRACT 1. HAVE WE FOUND THE LINE NUMBER? F577,27 17,, BEQ RON4 ; YES. GO DO "GOTO" OR "GOSUB". F579,ED 00,, STD 0,X ; NO. SAVE REMAINDER. F57B,C6 03,, LDAB #3 ; POINT PAST THE LINE NUMBER VALUE. F57D,18 3A,, ABY F57F,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES PAST THE LINE NUMBER. F582,18 A6 00,, LDAA 0,Y ; GET NEXT TOKEN. F585,81 7D,, CMPA #EOLTOK ; HAVE WE HIT THE END OF THE LINE? F587,27 E4,, BEQ RON5 ; YES. ERROR. F589,18 08,RON3:, RON3: INY ; NO. MUST BE A COMMA. BYPASS IT. F58B,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER THE COMMA. F58E,20 E2,, BRA RON1 ; GO SEE IF THE NEXT LINE NUMBER IS THE ONE. F590,BD FB B9,RON4:, RON4: JSR PULNUM ; GET RID OF ARGUMENT. F593,32,, PULA ; GET "GO" TOKEN. F594,81 12,, CMPA #GOTOTOK ; IS IT A "GOTO" TOKEN? F596,26 03,, BNE RON6 ; NO. MUST BE A "GOSUB" F598,7E F4 36,, JMP RGOTO ; GO DO A "GOTO". F59B,18 3C,RON6:, RON6: PSHY ; SAVE THE POINTER TO THE LINE NUMBER. F59D,C6 03,RON8:, RON8: LDAB #3 ; POINT PAST THE LINE NUMBER. F59F,18 3A,, ABY F5A1,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER LINE NUMBER. F5A4,18 A6 00,, LDAA 0,Y ; GET NEXT TERMINATOR CHARACTER. F5A7,81 7D,, CMPA #EOLTOK ; HIT THE END OF THE LINE YET? F5A9,27 0B,, BEQ RON7 ; YES. GO DO THE GOSUB. F5AB,81 7A,, CMPA #MEOLTOK ; NO. HIT THE LOGICAL END OF THE LINE YET? F5AD,27 07,, BEQ RON7 ; YES. GO DO THE GOSUB. F5AF,18 08,, INY ; NO. MUST BE A COMMA. F5B1,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER THE COMMA. F5B4,20 E7,, BRA RON8 ; GO FIND THE END OF THE LINE. F5B6,7E F4 8B,RON7:, RON7: JMP RGOSUB2 ; GO DO A "GOSUB". ,,, * ,,, * ,,, RPOKE: EQU * F5B9,18 08,, INY ; PASS UP THE OPEN PAREN. F5BB,BD F1 CA,, JSR RSKIPSPC ; PASS UP ANY SPACES. F5BE,BD FB 12,, JSR DONEXP ; GO EVALUATE THE ADDRESS EXPRESSION. F5C1,BD F1 CA,, JSR RSKIPSPC ; SKIP ANY SPACES. F5C4,18 08,, INY ; SKIP THE COMMA. F5C6,BD F1 CA,, JSR RSKIPSPC ; SKIP ANY SPACES. F5C9,BD FB 12,, JSR DONEXP ; GET THE VALUE TO PUT INTO MEMORY. F5CC,18 08,, INY ; PASS UP THE CLOSING PAREN. F5CE,BD FB B9,, JSR PULNUM ; GET THE MEMORY VALUE. F5D1,8F,, XGDX ; SAVE IT. F5D2,BD FB B9,, JSR PULNUM ; GET THE ADDRESS. F5D5,8F,, XGDX ; PUT ADDRESS INTO X & MEM VALUE INTO D. F5D6,E7 00,, STAB 0,X ; PUT VALUE INTO MEMORY. F5D8,39,, RTS ; BACK TO THE INTERPRET LOOP. ,,, * ,,, * F5D9,C6 00,RPORTA:, RPORTA: LDAB #PORTAIO F5DB,DE 61,RPORTA1:, RPORTA1: LDX IOBaseV ; GET ADDRESS OF PORTA I/O REGISTER. F5DD,3A,, ABX F5DE,3C,, PSHX ; SAVE POINTER TO VARIABLE. F5DF,18 08,, INY ; PUT IP PAST THE "=" TOKEN. F5E1,BD FB 12,, JSR DONEXP ; EVALUATE THE EXPRESSION. F5E4,BD FB B9,, JSR PULNUM ; GET VALUE INTO D. F5E7,4D,, TSTA ; IS THE VALUE <0 AND >255? F5E8,27 05,, BEQ RPORTA2 ; NO. GO PUT THE VALUE IN THE PORT. F5EA,86 2E,, LDAA #PRTASERR ; YES. ERROR. F5EC,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR. F5EF,38,RPORTA2:, RPORTA2: PULX ; POINT TO THE DICTIONARY ENTRY. F5F0,E7 00,, STAB 0,X ; STORE VALUE. F5F2,39,, RTS ; BACK TO MAIN INTERPRET LOOP. ,,, ,,, * ,,, * F5F3,C6 04,RPORTB:, RPORTB: LDAB #PORTBIO ; GET ADDRESS OF PORTB I/O REGISTER. F5F5,20 E4,, BRA RPORTA1 ; GO DO AN ASIGNMENT. ,,, * ,,, * F5F7,C6 03,RPORTC:, RPORTC: LDAB #PORTCIO ; GET ADDRESS OF PORTC I/O REGISTER. F5F9,20 E0,, BRA RPORTA1 ; GO DO AN ASIGNMENT. ,,, * ,,, * F5FB,C6 08,RPORTD:, RPORTD: LDAB #PORTDIO ; GET ADDRESS OF PORTD I/O REGISTER. F5FD,20 DC,, BRA RPORTA1 ; GO DO AN ASIGNMENT. ,,, * ,,, * ,,, #Include 'RUNTIME2.Asm' ,,, * title RUNTIME2 ,,, * page ,,, * ,,, * ,,, RTRON: EQU * F5FF,86 FF,, LDAA #$FF ; SET FLAG TO TURN TRACE MODE ON. F601,97 1B,, STAA TRFLAG ; PUT IT IN THE FLAG BYTE. F603,39,RTRON1:, RTRON1: RTS ; BACK TO THE INTERPRET LOOP. ,,, * ,,, * ,,, RTROFF: EQU * F604,7F 00 1B,, CLR TRFLAG ; TURN THE TRACE MODE OFF. F607,39,, RTS ; BACK TO THE INTERPRET LOOP. ,,, * ,,, * ,,, RSLEEP: EQU * F608,0F,, SEI ; DON'T ALLOW AN INTERRUPT TO BRING US OUT OF THE SLEEP MODE. F609,07,, TPA ; GET THE CONDITION CODE REGISTER. F60A,84 7F,, ANDA #$7F ; CLEAR THE STOP BIT F60C,06,, TAP ; TRANSFER THE RESULT BACK TO THE CCR. F60D,CF,, STOP ; HALT THE CPU. F60E,07,, TPA ; ON EXIT FROM THE STOP MODE, GET THE CCR. F60F,8A 80,, ORAA #$80 ; DISABLE THE STOP INSTRUCTION. F611,06,, TAP ; TRANSFER THE RESULT BACK TO THE CCR. F612,0E,, CLI ; ALLOW INTERRUPTS. F613,39,, RTS ; RETURN TO WHAT WE WERE DOING. ,,, * ,,, * ,,, RPRINT: EQU * F614,BD F8 52,, JSR CHCKDEV ; GO CHECK FOR ALTERNATE OUTPUT DEVICE. F617,18 A6 00,, LDAA 0,Y ; GET FIRST TOKEN. F61A,81 7D,, CMPA #EOLTOK ; IS IT AN EOL TOKEN? F61C,27 04,, BEQ RPRINT1 ; YES. JUST PRINT A CR/LF. F61E,81 7A,, CMPA #MEOLTOK ; IS IT A MID EOL TOKEN? F620,26 07,, BNE RPRINT2 ; NO. GO PRINT A STRING OR NUMBER. F622,BD E1 10,RPRINT1:, RPRINT1: JSR NL ; YES. JUST PRINT A CR/LF. F625,7F 00 37,, CLR DEVNUM ; GO BACK TO DEVICE #0. F628,39,, RTS ; BACK TO MAIN INTERPRET LOOP. F629,81 A2,RPRINT2:, RPRINT2: CMPA #SCONTOK ; IS IT A STRING CONSTANT? F62B,26 16,, BNE RPRINT3 ; NO. GO CHECK FOR A "PRINT FUNCTION". F62D,18 3C,, PSHY F62F,C6 02,, LDAB #2 ; COMPENSATE FOR CONSTANT & LENGTH BYTE. F631,18 EB 01,, ADDB 1,Y ; ADD IN LENGTH BYTE. F634,18 3A,, ABY ; POINT BEYOND PROMPT. F636,38,, PULX ; GET POINTER INTO X. F637,08,, INX ; POINT TO LENGTH BYTE. F638,E6 00,, LDAB 0,X ; GET IT. F63A,C0 02,, SUBB #2 ; SUBTRACT OUT THE DELIMETER COUNT. F63C,08,, INX ; POINT TO STRING. F63D,08,, INX F63E,BD F8 D0,, JSR OUTSTR ; GO PRINT THE STRING. F641,20 39,, BRA RPRINT4 ; GO DO NEXT EXPRESSION. F643,81 36,RPRINT3:, RPRINT3: CMPA #FUNCTFLG ; IS IT A FUNCTION? F645,26 1E,, BNE RPRINT10 ; NO. GO EVALUATE A NUMERIC EXPRESSION. F647,18 A6 01,, LDAA 1,Y ; GET THE FUNCTION TYPE. F64A,81 07,, CMPA #TABTOK ; IS IT A TAB? F64C,26 05,, BNE RPRINT11 ; NO GO CHECK FOR "CHR$". F64E,BD F6 B9,, JSR RTAB ; GO DO TAB. F651,20 29,, BRA RPRINT4 ; GO SEE IF THERE'S MORE TO PRINT. F653,81 02,RPRINT11:, RPRINT11: CMPA #CHRTOK ; IS IT THE CHR$ FUNCTION. F655,26 05,, BNE RPRINT12 ; NO. GO CHECK FOR HEX(). F657,BD F6 CE,, JSR RCHRS ; YES. GO DO CHR$. F65A,20 20,, BRA RPRINT4 ; GO SEE IF THERE'S MORE TO PRINT. F65C,81 0B,RPRINT12:, RPRINT12: CMPA #HEXTOK ; IS IT THE HEX() FUNCTION? F65E,26 05,, BNE RPRINT10 ; NO. GO DO A NUMERIC EXPRESSION. F660,BD F6 E2,, JSR RHEX ; YES. GO PRINT THE NUMBER AS HEX. F663,20 17,, BRA RPRINT4 ; GO SEE IF THERE'S MORE TO PRINT. F665,81 12,RPRINT10:, RPRINT10: CMPA #HEX2TOK ; IS IT THE HEX2() FUNCTION? F667,26 05,, BNE RPRINT14 ; NO. GO DO A NUMERIC EXPRESSION. F669,BD F6 DA,, JSR RHEX2 ; YES GO PRINT A NUMBER >=255 AS 2 HEX BYTES. F66C,20 0E,, BRA RPRINT4 ; GO SEE IF THERE'S MORE TO PRINT. F66E,BD FB 12,RPRINT14:, RPRINT14: JSR DONEXP ; GO DO A NUMERIC EXPRESSION. F671,BD FB B9,, JSR PULNUM ; GET THE NUMBER OFF THE NUMERIC STACK. F674,BD EB 1A,, JSR OUTDECI ; PRINT IT. F677,86 20,, LDAA #SPC ; PUT A TRAILING SPACE AFTER ALL NUMBERS. F679,BD FE CD,, JSR OUTBYTE ; PRINT IT. F67C,BD F1 CA,RPRINT4:, RPRINT4: JSR RSKIPSPC ; SKIP SPACES. F67F,18 A6 00,, LDAA 0,Y ; GET SEPERATOR CHARACTER. F682,81 7C,, CMPA #COMMATOK ; IS IT A COMMA? F684,27 08,, BEQ RPRINT5 ; NO. F686,81 7B,, CMPA #SEMITOK ; IS IT A SEMICOLIN? F688,26 28,, BNE RPRINT6 ; NO. MUST BE AN EOLTOK. F68A,18 08,, INY ; DO NOTHING BUT BUMP THE IP. F68C,20 13,, BRA RPRINT7 ; GO CHECK FOR EOL AFTER COMMA OR SEMICOLIN. F68E,18 08,RPRINT5:, RPRINT5: INY ; BUMP IP PAST THE COMMATOK. F690,D6 1E,, LDAB PRINTPOS ; YES. "TAB" TO NEXT PRINT FIELD. F692,C4 07,, ANDB #$07 ; MASK OFF ALL BUT THE FIELD WIDTH. F694,50,, NEGB ; MAKE IT NEGATIVE. F695,CB 08,, ADDB #8 ; ADD IN THE FIELD WIDTH. ARE WE ON A FIELD BOUND? F697,27 08,, BEQ RPRINT7 ; YES. GO CHECK FOR AN EOL. F699,86 20,, LDAA #SPC ; NO. GET A SPACE & PRINT TILL WE GET THERE. F69B,BD FE CD,RPRINT8:, RPRINT8: JSR OUTBYTE ; PRINT A SPACE. F69E,5A,, DECB ; DECREMENT THE COUNT. ARE WE DONE? F69F,26 FA,, BNE RPRINT8 ; NO. KEEP GOING. F6A1,BD F1 CA,RPRINT7:, RPRINT7: JSR RSKIPSPC ; SKIP ANY SPACES. F6A4,18 A6 00,, LDAA 0,Y ; GET THE NEXT TOKEN IN THE LINE. F6A7,81 7D,, CMPA #EOLTOK ; IS IT AN EOL TOKEN? F6A9,27 0A,, BEQ RPRINT9 ; YES. DONT DO A CR/LF AFTER A COMMA OR SEMI. F6AB,81 7A,, CMPA #MEOLTOK ; NO. IS IT A MID EOL? F6AD,27 06,, BEQ RPRINT9 ; SAME AS BEFORE. F6AF,7E F6 29,, JMP RPRINT2 ; IF NEITHER, GO PRINT THE NEXT EXPRESSION. F6B2,BD E1 10,RPRINT6:, RPRINT6: JSR NL ; DO A CR/LF IF EOL OR MIDEOL FOLLOWS EXPRESSION. F6B5,7F 00 37,RPRINT9:, RPRINT9: CLR DEVNUM ; GO BACK TO DEVICE #0. F6B8,39,, RTS ; GO DO NEXT LINE. ,,, * ,,, * ,,, RTAB: EQU * F6B9,8D 43,, BSR PFUNCOM ; GO GET ARG. & CHECK MAGNITUDE. IS ARG. OK? F6BB,27 05,, BEQ RTAB1 ; YES. GO DO TAB. F6BD,86 2A,, LDAA #TABARGER ; NO. ERROR. F6BF,7E EA EF,RTAB3:, RTAB3: JMP RPTRERR ; REPORT ERROR. F6C2,D1 1E,RTAB1:, RTAB1: CMPB PRINTPOS ; ARE WE ALREADY PAST THE "TAB" POSITION? F6C4,23 07,, BLS RTAB2 ; YES. DONE. F6C6,86 20,, LDAA #SPC ; GET A SPACE. F6C8,BD FE CD,, JSR OUTBYTE ; PRINT IT. F6CB,20 F5,, BRA RTAB1 F6CD,39,RTAB2:, RTAB2: RTS ; RETURN. ,,, * ,,, * ,,, RCHRS: EQU * F6CE,8D 2E,, BSR PFUNCOM ; GO GET ARG. & CHECK MAGNITUDE. IS ARG. OK? F6D0,27 04,, BEQ RCHRS1 ; YES. GO DO TAB. F6D2,86 2B,, LDAA #CHRARGER ; NO. ERROR. F6D4,20 E9,, BRA RTAB3 ; REPORT ERROR. F6D6,17,RCHRS1:, RCHRS1: TBA ; PUT BYTE INTO A F6D7,7E FE CD,, JMP OUTBYTE ; PRINT THE BYTE & RETURN. ,,, * ,,, * ,,, RHEX2: EQU * F6DA,8D 22,, BSR PFUNCOM ; GO GET ARG. & CHECK MAGNITUDE. IS ARG. OK? F6DC,27 08,, BEQ RHEX1 ; YES. GO PRINT 2 HEX CHARACTERS & RETURN. F6DE,86 32,, LDAA #HEX2AERR ; NO. ARG. MUST BE >=0 & <=255. F6E0,20 DD,, BRA RTAB3 ; GO REPORT ERROR. ,,, * ,,, * ,,, RHEX: EQU * F6E2,8D 1A,, BSR PFUNCOM ; GO DO COMMON CODE FOR PRINT FUNCTIONS F6E4,8D 01,, BSR PRNT2HEX ; GO PRINT 2 HEX CHARACTERS. F6E6,17,RHEX1:, RHEX1: TBA ; PUT LOWER BYTE IN A. ,,, * ; FALL THRU TO PRINT 2 HEX CHARACTERS & RETURN. ,,, * ,,, * ,,, PRNT2HEX: EQU * F6E7,36,, PSHA ; SAVE THE CHARACTER. F6E8,8D 03,, BSR PRNTHXL ; PRINT THE LEFT HEX NYBBLE. F6EA,32,, PULA ; GET BYTE BACK. F6EB,20 04,, BRA PRNTHXR ; PRINT RIGHT NYBBLE & RETURN. ,,, * ,,, * F6ED,44,PRNTHXL:, PRNTHXL: LSRA ; GET UPPER NYBBLE INTO LOWER ONE. F6EE,44,, LSRA F6EF,44,, LSRA F6F0,44,, LSRA F6F1,84 0F,PRNTHXR:, PRNTHXR: ANDA #$0F ; MASK OFF UPPER NYBBLE. F6F3,8B 30,, ADDA #$30 ; MAKE IT A HEX NUMBER. F6F5,81 39,, CMPA #$39 ; IS IT? F6F7,23 02,, BLS PRNTHXR1 ; YES. PRINT IT. F6F9,8B 07,, ADDA #$07 ; NO. MAKE IT A HEX LETTER. F6FB,7E FE CD,PRNTHXR1:, PRNTHXR1: JMP OUTBYTE ; PRINT IT & RETURN. ,,, * ,,, * ,,, PFUNCOM: EQU * F6FE,C6 03,, LDAB #3 ; POINT PAST FUNCTION FLAG, FUNCTION TOKEN, & F700,18 3A,, ABY ; OPEN PAREN. F702,BD FB 12,, JSR DONEXP ; GO GET POSITION TO TAB TO. F705,18 08,, INY ; BUMP IP PAST CLOSING PAREN. F707,BD FB B9,, JSR PULNUM ; GET OPERAND OFF STACK. F70A,4D,, TSTA ; CHECK THAT OPERAND IS >0 & <=255 FOR FUNCTIONS ,,, * ; THAT REQUIRE IT. F70B,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, RDIM: EQU * F70C,18 A6 00,, LDAA 0,Y ; GET VARIABLE FLAG/TYPE. F70F,85 10,, BITA #$10 ; IS IT A SUBSCRIPTED VARIABLE? F711,26 05,, BNE RDIM1 ; YES. GO DIMENSION IT. F713,86 21,, LDAA #NOSUBERR ; NO. GET ERROR. F715,7E EA EF,RDIM3:, RDIM3: JMP RPTRERR ; GO REPORT THE ERROR. F718,18 EC 01,RDIM1:, RDIM1: LDD 1,Y ; GET THE OFFSET INTO THE DICTIONARY. F71B,D3 08,, ADDD VARBEGIN ; ADD IN THE START OF THE DICTIONARY. F71D,8F,, XGDX ; PUT THE ADDRESS INTO X. F71E,EC 03,, LDD 3,X ; GET THE POINTER TO THE STORAGE. BEEN DIMENSIONED? F720,27 04,, BEQ RDIM2 ; NO. GO DIMENSION IT. F722,86 22,, LDAA #REDIMERR ; YES. ERROR. F724,20 EF,, BRA RDIM3 F726,3C,RDIM2:, RDIM2: PSHX ; SAVE THE POINTER TO THE DICTIONARY. F727,C6 04,, LDAB #4 ; POINT TO 1ST TOKEN IN EXPRESSION. F729,18 3A,, ABY F72B,BD FB 12,, JSR DONEXP ; EVALUATE THE SUBSCRIPT. F72E,18 08,, INY ; PASS UP THE CLOSING PAREN. F730,38,, PULX ; RESTORE POINTER TO DICTIONARY. F731,DC 2D,, LDD STRASTG ; GET THE DYNAMIC MEMORY POOL POINTER. F733,ED 03,, STD 3,X ; PUT THE POINTER IN THE DICTIONARY ENTRY. F735,C3 00 02,, ADDD #2 ; UP THE POINTER. F738,DD 2D,, STD STRASTG ; SAVE NEW POINTER FOR NOW. F73A,BD FB B9,, JSR PULNUM ; GET SUBSCRIPT OFF OF NUMERIC STACK. F73D,2A 04,, BPL RDIM8 ; ONLY POSITIVE SUBSCRIPTS ALLOWED. F73F,86 27,, LDAA #NEGSUBER ; NEGATIVE NUMBER. F741,20 18,, BRA RDIM9 ; REPORT ERROR. F743,3C,RDIM8:, RDIM8: PSHX F744,EE 03,, LDX 3,X ; GET POINTER TO STORAGE. F746,ED 00,, STD 0,X ; PUT MAX SUBSCRIPT IN POOL STORAGE. F748,C3 00 01,, ADDD #1 ; COMPENSATE FOR "0" SUBSCRIPT. F74B,38,, PULX ; RESTORE POINTER TO DICTIONARY ENTRY. F74C,05,, LSLD ; MULT. BY 2 (2 BYTES/INTEGER). F74D,D3 2D,, ADDD STRASTG ; ADD IN CURRENT POINTER TO POOL. F74F,1A 93 2D,, CPD STRASTG ; WAS THE SUBSCRIPT SO BIG WE WRAPPED AROUND? F752,23 05,, BLS RDIM4 ; YES. ERROR. F754,1A 93 10,, CPD VARMEND ; DO WE HAVE ENOUGH MEMORY? F757,23 05,, BLS RDIM5 ; YES. F759,86 09,RDIM4:, RDIM4: LDAA #OMEMERR ; NO. ERROR. F75B,7E EA EF,RDIM9:, RDIM9: JMP RPTRERR ; GO REPORT THE ERROR. F75E,DD 2D,RDIM5:, RDIM5: STD STRASTG ; SAVE POINTER. F760,EE 03,, LDX 3,X ; POINT TO START OF STORAGE. F762,08,, INX F763,08,, INX ; POINT PAST THE SUBSCRIPT LIMIT. F764,6F 00,RDIM6:, RDIM6: CLR 0,X ; CLEAR THE STORAGE. F766,08,, INX ; POINT TO THE NEXT LOCATION. F767,9C 2D,, CPX STRASTG ; ARE WE DONE? F769,26 F9,, BNE RDIM6 ; NO. KEEP GOING. F76B,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F76E,18 A6 00,, LDAA 0,Y ; GET THE NEXT CHARACTER. F771,81 7D,, CMPA #EOLTOK ; ARE WE AT THE END OF THE LINE. F773,27 07,, BEQ RDIM7 ; YES. F775,18 08,, INY ; BUMP IP PAST THE COMMA. F777,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F77A,20 90,, BRA RDIM ; DO DIMENSION THE NEXT VARIABLE. F77C,39,RDIM7:, RDIM7: RTS ; BACK TO MAIN INTERPRET LOOP. ,,, * ,,, * ,,, * ,,, #Include 'RUNTIME3.Asm' ,,, * title RUNTIME3.TXT ,,, * page ,,, * ,,, * ,,, RFOR: EQU * F77D,DC 23,, LDD FORSTACK ; GET FOR STACK POINTER. F77F,83 00 0A,, SUBD #10 ; ALLOCATE NEW FOR-NEXT DESCRIPTOR BLOCK. F782,1A 93 55,, CPD EFORSTK ; HAVE WE RUN OUT OF FOR-NEXT STACK SPACE? F785,24 05,, BHS RFOR1 ; NO. CONTINUE. F787,86 23,, LDAA #FORNXERR ; YES. ERROR. F789,7E EA EF,, JMP RPTRERR ; REPORT ERROR. F78C,DD 23,RFOR1:, RFOR1: STD FORSTACK ; SAVE NEW STACK POINTER. F78E,18 3C,, PSHY ; SAVE IP ON STACK. F790,BD F3 FF,, JSR RVARPTR ; GET POINTER TO ASIGNMENT VARIABLE. F793,18 38,, PULY ; RESTORE IP. F795,DE 23,, LDX FORSTACK ; GET FOR STACK POINTER. F797,ED 00,, STD 0,X ; PUT POINTER TO CONTROL VARIABLE IN STACK. F799,DC 29,, LDD CURLINE ; GET CURRENT LINE NUMBER. F79B,ED 08,, STD 8,X ; SAVE CURRENT LINE NUMBER IN STACK. F79D,BD F3 EC,, JSR RLET ; GO DO ASIGNMENT PART OF FOR. F7A0,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F7A3,18 08,, INY ; SKIP PAST "TO" TOKEN. F7A5,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F7A8,BD FB 12,, JSR DONEXP ; CALCULATE THE TERMINATING LOOP VALUE. F7AB,BD FB B9,, JSR PULNUM ; GET NUMBER OFF OF THE STACK. F7AE,DE 23,, LDX FORSTACK ; GET STACK POINTER. F7B0,ED 04,, STD 4,X ; PUT VALUE IN STACK BLOCK. F7B2,CC 00 01,, LDD #1 ; ASSUME A "STEP" VALUE OF 1. F7B5,ED 02,RFOR3:, RFOR3: STD 2,X ; PUT IT IN THE STACK. F7B7,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F7BA,18 A6 00,, LDAA 0,Y ; GET NEXT TOKEN. F7BD,81 3A,, CMPA #STEPTOK ; IS THE STEP CLAUSE PRESENT? F7BF,27 04,, BEQ RFOR2 ; YES. GO GET THE "STEP" VALUE. F7C1,1A EF 06,, STY 6,X ; PUT TERMINATING CHARACTER OF "FOR" STATEMENT ON. F7C4,39,, RTS ; EXECUTE NEXT STATEMENT. F7C5,18 08,RFOR2:, RFOR2: INY ; SKIP PAST THE "STEP" TOKEN. F7C7,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F7CA,BD FB 12,, JSR DONEXP ; GO CALCULATE THE "STEP" VALUE. F7CD,BD FB B9,, JSR PULNUM ; GET VALUE OFF OPERAND STACK. F7D0,DE 23,, LDX FORSTACK ; GET POINTER TO FOR STACK. F7D2,20 E1,, BRA RFOR3 ; GO PUT VALUE IN STACK. ,,, * ,,, * ,,, RNEXT: EQU * F7D4,BD F3 FF,, JSR RVARPTR ; GET POINTER TO LOOP INDEX VARIABLE. F7D7,DE 23,, LDX FORSTACK ; GET "FOR" STACK POINTER. F7D9,1A A3 00,, CPD 0,X ; IS THE LOOP VARIABLE THE SAME? F7DC,27 05,, BEQ RNEXT1 ; YES. CONTINUE. F7DE,86 24,, LDAA #MFRNXERR ; NO. ERROR. F7E0,7E EA EF,, JMP RPTRERR ; GO REPORT IT. F7E3,18 3C,RNEXT1:, RNEXT1: PSHY ; SAVE IP. F7E5,1A EE 00,, LDY 0,X ; GET POINTER TO CONTROL VARIABLE. F7E8,18 EC 00,, LDD 0,Y ; GET CONTROL VARIABLE VALUE. F7EB,E3 02,, ADDD 2,X ; ADD THE STEP VALUE TO IT. F7ED,18 ED 00,, STD 0,Y ; SAVE THE RESULT. F7F0,6D 02,, TST 2,X ; IS THE STEP VALUE NEGATIVE? F7F2,2B 11,, BMI RNEXT2 ; YES. GO DO TEST. F7F4,1A A3 04,, CPD 4,X ; NO. ARE WE DONE? F7F7,2F 11,, BLE RNEXT3 ; NO. GO DO THE LOOP AGAIN. F7F9,18 38,RNEXT4:, RNEXT4: PULY ; RESTORE THE CURRENT IP. F7FB,8F,, XGDX ; PUT "FOR - NEXT" STACK POINTER IN D. F7FC,C3 00 0A,, ADDD #10 ; REMOVE DESCRIPTOR FROM STACK. F7FF,DD 23,, STD FORSTACK ; SAVE NEW STACK VALUE. F801,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER CONTROL VARIABLE. F804,39,, RTS ; DO THE STATEMENT AFTER THE NEXT. F805,1A A3 04,RNEXT2:, RNEXT2: CPD 4,X ; ARE WE DONE? F808,2D EF,, BLT RNEXT4 ; YES. CONTINUE. F80A,18 38,RNEXT3:, RNEXT3: PULY ; CLEAN Y OFF OF STACK. F80C,1A EE 06,, LDY 6,X ; GET NEW IP. F80F,EC 08,, LDD 8,X ; GET LINE NUMBER OF FOR STATEMENT. F811,DD 29,, STD CURLINE ; MAKE IT THE CURRENT LINE. F813,39,, RTS ,,, * ,,, * ,,, * ,,, * ,,, RINPUT: EQU * F814,8D 3C,, BSR CHCKDEV ; CHECK FOR ALTERNATE INPUT DEVICE. F816,18 A6 00,, LDAA 0,Y ; GET A TOKEN. F819,81 A2,, CMPA #SCONTOK ; IS THERE A PROMPT TO PRINT? F81B,26 1B,, BNE RINPUT1 ; NO JUST GO GET THE DATA. F81D,18 3C,, PSHY ; YES. SAVE POINTER. F81F,C6 02,, LDAB #2 ; COMPENSATE FOR CONSTANT & LENGTH BYTE. F821,18 EB 01,, ADDB 1,Y ; ADD IN LENGTH BYTE. F824,18 3A,, ABY ; POINT BEYOND PROMPT. F826,38,, PULX ; GET POINTER INTO X. F827,08,, INX ; POINT TO LENGTH BYTE. F828,E6 00,, LDAB 0,X ; GET IT. F82A,C0 02,, SUBB #2 ; SUBTRACT OUT THE DELIMETER COUNT. F82C,08,, INX ; POINT TO STRING. F82D,08,, INX F82E,BD F8 D0,, JSR OUTSTR ; GO PRINT THE STRING. F831,18 08,, INY ; BYPASS COMMA. F833,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER COMMA. F836,20 03,, BRA RINPUT6 F838,BD E1 10,RINPUT1:, RINPUT1: JSR NL ,,, RINPUT6: EQU * F83B,CE F8 4F,, LDX #QSP ; POINT TO PROMPT. F83E,BD E1 1C,, JSR PL ; PRINT IT. F841,BD E0 BB,, JSR GETLINE ; GET THE DATA IN THE INPUT BUFFER. F844,8D 3B,, BSR RINRDC F846,25 F0,, BCS RINPUT1 F848,BD E1 10,, JSR NL F84B,7F 00 37,, CLR DEVNUM ; SET DEVICE NUMBER BACK TO 0. F84E,39,, RTS ,,, * ,,, * F84F,3F 20,QSP:, QSP: FCC "? " F851,00,, FCB 0 ,,, * ,,, * F852,18 A6 00,CHCKDEV:, CHCKDEV: LDAA 0,Y ; GET A TOKEN. F855,81 78,, CMPA #PNUMTOK ; IS AN ALTERNATE DEVICE SPECIFYED? F857,27 01,, BEQ CHCKDEV1 ; YES. CONTINUE. F859,39,, RTS ; NO. RETURN. F85A,18 08,CHCKDEV1:, CHCKDEV1: INY ; YES. PASS THE '#' TOKEN. F85C,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F85F,BD FB 12,, JSR DONEXP ; GO EVALUATE THE NUMERIC EXPRESSION. F862,BD FB B9,, JSR PULNUM ; GET THE NUMBER OFF THE STACK. F865,2A 05,, BPL CHCKDEV2 ; NEGATIVE NUMBERS NOT ALLOWED. F867,86 30,CHCKDEV3:, CHCKDEV3: LDAA #ILLIOERR ; REPORT THE ERROR. F869,7E EA EF,, JMP RPTRERR F86C,1A 83 00 07,CHCKDEV2:, CHCKDEV2: CPD #$0007 ; IS IT LARGER THAN 7? F870,22 F5,, BHI CHCKDEV3 F872,D7 37,, STAB DEVNUM ; MAKE IT THE NEW DEVICE NUMBER. F874,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F877,81 7D,, CMPA #EOLTOK ; IF THIS IS A PRINT STATEMENT, IS IT EOL? F879,27 05,, BEQ CHCKDEV4 ; YES. DON'T BUMP THE IP. F87B,18 08,, INY ; BYPASS THE COMMA. F87D,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F880,39,CHCKDEV4:, CHCKDEV4: RTS ; RETURN. ,,, * ,,, * ,,, * F881,BD E0 5B,RINRDC:, RINRDC: JSR SKIPSPCS F884,81 0D,, CMPA #EOL F886,26 02,, BNE RINRDC1 F888,0D,, SEC F889,39,, RTS F88A,8D 17,RINRDC1:, RINRDC1: BSR INNUMD F88C,BD F1 CA,, JSR RSKIPSPC F88F,18 A6 00,, LDAA 0,Y F892,81 7D,, CMPA #EOLTOK F894,27 0B,, BEQ RINRDC2 F896,81 7A,, CMPA #MEOLTOK F898,27 07,, BEQ RINRDC2 F89A,18 08,, INY ; BUMP PAST THE COMMA. F89C,BD F1 CA,, JSR RSKIPSPC F89F,20 E0,, BRA RINRDC F8A1,0C,RINRDC2:, RINRDC2: CLC F8A2,39,, RTS ,,, * ,,, * ,,, INNUMD: EQU * F8A3,81 24,, CMPA #'$' F8A5,26 08,, BNE INNUM2 F8A7,BD E3 CC,, JSR INCIBP F8AA,BD E6 CF,, JSR GETHEX F8AD,20 03,, BRA INNUM3 F8AF,BD F8 DD,INNUM2:, INNUM2: JSR INDECI ,,, INNUM3: EQU * ,,, * PSHD F8B2,37,, PSHB F8B3,36,, PSHA F8B4,BD E0 5B,, JSR SKIPSPCS F8B7,81 2C,, CMPA #COMMA F8B9,27 09,, BEQ INNUM4 F8BB,81 0D,, CMPA #EOL F8BD,27 08,, BEQ INNUM7 F8BF,86 15,, LDAA #MCOMAERR F8C1,7E EA EF,, JMP RPTRERR F8C4,BD E3 CC,INNUM4:, INNUM4: JSR INCIBP F8C7,BD F3 FF,INNUM7:, INNUM7: JSR RVARPTR F8CA,8F,, XGDX F8CB,32,, PULA F8CC,33,, PULB F8CD,ED 00,, STD 0,X F8CF,39,, RTS ,,, * ,,, OUTSTR EQU * F8D0,5D,, TSTB F8D1,27 09,, BEQ OUTSTR2 F8D3,A6 00,OUTSTR1, OUTSTR1 LDAA 0,X F8D5,08,, INX F8D6,BD FE CD,, JSR OUTBYTE F8D9,5A,, DECB F8DA,26 F7,, BNE OUTSTR1 F8DC,39,OUTSTR2, OUTSTR2 RTS ,,, * ,,, * ,,, INDECI: EQU * F8DD,BD E3 C3,, JSR GETCHR ; GET A CHARACTER. F8E0,81 2D,, CMPA #'-' ; IS IT A NEGATIVE NUMBER? F8E2,26 0C,, BNE INDECI1 ; NO. GO GET POSITIVE NUMBER. F8E4,BD E3 CC,, JSR INCIBP ; YES. BUMP INPUT BUFFER PAST IT. F8E7,BD E6 A1,, JSR GETDECI ; GET THE NUMBER. F8EA,43,, COMA ; NEGATE IT. F8EB,53,, COMB F8EC,C3 00 01,, ADDD #1 F8EF,39,, RTS ; RETURN. F8F0,BD E6 A1,INDECI1:, INDECI1: JSR GETDECI F8F3,39,, RTS ,,, * ,,, * ,,, RREAD: EQU * F8F4,DE 33,, LDX DATAPTR ; GET POINTER TO DATA. IS IT POINTING TO DATA? F8F6,26 04,, BNE RREAD1 ; YES. CONTINUE TO READ DATA. F8F8,8D 1D,, BSR RRESTOR ; NO. GO GET POINTER TO FIRST DATA STATEMENT. F8FA,DE 33,, LDX DATAPTR ; GET POINTER TO DATA. F8FC,DF 00,RREAD1:, RREAD1: STX IBUFPTR ; PUT IT IN THE INPUT BUFFER POINTER. F8FE,BD F8 81,, JSR RINRDC ; GO USE INPUT/READ COMMON CODE. F901,25 05,, BCS RREAD2 ; IF CARRY SET, MORE DATA TO READ. F903,DE 00,, LDX IBUFPTR ; GET POINTER TO DATA LINE. F905,DF 33,, STX DATAPTR ; SAVE DATA POINTER FOR NEXT READ. F907,39,, RTS ; RETURN. F908,18 3C,RREAD2:, RREAD2: PSHY ; SAVE Y. F90A,18 DE 00,, LDY IBUFPTR F90D,18 08,, INY F90F,18 08,, INY F911,8D 3A,, BSR RESTOR4 ; GO FIND NEXT "DATA" STATEMENT. F913,18 38,, PULY ; RESTORE Y. F915,20 DD,, BRA RREAD ; KEEP READING DATA. ,,, * ,,, * ,,, RRESTOR: EQU * F917,18 3C,, PSHY ; SAVE Y. F919,18 DE 04,, LDY BASBEG ; START SEARCH FOR "DATA" STATEMENTS AT THE BEGIN. F91C,18 3C,RESTOR2:, RESTOR2: PSHY ; SAVE POINTER TO THIS LINE. F91E,18 E6 02,, LDAB 2,Y ; GET LINE LENGTH. F921,18 3A,, ABY ; GET START OF NEXT LINE. F923,18 DF 33,, STY DATAPTR ; SAVE IN "DATAPTR". F926,18 38,, PULY ; RESTORE POINTER. F928,C6 03,, LDAB #3 F92A,18 3A,, ABY ; POINT TO FIRST TOKEN IN LINE. F92C,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F92F,18 A6 00,, LDAA 0,Y ; GET THE KEYWORD. F932,81 0C,, CMPA #DATATOK ; IS IT A DATA LINE? F934,27 0D,, BEQ RESTOR1 ; YES. GO SET UP POINTER. F936,18 DE 33,, LDY DATAPTR ; GET ADDRESS OF NEXT LINE. F939,18 9C 06,RESTOR3:, RESTOR3: CPY BASEND ; ARE WE AT THE END OF THE PROGRAM? F93C,26 DE,, BNE RESTOR2 ; NO. KEEP LOOKING. F93E,86 26,, LDAA #ODRDERR ; OUT OF DATA ERROR. F940,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR. F943,18 08,RESTOR1:, RESTOR1: INY ; POINT PAST DATA TOKEN & THE DATA LENGTH. F945,18 08,, INY F947,18 DF 33,, STY DATAPTR ; SAVE POINTER TO DATA. F94A,18 38,, PULY ; RESTORE Y. F94C,39,, RTS ; RETURN. ,,, * ,,, * F94D,18 3C,RESTOR4:, RESTOR4: PSHY ; CALL TO COMPENSATE FOR PULL OF Y ON RETURN. F94F,20 E8,, BRA RESTOR3 ,,, * ,,, * ,,, RIF: EQU * F951,BD FB 12,, JSR DONEXP ; GO DO A NUMERIC EXPRESSION. F954,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F957,18 08,, INY ; SKIP PAST "THEN" TOKEN. F959,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER THEN. F95C,BD FB B9,, JSR PULNUM ; GET RESULT OF EXPRESSION FROM OPERAND STACK. F95F,27 03,, BEQ RIF1 ; NOT TRUE. SEE IF ELSE CLAUSE PRESENT. F961,7E F4 36,RIF3:, RIF3: JMP RGOTO ; RESULT WAS TRUE. GOTO PROPER LINE NUMBER. F964,C6 03,RIF1:, RIF1: LDAB #3 ; BUMP IP PAST LINE NUMBER. F966,18 3A,, ABY F968,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES IF PRESENT. F96B,18 A6 00,, LDAA 0,Y ; GET NEXT TOKEN. F96E,81 39,, CMPA #ELSETOK ; IS IT THE "ELSE" CLAUSE. F970,26 07,, BNE RIF2 ; NO RETURN. F972,18 08,, INY ; PASS ELSE TOKEN. F974,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. F977,20 E8,, BRA RIF3 ; DO A GOTO. F979,39,RIF2:, RIF2: RTS ; RETURN. ,,, * ,,, * ,,, REEP: EQU * ; PROGRAM A WORD OF EEPROM. F97A,18 08,, INY ; PASS UP THE OPEN PAREN. F97C,BD F1 CA,, JSR RSKIPSPC ; PASS UP ANY SPACES. F97F,BD FB 12,, JSR DONEXP ; GO GET THE "SUBSCRIPT" OF THE EEPROM LOCATION. F982,18 08,, INY ; PASS UP THE CLOSING PAREN. F984,18 08,, INY ; PASS UP THE EQUALS TOKEN. F986,BD FB 12,, JSR DONEXP ; GET VALUE TO FROGRAM INTO EEPROM. F989,18 3C,, PSHY ; SAVE THE Y REG. F98B,18 DE 1F,, LDY NUMSTACK ; POINT TO THE NUMERIC STACK. F98E,18 EC 02,, LDD 2,Y ; GET THE SUBSCRIPT FOR THE EEPROM LOCATION. F991,2B 06,, BMI REEP1 ; NEGATIVE SUBSCRIPTS NOT ALLOWED. F993,1A 83 00 FF,, CPD #MAXEESUB ; IS THE SUBSCRIPT WITHIN RANGE? F997,23 05,, BLS REEP2 ; YES. CONTINUE. F999,86 28,REEP1:, REEP1: LDAA #EESUBERR ; EEPROM SUBSCRIPT ERROR. F99B,7E EA EF,, JMP RPTRERR ; REPORT IT. F99E,05,REEP2:, REEP2: LSLD ; MULT THE SUBSCRIPT BY 2. F99F,C3 B6 00,, ADDD #EEPBASAD ; ADD IN THE EEPROM BASE ADDRESS. F9A2,8F,, XGDX ; PUT THE ADDRESS INTO X. F9A3,A6 00,, LDAA 0,X ; GET THE MOST SIGNIFIGANT BYTE OF THE CURRENT NUM. F9A5,81 FF,, CMPA #$FF ; DOES IT NEED ERASING? F9A7,27 02,, BEQ REEP3 ; NO. SEE IF NEXT BYTE NEEDS ERASING. F9A9,8D 1D,, BSR ERASEBYT ; YES. GO ERASE IT. F9AB,08,REEP3:, REEP3: INX ; POINT TO NEXT BYTE. F9AC,A6 00,, LDAA 0,X ; GET NEXT BYTE. F9AE,81 FF,, CMPA #$FF ; DOES THIS BYTE NEED TO BE ERASED? F9B0,27 02,, BEQ REEP4 ; NO. GO WRITE DATA TO EEPROM. F9B2,8D 14,, BSR ERASEBYT ; YES. GO ERASE THE BYTE. F9B4,18 A6 01,REEP4:, REEP4: LDAA 1,Y ; GET LS BYTE OF WORD. F9B7,8D 32,, BSR PROGBYTE ; GO PROGRAM THE BYTE. F9B9,09,, DEX ; POINT TO THE MOST SIGNIFIGANT EEPROM LOCATION. F9BA,18 A6 00,, LDAA 0,Y ; GET THE MS BYTE OF THE WORD. F9BD,8D 2C,, BSR PROGBYTE ; GO PROGRAM THE BYTE. F9BF,18 38,, PULY ; RESTORE Y. F9C1,BD FB B9,, JSR PULNUM ; FIX UP NUM STACK. F9C4,BD FB B9,, JSR PULNUM F9C7,39,, RTS ; RETURN. ,,, * ,,, * ,,, ERASEBYT: EQU * F9C8,18 3C,, PSHY F9CA,18 DE 61,, LDY IOBaseV ; Point to the base address of the I/O Registers. F9CD,C6 16,, LDAB #$16 ; SET UP BYTE ERASE MODE, ADDR LATCH, ERASE F9CF,18 E7 3B,, STAB PPROG,Y ; VOLTAGE OFF. F9D2,A7 00,, STAA 0,X ; LATCH ADDRESS. F9D4,07,, TPA ; GET CURRENT I-BIT STATUS. F9D5,36,, PSHA ; SAVE IT. F9D6,0F,, SEI ; INHIBIT INTERRUPTS WHILE ERASING. F9D7,C6 17,, LDAB #$17 ; TURN ON ERASE VOLTAGE F9D9,18 E7 3B,, STAB PPROG,Y F9DC,8D 36,, BSR DLY10MS ; DELAY ABOUT 10 MS. F9DE,C6 16,, LDAB #$16 ; TURN PROGRAMING VOLTAGE OFF. F9E0,18 E7 3B,, STAB PPROG,Y F9E3,32,, PULA ; GET ORIGINAL I-BIT STATUS. F9E4,06,, TAP ; RESTORE IT. F9E5,18 6F 3B,, CLR PPROG,Y F9E8,18 38,, PULY F9EA,39,, RTS ; RETURN. ,,, * ,,, * ,,, PROGBYTE: EQU * F9EB,18 3C,, PSHY F9ED,18 DE 61,, LDY IOBaseV ; Point to the base address of the I/O Registers. F9F0,C6 02,PROGBYT2:, PROGBYT2: LDAB #$02 ; SET UP NORMAL PROGRAMING MODE, ADDRESS/DATA F9F2,18 E7 3B,, STAB PPROG,Y ; LATCHED, PROGRAMING VOLTAGE OFF. F9F5,A7 00,, STAA 0,X ; LATCH DATA & ADDRESS. F9F7,36,, PSHA ; SAVE THE DATA FOR COMPARE AFTER PROGRAMING. F9F8,07,, TPA ; GET CURRENT I-BIT STATUS. F9F9,36,, PSHA ; SAVE IT. F9FA,0F,, SEI ; INHIBIT INTERRUPTS WHILE PROGRAMING. F9FB,C6 03,, LDAB #$03 ; TURN ON PROGRAMING VOLTAGE. F9FD,18 E7 3B,, STAB PPROG,Y FA00,8D 12,, BSR DLY10MS ; LEAVE IT ON FOR 10 MS. FA02,C6 02,, LDAB #$02 ; NOW, TURN THE PROGRAMMING VOLTAGE OFF. FA04,18 E7 3B,, STAB PPROG,Y FA07,32,, PULA ; GET ORIGINAL I-BIT STATUS. FA08,06,, TAP ; RESTORE IT. FA09,18 6F 3B,, CLR PPROG,Y ; PUT THE EEPROM BACK IN THE READ MODE. FA0C,32,, PULA ; RESTORE THE DATA TO SEE IF IT WAS PROGRAMMED. FA0D,A1 00,, CMPA 0,X ; WAS THE DATA WRITTEN PROPERLY? FA0F,26 DF,, BNE PROGBYT2 ; NO. TRY AGAIN. FA11,18 38,, PULY ; Restore Y. FA13,39,, RTS ; YES. RETURN. ,,, * ,,, * ,,, DLY10MS: EQU * FA14,3C,, PSHX ; SAVE X. FA15,CE 0D 02,, LDX #3330 ; GET DELAY CONSTANT. FA18,09,DLY10MS1:, DLY10MS1: DEX ; DECREMENT THE COUNT. DONE? FA19,26 FD,, BNE DLY10MS1 ; NO. DELAY SOME MORE. FA1B,38,, PULX ; RESTORE X. FA1C,39,, RTS ; RETURN. ,,, * ,,, * ,,, RINBYTE: EQU * FA1D,BD F8 52,, JSR CHCKDEV ; GO CHECK FOR AN ALTERNATE DEVICE DESIGNATION. FA20,BD F3 FF,, JSR RVARPTR ; GO GET POINTER TO THE BYTE INPUT VARIABLE. FA23,8F,, XGDX ; PUT THE POINTER INTO X. FA24,BD FE EA,, JSR INBYTE ; GO GET A BYTE FROM THE SPECIFIED INPUT DEVICE. FA27,16,, TAB ; PUT THE BYTE IN THE L.S.BYTE. FA28,4F,, CLRA ; ZERO THE UPPER BYTE. FA29,ED 00,, STD 0,X ; PUT IT IN THE VARIABLE. FA2B,7F 00 37,, CLR DEVNUM ; RESET TO DEVICE #0. FA2E,39,, RTS ; RETURN. ,,, * ,,, * ,,, RTIME: EQU * FA2F,18 08,, INY ; POINT PAST THE EQUALS TOKEN. FA31,BD FB 12,, JSR DONEXP ; GO EVALUATE THE EXPRESSION. FA34,BD FB B9,, JSR PULNUM ; GET THE NUMBER OFF THE STACK. FA37,DD 38,, STD TIMEREG ; PUT IT IN THE TIME REGISTER. FA39,39,, RTS ; RETURN. ,,, * ,,, * ,,, RRTIME: equ * FA3A,0F,, sei ; disable interrupts. FA3B,86 03,, LDAA #SWPRE+1 ; ADD 1 TO NORMAL PRE SCALER. FA3D,97 3C,, STAA TIMEPRE ; SET UP THE SOFTWARE PRESCALER. FA3F,DE 61,, LDX IOBaseV ; Point to the I/O Base Address. FA41,EC 0E,, ldd TCNT,x ; get the current value of the timer counter. FA43,BD EE 00,, jsr TIMINTS3 ; go initialize the TOC using the timer interrupt code. FA46,4F,, clra FA47,5F,, clrb FA48,DD 38,, STD TIMEREG ; PUT IT IN THE TIME REGISTER. FA4A,0E,, cli FA4B,39,, RTS ; RETURN. ,,, * ,,, * ,,, RPACC: EQU * FA4C,18 08,, INY ; POINT PAST EQUALS TOKEN. FA4E,BD FB 12,, JSR DONEXP ; EVALUATE THE EXPRESSION. FA51,BD FB B9,, JSR PULNUM ; GET THE NUMBER OFF THE STACK. FA54,4D,, TSTA ; IS THE NUMBER WITHIN RANGE? FA55,27 05,, BEQ RPACC1 ; YES. GO SETUP THE PACC REGISTER. FA57,86 35,, LDAA #PACCARGE ; NO. REPORT AN ERROR. FA59,7E EA EF,, JMP RPTRERR FA5C,DE 61,RPACC1:, RPACC1: LDX IOBaseV FA5E,E7 27,, STAB PACNT,X ; PUT NUMBER IN PULSE ACC. FA60,39,, RTS ; RETURN. ,,, * ,,, * ,,, RONTIME: EQU * FA61,8D 4A,, BSR CHCKIMID ; NOT ALLOWED IN IMMIDIATE. FA63,BD FB 12,, JSR DONEXP ; GO EVALUATE THE TIME "MATCH" EXPRESSION. FA66,BD FB B9,, JSR PULNUM ; GET THE NUMBER OFF THE STACK. FA69,DD 3A,, STD TIMECMP ; PUT IN THE COMPARE REGISTER. FA6B,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. FA6E,18 08,, INY ; PASS UP COMMA. FA70,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. FA73,18 DF 3D,, STY ONTIMLIN ; SAVE THE POINTER TO THE LINE NUMBER. FA76,20 19,, BRA RONIRQ2 ; GO FINISH UP. ,,, * ,,, * ,,, RONIRQ: EQU * FA78,8D 33,, BSR CHCKIMID FA7A,BD FB 12,, JSR DONEXP ; GO CHECK TO SEE IF WE ARE TO ENABLE OR DISABLE. FA7D,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES UP TO COMMA. FA80,18 08,, INY ; BYPASS COMMA. FA82,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES UP TO LINE NUMBER. FA85,BD FB B9,, JSR PULNUM ; GET MODE. SHOULD WE ENABLE THE FUNCTION? FA88,26 04,, BNE RONIRQ1 ; YES. FA8A,DD 3F,, STD ONIRQLIN ; NO. MAKE THE LINE NUMBER 0. FA8C,20 03,, BRA RONIRQ2 ; GO FINISH UP. FA8E,18 DF 3F,RONIRQ1:, RONIRQ1: STY ONIRQLIN ; SAVE THE POINTER TO THE LINE NUMBER, FA91,C6 03,RONIRQ2:, RONIRQ2: LDAB #3 ; MOVE IP PAST THE LINE NUMBER. FA93,18 3A,, ABY FA95,39,, RTS ; RETURN. ,,, * ,,, * ,,, RRETI: EQU * FA96,8D 15,, BSR CHCKIMID FA98,07,, TPA ; CHECK TO SEE IF THE INTERRUPT MASK IS SET. FA99,85 10,, BITA #$10 ; ARE WE IN AN INTERRUPT ROUTINE? FA9B,26 05,, BNE RRETI1 ; SINCE THE IRQ MASK IS SET WE MUST BE. FA9D,86 34,, LDAA #NOTINTER ; NO. FLAG AN ERROR. FA9F,7E EA EF,, JMP RPTRERR ; GO REPORT IT. FAA2,DC 45,RRETI1:, RRETI1: LDD SCURLINE ; RESTORE THE MAIN PROGRAM CURRENT LINE. FAA4,DD 29,, STD CURLINE FAA6,DC 47,, LDD SADRNXLN ; RESTORE MAIN PROGRAM "ADDRESS OF THE NEXT LINE". FAA8,DD 2B,, STD ADRNXLIN FAAA,31,, INS ; TAKE THE RETURN ADDRESS OFF THE STACK. FAAB,31,, INS FAAC,3B,, RTI ; GO BACK TO WHERE WE LEFT OFF. ,,, * ,,, * ,,, CHCKIMID: EQU * FAAD,7D 00 19,, TST IMMID ; ARE WE IN THE IMMIDIATE MODE? FAB0,27 05,, BEQ CHCKIMI1 ; NO. JUST RETURN. FAB2,86 33,, LDAA #NOTALERR ; YES. THIS COMMAND NOT ALLOWED. FAB4,7E EA EF,, JMP RPTRERR ; REPORT THE ERROR. FAB7,39,CHCKIMI1:, CHCKIMI1: RTS ; RETURN. ,,, * ,,, * ,,, RONPACC: EQU * FAB8,8D F3,, BSR CHCKIMID ; THIS INSTRUCTION NOT ALLOWED IN IMMID MODE. FABA,BD FB 12,, JSR DONEXP ; GO EVALUATE THE COUNT MODE EXPRESSION. FABD,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. FAC0,18 08,, INY ; BYPASS THE COMMA. FAC2,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER COMMA. FAC5,BD FB 12,, JSR DONEXP ; GO EVALUATE THE INTERRUPT MODE EXPRESSION. FAC8,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. FACB,18 08,, INY ; BYPASS THE COMMA. FACD,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER THE COMMA. FAD0,07,, TPA ; GET CURRENT I-BIT STATUS. FAD1,36,, PSHA ; SAVE IT. FAD2,0F,, SEI ; INHIBIT INTERRUPTS. FAD3,18 DF 41,, STY ONPACLIN ; SAVE POINTER TO INTERRUPT ROUTINE. FAD6,BD FB B9,, JSR PULNUM ; GET INTERRUPT MODE OFF STACK. FAD9,1A 83 00 01,RONPACC1:, RONPACC1: CPD #1 ; IS THE ARGUMENT <=1? FADD,23 05,, BLS RONPACC2 ; YES. ARG. OK. FADF,86 36,RONPACC5:, RONPACC5: LDAA #INTMODER ; NO. GET ERROR CODE. FAE1,7E EA EF,, JMP RPTRERR FAE4,86 10,RONPACC2:, RONPACC2: LDAA #$10 ; GET BIT TO ENABLE INTERRUPT. FAE6,5D,, TSTB ; WAS THE ARGUMENT 0? FAE7,27 01,, BEQ RONPACC3 ; YES. GO ENABLE INTS. ON EACH COUNT. FAE9,48,, LSLA ; NO. ENABLE INTS. ON PACC OVERFLOW ONLY. FAEA,DE 61,RONPACC3:, RONPACC3: LDX IOBaseV FAEC,A7 24,, STAA TMSK2,X FAEE,BD FB B9,, JSR PULNUM ; GET THE COUNT MODE OFF THE STACK. FAF1,26 08,, BNE RONPACC4 ; GO SET THE MODE IF NOT 0. FAF3,DE 61,, LDX IOBaseV FAF5,6F 26,, CLR PACTL,X ; TURN OFF THE PULSE ACCUMULATOR. FAF7,DD 41,, STD ONPACLIN ; CLEAR POINTER TO LINE NUMBER. FAF9,20 10,, BRA RONPACC6 ; GO CLEAN UP & RETURN. FAFB,1A 83 00 04,RONPACC4:, RONPACC4: CPD #4 ; IS THE ARGUMENT IN RANGE? FAFF,22 DE,, BHI RONPACC5 ; YES. REPORT AN ERROR. FB01,CB 03,, ADDB #3 ; GET BIT TO ENABLE PACC. FB03,58,, LSLB FB04,58,, LSLB FB05,58,, LSLB FB06,58,, LSLB FB07,DE 61,, LDX IOBaseV FB09,E7 26,, STAB PACTL,X ; ENABLE THE PACC & SET MODE. FB0B,32,RONPACC6:, RONPACC6: PULA ; GET OLD I-BIT STATUS OFF STACK. FB0C,06,, TAP ; RESTORE OLD STATUS. FB0D,C6 03,, LDAB #3 FB0F,18 3A,, ABY ; PASS UP LINE NUMBER. FB11,39,, RTS ; RETURN. ,,, * ,,, * ,,, #Include 'REXPRES.Asm' ,,, * title REXPRES.TXT ,,, * page ,,, ****************************************************************************** ,,, * * ,,, * RUNTIME EXPRESSION EVALUATION SUBROUTINE * ,,, * * ,,, ****************************************************************************** ,,, * ,,, * FB12,86 10,DONEXP:, DONEXP: LDAA #OPARNTOK ; USE AN OPEN PAREN AS AN END OF EXPRESSION MARKER. FB14,BD FC 1B,, JSR PSHOP ; PUSH OPEN PAREN ON THE STACK. FB17,18 A6 00,DONEXP1:, DONEXP1: LDAA 0,Y ; GET THE NEXT CHARACTER IN THE EXPRESSION. FB1A,81 10,, CMPA #OPARNTOK ; IS IT AN OPEN PAREN? FB1C,26 08,, BNE DONEXP4 ; NO. CONTINUE. FB1E,18 08,, INY ; POINT TO NEXT TOKEN. FB20,8D F0,, BSR DONEXP ; GO DO A SUBEXPRESSION. FB22,18 08,, INY ; MOVE THE IP PAST THE CLOSING PAREN. FB24,20 F1,, BRA DONEXP1 ; GO GET THE NEXT CHARACTER. FB26,4D,DONEXP4:, DONEXP4: TSTA ; CHECK FOR OPERATOR OR OPERAND. FB27,2A 04,, BPL DONEXP2 ; IF NOT VARIABLE OR CONSTANT, GO CHECK FOR FUNCT. FB29,8D 12,, BSR PSHNUM ; GO PUSH OPERAND ONTO STACK. FB2B,20 EA,, BRA DONEXP1 ; GO GET NEXT TOKEN. FB2D,BD FB C8,DONEXP2:, DONEXP2: JSR CHKNFUN ; GO CHECK FOR FUNCTION THAT RETURNS A NUMBER. FB30,BD FC 0B,, JSR CHCKEE ; GO CHECK FOR END OF EXPRESSION. FB33,24 01,, BCC DONEXP3 ; IF NOT END OF EXPRESSION, GO PUSH OPERATOR. FB35,39,, RTS ; IF AT END, RETURN. FB36,18 08,DONEXP3:, DONEXP3: INY ; POINT TO THE NEXT TOKEN. FB38,BD FC 1B,, JSR PSHOP ; PUSH OPERATOR ONTO STACK. FB3B,20 DA,, BRA DONEXP1 ; GO GET NEXT TOKEN. ,,, * ,,, * ,,, * ,,, * PSHNUM SUBROUTINE ,,, * ,,, * PUSHES A NUMERIC OPERAND (CONSTANT OR VARIABLE) VALUE ONTO THE ,,, * OPERAND STACK. ,,, * ,,, * FB3D,81 84,PSHNUM:, PSHNUM: CMPA #IVARTOK ; IS IT AN INTEGER SCALER VARIABLE? FB3F,26 0E,, BNE PSHNUM1 ; NO. GO CHECK FOR CONSTANT. FB41,18 EC 01,, LDD 1,Y ; YES. GET THE "OFFSET" ADDRESS. FB44,D3 08,, ADDD VARBEGIN ; ADD IN THE START ADDRESS OF THE VARIABLE TABLE. FB46,8F,, XGDX ; GET THE ADDRESS INTO X. FB47,C6 03,, LDAB #$03 ; BUMP INTERPRETER POINTER PAST "VARIABLE". FB49,18 3A,, ABY FB4B,EC 03,, LDD 3,X ; GET THE VARIABLE VALUE. FB4D,20 2D,, BRA PSHNUM4 ; GO PUT IT ON THE STACK. FB4F,81 A4,PSHNUM1:, PSHNUM1: CMPA #ICONTOK ; IS IT AN INTEGER CONSTANT? FB51,26 0D,, BNE PSHNUM2 ; NO. GO CHECK FOR AN INTEGER ARRAY VARIABLE. FB53,CD EE 01,, LDX 1,Y ; GET THE CONSTANT VALUE INTO X. FB56,C6 04,, LDAB #$04 FB58,18 EB 03,, ADDB 3,Y FB5B,18 3A,, ABY FB5D,8F,, XGDX ; PUT THE CONSTANT VALUE INTO D. FB5E,20 1C,, BRA PSHNUM4 ; GO PUT IT ON THE STACK. FB60,81 94,PSHNUM2:, PSHNUM2: CMPA #IAVARTOK ; IS IT AN INTEGER ARRAY? FB62,26 13,, BNE PSHNUM3 ; NO. GO CHECK FOR A STRING VARIABLE. FB64,8D 2A,, BSR CALCSUB ; GO GET BASE ADDR. & SUBSCRIPT OF ARRAY. FB66,18 3C,, PSHY ; SAVE THE INTERPRETER POINTER. FB68,3C,, PSHX ; PUT THE BASE ADDRESS OF THE ARRAY ON THE STACK. FB69,05,, ASLD ; MULTIPLY THE SUBSCRIPT BY THE # OF BYTES/ELEMENT. FB6A,18 30,, TSY ; POINT TO THE BASE ADDRESS. FB6C,18 E3 00,, ADDD 0,Y ; GET ADDRESS OF THE ELEMENT. FB6F,38,, PULX ; RESTORE X. FB70,18 38,, PULY ; RESTORE Y FB72,8F,, XGDX ; PUT ELEMENT ADDRESS INTO X. FB73,EC 00,, LDD 0,X ; GET VALUE OF ELEMENT IN D. FB75,20 05,, BRA PSHNUM4 FB77,86 08,PSHNUM3:, PSHNUM3: LDAA #ILTOKERR FB79,7E EA EF,, JMP RPTRERR FB7C,DE 1F,PSHNUM4:, PSHNUM4: LDX NUMSTACK ; GET THE OPERAND STACK POINTER. FB7E,09,, DEX ; MAKE ROOM ON THE STACK FOR NEW OPERAND. FB7F,09,, DEX FB80,9C 51,, CPX ENUMSTK ; HAS THE STACK OVERFLOWED? FB82,24 07,, BHS PSHNUM5 ; NO. GO STACK THE VALUE. FB84,86 17,, LDAA #MSTKOERR ; YES. FB86,97 18,, STAA ERRCODE FB88,7E EA EF,, JMP RPTRERR ; GO REPORT THE ERROR. FB8B,DF 1F,PSHNUM5:, PSHNUM5: STX NUMSTACK ; SAVE THE STACK POINTER. FB8D,ED 00,, STD 0,X ; PUT THE VALUE ON THE STACK. FB8F,39,, RTS ; RETURN. ,,, * ,,, * ,,, * THIS SUBROUTINE CALCULATES BOTH THE BASE ADDRESS AND THE ,,, * SUBSCRIPT OF THE ARRAY VARIABLE THAT IS CURRENTLY POINTED TO BY ,,, * THE Y-REG. IT CHECKS TO SEE IF THE VARIABLE HAS BEEN DIMENTIONED ,,, * AND IF THE SUBSCRIPT IS IN RANGE. THE ROUTINE RETURNS WITH THE ,,, * ADDRESS OF THE ARRAY IN THE X-REG. & THE SUBSCRIPT IN THE D-REG. ,,, * FB90,18 EC 01,CALCSUB:, CALCSUB: LDD 1,Y ; GET THE VARIABLE OFFSET ADDRESS. FB93,D3 08,, ADDD VARBEGIN ; ADD IN THE START OF THE VARIABLE AREA. FB95,8F,, XGDX ; PUT ADDRESS INTO X. FB96,EE 03,, LDX 3,X ; GET THE ACTUAL STORAGE ADDRESS. ,,, * ; HAS THE ARRAY BEEN DIMENTIONED? FB98,26 05,, BNE CALCSUB2 ; YES. CONTINUE. FB9A,86 18,, LDAA #UNDIMERR ; NO. UNDIMENTIONED ARRAY REFERENCE. FB9C,7E EA EF,CALCSUB1:, CALCSUB1: JMP RPTRERR ; GO REPORT THE ERROR. FB9F,C6 04,CALCSUB2:, CALCSUB2: LDAB #$4 ; SET POINTER TO START OF SUBSCRIPT EXPRESSION. FBA1,18 3A,, ABY FBA3,3C,, PSHX ; SAVE THE POINTER TO THE ARRAY STORAGE AREA. FBA4,BD FB 12,, JSR DONEXP ; GO GET THE SUBSCRIPT. FBA7,18 08,, INY ; BUMP IP PAST THE CLOSING PAREN OF THE SUBSCRIPT. FBA9,38,, PULX ; RESTORE X. FBAA,BD FB B9,, JSR PULNUM ; GET SUBSCRIPT FROM THE OPERAND STACK. FBAD,1A A3 00,, CPD 0,X ; IS THE SUBSCRIPT WITHIN RANGE? FBB0,23 04,, BLS CALCSUB3 ; YES. CONTINUE. FBB2,86 19,, LDAA #SUBORERR ; NO. SUBSCRIPT OUT OF RANGE ERROR. FBB4,20 E6,, BRA CALCSUB1 ; GO REPORT IT. FBB6,08,CALCSUB3:, CALCSUB3: INX ; BYPASS THE SUBSCRIPT LIMIT. FBB7,08,, INX FBB8,39,, RTS ,,, * ,,, * FBB9,3C,PULNUM:, PULNUM: PSHX ; SAVE THE X-REG. FBBA,DE 1F,, LDX NUMSTACK ; GET THE OPERAND STACK POINTER. FBBC,EC 00,, LDD 0,X ; GET THE OPERAND. FBBE,08,, INX ; BUMP THE STACK POINTER. FBBF,08,, INX FBC0,DF 1F,, STX NUMSTACK ; SAVE THE STACK POINTER. FBC2,38,, PULX ; RESTORE THE X-REG. FBC3,1A 83 00 00,, CPD #0 ; "TEST" THE OPERAND BEFORE WE RETURN. FBC7,39,, RTS ; RETURN. ,,, * ,,, * ,,, * /***** chcknfun() *****/ ,,, * ,,, * /* checks for a numeric function and performs it if present */ ,,, * FBC8,81 36,CHKNFUN:, CHKNFUN: CMPA #FUNCTFLG ; IS THIS A FUNCTION CALL? FBCA,27 01,, BEQ CHKNFUN1 ; YES. GO DO THE FUNCTION. FBCC,39,, RTS ; NO. JUST RETURN. FBCD,18 A6 01,CHKNFUN1:, CHKNFUN1: LDAA 1,Y ; GET THE FUNCTION CODE BYTE IN B. FBD0,4A,, DECA ; SUBTRACT 1 FOR INDEXING. FBD1,C6 03,, LDAB #3 ; BUMP THE IP. FBD3,18 3A,, ABY ; POINT TO THE FIRST ELEMENT IN THE EXPRESSION. FBD5,16,, TAB ; PUT THE FUNCTION NUMBER INTO B. FBD6,58,, ASLB ; MULT BY THE NUMBER OF BYTES/ADDRESS. FBD7,CE FB E5,, LDX #RNFUNCT ; POINT TO THE FUNCTION ADDRESS TABLE. FBDA,3A,, ABX ; POINT TO THE PROPER FUNCTION. FBDB,EE 00,, LDX 0,X ; GET THE ADDRESS INTO X. FBDD,AD 00,, JSR 0,X ; GO DO THE FUNCTION. FBDF,18 08,, INY ; PUT IP PAST THE CLOSING PAREN. FBE1,18 A6 00,, LDAA 0,Y ; GET NEXT CHARACTER. FBE4,39,, RTS ; RETURN. ,,, * ,,, * ,,, RNFUNCT: EQU * FBE5,FE 20,, FDB RFDIV FBE7,FE 9E,, FDB ICHRS ; "ICHRS" BECAUSE IT'S ILLEGAL IN AN EXPRESSION. FBE9,FE 45,, FDB RADC FBEB,FD C8,, FDB RABS FBED,FE 76,, FDB RRND FBEF,FD D9,, FDB RSGN FBF1,FE 9E,, FDB ITAB ; "ITAB" BECAUSE IT'S ILLEGAL IN AN EXPRESSION. FBF3,FD EB,, FDB RCALL FBF5,FD F6,, FDB RPEEK FBF7,FE 05,, FDB RFEEP ; "EEP" AS A FUNCTION. FBF9,FE 9E,, FDB IHEX ; "IHEX" BECAUSE IT'S ILLEGAL IN AN EXPRESSION. FBFB,FE AE,, FDB RFPORTA FBFD,FE BD,, FDB RFPORTB FBFF,FE C1,, FDB RFPORTC FC01,FE C5,, FDB RFPORTD FC03,FE C9,, FDB RFPORTE FC05,FE A3,, FDB RFTIME FC07,FE 9E,, FDB IHEX2 ; "IHEX2" BECAUSE IT'S ILLEGAL IN AN EXPRESSION. FC09,FE A7,, FDB RFPACC ,,, * ,,, * ,,, * /***** chckee() *****/ ,,, * ,,, * /* if the current token is a semicolin, comma, colin, or space */ ,,, * /* all pending operations on the math stack are performed and */ ,,, * /* we return with the carry set */ ,,, * ,,, CHCKEE: EQU * FC0B,81 11,, CMPA #CPARNTOK ; IS IT A CLOSED PAREN? FC0D,27 08,, BEQ CHCKEE2 ; YES. FC0F,81 7A,, CMPA #MEOLTOK ; IS IT ONE OF THE "EXPRESSION END" TOKENS? FC11,24 02,, BHS CHCKEE1 ; YES. FC13,0C,, CLC ; FLAG "NOT AT THE END OF EXPRESSION". FC14,39,, RTS ; RETURN. FC15,86 11,CHCKEE1:, CHCKEE1: LDAA #CPARNTOK ; END OF EXPRESSION FOUND. PERFORM ALL PENDING FC17,8D 02,CHCKEE2:, CHCKEE2: BSR PSHOP ; OPERATIONS. FC19,0D,, SEC ; FLAG END OF EXPRESSION. FC1A,39,, RTS ,,, * ,,, * FC1B,DE 21,PSHOP:, PSHOP: LDX OPSTACK ; GET THE OPERATOR STACK POINTER. FC1D,09,, DEX ; DECREMENT THE STACK POINTER. FC1E,9C 4D,, CPX EOPSTK ; DID THE STACK OVERFLOW? FC20,26 05,, BNE PSHOP1 ; NO. CONTINUE. FC22,86 17,, LDAA #MSTKOERR ; YES. FC24,7E EA EF,, JMP RPTRERR ; GO REPORT THE ERROR. FC27,DF 21,PSHOP1:, PSHOP1: STX OPSTACK FC29,A7 00,, STAA 0,X ; PUT IT ON THE STACK. FC2B,DE 21,PSHOP2:, PSHOP2: LDX OPSTACK FC2D,A6 00,, LDAA 0,X ; GET THE NEW OPERATOR OFF THE TOP OF STACK. FC2F,81 10,, CMPA #OPARNTOK ; IS IT AN OPEN PAREN? FC31,27 19,, BEQ PSHOP5 ; YES. GO PUSH IT. FC33,E6 01,, LDAB 1,X ; GET THE PREVIOUS OPERATOR OFF THE STACK. FC35,C4 F0,, ANDB #$F0 ; MASK ALL BUT THE PRECIDENCE VALUE. FC37,84 F0,, ANDA #$F0 ; MASK ALL BUT THE OPERATOR PRECIDENCE. FC39,11,, CBA ; IS THE PRECIDENCE OF THE CURRENT OPERATOR >= ,,, * ; THE OPERATOR ON THE TOP OF THE STACK? FC3A,22 10,, BHI PSHOP5 ; NO. JUST GO PUSH IT ON THE STACK. FC3C,A6 01,, LDAA 1,X ; YES. GET THE PREVIOUS OPERATOR FROM THE STACK. FC3E,E6 00,, LDAB 0,X ; GET THE CURRENT OPERATOR FROM THE STACK. FC40,C1 11,, CMPB #CPARNTOK ; IS THE CURRENT OPERATOR A CLOSED PAREN? FC42,26 09,, BNE PSHOP3 ; NO. CONTINUE. FC44,81 10,, CMPA #OPARNTOK ; YES. IS THE PREVIOUS OPERATOR AN OPEN PAREN? FC46,26 05,, BNE PSHOP3 ; NO. CONTINUE. FC48,08,, INX ; YES. KNOCK BOTH OPERATORS OFF THE STACK. FC49,08,, INX FC4A,DF 21,, STX OPSTACK ; SAVE THE STACK POINTER. FC4C,39,PSHOP5:, PSHOP5: RTS ; RETURN. FC4D,E7 01,PSHOP3:, PSHOP3: STAB 1,X ; PUT IT ON THE STACK. FC4F,08,, INX ; UPDATE THE STACK POINTER. FC50,DF 21,, STX OPSTACK FC52,8D 02,, BSR DOOP ; GO DO THE OPERATION. FC54,20 D5,, BRA PSHOP2 ; GO TRY FOR ANOTHER OPERATION. ,,, * ,,, * FC56,81 70,DOOP:, DOOP: CMPA #$70 ; IS IT A UINARY OPERATOR? FC58,25 07,, BLO DOOP1 ; NO. GO CHECK THE NEXT GROUP. FC5A,80 70,, SUBA #$70 ; YES. SUBTRACT THE BASE VALUE OF THE GROUP. FC5C,CE FC A4,, LDX #HEIR7 ; POINT TO THE EXECUTION ADDRESS TABLE. FC5F,20 3C,, BRA DOOP7 ; GO DO THE OPERATION. FC61,81 60,DOOP1:, DOOP1: CMPA #$60 ; IS IT THE "^" OPERATOR? FC63,25 07,, BLO DOOP2 ; NO. GO CHECK THE NEXT GROUP. FC65,80 60,, SUBA #$60 ; YES. SUBTRACT THE BASE VALUE OF THE GROUP. FC67,CE FC AA,, LDX #HEIR6 ; POINT TO THE EXECUTION ADDRESS TABLE. FC6A,20 31,, BRA DOOP7 ; GO DO THE OPERATION. FC6C,81 50,DOOP2:, DOOP2: CMPA #$50 ; IS IT MULTIPLY, DIVIDE, OR MOD? FC6E,25 07,, BLO DOOP3 ; NO. GO CHECK THE NEXT GROUP. FC70,80 50,, SUBA #$50 ; YES. SUBTRACT THE BASE VALUE OF THE GROUP. FC72,CE FC AC,, LDX #HEIR5 ; POINT TO THE EXECUTION ADDRESS TABLE. FC75,20 26,, BRA DOOP7 ; GO DO THE OPERATION. FC77,81 40,DOOP3:, DOOP3: CMPA #$40 ; IS IT ADD OR SUBTRACT? FC79,25 07,, BLO DOOP4 ; NO. GO CHECK THE NEXT GROUP. FC7B,80 40,, SUBA #$40 ; YES. SUBTRACT THE BASE VALUE OF THE GROUP. FC7D,CE FC B2,, LDX #HEIR4 ; POINT TO THE EXECUTION ADDRESS TABLE. FC80,20 1B,, BRA DOOP7 ; GO DO THE OPERATION. FC82,81 30,DOOP4:, DOOP4: CMPA #$30 ; IS IT A LOGICAL OPERATOR? FC84,25 07,, BLO DOOP5 ; NO. GO CHECK THE NEXT GROUP. FC86,80 30,, SUBA #$30 ; YES. SUBTRACT THE BASE VALUE OF THE GROUP. FC88,CE FC B6,, LDX #HEIR3 ; POINT TO THE EXECUTION ADDRESS TABLE. FC8B,20 10,, BRA DOOP7 ; GO DO THE OPERATION. FC8D,81 20,DOOP5:, DOOP5: CMPA #$20 ; IS IT AND, OR, OR EOR? FC8F,25 07,, BLO DOOP6 ; NO. ERROR. FC91,80 20,, SUBA #$20 ; YES. SUBTRACT THE BASE VALUE OF THE GROUP. FC93,CE FC C2,, LDX #HEIR2 ; POINT TO THE EXECUTION ADDRESS TABLE. FC96,20 05,, BRA DOOP7 ; GO DO THE OPERATION. FC98,86 08,DOOP6:, DOOP6: LDAA #ILTOKERR ; ILLEGAL OPERATOR TOKEN ENCOUNTERED. FC9A,7E EA EF,, JMP RPTRERR ; GO REPORT THE ERROR. FC9D,16,DOOP7:, DOOP7: TAB ; PUT THE OFFSET IN B. FC9E,58,, ASLB ; MULTIPLY THE OFFSET BY 2. FC9F,3A,, ABX ; POINT TO THE ROUTINE ADDRESS. FCA0,EE 00,, LDX 0,X ; GET THE ADDRESS. FCA2,6E 00,, JMP 0,X ; GO DO THE OPERATION & RETURN. ,,, * ,,, * ,,, HEIR7: EQU * FCA4,FD 80,, FDB RINDIR FCA6,FD 81,, FDB RNOT FCA8,FD 8A,, FDB RNEG ,,, HEIR6: EQU * FCAA,FD C7,, FDB RPWR ,,, HEIR5: EQU * FCAC,FD 52,, FDB RMULT FCAE,FD 00,, FDB RDIV FCB0,FD 4C,, FDB RMOD ,,, HEIR4: EQU * FCB2,FC EA,, FDB RPLUS FCB4,FC F3,, FDB RMINUS ,,, HEIR3: EQU * FCB6,FD 92,, FDB RLT FCB8,FD 9D,, FDB RGT FCBA,FD A3,, FDB RLTEQ FCBC,FD A9,, FDB RGTEQ FCBE,FD AF,, FDB REQ FCC0,FD B5,, FDB RNOTEQ ,,, HEIR2: EQU * FCC2,FC DF,, FDB RAND FCC4,FC D4,, FDB RORV FCC6,FC C8,, FDB REOR ,,, * ,,, * FCC8,BD FB B9,REOR:, REOR: JSR PULNUM FCCB,DE 1F,, LDX NUMSTACK FCCD,A8 00,, EORA 0,X FCCF,E8 01,, EORB 1,X FCD1,ED 00,REOR1:, REOR1: STD 0,X FCD3,39,, RTS ,,, * ,,, * FCD4,BD FB B9,RORV:, RORV: JSR PULNUM FCD7,DE 1F,, LDX NUMSTACK FCD9,AA 00,, ORAA 0,X FCDB,EA 01,, ORAB 1,X FCDD,20 F2,, BRA REOR1 ,,, * ,,, * FCDF,BD FB B9,RAND:, RAND: JSR PULNUM FCE2,DE 1F,, LDX NUMSTACK FCE4,A4 00,, ANDA 0,X FCE6,E4 01,, ANDB 1,X FCE8,20 E7,, BRA REOR1 ,,, * ,,, * FCEA,BD FB B9,RPLUS:, RPLUS: JSR PULNUM FCED,DE 1F,, LDX NUMSTACK FCEF,E3 00,, ADDD 0,X FCF1,20 DE,, BRA REOR1 ,,, * ,,, * FCF3,DE 1F,RMINUS:, RMINUS: LDX NUMSTACK FCF5,EC 02,, LDD 2,X FCF7,A3 00,, SUBD 0,X FCF9,08,, INX FCFA,08,, INX FCFB,ED 00,, STD 0,X FCFD,DF 1F,, STX NUMSTACK FCFF,39,, RTS ,,, * ,,, * FD00,8D 08,RDIV:, RDIV: BSR RDIVS ; GO DO A SIGNED DIVIDE. FD02,BD FB B9,, JSR PULNUM ; GET INTEGER RESULT OFF STACK. FD05,DE 1F,, LDX NUMSTACK ; POINT TO NUMERIC STACK. FD07,ED 00,, STD 0,X ; OVERWRITE REMAINDER. FD09,39,, RTS ; RETURN. ,,, * ,,, * ,,, * FD0A,DE 1F,RDIVS:, RDIVS: LDX NUMSTACK ; POINT TO NUMERIC STACK. FD0C,A6 00,, LDAA 0,X ; GET UPPER BYTE OF DIVISOR. FD0E,A8 02,, EORA 2,X ; GET SIGN OF THE RESULT. FD10,36,, PSHA ; SAVE RESULT. FD11,EC 00,, LDD 0,X ; GET DIVISOR OFF NUMERIC STACK. IS IT ZERO? FD13,26 05,, BNE RDIV1 ; NO. CONTINUE. FD15,86 1A,RDIV2:, RDIV2: LDAA #ZDIVERR ; YES. GET DIVIDE BY ZERO ERROR. FD17,7E EA EF,, JMP RPTRERR ; GO REPORT IT. FD1A,2A 03,RDIV1:, RDIV1: BPL RDIV3 ; IF POSITIVE IT'S OK. FD1C,BD FD 8A,, JSR RNEG ; IF NOT MAKE IT POSITIVE. FD1F,6D 02,RDIV3:, RDIV3: TST 2,X ; IS THE DIVIDEND NEGATIVE? FD21,2A 09,, BPL RDIV4 ; NO. CONTINUE. FD23,EC 02,, LDD 2,X ; YES. GET THE NUMBER. FD25,43,, COMA ; NEGATE IT. FD26,53,, COMB FD27,C3 00 01,, ADDD #1 FD2A,ED 02,, STD 2,X ; SAVE THE RESULT. FD2C,EC 00,RDIV4:, RDIV4: LDD 0,X ; GET THE DIVISOR. FD2E,EE 02,, LDX 2,X ; GET THE DIVIDEND. FD30,8F,, XGDX ; PUT THEM IN THE PROPER REGISTERS. FD31,02,, IDIV ; DO AN UNSIGNED DIVIDE. FD32,3C,, PSHX ; SAVE THE QUOTIENT. FD33,DE 1F,, LDX NUMSTACK ; POINT TO THE NUMERIC STACK. FD35,ED 02,, STD 2,X ; SAVE THE REMAINDER. ,,, * PULD ; GET THE QUOTIENT. FD37,32,, PULA FD38,33,, PULB FD39,ED 00,, STD 0,X ; PUT IT ON THE NUMERIC STACK. FD3B,32,, PULA ; GET THE SIGN OF THE RESULT. FD3C,4D,, TSTA ; SET THE CONDITION CODES. FD3D,2A 0C,, BPL RDIV5 ; IF PLUS, RESULT OK AS IS. FD3F,BD FD 8A,, JSR RNEG ; MAKE THE QUOTIENT NEGATIVE. FD42,EC 02,, LDD 2,X ; GET THE REMAINDER. FD44,43,, COMA ; MAKE IT NEGATIVE. FD45,53,, COMB FD46,C3 00 01,, ADDD #1 FD49,ED 02,, STD 2,X ; SAVE THE RESULT. FD4B,39,RDIV5:, RDIV5: RTS ; RETURN. ,,, * ,,, * FD4C,8D BC,RMOD:, RMOD: BSR RDIVS ; GO GET QUOTIENT & REMAINDER. FD4E,BD FB B9,, JSR PULNUM ; REMOVE INTEGER RESULT & LEAVE REMAINDER. FD51,39,, RTS ; RETURN. ,,, * ,,, * FD52,18 3C,RMULT:, RMULT: PSHY FD54,DE 1F,, LDX NUMSTACK FD56,A6 01,, LDAA 1,X FD58,E6 03,, LDAB 3,X FD5A,3D,, MUL ,,, * PSHD FD5B,37,, PSHB FD5C,36,, PSHA FD5D,18 30,, TSY FD5F,A6 01,, LDAA 1,X FD61,E6 02,, LDAB 2,X FD63,3D,, MUL FD64,18 EB 00,, ADDB 0,Y FD67,18 E7 00,, STAB 0,Y FD6A,A6 00,, LDAA 0,X FD6C,E6 03,, LDAB 3,X FD6E,3D,, MUL FD6F,18 EB 00,, ADDB 0,Y FD72,18 E7 00,, STAB 0,Y FD75,08,, INX FD76,08,, INX ,,, * PULD FD77,32,, PULA FD78,33,, PULB FD79,ED 00,, STD 0,X FD7B,DF 1F,, STX NUMSTACK FD7D,18 38,, PULY FD7F,39,, RTS ,,, * ,,, * ,,, RINDIR: EQU * FD80,39,, RTS ,,, * ,,, * ,,, RNOT: EQU * FD81,DE 1F,, LDX NUMSTACK FD83,EC 00,, LDD 0,X FD85,43,, COMA FD86,53,, COMB FD87,ED 00,, STD 0,X FD89,39,, RTS ,,, * ,,, * ,,, RNEG: EQU * FD8A,8D F5,, BSR RNOT FD8C,C3 00 01,, ADDD #1 FD8F,ED 00,, STD 0,X FD91,39,, RTS ,,, * ,,, * ,,, RLT: EQU * FD92,8D 27,, BSR CMPNUM FD94,2C 02,, BGE RLT1 FD96,6C 03,RLT2:, RLT2: INC 3,X FD98,08,RLT1:, RLT1: INX FD99,08,, INX FD9A,DF 1F,, STX NUMSTACK FD9C,39,, RTS ,,, * ,,, * ,,, RGT: EQU * FD9D,8D 1C,, BSR CMPNUM FD9F,2F F7,, BLE RLT1 FDA1,20 F3,, BRA RLT2 ,,, * ,,, * ,,, RLTEQ: EQU * FDA3,8D 16,, BSR CMPNUM FDA5,2E F1,, BGT RLT1 FDA7,20 ED,, BRA RLT2 ,,, * ,,, * ,,, RGTEQ: EQU * FDA9,8D 10,, BSR CMPNUM FDAB,2D EB,, BLT RLT1 FDAD,20 E7,, BRA RLT2 ,,, * ,,, * ,,, REQ: EQU * FDAF,8D 0A,, BSR CMPNUM FDB1,26 E5,, BNE RLT1 FDB3,20 E1,, BRA RLT2 ,,, * ,,, * ,,, RNOTEQ: EQU * FDB5,8D 04,, BSR CMPNUM FDB7,27 DF,, BEQ RLT1 FDB9,20 DB,, BRA RLT2 ,,, * ,,, * ,,, CMPNUM: EQU * FDBB,DE 1F,, LDX NUMSTACK FDBD,EC 02,, LDD 2,X FDBF,6F 02,, CLR 2,X FDC1,6F 03,, CLR 3,X FDC3,1A A3 00,, CPD 0,X FDC6,39,, RTS ,,, * ,,, * ,,, RPWR: EQU * FDC7,39,, RTS ,,, * ,,, * ,,, RABS: EQU * FDC8,BD FB 12,, JSR DONEXP FDCB,DE 1F,, LDX NUMSTACK FDCD,EC 00,, LDD 0,X FDCF,2A 05,, BPL RABS1 FDD1,43,RABS2:, RABS2: COMA FDD2,53,, COMB FDD3,C3 00 01,, ADDD #1 FDD6,ED 00,RABS1:, RABS1: STD 0,X FDD8,39,, RTS ,,, * ,,, * ,,, RSGN: EQU * FDD9,BD FB 12,, JSR DONEXP FDDC,DE 1F,, LDX NUMSTACK FDDE,EC 00,, LDD 0,X FDE0,27 F4,, BEQ RABS1 FDE2,CC 00 01,, LDD #1 FDE5,6D 00,, TST 0,X FDE7,2A ED,, BPL RABS1 FDE9,20 E6,, BRA RABS2 ,,, * ,,, * ,,, RCALL: EQU * FDEB,BD FB 12,, JSR DONEXP FDEE,DE 1F,, LDX NUMSTACK FDF0,EE 00,, LDX 0,X FDF2,AD 00,, JSR 0,X FDF4,20 0A,, BRA RPEEK1 ,,, * ,,, * ,,, RPEEK: EQU * FDF6,BD FB 12,, JSR DONEXP FDF9,DE 1F,, LDX NUMSTACK FDFB,EE 00,, LDX 0,X FDFD,E6 00,, LDAB 0,X FDFF,4F,, CLRA FE00,DE 1F,RPEEK1:, RPEEK1: LDX NUMSTACK FE02,ED 00,, STD 0,X FE04,39,, RTS ,,, * ,,, * ,,, RFEEP: EQU * FE05,BD FB 12,, JSR DONEXP ; GO GET SUBSCRIPT OF EEPROM ARRAY. FE08,DE 1F,, LDX NUMSTACK ; POINT TO THE OPERAND STACK. FE0A,EC 00,, LDD 0,X ; GET THE SUBSCRIPT OFF THE STACK. FE0C,1A 83 00 FF,, CPD #MAXEESUB ; IS IT WITHIN THE LIMIT? FE10,23 05,, BLS RFEEP1 ; YES. GO GET THE VALUE. FE12,86 28,, LDAA #EESUBERR ; NO. SUBSCRIPT ERROR. FE14,7E EA EF,RFEEP2:, RFEEP2: JMP RPTRERR ; REPORT THE ERROR. FE17,05,RFEEP1:, RFEEP1: LSLD ; MULT THE SUBSCRIPT BY 2. FE18,C3 B6 00,, ADDD #EEPBASAD ; ADD IN THE BASE ADDRESS OF THE EEPROM ADDRESS. FE1B,8F,, XGDX ; PUT THE ADDRESS IN X. FE1C,EC 00,, LDD 0,X ; GET THE DATA. FE1E,20 E0,, BRA RPEEK1 ; GO STEAL SOME CODE. ,,, * ,,, * ,,, RFDIV: EQU * FE20,BD FB 12,, JSR DONEXP ; GO EVALUATE THE DIVIDEND EXPRESSION. FE23,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES. FE26,18 08,, INY ; PASS UP THE COMMA. FE28,BD F1 CA,, JSR RSKIPSPC ; SKIP SPACES AFTER THE COMMA. FE2B,BD FB 12,, JSR DONEXP ; EVALUATE THE DIVISOR EXPRESSION. FE2E,DE 1F,, LDX NUMSTACK ; POINT TO OPERAND STACK. FE30,EC 02,, LDD 2,X ; GET THE DIVIDEND. FE32,EE 00,, LDX 0,X ; GET THE DIVISOR. FE34,03,, FDIV ; DO THE FRACTIONAL DIVIDE. FE35,28 04,, BVC RFDIV1 ; ALL IS OK IF V=0. (IX > D). FE37,86 2C,, LDAA #OVDV0ERR ; ERROR. EITHER OVERFLOW OR /0 ERROR. FE39,20 D9,RFDIV2:, RFDIV2: BRA RFEEP2 ; GO REPORT IT. FE3B,8F,RFDIV1:, RFDIV1: XGDX ; PUT QUOTIENT IN D. FE3C,DE 1F,, LDX NUMSTACK ; POINT TO OPERAND STACK. FE3E,08,, INX ; REMOVE DIVISOR FROM STACK. FE3F,08,, INX FE40,ED 00,, STD 0,X ; PUT QUITIENT ON OPERAND STACK. FE42,DF 1F,, STX NUMSTACK ; SAVE NEW VALUE OF STACK POINTER. FE44,39,, RTS ; RETURN. ,,, * ,,, * ,,, RADC: EQU * FE45,BD FB 12,, JSR DONEXP ; GO GET THE CHANNEL NUMBER TO CONVERT. FE48,DE 1F,, LDX NUMSTACK ; POINT TO THE RESULT. FE4A,EC 00,, LDD 0,X ; GET THE CHANNEL NUMBER. FE4C,2B 06,, BMI RADC4 ; NEGATIVE CHANNEL NUMBERS ARE ILLEGAL. FE4E,1A 83 00 07,, CPD #7 ; IS IT A VALID CHANNEL NUMBER? FE52,23 04,, BLS RADC1 ; YES. GO CONVERT IT. FE54,86 2D,RADC4:, RADC4: LDAA #INVCHERR ; NO. INVALID CHANNEL NUMBER. FE56,20 E1,, BRA RFDIV2 ; GO REPORT THE ERROR. FE58,DE 61,RADC1:, RADC1: LDX IOBaseV FE5A,E7 30,, STAB ADCTL,X ; START THE CONVERSION ON THE SELECTED. FE5C,6D 30,RADC2:, RADC2: TST ADCTL,X ; IS THE CONVERSION COMPLETE? FE5E,2A FC,, BPL RADC2 ; NO. WAIT FOR 4 CONVERSIONS ON 1 CHANNEL. FE60,4F,, CLRA ; YES. NOW AVERAGE THE 4 CONVERSIONS. FE61,E6 31,, LDAB ADR1,X ; GET 1ST RESULT. FE63,EB 32,, ADDB ADR2,X ; ADD IN THE SECOND. FE65,89 00,, ADCA #0 ; ADD IN CARRY. FE67,EB 33,, ADDB ADR3,X ; ADD IN THE THIRD. FE69,89 00,, ADCA #0 ; ADD IN CARRY. FE6B,EB 34,, ADDB ADR4,X ; ADD IN THE FOURTH. FE6D,89 00,, ADCA #0 ; ADD IN CARRY. FE6F,04,, LSRD ; DIVIDE RESULT BY 4. FE70,04,, LSRD FE71,DE 1F,, LDX NUMSTACK ; POINT TO THE RESULT. FE73,ED 00,, STD 0,X ; PUT THE RESULT ON THE OPERAND STACK. FE75,39,, RTS ; RETURN. ,,, * ,,, * ,,, RRND: EQU * FE76,BD FB 12,, JSR DONEXP ; GO GET FUNCTION ARGUMENT. FE79,DE 1F,, LDX NUMSTACK ; GET ARGUMENT OFF STACK. GET NEW RANDOM NUMBER? FE7B,EC 00,, LDD 0,X FE7D,27 0C,, BEQ RRND2 ; YES. GO GET NEXT RANDOM NUMBER IN THE SERIES. FE7F,2B 04,, BMI RRND1 ; IF NEG., START A NEW SERIES. FE81,DC 35,, LDD RANDOM ; IF POSITIVE, GET LAST RANDOM NUMBER. FE83,20 15,, BRA RRND3 ; RETURN. FE85,DE 61,RRND1:, RRND1: LDX IOBaseV FE87,EC 0E,, LDD TCNT,X ; USE THE TIMER VALUE AS THE NEW SEED. FE89,DD 35,, STD RANDOM ; SAVE IT. FE8B,DC 35,RRND2:, RRND2: LDD RANDOM ; GET PREVIOUS RANDOM NUMBER (USE AS SEED). FE8D,58,, ASLB ; DO SOME OPERATIONS. FE8E,1B,, ABA FE8F,D6 36,, LDAB RANDOM+1 FE91,05,, ASLD FE92,05,, ASLD FE93,D3 35,, ADDD RANDOM FE95,C3 36 19,, ADDD #$3619 FE98,DD 35,, STD RANDOM FE9A,04,RRND3:, RRND3: LSRD ; MAKE THE NUMBER POSITIVE. FE9B,ED 00,, STD 0,X ; PUT THE NUMBER ON THE STACK. FE9D,39,, RTS ; RETURN. ,,, * ,,, * ,,, ITAB: EQU * ,,, ICHRS: EQU * ,,, IHEX: EQU * ,,, IHEX2: EQU * FE9E,86 29,, LDAA #PRFUNERR ; THESE FUNCTIONS MUST BE USED ONLY IN FEA0,7E EA EF,, JMP RPTRERR ; PRINT STATEMENTS. ,,, * ,,, * FEA3,DC 38,RFTIME:, RFTIME: LDD TIMEREG ; GET THE TIME IN SECONDS. FEA5,20 0F,, BRA RFPORTA2 ; GO PUT NUMBER ON THE STACK. ,,, * ,,, * FEA7,DE 61,RFPACC:, RFPACC: LDX IOBaseV FEA9,E6 27,, LDAB PACNT,X ; GET THE CURRENT VALUE OF THE PULSE ACCUMULATOR. FEAB,4F,, CLRA FEAC,20 08,, BRA RFPORTA2 ; GO PUT THE NUMBER ON THE STACK. ,,, * ,,, * ,,, RFPORTA: EQU * FEAE,C6 00,, LDAB #PORTAIO ; GET DATA FROM PORTA. FEB0,DE 61,RFPORTA1:, RFPORTA1: LDX IOBaseV FEB2,3A,, ABX FEB3,E6 00,, LDAB 0,X FEB5,4F,, CLRA ; CLEAR UPPER BYTE OF WORD. FEB6,18 09,RFPORTA2:, RFPORTA2: DEY ; DECREMENT IP BECAUSE CALLING ROUTINE WILL TRY FEB8,18 09,, DEY ; TO BUMP IT PAST AN OPENING & CLOSING PAREN ,,, * ; WHICH ISN'T THERE. FEBA,7E FB 7C,, JMP PSHNUM4 ; GO PUSH VALUE ON OPERAND STACK & RETURN. ,,, * ,,, RFPORTB: EQU * FEBD,C6 04,, LDAB #PORTBIO FEBF,20 EF,, BRA RFPORTA1 ,,, * ,,, RFPORTC: EQU * FEC1,C6 03,, LDAB #PORTCIO FEC3,20 EB,, BRA RFPORTA1 ,,, * ,,, RFPORTD: EQU * FEC5,C6 08,, LDAB #PORTDIO FEC7,20 E7,, BRA RFPORTA1 ,,, * ,,, RFPORTE: EQU * FEC9,C6 0A,, LDAB #PORTEIO FECB,20 E3,, BRA RFPORTA1 ,,, * ,,, * ,,, ; opt lis ,,, #Include 'IOPKG.Asm' ,,, * title IOPKG ,,, * page ,,, * ,,, * ,,, OUTBYTE: EQU * FECD,7C 00 1E,, INC PRINTPOS ; INCREMENT THE CURRENT PRINT POSITION. FED0,37,, PSHB ; SAVE THE B-REG. FED1,3C,, PSHX ; SAVE THE X-REG. FED2,CE 00 B4,, LDX #OUTABLE ; POINT TO THE OUTPUT VECTOR TABLE. FED5,D6 37,OUTBYTE1:, OUTBYTE1: LDAB DEVNUM ; GET THE CURRENT DEVICE NUMBER. FED7,58,, ASLB ; MULT BY 2. FED8,3A,, ABX ; POINT TO THE ADDRESS OF THE OUTPUT ROUTINE. FED9,EE 00,, LDX 0,X ; GET THE ADDRESS. HAS THE VECTOR BEEN INITALIZED? FEDB,26 08,, BNE OUTBYTE2 ; YES. GO OUTPUT THE CHARACTER. FEDD,7F 00 37,, CLR DEVNUM ; NO. RESET TO DEVICE #0. FEE0,86 31,, LDAA #UNINIERR ; GO REPORT AN UNINITALIZED I/O VECTOR ERROR. FEE2,7E EA EF,, JMP RPTRERR FEE5,AD 00,OUTBYTE2:, OUTBYTE2: JSR 0,X ; GO OUTPUT THE CHARACTER. FEE7,38,, PULX ; RESTORE X. FEE8,33,, PULB ; RESTORE B. FEE9,39,, RTS ; RETURN. ,,, * ,,, INBYTE: EQU * FEEA,37,, PSHB ; SAVE THE B-REG. FEEB,3C,, PSHX ; SAVE THE X-REG. FEEC,CE 00 A4,, LDX #INTABLE ; POINT TO THE INPUT VECTOR TABLE. FEEF,20 E4,, BRA OUTBYTE1 ; GO USE THE SAME CODE AS OUTBYTE. ,,, * ,,, * ,,, $if * > $FF00 ,,, $endif ,,, * ,,, * ,,, ORG $FF00 ,,, * ,,, * FF00,8D 0D,ACIAIN:, ACIAIN: BSR ACIAINNE ; GO GET CHARACTER FROM ACIA, NO ECHO. ,,, * ; NOW, FALL THROUGH TO ACIAOUT TO ECHO CHARACTER. ,,, * ,,, * FF02,36,ACIAOUT:, ACIAOUT: PSHA ; SAVE THE CHARACTER TO OUTPUT. FF03,B6 98 00,ACIAOUT1:, ACIAOUT1: LDAA ACIAST ; GET THE ACIA STATUS. FF06,85 02,, BITA #$02 ; IS THE XMIT DATA REGISTER EMPTY? FF08,27 F9,, BEQ ACIAOUT1 ; NO. WAIT TILL IT IS. FF0A,32,, PULA ; YES. GET BYTE TO SEND. FF0B,B7 98 01,, STAA ACIADT ; SEND IT. FF0E,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, * ,,, * ,,, * FF0F,B6 98 00,ACIAINNE:, ACIAINNE: LDAA ACIAST ; GET THE ACIA STATUS. FF12,85 01,, BITA #$01 ; HAS A CHARACTER BEEN RECIEVED? FF14,27 F9,, BEQ ACIAINNE ; NO. WAIT TILL WE HAVE ONE. FF16,B6 98 01,, LDAA ACIADT ; YES. GET THE CHARACTER. FF19,39,, RTS ; RETURN. ,,, * ,,, ACIASTAT: EQU * FF1A,36,, PSHA ; SAVE THE A-REG. FF1B,B6 98 00,, LDAA ACIAST ; GET THE ACIA STATUS. FF1E,85 01,, BITA #$01 ; CHECK FOR A CHARACTER. FF20,32,, PULA ; RESTORE A. FF21,39,, RTS ; RETURN. ,,, * ,,, * ,,, ,,, ,,, SCIIN: EQU * FF22,3C,, PSHX ; Save the index register. FF23,DE 61,, LDX IOBaseV FF25,A6 2E,SCIIN1:, SCIIN1: LDAA SCSR,X ; GET SCI STATUS. FF27,84 20,, ANDA #$20 ; HAS A CHARACTER BEEN RECIEVED? FF29,27 FA,, BEQ SCIIN1 ; NO. WAIT FOR CHARACTER TO BE RECIEVED. FF2B,A6 2F,, LDAA SCDR,X ; GET THE CHARACTER. FF2D,38,, PULX ; Restore X. ,,, ,,, * JKJ: Fall thru to echo the char... ,,, * RTS ; RETURN. ,,, * ,,, * ,,, ,,, SCIOUT: EQU * FF2E,3C,, PSHX ; Save the index register. FF2F,DE 61,, LDX IOBaseV FF31,36,, PSHA ; SAVE THE CHARACTER TO SEND. FF32,A6 2E,SCIOUT1:, SCIOUT1: LDAA SCSR,X ; GET THE SCI STATUS. FF34,85 80,, BITA #$80 ; HAS THE LAST CHARACTER BEEN SHIFTED OUT? FF36,27 FA,, BEQ SCIOUT1 ; NO. WAIT TILL IT HAS. FF38,32,, PULA ; RESTORE CHARACTER TO SEND. FF39,A7 2F,, STAA SCDR,X ; SEND THE CHARACTER. FF3B,38,, PULX ; Restore X. FF3C,39,, RTS ; RETURN. ,,, * ,,, * ,,, SCISTAT: EQU * FF3D,3C,, PSHX ; Save the index register. FF3E,DE 61,, LDX IOBaseV FF40,36,, PSHA ; SAVE THE A-REG. FF41,A6 2E,, LDAA SCSR,X ; GET THE SCI STATUS. FF43,85 20,, BITA #$20 ; CHECK TO SEE IF A CHARACTER HAS BEEN RECIEVED. FF45,32,, PULA ; RESTORE STATUS. FF46,38,, PULX ; Restore X. FF47,39,, RTS ; RETURN W/ STATUS. ,,, * ,,, * ,,, IODevInit: ,,, ;JKJ No ACIA. Set PORTC as output for starters. ,,, ; BSR InitACIA FF48,8D 19,, BSR InitSCI FF4A,3C,, PSHX FF4B,DE 61,, LDX IOBaseV FF4D,86 FF,, LDAA #$FF FF4F,A7 07,, STAA DDRC,X FF51,38,, PULX FF52,86 7E,, LDAA #JMPOP FF54,97 9E,, STAA CONSTAT ; INITIALIZE THE CONSOLE STATUS VECTOR. FF56,97 A1,, STAA INCONNE ; INITIALIZE THE INPUT FROM CONSOLE NO ECHO VECT. FF58,CC FF 3D,, LDD #SCISTAT ; CONSOLE IS INITIALLY THE SCI. FF5B,DD 9F,, STD CONSTAT+1 FF5D,CC FF 22,, LDD #SCIIN ; GET BYTE FROM SCI, DON'T ECHO IT. FF60,DD A2,, STD INCONNE+1 FF62,39,, RTS ,,, * ,,, * ,,, INITSCI: EQU * FF63,3C,, PSHX ; Save the index register. FF64,DE 61,, LDX IOBaseV FF66,86 30,, LDAA #$30 ; SET BAUD RATE TO 9600. FF68,A7 2B,, STAA BAUD,X FF6A,6F 2C,, CLR SCCR1,X ; SET FOR 8 BIT OPERATION, DISABLE WAKEUP. FF6C,86 0C,, LDAA #$0C ; ENABLE THE TRANSMITER & RECEIVER. FF6E,A7 2D,, STAA SCCR2,X FF70,86 11,, LDAA #$11 ; GET THE XON CHARACTER (CONTROL-Q). FF72,97 43,, STAA XONCH ; INITALIZE THE XON REGISTER. FF74,86 13,, LDAA #$13 ; GET THE XOFF CHARACTER (CONTROL-S). FF76,97 44,, STAA XOFFCH ; INITALIZE THE XOFF CHARACTER. FF78,38,, PULX FF79,39,, RTS ; RETURN. ,,, * ,,, * FF7A,86 13,INITACIA:, INITACIA: LDAA #$13 ; VALUE TO RESET THE ACIA. FF7C,B7 98 00,, STAA ACIAST ; RESET IT. FF7F,86 56,, LDAA #$56 ; SET /64, RTS=HI, 8-DATA/1 STOP FF81,B7 98 00,, STAA ACIAST FF84,39,, RTS ; RETURN. ,,, * ,,, * ,,, * ,,, PROUT: EQU * ; SEND A CHARACTER TO THE PRINTER. FF85,8D B6,, BSR SCISTAT ; WAS AN "X-OFF" RECIEVED? FF87,27 0E,, BEQ PROUT1 ; NO. GO SEND THE CHARACTER. FF89,36,, PSHA ; SAVE THE CHARACTER TO SEND. FF8A,8D 96,, BSR SCIIN ; YES. GO RESET THE SCI RECEIVER STATUS. FF8C,91 44,, CMPA XOFFCH ; WAS IT AN XOFF? FF8E,26 06,, BNE PROUT2 ; NO. SO GO SEND THE CHARACTER. FF90,8D 90,PROUT3:, PROUT3: BSR SCIIN ; GO WAIT FOR AN "X-ON" CHARACTER. FF92,91 43,, CMPA XONCH ; IS IT AN X-ON CHARACTER? FF94,26 FA,, BNE PROUT3 ; NO. GO WAIT FOR AN X-ON CHARACTER. FF96,32,PROUT2:, PROUT2: PULA ; GET THE CHARACTER TO SEND. FF97,20 95,PROUT1:, PROUT1: BRA SCIOUT ; SEND THE CHARACTER TO THE PRINTER & RETURN. ,,, * ,,, * ,,, #Include 'VECTORS.Asm' ,,, * title Config/Reset/Interrupt Vectors ,,, * page ,,, ,,, $if * > $ffa0 ,,, $endif ,,, * ,,, * ,,, * ,,, org $ffa0 FFA0,FF 22,IOVects, IOVects fdb SCIIN FFA2,00 00,, fdb 0 FFA4,00 00,, fdb 0 FFA6,00 00,, fdb 0 FFA8,00 00,, fdb 0 FFAA,00 00,, fdb 0 FFAC,00 00,, fdb 0 FFAE,00 00,, fdb 0 ,,, FFB0,FF 2E,, fdb SCIOUT FFB2,00 00,, fdb 0 FFB4,00 00,, fdb 0 FFB6,00 00,, fdb 0 FFB8,00 00,, fdb 0 FFBA,00 00,, fdb 0 FFBC,00 00,, fdb 0 FFBE,00 00,, fdb 0 ,,, * ,,, * ,,, org $ffc0 FFC0,80 00,RAMStart:, RAMStart: fdb $8000 ; starting address of system RAM. FFC2,20 00,RAMSize:, RAMSize: fdb $2000 ; size of BASIC11 RAM Buffer. FFC4,60 00,EEStart:, EEStart: fdb $6000 ; starting address of program storage EEPROM FFC6,20 00,EESize:, EESize: fdb $2000 ; size of the program storage EEPROM FFC8,10 00,IOBase:, IOBase: fdb $1000 ; Base Address of the I/O Registers FFCA,F4 24,TimeVal:, TimeVal: fdb 62500 ; value used for generating 'Time' Interrupt FFCC,FF 48,UserInit:, UserInit: fdb IODevInit ; Used to initialize console/other hardware. FFCE,40 00,DFLOPADR:, DFLOPADR: fdb $4000 ; Address of flip-flop used to connect the HC11 SCI ,,, ; to the host port connector. ,,, ; ,,, ; ,,, ,,, ORG ROMBEG+ROMSIZE-42 ; START OF VECTOR TABLE. FFD6,00 C4,, FDB SCISS ; SCI SERIAL SYSTEM FFD8,00 C7,, FDB SPITC ; SPI TRANSFER COMPLETE FFDA,00 CA,, FDB PACCIE ; PULSE ACCUMULATOR INPUT EDGE FFDC,00 CD,, FDB PACCOVF ; PULSE ACCUMULATOR OVERFLOW FFDE,00 D0,, FDB TIMEROVF ; TIMER OVERFLOW FFE0,00 D3,, FDB TOC5 ; TIMER OUTPUT COMPARE 5 FFE2,00 D6,, FDB TOC4 ; TIMER OUTPUT COMPARE 4 FFE4,00 D9,, FDB TOC3 ; TIMER OUTPUT COMPARE 3 FFE6,00 DC,, FDB TOC2 ; TIMER OUTPUT COMPARE 2 FFE8,00 DF,, FDB TOC1 ; TIMER OUTPUT COMPARE 1 FFEA,00 E2,, FDB TIC3 ; TIMER INPUT CAPTURE 3 FFEC,00 E5,, FDB TIC2 ; TIMER INPUT CAPTURE 2 FFEE,00 E8,, FDB TIC1 ; TIMER INPUT CAPTURE 1 FFF0,00 EB,, FDB REALTIMI ; REAL TIME INTERRUPT FFF2,00 EE,, FDB IRQI ; IRQ INTERRUPT FFF4,00 F1,, FDB XIRQ ; XIRQ INTERRUPT FFF6,00 F4,, FDB SWII ; SOFTWARE INTERRUPT FFF8,00 F7,, FDB ILLOP ; ILLEGAL OPCODE TRAP FFFA,00 FA,, FDB COP ; WATCH DOG FAIL FFFC,00 FD,, FDB CMF ; CLOCK MONITOR FAIL FFFE,ED 72,, FDB POWERUP ; RESET ,,, * ,,, * ,,, * ,,, ; opt nol ,,, END MAIN