Microsoft 6800 (GRT) BASIC patching loader for Sphere

ms_basic_loader_sphere.asm

;
; Microsoft 6800 (GRT) BASIC patching loader for Sphere
; Loads and patches GRT Corporation's G/2 BASIC (aka Microsoft 6800 BASIC).
;
; By Ben Zotto, 2023. https://sphere.computer
; 
; G/2 BASIC was sold by GRT Corporation from 1978, targeting the SWTPC 6800.
; It appears to be a thinly branded version of "Microsoft 6800 BASIC". It's not
; clear to me whether there were other editions of Microsoft 6800 BASIC outside 
; the Altair 680's earlier paper tape BASIC. Notable about this version is its
; addition of cassette save and load commands, critical for systems that don't 
; use punch tape as their standard mass storage. In other words, a great fit 
; for Sphere.
;
; Like the Altair 680 BASIC that preceded it, the BASIC object file is designed
; to (a) load and execute at address $0000, which runs afoul of Sphere's PDS 
; workspace in the direct page and (b) talk to SWTPC hardware. So this file 
; contains a one-time loader plus permanently resident drivers for the Sphere 
; console I/O and cassette.
; 
; This file is designed to be assembled and placed as the first block on a 
; Sphere cassette, to be loaded and run at $4E00 (top of a 20k system). 
; Executing this program will then load the original G/2 BASIC binary, move it
; to its final location, patch all the I/O locations plus some other bits and 
; pieces, and then start up BASIC.  
;
; N.B.! Once BASIC is loaded, PDS is off-limits. If you soft reset the Sphere, 
;   the act of starting up PDS will immediately stomp on BASIC's direct page 
;   storage. BASIC can not be trivially re-entered or re-cold-started, it must
;   be fully reloaded. So try not to get into trouble!
;   

; PDS-V3N Import locations and routines
;
CSTATS  EQU     $09         ; Cassette load status
BLKNM   EQU     $33         ; Block name to load
ACIANO  EQU     $38         ; ACIA number (address)
BFRPTR  EQU     $3C         ; Start of load buffer
BFRSZE  EQU     $3E         ; End of loaded program
RDBLK   EQU     $FB91       ; Read block routine

; G2 BASIC patch information, numbered based on the patch points on pg 12 of 
; the manual.
;
; The following five locations are the core console and tape IO hooks, 
; specified in the manual and verified with disassembly. All patch into JSR
; instructions (the patch location here points to the operand for the JSR).
;
PATCH1  EQU     $0479       ; Address for INCH routine goes here. Returns val
                            ;   in A, preserve X and B. 
PATCH2  EQU     $0968       ; Address for OUTCH routine goes here. Character 
                            ;   in A, preserve A/B/X.
PATCH3  EQU     $067C       ; Address for POLCAT routine goes here. Carry set
                            ;   on ch avail, else clear. Preserve X.
PATCH4  EQU     $13EB       ; Address for CASIN routine goes here. Same as INCH
                            ;   but only invoked for tape input.
PATCH5  EQU     $1333       ; Address for CASOUT routine goes here. Same as 
                            ;   OUTCH but only invoked for tape output.

; The following two locations are used for patching in a user line printer out
; routine
;
PATCH6A EQU     $1504       ; Insert PSH A, NOP, NOP starting at this location.
PATCH6B EQU     $1516       ; Insert PUL A, then JMP ext opcode starting here. 
PATCH6C EQU     $1518       ; Insert the override LPTOUT address at this loc.
; The final patch neuters SETIO, which detects SWTPC serial board type.
;
PATCH9A EQU     $1CFB       ; Start of SETIO routine. Insert JMP $1D1B here.
PATCH9B EQU     $1D1B

; Sphere usability patch information. Used to make use on Sphere more sane.
; These are "undocumented" patches, making them fragile were you to pair this
; with any but the GRT G/2 1.0 BASIC binary. But like, who cares.
;
PATCHA  EQU     $12DA       ; Location of the delay constant for tape 
                            ;   start/stop delay, normally $A. Smaller faster.
PATCHB  EQU     $1D45       ; JMP to MEMSZE patch goes here. Patch routine 
                            ;   should JMP back to $1D5A
