* title RUNTIME3.TXT * page * * RFOR: EQU * LDD FORSTACK ; GET FOR STACK POINTER. SUBD #10 ; ALLOCATE NEW FOR-NEXT DESCRIPTOR BLOCK. CPD EFORSTK ; HAVE WE RUN OUT OF FOR-NEXT STACK SPACE? BHS RFOR1 ; NO. CONTINUE. LDAA #FORNXERR ; YES. ERROR. JMP RPTRERR ; REPORT ERROR. RFOR1: STD FORSTACK ; SAVE NEW STACK POINTER. PSHY ; SAVE IP ON STACK. JSR RVARPTR ; GET POINTER TO ASIGNMENT VARIABLE. PULY ; RESTORE IP. LDX FORSTACK ; GET FOR STACK POINTER. STD 0,X ; PUT POINTER TO CONTROL VARIABLE IN STACK. LDD CURLINE ; GET CURRENT LINE NUMBER. STD 8,X ; SAVE CURRENT LINE NUMBER IN STACK. JSR RLET ; GO DO ASIGNMENT PART OF FOR. JSR RSKIPSPC ; SKIP SPACES. INY ; SKIP PAST "TO" TOKEN. JSR RSKIPSPC ; SKIP SPACES. JSR DONEXP ; CALCULATE THE TERMINATING LOOP VALUE. JSR PULNUM ; GET NUMBER OFF OF THE STACK. LDX FORSTACK ; GET STACK POINTER. STD 4,X ; PUT VALUE IN STACK BLOCK. LDD #1 ; ASSUME A "STEP" VALUE OF 1. RFOR3: STD 2,X ; PUT IT IN THE STACK. JSR RSKIPSPC ; SKIP SPACES. LDAA 0,Y ; GET NEXT TOKEN. CMPA #STEPTOK ; IS THE STEP CLAUSE PRESENT? BEQ RFOR2 ; YES. GO GET THE "STEP" VALUE. STY 6,X ; PUT TERMINATING CHARACTER OF "FOR" STATEMENT ON. RTS ; EXECUTE NEXT STATEMENT. RFOR2: INY ; SKIP PAST THE "STEP" TOKEN. JSR RSKIPSPC ; SKIP SPACES. JSR DONEXP ; GO CALCULATE THE "STEP" VALUE. JSR PULNUM ; GET VALUE OFF OPERAND STACK. LDX FORSTACK ; GET POINTER TO FOR STACK. BRA RFOR3 ; GO PUT VALUE IN STACK. * * RNEXT: EQU * JSR RVARPTR ; GET POINTER TO LOOP INDEX VARIABLE. LDX FORSTACK ; GET "FOR" STACK POINTER. CPD 0,X ; IS THE LOOP VARIABLE THE SAME? BEQ RNEXT1 ; YES. CONTINUE. LDAA #MFRNXERR ; NO. ERROR. JMP RPTRERR ; GO REPORT IT. RNEXT1: PSHY ; SAVE IP. LDY 0,X ; GET POINTER TO CONTROL VARIABLE. LDD 0,Y ; GET CONTROL VARIABLE VALUE. ADDD 2,X ; ADD THE STEP VALUE TO IT. STD 0,Y ; SAVE THE RESULT. TST 2,X ; IS THE STEP VALUE NEGATIVE? BMI RNEXT2 ; YES. GO DO TEST. CPD 4,X ; NO. ARE WE DONE? BLE RNEXT3 ; NO. GO DO THE LOOP AGAIN. RNEXT4: PULY ; RESTORE THE CURRENT IP. XGDX ; PUT "FOR - NEXT" STACK POINTER IN D. ADDD #10 ; REMOVE DESCRIPTOR FROM STACK. STD FORSTACK ; SAVE NEW STACK VALUE. JSR RSKIPSPC ; SKIP SPACES AFTER CONTROL VARIABLE. RTS ; DO THE STATEMENT AFTER THE NEXT. RNEXT2: CPD 4,X ; ARE WE DONE? BLT RNEXT4 ; YES. CONTINUE. RNEXT3: PULY ; CLEAN Y OFF OF STACK. LDY 6,X ; GET NEW IP. LDD 8,X ; GET LINE NUMBER OF FOR STATEMENT. STD CURLINE ; MAKE IT THE CURRENT LINE. RTS * * * * RINPUT: EQU * BSR CHCKDEV ; CHECK FOR ALTERNATE INPUT DEVICE. LDAA 0,Y ; GET A TOKEN. CMPA #SCONTOK ; IS THERE A PROMPT TO PRINT? BNE RINPUT1 ; NO JUST GO GET THE DATA. PSHY ; YES. SAVE POINTER. LDAB #2 ; COMPENSATE FOR CONSTANT & LENGTH BYTE. ADDB 1,Y ; ADD IN LENGTH BYTE. ABY ; POINT BEYOND PROMPT. PULX ; GET POINTER INTO X. INX ; POINT TO LENGTH BYTE. LDAB 0,X ; GET IT. SUBB #2 ; SUBTRACT OUT THE DELIMETER COUNT. INX ; POINT TO STRING. INX JSR OUTSTR ; GO PRINT THE STRING. INY ; BYPASS COMMA. JSR RSKIPSPC ; SKIP SPACES AFTER COMMA. BRA RINPUT6 RINPUT1: JSR NL RINPUT6: EQU * LDX #QSP ; POINT TO PROMPT. JSR PL ; PRINT IT. JSR GETLINE ; GET THE DATA IN THE INPUT BUFFER. BSR RINRDC BCS RINPUT1 JSR NL CLR DEVNUM ; SET DEVICE NUMBER BACK TO 0. RTS * * QSP: FCC "? " FCB 0 * * CHCKDEV: LDAA 0,Y ; GET A TOKEN. CMPA #PNUMTOK ; IS AN ALTERNATE DEVICE SPECIFYED? BEQ CHCKDEV1 ; YES. CONTINUE. RTS ; NO. RETURN. CHCKDEV1: INY ; YES. PASS THE '#' TOKEN. JSR RSKIPSPC ; SKIP SPACES. JSR DONEXP ; GO EVALUATE THE NUMERIC EXPRESSION. JSR PULNUM ; GET THE NUMBER OFF THE STACK. BPL CHCKDEV2 ; NEGATIVE NUMBERS NOT ALLOWED. CHCKDEV3: LDAA #ILLIOERR ; REPORT THE ERROR. JMP RPTRERR CHCKDEV2: CPD #$0007 ; IS IT LARGER THAN 7? BHI CHCKDEV3 STAB DEVNUM ; MAKE IT THE NEW DEVICE NUMBER. JSR RSKIPSPC ; SKIP SPACES. CMPA #EOLTOK ; IF THIS IS A PRINT STATEMENT, IS IT EOL? BEQ CHCKDEV4 ; YES. DON'T BUMP THE IP. INY ; BYPASS THE COMMA. JSR RSKIPSPC ; SKIP SPACES. CHCKDEV4: RTS ; RETURN. * * * RINRDC: JSR SKIPSPCS CMPA #EOL BNE RINRDC1 SEC RTS RINRDC1: BSR INNUMD JSR RSKIPSPC LDAA 0,Y CMPA #EOLTOK BEQ RINRDC2 CMPA #MEOLTOK BEQ RINRDC2 INY ; BUMP PAST THE COMMA. JSR RSKIPSPC BRA RINRDC RINRDC2: CLC RTS * * INNUMD: EQU * CMPA #'$' BNE INNUM2 JSR INCIBP JSR GETHEX BRA INNUM3 INNUM2: JSR INDECI INNUM3: EQU * * PSHD PSHB PSHA JSR SKIPSPCS CMPA #COMMA BEQ INNUM4 CMPA #EOL BEQ INNUM7 LDAA #MCOMAERR JMP RPTRERR INNUM4: JSR INCIBP INNUM7: JSR RVARPTR XGDX PULA PULB STD 0,X RTS * OUTSTR EQU * TSTB BEQ OUTSTR2 OUTSTR1 LDAA 0,X INX JSR OUTBYTE DECB BNE OUTSTR1 OUTSTR2 RTS * * INDECI: EQU * JSR GETCHR ; GET A CHARACTER. CMPA #'-' ; IS IT A NEGATIVE NUMBER? BNE INDECI1 ; NO. GO GET POSITIVE NUMBER. JSR INCIBP ; YES. BUMP INPUT BUFFER PAST IT. JSR GETDECI ; GET THE NUMBER. COMA ; NEGATE IT. COMB ADDD #1 RTS ; RETURN. INDECI1: JSR GETDECI RTS * * RREAD: EQU * LDX DATAPTR ; GET POINTER TO DATA. IS IT POINTING TO DATA? BNE RREAD1 ; YES. CONTINUE TO READ DATA. BSR RRESTOR ; NO. GO GET POINTER TO FIRST DATA STATEMENT. LDX DATAPTR ; GET POINTER TO DATA. RREAD1: STX IBUFPTR ; PUT IT IN THE INPUT BUFFER POINTER. JSR RINRDC ; GO USE INPUT/READ COMMON CODE. BCS RREAD2 ; IF CARRY SET, MORE DATA TO READ. LDX IBUFPTR ; GET POINTER TO DATA LINE. STX DATAPTR ; SAVE DATA POINTER FOR NEXT READ. RTS ; RETURN. RREAD2: PSHY ; SAVE Y. LDY IBUFPTR INY INY BSR RESTOR4 ; GO FIND NEXT "DATA" STATEMENT. PULY ; RESTORE Y. BRA RREAD ; KEEP READING DATA. * * RRESTOR: EQU * PSHY ; SAVE Y. LDY BASBEG ; START SEARCH FOR "DATA" STATEMENTS AT THE BEGIN. RESTOR2: PSHY ; SAVE POINTER TO THIS LINE. LDAB 2,Y ; GET LINE LENGTH. ABY ; GET START OF NEXT LINE. STY DATAPTR ; SAVE IN "DATAPTR". PULY ; RESTORE POINTER. LDAB #3 ABY ; POINT TO FIRST TOKEN IN LINE. JSR RSKIPSPC ; SKIP SPACES. LDAA 0,Y ; GET THE KEYWORD. CMPA #DATATOK ; IS IT A DATA LINE? BEQ RESTOR1 ; YES. GO SET UP POINTER. LDY DATAPTR ; GET ADDRESS OF NEXT LINE. RESTOR3: CPY BASEND ; ARE WE AT THE END OF THE PROGRAM? BNE RESTOR2 ; NO. KEEP LOOKING. LDAA #ODRDERR ; OUT OF DATA ERROR. JMP RPTRERR ; REPORT THE ERROR. RESTOR1: INY ; POINT PAST DATA TOKEN & THE DATA LENGTH. INY STY DATAPTR ; SAVE POINTER TO DATA. PULY ; RESTORE Y. RTS ; RETURN. * * RESTOR4: PSHY ; CALL TO COMPENSATE FOR PULL OF Y ON RETURN. BRA RESTOR3 * * RIF: EQU * JSR DONEXP ; GO DO A NUMERIC EXPRESSION. JSR RSKIPSPC ; SKIP SPACES. INY ; SKIP PAST "THEN" TOKEN. JSR RSKIPSPC ; SKIP SPACES AFTER THEN. JSR PULNUM ; GET RESULT OF EXPRESSION FROM OPERAND STACK. BEQ RIF1 ; NOT TRUE. SEE IF ELSE CLAUSE PRESENT. RIF3: JMP RGOTO ; RESULT WAS TRUE. GOTO PROPER LINE NUMBER. RIF1: LDAB #3 ; BUMP IP PAST LINE NUMBER. ABY JSR RSKIPSPC ; SKIP SPACES IF PRESENT. LDAA 0,Y ; GET NEXT TOKEN. CMPA #ELSETOK ; IS IT THE "ELSE" CLAUSE. BNE RIF2 ; NO RETURN. INY ; PASS ELSE TOKEN. JSR RSKIPSPC ; SKIP SPACES. BRA RIF3 ; DO A GOTO. RIF2: RTS ; RETURN. * * REEP: EQU * ; PROGRAM A WORD OF EEPROM. INY ; PASS UP THE OPEN PAREN. JSR RSKIPSPC ; PASS UP ANY SPACES. JSR DONEXP ; GO GET THE "SUBSCRIPT" OF THE EEPROM LOCATION. INY ; PASS UP THE CLOSING PAREN. INY ; PASS UP THE EQUALS TOKEN. JSR DONEXP ; GET VALUE TO FROGRAM INTO EEPROM. PSHY ; SAVE THE Y REG. LDY NUMSTACK ; POINT TO THE NUMERIC STACK. LDD 2,Y ; GET THE SUBSCRIPT FOR THE EEPROM LOCATION. BMI REEP1 ; NEGATIVE SUBSCRIPTS NOT ALLOWED. CPD #MAXEESUB ; IS THE SUBSCRIPT WITHIN RANGE? BLS REEP2 ; YES. CONTINUE. REEP1: LDAA #EESUBERR ; EEPROM SUBSCRIPT ERROR. JMP RPTRERR ; REPORT IT. REEP2: LSLD ; MULT THE SUBSCRIPT BY 2. ADDD #EEPBASAD ; ADD IN THE EEPROM BASE ADDRESS. XGDX ; PUT THE ADDRESS INTO X. LDAA 0,X ; GET THE MOST SIGNIFIGANT BYTE OF THE CURRENT NUM. CMPA #$FF ; DOES IT NEED ERASING? BEQ REEP3 ; NO. SEE IF NEXT BYTE NEEDS ERASING. BSR ERASEBYT ; YES. GO ERASE IT. REEP3: INX ; POINT TO NEXT BYTE. LDAA 0,X ; GET NEXT BYTE. CMPA #$FF ; DOES THIS BYTE NEED TO BE ERASED? BEQ REEP4 ; NO. GO WRITE DATA TO EEPROM. BSR ERASEBYT ; YES. GO ERASE THE BYTE. REEP4: LDAA 1,Y ; GET LS BYTE OF WORD. BSR PROGBYTE ; GO PROGRAM THE BYTE. DEX ; POINT TO THE MOST SIGNIFIGANT EEPROM LOCATION. LDAA 0,Y ; GET THE MS BYTE OF THE WORD. BSR PROGBYTE ; GO PROGRAM THE BYTE. PULY ; RESTORE Y. JSR PULNUM ; FIX UP NUM STACK. JSR PULNUM RTS ; RETURN. * * ERASEBYT: EQU * PSHY LDY IOBaseV ; Point to the base address of the I/O Registers. LDAB #$16 ; SET UP BYTE ERASE MODE, ADDR LATCH, ERASE STAB PPROG,Y ; VOLTAGE OFF. STAA 0,X ; LATCH ADDRESS. TPA ; GET CURRENT I-BIT STATUS. PSHA ; SAVE IT. SEI ; INHIBIT INTERRUPTS WHILE ERASING. LDAB #$17 ; TURN ON ERASE VOLTAGE STAB PPROG,Y BSR DLY10MS ; DELAY ABOUT 10 MS. LDAB #$16 ; TURN PROGRAMING VOLTAGE OFF. STAB PPROG,Y PULA ; GET ORIGINAL I-BIT STATUS. TAP ; RESTORE IT. CLR PPROG,Y PULY RTS ; RETURN. * * PROGBYTE: EQU * PSHY LDY IOBaseV ; Point to the base address of the I/O Registers. PROGBYT2: LDAB #$02 ; SET UP NORMAL PROGRAMING MODE, ADDRESS/DATA STAB PPROG,Y ; LATCHED, PROGRAMING VOLTAGE OFF. STAA 0,X ; LATCH DATA & ADDRESS. PSHA ; SAVE THE DATA FOR COMPARE AFTER PROGRAMING. TPA ; GET CURRENT I-BIT STATUS. PSHA ; SAVE IT. SEI ; INHIBIT INTERRUPTS WHILE PROGRAMING. LDAB #$03 ; TURN ON PROGRAMING VOLTAGE. STAB PPROG,Y BSR DLY10MS ; LEAVE IT ON FOR 10 MS. LDAB #$02 ; NOW, TURN THE PROGRAMMING VOLTAGE OFF. STAB PPROG,Y PULA ; GET ORIGINAL I-BIT STATUS. TAP ; RESTORE IT. CLR PPROG,Y ; PUT THE EEPROM BACK IN THE READ MODE. PULA ; RESTORE THE DATA TO SEE IF IT WAS PROGRAMMED. CMPA 0,X ; WAS THE DATA WRITTEN PROPERLY? BNE PROGBYT2 ; NO. TRY AGAIN. PULY ; Restore Y. RTS ; YES. RETURN. * * DLY10MS: EQU * PSHX ; SAVE X. LDX #3330 ; GET DELAY CONSTANT. DLY10MS1: DEX ; DECREMENT THE COUNT. DONE? BNE DLY10MS1 ; NO. DELAY SOME MORE. PULX ; RESTORE X. RTS ; RETURN. * * RINBYTE: EQU * JSR CHCKDEV ; GO CHECK FOR AN ALTERNATE DEVICE DESIGNATION. JSR RVARPTR ; GO GET POINTER TO THE BYTE INPUT VARIABLE. XGDX ; PUT THE POINTER INTO X. JSR INBYTE ; GO GET A BYTE FROM THE SPECIFIED INPUT DEVICE. TAB ; PUT THE BYTE IN THE L.S.BYTE. CLRA ; ZERO THE UPPER BYTE. STD 0,X ; PUT IT IN THE VARIABLE. CLR DEVNUM ; RESET TO DEVICE #0. RTS ; RETURN. * * RTIME: EQU * INY ; POINT PAST THE EQUALS TOKEN. JSR DONEXP ; GO EVALUATE THE EXPRESSION. JSR PULNUM ; GET THE NUMBER OFF THE STACK. STD TIMEREG ; PUT IT IN THE TIME REGISTER. RTS ; RETURN. * * RRTIME: equ * sei ; disable interrupts. LDAA #SWPRE+1 ; ADD 1 TO NORMAL PRE SCALER. STAA TIMEPRE ; SET UP THE SOFTWARE PRESCALER. LDX IOBaseV ; Point to the I/O Base Address. ldd TCNT,x ; get the current value of the timer counter. jsr TIMINTS3 ; go initialize the TOC using the timer interrupt code. clra clrb STD TIMEREG ; PUT IT IN THE TIME REGISTER. cli RTS ; RETURN. * * RPACC: EQU * INY ; POINT PAST EQUALS TOKEN. JSR DONEXP ; EVALUATE THE EXPRESSION. JSR PULNUM ; GET THE NUMBER OFF THE STACK. TSTA ; IS THE NUMBER WITHIN RANGE? BEQ RPACC1 ; YES. GO SETUP THE PACC REGISTER. LDAA #PACCARGE ; NO. REPORT AN ERROR. JMP RPTRERR RPACC1: LDX IOBaseV STAB PACNT,X ; PUT NUMBER IN PULSE ACC. RTS ; RETURN. * * RONTIME: EQU * BSR CHCKIMID ; NOT ALLOWED IN IMMIDIATE. JSR DONEXP ; GO EVALUATE THE TIME "MATCH" EXPRESSION. JSR PULNUM ; GET THE NUMBER OFF THE STACK. STD TIMECMP ; PUT IN THE COMPARE REGISTER. JSR RSKIPSPC ; SKIP SPACES. INY ; PASS UP COMMA. JSR RSKIPSPC ; SKIP SPACES. STY ONTIMLIN ; SAVE THE POINTER TO THE LINE NUMBER. BRA RONIRQ2 ; GO FINISH UP. * * RONIRQ: EQU * BSR CHCKIMID JSR DONEXP ; GO CHECK TO SEE IF WE ARE TO ENABLE OR DISABLE. JSR RSKIPSPC ; SKIP SPACES UP TO COMMA. INY ; BYPASS COMMA. JSR RSKIPSPC ; SKIP SPACES UP TO LINE NUMBER. JSR PULNUM ; GET MODE. SHOULD WE ENABLE THE FUNCTION? BNE RONIRQ1 ; YES. STD ONIRQLIN ; NO. MAKE THE LINE NUMBER 0. BRA RONIRQ2 ; GO FINISH UP. RONIRQ1: STY ONIRQLIN ; SAVE THE POINTER TO THE LINE NUMBER, RONIRQ2: LDAB #3 ; MOVE IP PAST THE LINE NUMBER. ABY RTS ; RETURN. * * RRETI: EQU * BSR CHCKIMID TPA ; CHECK TO SEE IF THE INTERRUPT MASK IS SET. BITA #$10 ; ARE WE IN AN INTERRUPT ROUTINE? BNE RRETI1 ; SINCE THE IRQ MASK IS SET WE MUST BE. LDAA #NOTINTER ; NO. FLAG AN ERROR. JMP RPTRERR ; GO REPORT IT. RRETI1: LDD SCURLINE ; RESTORE THE MAIN PROGRAM CURRENT LINE. STD CURLINE LDD SADRNXLN ; RESTORE MAIN PROGRAM "ADDRESS OF THE NEXT LINE". STD ADRNXLIN INS ; TAKE THE RETURN ADDRESS OFF THE STACK. INS RTI ; GO BACK TO WHERE WE LEFT OFF. * * CHCKIMID: EQU * TST IMMID ; ARE WE IN THE IMMIDIATE MODE? BEQ CHCKIMI1 ; NO. JUST RETURN. LDAA #NOTALERR ; YES. THIS COMMAND NOT ALLOWED. JMP RPTRERR ; REPORT THE ERROR. CHCKIMI1: RTS ; RETURN. * * RONPACC: EQU * BSR CHCKIMID ; THIS INSTRUCTION NOT ALLOWED IN IMMID MODE. JSR DONEXP ; GO EVALUATE THE COUNT MODE EXPRESSION. JSR RSKIPSPC ; SKIP SPACES. INY ; BYPASS THE COMMA. JSR RSKIPSPC ; SKIP SPACES AFTER COMMA. JSR DONEXP ; GO EVALUATE THE INTERRUPT MODE EXPRESSION. JSR RSKIPSPC ; SKIP SPACES. INY ; BYPASS THE COMMA. JSR RSKIPSPC ; SKIP SPACES AFTER THE COMMA. TPA ; GET CURRENT I-BIT STATUS. PSHA ; SAVE IT. SEI ; INHIBIT INTERRUPTS. STY ONPACLIN ; SAVE POINTER TO INTERRUPT ROUTINE. JSR PULNUM ; GET INTERRUPT MODE OFF STACK. RONPACC1: CPD #1 ; IS THE ARGUMENT <=1? BLS RONPACC2 ; YES. ARG. OK. RONPACC5: LDAA #INTMODER ; NO. GET ERROR CODE. JMP RPTRERR RONPACC2: LDAA #$10 ; GET BIT TO ENABLE INTERRUPT. TSTB ; WAS THE ARGUMENT 0? BEQ RONPACC3 ; YES. GO ENABLE INTS. ON EACH COUNT. LSLA ; NO. ENABLE INTS. ON PACC OVERFLOW ONLY. RONPACC3: LDX IOBaseV STAA TMSK2,X JSR PULNUM ; GET THE COUNT MODE OFF THE STACK. BNE RONPACC4 ; GO SET THE MODE IF NOT 0. LDX IOBaseV CLR PACTL,X ; TURN OFF THE PULSE ACCUMULATOR. STD ONPACLIN ; CLEAR POINTER TO LINE NUMBER. BRA RONPACC6 ; GO CLEAN UP & RETURN. RONPACC4: CPD #4 ; IS THE ARGUMENT IN RANGE? BHI RONPACC5 ; YES. REPORT AN ERROR. ADDB #3 ; GET BIT TO ENABLE PACC. LSLB LSLB LSLB LSLB LDX IOBaseV STAB PACTL,X ; ENABLE THE PACC & SET MODE. RONPACC6: PULA ; GET OLD I-BIT STATUS OFF STACK. TAP ; RESTORE OLD STATUS. LDAB #3 ABY ; PASS UP LINE NUMBER. RTS ; RETURN. * *