; 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 <outfile> -x <listfile> <filename>
;
;  For example, assemble this Astrocade Z-80 ROM file:
;
;  zmac -i -m -o astrobas.bin -x astrobas.lst astrobas.asm
;


; Part Two of Disassembly of the file "ASTROBAS.BIN" (C)1978&1980
; Programmed and Commented by: Jay Fenton for Bally Manufacturing
;
; CPU Type: Z80 - for Bally Home Video Game / Home Library System
;
; Created with dZ80 1.50 and a whole lot of hand editing/copying!
; Re-assembles 100% correctly with: zmac -i -m AstroBAS.ASM
;
; Dis-assembled and pasted-up by: Richard C. Degler, From Scratch
; Beginning on or about Monday, 21 of April 2008 at 07:42 PM
;
; Renamed some labels and added a very few comments in Mixed Case
;

; Source of Jay Fenton's comments is "astrobas.asm" by Adam Trionfo
; retyped from a wrapped-around paper listing with page headings of:

; TDL Z80 CP/M DISC ASSEMBLER VERSION 2.21 [overwritten by Page #]
; .MAIN. -

; Note: The only text in "bally_basic_souce_pages_01-32.pdf" was:

; > Bally BASIC Interpreter
; >
; > © July 1978 Bally Mfg.
; > © December 1980 Revised
; >
; > Written by Jay Fenton

; and:

; > This page left blank for double-sided printing purposes.
;


; Part Three - More Update of the file "AstroBAS.BIN" (C)1978&1980
; Programmed by: Jay Fenton for Bally Manufacturing [see Part Two]
;
; Jay Fenton's comments from "New Features/Differences in Basics"
; added as unindented Mixed Case text preceding revelant routines.
;
; Exact starting date unknown, sometime between Parts Two and Four.
;


; Part Four - Assembly Code for the file "AtroBASIC (listing).ASM"
; Programmed by: Jay Fenton for Bally Manufacturing [see Part Two]
;
; Reverse-source code found by Brett Bilbrey - "Bally Basic (1979)"
; Loose Leaf paper listing Scanned and saved as PDF by Adam Trionfo
; moved to Bally Alley Yahoo! user group dated Friday, May 15, 2009
;
; Comments (ONLY) then retyped by: Richard C. Degler, From Scratch
; Beginning on Memorial Day Eve Sunday, 24 of May 2009 at 02:24 PM
;

; To match the style (and only where useful) these are marked by ;*
; Author Unknown, but no LC decenders listing had page headings of:
;
; CROMEMCO CDOS Z80 ASSEMBLER version 02.15                  PAGE 0001
; Bally Tiny Basic        8/25/79

; [without leading semi-colons used here] and a program identifier:
;
;                   0002 ;************************************************
;                   0003 ;*                                              *
;                   0004 ;*              Bally Tiny Basic                *
;                   0005 ;*                                              *
;                   0006 ;*                  8/25/79                     *
;                   0007 ;*                                              *
;                   0008 ;************************************************
;                   0009 ;
;
; [End of Header]


;
; Here then is ...

; ***************************
; * 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  [with updated 2000 baud tape interface]
;
        NOLIST
        INCLUDE "HVGLIB.H"      ; HOME VIDEO GAME LIBRARY
;
; MACROS
TOKEN   MACRO   TINDX, TGOTO
        DB      TINDX
        DEFF    TGOTO
        ENDM

ITEM    MACRO   STRANG, JUMPTO  ; Quoted Character
        DB      'STRANG'
        DEFF    JUMPTO
        ENDM

DEFF    MACRO   WORDY          ;* Jump table entry
        DB      (WORDY >> 8) | $80
        DB      WORDY & $FF
        ENDM

TSTC    MACRO   CAT, DOG        ; Quoted Character
        RST     1
        DB      'CAT'          ;* Char. to check
        DB      (DOG - $)-1    ;* Jump bias if no match
        ENDM

TSTCC   MACRO   CAT1, DOG1
        RST     1
        DB      CAT1           ;* Char. to check
        DB      (DOG1 - $)-1   ;* Jump bias if no match
        ENDM

; New Features
; ------------
;
; note from Jay Fenton on Bally/Astro BASIC differences:
; I believe you will be excited and amazed by these improvements.
;
; among others: The memory layout has been modified to leave the
; system RAM used by HVGSYS alone.  This allows HVGSYS routines
; such as the music interpreter to be exploited.
;

;           Defines
HLTPORT EQU     $15             ; KEYPAD KEY WITH HALT ONIT
;
CR      EQU     $0D
RUBOUT  EQU     $1F
COMMA   EQU     $2C
EDKEY   EQU     $66
NLLN    EQU     $67
;
; EQUATES FOR RESTART INSTRUCTIONS
RSTEXP  EQU     $10             ; EXPR - Get EXPRession restart  ;* Evaluate expression
RSTLDE  EQU     $18             ; LDE - LoaD A, from (DE) [was OUTC in bb and cb]
RSTIGN  EQU     $20             ; IGNBLK - IGNore BLanKs  ;* Get next non-blank from (DE)
RSTPAR  EQU     $28             ; PARN - Expression in PAReNthesis  ;* Get value in ()
RSTFIN  EQU     $30             ; FINISH - FINISH  ;* cr. or ; otherwise, WHAT?
;
BOTROM  EQU     FIRSTC          ; $2000
;
; Scratchpad area:
BOTSCR  EQU     $4E20           ; BOTtom of SCReen [from $4000 to $4E18 + 2*4 for ??]
TXTUNF  EQU     BOTSCR         ;* "End of Basic Pgm" address [plus 2 is $FF00 ??]
VARBGN  EQU     $4E22           ; One-letter variables (two bytes each)
DEVVAR  EQU     $4E56           ; Two-letter DEVICES VARIABLES thusly:
DEVCL0  EQU     DEVVAR          ; BC = Background Color 0 (default 7)
DEVCL1  EQU     $4E58           ; FC = Foreground Color 1 (default 0)
DEVTEM  EQU     $4E5A           ; NT = TEMPO Note Timer (default 2)
VDMX    EQU     $4E5C           ; CX = VDM X COORDINATE (default -77)
VDMY    EQU     $4E5E           ; CY = VDM Y COORDINATE (default 40)
OLDXY   EQU     $4E60           ; XY = PREVIOUS COORDINATES FROM VECTOR DRAW
; Note: 12 new Two-letter device variables for AstroBasic (except for ReMain)
DEVMO   EQU     $4E62           ; MO = Master OSC (center octave = 71)
DEVOA   EQU     $4E64           ; TA = Tone OSCillator A
DEVOB   EQU     $4E66           ; TB = Tone OSC B
DEVOC   EQU     $4E68           ; TC = Tone OSC C
DEVVD   EQU     $4E6A           ; VR = Vibrato DEPTH aka "Range" = 0 - 63
DEVVR   EQU     $4E6C           ; VF = Vibrato RATE aka "Frequency" 0 - 3
DEVVC   EQU     $4E6E           ; VC = Volume C
DEVNM   EQU     $4E70           ; NM = Noise Mode if 1, Vibrato if 0
DEVVA   EQU     $4E72           ; VA = Volume A
DEVVB   EQU     $4E74           ; VB = Volume B
DEVNV   EQU     $4E76           ; NV = Noise Volume
REMAIN  EQU     $4E78           ; RM = REMAINder FROM LAST DIVIDE
SCRMOD  EQU     $4E7A           ; SM = Scroll Mode
;
VDMNLF  EQU     $4E7C           ; VDM NEW LINE FLAG
KEYTMR  EQU     $4E7D           ; KEYBOARD SCAN TIMER  ;* Key release timer (60 Hz)
MUZTMR  EQU     $4E7E           ; MUSIC NOTE TIMER  ;* Time remaining on current note
NEWTMR  EQU     $4E7F           ; NEW MUSIC TIMER VALUE  ;* Time for next note
MUZMO   EQU     $4E80           ; MASTER OSC FOR DICK  ;* Master sound divider value
MUZTON  EQU     $4E81           ; TONE VALUE  ;* Next note to output
SHARPF  EQU     $4E82           ; SHARP-FLAT
;
KEYTRK  EQU     $4E83           ; KEYpad debounce TRacKer  ;* Last calc. input
LINEND  EQU     $4E84
EDFLG   EQU     $4E86           ; line EDit FLaG
PIXVAL  EQU     EDFLG           ; PIXel VALue TO DRAW WITH
EDPTR   EQU     $4E87           ; line EDit PoinTeR
MNMX    EQU     EDPTR           ; MiN - MaX DELTAS FOR VECTOR DRAW
INCRO   EQU     $4E89           ; COORDINATE INCRements FOR VECTOR DRAW
NLLNLN  EQU     $4E8B           ; AUTO LINE # STUFF
NLLNCT  EQU     $4E8D
NLLNZS  EQU     $4E8E           ; AUTO LINE NUMBER Zero Suppress FLAG
OLDLN   EQU     $4E8F           ; PREVIOUS LINE # TYPED (used for GO+10)
;
CHECKER EQU     $4E91           ; PLACE FOR CHECKSUM
HKVECT  EQU     $4E92           ; 14 bytes initialized from HOOKER :
HKLPINT EQU     HKVECT          ; JP ($4E93) for Light Pen INTerrupt
HKINT   EQU     $4E95           ; JP ($4E96) for Screen INTerrupt
CHKIO   EQU     $4E98           ; JP ($4E99) for CHaracter Key IOput
OUTCH   EQU     $4E9B           ; JP ($4E9C) for OUTput CHaracter
STACKP  EQU     $4E9E           ; STACK toP reset on halt or stop
;
ALTFON  EQU     $4EA0           ; 7 byte ALTernate FONt descriptor
                               ;* Character Spec Table
; ??  EQU     $4EA6            ;* [+6 ??] Indexes VRBL storage area
OLDCUR  EQU     $4EA7           ; OLD CURsor
CURRNT  EQU     $4EA9           ; CURReNT line
STKGOS  EQU     $4EAB           ; STacK for GOSub
STKINP  EQU     $4EAD           ; ??
VARNXT  EQU     STKINP         ;* "NEXT" VRBL address
LOPVAR  EQU     $4EAF           ; FOR VARiable  ;* "FOR" VRBL address
LOPINC  EQU     $4EB1           ; FOR STEP  ;* "STEP" VRBL address
LOPLMT  EQU     $4EB3           ; FOR TO  ;* "TO" VRBL address
LOPLN   EQU     $4EB5           ; LOoP Line Number  ;* Line # of current FOR loop
LOPPT   EQU     $4EB7           ; 3 bytes LOoP PoinTer  ;* Current FOR line text pointer
;
XQTBUF  EQU     $4EBA           ; eXeCUTE BUFFER aka
BUFFER  EQU     XQTBUF          ; line input BUFFER  ;* Keyboard input buffer
BUFEND  EQU     $4F22           ; BUFfer END (104 Characters)
; ?? unused block of 48 bytes ??
STKLMT  EQU     $4F6A           ; STacK LiMiT (128 bytes available)
TOPSCR  EQU     DURAT           ; $4FEA used for Top of Stack 
STACK   EQU     TOPSCR          ; ... and loads into STACKP vector
;
BOTRAM  EQU     $A000           ; [Denotes $4000 but shared with screen image]
TXT     EQU     BOTRAM          ; [was TEXT] Text Array Area [flagged as negative ??]
DFTLMT  EQU     TXT + $070C     ; [Last interlaced address is $A70C]
; [use final two routines to read/write bit-shared data from screen+$6000 ?? [counts??]]
;
; (the @(x) array runs up from TXTUNF to, and *(x) array backwards from) DFTLMT
;  No check is performed to prevent *( ) from overstoring @( ) [new in AB]
;

        LIST
        ORG     BOTROM

        JP      BEGIN           ; ** AUTOSTART CASSETTE **

PIXTBL: DB      $80            ;* Masks for picture data (PX)
        DB      $20
        DB      $08
        DB      $02

; TRANSFER VECTORS TO RESTART ROUTINES
        JP      TSTCH           ; * RST $08

        JP      EXPR            ; * RST RSTEXP  ;* Evaluate expression

        JP      LDE             ; * RST RSTLDE [was OUTC  ; * RST RSTOUT in bb and cb ??]

        JP      IGNBLK          ; * RST RSTIGN  ;* Get next non-blank from (DE)

        JP      PARN            ; * RST RSTPAR  ;* Get value of () or storage adrs

        POP     AF              ; * RST RSTFIN  ;* cr. or ; otherwise, WHAT?
        JP      FINISH

; Text String
WHAT:   DB      'WHAT?',CR

; note: Light pen interrupts are always enabled.  The
; light pen interrupt routine is initialized as null, i.e.
; re-enable interrupts and return.  Therefore the coordinates of
; the most recent light pen hit are available from &(15) and &(14).
; As stated in the HACKERS GUIDE, the coordinates may be off by a
; constant amount due to time delays in the light pen circuits.
; The addition or subtraction of a fudge factor may be needed.
;
; INITIAL VECTOR ITEMS  -  points to HKVECT block in RAM, change vectors there
        DW      HKLPINT         ; (ITAB & $FFF0) HooK Light Pen INTerrupt vector

ITAB:   DW      HKINT           ; default HooK INTerrupt vector

; INITIAL VALUES FOR PARAMETER VECTOR  ;* Following is moved to DEVVAR at $4E56
INIDEV:
        DW      $0007           ; BACKGROUND COLOR  ;* BC preset-White
        DW      $0000           ; FOREGROUND COLOR  ;* FC preset-Black
        DW      $0002           ; MUSIC TEMPO  ;* NT preset
        DW      $FFB3           ; (-77) VDM X COORDINATE  ;* CX preset
        DW      $0028           ; (40) VDM Y COORDINATE  ;* CY preset

; BIT BANGER GOODIES FOLLOW:
BANGIN  EQU     $3C00           ; BIT BANGER READ PORT
BANG1   EQU     $3800           ; BIT BANG CODE TO WRITE A ONE
BANG0   EQU     $3C00           ; BIT BANG CODE TO WRITE A ZERO
;
WASTEIT MACRO  TIME, ?LAB       ; was WASTE[TIME,%LAB]= originally
        LD      A,TIME
?LAB    DEC     A
        JR      NZ,?LAB
        ENDM

; :PRINT COMMAND <start-address, #-of-words>
; IF VARIABLE NAME, BLOCKSIZE GIVEN, WE WILL WRITE OUT
; THE SPECIFIED BLOCK RATHER THAN THE PROGRAM STORAGE AREA
;
;     The :PRINT command causes the stored program, the
; screen image, the values in @( ) and *( ) arrays, and the
; values of all the variables to be written out.  This process
; will take between 10 and 20 seconds.  As only one jack is
; provided on the BASIC ROM cassette, it is necessary for the
; user to manually connect the audio cable to the MIC jack of
; the cassette recorder.
;     When writing blocks from *( ) we must cite the LAST
; word in the block rather than the first.  This is because *( )
; runs backwards.
;     The recording will consist of a 3 second leader
; tone, then the data block, followed by a 1/2 second trailer
; tone.  The tone frequencies are derived from software timing
; loops accurate to plus or minus one microsecond.
;
TOUTPU: CALL    IGNATNL         ; ANY ARGS?  do IGNore blanks, 0 AT NewLine or ;
        JR      Z,YYSPGM        ; JUMP TO SAVE PGM IF SO
        CALL    TSTVFF          ; ELSE GET START ADDR  ;* Get adrs. of VRBL
        PUSH    HL              ; SAVE THAT
        TSTCC   COMMA,BADSAV    ; CHECK FOR COMMA
        RST     RSTEXP          ; GET BLOCK SIZE  ;* Evaluate expression
        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 - $4000
        PUSH    DE
        LD      DE,$4000
; SAVE PROGRAM TO TAPE
;
YYOUTB: SYSSUK  EMUSIC

        DI
        CALL    LEADER          ; WRITE OUT SOME LEADER
        LD      A,$A5
        CALL    OUTBYA          ; do OUTput BYte in A to 2000-baud tape
OBL:    RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        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          ; does LD A,(DE) [from TeXT if necessary]
        LD      A,B             ; OUTPUT CHECKSUM
        CPL                     ; COMPLEMENT FOR LATER TEST
        CALL    OUTBYA          ; do OUTput BYte in A to 2000-baud tape
        LD      B,$02
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        EX      (SP),HL
        EX      (SP),HL
        CALL    LEADR1          ; PUT OUT TRAILER
        POP     DE
        EI
        RST     RSTFIN          ; BYE BYE  ;* cr. or ; otherwise, WHAT?

BADSAV: JP      QWHAT

; :LIST command
;
;     The :LIST command has been modified to perform a 
; verify function.  It no longer LISTS the data on tape, as the
; data rate is far too high.  Now :LIST will scan a digital
; recording and verify that the checksum is correct.  If
; incorrect, a question mark is printed just before the
; command returns.  This allows one to check recording
; integrity without damaging anything.
;      If problems arise, check the playback level on your
; cassette recorder.  We have found that maximum volume
; settings work best.  It is recommended that AC power be used
; if possible to minimize speed fluctuations.
;
TVLIST: PUSH    DE
        CALL    TVLLNK          ; do Prepare for tape input
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; SPECIAL ENTRY TO LOAD COMBINED SCREEN AND PGM
;
; :INPUT COMMAND <start-address>
; IF VARIABLE ADDRESS IS GIVEN, WE WILL INPUT
; THE BLOCK INTO THE SPECIFIED AREA, OTHERWISE
; WE HANDLE IT LIKE A PROGRAM
;
;      To load programs, use :INPUT.  This will retrieve the
; program, the screen image, the arrays and variables from
; audio tape.  It is necessary to 'cue up' the audio tape on
; the three second leaden tone, and switch the cable over to
; EARPHONE before loading.
;      The accuracy of the load is verified using a
; checksum.  If a checksum error is detected, a question mark
; will be typed out just before :INPUT returns.  It is possible
; that a checksum error could damage the program or system
; variables in such a way as to 'bomb' the computer.
;
;     Optional <start address> specifies where the load is to
; begin.  Note that the size of the block was determined when
; it was written out.  The block read back will be one byte
; longer than the one written out.  The extra byte is the
; checksum byte.  Therefore, allow one word of 'slop' when
; reading into an array.
;
TINPUT: CALL    IGNATNL         ; AND ARGS?  do IGNore blanks, 0 AT NewLine or ;
        LD      HL,$4000
        CALL    NZ,TSTVFF       ; GET VAR ADDR  ;* Get adrs. of VRBL
        PUSH    DE
        CALL    INBLK           ; do INput a BLocK from 2000-baud tape
XXELOD: POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; :RUN COMMAND - LOADS BOOTSTRAP INTO RAM
; AND JUMPS TO IT
;
;     The :RUN command is provided for loading machine
; language programs.  The load will begin at the top of the
; screen ($4000 or 16484).  When the load is completed,
; control will be transferred to this first address.  The block
; loaded is limited in size [to 128 ??] only by the need to avoid
; 'stomping' on the stack area.
;
TLOAD:  LD      HL,$4000        ; HL=SCREEN TOP
        PUSH    HL
; SUBROUTINE TO INPUT A BLOCK, HL=STORE ADDR
; FIRST - AN ENTRY TO REVEAL FEEDBACK AREA
INBLK:  CALL    SENWAI          ; do SENtinel WAIt
; LOOP TO GRAB CHARS AND STORE EM
ZZCHRL: CALL    INCHAR          ; do Read CHARacter from 2000-baud tape
        JR      Z,ZZEOT
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        INC     HL
        JR      ZZCHRL

;* Prepare for tape input
;
TVLLNK: CALL    SENWAI          ; do SENtinel WAIt
ZZKIL:  CALL    INCHAR          ; do Read CHARacter from 2000-baud tape
        JR      NZ,ZZKIL
ZZEOT:  DEC     HL
        EI
        INC     D               ; SHOULD HAVE BEEN FF
        RET     Z
OUTCHQ: LD      A,'?'
        JP      OUTCH           ; to Output Question Mark

SENWAI: SYSSUK  EMUSIC

        DI
SENW:   CALL    INCHAR          ; WAIT FOR THE SENTINEL
        JR      Z,SENW
        CP      $A5
        JR      NZ,SENW
        LD      D,A
        RET

; INCHAR CLOBBERS A, BC, DE
; NZ IF NO TIMEOUT, Z IF TIMEOUT, CHAR INC
;
INCHAR: LD      A,(BANGIN+2)
        AND     $01
        LD      E,A             ; PRIME THE PUMP
        LD      BC,$0810        ; 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

; CHECK FOR ABORT LOAD KEY
INBIT:  IN      A,(HLTPORT)
        RRCA
        JP      C,INIT0         ; do INITialize interrupts to 0
        LD      A,(BANGIN)
        XOR     E               ; CHECK FOR CHANGE
        RRCA
        JR      NC,INBIT        ; NO - WAIT
        WASTEIT $17
        LD      A,(BANGIN+1)
        AND     $01
        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 $0E             ; VERY TIME SENSITIVE
        LD      B,$08           ; 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 $0C
        JR      NXT

NXT:    JR      WRE             ; LOOP COUNTER

WR1:    CALL    WRONE           ; WRITE ONE-BIT
        WASTEIT $20
WRE:    DJNZ    WRL             ; TILL 8 BITS DONE
        JR      SEX

SEX:    POP     BC
        CALL    WRONE           ; WRITE A ONE BIT FOR STOP
        WASTEIT $18
        RET

;
; LEADER CLOBEBERS BC AND A
LEADER: LD      B,$0F           ; APPROX 3 SECS
LEADR2: WASTEIT $20
        NOP
LEADR1: CALL    WRONE           ; LEADER IS ALL ONES
        DEC     BC
        LD      A,B
        OR      C
        JR      NZ,LEADR2
        WASTEIT $1D
        RET

;
; WRONE WRITES ONE HALF CYCLE OF ONE-BIT (1/1200 SEC)
;
WRONE:  LD      A,(BANG1)       ; CHANGE ITS STATE
        WASTEIT $24             ; WAIT SOME, THEN FALL INTO...
        LD      A,(BANG0)
        RET

;
; WRZERO WRITES ONE HALF CYCLE OF ZERO BIT (1/2400 SEC)
;
WRZERO: LD      A,(BANG1)
        WASTEIT $11
        NOP
        NOP
        LD      A,(BANG0)
        RET

; CKHLDE and COMP [should be down below CHKSGN & CHGSGN ??]
;
CKHLDE: LD      A,H             ; *** CKHLDE ***
        XOR     D               ; SAME SIGN?
        JP      P,COMP          ; YES, COMPARE  ;* Jp if same sign
        EX      DE,HL           ; NO, XCH AND COMPARE ;* Exchange and fall into ...

;* COMPare HL and DE
;* Z if HL = DE
;* C if HL < DE
COMP:   LD      A,H             ; *** COMP ***
        CP      D               ; COMPARE HL WITH DE
        RET     NZ              ; RETURN CORRECT C AND
        LD      A,L             ; ZFLAGS
        CP      E               ; BUT OLD A IS LOST
        RET

; Text Strings continued
HOW:    DB      'HOW?',CR

SORRY:  DB      'SORRY',CR

; TABLE GIVING JUMP TO ADDRESS FOR COMMANDS
TOKJT:  DW      LISTCOM         ; 68 - 'LIST' COMmand routine
        DW      CLRSCR          ; 69 - 'CLEAR'
        DW      RUN             ; 6A - 'RUN'
        DW      NEXT            ; 6B - 'NEXT'
        DW      LINEDR          ; 6C - 'LINE'
        DW      IFF             ; 6D - 'IF'
        DW      GOTO            ; 6E - 'GOTO'
        DW      GOSUB           ; 6F - 'GOSUB'
        DW      RETURN          ; 70 - 'RETURN'
        DW      BOXDRW          ; 71 - 'BOX'
        DW      FOR             ; 72 - 'FOR'
        DW      INPUT           ; 73 - 'INPUT'
        DW      PRINT           ; 74 - 'PRINT'

; INITIAL HOOK VECTOR ITEMS
;
; EXPERIMENTERS note: HOOK VECTORS have been installed in RAM
; to allow the user to gain control at several strategic places.
; The hook vectors are jump instructions which reside in RAM,
; which then branches to the appropriate routine.  Hooks are
; provided for the following functions: 1) Light Pen Interrupt,
; 2) Screen Interrupt, 3) Character Read, 4) Character Print.
;
HOOKER: JP      LPINT           ; Copied to HKVECT

        JP      TBIINT

        JP      XCHKIO

        JP      XOUTCH

        DW      STACK           ; set to DURAT as default