PATCHC1 EQU     $1D9B       ; Location of default terminal width (standard 72).
PATCHC2 EQU     $1D9F       ; Location of uh some other terminal constant 
                            ;   derived from width (72 width -> 56)

; Live locations within G/2 BASIC
;
LINLEN  EQU     $0D         ; dir page loc that tracks terminal line length

; KBD/2 constants
; N.B.! If you change this constant to point to the KBD/1 address, you must 
; also change the POLCAT routine to rotate out the correct flag bit.
; 
KBDPIA  EQU     $F040
        
        ORG     $4E00       ; Loader origin at $4E00, the top of a 20k system

; MAIN: Loads the actual BASIC binary from tape, relocates it, applies patches
; to it, and jumps to its origin point to begin executing.
;
MAIN    LDS     MAIN-1      ; Stack just below this loader stub program for now. 
        JSR     CLRSCR
        LDX     #LDMSG      ; Print loading message
        JSR     OUTMSG      
        
        ; Cache the PDS ACIANO value within our resident cassette driver.
        
        LDX     ACIANO
        STX     ACIADR
        
        ; Setup cassette params. We don't touch ACIANO because it should be 
        ; already set correctly by the load of this loader and we don't want to
        ; ask the user or make assumptions.
        
        LDX     #$00FF      ; Load buffer at $FF. Weird but this is so we can 
                            ;  relocate it using fast indexed copy.
        STX     BFRPTR
        STX     BFRSZE
        LDX     #$4732      ; Block name "G2" (G/2 BASIC)
        STX     BLKNM
        
        ; Load the main BASIC binary.
        
LDMAIN  JSR     RDBLK
        LDA A   CSTATS
        BNE     LDMAIN      ; If there was an error, try again! :shrug:
        LDX     BFRSZE      ; Preserve the pointer to the end of the program
        STX     TEMP       
        
        ; Relocate the program down to its actual origin at $0000.
        ; !! After this point, PDS locations cannot be accessed.
        
        LDX     #0000
RELOC   LDA A   $FF, X
        STA A   0, X
        CPX     TEMP        ; Was that the final byte of the loaded program?
        BEQ     DOPTCH      ; Yes, go do the patching
        INX
        BRA     RELOC
        
        ; Patch the jump points for console I/O in the original implementation
        
DOPTCH  LDX     #INCH
        STX     PATCH1      ; patch console input
        LDX     #OUTCH
        STX     PATCH2      ; patch console output
        LDX     #POLCAT
        STX     PATCH3      ; patch console input query
        
        ; Patch the jump points for cassette I/O
        
        LDX     #CASIN
        STX     PATCH4      ; patch cassette input 
        LDX     #CASOUT
        STX     PATCH5      ; patch cassette output 
        
        ; Patch the line printer output (per the manual)
        
        LDX     #PATCH6A
        LDA A   #$36        ; PSH A
        STA A   0, X
        LDA A   #$01        ; NOP
        STA A   1, X
        STA A   2, X
        LDX     #PATCH6B
        LDA A   #$32        ; PUL A
        STA A   0, X
        LDA A   #$7E        ; JMP [ext]
        STA A   1, X
        LDX     #LPTOUT     ; Local LPTOUT override 
        STX     PATCH6C
        
        ; Patch out SWTPC-specific serial interface detection (per the manual)
        
        LDX     #PATCH9A
        STA A   0, X        ; (A still contains the $7E JMP opcode)
        LDX     #PATCH9B
        STX     PATCH9A+1   ; jump target follows the JMP.
                        
        ; We do not need to setup SWTPC console and printer, so the normal 
        ; entry can be set equal to the SETIO entry. 
        
        LDX     $0004       ; copy the address used in the second jump 
        STX     $0001       ; ... and insert it into the first jump. 
        
        ; The following are undocumented convenience patches for Sphere :-)
        ;
        
        ; Reduce cassette start/stop delay; Sphere runs slower than the SWTPC.
        
        LDA A   #07         ; Patch delay constant. Original value is 10 ($A).
        STA A   PATCHA
        
        ; Patch into "default" MEMORY SIZE code (which normally churns upwards
        ; through RAM to find the end of it, which won't do at all for us) to 
        ; jump to our fixup shim, below.
        
        LDA A   #$7E        ; JMP ext instruction
        STA A   PATCHB        
        LDX     #MEMSZE     ; address of our MEMSZE routine
        STX     PATCHB+1
        
        ; Patch the default TERMINAL SIZE? to Sphere's 31 (why not 32? Behavior
        ; seems wrong when 32)
        
        LDA A   #31         ; 31-line terminal
        STA A   PATCHC1
        LDA A   #28         ; <-- derived value I captured via debugger. (?)
        STA A   PATCHC2
        
        ; Setup the cassette hardware.
        
        LDX     ACIADR      ; Use the cached ACIANO value.
        LDA A   #$13        ; Reset ACIA
        STA A   0, X
        LDA A   #$51        ; Set to /16, 2 stop bits.        
        STA A   0, X
                
        ; We are now ready to roll. Clear the screen and jump to address zero, 
        ; where the BASIC program begins. 
        
        BSR     CLRSCR
        JMP     $0000
        
