; Astro BASIC (2000 Baud Version) ; (C) July 1978 Bally Mfg. ; (C) Dec 1980 Revised ; ; Written by Jay Fenton ; ; Source-code Retyped by Adam Trionfo ; ; Revisions: ; * March 2, 2004 - 1.0 ; - 100% Finished - HVGLIB.H 2.6 (or above) required ; - Matches perfectly with AstroBASIC cartridge ; - First assemble with no errors ; * February 29, 2004 - .02 ; - Finish typing in source-code ; - Start converting to standard Z-80 mnemonics ; * February 14, 2004 - .01 ; - Begin typing in source-code ; ; To assemble this Z-80 source code using ZMAC: ; ; zmac -d -o -x ; ; For example, assemble this Astrocade Z-80 ROM file: ; ; zmac -i -m -o astrobas.bin -x astrobas.lst astrobas.asm ; ; *************************** ; * BALLY BASIC INTERPRETER * ; * * ; * (C) JULY 1978 BALLY MFG * ; * (C) DEC 1980 REVISED * ; * * ; * WRITTEN BY: JAY FENTON * ; * * ; * BALLY BASIC IS BASED ON * ; * PALO ALTO TINY BASIC BY * ; * LICHEN WANG * ; * * ; *************************** ; TINY BASIC INTERPRETER ; INCLUDE "HVGLIB.H" ; HOME VIDEO GAME LIBRARY ; ; MACROS TOKEN MACRO TINDX, TGOTO DB TINDX DEFF TGOTO ENDM DEFF MACRO WORDY DB (WORDY >> 8) | 80H DB WORDY & 0FFH ENDM TSTC MACRO CAT, DOG RST 1 DB 'CAT' DB (DOG - $)-1 ENDM TSTCC MACRO CAT1, DOG1 RST 1 DB CAT1 DB (DOG1 - $)-1 ENDM ITEM MACRO STRANG, JUMPTO DB 'STRANG' DEFF JUMPTO ENDM ; URINAL EQU 0FFFH BOTSCR EQU 4E20H TOPSCR EQU 4FEAH BOTRAM EQU 0A000H DFTLMT EQU 0A70CH BOTROM EQU 02000H ; HLTPORT EQU 15H ; KEYPAD KEY WITH HALT ONIT ; CR EQU 0DH RUBOUT EQU 1FH COMMA EQU 44 EDKEY EQU 66H NLLN EQU 67H ; EQUATES FOR RESTART INSTRUCTIONS RSTEXP EQU 2 ; EXPR RSTLDE EQU 3 ; LDE RSTIGN EQU 4 ; IGNBLK RSTPAR EQU 5 ; PARN RSTFIN EQU 6 ; FINISH ; TXTUNF EQU 4E20H VARBGN EQU 4E22H DEVVAR EQU 4E56H ; DEVICES VARIABLES DEVCL0 EQU 4E56H ; BACKGROUND COLOR DEVCL1 EQU 4E58H ; FOREGROUND COLOR DEVTEM EQU 4E5AH ; TEMPO VDMX EQU 4E5CH ; VDM X COORDINATE VDMY EQU 4E5EH ; VDM Y COORDINATE OLDXY EQU 4E60H ; PREVIOUS COORDINATES FROM VECTOR DRAW DEVMO EQU 4E62H ; MASTER OSC DEVOA EQU 4E64H ; OSC A DEVOB EQU 4E66H ; OSC B DEVOC EQU 4E68H ; OSC C DEVVD EQU 4E6AH ; VIBRATO DEPTH DEVVR EQU 4E6CH ; VIBRATO RATE DEVVC EQU 4E6EH ; VOL C DEVNM EQU 4E70H ; NOIS MODE DEVVA EQU 4E72H ; VOLUME A DEVVB EQU 4E74H ; VOLUME B DEVNV EQU 4E76H ; NOISE VOLUME REMAIN EQU 4E78H ; REMAINDER FROM LAST DIVIDE SCRMOD EQU 4E7AH ; SCROLL MODE VDMNLF EQU 4E7CH ; VDM NEW LINE FLAG KEYTMR EQU 4E7DH ; KEYBOARD SCAN TIMER MUZTMR EQU 4E7EH ; MUSIC NOTE TIMER NEWTMR EQU 4E7FH ; NEW MUSIC TIMER VALUE MUZMO EQU 4E80H ; MASTER OSC FOR DICK MUZTON EQU 4E81H ; TONE VALUE SHARPF EQU 4E82H ; SHARP-FLAT ; KEYTRK EQU 4E83H ; KEYBOARD TRACKER LINEND EQU 4E84H EDFLG EQU 4E86H PIXVAL EQU 4E86H ; PIXEL TO DRAW WITH EDPTR EQU 4E87H MNMX EQU 4E87H ; MIN - MAX DELTAS FOR VECTOR DRAW INCRO EQU 4E89H ; COORDINATE INCREMENTS FOR VECTOR DRAW NLLNLN EQU 4E8BH ; AUTO LINE # STUFF NLLNCT EQU 4E8DH NLLNZS EQU 4E8EH ; AUTO LINE NUMBER ZERO SUPPRESS FLAG OLDLN EQU 4E8FH ; PREVIOUS LINE # TYPED ; CHECKER EQU 4E91H ; PLACE FOR CHECKSUM HKVECT EQU 4E92H HKLPINT EQU 4E92H HKINT EQU 4E95H CHKIO EQU 4E98H OUTCH EQU 4E9BH STACKP EQU 4E9EH ; STACK POINTER ALTFON EQU 4EA0H ; ALTERNATE FONT DESCRIPTOR OLDCUR EQU 4EA7H CURRNT EQU 4EA9H STKGOS EQU 4EABH VARNXT EQU 4EADH STKINP EQU 4EADH LOPVAR EQU 4EAFH LOPINC EQU 4EB1H LOPLMT EQU 4EB3H LOPLN EQU 4EB5H LOPPT EQU 4EB7H XQTBUF EQU 4EBAH BUFFER EQU 4EBAH BUFEND EQU 4F22H STKLMT EQU 4F6AH ; ORG TOPSCR STACK EQU 4FEAH ; ORG BOTRAM TXT EQU 0A000H ; ORG BOTROM JP BEGIN ; ** AUTOSTART CASSETTE ** PIXTBL DB 80H DB 20H DB 08H DB 02H ; TRANSFER VECTORS TO RESTART ROUTINES JP TSTCH ; * RST 8 JP EXPR ; * RST 16 JP LDE ; * RST 24 JP IGNBLK ; * RST 32 JP PARN ; * RST 40 POP AF ; * RST 48 JP FINISH WHAT DB 'WHAT?' DB CR DW HKLPINT ITAB DW HKINT ; INITIAL VALUES FOR PARAMETER VECTOR INIDEV DW 7 ; BACKGROUND COLOR DW 0 ; FOREGROUND COLOR DW 2 ; MUSIC TEMPO DW -77 ; VDM X COORDINATE DW 40 ; VDM Y COORDINATE ; BIT BANGER GOODIES FOLLOW: BANGIN EQU 3C00H ; BIT BANGER READ PORT BANG1 EQU 3800H ; BIT BANG CODE TO WRITE A ONE BANG0 EQU 3C00H ; BIT BANG CODE TO WRITE A ZERO ; WASTEIT MACRO TIME, ?LAB LD A,TIME ?LAB DEC A JR NZ,?LAB ENDM ; ; PRINT COMMAND ; IF VARIABLE NAME, BLOCKSIZE GIVEN, WE WILL WRITE ; OUT THE SPECIFIED BLOCK RATHER THAN THE PROGRAM STORAGE AREA TOUTPU CALL IGNATNL ; ANY ARGS? JR Z,YYSPGM ; JUMP TO SAVE PGM IF SO CALL TSTVFF ; ELSE GET START ADDR PUSH HL ; SAVE THAT TSTCC COMMA,BADSAV ; CHECK FOR COMMA RST RSTEXP ; GET BLOCK SIZE ADD HL,HL ; CONVERT TO BYTES EX DE,HL EX (SP),HL ; PUSH DE ON STACK EX DE,HL ; DE=START, HL=SIZE JR YYOUTB ; JUMP TO OUTPUTER YYSPGM LD HL,CHECKER-4000H PUSH DE LD DE,4000H ; SAVE PROGRAM TO TAPE YYOUTB SYSSUK EMUSIC DI CALL LEADER ; WRITE OUT SOME LEADER LD A,0A5H CALL OUTBYA OBL RST RSTLDE CALL OUTBYA ; TWEEDLE IT OUT INC DE ; BUMP BLOCK PTR DEC HL ; DECREMENT BLOCK SIZE LD A,H ; LOOP END YET? OR L JR NZ,OBL RST RSTLDE LD A,B ; OUTPUT CHECKSUM CPL ; COMPLEMENT FOR LATER TEST CALL OUTBYA LD B,2 RST RSTLDE EX (SP),HL EX (SP),HL CALL LEADR1 ; PUT OUT TRAILER POP DE EI RST RSTFIN ; BYE BYE BADSAV JP QWHAT TVLIST PUSH DE CALL TVLLNK POP DE RST RSTFIN ; SPECIAL ENTRY TO LOAD COMBINED SCREEN AND PGM ; ; :INPUT COMMAND ; IF VARIABLE ADDRESS IS GIVEN, WE WILL INPUT ; THE BLOCK INTO THE SPECIFIED AREA, OTHERWISE ; WE HANDLE IT LIKE A PROGRAM TINPUT CALL IGNATNL ; AND ARGS? LD HL,4000H CALL NZ,TSTVFF ; GET VAR ADDR PUSH DE CALL INBLK XXELOD POP DE RST RSTFIN ; : RUN COMMAND - LOADS BOOTSTRAP INTO RAM ; AND JUMPS TO IT TLOAD LD HL,4000H ; HL=SCREEN TOP PUSH HL ; SUBROUTINE TO INPUT A BLOCK, HL=STORE ADDR ; FIRST - AN ENTRY TO REVEAL FEEDBACK AREA INBLK CALL SENWAI ; LOOP TO GRAB CHARS AND STORE EM ZZCHRL CALL INCHAR JR Z,ZZEOT CALL STHL INC HL JR ZZCHRL TVLLNK CALL SENWAI ZZKIL CALL INCHAR JR NZ,ZZKIL ZZEOT DEC HL EI INC D ; SHOULD HAVE BEEN FF RET Z OUTCHQ LD A,'?' JP OUTCH ; SENWAI SYSSUK EMUSIC DI SENW CALL INCHAR ; WAIT FOR THE SENTINEL JR Z,SENW CP 0A5H JR NZ,SENW LD D,A RET ; INCHAR CLOBBERS A, BC, DE INCHAR ; NZ IF NO TIMEOUT, Z IF TIMEOUT, CHAR INC LD A,(BANGIN+2) AND 1 LD E,A ; PRIME THE PUMP LD BC,810H ; 8 BITS, 10=TIMEOUT FACTOR SBW CALL INBIT ; WAIT FOR START BIT JR NC,GETL ; GOT IT DEC C ; TIMEOUT? JR NZ,SBW ; NOT YET RET ; Z SET GETL CALL INBIT CALL C,INBIT ; GET ANOTHER 1 RR C DJNZ GETL ; GET 8 BITS LD A,C ; UPDATE CHECKSUM ADD A,D LD D,A DEC B ; SET NONZERO LD A,C ; RETURN VALUE RET ; RETURN INBIT ; CHECK FOR ABORT LOAD KEY IN A,(HLTPORT) RRCA JP C,INIT0 LD A,(BANGIN) XOR E ; CHECK FOR CHANGE RRCA JR NC,INBIT ; NO - WAIT WASTEIT 23 LD A,(BANGIN+1) AND 1 CP E LD E,A RET Z SCF RET ; OUTBYT CLOBBERS A, BC OUTBYA LD C,A ; GET CHAR FROM A ADD A,B ; ADD CHECKSUM ACCUM LD B,A ; AND SAVE PUSH BC CALL WRZERO ; WRITE START BIT WASTEIT 14 ; VERY TIME SENSITIVE LD B,8 ; WRITE 8 DATA, 1 STOP WRL SCF RR C ; GET BIT, INSERT 1 FOR STOP JR C,WR1 ; IF ONE, WRITE ONE CALL WRZERO ; ELSE WRITE ZERO WASTEIT 12 JR NXT NXT JR WRE ; LOOP COUNTER WR1 CALL WRONE ; WRITE ONE-BIT WASTEIT 32 WRE DJNZ WRL ; TILL 8 BITS DONE JR SEX SEX POP BC CALL WRONE ; WRITE A ONE BIT FOR STOP WASTEIT 24 RET ; ; LEADER CLOBEBERS BC AND A LEADER LD B,15 ; APPROX 3 SECS LEADR2 WASTEIT 32 NOP LEADR1 CALL WRONE ; LEADER IS ALL ONES DEC BC LD A,B OR C JR NZ,LEADR2 WASTEIT 29 RET ; ; WRONE WRITES ONE HALF CYCLE OF ONE-BIT (1/1200 SEC) ; WRONE LD A,(BANG1) ; CHANGE ITS STATE WASTEIT 36 ; WASIT SOME, THEN FALL INTO... LD A,(BANG0) RET ; ; WRZERO WRITES ONE HALF CYCLE OF ZERO BIT (1/2400 SEC) ; WRZERO LD A,(BANG1) WASTEIT 17 NOP NOP LD A,(BANG0) RET ; ; ; CKHLDE LD A,H XOR D JP P,COMP EX DE,HL ; ... COMP LD A,H CP D RET NZ LD A,L CP E RET HOW DB 'HOW?' DB CR SORRY DB 'SORRY' DB CR ; ; TABLE GIVING JUMP TO ADDRESS FOR COMMANDS TOKJT DW LISTCOM ; 'LIST' TOKEN DW CLRSCR DW RUN DW NEXT DW LINEDR DW IFF DW GOTO DW GOSUB DW RETURN DW BOXDRW DW FOR DW INPUT DW PRINT ; INITIAL HOOK VECTOR ITEMS HOOKER JP LPINT JP TBIINT JP XCHKIO JP XOUTCH DW STACK ; TABLE GIVING ASCII CHARS FOR TOKENS TOKTXT DB 'LIS' DB 'T'+80H DB 'CLEA' DB 'R'+80H DB 'RU' DB 'N'+80H DB 'NEX' DB 'T'+80H DB 'LIN' DB 'E'+80H DB 'I' DB 'F'+80H DB 'GOT' DB 'O'+80H DB 'GOSU' DB 'B'+80H DB 'RETUR' DB 'N'+80H DB 'BO' DB 'X'+80H DB 'FO' DB 'R'+80H DB 'INPU' DB 'T'+80H DB 'PRIN' DB 'T'+80H DB 'STE' DB 'P'+80H DB 'RN' DB 'D'+80H DB 'T' DB 'O'+80H ; ; DEVICE VARIABLE TABLE ; THIS TABLE IS IN INVERSE ORDER OF APPEARENC IN MEMORY PARNUM EQU 19 DEVLST DB 'S'-'@' DB 'M' DB 'R'-'@' DB 'M' DB 'N'-'@' DB 'V' DB 'V'-'@' DB 'B' DB 'V'-'@' DB 'A' DB 'N'-'@' DB 'M' DB 'V'-'@' DB 'C' DB 'V'-'@' DB 'F' DB 'V'-'@' DB 'R' DB 'T'-'@' DB 'C' DB 'T'-'@' DB 'B' DB 'T'-'@' DB 'A' DB 'M'-'@' DB 'O' DB 'X'-'@' DB 'Y' DB 'C'-'@' DB 'Y' DB 'C'-'@' DB 'X' DB 'N'-'@' DB 'T' DB 'F'-'@' DB 'C' DB 'B'-'@' DB 'C' ; TINY BASIC INTERRUPT ROUTINE TBIINT PUSH AF ; SAVE REGISTERS PUSH BC PUSH HL ; DEAL WITH KEYBOARD SCAN TIMER LD HL,KEYTMR LD A,(HL) AND A JR Z,TBIN0 DEC (HL) TBIN0 INC HL ; HAS MUSIC TIMER COUNTED DOWN? LD A,(HL) AND A JR Z,TBIN1 ; YEP - PLAY NEXT NOTE DEC (HL) ; ELSE DECREMENT IT JR NZ,TBIN3 ; JUMP IF NOT NOW ZERO XOR A LD (DEVOA),A JR TBIN2 ; MUSIC TIMER IS AT ZERO - ARE NEW PARAMETERS READY? TBIN1 INC HL ; STEP TO NEW TIMER VALUE OR (HL) ; IS IT NON ZERO? JR Z,TBIN3 ; JUMP IF NOT LD (HL),0 ; SAY WE GOT IT JP M,TBIN3 ; IF MINUS UPDATE NOTHING DEC HL ; ELSE SET OFFICIAL TIMER LD (HL),A INC HL INC HL LD A,(HL) ; SET NEW MASTER LD (DEVMO),A LD (HL),OA2 INC HL LD A,(HL) ; AND NEW TONE LD (DEVOA),A AND A ; REST WANTED? JR Z,TBIN3 ; YES - JUMP AROUND VOLUME UPDATE LD A,15 TBIN2 LD (DEVVA),A ; SET COLOR REGISTERS TO VALUES IN PARAMETER VARS %0 AND %1 TBIN3 LD A,(DEVCL0) OUT (COL0L),A OUT (COL1L),A LD A,(DEVCL1) OUT (COL2L),A OUT (COL3L),A ; UPDATE THE MUSIC PROCESSOR LD A,(DEVTEM) RLCA JR C,INTDON LD BC,410H LD HL,DEVMO LP1 LD A,(HL) OUT (C),A INC HL INC HL INC C DJNZ LP1 LD B,(HL) ; B=VD INC HL INC HL LD A,(HL) ; A=VR RRCA RRCA XOR B AND 0C0H XOR B OUT (C),A INC HL INC HL LD B,(HL) ; B=VOLC INC HL INC HL LD A,(HL) ; A=NM RLCA RLCA RLCA RLCA XOR B AND 30H XOR B OUT (15H),A INC HL INC HL LD B,(HL) ; VA INC HL INC HL LD A,(HL) ; VB RLCA RLCA RLCA RLCA XOR B AND 0F0H XOR B OUT (16H),A INC HL INC HL LD A,(HL) ; GET NOISE VOLUME OUT (17H),A ; DONE - RESTORE REGISTERS AND GO BACK INTDON POP HL POP BC POP AF LPINT EI RET ; CAMMAND TO SILENCE MUSIC PORTS SILENCE PUSH DE SYSSUK FILL DW DEVOA DW 20 DB 0 POP DE RST RSTFIN ; ROUTINE TO MOVE PROGRAM LINE FROM PGM STORAGE AREA ; INTO EXECUTION BUFFER EXPAND LD HL,(CURRNT) LD BC,(OLDCUR) AND A SBC HL,BC RET Z EXPMAN LD HL,(CURRNT) BIT 7,H ; IN LINE BUFFER ALREADY? RET Z ; YES - KICKOUT LD (OLDCUR),HL INC HL INC HL ADD HL,HL LD BC,XQTBUF EXP1 LD A,(HL) RLCA INC HL XOR (HL) AND 0AAH XOR (HL) LD (BC),A INC HL INC BC CP CR JR NZ,EXP1 SCF RR H RR L LD (LINEND),HL RET ; SUBROUTINE TO RETURN ZERO STATUS IF CHARACTER IN A IS NL OR ; ';' IGNATNL RST RSTIGN ; IGNORE ANY BLANKS ATNL CP ';' ; CHECK FOR CONTINUATION RET Z CP CR ; AND FOR CR RET ; FUNCTION TO RETURN STATE OF ADDRESSED PIXEL ; IE... PIX(X,Y)= 1 IF PIXEL IS 1, 0 IF 0 PIXFUN TSTC '(',PIXDUD PUSH BC RST RSTEXP PUSH HL TSTCC COMMA,PIXDUD RST RSTEXP TSTC ')',PIXDUD POP BC PUSH DE ; SAVE PTR LD D,L LD E,C CALL R2A EX DE,HL SYSSUK INDEXB ; INDEX BYTE (SYSTEM SUBROUTINE) DW PIXTBL LD A,(DE) ; GET BYTE FROM SCREEN AND (HL) ; MASK OFF NONSENSE LD H,0 LD L,H POP DE POP BC RET Z INC HL RET ; SOUROUTINE TO GET VARIABLE MAKING SURE IT IS ONE TSTVFF CALL TSTV RET NC ; GO BACK IF GOOD ; ELSE FALL INTO... PIXDUD JP QWHAT CLRSCR CALL CLRENT LD HL,0 LD (OLDXY),HL RST RSTFIN ; BOX DRAW ROUTINE BOXDRW RST RSTEXP ; GET X PUSH HL TSTCC COMMA,BOXDUD ; FIND COMMA RST RSTEXP ; GET Y PUSH HL TSTCC COMMA,BOXDUD RST RSTEXP LD A,L PUSH AF TSTCC COMMA,BOXDUD RST RSTEXP LD B,L PUSH BC TSTCC COMMA,BOXDUD RST RSTEXP PUSH DE POP IX POP BC ; RESTORE YS POP AF ; AND XS LD C,A LD A,L ; PRESERVE FLAG POP HL LD D,L POP HL LD E,L LD L,A ; NOW WE HAVE: B=YS, C=XS, D=Y, E=X, L=FLAG ; LIMIT CHECK Y LD H,B SRL H LD A,D CALL SABS ADD A,H CP 45 JR NC,BOXNDR LD A,B ; DIVIDE SIZE AGAIN DEC A ; THIS TIME WITH PRESUB SRL A ADD A,D LD D,A ; AND X LD H,C SRL H LD A,E CALL SABS ADD A,H CP 81 JR NC,BOXNDR LD A,E SUB H LD E,A ; DIDDLE WITH FLAG BYTE LD A,L AND 3 ; MODULO 4 JR Z,BOXNDR ; SKIP DRAW IF ZERO SUB 2 ; ELSE SUBTRACT 2 FOR MASK BOXDR1 PUSH AF CALL R2A ; HL = ABS ADDR, A = SA, B=YS, C=XS OUT (MAGIC),A POP AF CALL BOXPUT BOXNDR PUSH IX POP DE RST RSTFIN BOXDUD JP QWHAT SABS AND A RET P CPL INC A RET ; SUBROUTINE TO DRAW A BOX ON SCREEN BOXPUT LD E,A LD A,C ; D = X / 4 RRCA RRCA AND 3FH INC A LD D,A ; PAINT FULL BOX STRIPES MPT1 DEC D JR Z,MPT2 LD A,10101010B CALL STRIPE JR MPT1 MPT2 LD A,C AND 3 INC A LD C,A XOR A MPT3 DEC C JR Z,MPT4 RRCA RRCA OR 10000000B JR MPT3 MPT4 CALL STRIPE XOR A ; FALL INTO... ; SUBROUTINE TO PAINT A STRIPE STRIPE PUSH HL PUSH BC LD (URINAL),A LD A,(URINAL+4000H) LD C,A STRP1 LD A,E CP 1 JR NZ,STRP2 LD A,(HL) XOR C STRP2 XOR (HL) AND C XOR (HL) LD (HL),A LD A,L ADD A,BYTEPL LD L,A LD A,H ADC A,0 LD H,A DJNZ STRP1 POP BC POP HL INC HL RET ; LINE DRAWER LINEDR RST RSTEXP LD A,L PUSH AF TSTCC COMMA,LINED4 RST RSTEXP LD A,L PUSH AF LINED1 TSTCC COMMA,LINED4 RST RSTEXP LD C,L PUSH DE POP IX LD DE,(OLDXY) POP AF LD H,A POP AF LD L,A LD (OLDXY),HL ; SET NEW LAST PLACE ; DIDDLE WITH FLAG BYTE LD A,C AND 3 JR Z,LINED3 SUB 2 LINED2 LD (PIXVAL),A ; SET PIXVAL CALL DVECT LINED3 PUSH IX POP DE RST RSTFIN LINED4 JP QHOW ; LARRY LIVERMORE'S VECTOR DRAWING ALGORITHM ; H=Y1, L=X1, D=Y2, E=X2 DVECT PUSH DE LD B,L LD C,E CALL CDELTA LD E,B LD L,C LD B,H LD C,D CALL CDELTA LD H,C LD D,B ; NOW WE HAVE: H=SGN(DY), L=SGN(DX) ; D=ABS(DY), E=ANS(DX) LD (INCRO),HL ; DECIDE WHICH DELTA IS LARGER ; CALL BIGGER MX, SMALLER MN LD C,0 LD A,D CP E JR C,VECT1 LD D,E LD E,A INC C VECT1 LD A,D ; MX TO A SRL A LD B,A EX DE,HL LD (MNMX),HL POP DE LD A,L INC A ; MAKE SURE LAST PIXEL WRITTEN ; THE INFAMOUS PIXEL PAINTING LOOP VECT2 PUSH AF CALL R2ACLP JR NC,VECT2A PUSH BC PUSH HL LD C,A LD B,0 LD HL,PIXTBL ADD HL,BC LD B,(HL) POP HL LD A,(PIXVAL) CP 1 JR NZ,VECT9 LD A,(HL) XOR B VECT9 XOR (HL) AND B XOR (HL) LD (HL),A POP BC ; INCREMENT COORDINATES VECT2A LD HL,(MNMX) LD A,B ADD A,H CP B ; DID WRAP AROUND UNIVERSE? JR C,FUZZ CP L JR C,VECT4 FUZZ SUB L LD B,A LD HL,(INCRO) LD A,D ADD A,H LD D,A VECT3 LD A,E ADD A,L LD E,A JR VECT5 VECT4 LD B,A LD HL,(INCRO) LD A,C RRCA JR NC,VECT3 LD A,D ADD A,H LD D,A ; END OF LOOP VECT5 POP AF DEC A JR NZ,VECT2 RET ; SUBROUTINE TO LOAD HL WITH VDM COORDINATES ; FROM DEVICE VARIABLES LDVDMC PUSH AF LD A,(VDMY) CPL ADD A,41 CP 81 ; OUT OF RANGE? JR C,LDVDM1 ; NO XOR A LDVDM1 LD H,A LD A,(VDMX) ; DIDDLE WITH X ADD A,77 CP 157 JR C,LDVDM2 XOR A LDVDM2 LD L,A POP AF RET ; SUBROUTINE TO STORE HL INTO VDM COORDINATE DEVICE VARIABLES STVDMC PUSH HL LD A,H SUB 41 CPL LD L,A CALL SGNEXT LD (VDMY),HL POP HL LD A,L SUB 77 LD L,A CALL SGNEXT LD (VDMX),HL RET ; SUBROUTINE TO COMPUTE DELTA AND INCREMENT FOR TWO COORDINATES CDELTA PUSH HL PUSH DE LD L,C CALL SGNEXT EX DE,HL LD L,B CALL SGNEXT XOR A SBC HL,DE ; COMPUTE SGN(DELTA) AND ABS(DELTA) OR H JR Z,CDELT1 LD C,A LD A,L CPL INC A LD B,A JR CDELT3 CDELT1 OR L ; POS CASE 0? JR Z,CDELT2 LD A,1 CDELT2 LD B,L LD C,A CDELT3 POP DE POP HL RET ; RELATIVE TO ABSULUTE CONVERSION WITHING CLIPPING R2ACLP LD A,E ADD A,80 CP 160 ; IN RANGE 0-159 - CY FOR OK RET NC LD A,D ADD A,44 CP 88 RET NC ; ... ; RELATIVE TO ABSOLUTE CONVERSTION R2A PUSH DE LD A,D CPL ADD A,44 LD D,A LD A,E ADD A,80 LD E,A XOR A SYSTEM RELAB1 EX DE,HL POP DE SCF RET ; KB - FUNCTION TO RETURN NEXT CHARACTER FROM KEYBOARD GETKB PUSH BC PUSH DE CALL CHKIO POP DE KBLNKX POP BC LD L,A LD H,0 RET ; DEVICE VARIABLE TO OUTPUT TO REFERENCED IO PORT PUTIO RST RSTPAR ; GET PORT # TSTC '=',PUTCD2 ; GET EQUALS PUSH HL ; SAVE PORT # RST RSTEXP ; EVALUATE EXPRESSION FOLLOWING LD A,L ; A=VALUE TO OUTPUT POP HL ; RESTORE PORT # PUSH BC LD B,H LD C,L OUT (C),A ; IT 1 POP BC RST RSTFIN ; GO HOME ; FUNCTION TO RETURN VALUE OF A GIVEN IO PORT IOFUN RST RSTPAR ; GET PORT NUMBA PUSH BC LD B,H LD C,L IN A,(C) JR KBLNKX ; DEVICE VARIABLE TO PLAY NOTE WITHOUT PRINTING PUTMU TSTC '=',PUTCD2 RST RSTEXP LD A,L CALL PNOTE RST RSTFIN ; DEVICE VARIABLE TO OUTPUT CHARACTER ON VDM PUTCD TSTC '=',PUTCD2 RST RSTEXP LD A,L CALL OUTCH RST RSTFIN PUTCD2 JP QWHAT ; ROUTINE TO TRANSFER CONTROL TO ASSEMBLY LANGUAGE SUBROUTINE DOCALL LD HL,BBRET ; PUSH RETURN ADDR ON STACK PUSH HL RST RSTEXP ; GET ADDRESS JP (HL) ; AND JUMP TO IT ; ** TINY BASIC EXECUTION STARTS HERE ** ; CLEAR WHOLE KIT AND KABOOBLE BEGIN XOR A OUT (MAGIC),A LD H,A LD L,A LD (HL),A ; MAKE SURE SHIFTER FLUSHED BEGIN1 LD (HL),A INC HL BIT 4,H JR Z,BEGIN1 LD SP,SYSRAM SYSTEM INTPC DO SETOUT DB 176 DB 44 DB 18H ; INITIALIZE DEVICE VARIABLES DO MOVE ; MOVE BYTES (SYSTEM ROUTINE) DW DEVVAR DW 10 DW INIDEV DO MOVE ; MOVE BYTES (SYSTEM ROUTINE) DW ALTFON DW 07 DW FNTSYS DO MOVE ; MOVE BYTES (SYSTEM ROUTINE) DW HKVECT DW 14 DW HOOKER DO SETW ; STORE WORD (SYSTEM ROUTINE) DW 6A0H DW ALTFON DO SETW ; STORE WORD (SYSTEM ROUTINE) DW TXT+4 DW TXTUNF DO SETW ; STORE WORD (SYSTEM ROUTINE) DW 5555H DW 4002H ; TXT+2 DONT XINTC INIT0 DI IM 2 LD A,ITAB >> 8 LD I,A LD A,ITAB & 0FFH OUT (INFBK),A LD A,200 OUT (INLIN),A EI INIT CALL CRLF ; DIRECT COMMAND - TEXT COLLECTOR TELL STOP RSTART LD HL,(STACKP) LD SP,HL LD HL,XXST1+1 LD (CURRNT),HL XXST1 LD HL,0 LD (OLDCUR),HL LD (LOPVAR),HL LD (STKGOS),HL XXST2 LD A,'>' CALL GETLN PUSH DE LD DE,BUFFER CALL TSTNUM RST RSTIGN LD A,H OR L POP BC JR Z,EXEC0 LD (OLDLN),HL DEC DE LD A,H LD (DE),A DEC DE LD A,L LD (DE),A PUSH BC PUSH DE LD A,C SUB E PUSH AF CALL FNDLN PUSH DE JR NZ,XXST3 PUSH DE CALL FNDNXT POP BC LD HL,(TXTUNF) CALL MVUP LD H,B LD L,C LD (TXTUNF),HL XXST3 POP BC LD HL,(TXTUNF) POP AF PUSH HL CP 3 JR Z,RSTART ADD A,L LD E,A LD A,0 ADC A,H LD D,A LD HL,DFTLMT EX DE,HL CALL COMP JP NC,QSORRY LD (TXTUNF),HL POP DE CALL MVDOWN POP DE POP HL CALL MVUP JR XXST2 ; DIRECT AND EXEC EXEC0 RST RSTIGN ; GET FIRST NONBLANK PUSH DE ; SAVE POINTER SUB 68H ; IS SHE A TOKEN? JR C,EXEC0A ; NO CP 0DH JR NC,EXEC0A ; WE FOUND A TOKEN - LOOKUP IN TABLE AND JUMP TO IT RLCA LD E,A LD D,0 LD HL,TOKJT ADD HL,DE LD E,(HL) INC HL LD D,(HL) EX DE,HL POP DE INC DE JP (HL) ; NOT A TOKEN - A VARIABLE PERHAPS? EXEC0A CALL TSTV ; TEST FOR VARIABLE JR C,EXEC0B ; NO - SEARCH 1 TSTC '=',EXEC0B POP BC ; THROW OUT OLD PTR CALL SETV1 ; ASSIGNMENT 1 BBRET RST RSTFIN EXEC0B POP DE LD HL,TAB2-1 EXEC RST RSTIGN ; EXEC PUSH DE ; SAVE POINTER EX1 LD A,(DE) ; ZAPPED LDE INC DE INC HL CP (HL) JR Z,EX1 LD A,07FH DEC DE CP (HL) JR C,EX5 EX2 INC HL CP (HL) JR NC,EX2 INC HL POP DE JR EXEC EX5 LD A,(HL) ; LOAD HL WITH THE JUMP INC HL ; ADDRESS FROM TABLE LD L,(HL) AND 07FH LD H,A POP AF JP (HL) ; IF AND REM IFF RST RSTEXP LD A,H OR L JR NZ,RUNSML REM RUNNXL LD DE,(LINEND) JR RUNX1 RUN LD DE,TXT RUNX1 LD HL,0 CALL FNDLP JP C,RSTART RUNTSL LD (CURRNT),DE IN A,(14H) LD L,A IN A,(15H) AND L CP 20H CALL Z,PRTLNS OK CALL EXPAND LD DE,XQTBUF RUNSML CALL WHATSU ; CHECK FOR INTERRUPT KEY JR EXEC0 GOTO RST RSTEXP PUSH DE CALL FNDLN JP NZ,AHOW POP AF JR RUNTSL ; LIST AND PRINT ; NEW - IMPROVED LIST COMMAND ; LETS YOU PUT IT IN A PROGRAM LISTCOM LD HL,0 ; ASSUME AT EOL CALL IGNATNL JR Z,LS3 CP ',' ; LEADING COMMA? JR Z,LS3 ; YEP - SKIP FIRST EXPR GET ; NOT AT FIRST - GET FIRST EXPR LS2 RST RSTEXP LS3 PUSH HL LD HL,0FFFFH TSTCC COMMA,LS4 RST RSTEXP LS4 PUSH DE POP IY EX (SP),HL CALL FNDLN LS5 JR C,LSQUIT EX (SP),HL LD A,H OR L JR Z,LSQUIT DEC HL EX (SP),HL CALL PRTLNS CALL WHATSU CALL FNDLP JR LS5 LSQUIT PUSH IY POP DE RST RSTFIN PRINT LD C,8 ; C=# OF SPACES TSTCC 59,PR1 ; IF NULL LIST & ";" CALL CRLF ; GIVE CR-LF AND JR RUNSML ; CONTINUE SAME LINE PR1 TSTCC CR,PR6 ; IF NULL LIST (CR) CALL CRLF ; ALSO GIVE CR-LF AND JP IMCHEK ; GO TO NEXT LINE IF POSSIBLE PR2 TSTC '#',PR4 ; ELSE IS IT FORMAT? PR3 RST RSTEXP ; YES, EVALUATE EXPR. LD C,L ; AND SAVE IT IN C JR PR5 ; LOOK FOR MORE TO PRINT PR4 CALL QTSTG ; OR IS IT A STRING? JR PR9 ; IF NOT, MUST BE EXPR. PR5 TSTCC COMMA,PR8 ; IF COMMA, GO FIND NEXT PR6 TSTCC COMMA,PR7 CALL SPOUTCH JR PR6 PR7 CALL FIN ; IN THE LIST. JR PR2 ; LIST CONTINUES PR8 CALL CRLF ; LIST ENDS RST RSTFIN PR9 RST RSTEXP ; EVALUATE THE EXPR PUSH BC CALL PRTNUM ; PRINT THE VALUE POP BC JR PR5 ; PRINT THE VALUE ; * ************************************************************** ; * ; * *** GOSUB *** & *** RETURN *** ; * ; * 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' COMMAND, ; * EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER ETC. ARE SAVED ; * SO THAT EXECUTION CAN BE CONTINUED AFTER THE SUBROUTINE 'RETURN'. ; * IN ORDER THAT 'GOSUB' CAN BE NESTED (AND EVEN RECURSIVE), THE SAVE ; * AREA MUST BE STACKED. THE STACK POINTER IS SAVED IN 'STKGOS'. THE ; * OLD 'STKGOS' IS SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, ; * 'STKGOS' IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF CODE). ; * BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S. ; * ; * 'RETURN(CR)' UNDOES EVERYTHING THAT 'GOSUB' DID, AND THUS RETURN THE ; * EXECUTION TO THE COMMAND AFTER THE MOST RECENT 'GOSUB'. IF 'STKDOS' ; * IS ZERO, IT INDICATES THAT WE NEVER HAD A 'GOSUB' AND IS THUS AN ; * ERROR ; * GOSUB LD A,(CURRNT+1) ; DISALLOW FROM COMMAND RLCA JP NC,QHOW CALL PUSHA ; SAVE THE CURRENT "FOR" RST RSTEXP ; PARAMETERS PUSH DE ; AND TEXT POINTER CALL FNDLN ; FIND THE TARGET LINE JP NZ,AHOW ; NOT THERE. SAY "HOW?" LD HL,(CURRNT) ; SAVE OLD PUSH HL ; 'CURRENT' OLD 'STKGOS' LD HL,(STKGOS) PUSH HL LD HL,0 ; AND LOAD NEW ONES LD (LOPVAR),HL ADD HL,SP LD (STKGOS),HL JP RUNTSL ; THEN RUN THAT LINE RETURN LD HL,(STKGOS) ; OLD STACK POINTER LD A,H ; 0 MEANS NOT EXIST OR L JP Z,QWHAT ; SO, WE SAY: "WHAT?" LD SP,HL ; ELSE, RESTORE IT RESTO POP HL LD (STKGOS),HL ; AND THE OLD 'STKGOS' POP HL LD (CURRNT),HL ; AND THE OLD 'CURRNT' POP DE CALL POPA CALL EXPAND RST RSTFIN ; ******************************************* ; * ; * FOR *** & NEXT *** ; * ; * 'FOR' HAS TWO FORMS: 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND ; * 'FOR VAR=EXP1 TO EXP2'. THE SECOND FORM MEANS THE SAME THING ; * AS THE FIRST FORM WITH EXP3=1, (I.E. WITH A STEP OF +1) TBI ; * WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE CURRENT ; * VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3 AND SAVES ALL ; * THESE TOGETHER WITH THE TEXT POINTER ETC. IN THE 'FOR' SAVE AREA ; * WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', AND 'LOPPT'. ; * IF THERE IS ALREADY SOMETHING IN THE SAVE AREA (INDICATED BY A ; * NON-ZERO 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK ; * BEFORE THE NEW ONE OVERWRITES IT. TBI WILL THEN DIG IN THE STACK ; * AND FIND OUT IF THIS SAME VARIAABLE WAS USED IN ANOTHER CURRENTLY ; * ACTIVE 'FOR' LOOP. IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS ; * DEACTIVATED. (PURGED FROM THE STACK..) ; * ; * 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILY PHYSICAL) END OF ; * THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED WITH THE ; * 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN THE STACK TO FIND ; * THE RIGHT ONE AND PURGES ALL THOSE THAT DID NOT MATCH. EITHER WAY, ; * TBI THEN ADDS THE 'STEP' TO THAT VARIABLE AND CHECKS THE RESULT WITH ; * THE LIMIT. IF IT IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE ; * COMMAND FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA IS ; * PURGED AND EXECUTION CONTINUES. ; * FOR CALL PUSHA ; SAVE THE OLD SAVE AREA CALL SETVAL ; SET THE CONTROL VAR. DEC HL ; HL IS ITS ADDRESS LD (LOPVAR),HL ; SAVE THAT TSTCC 77H,FR1A ; TO? - LOOK FOR WORD "TO" FR1 RST RSTEXP ; EVALUATE THE LIMIT FR1A LD (LOPLMT),HL ; SAVE THAT LD HL,1 TSTCC 75H,FR4 ; STEP? RST RSTEXP FR4 LD (LOPINC),HL ; SAVE THAT TOO LD HL,(CURRNT) ; SAVE CURRENT LINE # LD (LOPLN),HL ; AND TEXT POINTER EX DE,HL LD (LOPPT),HL LD BC,10 ; DIG INTO STACK TO LD HL,(LOPVAR) ; FIND 'LOPVAR' EX DE,HL LD H,B LD L,B ; HL=0 NOW ADD HL,SP ; HERE IS THE STACK JR FR6 FR5 ADD HL,BC ; EACH LEVEL IS 10 DEEP FR6 LD A,(HL) ; GET THAT OLD 'LOPVAR' INC HL OR (HL) JR Z,FR7 ; 0 SAYS NO MORE IN IT LD A,(HL) DEC HL CP D ; SAME AS THIS ONE? JR NZ,FR5 LD A,(HL) ; THE OTHER HALF? XOR E JR NZ,FR5 EX DE,HL ; YES, FOUND ONE LD H,A LD L,A ADD HL,SP ; TRY TO MOVE SP LD B,H LD C,L LD HL,10 ADD HL,DE CALL MVDOWN ; AND PURGE 10 WORDS LD SP,HL ; IN THE STACK FR7 LD HL,(LOPPT) ; JOB DONE, RESTORE DE EX DE,HL RST RSTFIN ; AND CONTINUE NEXT CALL TSTV ; GET ADDRESS OF VAR. JP C,QWHAT ; NO VARIABLE, "WHAT?" LD (VARNXT),HL ; YES, SAVE IT NX1 PUSH DE ; SAVE TEXT POINTER EX DE,HL LD HL,(LOPVAR) ; GET VAR. IN 'FOR' LD A,H OR L ; 0 SAYS NEVER HAD ONE JP Z,AWHAT ; SO WE ASK: "WHAT?" CALL COMP ; ELSE WE CHECK THEM JR Z,NX2 ; OK, THEY AGREE POP DE ; NO, LET'S SEE CALL POPA ; PURGE CURRENT LOOP LD HL,(VARNXT) ; AND POP ONE LEVEL JR NX1 ; GO CHECK AGAIN NX2 EX DE,HL ; COME HERE WHEN AGREED RST RSTLDE ; DE=VALUE OF VAR. LD L,A INC DE RST RSTLDE LD H,A EX DE,HL LD HL,(LOPINC) PUSH HL LD A,H XOR D ; S=SIGN OF DIFFER LD A,D ; A=SIGN OF DE ADD HL,DE ; ADD ONE STEP JP M,NX3 ; CANNOT OVERFLOW XOR H ; MAY OVERFLOW JP M,NX5 ; AND IT DID NX3 EX DE,HL LD HL,(LOPVAR) ; PUT IT BACK CALL STDEHL LD HL,(LOPLMT) ; HL=LIMIT POP AF ; OLD HL RLCA ; EXAMINE SIGN BIT JR NC,NX4 ; IF POS SKIP EX DE,HL EX DE,HL NX4 CALL CKHLDE ; COMPARE WITH LIMIT POP DE ; RESTORE TEST POINTER JR C,NX6 ; OUTSIDE LIMIT LD HL,(LOPLN) ; WITHIN LIMIT, GO LD (CURRNT),HL ; BACK TO THE SAVED LD HL,(LOPPT) ; 'CURRNT' AND TEXT EX DE,HL ; POINTER CALL EXPAND RST RSTFIN NX5 POP HL ; OVERFLOW , PURGE ; RESTO LINKS IN HERE NXXX POP DE ; GARBAGE IN STACK NX6 CALL POPA ; PURGE THIS LOOP RST RSTFIN ; * ; ********************************************************* ; * ; * IF *** INPUT *** & LET (& DEFLT) **** ; * ; * ; * 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE COMMANDS ; * (INCLUDING OTHER 'IF'S). SEPARATED BY SEMI-COLONS. NOTE THAT THE ; * WORD 'THEN' IS NOT USED. TBI EVALUATES THE EXPR. IF IT IS NON-ZERO, ; * EXECUTION CONTINUES. IF THE EXPR. IS ZERO, THE COMMANDS THAT ; * FOLLOW ARE IGNORED AND EXECUTION CONTINUES AT THE NEXT LINE. ; * ; * 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED BY A ; * LIST OF ITEMS. IF THE ITEM IS A STRING IN A SINGLE OR DOUBLE QUOTES, ; * OR IS AN UP-ARROW, IT HAS THE SAME EFFECT AS IN 'PRINT'. IF AN ITEM ; * IS A VARIABLE, THIS VARIABLE NAME IS PRINTED OUT FOLLOWED BY A ; * COLON. THEN TBI WAITS FOR AN EXPR. TO BE TYPED IN. THE VARIABLE IS ; * THEN SET TO THE VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY ; * A STRING (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STING WILL BE ; * PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. AND ; * SET THE VARIABLE TO THE VALUE OF THE EXPR. ; * ; * IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", "HOW?", OR ; * 'SORRY' AND REPRINT THE PROMPT AND REDO THE INPUT. THE EXECUTION ; * WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. THIS IS HANDLED IN ; * 'INPERR'. ; * INPERR LD HL,(STKINP) ; *** INPERR *** LD SP,HL ; RESTORE OLD SP POP HL ; AND OLD 'CURRNT' LD (CURRNT),HL POP DE ; AND OLD TEXT POINTER POP DE ; REDO INPUT CALL EXPMAN ; EXPAND THAT LINE OUT INPUT EQU $ IP1 PUSH DE ; SAVE IN CASE OF ERROR CALL QTSTG ; IS NEXT ITEM A STRING? JR IP8 ; NO IP2 CALL TSTV ; YES, BUT FOLLOWED BY A JR C,IP5 ; M6I VARIABLE? NO. IP3 CALL IP12 LD DE,BUFFER ; POINTS TO BUFFER RST RSTEXP ; EVALUATE INPUT POP DE ; OK, GET OLD HL EX DE,HL CALL STDEHL IP4 POP HL ; GET OLD 'CURRNT' LD (CURRNT),HL POP DE ; AND OLD TEXT POINTER CALL EXPMAN IP5 POP AF ; PURGE JUNK IN STACK IP6 TSTCC COMMA,IP7 ; IS NEXT CH. ','? JR INPUT ; YES, MORE ITEMS. IP7 RST RSTFIN IP8 PUSH DE ; SAVE FOR 'PRTSTG' CALL TSTV ; MUST BE VARIABLE NOT JP C,QWHAT ; "WHAT?" IT IS NOT? IP11 LD B,E POP DE CALL PRTCHS ; PRINT THOSE AS PROMPT JR IP3 ; YES, INPUT VARIABLE IP12 POP BC ; RETURN ADDRESS PUSH DE ; SAVE TEXT POINTER EX DE,HL LD HL,(CURRNT) ; ALSO SAV 'CURRNT' PUSH HL LD HL,IP1 ; A NEGATIVE NUMBER LD (CURRNT),HL ; AS A FLAG LD HL,0 ; SAVE SP TOO ADD HL,SP LD ( STKINP),HL PUSH DE ; OLD HL PUSH BC LD A,' ' JP GETLN ; AND GET A LINE ; ********************************************* ; * ; ** EXPR ** ; * ; * 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS ; * ::= ; * ; * WHERE IS ONE OF THE OPERATORS IN TAB6 AND THE RESULT OF ; * THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. ; * ::=(+ OR -)(+ OR -)(...) ; * WHERE () ARE OPTIONAL AND (...) ARE OPTIONAL REPEATS. ; * ::=<(<* OR />)(...) ; * ::= ; * ; * () ; * IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN AS ; * INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND ; * CAN BE AN IN PARENTHESES. EXPR CALL EXPR1 ; *** EXPR *** PUSH HL ; SAVE VALUE LD HL,TAB6-1 ; LOOKUP REL.OP. JP EXEC ; GO DO IT. XPR1 CALL XPR8 ; REL.OP. ">=" RET C ; NO, RETURN HL=0 LD L,A ; YES, RETURN HL=1 RET XPR2 CALL XPR8 ; REL.OP. "#" RET Z ; FALSE, RETURN HL=0 LD L,A ; TRUE, RETURN HL=1 RET XPR3 CALL XPR8 ; REL.OP. ">" RET Z ; FALSE RET C LD L,A ; TRUE, RETURN HL=1 RET XPR4 CALL XPR8 ; REL.OP "<=" LD L,A ; SET HL=1 RET Z ; REL. TRUE, RETURN RET C LD L,H ; ELSE SET HL=0 RET XPR5 CALL XPR8 ; REL.OP. "=" RET NZ ; FALSE, RETURN HL=0 LD L,A ; ELSE SET HL=1 RET XPR6 CALL XPR8 ; REL.OP. "<" RET NC ; FALSE, RETURN HL=0 LD L,A ; ELSE SET HL=1 RET XPR7 POP HL ; NOT REL.OP. RET ; RETURN HL= XPR8 LD A,C ; SUBROUTINE FOR ALL POP HL ; REL.OP.'S POP BC PUSH HL ; REVERSE TOP OF STACK PUSH BC LD C,A CALL EXPR1 ; SET 2ND EX DE,HL ; VALUE IN DE NOW EX (SP),HL ; 1ST IN HL CALL CKHLDE ; COMPARE 1ST WITH 2ND POP DE ; RESTORE TEXT POINTER LD HL,0 ; SET HL=0, A=1 LD A,1 RET EXPR1 TSTC '-',XP11 ; NEGATIVE SIGN? LD HL,0 ; YES, FAKE "0-" JR XP16 ; TREAT LIKE SUBTRACT XP11 TSTC '+',XP12 ; POSITIVE SIGN? IGNORE XP12 CALL EXPR2 ; 1ST XP13 TSTC '+',XP15 ; ADD? PUSH HL ; YES, SAVE VALUE CALL EXPR2 ; GET 2ND XP14 EX DE,HL ; 2ND IN DE EX (SP),HL ; 1ST IN HL LD A,H ; COMPARE SIGN XOR D LD A,D ADD HL,DE POP DE ; RESTORE TEST POINTER JP M,XP13 ; 1ST 2ND SIGN DIFFER XOR H ; 1ST 2ND SIGN EQUAL JP P,XP13 ; SO IS RRESULT JP QHOW ; ELSE WE HAVE OVERFLOWN XP15 TSTC '-',XPR9 ; SUBTRACT? XP16 PUSH HL ; YES, SAVE 1ST CALL EXPR2 ; GET 2ND CALL CHGSGN ; NEGATE JR XP14 ; AND ADD THEM EXPR2 CALL EXPR3 ; GET 1ST XP21 TSTCC 62H,XP24 ; MULTIPLY? PUSH HL ; YESY, SAVE 1ST CALL EXPR3 ; AND GET 2ND LD B,0 ; CLEAR B FOR SIGN CALL CHKSGN ; CHECK SIGN EX (SP),HL ; 1ST IN HL CALL CHKSGN ; CHECK SIGN OF 1ST EX DE,HL EX (SP),HL LD A,H ; IS HL > 255? OR A JR Z,XP22 ; NO LD A,D ; YES, HOW ABOUT DE OR D EX DE,HL ; PUT SMALLER IN DE JP NZ,AHOW ; ALSO >, WILL OVERFLOW XP22 LD A,L ; THIS IS DUMB LD HL,0 ; CLEAR RESULT OR A ; ADD AND COUNT NERDXX JR Z,XP25 XP23 ADD HL,DE JP C,AHOW ; OVERFLOW DEC A JR NERDXX ; FINISHED XP24 TSTCC 63H,XPR9 ; DIVIDE? PUSH HL ; YES, SAVE 1ST CALL EXPR3 ; AND GET 2ND ONE LD B,0 ; CLEAR B FOR SIGN CALL CHKSGN ; CHECK SIGN OF 2ND EX (SP),HL ; GET 1ST IN HL CALL CHKSGN ; CHECK SIGN OF 1ST EX DE,HL EX (SP),HL EX DE,HL LD A,D ; DIVIDE BY 0? OR E JP Z,AHOW ; SAY "HOW?" PUSH BC ; ELSE, SAVE SIGN CALL DIVIDE ; USE SUBROUTINE POP DE ; SIGN STUFF TO DE PUSH BC ; SAVE DIVIDE RESULT BIT 7,D ; WAS SIGN SET? CALL NZ,CHGSGN ; YEP - CHANGE LD (REMAIN),HL ; STUFF IT POP HL ; RESULT IN HL LD B,D ; COPY OVER SIGN STUFF LD C,E XP25 POP DE ; GET TEXT POINTER BACK LD A,H ; HL MUST BE + OR A JP M,QHOW ; ELSE IT IS OVERFLOW LD A,B OR A CALL M,CHGSGN ; CHANGE SIGN IF NEEDED JR XP21 ; LOOK FOR MORE TERMS EXPR3 LD HL,TAB3-1 ; FIND FUNCTION IN TAB3 JP EXEC ; AND GO DO IT NOTF CALL TSTV ; NO, NOT A FUNCTION JR C,XP32 ; NOR A VARIABLE EX DE,HL RST RSTLDE PUSH AF INC DE RST RSTLDE EX DE,HL LD H,A POP AF LD L,A RET XP32 CALL TSTNUM ; OR IS IT A NUMBER? LD A,B ; # OF DIGIT OR A RET NZ ; OK ; SINGLE CHAR STRING CONSTANT? TSTC '"',PARN ; HAVE WE GOT QUOTES? LD A,(DE) ; NAILED RSTLDE LD L,A ; FAILED TSTNUM SET H TO ZERO INC DE TSTC '"',XPRO ; ERROR IF NO TRAILING RET ; ***** ; * PARN TSTC '(',XPRO ; NO DIGIT, MUST BE PARNP RST RSTEXP ; "(EXPR)" TSTC ')',XPRO XPR9 RET XPRO JP QWHAT ; ELSE SAY: "WHAT?" RND RST RSTPAR ; *** RND(EXOR) *** LD A,H ; EXPR MUST BE + OR A JP M,QHOW PUSH DE ; SAVE BOTH EX DE,HL ; DE = RANGE XOR A SYSTEM RANGED LD L,A XOR A SYSTEM RANGED LD H,A ; HL = RANDOM # PUSH BC LD A,D OR E CALL NZ,DIVIDE ; RND(N)=MOD(M,N)+1 POP BC POP DE INC HL RET ABS RST RSTPAR ; *** ABS(EXPR) *** DEC DE CALL CHKSGN ; CHECK SIGN INC DE RET SIZE LD HL,(TXTUNF) ; *** SIZE *** PUSH DE ; GET THE NUMBER OF EX DE,HL ; FREE BYTES BETWEEN 'TXTUNF' LD HL,DFTLMT ; AND 'TXTLMT' AND A SBC HL,DE POP DE RET ; FUNCTION TO SENSE DIAL VALUE GETPOT LD A,1BH CALL CHKRNG ; GET DATA CPL SUB 80H LD L,A ; FALL INTO... ; SIGN EXTEND SUBROUTINE SGNEXT LD H,0 LD A,L AND A RET P DEC H RET ; FUNCTION TO SENSE STATE OF TRIGGER GETTRG CALL CHKRN1 AND 10H RET Z INC L RET ; FUNCTIONS TO RETURN JOYSTICK VALUE ; THESE FUNCTIONS RETURN EITHER +1, 0, OR -1, DEPENDING ; ON JOYSTICK STATE GETJX CALL CHKRN1 ; PARM IN RANGE? RRCA RRCA RRCA JR C,GETJY3 RRCA JR C,GETJY1 RET ; ENTRY FOR Y JOYSTICK VALUE GETJY CALL CHKRN1 RRCA JR NC,GETJY2 GETJY1 INC HL RET GETJY2 RRCA RET NC GETJY3 DEC HL RET ; SUBROUTINE TO GET PARAMETER BETWEEN 1 AND 4 CHKRN1 LD A,0FH CHKRNG PUSH BC PUSH AF RST RSTPAR POP AF ADD A,L LD C,A IN A,(C) POP BC LD HL,0 RET ; * ; ********************************************** ; * *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** ; * ; * 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL ; * ; * 'SUBDE' SUBTRACTS DE FROM HL ; * ; * 'CHKSGN' CHECKS SIGN OF HL. IF +,NO CHANGE. IF -,CHANGE SIGN AND ; * FLIP SIGN OF B. ; * ; * 'CHKSGN' CHANGES SIGN OF HL AND B UNCONDITIONALLY. ; * ; * 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE ARE ; * INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER CASE, HL DE ; * ARE THEN COMPARED TO SET THE FLAGS. ; * DIVIDE PUSH HL ; *** DIVIDE *** LD L,H ; DIVIDE H BY DE LD H,0 CALL DV1 LD B,C ; SAVE RESULT IN B LD A,L ; (REMAINDER + L)/DE POP HL LD H,A DV1 LD C,-1 ; RESULT IN C DV2 INC C ; DUMB ROUTINE AND A SBC HL,DE JR NC,DV2 ADD HL,DE RET CHKSGN LD A,H ; *** CHKSGN *** OR A ; CHECK SIGN OF HL RET P ; IF -, CHANGE SIGN CHGSGN LD A,H ; *** CHGSGN *** OR L RET Z LD A,H PUSH AF CPL ; CHANGE SIGN OF HL LD H,A LD A,L CPL LD L,A INC HL POP AF ; XOR H ; JP QHOW LD A,B ; AND ALSO FLIB B XOR 80H LD B,A RET ; CKHLDE LD A,H ; *** CKHLDE *** ; XOR D ; SAME SIGN? ; JP CH1 ; YES, COMPARE ; EX DE,HL ; NO, XCH AND COMPARE ; CK1 CALL COMP ; RET ; COMP LD A,H ; *** COMP *** ; CMP D ; COMPARE HL WITH DE ; RET NZ ; RETURN CORRECT C AND ; LD A,L ; ZFLAGS ; CMP E ; BUT OLD A IS LOST ; RET ; * ************************************************** ; * ; * *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS)*** ; * ; * "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND THEN AN ; * EXPR. IT EVALUATES THE EXPR. AND SETS THE VARIABLE TO THAT VALUE. ; * ; * "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";",EXECUTION ; * CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE NEXT LINE AND ; * CONTINUES FROM THERE. ; * ; * "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS REQUIRED IN ; * CERTAIN COMMANDS. (GOTO,RETURN,AND STOP ETC.) ; * ; * "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). IT THEN ; * PRINTS THE LINE POINTED BY 'CURRENT' WITH A "?" INSERTED AT WHERE THE ; * OLD TEXT POINTER (SHOULD BE ON TOP OF THE STACK) POINTS TO. ; * EXECUTION OF TB IS STOPPED AND TBI IS RESTARTED. HOWEVER, IF ; * 'CURRNT'=> ZERO (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND ; * IS NOT PRINTED. AND IF 'CURRNT'=>NEGATIVE # (INDICATING 'INPUT' ; * COMMAND, THE INPUT LINE IS NOT PRINTED AND EXECUTION IS NOT ; * TERMINATED BUT CONTINUED AT 'INPERR'. ; * ; * RELATED TO 'ERROR' ARE THE FOLLOWING: 'QWHAT' SAVES TEXT POINTED IN ; * STACK AND GET MESSAGE "WHAT?" JUST GETS MESSAGE "WHAT?" AND ; * JUMP TO 'ERROR'. 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. ; * 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION DO THIS. ; * SETVAL CALL TSTVFF ; *** SETVAL *** TSTC '=',QWHAT ; 2WHAT?" NO VARIABLE SETV1 PUSH HL ; SAVE ADDRESS OF VAR. RST RSTEXP ; EVALUATE EXPR. EX DE,HL EX (SP),HL CALL STDEHL POP DE RET FINISH CALL FIN ; CHECK END OF COMMAND JR QWHAT ; PRINT "WHAT?" IF WRONG FIN TSTCC 59,FI1 ; *** FIN *** POP AF ; ";", PURGE RET ADDR. JP RUNSML ; CONTINUE SAME LINE FI1 TSTCC CR,FI2 ; NOT ";", IF IT CR? POP AF ; PURGE RETURN ADDRESS IMCHEK LD A,(CURRNT+1) RLCA JP NC,RSTART JP RUNNXL ; RUN NEXT LINE QWHAT PUSH DE ; *** QWHAT *** AWHAT LD DE,WHAT ; *** AWHAT *** ERROR CALL CRLF ; *** ERROR *** CALL PRTSTG ; PRINT ERROR MESSAGE LD HL,(CURRNT) ; GET CURRENT LINE # PUSH HL EX DE,HL ; CHECK THE VALUE RST RSTLDE LD H,A INC DE RST RSTLDE OR H EX DE,HL POP DE JP Z,TELL ; IF ZERO, JUST RESTART EX DE,HL ; IF NEGATIVE RST RSTLDE EX DE,HL OR A JP M,INPERR ; REDO INPUT CALL PRTLN ; ELSE PRINT THE LINE POP HL ; HL=ERROR ADDR LD BC,XQTBUF AND A SBC HL,BC ADD HL,DE LD B,L CALL PRTCHS CALL OUTCHQ CALL PRTSTG ; LINE JP TELL ; THEN RESTART QSORRY PUSH DE ; *** QSORRY *** ASORRY LD DE,SORRY ; *** ASORRY *** JR ERROR ; * ***************************************** ; * ; * *** FNDLN (& FRIENDS) *** ; * ; * 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE TEXT SAVE ; * AREA. DE IS USED AS THE TEXT POINTER. IF THE LINE IS FOUND, DE ; * WILL POINT TO THE BEGINNING OF THAT LINE (I.E., THE LOW BYTE OF THE ; * LINE #), AND FLAGS ARE NC & Z. IF THAT LINE IS NOT THERE AND A LINE ; * WITH A HIGHER # IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & ; * NZ. IF WE REACHED THE END OF TEXT SAVE AREA AND CAN NOT FIND THE ; * LINE, FLAGS ARE C & NZ. 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING ; * OF THE TEXT SAVE AREA TO START THE SEARCH. SOME OTHER ENTRIES OF ; * THIS ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. 'FNDLP' ; * WILL START WITH DE AND SEARCH FOR THE LINE #. 'FINDNXT' WILL BUMP DE ; * BY 2, FIND A CR AND THEN START SEARCH. 'FNDSKP' USES DE TO FIND A ; * CR, AND THEN STARTS SEARCH. ; * FNDLN LD A,H ; *** FNDLN *** OR A ; CHECK SIGN OF HL JP M,QHOW ; IT CANNOT BE - LD DE,TXT ; INIT. TEXT POINTER FNDLP INC DE ; IS EDT MARK? RST RSTLDE LD C,A DEC DE ADD A,A RET C RST RSTLDE ; C,NZ PASSED END SUB L ; WE DID NOT, GET BYTE 1 LD B,A ; IS THIS THE LINE? INC DE ; COMPARE LOW ORDER LD A,C ; GET BYTE 2 SBC A,H ; COMPARE HIGH ORDER JR C,FL1 ; NO, NOT THERE YET DEC DE ; ELSE WE EITHER FOUND OR B ; IT, OR IT IS NOT THERE FI2 RET ; NC,Z: FOUND; NC,NZ: NO FNDNXT INC DE ; FIND NEXT LINE FL1 INC DE ; JUST PASSED BYTE ; FASTER FNDSKP FNDSKP EX DE,HL ADD HL,HL ; CONVERT TO 'NORMAL' FS01 LD A,(HL) ; GET NEXT BYTE RLCA ; COMBINE WITH FOLLOWING FELLA INC HL XOR (HL) ; TO MAKE THE REAL DATA AND 0AAH XOR (HL) INC HL CP CR ; HIT A CR YET? JR NZ,FS01 ; NO SIR EEE SCF ; WE GOT IT RR H ; NORMALIZE OUR POINTER RR L EX DE,HL JR FNDLP ; REENTER FIND LOOP ; SUBROUTINE TO GRAB AND VERIFY SUBSCRIPT GETSUB POP IY ; STICK RETURN INTO IY INC DE ; SKIP DA NAME RST RSTPAR ; GET THE PARM ADD HL,HL ; CONVERTETH TO BYTES JP C,QHOW ; REJECT ABSURD VALUES PUSH DE ; SAVE SCAN PTR EX DE,HL CALL SIZE ; CHECK FOR VALID SUBSCRIPT CALL COMP JR C,ASORRY ; APOLOGIZE FOR RANGE ERR JP (IY) ; GO HOME TSTV RST RSTIGN ; *** TSTV *** CP '%' ; PEEK-POKE? JR Z,TSTV0 CP '*' ; BACKWARDS ARRAY? JR Z,STARR ; YEP - JUMP TO IT SUB '@' ; TEST VARIABLES RET C ; C: NOT A VARIABLE JR NZ,TV1 ; NOT "@" ARRAY CALL GETSUB LD HL,(TXTUNF) DEC HL DEC HL ADD HL,DE POP DE RET ; PROCESS BACKWARDS ARRAY STARR CALL GETSUB LD HL,DFTLMT ; SUBTRACT INDEX FROM END SBC HL,DE POP DE XOR A ; NO CY SHIT RET ; %(ADDR) PEEK-POKE CALL TSTV0 INC DE RST RSTPAR ; GET ADDR XOR A ; CLEAR CY RET ; AND GO BACK TV1 CP 27 ; NOT @, IS IT A TO Z CCF ; IF NOT RETURN C FLAG RET C INC DE ; IF A THROUGH Z ; IS SECOND CHARACTER ALSO ALPHA? LD L,A ; SAVE FIRST ONE LD A,(DE) ; ZAPPED RSTLDE CP 'A' JR C,DEVV4 ; IF NOT IN RANGE A-Z CP 'Z'+1 JR NC,DEVV4 ; THEN SEARCH PUSH BC PUSH DE LD H,A ; SECOND CHAR TO H LD B,PARNUM ; B - ITERATION CTR LD DE,DEVLST ; DE - SEARCH TABLE DEVV1 LD A,(DE) ; GET FIRST ENTRY INC DE CP L LD A,(DE) INC DE JR NZ,DEVV2 CP H JR NZ,DEVV2 ; MATCH FOUND - FIGURE OUT LOOKUP INDEX LD A,B ADD A,26 LD L,A POP DE INC DE ; BUMP CHAR PTR JR DEVV3 ; MISMATCH - LOOP BACK IF POSS DEVV2 DJNZ DEVV1 ; NOT POSSIBLE - RETURN NOT A VAR POP DE POP BC DEC DE ; BACKUP TO CHAR START SCF ; SET CARRY RET DEVV3 POP BC DEVV4 LD A,L LD HL,VARBGN-2 RLCA ADD A,L LD L,A LD A,0 ADC A,H LD H,A RET ; * ; * *************************************** ; * ; * ***TSTCH *** TSTNUM *** ; * ; * TSTCH IS USED TO TEST THE NEXT NON-BLANK CHARACTER IN THE TEXT ; * (POINTED BY DE) AGAINST THE CHARACTER THAT FOLLOWS THE CALL. IF ; * THEY DO NOT MATCH, N BYTES OF CODE WILL BE SKIPPED OVER, WHERE N IS ; * BETWEEN 0 & 255 AND IS STORED IN THE SECOND BYTE FOLLOWING THE CALL ; * ; * TSTNUM IS USED TO CHECK WHETHER THE TEXT (POINTED BY DE) IS A ; * NUMBER. IF A NUMBER IS FOUND, B WILL BE NON-ZERO AND HL WILL ; * CONTAIN THE VALUE (IN BINARY) OF THE NUMBER, ELSE B AND HL ARE 0. ; * TSTCH EX (SP),HL ; *** TSTCH *** RST RSTIGN ; IGNORE LEADING BLANKS CP (HL) ; AND TEST THE CHARACTER INC HL ; COMPARE THE BYTE THAT JR Z,TC1 ; FOLLOWS THE CALL INTS. PUSH BC ; WITH TEXT (DE->) LD C,(HL) ; IF NOT =, ADD THE 2ND LD B,0 ; BYTE THAT FOLLOWS THE ADD HL,BC ; CALL TO THE OLD PC POP BC ; I.E., DO A RELATIVE DEC DE ; JUMP IF NOT = TC1 INC DE ; IF =, SKIP THOSE BYTES INC HL ; AND CONTINUE EX (SP),HL RET TSTNUM LD HL,0 ; *** TSTNUM *** LD B,H ; TEST IF THE TEXT IS RST RSTIGN ; A NUMBER TN1 CP '0' ; IF NOT, RETURN 0 IN RET C ; B AND HL CP 3AH ; IF NUMBERS, CONVERT RET NC ; TO BINARY IN HL AND LD A,0F0H ; SET B TO # OF DIGITS AND H ; IF H>255, THERE IS NO JR NZ,QHOW ; ROOM FOR NEXT DIGIT INC B ; B COUNTS # OF DIGITS PUSH BC LD B,H ; HL=10*HL+(NEW DIGIT) LD C,L ADD HL,HL ; WHERE 10* IS DONE BY ADD HL,HL ; SHIFT AND ADD ADD HL,BC ADD HL,HL LD A,(DE) ; AND (DIGIT) IS FROM INC DE ; STRIPPING THE ASCII AND 00FH ; CODE ADD A,L LD L,A LD A,0 ADC A,H LD H,A POP BC LD A,(DE) ; DO THIS DIGIT AFTER JP P,TN1 ; DIGIT. S SAYS OVERFLOW QHOW PUSH DE ; *** ERROR: "HOW?" *** AHOW LD DE,HOW JP ERROR ; MVUP, MVDOWN, POPA, AND PUSHA ; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> ; UNTIL DE=HL ; ; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> ; UNTIL DE=BC ; ; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE STACK ; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE STACK MVUP CALL COMP ; *** MVUP *** RET Z ; DE=HL, RETURN RST RSTLDE ; GET ONE BYTE PUSH HL ; SHOVEL REGS LD H,B LD L,C CALL STHL ; MOVE IT POP HL INC DE ; INCREASE BOTH POINTERS INC BC JR MVUP ; UNTIL DONE MVDOWN LD A,B ; *** MCDOWN *** SUB D ; TEST IF DE = BC JR NZ,MD1 ; NO, GO MOVE LD A,C ; MAYBE, OTHER BYTE SUB E RET Z ; YES, RETURN MD1 DEC DE ; ELSE MOVE A BYTE DEC HL ; BUT FIRST DECREASE RST RSTLDE ; BOTH PTRS AND THEN CALL STHL ; DO IT JR MVDOWN ; LOOP BACK POPA POP BC ; BC = RETURN ADDR. POP HL ; RESTORE LOPVAR, BUT LD (LOPVAR),HL ; =0 MEANS NO MORE LD A,H OR L JR Z,PP1 ; YEP, GO RETURN POP HL ; NO, RESTORE OTHERS LD (LOPINC),HL POP HL LD (LOPLMT),HL POP HL LD (LOPLN),HL POP HL LD (LOPPT),HL PP1 PUSH BC ; BC = RETURN ADDR. RET PUSHA LD HL,-STKLMT ; *** PUSHA *** POP BC ; BC = RETURN ADDR. ADD HL,SP ; IS STACK NEAR THE TOP? JP NC,QSORRY ; YES - SORRY FOR THAT LD HL,(LOPVAR) ; ELSE SAVE LOOP VAR.S LD A,H ; BUT IF LOPVAR IS 0 OR L ; THAT WILL BE ALL JR Z,PU1 LD HL,(LOPPT) ; ELSE MORE TO SAVE PUSH HL LD HL,(LOPLN) PUSH HL LD HL,(LOPLMT) PUSH HL LD HL,(LOPINC) PUSH HL LD HL,(LOPVAR) PU1 PUSH HL PUSH BC ; BC = RETURN ADDR. RET ; PRTSTG, QTSTG, PRTNUM, PRTLN ; 'PRTSRG' PRINTS A STRING POINTED AT BY DE. IT STOPS ; PRINTING AND RETURNS TO CALLER WHEN EITHER A CR IS ; PRINTED OR WHEN THE NEXT BYTE IS ZERO. REG. A AND B ; ARE CHANGED. REG. DE POINTS TO WHAT FOLLOWS THE CR ; OR TO THE ZERO ; 'QTSTG' LOOKS FOR SINGLE QUOTE, OR DOUBLE QUOTE. IF ; EITHER IT PRINTS THE STRING UNTIL MATCHING UNQUOTE ; AND RETURNS 2 BYTES LATE. ; 'PRTNUM' PRINTS THE NUMBER HL. LEADING BLANKS ARE ADDED IF ; NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. ; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN C, ; ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO PRINTED ; AND COUNTED IN. POSITIVE SIGN IS NOT. ; 'PRTLN' FINDS A SAVED LINE, PRINTS THE LINE # AND A SPACE. PRTLNS CALL PRTLN PRTSTG SUB A ; *** PRTSTG *** PS1 LD B,A PS2 RST RSTLDE ; GET A CHARACTER INC DE ; BUMP POINTER CP B ; SAME AS OLD A RET Z ; YES, RETURN CALL OUTCH ; ELSE PRINT IT CP CR ; WAS IT A CR? JR NZ,PS2 ; NO - NEXT RET ; YES-RETURN QTSTG RST RSTLDE INC DE ; BUMP PAST CP '"' JR Z,QT1 ; IF SINGLE QUITE-PRINT IT CP 27H ; OR IF DOUBLE JR Z,QT1 ; LIKEWISE DEC DE RET QT1 CALL PS1 ; PRINT UNTIL ANOTHER QT2 CP CR ; WAS LAST ONE A CR? POP HL ; RETURN ADDRESS JP Z,IMCHEK ; WAS CR, END OF THIS INC HL ; SKIP 2 BYTES, THE RET INC HL JP (HL) PRTCHS LD A,E CP B RET Z RST RSTLDE CALL OUTCH INC DE JR PRTCHS PRTNUM EQU $ ; *** PRTNUM *** PN3 LD B,0 ; B=SIGN CALL CHKSGN ; CHECK SIGN JP P,PN4 ; NO SIGN LD B,'-' ; B=SIGN DEC C ; '-' TAKES SPACE PN4 PUSH DE LD DE,10 PUSH DE DEC C PUSH BC PN5 CALL DIVIDE ; DIV HL BY 10 LD A,B ; RESULT 0 OR C JR Z,PN6 ; YES, WE GOT ALL EX (SP),HL ; NO SAVE REMAINDER DEC L ; AND COUNT SPACE PUSH HL ; HL IS OLD BC LD H,B ; MOVE RESULT TO BC LD L,C JR PN5 ; AND DIV BY 10 PN6 POP BC ; WE GOT ALL DIGITS IN PN7 DEC C ; THE STACK BIT 7,C ; IF SPACE COUNT NEG JR NZ,PN8 ; NO LEADING BLANKS CALL SPOUTCH ; SPACE OUTCH JR PN7 ; MORE? PN8 LD A,B ; PRINT SIGN OR A CALL NZ,OUTCH ; MOAYBE - OR NULL LD E,L ; LAST REMAINDER IN E PN9 LD A,E ; CHECK DIGIT IN E CP 10 ; 10 IS FLAG FOR NO MORE POP DE RET Z ; IF SO RETURN ADD A,'0' CALL OUTCH ; AND PRINT THE DIGIT JR PN9 ; GO BACK FOR MORE PRTLN RST RSTLDE ; *** PRTLN*** LD L,A ; LOW ORDER LINE # INC DE RST RSTLDE ; HIGH ORDER LD H,A INC DE LD C,2 ; PRINT 2 DIGIT LINE # CALL PRTNUM SPOUTCH LD A,' ' ; FOLLOWED BY BLANK JP OUTCH TAB2 ITEM 'TV',PUTCD ; DIRECT-STATEMENT ITEM 'MU',PUTMU ITEM '&',PUTIO ITEM 'CALL',DOCALL ITEM '.',REM DB ':' TOKEN 74H,TOUTPU DB ':' TOKEN 73H,TINPUT DB ':' TOKEN 6AH,TLOAD DB ':' TOKEN 68H,TVLIST TOKEN 60H,SILENCE ITEM 'STOP',STOP DEFF FINISH TAB3 TOKEN 76H,RND ; FUNCTIONS ITEM 'KN',GETPOT ITEM 'TR',GETTRG ITEM 'JX',GETJX ITEM 'JY',GETJY ITEM 'KP',GETKB ITEM 'PX',PIXFUN ITEM '&',IOFUN ITEM 'ABS',ABS ITEM 'SZ',SIZE DEFF NOTF TAB6 ITEM '>=',XPR1 ; RELATION OPS ITEM '#',XPR2 ITEM '>',XPR3 ITEM '=',XPR5 ITEM '<=',XPR4 ITEM '<',XPR6 DEFF XPR7 RANEND EQU $ GLED LD A,(EDFLG) AND A JR Z,GLEDA LD DE,BUFFER CALL TSTNUM CALL FNDLN LD A,'?' RET NZ INC DE CALL GLEDB XOR A LD (EDFLG),A GLEDA LD DE,(EDPTR) RST RSTLDE GLEDB INC DE LD (EDPTR),DE RET GETLN LD DE,BUFFER LD (EDFLG),A GL1 CALL OUTCH ; PROMPT OR ECHO GL2 PUSH BC PUSH HL PUSH DE ; PLACE UP CURSOR BLOCK LD C,0AAH CALL CURSE ; RETURN CHAR FROM NEXT LINE # GL2A LD HL,NLLNCT LD A,(HL) ; SENSE FLAG AND A JR Z,GL2C DEC (HL) ; FIRST TIME THRU? CP 5 JR NZ,GL2B ; JUMP IF NOT ; GET PREVIOUS LINE # AND BUMP IT LD HL,(OLDLN) LD DE,10 ADD HL,DE RES 7,H ; ALLOW NEG GL2J LD (NLLNLN),HL ; MOVE TO WORKING RAM CELL ; COMPUTE DIVISION SUBTRACTOR GL2B SYSSUK INDEXW DW TBLDIV-2 LD HL,(NLLNLN) LD B,0 GL2E AND A SBC HL,DE JP M,GL2F INC B JR GL2E GL2F ADD HL,DE LD (NLLNLN),HL LD HL,NLLNZS LD A,B AND A JR NZ,GL2G LD A,(HL) AND A JR Z,GL2A ; YES - JUMP BACK XOR A GL2G ADD A,'0' ; MAKE ASCII LD (HL),A ; ET NONZERO FLAG JR GL2D ; NOTHIN FANCY GL2C CALL CHKIO ; GET NORMAL CHARACTER POP DE LD (DE),A ; STUFF CHAR AS DELIMITER PUSH DE CP EDKEY CALL Z,GLED GL2D POP DE POP HL POP BC GL3 LD (DE),A CP RUBOUT JR NZ,GL4 LD A,E CP BUFFER & 0FFH JR Z,GL2 DEC DE LD A,(DE) CP 68H ; TOKEN TO RUB OUT? JR NC,TOKIN CALL PNOTE LD A,RUBOUT JR GL1 TOKIN PUSH DE CALL TOKEPT TOKER LD A,(HL) PUSH HL AND 7FH CALL PNOTE LD A,RUBOUT CALL VDM POP HL LD A,(HL) INC HL RLCA JR NC,TOKER TOKEQ LD A,RUBOUT CALL OUTCH ; ECHO ONE RUBOUT CHAR POP DE GL9 JP GL2 GL4 XOR CR JR Z,GL5 LD A,E CP BUFEND & 0FFH JR Z,GL9 LD A,(DE) INC DE JP GL1 GL5 INC DE INC DE DEC A LD (DE),A DEC DE CRLF LD A,CR JP OUTCH ; SUBROUTINE TO SIMULATE A CHARACTER DISPLAY IN ; THE ARCADE FRAME BUFFER. THE SIMULATED VDM HAS ; DIMENSIONS 26 CHARS BY 11 LINES. THE CHARACTER GRAPHICS ARE 5 X 7 ; IN A 6 X 8 FRAME. ALTERNATE FONT IS USED TO GET THIS. ; THE 64 UPPER CASE ASCII CHARACTERS ARE DISPLAYED BY THIS ; HANDLER. THE ASCII CONTROL CHARACTERS CARRIAGE RETURN AND ; RUBOUT ARE ALSO PROCESSED BY THIS HANDLER. CR CAUSES ; THE DISPLAY TO GO TO THE NEXT LINE OF THE DISPLAY, WITH ; SCROLL UP IF NECESSARY. RUBOUT CAUSES THE CURSOR TO MOVE ; BACKWARDS ONE CHARACTER POSITION. ; CHARACTER TO DISPLAY IS IN A. THE ALTERNATE REGISTER ; IS USED. XOUTCH PUSH AF EXX CALL VDM POP AF EXX RET ; SOME FUNNY GUYS ENTER HERE VDM CP CR JR Z,VDMOCR CP RUBOUT ; TRANSLATE TRASH TO ? JR Z,VDM1 JR C,FILT1 CP 78H JR C,FILT2 FILT1 LD A,'?' FILT2 CP 68H ; TOKEN TO PRINT? JR NC,TOKEP ; JUMP IF SO ; PLAY NOTE FOR THIS CHAR CALL PNOTE ; NON NEW LINE CHAR - UNWRITE OLD CURSOR VDM1 CALL UCURSE CALL LDVDMC CP RUBOUT ; WAS THAT RUBOUT? JR NZ,VDM3 ; JUMP IF NOT ; RUBOUT ENTERED - SO RUB OUT LD A,L ; GET X AND A ; IS X =0? JR Z,VDM2 ; YES - JUMP SUB 6 ; NO - BACKUP X LD L,A JR VDMDN1 ; AND JOIN STORE BACK VDM2 LD L,150 LD A,H SUB 8 LD H,A JR VDMDN1 ; NEW LINE CHAR - DID WE JUST WRAP AROUND VDMOCR LD A,(VDMNLF) ; CHECK OLD GLORY AND A JR NZ,VDMDON ; YES - SKIP DIDDLING CALL UCURSE ; NO - UNWRITE CURSOR CALL NEWLIN ; GO TO NEXT LINE JR VDMDON ; AND QUIT ; NORMAL CHARACTER ENTERED - DISPLAY IT VDM3 LD D,H ; COORDINATES TO DE LD E,L OR 80H ; ALT FONT THE CHAR LD C,011000B ; OR WRITE THE CHAR LD IX,ALTFON ; USING ALTERNATE CHAR F SYSTEM CHRDIS ; IT LD A,L ; ADVANCE X POINTER ADD A,6 LD L,A CP 156 ; END OF LINE? JR NZ,VDMDN1 ; NO - JUMP CALL NEWLIN ; YES - NEW 1 LINE LD A,1 ; AND SET NEW LINE FORCED FLAG JR VDMDN2 VDMDN1 CALL STVDMC VDMDON XOR A ; CLEAR NEW LINE FORCED FLAG VDMDN2 LD (VDMNLF),A RET ; ROUTINE TO DISPLAY A TOKEN IN FULL FORM TOKEP CALL TOKEPT TOKEP1 LD A,(HL) AND 7FH PUSH HL CALL VDM POP HL LD A,(HL) INC HL RLCA JR NC,TOKEP1 TOKEP2 LD A,' ' ; PUT SPACE AFTER TOKEN JP VDM ; AND GO HOME ; SUBROUTINE TO UNWRITE THE CURSOR UCURSE LD C,0 JR CURSE ; SUBROUTINE TO DISPLAY NEW LINE NEWLIN CALL LDVDMC ; IS SCROLL UP NEEDED? LD L,0 LD A,H CP 80 JR NZ,NEWL1 ; JUMP IF NOT NEEDED ; SCROLL UP IS NEEDED CALL STVDMC ; WHAT MODE SHALL WE USE? LD A,(SCRMOD) DEC A RET Z DEC A LD HL,4C80H JR Z,CLRLP DEC A JR Z,CLRENT DEC A JR Z,CLRFRZ LD HL,4DC0H SCRL9 LD A,(HL) AND 01010101B LD (HL),A INC HL LD A,L CP 20H JR NZ,SCRL9 LD B,4 SCRLP PUSH BC LD HL,NORMEM LD DE,NORMEM+80 LD BC,0C00EH SCRUP LD A,(DE) XOR (HL) AND 10101010B XOR (HL) LD (HL),A INC HL INC DE DJNZ SCRUP DEC C JR NZ,SCRUP POP BC DJNZ SCRLP RET ; NEWL1 ADD A,8 LD H,A JP STVDMC ; CLEAR COMMAND CLRFRZ CALL KEYSCN JR Z,CLRFRZ ; RESET VDM GOODIES CLRENT PUSH DE SYSSUK MOVE ; MOVE BYTES (SYSTEM ROUTINE) DW VDMX DW 4 DW INIDEV+6 POP DE LD HL,4000H CLRLP LD A,(HL) AND 01010101B LD (HL),A INC HL LD A,H CP 4EH JR NZ,CLRLP RET ; SUBROUTINE TO PAINT CURSOR ; C = DATA TO PAINT 00 OR AA CURSE PUSH AF CALL LDVDMC PCURS1 EX DE,HL XOR A SYSTEM RELAB1 OUT (MAGIC),A EX DE,HL LD A,C LD BC,0806H CALL BOXPUT POP AF RET ; NEW KEYBOARD HANDLER ; WITH SHIFT KEY ROLLOVER XCHKIO CALL KEYSCN ; MAKE SURE PREVIOUS KEY RELEASE JR NZ,XCHKIO ; AWAIT DEBOUNCE TIMER COUNTDOWN CHKIO0 LD HL,KEYTMR LD (HL),6 ; SET IT LOOPER LD A,(HL) AND A JR NZ,LOOPER ; SAVE BACKGROUND COLOR LD A,(DEVCL0) PUSH AF ; ASSUME FIRST LEVEL KEYCODE LD HL,FIRSTL GETK1 PUSH HL ; SAVE TABLE PTR ; SCAN ONLY FOR SHIFT KEYS LD HL,KTBL4 LD DE,-21 ; ** SIZE OF LOOKUP TABLE LD BC,0414H GETK2 IN A,(C) ; INPUT FROM PORT AND 20H ; SHIFT KEY DOWN? JR NZ,GETK3 ; JUMP IF YEP ADD HL,DE ; ELSE TO NEXT TABLE INC C ; AND PORT DJNZ GETK2 ; NO SHIFT KEY IS DOWN - USE WHATEVER WE HAD BEFORE POP HL JR GETK5 ; A SHIFT KEY IS DOWN - SAME OLD STORY? GETK3 POP DE ; DISCARD OLD BELIEFS LD A,(HL) ; SET NEW COLOR LD (DEVCL0),A GETK4 INC HL ; SKIP COLOR BYTE ; NOW SCAN FOR ANY 'NORMAL' KEY DEPRESSION GETK5 CALL KEYSCN JR Z,GETK1 ; JUMP IF NO KEY DOWN ; WE GOT ONE - CONVERT TO ASCII DEC A ; BY TABLE LOOKUP LD C,A LD B,0 ADD HL,BC POP AF ; RESTORE COLOR LD (DEVCL0),A LD A,(HL) ; GET CODE AND A ; A HLT PERCHANCE? JR Z,INIJMP ; YEP - RESET CP 1 ; AN ERROR? JR Z,XCHKIO ; YEP - GO DOIT AGAIN ; GOOD KEY... CHKI02 RLCA CALL C,WCLICK LD A,(HL) AND 7FH CP NLLN RET NZ LD HL,5 LD (NLLNCT),HL ; SET FLAG AND ZERO SUPPRESS LD A,CR ; PASS BACK CR AS FIRST CHAR RET ; ; NEW CLICK ROUTINE WCLICK LD A,G0 LD (MUZTON),A LD A,(DEVTEM) DEC A RET M LD A,1 LD (NEWTMR),A RET ; SUBROUTINE TO CHECK FOR HLT KEY WHILE PGM RUNNING WHATSU PUSH BC PUSH DE CALL KEYSCN ; GET KEY CODE SUB 2 ; FREEZE? JR Z,FRZKEY DEC A JR Z,INIJMP JR FRZGBK ; ELSE GO BACK TO CALLER FRZKEY CALL KEYSCN ; SCAN FOR NONZERO KEY TO REL JR Z,FRZKEY CP 3 ; HLT NAILED? INIJMP JP Z,INIT FRZGBK POP DE POP BC RET ; SUBROUTINE TO SCAN TINY BASIC KEYBOARD KEYSCN LD BC,0414H ; B = CNT, C = PORT # LD DE,KEYTRK ; DE = KEYBOARD MEMORY XOR A SYSTEM RANGED KYSCN1 IN A,(C) ; LOOK AT COLUMN AND 1FH ; ISOLATE THE RELEVANT JR NZ,KYSCN2 ; JUMP IF BITS HIGH INC C ; BUMP PORT # DJNZ KYSCN1 XOR A ; SET ZERO STATUS LD (DE),A ; NOTHIN - SAY ZIP RET ; DEPRESSION FOUND - JUMP UP AND DOWN KYSCN2 DEC B LD C,0 ; COME UP WITH BIT # KYSCN4 RRCA ; SHIFT BIT OVER JR C,KYSCN3 ; JUMP IF THE ONE INC C ; ELSE COUNT UP JR KYSCN4 ; AND TRY AGAIN ; FOUND BIT - ASSEMBLE KEYCODE KYSCN3 LD A,C ; BIT # TO A RLCA ; * 4 RLCA OR B ; COMBINE WITH COL # INC A LD B,A LD A,(DE) XOR B LD A,B RET Z ; QUIT IF THE SAME LD (DE),A ; ELSE UPDATE TRACKER RET ; SUBROUTINE TO PLAY A NOTE PNOTE PUSH HL PUSH DE PUSH AF LD H,A ; WAIT FOR PREVIOUS PARAMETERS TO BE EATEN PRWAIT LD A,(NEWTMR) AND A JR NZ,PRWAIT ; LOOP LD A,H XOR ' ' JR Z,TSTOR LD A,H CP 63H JR Z,PNOTDV CP 62H JR Z,PNOTML CP '+' JR Z,PNOTPL CP '-' JR Z,PNOTMN CP CR JR Z,PNOTCL SUB '0' JR Z,PNOTZ DEC A CP 7 JR C,ANSW LD A,6CH SUB H JR TSTOR ANSW LD HL,SHARPF ADD A,(HL) SYSSUK INDEXB ; INDEX BYTE (SYSTEM SUBROUTINE) DW DICKY TSTOR LD (MUZTON),A LD A,(DEVTEM) LD (NEWTMR),A PNOTCL XOR A PSHARP LD (SHARPF),A LINKB POP AF POP DE POP HL RET PNOTDV LD A,OA1 DB 11H PNOTML LD A,OA3 LD (MUZMO),A JR LINKB PNOTPL LD A,7 DB 11H PNOTMN LD A,14 JR PSHARP PNOTZ LD HL,MUZTMR LD A,(DEVTEM) AND A JP M,LINKB DI ADD A,(HL) LD (HL),A EI JR LINKB ; SUBROUTINE TO POINT AT A TOKEN TOKEPT LD HL,TOKTXT ; POINT AT TEXT LIST SUB 68H JOKEP1 RET Z ; QUIT IF POINTING AT EM JOKEP2 BIT 7,(HL) ; MOVE PAST NEXT WORD INC HL JR Z,JOKEP2 DEC A JR JOKEP1 ; LOOP BACK AND CHECK ; DICKS MUSIC SYSTEM NOTE LOOKUP TABLE DICKY DB C2,D2,E2,F2,G2,A2,B2 DB CS2,DS2,F2,FS2,GS2,AS2,C3 DB B1,CS2,DS2,E2,FS2,GS2,AS2 TBLDIV DW 1 DW 10 DW 100 DW 1000 DW 10000 IGNBLK LD A,(DE) ; *** IGNBLK *** CP ' ' ; IGNORE BLANKS RET NZ ; IN TEXT (WHERE DE->) INC DE ; AND RETURN THE FIRST JR IGNBLK ; NON-BLANK CHAR. IN A ; TABLE OF FIST LEVEL KEYCODES FIRSTL DB CR+80H DB EDKEY DB 0 DB 63H+80H DB '7' DB '8' DB '9' DB 62H+80H DB '4' DB '5' DB '6' DB '-'+80H DB '1' DB '2' DB '3' DB '+'+80H DB ' ' DB '0'+80H DB RUBOUT+80H DB '=' ; FIRST SHIFT KEY KTBL1 DB 0A7H ; FIRST SHIFT KEY COLOR DB CR+80H DB EDKEY DB 0 DB 1 DB 'A' DB 'D' DB 'G' DB 'J' DB 'M' DB 'P' DB 'S' DB 'V' DB 'Y' DB 5FH DB 5EH DB '&' DB '$' DB '<' DB '(' DB '#' ; SECOND SHIFT KEY KTBL2 DB 05FH ; SECOND SHIFT KEY COLOR DB CR+80H DB 2FH DB 0 DB 5BH DB 'B' DB 'E' DB 'H' DB 'K' DB 'N' DB 'Q' DB 'T' DB 'W' DB 'Z' DB 27H DB '.' DB '@' DB ',' DB 22H DB ';' DB '%' ; TABLE THE THIRD KTBL3 DB 0FH ; THIRD SHIFT KEY COLOR DB CR+80H DB 5CH DB 0 DB 5DH DB 'C' DB 'F' DB 'I' DB 'L' DB 'O' DB 'R' DB 'U' DB 'X' DB '!' DB 61H DB 60H DB '*' DB '?' DB '>' DB ')' DB ':' ; TOKEN KEY KTBL4 DB 77H ; WORDS KEY COLOR DB NLLN DB EDKEY DB 6AH DB 68H DB 72H DB 77H DB 75H DB 6BH DB 6FH DB 70H DB 76H DB 6DH DB 69H DB 6CH DB 71H DB 6EH DB EDKEY DB 73H DB 1 DB 74H ; SUBROUTINE TO LD A,(DE) FROM SCREEN TEXT MEMORY IF NECESSARY LDE BIT 7,D JR Z,LDE1 EX DE,HL ADD HL,HL LD A,(HL) RLCA INC HL XOR (HL) AND 10101010B XOR (HL) SCF RR H RR L EX DE,HL RET LDE1 LD A,(DE) RET ; DOUBLE STORE INTO HL STDEHL LD A,E CALL STHL INC HL LD A,D ; THEN FALL INTO... ; SUBROUTINE TO STORE LD (HL),A STHL BIT 7,H JR Z,STHL1 PUSH BC LD C,A ADD HL,HL RRCA XOR (HL) AND 01010101B XOR (HL) LD (HL),A INC HL LD A,C XOR (HL) AND 01010101B XOR (HL) LD (HL),A SCF RR H RR L LD A,C POP BC RET STHL1 LD (HL),A RET ; END OF BALLY BASIC INTERPRETER (AKA ASTROBASIC)