BASICI IDT TITL 'T.I. 99/4A BASIC INTERPRETER' * ************************************************** * * MEMORY ALLOCATION IS GIVEN IN THE GPL AND FPT * ************************************************** * * DEFINTIONS FOR GPL INTERPRETER * DEF PARSEG,CONTG,EXECG,RTNG * * DEFINTIONS FOR FPT PACK * DEF SYMB,SMBB,ASSGNV,FBSYMB DEF VPUSHG,VPOP,PGMCH,POPSTK * * REFERENCES INTO GPL ROM FROM BASIC INT. * C020 EQU >0020 RESET EQU S+>6A SET EQU S+>CE GETSTK EQU S+>842 PUTSTK EQU S+>864 HX0002 EQU S+>072 * * REFS INTO FPT ROM FROM BASIC INT. * SMULT EQU S+>E8C CSNGR EQU S+>11A2 SADD EQU S+>0D84 SCOMPB EQU S+>0D42 SSUB EQU S+>0D74 SDIV EQU S+>0FF8 CFI EQU S+>12B8 * *EQUATES * VWDOFF EQU -2 VDP WRITE DATA OFFSET (FROM R15) GRAOFF EQU 2 GROM READ ADDRESS OFFSET (FROM R13) GWDOFF EQU >400 GROM WRITE DATA OFFSET (FROM R13) VRSOFF EQU ->400 VDP READ STATUS OFFSET (FROM R15) GWAOFF EQU >402 WRITE ADDRESS OFFSET(FROM R13) VRDOFF EQU ->402 VDP READ DATA OFFSET (FROM R15) WRVDP EQU >4000 WRITE BIT FOR VDP SGCADR EQU >8400 SOUND CHIP * * RAM EQUATES * PAD EQU >8300 START OF 256 BYTES OF RAM BYTE EQU PAD+>0C USED FOR CALL TO GETSTR PROA EQU PAD+>10 PROCESSOR ROLL OUT AREA STREND EQU PAD+>1A END OF STRING PTR SREF EQU PAD+>1C TEMP STRING PTR 1 ERRCOD EQU PAD+>22 RETURN CODE FROM EXEC STVSPT EQU PAD+>24 BASE OF VALUE STACK (-8) RTNADD EQU PAD+>26 ADR. TO RTN TO IN GPL NUDTAB EQU PAD+>28 PTR TO NUD TABLE EXTRAM EQU PAD+>2E LINE BUFFER POINTER PGMPTR EQU PAD+>2C STLN EQU PAD+>30 LAST LINE PTR IN L.N. BUFFER ENLN EQU PAD+>32 1ST LINE PTR IN L.N. BUFFER SYMTAB EQU PAD+>3E SYMBOL TABLE POINTER * EQU PAD+>40 PTR TO HIGHEST FREE BYTE OF ... CHAT EQU PAD+>42 CURRENT CHAR BASE EQU PAD+>43 OPTION BASE BUFFY EQU PAD+>44 IMPERATIVE INDICATOR FAC EQU PAD+>4A FLOATING ACCUMULATOR FDVSR EQU FAC+10 DIVISOR STORE DURING DIVISION * ALSO INSTRUCTION SAVE INDEX SCLEN EQU PAD+>55 ARG EQU PAD+>5C FLOATING ARGUMENT * ALSO FLTERR ERROR ADR. FOR MATH ROUTINES TEMP2 EQU PAD+>6C TYPE EQU PAD+>6D VSPTR EQU PAD+>6E VALUE STACK POINTER STKDAT EQU PAD+>72 STKADD EQU PAD+>73 PLAYER EQU PAD+>74 KEYBRD EQU $ SIGN EQU PAD+>75 TEMP SIGN STORE JOYY EQU $ EXP EQU PAD+>76 TEMP EXP. STORE JOYX EQU PAD+>77 RANDOM EQU PAD+>78 TIME EQU PAD+>79 TIME MOTION EQU PAD+>7A VDPST EQU PAD+>7B VDP STATUS STATUS EQU PAD+>7C STATUS REGISTER CHRBUF EQU PAD+>7D YPT EQU PAD+>7E XPT EQU PAD+>7F FLAG EQU PAD+>88 BASIC TRACE FLAG GROMFG EQU PAD+>89 GROM/VDPRAM (0) FLAG STKEND EQU PAD+>BA END OF SUBROUTINE STACK(2 SPARE ENTRIES) * WKSC EQU PAD+>C0 INT. 1 WORKSPACE RAND16 EQU PAD+>C0 SEED FOR RANDOM NO. HHREG EQU PAD+>C2 INPUT CHAR (/4 ONLY?) DEB EQU PAD+>CA DEBOUNCE KEY SAVEG EQU PAD+>CB SAVE GROM ADR. OF HEADER STFLGS EQU PAD+>CE NO. OF SOUND BYTES SAVVDP EQU WKSC+R12+R12 CRULST EQU PAD+>D0 R8, INT WKS SADDR EQU PAD+>D2 RSAVE EQU PAD+>D8 SAVE R11 IN SCAN ROUTINE WKSE EQU PAD+>E0 MAIN WORKSPACE * R0LSB EQU WKSE+R0+R0+1 R1LSB EQU WKSE+R1+R1+1 R3LSB EQU WKSE+R3+R3+1 R4LSB EQU WKSE+R4+R4+1 R5LSB EQU WKSE+R5+R5+1 R6LSB EQU WKSE+R6+R6+1 R7LSB EQU WKSE+R7+R7+1 R9LSB EQU WKSE+R9+R9+1 R11LSB EQU WKSE+R11+R11+1 * VDPREG EQU >8000 * GR EQU >9800 GROM READ (DATA) VDPRD EQU >8800 VDP READ DATA VRS EQU >8802 VDP READ STATUS VWD EQU >8C00 VDP WRITE DATA VWA EQU >8C02 VDP WRITE ADDRESS * * MISC. EQUATES * CONCAT EQU 8 CONCATENATE (&) STRINGS BRKFL EQU 1 BRKPNT RTN VECTOR NUDD2 EQU 6 FUNCTION REFERENCE * * ERROR CODES * ERRSN EQU >0003 SYNTAX ERROR ERROM EQU >0103 OUT OF MEMORY ERRIOR EQU >0203 ERRLNF EQU >0303 LINE NOT FOUND ERREX EQU >0403 EXECUTION ERROR ERRBS EQU >0503 BAD SUBSCRIPT ERRTM EQU >0603 STRING/NUMBER MISMATCH * * TOKEN DEFINITIONS * ELSE$ EQU >81 GO$ EQU >85 GOTO$ EQU >86 GOSUB$ EQU >87 LET$ EQU >8D SUB$ EQU >A1 THEN$ EQU >B0 TO$ EQU >B1 COMMA$ EQU >B3 RPAR$ EQU >B6 LPAR$ EQU >B7 CONC$ EQU >B8 CONCATENATE (&) EQ$ EQU >BE GT$ EQU >C0 MINUS$ EQU >C2 DIVI$ EQU >C4 EXPON$ EQU >C5 LN$ EQU >C9 * S EQU 0 AORG S+>15D4 HX6500 DATA >6500 * * ENTRY TO FIND BASIC SYMBOL ENTRY FOR GPL * FBSYMB BL @FBS CALL SUBROUTINE DATA RESET IF NOT FOUND B @SET IF FOUND * * ENTRY TO FIND BASIC SYMBOL FOR ASSEMBLY LANGUAGE * CALL = BL @FBS * DATA NOTFOUND * R4 = SYMBOL TABLE ENTRY ADDRESS RETURN * R8 - NOT DESTROYED * FBS MOV @SYMTAB,R4 GET TABLE POINTER JEQ FBS006 IF TABLE IS EMPTY MOVB @FAC+15,R3 LENGTH OF DESIRED SYMBOL CLR R7 CLEAR COUNTER (MS BYTE) FBS002 INC R4 POINT TO LENGTH BYTE OF ENTRY MOVB @R4LSB,*R15 LOAD VDP ADR. NOP MOVB R4,*R15 LI R10,VDPRD SET UP VDP READ CB *R10,R3 COMPARE LENGTH OF NAMES JEQ FBS010 IF SAME, THEN COMPARE MOVB *R10,R6 NOT THE SAME NOP MOVB *R10,@R6LSB GET LINK TO NEXT ENTRY FBS004 MOV R6,R4 TRANSFER LINK AND TEST JNE FBS002 LOOP IF NOT END OF TABLE FBS006 MOV *R11,R11 END OF TABLE, GET VECTOR RT * * LENGTH MATCHES, COMPARE NAMES * FBS010 MOVB *R10,R6 GET LINK IN CASE NOP MOVB *R10,@R6LSB OF NO NAME MATCH NOP MOVB *R10,R5 GET POINTER TO NAME MOVB R3,@R7LSB GET LENGTH TO COUNT MOVB *R10,R2 MOVB R2,*R15 NOP MOVB R5,*R15 LI R2,FAC STRING POINTER FBS014 CB *R10,*R2+ COMPARE A BYTE JNE FBS004 NOT EQ, TRY NEXT ENTRY IN T DEC R7 COUNT CHARS JGT FBS014 MORE LEFT, LOOP DEC R4 ADJUST TABLE POINTER MOV R4,@FAC SAVE FOR GPL B @2(R11) RTN, BYPASS NOT FOUND ENTRY * * GPL ENTRY FOR VPUSH TO TAKE ADVANTAGE OF COMMON CODE * VPUSHG LI R6,VPUSH JMP SMBB10 * * SCREWY ENTRY POINT FOR ASSGNV TO TAKE ADVANTAGE OF COMMON * CODE. DON'T EVEN TRY TO FOLLOW IT * ASSGNV LI R6,ASSG JMP SMBB10 * * BASIC ENTRY FOR "SYM" * SYMB LI R6,SYM JMP SMBB10 * * SUBROUTINE TO FIND THE PTR TO VARIABLE SPACE OF EACH ELEMENT * OF SYMBOL TABLE ENTRY. DECIDES WHETHER SYMBOL TABLE ENTRY * POINTED TO BY FAC,FAC+1 IS A SIMPLE VARIABLE, STRING VARIABLE * OR ARRAY VARIABLE, AND RETURNS PROPER 8-BYTE BLOCK IN FAC * THRU FAC+7 * SMBB LI R6,SMB SMBB10 MOV R11,R7 BL @PUTSTK SAVE GROM ADR BL @SETREG INCT R9 MOV R7,*R9 BL *R6 MOV *R9,R7 DECT R9 BL @SAVREG SAVE REGS FOR GETSTK BL @GETSTK RESTORE GROM ADR B *R7 * = BL SMB INCT R9 MOV R11,*R9 MOV @FAC,@FAC+4 A @HX0006,@FAC+4 BL @D9F6 RETURNS STATUS OF CHAR. JLT SMB050 IF MSB SET, STRING CLR @FAC+2 CI R8,LPAR$*256 LEFT PARENTH? JEQ SMB020 SMB010 MOV *R9,R11 RETURN DECT R9 RT SMB050 CI R8,LPAR$*256 LEFT PAREN? JEQ SMB020 YES, PROCESS AS STRING ARRAY SMB51 MOV @HX6500,@FAC+2 INDICATE A STRING MOV @FAC+4,R3 GET STRING POINTER ADR MOV R3,@FAC SAVE POINTER TO POINTER BL @GETV1 INDIRECT THRU SYMBOL TABLE MOVB @VDPRD,@R1LSB 2ND BYTE TOO MOV R1,@FAC+4 SAVE PTR TO VALUE MOV R1,R3 NO VALUE ASSIGNED? JEQ SMB57 RIGHT- LENGTH IS ZERO DEC R3 POINT AT LENGTH BYTE BL @GETV1 READ VDP TO R1 MSB FROM ADR IN R3 SRL R1,8 SMB57 MOV R1,@FAC+6 STRING LENGTH JMP SMB010 RETURN * HX0007 DATA >0007 * * *R1 STILL CONTAINS THE 1STT BYTE FROM SYMBOL TABLE ENTRY * SMB020 SLA R1,5 SRL R1,13 GET DIMENSIONED FIELD MOV R1,@FAC+2 DIM. COUNTER INIT'D TO MAX * * FAC+4,FAC+5 ALREADY POINT TO 1ST DIM. MAXIMA IN SYMBOL TABLE * CLR R2 CLR INDEX ACCUMULATOR SMB025 MOV R2,@FAC+6 SAVE ACC. IN FAC BL @PGMCHR GET NEXT CHAR BL @PSHPRS PUSH AND PARSE BYTE LPAR$,0 CB @FAC+2,@HX6500 CAN'T BE STRING JHE ERR1 * ------ NOW DO FLOAT TO INTEGER CONVERSION CLR @FAC+10 BL @CFI GET 2 BYTE INTEGER IN FAC, FAC+ MOVB @FAC+10,R4 ERROR? JNE ERR3 ERROR MOV @FAC,R5 SAVE INDEX JUST READ BL @VPOP RESTORE FAC BLOCK BL @GETV DATA FAC+4 R1 NOW HAS DIM. MAX MOVB @VDPRD,@R1LSB C R5,R1 INDEX JH ERR3 INDEX OUT OF BOUNDS MOVB @BASE,R4 R4 NOW HAS OPTION BASE JEQ SMB040 IF BASE=0, INDEX=0 OS OK DEC R5 ADJUST BASE 1 INDEX JLT ERR3 BETTER NOT HAVE BEEN 0 JMP SMB041 SMB040 INC R1 ADJUST SIZE IF BASE 0 SMB041 MPY @FAC+6,R1 R1,R2 HAS ACCUM*MAX DIM A R5,R2 ADD LATEST INDEX TO ACC. INCT @FAC+4 INC THE DIM. PTR DEC @FAC+2 DEC 'REMAINING' DIM COUNT JEQ SMB070 NONE LEFT, EXIT CI R8,COMMA$*256 MUST BE A COMMA JEQ SMB025 YES, LOOP FOR MORE ERR1 B @ERRSYN NO, SYNTAX ERROR * * AT THIS POINT THE REQD NO. OF DIM'S HAVE BEEN SCANNED * R2 CONTAINS THE INDEX * R4 POINTS TO THE 1ST ARRAY ELEMENT * SMB070 CI R8,RPAR$*256 MUST BE AT ")" JNE ERR1 BL @PGMCHR GET THING AFTER ")" BL @GETV CHECK STRING ARRAY DATA FAC JLT SMB71 IS A STRING ARRAY SLA R2,3 MPY INDEX BY 8 A R2,@FAC+4 ADD INTO BEGINING OF VALUES P JMP SMB010 RTN SMB71 SLA R2,1 MPY INDEX BY 2 A R2,@FAC+4 ADD INTO BEGINING OF VALUES P JMP SMB51 RTN * ERR3 LI R0,ERRBS ERRX B @ERR EXIT TO GPL * ERRT LI R0,ERRTM JMP ERRX * * SUBROUTINE TO PUT SYMBOL NAME AND ITS POINTER TO * VARIABLE SPACE AND ITS ARGUMENT'S LIMIT(S) IF ANY, * ON THE VALUE STACK * * * SYMBOL ROUTINE (9900 ENTRY) * SYM CLR @FAC+15 CHARACTER COUNTER LI R2,FAC MOV R11,R1 SAVE LINK BACK SYM1 MOVB R8,*R2+ STORE THE CHAR INC @FAC+15 COUNT IT BL @PGMCHR GET NEXT CHAR JGT SYM1 LEGAL SYMBOL NAME BL @FBS DATA ERR1 NOT FOUND B *R1 RTN * * SUBROUTINE CALLABLE FROM GPL OR 9900 CODE, TO ASSIGN A * VALUE TO A SYMBOL (STRING OR NUMERIC). IF NUMERIC, THE 8- * BYTE VALUE IS IN FAC. IF STRING, THE 8-BYTE DESCRIPTOR * IS IN FAC. THE DESCRIPTOR BLOCK(8 BYTES) FOR THE DEST'N * VARIABLE IS ON THE STACK. * * CRITICAL NOTE: BECAUSE OF THE BL @POPSTK BELOW, IF A * STRING ENTRY IS POPPED AND A GARBAGE COLLECTION HAS TAKEN * PLACE SINCE THE ENTRY WAS PUSHED, THE POINTER IN FAC+4,5 IS * MOST LIKELY MESSED UP. A BL @VPOP WOULD HAVE TAKEN CARE OF * THE PROBLEM BUT WOULD HAVE TAKEN A LOT OF EXTRA CODE. * THEREFORE, AT ASSG50-ASSG54 IT IS ASSUMED THAT THE PREVIOUS * VALUE ASSIGNED TO THE DESTINATION HAS BEEN MOVED AND THE * POINTER MUST BE RESET BY GOING BACK INTO THE SYMBOL TABLE * AND GETTING THE CORRECT POINTER TO THE STRING. * ASSG MOV R11,R10 SAVE RTN BL @POPSTK TAKE 2ND ENTRY TO VPOP SO IT * POPS 8 BYTES TO ARG BL @GETV GET VRAM(ARG) INTO R1; THIS D792 DATA ARG IS THE 1ST BYTE OF SYM. TAB. CB @ARG+2,@HX6500 STRING? JEQ ASSG50 IF STRING, GO HANDLE IT CB @FAC+2,@HX6500 SOURCE IS A STRING? JHE ERRT IS SO, SYNTAX ERROR(DEST IS NUM) * ------ AT THIS POINT, FAC+0...7 HAS NUMERIC VALUE LI R2,8 (TRANSFER COUNT) JMP ASSG70 GOTO COMMON CODE TO WRITE TO VRAM * * STRING HANDLER * ASSG50 CB @FAC+2,@HX6500 IS SOURCE A STRING? JNE ERRT DEST IS STRING, SOURCE IS NOT MOV @ARG+4,R1 GET DESTN PTR JEQ ASSG54 NO, NEVER ASSIGNED * PREVIOUSLY ASSIGNED, MUST FIRST GARBAGE OLD VALUE BL @GETV CORRECT FOR POPSTK ABOVE D7BC DATA ARG MOVB @VDPRD,@R1LSB GET BOTH BYTES OF STRING PTR MOV R1,@ARG+4 CORRECT ARG+4,5 TOO C R1,@FAC+4 (NOT IN /4) JEQ D7FC CLR R6 BL @STVDP3 ASSG54 MOV @FAC+6,R4 NULL STRING? JEQ ASSG57 YES MOV @FAC,R3 GET ADDR OF SOURCE PTR CI R3,SREF-PAD GOT A TEMP STRING? JNE ASSG56 NO, MORE COMPLICATED MOV @FAC+4,R4 PICK UP DIRECT PTR TO STRING * * COMMON CODE TO SET FORWARD AND BACK POINTERS * ASSG55 MOV @ARG,R6 PTR TO SYMBOL TABLE PTR MOV R4,R1 PTR TO STRING BL @STVDP3 SET THE BACK PTR ASSG57 MOV @ARG,R1 ADR OF S. T. PTR MOV R4,R6 PTR TO STRING BL @STVDP SET THE FOWARD PTR D7FC B *R10 RTN * * SYMBOL TO SYMBOL ASSIGNMENT OF STRINGS * ASSG56 MOV @FAC+6,@BYTE FETCH LENGTH FOR GETSTR MOV @HX0007,@ERRCOD GETSTR CODE * NOTE FAC THRU FAC+7 CANNOT BE DESTROYED BL @VPUSH MOV R10,@FAC SAVE RTN LINK BL @CALGPL DO THE GET STRING HX0006 DATA 6 DUMMY FOR RETURN MOV @FAC,R10 RESTORE RTN LINK BL @VPOP * * PREPARE TO COPY THE SOURCE STRING INTO THE DESTINATION * MOV @FAC+4,R3 R3 IS NOW COPY FROM MOV @SREF,R5 R5 IS NOW COPY TO MOV R5,R4 SAVE FOR PTR SET * REGISTERS TO BE USED IN THE COPY * R1 - USED FOR A BUFFER * R2 NO. OF BYTES TO BE MOVED * R3 COPY FROM * R5 COPY TO * MOV @FAC+6,R2 FETCH THE LENGTH ORI R5,WRVDP ASSG59 BL @GETV1 READ VDP TO R1 MSB FROM ADR IN R3 MOVB @R5LSB,*R15 LOAD THE ADR. NOP MOVB R5,*R15 INC R5 MOVB R1,@VWD PUT THE DATA INC R3 DEC R2 FINISHED? JGT ASSG59 NO JMP ASSG55 YES, NOW SET PTRS * COMMON CODE TO WRITE TO RAM ASSG70 MOV @ARG+4,R5 DEST PTR (R5) MOVB @R5LSB,*R15 ORI R5,WRVDP MOVB R5,*R15 LI R4,FAC BUFFER PTR ASSG75 MOVB *R4+,@VWD DEC R2 JGT ASSG75 B *R10 RTN FROM ASSGNV ***************************** PGMCH MOV R11,R12 BL @PUTSTK TO MAKE GROM BASIC PGMS WORK BL @PGMCHR GET NEXT TOKEN MOVB R8,@CHAT SAVE FOR GPL BL @GETSTK RESTORE GROM ADR B *R12 RTN TO INTERPRETER ***************************** * = BL, REQUIRES DATA STATEMENT IN CALL GETV MOV *R11+,R3 MOV *R3,R3 * = BL * WRITE ADDRESS IN R3 TO VDP, READ A BYTE TO R1 MSB * GETV1 MOVB @R3LSB,*R15 NOP MOVB R3,*R15 NOP MOVB @VDPRD,R1 RT * = BL MOVFAC MOVB @FAC+5,*R15 LI R2,8 MOVB @FAC+4,*R15 LI R3,FAC MOVF1 MOVB @VDPRD,*R3+ DEC R2 JGT MOVF1 RT * = BL STVDP3 AI R1,-3 POINT AT BACK PTR * = BL STVDP MOVB @R1LSB,*R15 LOAD THE ADR ORI R1,WRVDP MOVB R1,*R15 NOP MOVB R6,@VWD PUT THE DATA MOVB @R6LSB,@VWD BOTH BYTES RT ******************************************** * * BASIC PARSE CODE * * REGISTER USAGE: * RESERVED FOR GPL INTERPRTER: R13,R14,R15 * R13 CONTAINS THE READ ADR. FOR GROM * R14 IS USED IN BASSUP/10 FOR THE VDPRAM PTR * RESERVED IN BASIC SUPPORT * R8 MSBy CURRENT CHAR (LIKE CHAT IN GPL) * R8 LSBy ZERO * R9 STACK PTR PAD+@STKADD * R10 READ DATA PORT ADR. FOR PGM DATA * ALL EXITS TO GPL MUST GO THROUGH "NUDG05" * EXRTNA DATA EXRTN * * GRAPHICS LANGUAGE ENTRY TO "PARSE" * PARSEG BL @SETREG MOVB @2(R13),R11 MOVB @2(R13),@R11LSB AI R11,>7FFF ADD MSBY -1 * * 9900 ENTRY TO PARSE * * = BL PARSE INCT R9 PUT RTN ADR. ON STACK CI R9,STKEND STACK FULL? JH P20 MOV R11,*R9 * = B *R0 P05 MOVB R8,R7 TEST CURRENT CHAR JLT P10 B @PSYM IF NOT TOKEN P10 BL @PGMCHR GET NEXT CHAR HX0977 EQU $ 1 BYTE CONSTANT '9' SRL R7,7 CHANGE LAST CHAR TO OFFSET AI R7,->B7*2 CI R7,NTABLN JH CONT15 MOV @NTAB(R7),R7 GET NUD ADR. JGT B9985 IF 9985 CODE P17 ANDI R7,>7FFF IF GPL CODE, GET RID OF MSB A @NUDTAB,R7 ADD IN TABLE ADR. NUDG05 BL @SAVREG RESTORE GPL PTRS MOVB R7,@GWAOFF(R13) MOVB @R7LSB,@GWAOFF(R13) B @RESET GO BACK TO GPL * P20 B @VPSH23 * * CONTINUE ROUTINE FOR PARSE * CONTG BL @SETREG CONT MOV *R9,R6 GET LAST ADR FROM STACK JGT CONT10 990 CODE IF NOT REG ANDI R6,>7FFF GET GROM ADR MOVB R6,@GWAOFF(R13) MOVB @R6LSB,@GWAOFF(R13) MOV R13,R6 CONT10 CB *R6,R8 TEST PRECEDENCE JHE NUDEND CI R8,CONC$*256 CONCATENATE (&)? JEQ CONT20 YES, CHEAT ON TABLES SRL R8,7 TABLE OFFSET AI R8,->BE*2 MIN TOKEN FOR LED (*2) CI R8,LTBLEN MAX TOKEN FOR LED (*2) CONT15 JH ERRSYN MOV @LTAB(R8),R7 CLR R8 BL @PGMCHR GET NEXT CHAR B9985 B *R7 GO TO ROUTINE CONT20 LI R0,CONCAT GO TO GRAPHICS JMP ERR * NUDE10 DECT R9 BACK UP STACK AI R7,>8001 GET RID OF GROM FLAG AND * SKIP OVER PRECEDENCE JMP NUDG05 MERGE WITH OTHER CODE TO RTN * * EXECUTE ONE OR MORE LINES OF BASIC * * = BR TABLE EXECG BL @SETREG CLR @ERRCOD MOV @BUFFY,R0 IMPERATIVE? JEQ EXEC15 YES EXEC10 LIMI 3 LET INTERRUPTS LOOSE LIMI 0 CLR @WKSC+R11+R11 RESET VDP TIME-OUT BL @C020 **** DIFFERS ON /4 JEQ BRKPN1 MOVB @FLAG,R0 TEST TRACE FLAG SLA R0,3 JLT TRACE EXEC11 MOV @EXTRAM,@PGMPTR GET LINE PTR BL @PGMCHR JLT BRKPNT EXEC14 MOVB R8,@PGMPTR MOVB *R10,@PGMPTR+1 GET SECOND BYTE OF PTR EXEC15 INCT R9 SAVE A RTN ADR MOV @EXRTNA,*R9 BL @PGMCHR GET 1ST CHAR JLT EXEC20 TOKEN B @NLET NO, FAKE "LET" EXEC20 MOV R8,R7 SAVE 1ST TOKEN BL @PGMNXT GET 2ND TOKEN SRL R7,7 GET TABLE OFFSET AI R7,->A2*2 -VE OR ZERO VALUES ONLY JGT ERRSYN MOV @STMTTB(R7),R7 GET BRANCH ADR JLT P17 IF GROM CODE B *R7 IF 9900 CODE * EXRTN BYTE 0 CBH65 BYTE >65 UNUSED BYTE FOR CONSTANT * ENTRY NOT KNOWN MOV @BUFFY,R0 IMPERATIVE MODE? JEQ EXEC50 YES S @HX0004,@EXTRAM NO, GO TO NEXT LINE C @EXTRAM,@STLN END OF PROGRAM? JHE EXEC10 NO LOOP FOR NEXT LINE JMP EXEC50 YES, QUIT PROGRAM * TEST FOR REQUIRED END-OF-LINE AFTER A STATEMENT EOL MOVB R8,R8 EOL TOKEN? JNE ERRSYN * * RETURN FROM CALL TO PARSE (ENTERED FROM CONT) * * = BR TABLE NUDEND MOV *R9,R7 GET RTN ADR. JLT NUDE10 RTN TO GPL DECT R9 BACK UP STACK B @2(R7) * * RETURN FROM "CALL" TO GPL * * = BR TABLE RTNG BL @SETREG JMP NUDEND * = BL D9F6 MOV R11,R2 BL @GETV DATA FAC MOV R1,R4 SLA R1,2 JOC ERRSYN MOV R4,R1 B *R2 = RT * REF NOT KNOWN DATA 0,0,0,0,0,0,0,0 DATA 0,0,0,0 * BRKPNT MOVB @GROMFG,R0 GROM PROGRAM? JNE EXEC14 YES IGNORE BRKPT BRKPN1 LI R0,BRKFL BREAKPOINT RTN VECTOR JMP ERR * = BR TABLE ERRSYN LI R0,ERRSN SYNTAX ERROR CODE ERR MOV R0,@ERRCOD * * GENERAL RETURN TO BASIC * EXEC50 MOV @RTNADD,R7 RTN ADR. B @NUDG05 USE COMMON CODE TO LINK BACK * STOP EQU $ * = BR TABLE END DECT R9 POP LAST CALL TO PARSE JMP EXEC50 * * WARNING ROUTINE (ONLY OVERFLOW) * WARN$$ MOV @HX0004,@ERRCOD ERROR CODE FOR GPL LI R11,CONT-2 TO OPTIMIZE * * RETURN TO GPL AS CALL * * = BL CALGPL INCT R9 MOV R11,*R9 STACK RETURN JMP EXEC50 * * TRACE A LINE (CALL GPL ROUTINE) * TRACE MOV @HX0002,@ERRCOD RETURN VECTOR LI R11,EXEC11-2 RETURN ENTRY IN 9985 JMP CALGPL * * NUD ROUTINE FOR NUMERIC CONSTANT * NUMCOM MOV @PGMPTR,@FAC+12 PNTR FOR CSN SWPB R8 A R8,@PGMPTR CLR @FAC+10 ERROR INDICATOR BL @SAVRE2 SAVE REGISTERS BL @CSNGR CONVERT STRING TO NO. BL @SETREG SET UP REGS C @FAC+12,@PGMPTR IS PTR AS EXPECTED JNE ERRSYN NO, SYNTAX ERROR BL @PGMCHR GET NEXT CHAR FROM PGM MOVB @FAC+10,R0 OVERFLOW? JNE WARN$$ YES, HAVE GPL ISSUE WARNING B @CONT CONTINUE PARSE * * NUD ROUTINE FOR "GO" * * = BR TABLE GO CLR R3 DUMMY "ON"INDEX JMP ON30 MERGE WITH "ON" CODE * * NUD ROUTINE FOR "ON" * * = BR TABLE ON BL @PARSE PARSE EXPRESSION FOR VALUE HXB366 BYTE >B3 CBH66 BYTE >66 UNUSED BYTE FOR CONSTANT BL @NUMCHK ENSURE IT'S A NUMBER CLR @FAC+10 CLEAR ERROR BYTE FOR CFI BL @CFI CONVERT TO INTEGER MOVB @FAC+10,R0 TEST ERROR CODE JNE GOTO90 IF OVERFLOW MOV @FAC,R3 GET VALUE JGT ON20 MUST BE +VE GOTO90 LI R0,ERRIOR NOT -VE GOTO95 JMP ERR * ON20 CI R8,GO$*256 BARE "GO"? JNE ON40 NO, CHECK OTHER POSSIBILITIES BL @PGMCHR YES, GET NEXT CHAR ON30 CI R8,TO$*256 "GO TO"? JEQ GOTO50 YES CI R8,SUB$*256 "GO SUB"? JMP ON50 MERGE CODE ON40 CI R8,GOTO$*256 "GOTO"? JEQ GOTO50 YES CI R8,GOSUB$*256 "GOSUB"? ON50 JNE ERRSYN NO, SYNTAX ERROR BL @PGMCHR JMP GOSUB2 ERR1B JMP ERRSYN SYNTAX ERROR * * NUD ROUTINE FOR "GOSUB" * * = BR TABLE GOSUB CLR R3 * * COMMON GOSUB CODE * GOSUB2 MOV @EXTRAM,@FAC SAVE CURRENT PGM ADR. MOVB @CBH66,@FAC+2 INDICATE GOSUB ENTRY MOV R3,@FAC+6 SAVE "ON" COUNT * IN CASE OF GARBAGE COLLECTION BL @VPUSH PUSH RTN MOV @FAC+6,R3 RESTORE COUNT JMP GOTO20 * * NUD ROUTINE FOR "GOTO" * * = BR TABLE GOTO CLR R3 DUMMY INDEX FOR "ON"CODE * * COMMON (ON) GOTO/GOSUB THEN/ELSE CODE * GOTO20 CI R8,LN$*256 SPECIAL LINE NUMBER TOKEN? JNE ERR1B ELSE SYNTAX ERROR BL @PGMCHR GET MSBYTE OF LINE NO. MOVB R8,R0 SAVE IT BL @PGMNXT GET LSBYTE OF LINE NO. DEC R3 COUNT FOR ON JGT GOTO40 LOOP IF NOT THERE * * FIND PROGRAM LINE * MOV @STLN,R1 GET INTO THE LINE NO. BUFFER MOVB @GROMFG,R2 WHERE DO WE GET THE ARGS FROM? JEQ GOTO31 FROM RAM - ACT NATURALLY MOVB R1,@GWAOFF(R13) WRITE OUT LSB ADR MOV R13,R2 GET FROM READ ADR IN R2 MOVB @R1LSB,@GWAOFF(R13) DO MSB ADR JMP GOTO32 CONTINUE IN COMMON MODE GOTO31 MOVB @R1LSB,*R15 GET IT FROM THE VDP LI R2,VDPRD MOVB R1,*R15 GOTO32 C R1,@ENLN FINISHED WITH W/# BUFFER JHE GOTO34 CB *R2,R0 COMPARE 1ST BYTE OF A #-MATCH JNE GOTO35 NOT A MATCH, MOVE ON CB *R2,R8 2ND BYTE MATCH? JEQ GOTO36 YES, LINE IS FOUND GOTO33 MOVB *R2,R3 SKIP 1ST BYTE OF LINE PTR AI R1,4 ADVANCE TO NEXT NO. IN BUFFER MOVB *R2,R3 SKIP 2ND BYTE OF LINE PTR JMP GOTO32 GOTO35 MOVB *R2,R3 SKIP 2ND BYTE OF NO. JMP GOTO33 GOTO34 LI R0,ERRLNF LINE NOT FOUND JMP GOTO95 ERROR EXIT GOTO36 INCT R1 ADJUST TO LINE PTR MOV R1,@EXTRAM SAVE FOR EXECUTE DECT R9 POP SAVED LINK TO GOTO B @EXEC10 RE-ENTER EXEC CODE DIRECTLY * MUST BE CHANGED IN IMPERATIVE * GOTO ETC. ARE ALLOWED...... GOTO40 BL @PGMCHR CI R8,COMMA$*256 COMMA NEXT JNE GOTO90 NO, ERROR GOTO50 BL @PGMCHR YES, GET NEXT CHAR JMP GOTO20 AND LOOP ERR1C JMP ERR1B * * NUD ENTRY FOR "RETURN" * * = BR TABLE RETURN EQU $ RETU10 BL @VPOP POP ENTRY CB @CBH66,@FAC+2 FLAG FOR GOSUB ENTRY JNE RETU10 LOOP TILL FIND ONE MOVB R8,R8 END OF LINE? JNE ERR1C NO, ERROR MOV @FAC,@EXTRAM GET RETURN TEXT PTR B @NUDEND GO ADJUST IT * SYMB20 LI R0,NUDD2 JMP GOTO95 * * SUBROUTINE FOR A SYMBOL (VARIABLE) * PSYM BL @SYM GET SYMBOL TABLE ENTRY DB98 BL @GETV DATA FAC SLA R1,1 FUNCTION REFERENCE? JLT SYMB20 YES, SPECIAL CODE BL @SMB GET VALUE SPACE POINTER CB @FAC+2,@CBH65 STRING REF? JEQ SYMB10 YES, SPECIAL CODE BL @MOVFAC GET VALUE SPACE INTO FAC SYMB10 B @CONT CONTINUE PARSE * * NUD ENTRY FOR IF STATEMENT * * = BR TABLE IF BL @PARSE EVALUATE EXPN BYTE COMMA$ CBH67 BYTE >67 UNUSED BYTE FOR CONSTANT BL @NUMCHK ENSURE ITS A NUMBER CLR R3 DUMMY ON INDEX CI R8,THEN$*256 JNE ERR1C ERROR IF THEN NOT NEXT TOKEN NEG @FAC TEST IF TRUE, I.E. NOT ZERO JNE GOTO50 AND BRANCH TO LINE NO. BL @PGMCHR ADVANCE TO LINE NO. TOKEN CI R8,LN$*256 SPECIAL LINE NO. TOKEN JNE ERR1C ERROR IF NOT LINE NO. INCT @PGMPTR SKIP LINE NO. BL @PGMCHR GET NEXT CHAR FROM TOKEN CI R8,ELSE$*256 TEST IF LUCKY TOKEN IS ELSE JEQ GOTO50 IF SO BRANCH TO LINE NO. B @EOL MUST BE END OF LINE * * SUBROUTINE FOR "LET" * * = BR TABLE NLET BL @SYM GET SYMBOL TABLE ADR BL @SMB CI R8,EQ$*256 IS TOKEN A "="? JNE ERR1C NO, ERROR BL @PGMCHR GET NEXT TOKEN BL @PSHPRS PUSH AND PARSE BYTE LET$ BYTE >30 UNUSED BYTE FOR CONSTANT BL @ASSG ASSIGN THE VAR. B @CONT CONTINUE PARSE * REF NOT KNOWN DATA 0,0,0,0,0 * = BR TABLE * * SUBROUTINE FOR "NEXT" * NNEXT BL @SYM GET S.T. I.D. MOV @FAC,R4 NEXT2 BL @VPOP GET "FOR" ENTRY OFF STACK CB @FAC+2,@CBH67 CHECK "FOR" ENTRY JEQ NEXT3 IS A "FOR" ENTRY ERROR B @VPOP20 NOT - ERROR NEXT3 C R4,@FAC CHECK IF MATCHING "FOR" ENTRY JEQ NEXT4 IS A MATCH S @HX10,@VSPTR LOOP VARIABLES DON'T MATCH JMP NEXT2 NEXT4 BL @MOVFAC GET INDEX VALUE BL @SAVREG BL @SADD ADD IN THE INCREMENT BL @SETREG A @HX10,@VSPTR BL @ASSG SAVE NEW INDEX VALUE S @HX0008,@VSPTR POINT TO THE LIMIT BL @SCOMPB TEST W/IN LIMIT STST R4 SAVE RESULT OF COMPARE JEQ NEXT5 IF = DO LAST LOOP MOV @VSPTR,R3 CHECK FOR A DECREMENT AI R3,>10 HX10 EQU $-2 BL @GETV1 READ VDP TO R1 MSB FROM ADR IN R3 MOVB R1,R1 CHECK IF A DECREMENT JLT NEXT6 YES SLA R4,1 CHECK OUT OF LIMIT JGT NEXT8 OUT OF LIMIT NEXT5 A @HX0018,@VSPTR POINT TO I.D. MOV @VSPTR,R3 GOTO TOP OF "FOR" LOOP AI R3,6 BL @GETV1 READ VDP TO R1 MSB FROM ADR IN R3 MOVB @VDPRD,@EXTRAM+1 MOVB R1,@EXTRAM NEXT8 B @CONT CONTINUE PARSE * * TEST LIMIT FOR DECREMENT * NEXT6 SLA R4,1 CHECK OUT OF LIMIT JGT NEXT5 WITHIN LIMIT JMP NEXT8 CONTINUE PARSE * * STATEMENT TABLE * DATA ERRSYN SPARE (80) DATA ERRSYN ELSE DATA ERRSYN (RESERVED FOR SR62) DATA ERRSYN (SR62) DATA IF IF (84) DATA GO GO DATA GOTO GOTO DATA GOSUB GOSUB DATA RETU10 RETURN DATA NUDEND DEF DATA NUDEND DIM DATA END END DATA >8000 FOR DATA NLET LET DATA >8002 BREAK DATA >8004 UNBREAK DATA >8006 TRACE (90) DATA >8008 UNTRACE DATA >8016 INPUT DATA NUDEND DATA (93) DATA >8012 RESTORE DATA >8014 RANDOMIZE DATA NNEXT NEXT DATA >800A READ DATA END STOP (98) DATA >803E DELETE DATA NUDEND REM DATA ON ON DATA >800C PRINT DATA >800E CALL DATA NUDEND OPTION DATA >8018 OPEN DATA >801A CLOSE (40) DATA ERRSYN SUB STMTTB DATA >803C DISPLAY * * * NTAB DATA >801C (B7) DATA ERRSYN RESERVED FOR SR62 DATA ERRSYN SPARE DATA ERRSYN (SR62) DATA ERRSYN (SR62) DATA ERRSYN SPARE DATA ERRSYN (SR62) DATA ERRSYN = DATA ERRSYN < DATA ERRSYN > (C0) DATA >801E + DATA >8020 - DATA ERRSYN * DATA ERRSYN / DATA ERRSYN ^ DATA ERRSYN SPARE DATA >8010 QUOTED STRING DATA NUMCOM UNQUOTED STRING(NUMERIC) (C8) DATA ERRSYN LINE NUMBER DATA >804A EOF DATA >8022 ABS DATA >8024 ATN DATA >8026 COS DATA >8028 EXP DATA >802A INT DATA >802C LOG (D0) DATA >802E SGN DATA >8030 SIN DATA >8032 SQR DATA >8034 TAN DATA >8036 LEN DATA >8038 CHR$ DATA >803A RND DATA >8040 SEG$ DATA >8046 POS DATA >8044 VAL DATA >8042 STR$ DATA >8048 ASC NTABLN EQU $-NTAB * * LED TABLE * LTAB DATA EQUALS DATA LESS DATA GREATR DATA PLUS DATA MINUS DATA TIMES DATA DIVIDE DATA EXPON LTBLEN EQU $-LTAB * * LED ROUTINES * * LOGICAL COMPARISONS ENCODE TYPE OF COMPARISON AND USE * COMMON CODE TO PARSE EXPRESSION AND SET UP STATUS... * * TYPES ARE EQUAL (0), NOT EQUAL (1), LESS THAN (2) * LESS OR EQUAL (3), GREATER THAN (4) AND GREATER OR EQUAL (5) * THIS CODE IS SAVED ON THE SUBROUTINE STACK * * = BR TABLE LESS LI R2,2 LESS THAN CODE FOR COMMON RTN CI R8,GT$*256 TEST FOR > TOKENAL JNE LT10 JUMP IF NO MATCH DECT R2 NOT EQUAL CODE FOR COMMON RTN JMP LT15 * = BR TABLE GREATR LI R2,4 GREATER THAN CODE HX0004 EQU $-2 LT10 CI R8,EQ$*256 TEST FOR EQUAL TOKEN JNE LTST01 NOT GREATER OR NOT LESS THAN BRANCH LT15 BL @PGMCHR MUST BE PLAIN OLD > OR < TOKEN JMP LEDLE * = BR TABLE EQUALS SETO R2 EQUAL BIT FOR COMMON ROUTINE LEDLE INC R2 SETS TO ZERO LTST01 INCT R9 MOV R2,*R9 SAVE STATUS MATCHING CODE BL @PSHPRS PICK UP ARGUMENTS BYTE GT$,0 MOV *R9,R4 RECALL TYPE CODE DECT R9 RESET STACK PTR MOVB @LTSTAB(R4),R12 GET ADR BIAS TO BRANCH TO SRA R12,8 RIGHT JUSTIFY BL @ARGTST TEST FOR MATCHING ARGUMENTS JEQ LTST20 IF BOTH ARE STRING BL @SCOMPB FLOATING POINT COMPARISON LTST15 B @LTSTXX(R12) USE APPROPRIATE ROUTINE * LTSTGE EQU $ LTSTXX JGT LTRUE TEST IF GREATER OR EQUAL LTSTEQ JEQ LTRUE TEST IF EQUAL LFALSE CLR R4 FALSE IS ZERO JMP LTST90 LTSTNE JEQ LFALSE TEST IF NOT EQUAL LTRUE LI R4,>BFFF TRUE IS MINUS ONE LTST90 LI R3,FAC STORE RESULT IN FAC MOV R4,*R3+ STORE EXP AND 1ST BYTE OF MA CLR *R3+ ZERO REMAINING DIGITS CLR *R3+ CLR *R3+ JMP LEDEND END OF LED ROUTINE LTSTLE JEQ LTRUE TEST LESS THAN OR EQUAL LTSTLT JLT LTRUE TEST LESS THAN JMP LFALSE LTSTGT JGT LTRUE TEST GREATER THAN JMP LFALSE * * BYTEE TABLE FOR OFFSETS FOR TYPES * LTSTAB BYTE LTSTEQ-LTSTXX EQUAL (0) BYTE LTSTNE-LTSTXX NOT EQUAL (1) BYTE LTSTLT-LTSTXX LESS THAN (2) BYTE LTSTLE-LTSTXX LESS OR EQUAL (3) BYTE LTSTGT-LTSTXX GREATER THAN (4) BYTE LTSTGE-LTSTXX GREATER OR EQUAL (5) * * STRING COMPARISON * LTST20 MOV @FAC+4,R10 POINTER TO STRING 1 MOVB @FAC+7,R7 R7 = RH STRING LENGTH BL @VPOP GET LH ARG BACK MOV @FAC+4,R4 POINTER TO STRING 2 MOVB @FAC+7,R6 R6 = LH STRING LENGTH MOVB R6,R5 R5 WILL CONTAIN SHORTER LENGTH CB R6,R7 JLT CSTR05 JUMP IF LENGTH 2< LENGTH 1 MOVB R7,R5 CSTR05 SRL R5,8 SHIFT FOR SPEED AND TEST ZERO JEQ CSTR20 IF ZERO, SET STATUS WITH LENGTH CSTR10 MOV R10,R3 CURRENT CHAR. LOCATION INC R10 INC. PTR BL @GETV1 GET FROM VDP MOVB R1,R0 AND SAVE FOR COMPARISON MOV R4,R3 CURRENT CHAR LOCATION IN ARG INC R4 INC PTR BL @GETV1 GET FROM VDP CB R1,R0 COMPARE CHARS JNE LTST15 RETURN WITH STATUS IF NOT EQUAL DEC R5 OTHERWISE DEC. COUNTER JGT CSTR10 AND LOOP FOR EACH CHAR CSTR20 CB R6,R7 STATUS SET BY LENGTH COMPARISON JMP LTST15 RETURN TO DO TEST OF STATUS * * ARITHMETIC FUNCTIONS * * = BR TABLE PLUS BL @PSHPRS PARSE FOR VALUES BYTE MINUS$,0 LI R2,SADD ADR. OF ROUTINE LEDEX CLR @FAC+10 CLEAR ERROR CODE BL @ARGTST TEST ARGS JEQ ARGT05 IF STRING BL @SAVREG SAVE REGS IN RAM BL *R2 GO TO ROUTINE BL @SETREG RESTORE REGS MOVB @FAC+10,R2 TEST FOR OVERFLOW JNE LEDERR LEDEND B @CONT LEDERR B @WARN$$ * = BR TABLE MINUS BL @PSHPRS BYTE MINUS$,0 LI R2,SSUB JMP LEDEX * = BR TABLE TIMES BL @PSHPRS BYTE DIVI$,0 LI R2,SMULT JMP LEDEX * = BR TABLE DIVIDE BL @PSHPRS BYTE DIVI$,0 LI R2,SDIV JMP LEDEX * = BR TABLE EXPON BL @PSHPRS BYTE EXPON$,0 LI R0,5 RETURN VECTOR FOR EXPON NUD B @ERR RETURN TO GPL * * TEST ARGUMENTS ON BOTH STACK AND IN FAC. * BOTH MUST BE OF SAME TYPE * CALL: BL @ARGTST * JEQ IF STRING * JNE IF NUMERIC * * = BL ARGTST MOV @VSPTR,R6 GET STACK PTR INCT R6 MOVB @R6LSB,*R15 NOP MOVB R6,*R15 NOP CB @VDPRD,@CBH65 JL NUMCHK NO, NUMERIC JH ARGT05 NO, OTHER CB @FAC+2,@CBH65 YES, IS OTHER SAME? JEQ ARGT20 YES, DO STRING COMP ARGT05 B @ERRT DATA TYPES DON'T MATCH NUMCHK CB @FAC+2,@CBH65 2ND OP. CAN'T BE STRING JHE ARGT05 IF SO, ERROR ARGT20 RT NO ERROR, RETURN W/ STATUS * * SUBROUTINE TO SET UP REGISTERS ON ENTRY FROM GPL * * = BL SETREG CLR R8 MOVB @CHAT,R8 GET CURRENT CHAR MOVB @STKADD,R9 GET STACK ADR. SRL R9,8 AI R9,PAD ADD IN BASE RT * * SUBROUTINE TO RESTORE GPL MEMORY LOCATIONS * ALSO USED TO SAVE R8 AND R9 FOR CALLS TO FPT PACK * * = BL SAVREG MOVB R8,@CHAT PUT CURRENT CHAR. IN FOR GPL SAVRE2 AI R9,-PAD CALC. CURRENT STACK ADR. MOVB @R9LSB,@STKADD RT * * PUSH FOLLOWED BY PARSE * * = BL PSHPRS INCT R9 CI R9,STKEND STACK FULL? DEA2 JH VPSH23 YES, ERROR MOV R11,*R9 SAVE RTN ON STACK LI R11,P05 OPTIMIZE * * STACK PUSH ROUTINE * * = BL VPUSH LI R0,8 NUBER TO PUSH HX0008 EQU $-2 A R0,@VSPTR BUMP POINTER MOV @VSPTR,R1 GET STACK PTR MOVB @R1LSB,*R15 ORI R1,WRVDP MOVB R1,*R15 LI R1,FAC VPSH15 MOVB *R1+,@VWD DEC R0 COUNT JGT VPSH15 MOV R11,R0 SAVE RETURN ADR CB @FAC+2,@CBH65 PUSHING A STRING? JNE VPSH20 NO MOV @VSPTR,R6 ENTRY ON STACK AI R6,4 PTR TO STRING MOV @FAC,R1 CI R1,SREF-PAD IS IT A TEMPORARY STRING? JNE VPSH20 NO, OK VPSH19 MOV @FAC+4,R1 ADR. OF STRING JEQ VPSH20 IF NULL STRING BL @STVDP3 SET THE BACKPOINTER VPSH20 MOV @VSPTR,R1 GET STACK POINTER AI R1,16 CORRECT BY 8 C R1,@STREND AT LEAST 8 LEFT JLE VPOP18 INCT R9 MOV R0,*R9 MOVB @HX0977,@ERRCOD+1 COLLECT GARBAGE BL @CALGPL HX0018 DATA >0018 UNUSED WORD FOR CONSTANT MOV *R9,R0 DECT R9 MOV @VSPTR,R1 AI R1,16 C R1,@STREND OUT OF MEMORY? JLE VPOP18 NO, OK VPSH23 LI R0,ERROM OUT OF MEMORY VPSH25 BL @SETREG IN CASE OF GPL CALL B @ERR * * STACK POP ROUTINE * * = BL VPOP LI R2,FAC MOV @VSPTR,R1 GET STACK PTR C R1,@STVSPT CHECK FOR STACK UNDERFLOW JLE VPOP20 YES, ERROR MOVB @R1LSB,*R15 LI R0,8 MOVB R1,*R15 S R0,@VSPTR VPOP10 MOVB @VDPRD,*R2+ DEC R0 COUNT JGT VPOP10 MOV R11,R0 CB @FAC+2,@CBH65 POP A STRING? JNE VPOP18 NO, OK CLR R6 FOR BACK PTR CLEAR MOV @FAC,R3 CI R3,SREF-PAD POP A TEMP JEQ VPSH19 YES, FREE IT BL @GETV1 GET NEW PTR FROM S.T. MOVB @VDPRD,@R1LSB MOV R1,@FAC+4 SET NEW PTR TO STRING VPOP18 B *R0 RTN VPOP20 LI R0,ERREX JMP VPSH25 * * GET NEXT CHAR FROM BASIC PROG. THE RETURNED STATUS * REFLECTS THE CHAR. * = BL * READ BYTE FROM GROM OR VDP (DEPENDING ON GROMFG) FROM * ADR. IN >838C, INC >838C, PUT READ DATA IN MSB OF R8. * PGMCHR MOVB @GROMFG,R8 TEST GROM FLAG JNE PGMC10 YES, DO GROM INPUT MOVB @PGMPTR+1,*R15 LI R10,VDPRD MOVB @PGMPTR,*R15 JMP PGMNXT PGMC10 MOVB @PGMPTR,@GWAOFF(R13) MOVB @PGMPTR+1,@GWAOFF(R13) MOV R13,R10 GET GROM READ DATA PORT ADR * = BL PGMNXT INC @PGMPTR MOVB *R10,R8 RT * * SUBROUTINE TO POP VALUE STACK * * * = BL * READ 8 BYTES FROM VDP STARTING AT ADR. IN VSPTR * SUBTRACT 8 FROM THIS ADR. PUT THE 8 BYTES IN RAM * FROM >8356 THRU >8363. * POPSTK LI R5,-8 COUNTER FOR LOOP LI R6,ARG ADR. TO STORE OPERAND MOVB @VSPTR+1,*R15 LOAD ADR. TO VDP LI R7,VDPRD SET UP TO READ FROM VDP MOVB @VSPTR,*R15 LOAD MSB ADR. TO VDP A R5,@VSPTR CORRECT STACK COUNTER STKMOV MOVB *R7,*R6+ RECALL BYTE FROM VDP INC R5 INC. LOOP COUNTER JNE STKMOV 8 BYTES? RT * = BL *R3 * * WRITE CURRENT READ ADR. (IN R6) TO VDP, INC R6 * READ VDP DATA TO LSB OF R8 * GETCH MOVB @R6LSB,*R15 LOAD VDP ADR. NOP MOVB R6,*R15 AND THE MSB INC R6 NEXT ADR. MOVB @VDPRD,R8 GETCH1 SRL R8,8 TO LSB RT RTN * BL *R3 * * WRITE CURRENT READ ADR. (IN R6) TO GROM, INC R6, * READ GROM TO LSB OF R8 * GETCHG MOVB R6,@GWAOFF(R13) MOVB @R6LSB,@GWAOFF(R13) INC R6 MOVB *R13,R8 JMP GETCH1 * SPARE DATA 0,0,0,0,0,0,0,0,0 DFFC DATA >2A61,>A38A END