; ---------        
        
        
; CLRSCR: Clear screen and reset cursor.
;
CLRSCR  LDX     #$E000      ; Clear the screen and set the cursor
        STX     CURSOR      
        LDA A   #' 
CLEAR   STA A   0, X
        INX
        CPX     #$E200
        BNE     CLEAR
        RTS

; OUTMSG: Helper routine to print a zero terminated string.
;
OUTMSG  LDA A   0, X
        BEQ     MSGEXT
        BSR     OUTCH
        INX
        BRA     OUTMSG
MSGEXT  RTS

LDMSG   DS      "LOADING BASIC..."
        FCB     $00
        
; MEMSZE: Memory size shim. This routine, which can be overwritten once BASIC
;   has started up, is patched in and called when the user hits Return (blank)
;   in response to the MEMORY SIZE? prompt. Instead of letting BASIC run 
;   through the address space and destroying this driver (and put junk on the
;   screen), it will essentially substitute "20000" (a safe high mem value) in
;   BASIC's input buffer and then redirect to process it as if the user had
;   entered that value. The MEMORY SIZE? will still respond as designed to a
;   normally input number.
;
MEMSZE  LDX     #$12        ; Start of BASIC's input buffer area
        LDA A   #'2         ; Write "20000", then NUL, here
        STA A   0, X
        LDA A   #'0
        STA A   1, X
        STA A   2, X
        STA A   3, X
        STA A   4, X
        CLR     5, X
        JMP     $1D5A       ; Process the input as if the user entered it.
        
; -------

SPHRIO                      ; Start of console driver (=end of available mem)
        
;------------------------------------------------------------------------------
; Sphere console I/O shims. 
;
; Everything above this point is now disposable in theory; but the code below 
; here must not be overwritten by the BASIC interpreter-- you must answer the 
; MEMORY SIZE prompt with something resonable that doesn't reach beyond here.
;------------------------------------------------------------------------------

; Local resident variables 

ACIADR  RMB     2           ; copy of the PDS ACIANO value
CURSOR  RMB     2           
TEMP    RMB     2
BKSPAC  FCB     $00         ; backspace pending flag

; INCH: Input one char, result in A -- nothing else clobbered.
;
INCH    STX     TEMP        ; stash the caller's X
ICBLNK  LDX     CURSOR      ; blink the cursor
        COM     0, X
        LDX     #9968       ; cursor blink delay
ICCHK   DEX
        BEQ     ICBLNK      ; if delay is done, next blink
        BSR     POLCAT      ; check for ready input
        BCC     ICCHK
        LDX     CURSOR      ; unblink the cursor if needed
        LDA A   0, X
        BPL     ICGET
        COM     0, X
ICGET   LDA A   KBDPIA      ; load the pending character
        CMP A   #$08        ; An actual ^H backspace? 
        BEQ     BKTHNK      ; yes, go to backspace thunk
        CMP A   #'_         ; is this a logical backspace (underscore)
        BNE     ICDONE      ; no, we're done.
BKTHNK  INC     BKSPAC      ; set the backspace pending flag
        LDA A   #'_         ; make we're returning an underscore to = backsp
ICDONE  LDX     TEMP        ; restore X
        RTS
        