; TABLE GIVING ASCII CHARS FOR TOKENS with last character marked negative
TOKTXT:
        DB      'LIS'
        DB      'T' + $80       ; ($68) "LIST" Text
        DB      'CLEA'
        DB      'R' + $80       ; ($69) "CLEAR"
        DB      'RU'
        DB      'N' + $80       ; ($6A) "RUN"
        DB      'NEX'
        DB      'T' + $80       ; ($6B) "NEXT"
        DB      'LIN'
        DB      'E' + $80       ; ($6C) "LINE"
        DB      'I'
        DB      'F' + $80       ; ($6D) "IF"
        DB      'GOT'
        DB      'O' + $80       ; ($6E) "GOTO"
        DB      'GOSU'
        DB      'B' + $80       ; ($6F) "GOSUB"
        DB      'RETUR'
        DB      'N' + $80       ; ($70) "RETURN"
        DB      'BO'
        DB      'X' + $80       ; ($71) "BOX"
        DB      'FO'
        DB      'R' + $80       ; ($72) "FOR"
        DB      'INPU'
        DB      'T' + $80       ; ($73) "INPUT"
        DB      'PRIN'
        DB      'T' + $80       ; ($74) "PRINT"
        DB      'STE'
        DB      'P' + $80       ; ($75) "STEP"
        DB      'RN'
        DB      'D' + $80       ; ($76) "RND"
        DB      'T'
        DB      'O' + $80       ; ($77) "TO"