; POLCAT: Poll for character, sets carry if ready -- clobbers B only
;
POLCAT  LDA B   KBDPIA+1    ; load the PIA flags
        ASL B               ; rotate the char ready flag ($40) into the carry
        ASL B
RETURN  RTS

; OUTCH: Output character in A. All regs preserved
;
OUTCH   STX     TEMP
        LDX     CURSOR
        PSH A               ; Store the original parameter character value
        AND A   #$7F        ; Clear "parity" bit. Not sure if necessary here.
        CMP A   #$0A        ; is this a linefeed? we just ignore those.
        BEQ     OCDONE
        CMP A   #'_         ; underscore is the BASIC "backspace character"
        BNE     OCCKBEL     
        TST     BKSPAC      ; bkspc flag set if 1:1 with a user entered char. 
        BEQ     OCDONE      ;   no, drop the "extra" emitted underscore. 
        CLR     BKSPAC      ; clear the backspace flag
        DEX                 ; decrement cursor and blank last char.
        LDA A   #'          
        STA A   0, X
        STX     CURSOR      ; store the new cursor
        DEC     LINLEN      ; decrement BASIC's line length counter twice, 
        DEC     LINLEN      ;   we moved left twice relative to underscore.
        BRA     OCDONE
OCCKBEL CMP A   #$07        ; no speaker so bell character gets a screen flash 
        BNE     OCCKCR      
        BSR     INVSCR
        BSR     INVSCR
        BRA     OCDONE
OCCKCR  CMP A   #$0D        ; Check for special case of carriage return.
        BNE     OCEMIT
        LDA A   #32         ; CR -> add 32 and then truncate the cursor index
OCCR    INX
        DEC A
        BNE     OCCR       
        STX     CURSOR
        LDA A   CURSOR+1
        AND A   #$E0
        STA A   CURSOR+1
        LDX     CURSOR
        BRA     OCCHKOV     ; Go check to see if we scrolled off the screen!
    
OCEMIT  STA A   0, X        ; Emit the character to the screen
        INX
        STX     CURSOR
OCCHKOV CPX     #$E200      ; Did we bump the cursor off screen?
        BNE     OCDONE
    
        LDX     #$E000      ; Scroll the contents of the screen up one line.
OCSCRL  LDA A   32, X
        STA A   0, X
        INX
        CPX     #$E1E0
        BNE     OCSCRL  
        STX     CURSOR      ; New cursor at start of last screen line.
        LDA A   #'          ; Fill the last line with blanks.
OCBLNK  STA A   0, X
        INX 
        CPX     #$E200
        BNE     OCBLNK
 
OCDONE  PUL A   
        LDX     TEMP
        RTS 
            
; INVSCR: Helper routine for flashing the screen. Invert all the screen bytes. 
;   Call it twice to get back to normal! Trashes X.
;
INVSCR  LDX     #$E000
INVSCR1 COM     0, X
        INX
        CPX     #$E200
        BNE     INVSCR1
        RTS
            
;------------------------------------------------------------------------------
; Sphere cassette I/O drivers. 
; 
; Because the SYS2NF ROM routines read from direct page PDS memory, they cannot
; be used by a running instance of G2 BASIC. And because the BASIC loads and 
; saves in serial rather than a block output files, most of the standard Sphere
; cassette routines are not helpful anyway. So all that we have here is the 
; basic character in and out functionality, and we have the cached ACIA address
; locally.
;------------------------------------------------------------------------------

; CASIN: Waits for a character from the cassette interface. 
;
CASIN   STX     TEMP
        LDX     ACIADR
        LDA A   #1      
CASIN1  BIT A   0, X
        BEQ     CASIN1
        LDA A   1, X
        STA A   $E01F       ; Display at top right of screen for progress.
        LDX     TEMP
        RTS
        
; CASOUT: Sends char in A to the cassette interface.
;
CASOUT  STX     TEMP
        PSH A   
        LDX     ACIADR
        LDA A   #2
CASO1   BIT A   0, X
        BEQ     CASO1
        PUL A
        STA A   1, X
        STA A   $E01F       ; Display at top right of screen for progress.
        LDX     TEMP
        RTS
        
;------------------------------------------------------------------------------
; [NYI] Sphere line printer driver.
;------------------------------------------------------------------------------

LPTOUT  RTS                 ; Swallow any printer output for now.

END