; DEVICE VARIABLE TABLE /* Special 2-letter variables
; THIS TABLE IS IN INVERSE ORDER OF APPEARENCE IN MEMORY
PARNUM  EQU     19              ; [was only 7 in bb]
DEVLST:                         ; [has first character minus $40 for ?? why??]
        DB      'S'-'@'
        DB      'M'             ; "SM" = Scroll Mode [New for AB]
        DB      'R'-'@'
        DB      'M'             ; "RM" = ReMainder from last divide
        DB      'N'-'@'
        DB      'V'             ; "NV" = Noise Volume [New for AB]
        DB      'V'-'@'
        DB      'B'             ; "VB" = Volume B [New for AB]
        DB      'V'-'@'
        DB      'A'             ; "VA" = Volume A [New for AB]
        DB      'N'-'@'
        DB      'M'             ; "NM" = Noise Mode [New for AB]
        DB      'V'-'@'
        DB      'C'             ; "VC" = Volume C [New for AB]
        DB      'V'-'@'
        DB      'F'             ; "VF" = Vibrato Frequency [New for AB]
        DB      'V'-'@'
        DB      'R'             ; "VR" = Vibrato Range [New for AB]
        DB      'T'-'@'
        DB      'C'             ; "TC" = Tone C [New for AB]
        DB      'T'-'@'
        DB      'B'             ; "TB" = Tone B [New for AB]
        DB      'T'-'@'
        DB      'A'             ; "TA" = Tone A [New for AB]
        DB      'M'-'@'
        DB      'O'             ; "MO" = Master Oscillator [New for AB]
        DB      'X'-'@'
        DB      'Y'             ; "XY" = Location from last draw 
        DB      'C'-'@'
        DB      'Y'             ; "CY" = Character print Y
        DB      'C'-'@'
        DB      'X'             ; "CX" = Character print X
        DB      'N'-'@'
        DB      'T'             ; "NT" = Note Tempo
        DB      'F'-'@'
        DB      'C'             ; "FC" = Foreground Color
        DB      'B'-'@'
        DB      'C'             ; "BC" = Background Color

; TINY BASIC INTERRUPT ROUTINE
;* NORMAL INTERRUPT PROCESSOR
;
TBIINT: PUSH    AF              ; SAVE REGISTERS
        PUSH    BC
        PUSH    HL
; DEAL WITH KEYBOARD SCAN TIMER
        LD      HL,KEYTMR
        LD      A,(HL)         ;* Get key release timer
        AND     A
        JR      Z,TBIN0        ;* Jp if already zero
        DEC     (HL)            ; Count KEYTMR down to 0
TBIN0:  INC     HL              ; point to MUZTMR
; 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       ; Silence A Stacato
        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),$00        ; 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        ; Restore Center Octave = 71
        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,$0F
TBIN2:  LD      (DEVVA),A
; SET COLOR REGISTERS TO VALUES IN PARAMETER VARS %0 AND %1
TBIN3:  LD      A,(DEVCL0)     ;* Get BC
        OUT     (COL0L),A
        OUT     (COL1L),A
        LD      A,(DEVCL1)     ;* Get FC
        OUT     (COL2L),A
        OUT     (COL3L),A
; UPDATE THE MUSIC PROCESSOR [new for ab]
        LD      A,(DEVTEM)      ; Note Timer < 0 ?
        RLCA
        JR      C,INTDON
        LD      BC,$0410        ; &(16) thru &(19)
        LD      HL,DEVMO        ; Start with Master Oscillator
LP1:    LD      A,(HL)
        OUT     (C),A
        INC     HL
        INC     HL
        INC     C
        DJNZ    LP1             ; Then TA, TB, TC
        LD      B,(HL)          ; B=VD aka VR
        INC     HL
        INC     HL
        LD      A,(HL)          ; A=VR aka VF
        RRCA
        RRCA
        XOR     B
        AND     $C0
        XOR     B
        OUT     (C),A           ; &(20) = "VFVRange"
        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     $30
        XOR     B
        OUT     (VOLC),A        ; &(21) = "00NMVCcc"
        INC     HL
        INC     HL
        LD      B,(HL)          ; VA
        INC     HL
        INC     HL
        LD      A,(HL)          ; VB
        RLCA
        RLCA
        RLCA
        RLCA
        XOR     B
        AND     $F0
        XOR     B
        OUT     (VOLAB),A       ; &(22) = "VBbbVAaa"
        INC     HL
        INC     HL
        LD      A,(HL)          ; GET NOISE VOLUME
        OUT     (VOLN),A        ; &(23) = "NVvalues"
; DONE - RESTORE REGISTERS AND GO BACK
INTDON: POP     HL
        POP     BC
        POP     AF
;* Light pen interrupt processor [was 300baud read in bb, now just...]
LPINT:  EI
        RET

; COMMAND TO SILENCE MUSIC PORTS - but only if NT < 0
;
SILENCE:
        PUSH    DE
        SYSSUK  FILL            ; Clear TA through NV
        DW      DEVOA
        DW      $0014
        DB      $00

        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; ROUTINE TO MOVE PROGRAM LINE FROM PGM STORAGE AREA
; INTO EXECUTION BUFFER
;
;                   ENHANCED EXECUTION SPEED
;
;     Internal changes have been made to speed up the
; execution of BASIC programs.  The speedup ranges from 50% to
; 100% depending on the program.  In general, long programs
; with long statements will benefit the most.  The speedup is
; implemented by transferring the text of each line from pixel
; shared storage into the line input buffer before execution.
; This allows most 'searching' functions expedited access to
; the line.
;      This has forced the introduction of an
; incompatibility with the original version of BASIC.  The use
; of GOSUB statements in immediate mode (in a line without a
; line number) is now illegal.
;
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     $AA
        XOR     (HL)
        LD      (BC),A
        INC     HL
        INC     BC
        CP      $0D
        JR      NZ,EXP1
        SCF
        RR      H
        RR      L
        LD      (LINEND),HL
        RET

; SUBROUTINE TO RETURN ZERO STATUS IF CHARACTER IN A IS NL
; OR ';'  [was ZONATNL in bb, IGNore restart added for ab]
;
IGNATNL:
        RST     RSTIGN          ; IGNORE ANY BLANKS  ;* Get next non-blank from (DE)
        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
;
;* PX - Check screen dot
;* PX(<expr1>,<expr2>)
;
PIXFUN: TSTC    '(',PIXDUD     ;* Open = Char. to check, Jump if no match
        PUSH    BC
        RST     RSTEXP         ;* Evaluate expression
        PUSH    HL             ;* Save value of <expr1>
        TSTCC   COMMA,PIXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        TSTC    ')',PIXDUD     ;* Close = Char. to check, Jump if no match
        POP     BC             ;* X value
        PUSH    DE              ; SAVE PTR  ;* Save text pointer
        LD      D,L            ;* D = Y
        LD      E,C            ;* E = X
        CALL    R2ABS          ;* Get odd crt adrs to A
        EX      DE,HL          ;* and adrs to DE
        SYSSUK  INDEXB          ; INDEX BYTE (SYSTEM SUBROUTINE)
        DW      PIXTBL          ; HL + A [not loaded!] to HL

        LD      A,(DE)          ; GET BYTE FROM SCREEN  ;* Get CRT dots
        AND     (HL)            ; MASK OFF NONSENSE  ;* AND with mask
        LD      H,$00
        LD      L,H
        POP     DE
        POP     BC              ;* No dot
        RET     Z
        INC     HL
        RET                     ;* Dot on

; SUBROUTINE TO GET VARIABLE MAKING SURE IT IS ONE
;
TSTVFF: CALL    TSTV           ;* Get VRBL storage address
        RET     NC              ; GO BACK IF GOOD  ;* Was a variable
; ELSE FALL INTO...
PIXDUD: JP      QWHAT

; CLEAR COMMAND
;
CLRSCR: CALL    CLRENT          ; do RESET VDM GOODIES then CLeaR ENTire screen
        LD      HL,$0000        ; and clear OLD XY [separate ??]
        LD      (OLDXY),HL
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; BOX DRAW ROUTINE  ;* - Draw a box on the screen
;* BOX(<x>,<y>,<xsize>,<ysize>,<type>)
;
BOXDRW: RST     RSTEXP          ; GET X  ;* Evaluate expression
        PUSH    HL             ;* Save starting x
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP          ; GET Y  ;* Evaluate expression
        PUSH    HL             ;* Save starting y
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP          ; Get Expr., Range 0-255 [was 1-255 in bb]
        LD      A,L
        PUSH    AF             ;* Save xsize
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP          ; Get Expr., Range 0-255 [was 1-255 in bb]
        LD      B,L
        PUSH    BC             ;* Save ysize
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Get box type  ;* Evaluate expression
        PUSH    DE             ;* Save text pointer
        POP     IX             ;*  in IX
        POP     BC              ; RESTORE YS  ;* Get ysize to B
        POP     AF              ; AND XS
        LD      C,A            ;* Get xsize to C
        LD      A,L             ; PRESERVE FLAG  ;*  Get box type to A
        POP     HL
        LD      D,L            ;* Get start y to D
        POP     HL
        LD      E,L            ;* Get start x to E
        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            ; do Set to ABSoulte value
        ADD     A,H
        CP      $2D
        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            ; do Set to ABSoulte value
        ADD     A,H
        CP      $51
        JR      NC,BOXNDR
        LD      A,E
        SUB     H
        LD      E,A
; DIDDLE WITH FLAG BYTE
        LD      A,L
        AND     $03             ; MODULO 4
        JR      Z,BOXNDR        ; SKIP DRAW IF ZERO
        SUB     $02             ; ELSE SUBTRACT 2 FOR MASK
BOXDR1: PUSH    AF
        CALL    R2ABS           ; do Relative TO ABSoulte conversion
; HL = ABS ADDR, A = SA, B=YS, C=XS
        OUT     (MAGIC),A
        POP     AF
        CALL    BOXPUT          ; do draw a BOX PUT on screen
BOXNDR: PUSH    IX
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

BOXDUD: JP      QWHAT

; Set A to ABSoulute value
;
SABS:   AND     A
        RET     P
        CPL
        INC     A
        RET

; SUBROUTINE TO DRAW A BOX ON SCREEN
;
;      The BOX command has been fixed to eliminate a
; problem with the off-screen detection logic.  BOX will still
; refuse to draw a box that is partially or totally off-screen.
; The bug used to cause a bug in the scrolling function where
; stripes from 'nowhere' would propagate up the screen.  This
; was exploited by some as a 'feature' to make video art.
; Sorry.
;
BOXPUT: LD      E,A
        LD      A,C             ; D = X / 4
        RRCA
        RRCA
        AND     $3F
        INC     A
        LD      D,A
; PAINT FULL BOX STRIPES
MPT1:   DEC     D
        JR      Z,MPT2
        LD      A,10101010B
        CALL    STRIPE          ; do draw a STRIPE on screen
        JR      MPT1

MPT2:   LD      A,C
        AND     $03
        INC     A
        LD      C,A
        XOR     A
MPT3:   DEC     C
        JR      Z,MPT4
        RRCA
        RRCA
        OR      10000000B
        JR      MPT3

MPT4:   CALL    STRIPE          ; do draw a STRIPE on screen
        XOR     A
; FALL INTO...
; SUBROUTINE TO PAINT A STRIPE
;
STRIPE: PUSH    HL
        PUSH    BC
        LD      (WASTER),A
        LD      A,(WASTER + $4000)
        LD      C,A
STRP1:  LD      A,E
        CP      $01
        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,$00
        LD      H,A
        DJNZ    STRP1
        POP     BC
        POP     HL
        INC     HL
        RET

; LINE DRAWER  ;* - Draw a line on the screen
;
;      The LINE command now performs rudimentary clipping.
; The onscreen portion of the line is drawn.  Note that only
; the low order 8 bits of a coordinate are examined by LINE.
; Thus 256 is equivalent to 0 and so on.
;
;* LINE(<x>,<y>,<type>)
;
LINEDR: RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        PUSH    AF             ;* Save starting x
        TSTCC   COMMA,LINEDX   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        PUSH    AF             ;* Save starting y
        TSTCC   COMMA,LINEDX   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        LD      C,L
        PUSH    DE
        POP     IX
        LD      DE,(OLDXY)     ;* Current xy [Y is high order byte, X is lower byte]
        POP     AF
        LD      H,A
        POP     AF
        LD      L,A
        LD      (OLDXY),HL      ; SET NEW LAST PLACE  ;* Update xy
; DIDDLE WITH FLAG BYTE
        LD      A,C
        AND     $03
        JR      Z,LINED1
        SUB     $02
        LD      (PIXVAL),A      ; SET PIXVAL
        CALL    DVECT           ; do Draw line VECTor
LINED1: PUSH    IX
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

LINEDX: 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          ; do Compute DELTA for X
        LD      E,B
        LD      L,C
        LD      B,H
        LD      C,D
        CALL    CDELTA          ; do Compute DELTA for Y
        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,$00
        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          ; do Relative To Absolute with CLiPping [new for ab]
        JR      NC,VECT2A
        PUSH    BC
        PUSH    HL
        LD      C,A
        LD      B,$00
        LD      HL,PIXTBL
        ADD     HL,BC
        LD      B,(HL)
        POP     HL
        LD      A,(PIXVAL)
        CP      $01
        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,$29
        CP      $51             ; OUT OF RANGE?
        JR      C,LDVDM1        ; NO
        XOR     A
LDVDM1: LD      H,A
        LD      A,(VDMX)        ; DIDDLE WITH X
        ADD     A,$4D
        CP      $9D
        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     $29
        CPL
        LD      L,A
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        LD      (VDMY),HL      ;* Update CY
        POP     HL
        LD      A,L
        SUB     $4D
        LD      L,A
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        LD      (VDMX),HL      ;* Update CX
        RET

; SUBROUTINE TO COMPUTE DELTA AND INCREMENT FOR TWO COORDINATES
;
CDELTA: PUSH    HL
        PUSH    DE
        LD      L,C
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        EX      DE,HL
        LD      L,B
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        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,$01
CDELT2: LD      B,L
        LD      C,A
CDELT3: POP     DE
        POP     HL
        RET

; RELATIVE TO ABSULUTE CONVERSION WITH CLIPPING
;
R2ACLP: LD      A,E
        ADD     A,$50           ; X was -80 up to 79
        CP      $A0             ; IN RANGE 0-159 - CX FOR OK
        RET     NC
        LD      A,D
        ADD     A,$2C           ; Y was -44 up to 43
        CP      $58             ; IN RANGE 0-87 - CY FOR OK
        RET     NC
; ...
; RELATIVE TO ABSOLUTE CONVERSTION
;
R2ABS:  PUSH    DE             ;* Save XY
        LD      A,D            ;* Get y
        CPL                    ;* Reverse sense
        ADD     A,$2C          ;* Make it 0-87
        LD      D,A            ;* Put it back
        LD      A,E
        ADD     A,$50          ;* Same for x [0-159]
        LD      E,A
        XOR     A
        SYSTEM  RELAB1         ;* Get CRT adrs to DE

        EX      DE,HL
        POP     DE             ;* Regain original XY
        SCF
        RET

; KB - FUNCTION TO RETURN NEXT CHARACTER FROM KEYBOARD
;
GETKB:  PUSH    BC
        PUSH    DE
        CALL    CHKIO           ; do Read a character from keyboard
        POP     DE
KBLNKX: POP     BC
        LD      L,A            ;* HL is output register
        LD      H,$00
        RET

; DEVICE VARIABLE TO OUTPUT TO REFERENCED IO PORT
;* OUTPUT &(<expr>)=
;
PUTIO:  RST     RSTPAR          ; GET PORT #  ;* Get value of () or storage adrs
        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  ;* cr. or ; otherwise, WHAT?

; FUNCTION TO RETURN VALUE OF A GIVEN IO PORT
;* INPUT =&(<expr>)
;
IOFUN:  RST     RSTPAR         ;* Get value of () or storage adrs
        PUSH    BC              ; GET PORT NUMBA
        LD      B,H
        LD      C,L
        IN      A,(C)
        JR      KBLNKX

; DEVICE VARIABLE TO PLAY NOTE WITHOUT PRINTING [via MU=]
;
PUTMU:  TSTC    '=',PUTCD2
        RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        CALL    PNOTE           ; do Play NOTE tone for key in A
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; DEVICE VARIABLE TO OUTPUT CHARACTER ON VDM [via TV=]
;
PUTCD:  TSTC    '=',PUTCD2
        RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        CALL    OUTCH           ; do OUTput CHaracter in A
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

PUTCD2: JP      QWHAT

; ROUTINE TO TRANSFER CONTROL TO ASSEMBLY LANGUAGE SUBROUTINE
;
;     The CALL command transfers control to an assembly
; Language subroutine.  This routine should terminate by
; executing a RET instruction.  Register DE contains a pointer
; to the line being interpreted, if needed it should be saved
; then restored before returning to BASIC.  Stupid example:
;        500 CALL 0     ; Self destruct reset!
;
;* CALL <expr>
;
DOCALL: LD      HL,BBRET        ; PUSH RETURN ADDR ON STACK
        PUSH    HL
        RST     RSTEXP          ; GET ADDRESS  ;* Evaluate expression
        JP      (HL)            ; AND JUMP TO IT

; ** TINY BASIC EXECUTION STARTS HERE **
; CLEAR WHOLE KIT AND KABOOBLE
;
;
;***********************
;*      Cold Start     *
;***********************
;
BEGIN:  XOR     A
        OUT     (MAGIC),A       ; Set up port $0C
        LD      H,A            ;* Clear $4000-$4FFF
        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          ;* Start multiple Subr.

        DO      SETOUT
        DB      $B0            ;* Display height
        DB      00101100B      ;* Border [$2C or 44] color 0, Left
        DB      $18            ;* Normal and _Masked_ Lite Pen interrupts
; [*** This is what breaks MESS v.0.124 and above - try $0C for Unmasked LPI ??]

; INITIALIZE DEVICE VARIABLES
        DO      MOVE            ; MOVE BYTES (SYSTEM ROUTINE)
        DW      DEVVAR
        DW      $000A          ;* Move 10 bytes from
        DW      INIDEV         ;* $2024 to $4E56

        DO      MOVE            ; MOVE BYTES (SYSTEM ROUTINE)
        DW      ALTFON
        DW      $0007          ;* Move 7 bytes from
        DW      FNTSYS         ;* $0206 to $4EA0

        DO      MOVE            ; MOVE BYTES (SYSTEM ROUTINE)
        DW      HKVECT
        DW      $000E
        DW      HOOKER

        DO      SETW            ; STORE WORD (SYSTEM ROUTINE)
        DW      $06A0
        DW      ALTFON        ;* Char spacing = 6, table base [still] = $A0

        DO      SETW            ; STORE WORD (SYSTEM ROUTINE)
        DW      TXT + 4
        DW      TXTUNF        ;* LD (TXTUNF),$A004 [in virtual TeXT area]

        DO      SETW            ; STORE WORD (SYSTEM ROUTINE) [commented TeXT + 2 ??]
        DW      $5555           ; [TeXT + 1 init to $FF (or -1) End of Program marker]
        DW      $4002           ; LD (NORMEM + 2),$55 and LD (NORMEM + 3),$55 [why ??]

        DONT    XINTC         ;* End multiple Subr.

;* Initialize interrupts
;
INIT0:  DI
        IM      2
        LD      A,ITAB >> 8    ;* Interrupt Page
        LD      I,A
        LD      A,ITAB & $FF    ; Set TBIINT as Interrupt
        OUT     (INFBK),A      ;* Interrupt vector
        LD      A,$C8          ;* Interrupt every 200 lines
        OUT     (INLIN),A       ; [actually on every line 200 !]
        EI
INIT:   CALL    CRLF            ; Prints NULL,cr [instead of a string]
TELL:
;
; DIRECT COMMAND - TEXT COLLECTOR
;
; STOP command
;
;     The STOP command halts the program.  It is typed in
; as four discrete keystrokes.
;
STOP:
; note: The STACK TOP is reset on halt or stop from STACKP
; instead of a fixed location.  This allows some stack space
; to be borrowed for assembly language routines. [new for AB]
;
RSTART: LD      HL,(STACKP)     ; DURAT precludes Counter Timers use
        LD      SP,HL
        LD      HL,XXST1 + 1
        LD      (CURRNT),HL
XXST1:  LD      HL,$0000
        LD      (OLDCUR),HL
        LD      (LOPVAR),HL
        LD      (STKGOS),HL
XXST2:  LD      A,'>'
        CALL    GETLN           ; do GET a LiNe
        PUSH    DE
        LD      DE,BUFFER
        CALL    TSTNUM         ;* Get possible line number
        RST     RSTIGN         ;* Get next non-blank from (DE)
        LD      A,H
        OR      L
        POP     BC             ;* BC = end of line
        JR      Z,EXEC0        ;* Direct mode if no line #
        LD      (OLDLN),HL
        DEC     DE             ;* Put binary line number in
        LD      A,H            ;*  front of first significant
        LD      (DE),A         ;*  character of line in input
        DEC     DE             ;*  buffer
        LD      A,L
        LD      (DE),A
        PUSH    BC
        PUSH    DE
        LD      A,C
        SUB     E
        PUSH    AF             ;* A = # bytes in line
        CALL    FNDLN          ;* Find this line in SAVE area
        PUSH    DE             ;* DE = adrs
        JR      NZ,XXST3       ;* Jp if not found; insert
        PUSH    DE             ;* Found, delete it
        CALL    FNDNXT         ;* Find next line
        POP     BC             ;* Start adrs of line to delete
        LD      HL,(TXTUNF)    ;* End of all text
        CALL    MVUP           ;* Move up to delete
        LD      H,B            ;* Save new text end address
        LD      L,C
        LD      (TXTUNF),HL
XXST3:  POP     BC             ;* Adrs of where to insert
        LD      HL,(TXTUNF)    ;* Text end address
        POP     AF             ;* Length of new line
        PUSH    HL             ;* Save text last adrs.
        CP      $03            ;* Length = 3, delete only
        JR      Z,RSTART
        ADD     A,L            ;* Compute new text end
        LD      E,A            ;*   to DE
        LD      A,$00
        ADC     A,H
        LD      D,A
        LD      HL,DFTLMT      ;* Last possible address
        EX      DE,HL
        CALL    COMP            ; do COMPare HL and DE
        JP      NC,QSORRY      ;* SORRY if no room
        LD      (TXTUNF),HL    ;* Save new text end
        POP     DE             ;* Old text end
        CALL    MVDOWN          ; do MoVe a block DOWN
        POP     DE             ;* New line start
        POP     HL             ;*          end
        CALL    MVUP           ;* Move line to SAVE
        JR      XXST2          ;* Get next line

; DIRECT AND EXEC  ;* Direct Execute
;
EXEC0:  RST     RSTIGN          ; GET FIRST     NONBLANK  ;* Get next non-blank from (DE)
        PUSH    DE              ; SAVE POINTER
        SUB     $68             ; IS SHE A TOKEN? [bb did CP $68 ??]  ;* Is this a word?
        JR      C,EXEC0A        ; NO
        CP      $0D            ;* Yes, sure? [bb did CP ($68 + $0D) for $75 ??]
        JR      NC,EXEC0A      ;* No, assume implied LET
; WE FOUND A TOKEN - LOOKUP IN TABLE AND JUMP TO IT
        RLCA
        LD      E,A
        LD      D,$00
        LD      HL,TOKJT       ;* Jump table [ab did (token - $68) already]
        ADD     HL,DE
        LD      E,(HL)
        INC     HL
        LD      D,(HL)
        EX      DE,HL
        POP     DE
        INC     DE
        JP      (HL)           ;* Go to proper routine

; NOT A TOKEN - A VARIABLE PERHAPS?
EXEC0A: CALL    TSTV            ; TEST FOR VARIABLE  ;* Get VRBL storage address
        JR      C,EXEC0B        ; NO - SEARCH   1
        TSTC    '=',EXEC0B
        POP     BC              ; THROW OUT OLD PTR
        CALL    SETV1           ; ASSIGNMENT    1
BBRET:  RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

EXEC0B: POP     DE
        LD      HL,TAB2-1
EXEC:   RST     RSTIGN          ; EXEC  ;* Get next non-blank from (DE)
        PUSH    DE              ; SAVE POINTER
EX1:    LD      A,(DE)          ; ZAPPED LDE [instead of using RST RSTLDE ??]
        INC     DE
        INC     HL
        CP      (HL)
        JR      Z,EX1
        LD      A,$7F
        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     $7F
        LD      H,A
        POP     AF
        JP      (HL)

; IF AND REM
;
;* . Comment line
IFF:    RST     RSTEXP         ;* Evaluate expression
        LD      A,H
        OR      L
        JR      NZ,RUNSML      ;* Jp if true
REM:
RUNNXL: LD      DE,(LINEND)     ; Point to LINe END
        JR      RUNX1          ;* And run next one

; RUN routine(s)
;
RUN:    LD      DE,TXT
; RUn NeXt One
RUNX1:  LD      HL,$0000       ;* RST30 Jumps here on cr
        CALL    FNDLP          ;* Find next line [starting at Pointer]
        JP      C,RSTART       ;* Passed end; quit
; RUN The goSub Line
RUNTSL: LD      (CURRNT),DE    ;* Set CURRNT to line address
        IN      A,($14)
        LD      L,A
        IN      A,($15)         ; Pressing PAUSE or LIST during execution
        AND     L               ; will pause or trace!
        CP      $20
        CALL    Z,PRTLNS        ; do PRinT Line Number, space, then String

OK:     CALL    EXPAND          ; Load program line into eXeCuTe BUFfer [ab only]
        LD      DE,XQTBUF       ; Back to start of line [no line number ??]
; RUN SaMe Line  ;* RST30 Jps to RUNSML on ;
RUNSML: CALL    WHATSU          ; CHECK FOR INTERRUPT KEY
        JR      EXEC0          ;* Continue Same line execution

; GOTO routine
;
GOTO:   RST     RSTEXP         ;* Evaluate expression
        PUSH    DE             ;* Save for error routine
        CALL    FNDLN          ;* Find target line
        JP      NZ,AHOW        ;* No such line
        POP     AF             ;* Clear stack
        JR      RUNTSL

; LIST AND PRINT
; NEW - IMPROVED LIST COMMAND
; LETS YOU PUT IT IN A PROGRAM
;
;* LIST [<expr1>][,<expr2>]
LISTCOM:
        LD      HL,$0000        ; ASSUME AT EOL  ;* Preset to list from beginning
        CALL    IGNATNL         ; do IGNore blanks, set zero AT NewLine or ;
        JR      Z,LS3          ;* Jp if ; or cr
        CP      ','             ; LEADING COMMA?  ;* Jp if only # lines specified
        JR      Z,LS3           ; YEP - SKIP FIRST EXPR GET
; NOT AT FIRST - GET FIRST EXPR
LS2:    RST     RSTEXP         ;* Evaluate expression
LS3:    PUSH    HL             ;* Save line # for start
        LD      HL,$FFFF       ;* Set for max number of lines
        TSTCC   COMMA,LS4      ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Get number of lines  ;* Evaluate expression
LS4:    PUSH    DE
        POP     IY
        EX      (SP),HL
        CALL    FNDLN           ; do FiND HL Line Number in TeXT
LS5:    JR      C,LSQUIT
        EX      (SP),HL
        LD      A,H
        OR      L
        JR      Z,LSQUIT
        DEC     HL
        EX      (SP),HL
        CALL    PRTLNS          ; do PRinT Line Number, space, then String
        CALL    WHATSU          ; do Check for PAUSE or ABORT keys
        CALL    FNDLP           ; do FiND Linenumber starting at Pointer
        JR      LS5

LSQUIT: PUSH    IY
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; PRINT routine
;
PRINT:  LD      C,$08           ; C=# OF SPACES  /* Default number of spaces
        TSTCC   $3B,PR1         ; IF NULL LIST & ";"  ;* Jump if no match
        CALL    CRLF            ; GIVE CR-LF AND
        JR      RUNSML          ; CONTINUE SAME LINE

PR1:    TSTCC   CR,PR6          ; IF NULL LIST (CR)  ;* Jump if no match
        CALL    CRLF            ; ALSO GIVE CR-LF AND
        JP      IMCHEK          ; GO TO NEXT LINE IF POSSIBLE

PR2:    TSTC    '#',PR4         ; ELSE IS IT FORMAT?  ;* Jump if no match
PR3:    RST     RSTEXP          ; YES, EVALUATE EXPR.
        LD      C,L             ; AND SAVE IT IN C  [ab not limited to 6 bits ??]
        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  ;* Jump if no match
PR6:    TSTCC   COMMA,PR7     ;* Comma = Char. to check, Jump if no match
        CALL    SPOUTCH         ; do SPace OUTput CHar.
        JR      PR6

PR7:    CALL    FIN             ; IN THE LIST.
        JR      PR2             ; LIST CONTINUES

PR8:    CALL    CRLF            ; LIST ENDS
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

PR9:    RST     RSTEXP          ; EVALUATE THE EXPR
        PUSH    BC
        CALL    PRTNUM          ; PRINT THE VALUE
        POP     BC
        JR      PR5             ; Next value [not another 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"  ;* Save current "FOR" params
        RST     RSTEXP          ; PARAMETERS  ;* Evaluate expression
        PUSH    DE              ; AND TEXT POINTER  ;* Save text pointer
        CALL    FNDLN           ; FIND THE TARGET LINE  ;* Find target line
        JP      NZ,AHOW         ; NOT THERE.  SAY "HOW?"  ;* Not present; 'HOW?'
        LD      HL,(CURRNT)     ; SAVE OLD  ;* Save everything
        PUSH    HL              ; 'CURRENT' OLD 'STKGOS'
        LD      HL,(STKGOS)
        PUSH    HL
        LD      HL,$0000        ; AND LOAD NEW ONES
        LD      (LOPVAR),HL    ;* And load it up
        ADD     HL,SP
        LD      (STKGOS),HL
        JP      RUNTSL          ; THEN RUN THAT LINE

RETURN: LD      HL,(STKGOS)     ; OLD STACK POINTER  ;* Old stack pointer
        LD      A,H             ; 0 MEANS NOT EXIST
        OR      L
        JP      Z,QWHAT         ; SO, WE SAY: "WHAT?"  ;* RETURN with no GOSUB
        LD      SP,HL           ; ELSE, RESTORE IT  ;* Restore old SP
RESTO:  POP     HL
        LD      (STKGOS),HL     ; AND THE OLD 'STKGOS'  ;* And old STKGOS
        POP     HL
        LD      (CURRNT),HL     ; AND THE OLD 'CURRNT'  ;* And old CURRNT
        POP     DE             ;* Get old text pointer
        CALL    POPA           ;* Restore old "FOR" params
        CALL    EXPAND          ; Load program line into eXeCuTe BUFfer [ab only]
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; *******************************************
; *
; * *** 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 VARIABLE 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  ;* Save old "FOR" params
        CALL    SETVAL          ; SET THE CONTROL VAR.  ;* Set control VRBL
        DEC     HL              ; HL IS ITS ADDRESS
        LD      (LOPVAR),HL     ; SAVE THAT
        TSTCC   $77,FR1A        ; TO? - LOOK FOR WORD "TO"  ;* "TO" (don't need one)
FR1:    RST     RSTEXP          ; EVALUATE THE LIMIT
FR1A:   LD      (LOPLMT),HL     ; SAVE THAT  ;* Save limit
        LD      HL,$0001       ;* Preset step of 1
        TSTCC   $75,FR4         ; STEP?  ;* "STEP" (don't need one), Jump if no match
        RST     RSTEXP         ;* Evaluate expression
FR4:    LD      (LOPINC),HL     ; SAVE THAT TOO  ;* Save increment
        LD      HL,(CURRNT)     ; SAVE CURRENT LINE #
        LD      (LOPLN),HL      ; AND TEXT POINTER  ;* Save current line number
        EX      DE,HL
        LD      (LOPPT),HL     ;* And current text pointer
        LD      BC,$000A        ; DIG INTO STACK TO  ;* Dig into stack to find
        LD      HL,(LOPVAR)     ; FIND 'LOPVAR'  ;*  LOPVAR from last
        EX      DE,HL
        LD      H,B
        LD      L,B             ; HL=0 NOW  ;* HL = 0
        ADD     HL,SP           ; HERE IS THE STACK
        JR      FR6

FR5:    ADD     HL,BC           ; EACH LEVEL IS 10 DEEP  ;* Each level is 10 deeper
FR6:    LD      A,(HL)          ; GET THAT OLD 'LOPVAR'  ;* Get old LOPVAR
        INC     HL
        OR      (HL)
        JR      Z,FR7           ; 0 SAYS NO MORE IN IT  ;* Jp if no more
        LD      A,(HL)
        DEC     HL
        CP      D               ; SAME AS THIS ONE?  ;* Same as this one?
        JR      NZ,FR5
        LD      A,(HL)          ; THE OTHER HALF?  ;* Other half also?
        XOR     E
        JR      NZ,FR5
        EX      DE,HL           ; YES, FOUND ONE  ;* Yes, found one
        LD      H,A
        LD      L,A
        ADD     HL,SP           ; TRY TO MOVE SP  ;* Try to move SP
        LD      B,H
        LD      C,L
        LD      HL,$000A
        ADD     HL,DE
        CALL    MVDOWN          ; AND PURGE 10 WORDS  ;* Purge 10 words
        LD      SP,HL           ; IN THE STACK  ;* In the stack
FR7:    LD      HL,(LOPPT)      ; JOB DONE, RESTORE DE  ;* Job done
        EX      DE,HL
        RST     RSTFIN          ; AND CONTINUE  ;* cr. or ; otherwise, WHAT?

NEXT:   CALL    TSTV            ; GET ADDRESS OF VAR.  ;* Get VRBL storage address
        JP      C,QWHAT         ; NO VARIABLE, "WHAT?"  ;* None, 'WHAT?'
        LD      (VARNXT),HL     ; YES, SAVE IT  ;* Save its address
NX1:    PUSH    DE              ; SAVE TEXT POINTER  ;* Save text pointer
        EX      DE,HL
        LD      HL,(LOPVAR)     ; GET VAR. IN 'FOR'  ;* Get VRBL in FOR
        LD      A,H
        OR      L               ; 0 SAYS NEVER HAD ONE
        JP      Z,AWHAT         ; SO WE ASK: "WHAT?"  ;* Never had one
        CALL    COMP            ; ELSE WE CHECK THEM  ;* Check them for match
        JR      Z,NX2           ; OK, THEY AGREE  ;* Jp if agree
        POP     DE              ; NO, LET'S SEE  ;* No agree, Purge current
        CALL    POPA            ; PURGE CURRENT LOOP  ;* loop and pop one level
        LD      HL,(VARNXT)     ; AND POP ONE LEVEL
        JR      NX1             ; GO CHECK AGAIN  ;* Try again

NX2:    EX      DE,HL           ; COME HERE WHEN AGREED  ;* ;Get value of VRBL to DE
        RST     RSTLDE          ; DE=VALUE OF VAR. [load from TeXT if necessary]
        LD      L,A
        INC     DE
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        LD      H,A
        EX      DE,HL
        LD      HL,(LOPINC)    ;* Get increment
        PUSH    HL
        LD      A,H
        XOR     D               ; S=SIGN OF DIFFER
        LD      A,D             ; A=SIGN OF DE
        ADD     HL,DE           ; ADD ONE STEP  ;* 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          ; do STore DE word by HL [into TeXT if necessary]
        LD      HL,(LOPLMT)     ; HL=LIMIT
        POP     AF              ; OLD HL
        RLCA                    ; EXAMINE SIGN BIT
        JR      NC,NX4          ; IF POS SKIP EX     DE,HL  ;* Step > 0
        EX      DE,HL          ;* Step < 0
NX4:    CALL    CKHLDE          ; COMPARE WITH LIMIT  ;* Compare with limit
        POP     DE              ; RESTORE TEST POINTER  ;* Restore text pointer
        JR      C,NX6           ; OUTSIDE LIMIT  ;* Outside limit
        LD      HL,(LOPLN)      ; WITHIN LIMIT, GO  ;* Within limit
        LD      (CURRNT),HL     ; BACK TO THE SAVED  ;* Put LOPLN in CURRNT
        LD      HL,(LOPPT)      ; 'CURRNT' AND TEXT  ;*  and LOPPT
        EX      DE,HL           ; POINTER
        CALL    EXPAND          ; Load program line into eXeCuTe BUFfer [ab only]
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

NX5:    POP     HL              ; OVERFLOW , PURGE
; RESTO LINKS IN HERE
NXXX:   POP     DE              ; GARBAGE IN STACK
NX6:    CALL    POPA            ; PURGE THIS LOOP
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; *********************************************************
; *
; * *** 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 STRING WILL BE
; * PRINTED FOLLOWED BY A COLON.  TBI THEN WAITS FOR INPUT EXPR.  AND
; * SETS 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  ;* Get VRBL storage address
        JR      C,IP5           ; M6IVARIABLE? 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          ; do STore DE word by HL [into TeXT if necessary]
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         ;* cr. or ; otherwise, WHAT?

IP8:    PUSH    DE              ; SAVE FOR 'PRTSTG'
        CALL    TSTV            ; MUST BE VARIABLE NOT  ;* Get VRBL storage address
        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  ;* Save in case of error
        EX      DE,HL
        LD      HL,(CURRNT)     ; ALSO SAVE 'CURRNT'
        PUSH    HL
        LD      HL,IP1          ; A NEGATIVE NUMBER
        LD      (CURRNT),HL     ; AS A FLAG
        LD      HL,$0000        ; SAVE SP TOO
        ADD     HL,SP
        LD      (STKINP),HL
        PUSH    DE              ; OLD HL
        PUSH    BC
        LD      A,' '          ;* Space after VRBL
        JP      GETLN           ; AND GET A LINE

; *********************************************
; *
; * *** EXPR ***
; *
; * 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
; * <EXPR>::=<EXPR1>
; *           <EXPR1><REL.OP><EXPR1>
; * WHERE <REL.OP> IS ONE OF THE OPERATORS IN TAB6 AND THE RESULT
; * OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
; *
; * <EXPR1>::=(+ OR -)<EXPR2>(+ OR -<EXPR2>)(...)
; * WHERE () ARE OPTIONAL AND (...) ARE OPTIONAL REPEATS.
; *
; * <EXPR2>::=<<EXPR3>(<* OR /><EXPR3>)(...)
; *
; * <EXPR3>::=<VARIABLE>
; *            <FUNCTION>
; *            (<EXPR>)
; *
; * <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
; * AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
; * <EXPR3> CAN BE AN <EXPR> IN PARENTHESES.
;
EXPR:   CALL    EXPR1           ; *** EXPR ***
        PUSH    HL              ; SAVE <EXPR1> 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               ; ELSE SET HL=0
        LD      L,H
        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.  ;* - end of list 3
        RET                     ; RETURN HL=<EXPR1>

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 <EXPR1>
        EX      DE,HL           ; VALUE IN DE NOW
        EX      (SP),HL         ; 1ST <EXPR1> IN HL
        CALL    CKHLDE          ; COMPARE 1ST WITH 2ND
        POP     DE              ; RESTORE TEXT POINTER
        LD      HL,$0000        ; SET HL=0, A=1
        LD      A,$01
        RET

EXPR1:  TSTC    '-',XP11        ; NEGATIVE SIGN?
        LD      HL,$0000        ; YES, FAKE "0-"
        JR      XP16            ; TREAT LIKE SUBTRACT  ;* Fake "0-x"

XP11:   TSTC    '+',XP12        ; POSITIVE SIGN?  IGNORE  ;* Ignore leading +
XP12:   CALL    EXPR2           ; 1ST <EXPR2>
XP13:   TSTC    '+',XP15        ; ADD?
        PUSH    HL              ; YES, SAVE VALUE
        CALL    EXPR2           ; GET 2ND <EXPR2>
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  ;* Jp if signs different
        XOR     H               ; 1ST 2ND SIGN EQUAL  ;* Signs alike
        JP      P,XP13          ; SO IS RESULT
        JP      QHOW            ; ELSE WE HAVE OVERFLOWN

XP15:   TSTC    '-',XPR9        ; SUBTRACT?
XP16:   PUSH    HL              ; YES, SAVE 1ST <EXPR2>
        CALL    EXPR2           ; GET 2ND <EXPR2>
        CALL    CHGSGN          ; NEGATE
        JR      XP14            ; AND ADD THEM

EXPR2:  CALL    EXPR3           ; GET 1ST <EXPR3>
XP21:   TSTCC   $62,XP24        ; MULTIPLY?
        PUSH    HL              ; YES, SAVE 1ST
        CALL    EXPR3           ; AND GET 2ND <EXPR3>
        LD      B,$00           ; CLEAR B FOR SIGN
        CALL    CHKSGN          ; CHECK SIGN
        EX      (SP),HL         ; 1ST IN HL
        CALL    CHKSGN          ; CHECK SIGN OF 1ST
        EX      DE,HL          ;* 2nd in DE
        EX      (SP),HL        ;* Get back 1st
        LD      A,H             ; IS HL > 255?
        OR      A
        JR      Z,XP22          ; NO  ;* Jp if HL <255
        LD      A,D             ; YES, HOW ABOUT DE
        OR      D
        EX      DE,HL           ; PUT SMALLER IN DE
        JP      NZ,AHOW         ; ALSO >, WILL OVERFLOW ;* Jp if DE >255 (will overflow)
XP22:   LD      A,L             ; THIS IS DUMB
        LD      HL,$0000        ; CLEAR RESULT
        OR      A               ; ADD AND COUNT
NERDXX: JR      Z,XP25         ;* Done
XP23:   ADD     HL,DE          ;* Continue multiply
        JP      C,AHOW          ; OVERFLOW
        DEC     A
        JR      NERDXX          ; FINISHED

XP24:   TSTCC   $63,XPR9        ; DIVIDE?  ;* Jump if no match
        PUSH    HL              ; YES, SAVE 1ST <EXPR3>
        CALL    EXPR3           ; AND GET 2ND ONE
        LD      B,$00           ; 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  ;* End of list 2
        JR      C,XP32          ; NOR A VARIABLE  ;* Is it a variable? No
        EX      DE,HL          ;* Yes, a variable
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        PUSH    AF
        INC     DE
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        EX      DE,HL
        LD      H,A            ;* Get VRBL value to HL
        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?  ;* Get one byte ASCII input
        LD      A,(DE)          ; NAILED RSTLDE [instead of using RST 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)"  ;* Evaluate expression
        TSTC    ')',XPRO
XPR9:   RET

XPRO:   JP      QWHAT           ; ELSE SAY: "WHAT?"

; RND( ) command
;
;      RND(0) has been defined to mean: return a random
; number between -32768 and 32767.  This saved ROM space.
;
RND:    RST     RSTPAR          ; *** RND(EXOR) ***  ;* Get value of () or storage adrs
        LD      A,H             ; EXPR MUST BE +
        OR      A
        JP      M,QHOW         ;* Bad if - [and not if 0 anymore]
        PUSH    DE              ; SAVE BOTH
        EX      DE,HL           ; DE = RANGE
        XOR     A
        SYSTEM  RANGED         ;* Get Random Number

        LD      L,A
        XOR     A
        SYSTEM  RANGED         ;* Get Random Number

        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( ) function 
;
;     The absolute value function is available. It is
; typed in as 3 discrete keystrokes: "A", "B", and "S".
;
ABS:    RST     RSTPAR          ; *** ABS(EXPR) ***  ;* Get value of () or storage adrs
        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
;     The value ranges from 0 (full clockwise)
; to 255 (full counterclockwise). 
;
GETPOT: LD      A,$1B
        CALL    CHKRNG          ; GET DATA
        CPL
        SUB     $80
        LD      L,A
; FALL INTO...
; SIGN EXTEND SUBROUTINE
SGNEXT: LD      H,$00
        LD      A,L
        AND     A
        RET     P
        DEC     H
        RET

; FUNCTION TO SENSE STATE OF TRIGGER
;
GETTRG: CALL    CHKRN1          ; do CHecK RaNge is 1-4
        AND     $10
        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          ; do CHecK RaNge is 1-4
        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,$0F
CHKRNG: PUSH    BC
        PUSH    AF
        RST     RSTPAR          ;* Get value of () or storage adrs
        POP     AF
        ADD     A,L
        LD      C,A
        IN      A,(C)
        POP     BC
        LD      HL,$0000
        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. [moved up with COMP routine]
;
DIVIDE: PUSH    HL              ; *** DIVIDE ***
        LD      L,H             ; DIVIDE H BY DE
        LD      H,$00
        CALL    DV1
        LD      B,C             ; SAVE RESULT IN B
        LD      A,L             ; (REMAINDER + L)/DE
        POP     HL
        LD      H,A
DV1:    LD      C,$FF           ; RESULT IN C [initialize to -1]
DV2:    INC     C               ; DUMB ROUTINE
        AND     A
        SBC     HL,DE
        JR      NC,DV2
        ADD     HL,DE
        RET

CHKSGN: LD      A,H             ; *** CHKSGN ***  ;* Check sign of HL
        OR      A               ; CHECK SIGN OF HL
        RET     P               ; IF -, CHANGE SIGN  ;* Leave if +

CHGSGN: LD      A,H             ; *** CHGSGN ***  ;* Change sign of HL
        OR      L
        RET     Z              ;* +0 stays the same
        LD      A,H            ;* Change sign
        PUSH    AF
        CPL                     ; CHANGE SIGN OF HL
        LD      H,A
        LD      A,L
        CPL
        LD      L,A
        INC     HL
        POP     AF
        LD      A,B             ; AND ALSO FLIP B  ;* Also flip sign of B
        XOR     $80
        LD      B,A
        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.) [ab just uses 'FINISH' ??]
; *
; * 'ERROR' PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). IT THEN
; * PRINTS THE LINE POINTED BY 'CURRNT' 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 GETS MESSAGE "WHAT?".  'AWHAT' JUST GETS MESSAGE "WHAT?"
; * AND JUMPS TO 'ERROR'.  'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
; * 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
;
SETVAL: CALL    TSTVFF          ; *** SETVAL ***  ;* Get adrs. of VRBL
        TSTC    '=',QWHAT       ; "WHAT?" NO VARIABLE  ;* Jump if no match
SETV1:  PUSH    HL              ; SAVE ADDRESS OF VAR.
        RST     RSTEXP          ; EVALUATE EXPR.
        EX      DE,HL          ;* Value now in [?? not use BC in ab ??]
        EX      (SP),HL        ;* Get address
        CALL    STDEHL         ;* Place [double] into VRBL [into TeXT if necessary]
        POP     DE
        RET

FINISH: CALL    FIN             ; CHECK END OF COMMAND  ;* RST30 after POP AF
        JR      QWHAT           ; PRINT "WHAT?" IF WRONG

FIN:    TSTCC   $3B,FI1         ; *** FIN ***  ;* Semicolon, Jump if no match
        POP     AF              ; ";", PURGE RET ADDR.
        JP      RUNSML          ; CONTINUE SAME LINE

FI1:    TSTCC   CR,FI2          ; NOT ";", IS IT CR?  ;* $0D, Jump if no match
        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 #  ;* Current line pointer
        PUSH    HL             ;* Save it
        EX      DE,HL           ; CHECK THE VALUE
        RST     RSTLDE         ;* Get character in text
        LD      H,A
        INC     DE
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        OR      H
        EX      DE,HL
        POP     DE             ;* Set DE to line #
        JP      Z,TELL          ; IF ZERO, JUST RESTART  ;* If 0, just restart
        EX      DE,HL           ; IF NEGATIVE  ;* Get first digit
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        EX      DE,HL
        OR      A
        JP      M,INPERR        ; REDO INPUT  ;* If negative, redo input
        CALL    PRTLN           ; ELSE PRINT THE LINE Number then Space
        POP     HL              ; HL=ERROR ADDR
        LD      BC,XQTBUF
        AND     A
        SBC     HL,BC
        ADD     HL,DE
        LD      B,L
        CALL    PRTCHS
        CALL    OUTCHQ         ;* do Output $3F Question Mark
        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 LINE # IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC &
; * NZ.  IF WE REACHED THE END OF TEXT SAVE AREA AND CANNOT 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 #.  'FNDNXT' 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          ; does LD A,(DE) [from TeXT if necessary]
        LD      C,A
        DEC     DE
        ADD     A,A
        RET     C
        RST     RSTLDE          ; C,NZ PASSED END [load from TeXT if necessary]
        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  ;* Try to find cr
        RLCA                    ; COMBINE WITH FOLLOWING FELLA
        INC     HL
        XOR     (HL)            ; TO MAKE THE REAL DATA
        AND     $AA
        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  ;* Get value of () or storage adrs
        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            ; do COMPare HL and DE
        JR      C,ASORRY        ; APOLOGIZE FOR RANGE ERR
        JP      (IY)            ; GO HOME

; *** TSTV ***
;* Get VRBL storage address
;
TSTV:   RST     RSTIGN         ;* Get next non-blank from (DE)
        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          ; [new for ab ??]
;
        LD      HL,(TXTUNF)
        DEC     HL
        DEC     HL
        ADD     HL,DE
        POP     DE
        RET

; PROCESS THE BACKWARDS ARRAY [new for ab, why GETSUB broken out ??]
STARR:  CALL    GETSUB
        LD      HL,DFTLMT       ; SUBTRACT INDEX FROM END
        SBC     HL,DE
        POP     DE
        XOR     A               ; NO CY SHIT
        RET

; does %(ADDR) PEEK-POKE CALL here
;
TSTV0:  INC     DE
        RST     RSTPAR          ; GET ADDR  ;* Get value of () or storage adrs
        XOR     A               ; CLEAR CY
        RET                     ; AND GO BACK

TV1:    CP      $1B             ; 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 [instead of using RST 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,$1A
        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,$00
        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.
;
;****************************************
;*      RST8    TSTCH                   *
;****************************************
;
TSTCH:  EX      (SP),HL         ;  *** TSTCH ***  ;* Get (caller+1)
        RST     RSTIGN          ; IGNORE LEADING BLANKS  ;* Get next non-blank from (DE)
        CP      (HL)            ;  AND TEST THE CHARACTER  ;* Same?
        INC     HL              ; COMPARE THE BYTE THAT  ;* Next location
        JR      Z,TC1           ; FOLLOWS THE CALL INTS.  ;* Match!
        PUSH    BC              ; WITH TEXT (DE->)
        LD      C,(HL)          ;  IF NOT =, ADD THE 2ND  ;* Get # of bytes to skip
        LD      B,$00           ;  BYTE THAT FOLLOWS THE
        ADD     HL,BC           ;  CALL TO THE OLD PC  ;* Increment past
        POP     BC              ;  I.E., DO A RELATIVE
        DEC     DE              ;  JUMP IF NOT =  ;* Stay stuck on non-match
TC1:    INC     DE              ;  IF =, SKIP THOSE BYTES  ;* Next char.
        INC     HL              ;  AND CONTINUE  ;* Bump past # bytes
        EX      (SP),HL        ;* Put return back on stack
        RET

TSTNUM: LD      HL,$0000        ; *** TSTNUM ***
        LD      B,H             ; TEST IF THE TEXT IS
        RST     RSTIGN          ; A NUMBER  ;* Get next non-blank from (DE)
TN1:    CP      '0'             ; IF NOT, RETURN 0 IN
        RET     C               ; B AND HL
        CP      ':'             ; IF NUMBERS, CONVERT
        RET     NC              ; TO BINARY IN HL AND
        LD      A,$F0           ; 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     $0F             ; CODE
        ADD     A,L
        LD      L,A
        LD      A,$00
        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 ***  ; do COMPare HL and DE
        RET     Z               ; DE=HL, RETURN
        RST     RSTLDE          ; GET ONE BYTE [load from TeXT if necessary]
        PUSH    HL              ; SHOVEL REGS
        LD      H,B
        LD      L,C
        CALL    STHL            ; MOVE IT [interlaced into TeXT if necessary]
        POP     HL
        INC     DE              ; INCREASE BOTH POINTERS
        INC     BC
        JR      MVUP            ; UNTIL DONE

MVDOWN: LD      A,B             ; *** MVDOWN ***
        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 [load from TeXT if necessary]
        CALL    STHL            ; DO IT [interlaced into TeXT if necessary]
        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 *** [ab omitted CALL CHGSGN ??]
        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 *** AND PRTLNS ***
; *
; * 'PRTSTG' 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 INCLUDED IN COUNT.  POSITIVE SIGN IS NOT.
; *
; * 'PRTLN' FINDS A SAVED LINE, PRINTS THE LINE # AND A SPACE.
; *
; * [new for AB, 'PRTLNS' CALLS 'PRTLN' THEN FALLS INTO 'PRTSTG']
;
PRTLNS: CALL    PRTLN           ; do PRinT Line Number, then ...
PRTSTG: SUB     A               ; *** PRTSTG ***
PS1:    LD      B,A
PS2:    RST     RSTLDE          ; GET A CHARACTER [load from TeXT if necessary]
        INC     DE              ; BUMP POINTER
        CP      B               ; SAME AS OLD A
        RET     Z               ; YES, RETURN
        CALL    OUTCH           ; ELSE PRINT IT  ;* Output Char. in A
        CP      CR              ; WAS IT A CR?
        JR      NZ,PS2          ; NO - NEXT
        RET

QTSTG:  RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        INC     DE              ; BUMP PAST
        CP      '"'
        JR      Z,QT1           ; IF DOUBLE QUOTE-PRINT IT
        CP      $27             ; OR IF SINGLE
        JR      Z,QT1           ; LIKEWIZE
        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, THEN RET
        INC     HL
        JP      (HL)

PRTCHS: LD      A,E
        CP      B
        RET     Z
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
        CALL    OUTCH           ; do OUTput CHaracter in A
        INC     DE
        JR      PRTCHS

PRTNUM  EQU     $               ; *** PRTNUM ***
PN3:    LD      B,$00           ; B=SIGN
        CALL    CHKSGN          ; CHECK SIGN
        JP      P,PN4           ; NO SIGN
        LD      B,'-'           ; B=SIGN
        DEC     C               ; '-' TAKES SPACE
PN4:    PUSH    DE
        LD      DE,$000A
        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  ;* Output a Space
        JR      PN7             ; MORE?

PN8:    LD      A,B             ; PRINT SIGN
        OR      A
        CALL    NZ,OUTCH        ; MAYBE - OR NULL
        LD      E,L             ; LAST REMAINDER IN E
PN9:    LD      A,E             ; CHECK DIGIT IN E
        CP      $0A             ; 10 IS FLAG FOR NO MORE
        POP     DE
        RET     Z               ; IF SO RETURN
        ADD     A,'0'
        CALL    OUTCH           ; AND PRINT THE DIGIT  ;* Output Char. in A
        JR      PN9             ; GO BACK FOR MORE

PRTLN:  RST     RSTLDE          ; *** PRTLN *** [load from TeXT if necessary]
        LD      L,A             ; LOW ORDER LINE #
        INC     DE
        RST     RSTLDE          ; HIGH ORDER [load from TeXT if necessary]
        LD      H,A
        INC     DE
        LD      C,$02           ; PRINT 2 DIGIT [minimum] LINE #
        CALL    PRTNUM          ; do PRinT NUMber in HL
SPOUTCH:    ; SPace OUTput CHaracter routine
        LD      A,' '           ; FOLLOWED BY BLANK
        JP      OUTCH           ; Output Space

; Tables for some COMMANDS, FUNCTIONS, and RELATIVE OPERATIONS
TAB2:   ITEM    'TV',PUTCD      ; DIRECT-STATEMENT
        ITEM    'MU',PUTMU
        ITEM    '&',PUTIO
        ITEM    'CALL',DOCALL
        ITEM    '.',REM
; [Note: ITEM    '$',DOLLAR  for Calculator routine has been deleted] 
        DB      ':'
        TOKEN   $74,TOUTPU      ; on :PRINT
        DB      ':'
        TOKEN   $73,TINPUT      ; on :INPUT
        DB      ':'
        TOKEN   $6A,TLOAD       ; on :RUN
        DB      ':'
        TOKEN   $68,TVLIST      ; on :LIST
; [Note: DB      ':'
;        TOKEN   $70,TCLOSE       on :RETURN to close off tape input port
;        DB      '*'
;        TOKEN   $74,POUTPU       ... and on *PRINT have been deleted,
;  Crafty hackers are now referred to the section explaining EXPERIMENTER
; SUPPORT FEATURES for hints on how to add a custom character print routine.
;
        TOKEN   $60,SILENCE     ; on Down-Arrow [new for ab]
        ITEM    'STOP',STOP
        DEFF    FINISH
;* End list 1
;
;*       FUNCTIONS
;
TAB3:   TOKEN   $76,RND         ; Input 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
;* End list 2

TAB6:   ITEM    '>=',XPR1       ; RELATION OPS
        ITEM    '#',XPR2
        ITEM    '>',XPR3
        ITEM    '=',XPR5
        ITEM    '<=',XPR4
        ITEM    '<',XPR6
        DEFF    XPR7
RANEND  EQU     $
;* End list 3

; more routines here

;                        EDITOR FEATURE
;
;     An editing feature has been added.  Pressing the PAUSE
; key will retrieve a character from a statement in program
; storage.  This feature is used as follows:
;     1) Type the line number of the line you wish to
; correct.
;     2) Press the PAUSE key once to recall the next
; character from the line in storage.  Repeated pressing of
; PAUSE will scan across the stored line.
;     3) A character drawn by PAUSE looks to the computer
; just like a character entered directly from the keypad.  This
; means ERASE can be used to discard unwanted characters from
; the stored line.
;     4) Additions can be entered at any time, intermixed
; as desired.
;     5) If PAUSE runs off the end of the stored line, it
; will have the same effect as pressing the GO key.  The key
; sequence WORDS-SPACE will also activate this feature.  An
; earlier version of Improved BASIC worked using this
; sequence.
;
GLED:   LD      A,(EDFLG)       ; *** Graphic Line EDitor ***
        AND     A
        JR      Z,GLEDA
        LD      DE,BUFFER
        CALL    TSTNUM          ; do TeST for NUMber
        CALL    FNDLN           ; do FiND HL Line Number in TeXT
        LD      A,'?'
        RET     NZ
        INC     DE
        CALL    GLEDB
        XOR     A
        LD      (EDFLG),A
GLEDA:  LD      DE,(EDPTR)
        RST     RSTLDE          ; does LD A,(DE) [from TeXT if necessary]
GLEDB:  INC     DE
        LD      (EDPTR),DE
        RET

;* Output A and input into BUFFER
GETLN:  LD      DE,BUFFER       ; *** GET a LiNe [redone for ab] ***
        LD      (EDFLG),A
GL1:    CALL    OUTCH           ; PROMPT OR ECHO  ;* Output Char. in A
GL2:    PUSH    BC
        PUSH    HL
        PUSH    DE
; PLACE UP CURSOR BLOCK
        LD      C,$AA
        CALL    CURSE           ; do Draw CURSor
; 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      $05
        JR      NZ,GL2B         ; JUMP IF NOT
; GET PREVIOUS LINE # AND BUMP IT
        LD      HL,(OLDLN)
        LD      DE,$000A
        ADD     HL,DE
        RES     7,H             ; ALLOW NEG
GL2J:   LD      (NLLNLN),HL     ; MOVE TO WORKING RAM CELL
; COMPUTE DIVISION SUBTRACTOR
GL2B:   SYSSUK  INDEXW         ;* Get $2F0F+(A*2)
        DW      TBLDIV - 2     ;* to DE

        LD      HL,(NLLNLN)
        LD      B,$00
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          ; SET NONZERO FLAG
        JR      GL2D

; NOTHIN FANCY
GL2C:   CALL    CHKIO           ; GET NORMAL CHARACTER from keyboard
        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          ; [label not needed]
        CP      RUBOUT
        JR      NZ,GL4         ;* Jp if not ERASE
        LD      A,E
        CP      BUFFER & $FF
        JR      Z,GL2          ;* Jp if at beginning
        DEC     DE
        LD      A,(DE)
        CP      $68             ; TOKEN TO RUB OUT?
        JR      NC,TOKIN
        CALL    PNOTE           ; do Play NOTE tone for key in A
        LD      A,RUBOUT
        JR      GL1

TOKIN:  PUSH    DE
        CALL    TOKEPT          ; do TOKEn PoinTer returned in HL
TOKER:  LD      A,(HL)
        PUSH    HL
        AND     $7F
        CALL    PNOTE           ; do Play NOTE tone for key in A
        LD      A,RUBOUT
        CALL    VDM             ; do Virtual Display Monitor output
        POP     HL
        LD      A,(HL)
        INC     HL
        RLCA
        JR      NC,TOKER
TOKEQ:  LD      A,RUBOUT        ; [label not needed]
        CALL    OUTCH           ; ECHO ONE RUBOUT CHAR  ;* Output Char. in A
        POP     DE
GL9:    JP      GL2

GL4:    XOR     CR
        JR      Z,GL5
        LD      A,E
        CP      BUFEND & $FF
        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            ; Carriage Return (and Line Feed)
        JP      OUTCH           ; to OUTput CHaracter in A

; SUBROUTINE TO SIMULATE A CHARACTER DISPLAY IN THE ARCADE
; FRAME BUFFER.  THE SIMULATED VDM [Virtual Display Monitor]
; 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 SET
; IS USED.
;
XOUTCH: PUSH    AF              ; [Vectored to by a CALL OUTCH into RAM at
                                ; $4E9B of HVECT, initialized to JP XOUTCH]
        EXX
        CALL    VDM             ; do Virtual Display Monitor output
        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      $78
        JR      C,FILT2
FILT1:  LD      A,'?'
FILT2:  CP      $68             ; TOKEN TO PRINT?
        JR      NC,TOKEP        ; JUMP IF SO
; PLAY NOTE FOR THIS CHAR
        CALL    PNOTE           ; do Play NOTE tone for key in A
; NON NEW LINE CHAR - UNWRITE OLD CURSOR
VDM1:   CALL    UCURSE          ; do Undraw CURSor
        CALL    LDVDMC          ; do LoaD VDM Coordinates
        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     $06             ; NO - BACKUP X
        LD      L,A
        JR      VDMDN1          ; AND JOIN STORE BACK

VDM2:   LD      L,$96
        LD      A,H
        SUB     $08
        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      $80             ; ALT FONT THE CHAR
        LD      C,011000B       ; OR WRITE THE CHAR
        LD      IX,ALTFON       ; USING ALTERNATE CHAR FONT
        SYSTEM  CHRDIS          ; IT  ;* Display Character

        LD      A,L             ; ADVANCE X POINTER  ;* Skip a space
        ADD     A,$06
        LD      L,A
        CP      $9C             ; END OF LINE?
        JR      NZ,VDMDN1       ; NO - JUMP
        CALL    NEWLIN          ; YES - NEW 1 LINE
        LD      A,$01           ; AND SET NEW LINE FORCED FLAG
        JR      VDMDN2

VDMDN1: CALL    STVDMC          ; do STore VDM Coordinates
VDMDON: XOR     A               ; CLEAR NEW LINE FORCED FLAG
VDMDN2: LD      (VDMNLF),A
        RET

; ROUTINE TO DISPLAY A TOKEN IN FULL FORM
;
TOKEP:  CALL    TOKEPT          ; do TOKEn PoinTer returned in HL 
TOKEP1: LD      A,(HL)
        AND     $7F
        PUSH    HL
        CALL    VDM             ; do Virtual Display Monitor output
        POP     HL
        LD      A,(HL)
        INC     HL
        RLCA
        JR      NC,TOKEP1
        LD      A,' '           ; PUT SPACE AFTER TOKEN
        JP      VDM             ; AND GO HOME via VDM output

; SUBROUTINE TO UNWRITE THE CURSOR
;
UCURSE: LD      C,$00
        JR      CURSE           ; do Draw CURSor in BC

; SUBROUTINE TO DISPLAY NEW LINE
;
NEWLIN: CALL    LDVDMC          ; do LoaD VDM Coordinates
; IS SCROLL UP NEEDED?
        LD      L,$00
        LD      A,H
        CP      $50
        JR      NZ,NEWL1        ; JUMP IF NOT NEEDED
;
;     A variable called SM (SCROLL MODE) has been added to
; allow more user control of the scrolling process which
; occurs when printing reaches the bottom of the screen.
;        SM=0    Scrolls conventionally [as in BB].
;        SM=1    Suppresses scrolling, cursor stays at bottom
;        SM=2    Holds cursor at screen bottom, clears after
;                each CR
;        SM=3    Clears the screen and resets cursor to
;                screen top.
;        SM=4    AUTO-PAUSE, release by pressing any key.
;                After release the screen will clear and
;                printing will resume from screen top.
;
; SCROLL UP IS NEEDED
        CALL    STVDMC          ; do STore VDM Coordinates
; WHAT MODE SHALL WE USE?
        LD      A,(SCRMOD)
        DEC     A
        RET     Z               ; 1 - NO SCROLL
        DEC     A
        LD      HL,$4C80
        JR      Z,CLRLP         ; 2 - to CLeaR LooP [just last line]
        DEC     A
        JR      Z,CLRENT        ; 3 - to CLeaR ENTire screen
        DEC     A
        JR      Z,CLRFRZ        ; 4 - to CLeaR after FReeZe until keydown
        LD      HL,$4DC0
SCRL9:  LD      A,(HL)          ; else - NORMAL SCROLL
        AND     01010101B      ;* Save screen bits
        LD      (HL),A         ;* Make them good
        INC     HL             ;* Move them up
        LD      A,L
        CP      $20
        JR      NZ,SCRL9
        LD      B,$04
SCRLP:  PUSH    BC
        LD      HL,NORMEM
        LD      DE,NORMEM + $0050
        LD      BC,$C00E
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,$08
        LD      H,A
        JP      STVDMC          ; to STore VDM Coordinates

; Clear Screen subroutines [by SM variable, new for ab]
CLRFRZ: CALL    KEYSCN          ; FReeZe until ANY KEY DOWN
        JR      Z,CLRFRZ
; RESET VDM GOODIES then CLeaR ENTire screen
CLRENT: PUSH    DE
        SYSSUK  MOVE            ; MOVE BYTES (SYSTEM ROUTINE)
        DW      VDMX
        DW      $0004           ; 4 bytes   VDM X, VDM Y
        DW      INIDEV + 6      ; INIDEV Part 2 to $4E5C

        POP     DE
        LD      HL,$4000
CLRLP:  LD      A,(HL)          ; [also used for last line only]
        AND     01010101B
        LD      (HL),A
        INC     HL
        LD      A,H
        CP      $4E
        JR      NZ,CLRLP
        RET

; SUBROUTINE TO PAINT CURSOR
; C = DATA TO PAINT 00 OR AA
;
CURSE:  PUSH    AF             ;* Get CY/CX to HL
        CALL    LDVDMC          ; do LoaD VDM Coordinates
PCURS1: EX      DE,HL
        XOR     A
        SYSTEM  RELAB1         ;* Subroutine 58

        OUT     (MAGIC),A
        EX      DE,HL
        LD      A,C
        LD      BC,$0806
        CALL    BOXPUT          ; do draw a BOX PUT on screen
        POP     AF
        RET

; NEW KEYBOARD HANDLER
; WITH SHIFT KEY ROLLOVER
;
XCHKIO: CALL    KEYSCN          ; MAKE SURE PREVIOUS KEY RELEASE  ;* Get keyboard data
        JR      NZ,XCHKIO      ;* Wait till no key change
; AWAIT DEBOUNCE TIMER COUNTDOWN
CHKIO0: LD      HL,KEYTMR
        LD      (HL),$06        ; SET IT  ;* Set key release timer
LOOPER: LD      A,(HL)
        AND     A
        JR      NZ,LOOPER      ;* Wait for timer to expire
; SAVE BACKGROUND COLOR
        LD      A,(DEVCL0)     ;* Get BC
        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,$FFEB        ; (-21) ** SIZE OF LOOKUP TABLE  ;* 20 keys+color
        LD      BC,$0414
GETK2:  IN      A,(C)           ; INPUT FROM PORT  ;* Get shift key
        AND     $20             ; SHIFT KEY DOWN?
        JR      NZ,GETK3        ; JUMP IF YEP  ;* Got one
        ADD     HL,DE           ; ELSE TO NEXT TABLE  ;* Back up to previous table
        INC     C               ; AND PORT  ;* Next port
        DJNZ    GETK2          ;* Do all 4 ports
; NO SHIFT KEY IS DOWN - USE WHATEVER WE HAD BEFORE
        POP     HL             ;* Get current no-shift address
        JR      GETK5

; A SHIFT KEY IS DOWN - SAME OLD STORY?
GETK3:  POP     DE              ; DISCARD OLD BELIEFS  ;* Clear stack
        LD      A,(HL)          ; SET NEW COLOR  ;* Get BC
        LD      (DEVCL0),A
GETK4:  INC     HL              ; SKIP COLOR BYTE  ;* Point to keys
; NOW SCAN FOR ANY 'NORMAL' KEY DEPRESSION
GETK5:  CALL    KEYSCN         ;* Get input
;* Not there, allow different shift key
        JR      Z,GETK1         ; JUMP IF NO KEY DOWN
; WE GOT ONE - CONVERT TO ASCII
        DEC     A               ; BY TABLE LOOKUP  ;* Back to keys 0-23
        LD      C,A
        LD      B,$00
        ADD     HL,BC          ;* Point to conversion
        POP     AF              ; RESTORE COLOR  ;* Get original BC
        LD      (DEVCL0),A     ;* Reset it
        LD      A,(HL)          ; GET CODE  ;* Get key conversion
        AND     A               ; A HLT PERCHANCE?
        JR      Z,INIJMP        ; YEP - RESET  ;* Restart if no code
        CP      $01             ; AN ERROR?
        JR      Z,XCHKIO        ; YEP - GO DOIT AGAIN  ;* Meaningless key
; GOOD KEY...
CHKI02: RLCA                    ; set C to bit 7 value [label no longer needed]
        CALL    C,WCLICK        ; do Click if flagged (GO,ERASE,+,-,0,x,divide)
        LD      A,(HL)         ;* Regain converted key
        AND     $7F
        CP      NLLN           ;* Was it GO+10 ?
        RET     NZ
        LD      HL,$0005       ;* Yes
        LD      (NLLNCT),HL     ; SET FLAG AND ZERO SUPPRESS
        LD      A,CR            ; PASS BACK CR AS FIRST CHAR  ;* Return a CR
        RET

; NEW CLICK ROUTINE
;
WCLICK: LD      A,G0            ; $FD or 253 (not "GO")
        LD      (MUZTON),A
        LD      A,(DEVTEM)     ;* Get note time
        DEC     A
        RET     M               ; Silence if Tempo = 0
        LD      A,$01          ;* 1 beat delay
        LD      (NEWTMR),A      ; Short Click
        RET

; SUBROUTINE TO CHECK FOR HLT KEY WHILE PGM RUNNING
;* Check for PAUSE or ABORT
;
WHATSU: PUSH    BC
        PUSH    DE
        CALL    KEYSCN          ; GET KEY CODE  ;* Get calculator input
        SUB     $02             ; FREEZE?  ;* Was it PAUSE?
        JR      Z,FRZKEY       ;* Yes
        DEC     A
        JR      Z,INIJMP       ;* Jp if HALT
        JR      FRZGBK          ; ELSE GO BACK TO CALLER  ;* Else leave

;* PAUSE: wait for another key
FRZKEY: CALL    KEYSCN          ; SCAN FOR NONZERO KEY TO REL
        JR      Z,FRZKEY
        CP      $03             ; HLT NAILED?  ;* Was it another HALT
INIJMP: JP      Z,INIT         ;* Yes, restart
FRZGBK: POP     DE
        POP     BC
        RET

; SUBROUTINE TO SCAN TINY BASIC KEYBOARD
;* KEYPAD INPUT (all but shift)
;
KEYSCN: LD      BC,$0414        ; B = CNT, C = PORT #
        LD      DE,KEYTRK       ; DE = KEYBOARD MEMORY
        XOR     A
        SYSTEM  RANGED         ;* Random number

KYSCN1: IN      A,(C)           ; LOOK AT COLUMN  ;* Raw key number
        AND     $1F             ; ISOLATE THE RELEVANT
        JR      NZ,KYSCN2       ; JUMP IF BITS HIGH  ;* Got one
        INC     C               ; BUMP PORT #  ;* Next port
        DJNZ    KYSCN1         ;* Do all input ports
        XOR     A               ; SET ZERO STATUS
        LD      (DE),A          ; NOTHIN - SAY ZIP  ;* Set last key = 0
        RET                    ;* and leave

; DEPRESSION FOUND - JUMP UP AND DOWN
KYSCN2: DEC     B
        LD      C,$00           ; 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              ;* Keys 1-24
        LD      B,A
        LD      A,(DE)
        XOR     B
        LD      A,B            ;* Save new value
        RET     Z               ; QUIT IF THE SAME  ;* Leave if same as last time
        LD      (DE),A          ; ELSE UPDATE TRACKER
        RET                    ;*  and leave

; SUBROUTINE TO PLAY A NOTE
;* NOTE OUTPUT
;
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         ; Tone STORe a Zero for Space
        LD      A,H
        CP      $63
        JR      Z,PNOTDV        ; Down an octave on Divide sign
        CP      $62
        JR      Z,PNOTML        ; Up an octave on Multiply sign
        CP      '+'
        JR      Z,PNOTPL        ; Sharp next note +1 through +7
        CP      '-'
        JR      Z,PNOTMN        ; Flat next note -1 through -7
        CP      CR
        JR      Z,PNOTCL        ; on GO
        SUB     '0'
        JR      Z,PNOTZ         ; to Play NOTe Zero
        DEC     A
        CP      $07
        JR      C,ANSW          ; Play Notes 1 thru 7
        LD      A,$6C           ; Play Notes 8, 9, & etc.
        SUB     H
        JR      TSTOR           ; 52 down through 9 for Divide

ANSW:   LD      HL,SHARPF       ; *** for Dick AiNSWorth ***
        ADD     A,(HL)          ; + 7 if Sharp, + 14 if Flat
        SYSSUK  INDEXB          ; INDEX BYTE (SYSTEM SUBROUTINE)
        DW      DICKY           ; HL + A [not loaded!] to HL

TSTOR:  LD      (MUZTON),A      ; Tone STORe routine  ;* Save next note
        LD      A,(DEVTEM)
        LD      (NEWTMR),A
PNOTCL: XOR     A               ; Clear SHARPF  ;* Set for normal notes
PSHARP: LD      (SHARPF),A
LINKB:  POP     AF
        POP     DE
        POP     HL
        RET

PNOTDV: LD      A,OA1          ;* Set down an octave
        DB      $11             ; does a LD DE,$233E  ;* Skips 2 bytes
PNOTML: DB      $3E             ; does a LD A,OA3  ;* Set up an octave
        DB      $23
        LD      (MUZMO),A       ; save as Master Oscillator  ;* Set master sound divider
        JR      LINKB

PNOTPL: LD      A,$07          ;* Set for sharps
        DB      $11             ; does a LD DE,$0E3E  ;* Skips 2 bytes
PNOTMN: DB      $3E             ; does a LD A,14  ;* Set for flats
        DB      $0E
        JR      PSHARP          ; save as SHARPF

PNOTZ:  LD      HL,MUZTMR       ; Play NOTe Zero routine
        LD      A,(DEVTEM)
        AND     A
        JP      M,LINKB         ; exit if NT < 0
        DI
        ADD     A,(HL)          ; add NT to MUZTMR  ;* Increment note timer by one NT
        LD      (HL),A
        EI
        JR      LINKB           ; LINK Back

; SUBROUTINE TO POINT AT A TOKEN
;
TOKEPT: LD      HL,TOKTXT       ; POINT AT TEXT LIST
        SUB     $68
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:                          ; for Keys 1 to 7 only  ;* Normal note table
        DB      C2,D2,E2,F2,G2,A2,B2
                                ; Sharps  ;* Sharp note table
        DB      CS2,DS2,F2,FS2,GS2,AS2,C3
                                ; Flats  ;* Flat note table
        DB      B1,CS2,DS2,E2,FS2,GS2,AS2

TBLDIV: DW      $0001           ; 1
        DW      $000A           ; 10
        DW      $0064           ; 100
        DW      $03E8           ; 1000
        DW      $2710           ; 10000

IGNBLK: LD      A,(DE)          ; *** IGNBLK ***  ;* RST20 [not RST#0]
        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
;* CHARACTER TABLE, NO SHIFT KEYS
;
; Also used as Note to Play, new for ab
; Does a short Click if flagged negative
;
FIRSTL:
        DB      CR + $80        ; Go
        DB      EDKEY           ; Pause
        DB      $00             ; Halt
        DB      $63 + $80       ; Divide
        DB      '7'
        DB      '8'
        DB      '9'
        DB      $62 + $80       ; Multiply
        DB      '4'
        DB      '5'
        DB      '6'
        DB      '-' + $80
        DB      '1'
        DB      '2'
        DB      '3'
        DB      '+' + $80
        DB      ' '
        DB      '0' + $80
        DB      RUBOUT + $80    ; Erase
        DB      '='

; FIRST SHIFT KEY
;* PORT 17 SHIFT KEY (GREEN BACKGROUND)
KTBL1:
        DB      $A7             ; FIRST SHIFT KEY COLOR = Green
        DB      CR + $80        ; (Go)
        DB      EDKEY           ; (Pause)
        DB      $00             ; (Halt)
        DB      $01             ; [bb was EDKEY]
        DB      'A'
        DB      'D'
        DB      'G'
        DB      'J'
        DB      'M'
        DB      'P'
        DB      'S'
        DB      'V'
        DB      'Y'
        DB      $5F             ; Left-Arrow
        DB      $5E             ; Up-Arrow
        DB      '&'
        DB      '$'
        DB      '<'
        DB      '('
        DB      '#'

; SECOND SHIFT KEY
;* PORT 16 SHIFT KEY (RED BACKGROUND)
KTBL2:
        DB      $5F             ; SECOND SHIFT KEY COLOR = Red
        DB      CR + $80        ; (Go)
        DB      $2F             ; Slash
        DB      $00             ; (Halt)
        DB      $5B             ; Left Bracket
        DB      'B'
        DB      'E'
        DB      'H'
        DB      'K'
        DB      'N'
        DB      'Q'
        DB      'T'
        DB      'W'
        DB      'Z'
        DB      $27             ; Apostrophe
        DB      '.'
        DB      '@'
        DB      ','
        DB      $22             ; Quotes
        DB      ';'
        DB      '%'

; TABLE THE THIRD
;* PORT 15 SHIFT KEY (BLUE BACKGROUND)
KTBL3:
        DB      $0F             ; THIRD SHIFT KEY COLOR = Blue
        DB      CR + $80        ; (Go)
        DB      $5C             ; Backslash
        DB      $00             ; (Halt)
        DB      $5D             ; Right Bracket
        DB      'C'
        DB      'F'
        DB      'I'
        DB      'L'
        DB      'O'
        DB      'R'
        DB      'U'
        DB      'X'
        DB      '!'
        DB      $61              ; Right Arrow
        DB      $60              ; Down Arrow
        DB      '*'
        DB      '?'
        DB      '>'
        DB      ')'
        DB      ':'

; TOKEN KEY
;* PORT 14 SHIFT KEY (WORDS)
KTBL4:
        DB      $77             ; WORDS KEY COLOR = Gold
        DB      NLLN            ; GO+10
        DB      EDKEY           ; (Pause)
        DB      $6A             ; RUN token
        DB      $68             ; LIST token
        DB      $72             ; FOR token
        DB      $77             ; TO token
        DB      $75             ; STEP token
        DB      $6B             ; NEXT token
        DB      $6F             ; GOSUB token
        DB      $70             ; RETURN token
        DB      $76             ; RND token
        DB      $6D             ; IF token
        DB      $69             ; CLEAR token
        DB      $6C             ; LINE token
        DB      $71             ; BOX token
        DB      $6E             ; GOTO token
        DB      EDKEY
        DB      $73             ; INPUT token
        DB      $01             ; [bb was EDKEY]
        DB      $74             ; PRINT token

;                    More Routines here

; SUBROUTINE TO LD   A,(DE) FROM SCREEN TEXT MEMORY IF NECESSARY
;
;* EXTRACT BYTE (DE) FROM SCRATCHPAD
;*                   OR
;* EXTRACT BYTE (DE*2) FROM HIDDEN SCREEN AREA
;
; [new for ab, use] RST     RSTLDE (RST $18)
;
LDE:    BIT     7,D
        JR      Z,LDE1         ;* Jp if normal scratchpad
        EX      DE,HL
        ADD     HL,HL          ;* Double the phoney number
        LD      A,(HL)         ;* First get bits 7,5,3,1
        RLCA
        INC     HL
        XOR     (HL)
        AND     10101010B
        XOR     (HL)           ;* Then bits 6,4,2,0
        SCF
        RR      H              ;* Byte value to A [different for ab ??]
        RR      L
        EX      DE,HL          ;* Don't mess up his pointer
        RET

LDE1:   LD      A,(DE)         ;* Extract normal data
        RET

; DOUBLE STORE a word in DE into memory pointed to by HL Routine
;
STDEHL: LD      A,E
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        INC     HL
        LD      A,D
; THEN FALL INTO...
; STORE a byte INTO memory pointed to by HL Routine
;
;* DEPOSIT BYTE AT (HL) INTO SCRATCHPAD
;*                 OR
;* DEPOSIT BYTE AT (HL*2) INTO HIDDEN SCREEN AREA
;
STHL:   BIT     7,H
        JR      Z,STHL1        ;* Jp if normal deposit
        PUSH    BC
        LD      C,A
        ADD     HL,HL          ;* Double his phoney number
        RRCA                   ;* Make bits 7,5,3,1 as
        XOR     (HL)           ;*  6,4,2,0 and get screen
        AND     01010101B      ;* Save screen bits
        XOR     (HL)           ;*  and restore mine
        LD      (HL),A         ;* Then place them away
        INC     HL
        LD      A,C
        XOR     (HL)           ;* With screen bits
        AND     01010101B
        XOR     (HL)           ;* Combined with mine
        LD      (HL),A         ;* For the screen area
        SCF
        RR      H
        RR      L
        LD      A,C
        POP     BC
        RET

; SUBROUTINE TO STORE a byte using LD     (HL),A
STHL1:  LD      (HL),A         ;* Store normal data
        RET

; END OF BALLY BASIC INTERPRETER (AKA ASTROBASIC)