Mercurial > hg > index.cgi
view src/lwbasic.s @ 39:e956d8b6e806
Add raw version of nextchar/curchar that does not skip spaces
There are a few cases where fetching the next character without skipping
spaces but with the usual flag setting is useful. Notably for parsing line
numbers and other non-keyword syntactic units.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Mon, 21 Nov 2022 23:18:40 -0700 |
| parents | ef961e1c30cb |
| children | 68253ccbb9dc |
line wrap: on
line source
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; LWBasic Version 0.1 ; Copyright © 2022 Lost Wizard Enterprises Incorporated ; ; This is LWBasic, a replacement Basic ROM system for the TRS-80 Color Computer which ; is most definitely not binary compatible with the stock ROMs. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; *pragmapush list *pragma nolist *pragma noexpandcond *pragma cescapes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Utility macros ; ; skip next byte; flags preserved skip1 macro noexpand fcb 0x21 ; opcode for BRN endm ; skip next byte and load nonzero to A skip1lda macro noexpand fcb 0x86 ; opcode for LDA immediate endm ; skip next byte and load nonzero to B skip1ldb macro noexpand fcb 0xc6 ; opcoe for LDB immediate endm ; skip next 2 bytes; clobbers flags skip2 macro noexpand fcb 0x8c ; opcode for CMPX immediate endm *pragmapop list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Various constants console_curdel equ 10 ; delay between cursor blink cycles keyb_bufflen equ 64 ; keyboard ring buffer length keyb_repdeli equ 40 ; ticks before initial repeat (2/3 s) keyb_repdelr equ 6 ; 10 repeats per second keyb_caps equ 0x80 ; capslock enabled keyb_alt equ 0x04 ; alt pressed keyb_ctrl equ 0x02 ; ctrl pressed keyb_shift equ 0x01 ; shift pressed linebuffsize equ 0x100 ; the line input buffer (256 bytes) ifdef COCO3 ; GIME INIT0 GIME_COCO equ 0x80 ; Set for coco2 compatible mode (video display) GIME_MMUEN equ 0x40 ; Set to enable MMU GIME_IEN equ 0x20 ; GIME IRQ enable GIME_FEN equ 0x10 ; GIME FIRQ enable GIME_FExx equ 0x08 ; Enable constant RAM at 0xFExx (comes from block 0x3f) GIME_SCS equ 0x04 ; Set to enable standard SCS (switches 0xFF5x) GIME_ROME16 equ 0x00 ; 16K internal, 16K external ROM mode GIME_ROME32 equ 0x03 ; 32K external ROM GIME_ROMI32 equ 0x02 ; 32K internal ROM ; GIME INIT1 GIME_TMRFAT equ 0x20 ; TIMER ticks approx every 279.365 ns GIME_TMRSLOW equ 0x00 ; TIMER ticks approx every 63.695 µs GIME_TASK0 equ 0x00 ; MMU task 0 GIME_TASK1 equ 0x01 ; MMU task 1 ; GIME interrupt enable/status bits GIME_ITIMER equ 0x20 ; TIMER interrupt (timer reaches 0) GIME_IHBORD equ 0x10 ; HSYNC interrupt (falling edge) GIME_IVBORD equ 0x08 ; VSYNC interrupt (falling edge) GIME_ISERIAL equ 0x04 ; Falling edge of signal on pin 4 of serial port GIME_IKEYBOARD equ 0x02 ; Interrupt if a 0 bit appears on bits 6-0 of PIA0.DA GIME_ICART equ 0x01 ; Interrupt on falling edge of pin 8 of cartridge port ; GIME VMODE GIME_BP equ 0x80 ; enable bit plane mode GIME_BPI equ 0x20 ; colour burst phase inversion (composite output only) GIME_MONO equ 0x10 ; disable colour burst (composite output only) GIME_H50 equ 0x08 ; set to 50Hz operation GIME_LPR1 equ 0x00 ; one line per row GIME_LPR2 equ 0x02 ; two lines per row (also works on graphics) GIME_LPR8 equ 0x03 ; 8 lines per row GIME_LPR9 equ 0x04 ; 9 lines per row GIME_LPR10 equ 0x05 ; 10 lines per row GIME_LPR11 equ 0x06 ; 11 lines per row GIME_LPRINF equ 0x07 ; "infinite" lines per row ; GIME VRES GIME_LPF192 equ 0x00 ; 192 lines on screen GIME_LPF200 equ 0x40 ; 200 lines on screen (actually 199 due to hardware bug) GIME_LPF225 equ 0x60 ; 225 lines on screen GIME_BPR16 equ 0x00 ; 16 bytes per row GIME_BPR20 equ 0x04 ; 20 bytes per row GIME_BPR32 equ 0x08 ; 32 bytes per row GIME_BPR40 equ 0x0c ; 40 bytes per row GIME_BPR64 equ 0x10 ; 64 bytes per row GIME_BPR80 equ 0x14 ; 80 bytes per row GIME_BPR128 equ 0x18 ; 128 bytes per row GIME_BPR160 equ 0x1c ; 160 bytes per row GIME_TXT32 equ 0x00 ; 32 characters per row GIME_TXT40 equ 0x04 ; 40 characters per row GIME_TXT64 equ 0x10 ; 64 characters per row GIME_TXT80 equ 0x14 ; 80 characters per row GIME_BPP1 equ 0x00 ; 1 bit per pixel GIME_BPP2 equ 0x01 ; 2 bits per pixel GIME_BPP4 equ 0x02 ; 4 bits per pixel GIME_TXTATTR equ 0x01 ; text attributes enabled endc ifdef COCO3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Stuff on the fixed memory page org 0xfe00 rmb 0xed ; unused INT.FLAG rmb 1 ; validity flag INT.SWI3 rmb 3 ; SWI3 bounce vector INT.SWI2 rmb 3 ; SWI2 bounce vector INT.FIRQ rmb 3 ; FIRQ bounce vector INT.IRQ rmb 3 ; IRQ bounce vector INT.SWI rmb 3 ; SWI bounce vector INT.NMI rmb 3 ; NMI bounce vector endc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Hardware definitions for the I/O page org 0xff00 PIA0 equ * ; Keyboard PIA PIA0.DA rmb 1 ; PIA0 data/direction A PIA0.CA rmb 1 ; PIA0 control A PIA0.DB rmb 1 ; PIA0 data/direction B PIA0.CB rmb 1 ; PIA0 control B rmb 28 ; mirror images of PIA0 PIA1 equ * ; DA/misc stuff PIA1.DA rmb 1 ; PIA1 data/direction A PIA1.CA rmb 1 ; PIA1 control A PIA1.DB rmb 1 ; PIA1 data/direction B PIA1.CB rmb 1 ; PIA1 control B rmb 28 ; mirror images of PIA1 rmb 16 ; SCS/Disk controller rmb 16 ; second half of SCS area rmb 32 ; miscelaneous hardware ifdef COCO3 rmb 16 ; *reserved* (unused but the GIME drives them) GIME.INIT0 rmb 1 ; basic GIME system config GIME.INIT1 rmb 1 ; MMU task and timer rate GIME.IRQ rmb 1 ; GIME IRQ enable/status register GIME.FIRQ rmb 1 ; GIME FIRQ enable/status register GIME.TIMER rmb 2 ; GIME programmable timer rmb 2 ; *reserved* GIME.VMODE rmb 1 ; GIME video mode setting GIME.VRES rmb 1 ; GIME video resolution setting rmb 1 ; *reserved* (used for MMU expansion on some memory boards) GIME.BORDER rmb 1 ; GIME border colour GIME.VSCROLL rmb 1 ; vertical scroll offset register/VDG screen mode variation GIME.VOFFSET rmb 2 ; address of video memory (8 byte increments) GIME.HOFFSET rmb 1 ; horizontal scroll offset GIME.MMU equ * ; MMU registers (two tasks) GIME.MMU0 rmb 8 ; MMU task 0 GIME.MMU1 rmb 8 ; MMU task 1 GIME.PALETTE rmb 16 ; Palette registers else rmb 64 ; unused on Coco 1/2 (GIME on Coco 3) endc SAMREG equ * ; the SAM configuration register SAM.V0CLR rmb 1 ; SAM video mode bits SAM.V0SET rmb 1 SAM.V1CLR rmb 1 SAM.V1SET rmb 1 SAM.V2CLR rmb 1 SAM.V2SET rmb 1 SAM.F0CLR rmb 1 ; SAM screen address bits SAM.F0SET rmb 1 SAM.F1CLR rmb 1 SAM.F1SET rmb 1 SAM.F2CLR rmb 1 SAM.F2SET rmb 1 SAM.F3CLR rmb 1 SAM.F3SET rmb 1 SAM.F4CLR rmb 1 SAM.F4SET rmb 1 SAM.F5CLR rmb 1 SAM.F5SET rmb 1 SAM.F6CLR rmb 1 SAM.F6SET rmb 1 SAM.P1CLR rmb 1 ; SAM "page 1" selection (or extra memory type flag) SAM.P1SET rmb 1 SAM.R0CLR rmb 1 ; SAM R0 bit (address dependent speedup, not used on Coco3) SAM.R0SET rmb 1 SAM.R1CLR rmb 1 ; SAM R1 bit (full speedup/coco 3 speedup) SAM.R1SET rmb 1 SAM.M0CLR rmb 1 ; SAM M0/M1 bits (memory type, not used on Coco3) SAM.M0SET rmb 1 SAM.M1CLR rmb 1 SAM.M1SET rmb 1 SAM.TYCLR rmb 1 ; force ROM mode (map type 0) SAM.TYSET rmb 1 ; set RAM mode (map type 1) rmb 18 ; *MPU reserved* CPU.SWI3 rmb 2 ; CPU SWI3 vector CPU.SWI2 rmb 2 ; CPU SWI2 vector CPU.FIRQ rmb 2 ; CPU FIRQ vector CPU.IRQ rmb 2 ; CPU IRQ vector CPU.SWI rmb 2 ; CPU SWI vector CPU.NMI rmb 2 ; CPU NMI vector CPU.RESET rmb 2 ; CPU RESET/startup vector ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Start of memory which has the direct page and other data. org 0 dpstart equ * ; start of direct page memtop rmb 2 ; absolute top of memory in 64K memory map memsize rmb 2 ; top of memory not reserved freetop rmb 2 ; top of free memory (bottom of string space) stringtab rmb 2 ; bottom of used string space progtext rmb 2 ; pointer to start of program text vartabint rmb 2 ; pointer to start of integer scalars vartabfloat rmb 2 ; pointer to start of floating point scalars vartabstring rmb 2 ; pointer to start of string scalars objecttab rmb 2 ; pointer to start of arrays and other variable sized objects freestart rmb 2 ; pointer to start of unallocated memory readlinenoecho rmb 1 ; if nonzero, the readline routine won't echo its input console_curptr rmb 2 ; current cursor pointer for console driver console_blnkdel rmb 1 ; cursor blink delay console_truelc rmb 1 ; set to nonzero if the console supports true lower case (gfx, etc.) filenum rmb 1 ; current input/output channel fileeof rmb 1 ; flag for whether last read detected EOF keyb_flags rmb 1 ; shift flags for the keyboard keyb_joystate rmb 1 ; joystick button state keyb_repdel rmb 1 ; repeat delay keyb_curscan rmb 1 ; current repeating scan code keyb_buffw rmb 2 ; keyboard ring buffer write pointer keyb_buffr rmb 2 ; keyboard ring buffer read pointer curline rmb 2 ; pointer to current line contline rmb 2 ; pointer to line for CONT contstmt rmb 2 ; interpretation pointer for CONT curstmt rmb 2 ; start of statement currently being interpreted endflag rmb 1 ; 00 = END, FF = STOP rmb 0x71-* ; align RSTFLG/RSTVEC for stock ROM compatibility RSTFLG rmb 1 ; 0x55 if RSTVEC is valid RSTVEC rmb 2 ; points to warm start routine (must start with NOP) inputptr rmb 2 ; pointer to current program execution location rmb 0x100-* ; make sure the stuff that isn't direct page is outside of it SW3VEC rmb 3 ; SWI3 vector (for compatibility) SW2VEC rmb 3 ; SWI2 vector (for compatibility) SWIVEC rmb 3 ; SWI vector (for compatibility) NMIVEC rmb 3 ; NMI vector (for compatibility) IRQVEC rmb 3 ; IRQ vector (for compatibility) FRQVEC rmb 3 ; FIRQ vector (for compatibility) keyb_state rmb 8 ; rollover table state keyb_buff rmb keyb_bufflen ; the keyboard ring buffer linebuff rmb linebuffsize ; the line input buffer tokebuff rmb linebuffsize+50 ; make it as long as line buffer plus a margin ifne *&0x1ff rmb 0x200-(*&0x1ff) endc textscreen rmb 0x200 ; the actual text screen (must be on 512 byte alignment) heapstart equ * ; start of dynamically allocated stuff org 0x8000 ; the hardware puts the ROMs here; it's not negotiable ROMSTART equ * START orcc #0x50 ; make sure interrupts are disabled if we come here in an unusual way ifdef COCO3 ldu #gime_inite ; point to end of GIME initializer ldx #GIME.INIT0+(gime_inite-gime_init) ; point to end of GIME registers ldb #gime_inite-gime_init ; number of bytes to transfer initc0 lda ,-u ; copy byte to GIME (count down so we init MMU before turning it on) sta ,-x decb ; done? bne initc0 ; brif not endc ldd #0xff34 ; initizer for below tfr a,dp ; set DP to I/O page setdp 0xff ; tell assembler about DP value clr PIA0.CA ; set PIA0 A to direction mode clr PIA0.CB ; set PIA0 B to direction mode clr PIA0.DA ; set PIA0 A to all inputs (comparator, keyboard rows) sta PIA0.DB ; set PIA0 B to all outputs (keyboard columns) stb PIA0.CA ; set PIA0 A to data mode, interrupt disabled, MUX to source 0 stb PIA0.CB ; set PIA0 B to data mode, interrupt disabled, MUX to source 0 clr PIA1.CA ; set PIA1 A to direction mode clr PIA1.CB ; set PIA1 B to direction mode deca ; set PIA1 A bits 7-1 output (DAC, RS232), 0 input (cassette) sta PIA1.DA lda #0xf8 ;* set PIA1 B bits 7-3 output (VDG stuff), 2-0 input (single bit sound, sta PIA1.DB ;* RS232 input, ram size input) stb PIA1.CA ; set PIA1 A to data mode, interrupt disabled, cassette motor off stb PIA1.CB ; set PIA1 B to data mode, interrupt disabled, sound off lda #2 ; set RS232 output to "marking" (stop bit) sta PIA1.DA lda #16 ; clear 16 SAM register bits ldu #SAMREG ; point to SAM register bits init0 sta ,u++ ; clear SAM bit deca ; done all? bne init0 ; brif not ; set the SAM to point to the text screen, which the code will handle at any ; arbitrary 512 byte aligned address in memory ifne (textscreen)&0x200 sta SAM.F0SET endc ifne (textscreen)&0x400 sta SAM.F1SET endc ifne (textscreen)&0x800 sta SAM.F2SET endc ifne (textscreen)&0x1000 sta SAM.F3SET endc ifne (textscreen)&0x2000 sta SAM.F4SET endc ifne (textscreen)&0x4000 sta SAM.F5SET endc ifne (textscreen)&0x8000 sta SAM.F6SET endc ifdef COCO2B ; The following SAM configuration sequence is different from the one in the usual ; one used by the earlier models of the Coco because the Coco2B has the '785 variant ; of the SAM instead of the '783 variant. The '785 variant supports 16Kx4 RAMs which ; are used in Coco2B systems. Hence why there is a different version of this ROM ; just for the Coco2B. clr PIA0.DB ; strobe RAM size low ldb #4 ; is input low? bitb PIA1.DB beq init1 ; brif not sta SAM.M0SET ; program SAM for 16Kx4 RAMs sta SAM.P1SET skip2 init1 sta SAM.M1SET ; program SAM for 64Kx1 RAMs else ifndef COCO3 ; Detect the installed memory size so the SAM ('783 variant) can be correctly ; programmed for the installed memory. Note that this sequence is replaced with ; a different one for the Coco2B which has the '785 variant of the SAM. ldb #0xff ; strobe RAM size high stb PIA0.DB ldb #4 ; mask for ram size check bitb PIA1.DB ; is the bit set on ram size input? beq init2 ; brif not - 4Kx1 RAMs sta PIA0.DB ; clear RAM size output to see what happens (A is 0 from above) bitb PIA1.DB ; is it set now? beq init1 ; brif not - 64Kx1 RAMs leau -2,u ; adjust pointer so we set the other RAM size bit for the SAM (16Kx1) init1 sta -3,u ; set M0 (16Kx1) or M1 (64Kx1) endc endc init2 tfr a,dp ; set DP to bottom of memory (A is 0 from above) setdp 0 ; tell assembler about it lds #textscreen ; put the stack just below the text screen ifdef COCO3 ; Check if we need to do a ROM/RAM copy, which will happen if the interrupt vectors are ; not flagged valid OR the reset vector isn't valid ldb INT.FLAG ; are the bounce vectors valid? cmpb #0x55 bne initc4 ; brif not - do ROM/RAM copy ldb RSTFLG ; is reset vector valid? bne initc2 ; brif not - check secondary location ldx RSTVEC ; get reset vector ldb ,x ; is it valid?\ cmpb #0x12 bne initc2 ; brif not initc1 jmp ,x ; transfer control to warm start routine initc2 clr GIME.MMU0 ; check again with block 0 in the direct page ldb RSTFLG ; get new RSTFLG cmpb #0x55 ; valid? bne initc3 ; brif not ldx RSTVEC ; get new RSTVEC ldb ,x ; is it valid? cmpb #0x12 beq initc1 ; brif so - transfer control initc3 ldb #0x38 ; restore MMU stb GIME.MMU0 initc4 ldx #initc6 ; point to helper ldu #textscreen ; point to text screen ldb #initc7-initc6 ; bytes to copy initc5 lda ,x+ ; copy byte sta ,u+ decb ; done? bne initc5 ; brif not ldu #0x8000 ; point to start of ROM jmp textscreen ; transfer control to helper in RAM initc6 sta SAM.TYCLR ; drop to ROM mode pulu d,x,y,s ; grab 8 bytes sta SAM.TYSET ; go to RAM mode pshu d,x,y,s ; stick the bytes in RAM leau 8,u ; move to next 8 bytes cmpu #0xfe00 ; end of stuff to copy? blo initc6 ; brif not jmp initc7 ; go back to mainline initc7 lds #textscreen ; reset stack to somewhere safe lda #0x12 ; activate ROM warm start handler sta warmstart ldx #INT.FLAG ; point to bounce vector destination ldu #int_init ; point to initializer for bounce vectors ldb #int_inite-int_init ; number of bytes to copy initc8 lda ,u+ ; copy byte sta ,x+ decb ; done? bne initc8 ; brif not ; now recheck for warm start in case ROM/RAM copy made things valid endc ldb RSTFLG ; is the reset vector valid? cmpb #0x55 bne coldstart ; brif not - do cold start ldx RSTVEC ; get warm start routine pointer ldb ,x ; does it start with NOP? cmpb #0x12 bne coldstart ; brif not - do cold start jmp ,x ; transfer control to warm start routine ifdef COCO3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; GIME register initializer gime_init fcb GIME_COCO|GIME_MMUEN|GIME_FExx|GIME_SCS|GIME_ROMI32 ; enable MMU, SCS, constant page, internal ROM fcb GIME_TASK0 ; use MMU task 0 fcb 0 ; do not enable IRQ sources fcb 0 ; do not enable FIRQ sources fdb 0xfff ; set timer to max value fdb 0 ; *reserved placeholder* fcb 0,0,0,0 ; SG4 screen settings with black border fcb 0x0f,0xe0,0x00,0x00 ; (puts screen in bottom 64K of memory) fcb 0x38,0x39,0x3a,0x3b ; MMU task 0 (bottom of top 64K of RAM) fcb 0x3c,0x3d,0x3e,0x3f ; (ROM shadow must be in 3c...3f) fcb 0x38,0x39,0x3a,0x3b ; MMU task 1 (copy of task 0) fcb 0x3c,0x3d,0x3e,0x3f fcb 18,54,9,36,63,27,45,38 ; palette values (RGB) fcb 0,18,0,63,0,18,0,38 gime_inite equ * int_init fcb 0x55 ; vectors valid flag jmp SW3VEC ; bounce to stock ROM compatibility vector jmp SW2VEC ; bounce to stock ROM compatibility vector jmp FRQVEC ; bounce to stock ROM compatibility vector jmp IRQVEC ; bounce to stock ROM compatibility vector jmp SWIVEC ; bounce to stock ROM compatibility vector jmp NMIVEC ; bounce to stock ROM compatibility vector int_inite equ * endc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Cold start handling coldstart ldx #dpstart ; point to start of direct page ldd #0 ; set up for blanking coldstart0 std ,x++ ; blank a couple of bytes cmpx #textscreen ; end of low memory? blo coldstart0 ; brif not ifndef COCO3 ; This is the memory size detection sequence. This runs through memory starting at the bottom of memory ; and stops when it reaches something that can't be modified successfully. This is basically the same ; algorithm used by the stock ROM. It takes less space than doing a more pointed set of probes. The end ; result will be X pointing to the byte one below the top of RAM. This is intentional to ensure there ; is one writeable byte at the top of string space. Note that X will point to the byte after the end ; of the text screen when we get here. ldx #heapstart ; point to start of heap coldstart1 lda 2,x ; get original value at test location coma ; invert all bits sta 2,x ; write it to the memory location cmpa 2,x ; did it take? bne coldstart2 ; brif not com 2,x ; restore memory byte leax 1,x ; move pointer forward bra coldstart1 ; go check next byte else ; For the Coco3, we do not need to concern ourselves about where the top actual memory is so we don't ; bother doing a memory scan in the default 64K memory map. Because we always run from RAM, we can actually ; set the top of memory to the actual top of the 32K space without having to ensure there is an extra byte ; available above the string space. ldx #ROMSTART-1 ; point to top of memory endc coldstart2 stx memtop ; save absolute top of memory stx memsize ; save top of unreserved memory stx stringtab ; mark string space as empty leax -200,x ; allocate 200 bytes of string space stx freetop ; save top of free memory leas ,x ; put the stack there ldx #heapstart ; point to start of free memory stx progtext ; put the start of the program there clr ,x+ ; put a NULL pointer to mark end of program clr ,x+ stx vartabint ; put start of integer variables at end of program stx vartabfloat ; put start of floating point variables after that stx vartabstring ; put start of string variables after that stx objecttab ; also put the start of large objects there stx freestart ; mark the start of free memory lda #keyb_caps ; enable caps lock but disable all other shift states sta keyb_flags ldx #warmstart ; set up warm start handler stx RSTVEC lda #0x55 ; activate warm start handler sta RSTFLG ldd #0x7e3b ; opcodes for JMP extended and RTI ldx #irqhandler ; enable IRQ handler with a JMP at the vector sta IRQVEC stx IRQVEC+1 sta FRQVEC ; initialize FIRQ handler with JMP ldx #firqhandler stx FRQVEC+1 stb NMIVEC ; initialize NMI to RTI stb SW3VEC ; initialize SWI3 to RTI stb SW2VEC ; initialize SWI2 to RTI stb SWIVEC ; initialize SWI to RTI ldx #greeting ; display greeting jsr console_outstr bra warmstartb ; finish up initialization ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Warm start handling ifdef COCO3 warmstart fcb 0xff ; set to 0xff to force ROM/RAM copy on reset else warmstart nop ; flag warm start routine as valid endc jsr console_clear ; clear screen clr filenum ; reset I/O channel to the screen warmstartb jsr keyb_reset ; reset the keyboard lda #0x35 ; enable VSYNC interrupt in PIA sta PIA0.CB andcc #0xaf ; enable interrupts at the cpu jmp immediate ; go start immediate mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; System startup message ; (start with form feed to clear screen; saves 2 bytes over 'jsr console_clear' in cold start) greeting fcc '\fLWBASIC VERSION 2022.0\r\n' fcc 'COPYRIGHT (C) 2022 BY LOST\r\n' fcc 'WIZARD ENTERPRISES INC.\r\n' fcn '\n' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; IRQ handler ; ; Note that the interrupt flag in the PIA is cleared at the start of the interrupt handler. That means that if it takes ; a long time to process this interrupt, or processing this interrupt was delayed somewhat, it is far less likely that ; an interrupt gets missed. In that case, we may end up re-interrupting immediately on RTI, but it should reduce the ; number of missed interrupts. irqhandler lda PIA0.CB ; was it VSYNC? bmi irqhandler0 ; brif so lda PIA0.DA ; clear HSYNC flag so we don't get stuck if it gets enabled ifdef COCO3 lda GIME.IRQ ; clear GIME IRQ state flags endc rti irqhandler0 lda PIA0.DB ; clear VSYNC flag clra ; make sure DP is pointing to the right place tfr a,dp lda console_blnkdel ; is the cursor blinking? beq irqhandler1 ; brif not dec console_blnkdel ; time to cycle cursor? bne irqhandler1 ; brif not lda #console_curdel ; reset blink counter sta console_blnkdel lda [console_curptr] ; get character at cursor adda #0x10 ; move to next colour ora #0x8f ; force it to be a full 4x4 colour block sta [console_curptr] ; update cursor on screen irqhandler1 bsr keyb_read ; go handle the keyboard rti ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; FIRQ handler ; ; This handler is present to prevent accidentally enabling the interrupt and thus hanging to system. It may seem to be ; a waste of code space, but consider it a self defense situation. firqhandler pshs a ; need a scratch register ifdef COCO3 lda GIME.FIRQ ; clear GIME FIRQ state flags endc lda PIA1.DA ; clear interrupt flags lda PIA1.DB lda PIA1.CA ; disable interrupts to prevent system hang anda #0xfe sta PIA1.CA lda PIA1.CB anda #0xfe sta PIA1.CB puls a ; restore register rti ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Console keyboard input driver ; ; Reset the keyboard state, which means clearing the buffer and state flags keyb_reset ldx #keyb_buff ; point to start of keyboard ring buffer stx keyb_buffw ; set write point there stx keyb_buffr ; set read point there (pointers equal means empty buffer) lda keyb_flags ; reset keyboard state flags but keep capslock anda #keyb_caps sta keyb_flags clr keyb_joystate ; clear joystick button state clr keyb_curscan ; stop any keyboard repeating ldx #0xffff ; mark all key state as "unpressed" stx keyb_state stx keyb_state+2 stx keyb_state+4 stx keyb_state+6 rts ; Read character from keyboard ring buffer; return with C set if buffer empty; this doesn't actually need to have ; interrupts disabled because the interrupt only ever updates the write pointer and then only to increase it. As a ; result, worst case is that we don't detect the contents added to the buffer on this call and have to wait for the ; next. keyb_getkey pshs x ; save register ldx keyb_buffr ; get read pointer cmpx keyb_buffw ; same as write pointer? bne keyb_getkey0 ; brif not - we have a result coma ; set carry for empty buffer puls x,pc ; restore register and return keyb_getkey0 lda ,x+ ; get character from buffer cmpx #keyb_buff+keyb_bufflen ; did we run off end of buffer? blo keyb_getkey1 ; brif not ldx #keyb_buff ; reset to start keyb_getkey1 stx keyb_buffr ; save new read pointer andcc #0xfe ; flag key retrieved puls x,pc ; restore register and return ; The PIA reading loop is specifically set up to NOT read PIA0.DB to avoid prematurely clearing the VSYNC interrupt flag ; since that could lead to missing interrupts. Reading PIA0.DA will clear the HSYNC interrupt flag but that's less of a ; problem because that interrupt is basically useless. ; ; As a note, doing the PIA read in a loop ends up using an extra 27 CPU cycles for the BCS instruction. However, it ; saves 70 code bytes. The trade off seems worth it in this case. ; ; Once keyboard state is read, we do the following: ; ; * update the state of SHIFT, CTRL, ALT ; * decode all other keys in a loop keyb_read0a pshs b ; save flag bit ldb a,y ; get state flag bitb #0x40 ; did it change state? bne keyb_read0d ; brif so puls b,pc ; clean up and return keyb_read0d andb #0xbf ; flag it as not changed stb a,y ldb a,u ; get current modifier state eorb #0x40 ; flip the state bit stb a,u ; save new state flags bitb #0x40 ; Z set if not down puls b ; get back flag bit beq keyb_read0b ; brif key is pressed comb ; invert bit flag andb keyb_flags ; clear bit in flags bra keyb_read0c ; finish up keyb_read0b orb keyb_flags ; set the flag keyb_read0c stb keyb_flags ; update flags rts keyb_read leas -9,s ; make temporary buffer leay 1,s ; point to temporary state buffer clra ;* set to 0xff with C clear; start by strobing no columns for joystick deca ;* then rotate the 0 bit through to do the actual keyboard columns ldu #keyb_state ; point to end of keyboard state buffer sta PIA0.DB ; strobe no columns ldb PIA0.DA ; get joystick button state stb keyb_joystate ; save it for later when needed andb #0x7f ; mask off comparator (pretend "button" down) stb ,s ; save button/comparator state mask rola ; set up for first column keyb_read0 sta PIA0.DB ; set column strobe ldb PIA0.DA ; read row data eorb ,u+ ; set bits if state changed andb ,s ; mask off comparator and active buttons stb ,y+ ; save state change information rola ; shift to next column bcs keyb_read0 ; brif we haven't done the last column sta PIA0.DB ; reset column strobe to none ldd #0xff00|keyb_shift bsr keyb_read0a ldd #0xfc00|keyb_ctrl bsr keyb_read0a ldd #0xfb00|keyb_alt bsr keyb_read0a keyb_read3 ldd #0x0701 ; initialize bit probe and counter keyb_read4 leay -1,y ; move pointers to next byte leau -1,u keyb_read5 bitb ,y ; did this key change state? bne keyb_read7 ; brif so keyb_read6 adda #8 ; adjust scan code lslb ; shift bit probe bpl keyb_read5 ; brif we haven't done all bits ldb ,y ; update state flags for this byte eorb ,u stb ,u ldb #1 ; reset bit probe anda #0x07 ; reset scan code deca ; adjust for next column bpl keyb_read4 ; brif not - do another leas 9,s ; clean up stack ldb keyb_curscan ; is key repeating? bne keyb_read9 ; brif so keyb_reada rts keyb_read7 bitb ,u ; get current state bne keyb_read8 ; brif key pressed (make) cmpa keyb_curscan ; is it the currently repeating key? bne keyb_read6 ; brif not - don't need to do anything clr keyb_curscan ; clear the current repeat bra keyb_read6 keyb_read8 sta keyb_curscan ; set the current scan code that is repeating pshs d ; save current bit probe and scan code ldb #keyb_repdeli ; intialize repeat delay stb keyb_repdel bsr keyb_tobuff ; decode key to buffer puls d ; restore scan code and bit probe bra keyb_read6 ; go handle the next bit keyb_read9 dec keyb_repdel ; is it time to repeat it? bne keyb_reada ; brif not ldb #keyb_repdelr ; reset repeat delay stb keyb_repdel lda keyb_curscan ; get current scan code keyb_tobuff tsta ; @? beq keyb_tobuff7 ; brif so cmpa #26 ; is it alpha or @? bhi keyb_tobuff6 ; brif not ldb keyb_flags ; get shift flags bitb #keyb_ctrl|keyb_alt ; ALT or CTRL? bne keyb_tobuff4 ; brif one or both ora #0x60 ; make lower case bitb #keyb_caps ; capslock enabled? beq keyb_tobuff0 ; brif not eora #0x20 ; flip to upper case keyb_tobuff0 bitb #keyb_shift ; shifted? beq keyb_tobuff1 ; brif not eora #0x20 ; flip case if shifted keyb_tobuff1 ldx keyb_buffw ; get write pointer for keyboard buffer sta ,x+ ; put it in the buffer cmpx #keyb_buff+keyb_bufflen ; end of buffer? blo keyb_tobuff2 ; brif not ldx #keyb_buff ; reset pointer to start keyb_tobuff2 cmpx keyb_buffr ; did we run into the read pointer? beq keyb_tobuff3 ; brif so - there wasn't room so don't save pointer stx keyb_buffw ; update the write pointer keyb_tobuff3 rts keyb_tobuff4 bitb #keyb_alt ; is ALT? beq keyb_tobuff1 ; brif not - scan code is CTRL-<letter> code ora #0x80 ; set bit 7 for "ALT" codes bitb #keyb_shift ; shifted? beq keyb_tobuff5 ; brif not ora #0x20 ; set bit 5 keyb_tobuff5 bitb #keyb_ctrl ; ctrl? beq keyb_tobuff1 ; brif not - stash it in the buffer ora #0x40 ; set bit 6 for "ctrl bra keyb_tobuff1 ; stash it the buffer keyb_tobuff6 suba #26 ; codes above 26 down to 1; @ will be 0 keyb_tobuff7 cmpa #6 ; is it "0"? bne keyb_tobuff8 ; brif not ldb keyb_flags ; get shift flags bitb #keyb_shift|keyb_ctrl ; CTRL-0 or SHIFT-0? beq keyb_tobuff8 ; brif not - not "capslock" eorb #keyb_caps ; flip the capslock state stb keyb_flags keyb_tobuffa rts ; and don't put it in the buffer keyb_tobuff8 cmpa #25 ; is it at or above ALT? blo keyb_tobuff9 ; brif not suba #2 ; close gap for ALT/CTRL keyb_tobuff9 ldb #8 ;* 8 codes; multiply by 8 and move to B mul ;* ldx #keyb_codetab ; point to special code table abx ; now X points to the base entry in the table ldb keyb_flags ; get shift flags andb #keyb_shift|keyb_ctrl|keyb_alt ; keep only shift/ctrl/alt lda b,x ; fetch key code beq keyb_tobuffa ; brif no code to return bra keyb_tobuff1 ; go stash it in the buffer ; This is the keyboard code table; there are 8 bytes per entry in the following order: ; 0: unmodified ; 1: shift ; 2: ctrl ; 3: ctrl-shift ; 4: alt ; 5: alt-shift ; 6: alt-ctrl ; 7: alt-ctrl-shift ; ; No entries for ALT, CTRL, SHIFT, or letters keyb_codetab fcb 0x40,0x13,0x40,0x40,0x80,0xa0,0xc0,0xe0 ; @ fcb 0x5e,0x5f,0x00,0x00,0x00,0x00,0x00,0x00 ; <UP> fcb 0x0a,0x5b,0x00,0x00,0x00,0x00,0x00,0x00 ; <DOWN> fcb 0x08,0x15,0x00,0x00,0x00,0x00,0x00,0x00 ; <LEFT> fcb 0x09,0x5d,0x00,0x00,0x00,0x00,0x00,0x00 ; <RIGHT> fcb 0x20,0x20,0x20,0x20,0x20,0x20,0x20,0x20 ; <SPACE> fcb 0x30,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; 0 (shift/ctrl variants shadowed above) fcb 0x31,0x21,0x00,0x00,0x00,0x00,0x00,0x00 ; 1 ! fcb 0x32,0x22,0x00,0x00,0x00,0x00,0x00,0x00 ; 2 " fcb 0x33,0x23,0x00,0x00,0x00,0x00,0x00,0x00 ; 3 # fcb 0x34,0x24,0x00,0x00,0x00,0x00,0x00,0x00 ; 4 $ fcb 0x35,0x25,0x00,0x00,0x00,0x00,0x00,0x00 ; 5 % fcb 0x36,0x26,0x00,0x00,0x00,0x00,0x00,0x00 ; 6 & fcb 0x37,0x27,0x00,0x00,0x00,0x00,0x00,0x00 ; 7 ' fcb 0x38,0x28,0x00,0x00,0x00,0x00,0x00,0x00 ; 8 ( fcb 0x39,0x29,0x00,0x00,0x00,0x00,0x00,0x00 ; 9 ) fcb 0x3a,0x2a,0x00,0x00,0x00,0x00,0x00,0x00 ; : * fcb 0x3b,0x2b,0x00,0x00,0x00,0x00,0x00,0x00 ; ; + fcb 0x2c,0x3c,0x00,0x00,0x00,0x00,0x00,0x00 ; , < fcb 0x2d,0x3d,0x00,0x00,0x00,0x00,0x00,0x00 ; - = fcb 0x2e,0x3e,0x00,0x00,0x00,0x00,0x00,0x00 ; . > fcb 0x2f,0x3f,0x00,0x00,0x00,0x00,0x00,0x00 ; / ? fcb 0x0d,0x0d,0x0d,0x0d,0x0d,0x0d,0x0d,0x0d ; <ENTER> fcb 0x0c,0x5c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c ; <CLEAR> fcb 0x03,0x03,0x1b,0x1b,0x9b,0xbb,0xdb,0xfb ; <BREAK> fcb 0x1c,0x1d,0x1c,0x1d,0x00,0x00,0x00,0x00 ; <F1> fcb 0x1e,0x1f,0x1e,0x1f,0x00,0x00,0x00,0x00 ; <F2> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Console screen output driver ; ; Clear screen console_clear ldb #0x60 ; VDG space character ldx #textscreen ; point to text screen stx console_curptr ; set cursor pointer to start of screen console_clear0 stb ,x+ ; blank a character cmpx #textscreen+0x200 ; end of screen? blo console_clear0 ; brif not rts ; Output NUL terminated string console_outstr0 bsr console_outchr ; output the character console_outstr lda ,x+ ; get byte from string bne console_outstr0 ; brif not end of string rts ; Output NUL terminated string followed by a newline console_outstrn bsr console_outstr ; output the string ; fallthrough intentional ; Output a newline (CR LF) console_outnl lda #0x0d ; do the CR bsr console_outchr lda #0x0a ; do the LF ; fallthrough intentional ; Output a single character to the screen; enter with character in A console_outchr pshs d,x ; save registers ldx console_curptr ; get current cursor pointer cmpa #0x20 ; printable character? blo console_outchr5 ; brif not tsta ; is it a graphics block? bmi console_outchr1 ; brif so - don't do anything to it cmpa #0x40 ; number or most non-alpha characters? blo console_outchr0 ; brif so - will need to flip bit 6 cmpa #0x60 ; upper case? blo console_outchr1 ; brif so - don't need to do anything to it anda #0xdf ; clear bit 5 of lower case; moves it to bottom of character set console_outchr0 eora #0x40 ; flip bit 6 - the "inversion" bit console_outchr1 sta ,x+ ; stick it on screen console_outchr2 stx console_curptr ; save new cursor pointer cmpx #textscreen+0x200 ; end of screen? blo console_outchr4 ; brif not leax -32,x ; move pointer back one line stx console_curptr ldx #textscreen ; point to start of screen console_outchr3 ldd 32,x ; get bytes from next line std ,x++ ; stick them here cmpx #textscreen+0x1e0 ; at last row? blo console_outchr3 ; brif not ldb #0x60 ; space character for VDG screen bsr console_clear0 ; blank out last row (borrowing screen clear loop) console_outchr4 puls d,x,pc ; restore registers and return console_outchr5 cmpa #0x0c ; form feed? bne console_outchr6 ; brif not bsr console_clear ; clear screen puls d,x,pc ; restore registers and return console_outchr6 cmpa #0x0d ; carriage return? bne console_outchr7 ; brif not ldb console_curptr+1 ; get current screen pointer LSB andb #0xe0 ; reset offset to start of line stb console_curptr+1 ; save new pointer LSB puls d,x,pc ; restore registers and return console_outchr7 cmpa #0x0a ; line feed? bne console_outchr8 ; brif not ldx console_curptr ; get cursor pointer leax 32,x ; move it forward exactly one line bra console_outchr2 ; go update stuff check for scroll console_outchr8 cmpa #0x08 ; backspace? bne console_outchr9 ; brif not cmpx #textscreen ; at start of screen? beq console_outchr4 ; brif so - backspace does nothing leax -1,x ; back up pointer (backspace is non-destructive) bra console_outchr2 ; go update pointers, etc. console_outchr9 cmpa #0x09 ; TAB character? bne console_outchr4 ; brif not ldb console_curptr ; get LSB of pointer andb #7 ; 8 space tabs - only keep low 3 bits lda #0x60 ; space character (tab is destructive) console_outchra sta ,x+ ; put a space out incb ; bump counter cmpb #8 ; at next tab stop? blo console_outchra ; brif not bra console_outchr2 ; go update details and check for scroll ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; General I/O handling package ; ; These routines operate on the I/O channel specified by filenum. The defined values of filenum are: ; ; 0: keyboard/screen console ; ; Read a line from the active file into linebuff. The resulting line will be NUL terminated leading to at most ; linbuffsize-1 character input. The trailing CR/LF will not be included. The input will be echoed if linebuffecho is ; enabled. Exit with the length of the input line in B. readline ldx #linebuff ; point to line input buffer clr ,x ; make sure buffer is NUL terminated readline0 bsr readchr ; read an input character bcs readline1 ; brif not EOF cmpa #0x0d ; CR (carriage return) beq readline1 ; brif so - return cmpa #0x03 ; BREAK? bne readline3 ; brif not coma ; set carry for irregular exit skip1 readline1 clra ; clear carry for regular exit pshs cc ; save carry state lda readlinenoecho ; are we echoing? bne readline2 ; brif not lda #0x0d ; echo carriage return + line feed bsr writechr readline2 tfr x,d ; get end address after input subd #linebuff ; subtract start of buffer; D is now length and C is clear clr ,x ; make sure line is NUL terminated puls cc,pc ; restore BREAK flag (C) and return readline3 cmpa #0x08 ; backspace? bne readline4 ; brif not cmpx #linebuff ; at start of buffer? beq readline0 ; brif so - do nothing leax -1,x ; move back buffer pointer bsr readlinee ; write a BS lda #0x20 ; write a space bsr readlinee lda #0x08 ; and finally a BS bsr readlinee bra readline0 ; go process more characters readline4 cmpa #0x0c ; form feed? bne readline5 ; brif not bsr readlinee ; go echo character if needed bra readline ; go restart line entry readline5 cmpa #0x20 ; is it non-printing? blo readline0 ; brif so - don't store it and continue bsr readlines ; stash character in buffer and echo if necessary bra readline0 ; go get another character readlines cmpx #linebuff+linebuffsize-1 ; is the line buffer full? bhs readlinee0 ; brif so - don't store character OR echo it sta ,x+ ; stash character readlinee ldb readlinenoecho ; are we echoing? bne readlinee0 ; brif not bsr writechr ; echo the character readlinee0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Write a newline if not at left margin. This will unconditinally output a newline for devices where the horizontal ; position is not knowable. writecondnl lda filenum ; get file number bne writenl ; brif not screen - we'll do it unconditionally lda console_curptr+1 ; get LSB of cursor pointer anda #0x1f ; keep only the low 5 bits (32 characters per line) beq writecondnl0 ; brif no newline is needed ; fallthrough intended ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Write a newline to the chosen device. writenl lda #0x0d ; code for carriage return - will serve as newline ; fallthrough intended ; Write a character to the active file; all registers preserved but C will be set if the output file cannot handle ; an output character (doesn't exist, etc.) writechr tst filenum ; is it screen? beq writechr_scr ; brif writing to screen orcc #1 ; unknown device flag writecondnl0 rts ; Handle output to the screen. This is where we convert CR to CRLF writechr_scr jsr console_outchr ; output the character cmpa #0x0d ; was it CR? bne writechr_scr0 ; brif not lda #0x0a ; ouptut an LF jsr console_outchr lda #0x0d ; restore original value writechr_scr0 andcc #0xfe ; clear error flag rts ; Read a character from the active file and return it in A; in the event that EOF is detected, readeof will be nonzero ; and the call will return with carry set. readchr clr fileeof ; flag not end of file (and clear carry) lda filenum ; get input file number beq readchr_kb ; brif keyboard input com fileeof ; flag end of file (C set and fileeof nonzero) rts ; Read character from keyboard; blink cursor while doing so readchr_kb pshs b ; preserve B as temp storage ldb [console_curptr] ; get character at cursor inc console_blnkdel ; activate cursor blinking (first interrupt will cycle it) readchr_kb0 jsr keyb_getkey ; read keyboard bcc readchr_kb1 ; brif we got a result cwai #0xaf ; wait for interrupt to scan keyboard bra readchr_kb0 ; see if we have something yet readchr_kb1 clr console_blnkdel ; disable cursor blinking stb [console_curptr] ; restore screen character clrb ; clear carry to indicate not eof puls b,pc ; restore temp and return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Write a character to the selected output device. If the device is one that does not support actual lower case, then ; conver the character to upper case. Otherwise, pass it through as is. Currently, only the console screen falls into ; this category. This *will* modify the character in A if a change is made. writechrconduc tst filenum ; is it screen? bne writechr ; brif not - just output it tst console_truelc ; does the current text screen support actual lower case? bne writechr ; brif so - just output character cmpa #'a ; is it lower case? blo writechr ; brif not cmpa #'z ; is it still lower case? bhi writechr ; brif not suba #0x20 ; shift to upper case bra writechr ; go output it ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Fetch next input character, skip spaces. This is structured the way it is to avoid burning any register except A ; which is used for the returned value. Z will be set if the input character is NUL or a colon. C will be set if the ; input character is an ASCII digit. This allows testing Z to identify the end of a command due to either a colon or ; the end of a line. ; ; Compared to Color Basic, the instruction sequence only varies in the handling of the LDA. In Color Basic, the sequence ; is an LDA extended followed by a JMP extended. This totals to 9 cycles (5 for LDA, 4 for JMP). In LWBasic, an LDA ; with extended indirect addressing is used. This also totals 9 cycles. The only other difference is when a space is ; detected where the branch can be direct to the nextchar code instead of having to branch around a direct page JUMP ; which saves 3 cycles for the case where a space is detected. In other words, this is only slower by virtue of the ; fact that it is called with an extended JSR instead of a direct JSR which causes one extra cycle to be used there ; and one extra byte for each call to nextchar or curchar. ; ; On 6309, native move saves an extra cycle in the LDA sequence using the LDA extended followed by JMP extended ; sequence. ; ; This whole thing could be sped up by keeping the input pointer in a register. However, retaining the ability to ; use Y without having to save it first is likely more beneficial. nextchar inc inputptr+1 ; bump LSB of input pointer bne curchar ; brif no carry inc inputptr ; bump MSB curchar lda [inputptr] ; read the byte cmpa #'9+1 ; clear C if above ASCII digits, Z if colon bhs curchar0 ; brif above the ASCII digits cmpa #0x20 ; is it a space? beq nextchar ; brif so - skip over it suba #'0 ; clever way to set C if >= ASCII 0, Z if zero suba #-'0 curchar0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This is exactly the same as nextchar except it doesn't skip spaces. Unfortunately, for efficiency purposes, we need ; to actually duplicate code here. nextcharraw inc inputptr+1 ; bump LSB of input pointer bne curchar ; brif no carry inc inputptr ; bump MSB curcharraw lda [inputptr] ; fetch the byte cmpa #'9+1 ; clear C if above digits, set Z if colon bhs curcharraw0 ; brif above digits suba #'0 ; clever way to set C if >= ASCII 0, Z if zero suba #-'0 curcharraw0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The error handler ; ; Enter with the error number in B. This routine will do some cleanup and handle any ON ERROR GOTO handler that ; may be active. ; ; Note the error message lookup does not need to be efficient which is why the lookup just runs through the list ; of error messages in sequence looking for NUL terminators. The specific handling of B (error number) below avoids ; issues if there happen to be error codes above 128. ERROR clr filenum ; reset display device to console jsr writecondnl ; do a newline if needed (will preserve B) ldx #errormsg ; point to error message list incb ; account for decb below bra ERROR1 ; go search for correct message ERROR0 lda ,x+ ; end of message? bne ERROR0 ; brif not end of message ERROR1 decb ; at the correct one? bne ERROR0 ; brif not - skip to next one ERROR2 lda ,x+ ; get character to output beq ERROR3 ; brif end of message jsr writechrconduc ; output the character, converted to upper case situationally bra ERROR2 ; handle another character ERROR3 lds freetop ; reset the stack pointer (error routine could be called anywhere) ; fall through to immediate mode intentional ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Immediate mode handler immediate jsr writecondnl ; do newline if required ldx #prompt ; point to prompt string jsr console_outstrn immediate0 jsr readline ; read input line bcs immediate0 ; brif ended with BREAK ldx #linebuff ; point to start of line input buffer stx inputptr ; set input pointer jsr curchar ; skip spaces and set flags bcs immediate1 ; brif there's a line number tsta ; is there anything there at all (end of line)? beq immediate0 ; brif not - read another line ldx inputptr ; get the modified input pointer processing above jsr tokenize ; tokenize the line at inputptr, return with result at tokebuff jsr interpretline ; go interpret the tokenized line bra immediate ; go handle another line immediate1 ; handle line insert/delete/modify bra immediate0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Main interpretation loop ; ; Enter at interpret with inputptr pointing to the code stream to interpret. ; Enter at interpretline with X pointing to the command stream to interpret which will return to the caller one the ; command stream has completed. STOP or BREAK will return with carry set while END or falling off the end of the ; code will return with carry clear. In the event of an error, the usual error processing will be done and control ; will return to immediate mode with the stack reset. interpret ldx inputptr ; get interpration address stx curstmt ; save address of the current statement (needed for some stuff) lda ,x+ ; are we at the end of the line? beq interpret0 ; brif so cmpa #': ; end of statement? beq interpret3 ; brif so - do a statement SNERROR ldb #err_sn ; raise a syntax error jmp ERROR interpret0 sta endflag ; flag the program exit state as "END" (will be zero) ldd curline ; were we in immediate mode? bne interpret1 ; brif not clra ; clear carry to indicate normal exit rts ; return to caller interpret1 ldd ,x++ ; are we at the end of the program? beq interpret4 ; brif so - bail out stx curline ; save pointer to current line leax 1,x ; set input pointer one before the start of the line text interpret2 stx inputptr interpret3 jsr nextchar ; fetch first character of next statement beq interpret ; brif end of statement - do the next statement dance tsta ; set flags properly for token lbpl cmd_let ; brif no command - do assignment (LET command is optional) ldx #primaryjump ; point to jump table anda #0x7f ; lose bit 7 leax a,x ; get half way to the correct offset ldx a,x ; get the address the other half of the way from here jsr nextchar ; skip past token and set flags jsr ,x ; call the routine bra interpret ; go handle the next statement dance interpret4 bsr cmd_stop1 ; make sure stack is aligned correctly (will not return) interpretline clr curline ; blank out current line pointer (for immediate mode) clr curline+1 leax -1,x ; move back before start of code stream bra interpret2 ; go interpret this statement and then continue with stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The END command. cmd_end bne SNERROR ; error out if there is an argument ;jsr closeall ; close all files for END clra ; flag END bra cmd_stop0 ; go do the stop/end cmd_stop bne SNERROR ; raise error if there was an argument lda #0xff ; flag STOP cmd_stop0 sta endflag ; set stop/end flag cmd_stop1 clr filenum ; reset I/O to console ldx curline ; in immediate mode? beq cmd_stop2 ; brif so - don't save the continue pointers stx contline ; save pointer to current line for CONT ldx curstmt ; get current statement address stx contstmt ; save it for CONT cmd_stop2 rol endflag ; get STOP/END to C (1=STOP) bcc cmd_stop3 ; brif END - don't do message ldx #breakmsg ; do "BREAK IN" jmp ERROR2 ; the bottom half of the error handler can deal with the details cmd_stop3 puls x,pc ; lose return address and return to caller of interpretation loop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; REM and ' commands; also ELSE comes here since it needs to skip the rest of the line in that case. cmd_else cmd_apos cmd_rem clra ; clear carry ldx curline ; get start of current line beq cmd_stop3 ; brif immediate mode - fall back to caller ldx ,x ; get address of next line leax -1,x ; move back one stx inputptr ; put input pointer there rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; DATA command ; ; need to skip to the end of the current statement, which is either the end of the line OR a colon not included inside ; a quoted string cmd_data ldx inputptr ; get input pointer cmd_data0 lda ,x+ ; get character at pointer beq cmd_data2 ; brif end of line cmpa #': ; end of statement? bne cmd_data1 ; brif not cmd_data1 leax -1,x ; move back to the NUL or colon stx inputptr ; reset input pointer for interpreter rts cmd_data2 cmpa #'" ; start of constant string? bne cmd_data0 ; brif not - process more characters cmd_data3 lda ,x+ ; get next string character beq cmd_data1 ; brif end of line cmpa #'" ; string delimiter? bne cmd_data3 ; brif not - keep going bra cmd_data0 ; process stuff outside string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Miscelaneous strings prompt fcn 'OK' ; general prompt breakmsg fcn 'BREAK' ; "BREAK" message ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Error messages ; ; Each error begins with a deferr macro invocation which will define a symbol err_slug with the next error number ; ; deferr slug ; ; This is then followed by the error message defined with fcn. ; ; Real error numbers start at 1; 0 is used to indicate no error. *pragmapush list *pragma nolist __errnum set 0 deferr macro noexpand err_{1} equ __errnum __errnum set __errnum+1 endm *pragmapop list errormsg deferr none fcn 'No error' deferr nf fcn 'NEXT without FOR' deferr sn fcn 'Syntax error' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The LET command which is the default if no token begins a statement cmd_let jmp SNERROR ; not yet implemented ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Set carry if upper/lower case alpha setcifalpha cmpa #'z+1 ; is it above lower case Z? bhs setcifalpha0 ; brif so, C clear suba #'a ; set C if >= lower case A suba #-'a bcs setcifalpha0 ; brif lower case alpha setcifualpha cmpa #'Z+1 ; is it above upper case Z? bhs setcifalpha0 ; brif so, C clear suba #'A ; set C if >= upper case A suba #-'A setcifalpha0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Set carry if digit setcifdigit cmpa #'9+1 ; is it above digit 9? bhs setcifdigit0 ; brif so, C clear suba #'0 ; set C if >= digit 0 suba #-'0 setcifdigit0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Tokenize line to tokebuff ; ; Enter with X pointing to the text to tokenize. ; Exit with X pointing to the start of the tokenized line and D holding the length of the tokenized line. tokenize clra ; clear "not token" flag clrb ; clear the "in data" flag ldy #tokebuff ; point to destination buffer pshs d,y ; set return value, the "not token" flag, and the "in data" flag tokenize0 lda ,x+ ; get input character bne tokenize1 ; brif not end of input tokenize0a sta ,y+ ; blank out final byte in result tokenize0b leas 2,s ; clean up temporaries on stack tfr y,d ; get end address to accumulator subd #tokebuff ; subtract out start; gives length of result puls x,pc ; set return pointer and return tokenize1 tst ,s ; are we in the middle of a "not token"? beq tokenize3a ; brif not bsr setcifalpha ; is it alpha bcs tokenize2 ; brif so - store it and continue bsr setcifdigit ; is it numeric? bcc tokenize3 ; brif not tokenize2 sta ,y+ ; save output character bra tokenize0 ; check for another tokenize3 clr ,s ; clear the "not token" flag tokenize3a cmpa #'" ; is it a string? bne tokenize5 ; brif not sta ,y+ ; save string delimiter tokenize4 lda ,x+ ; get input character beq tokenize0a ; brif end of input sta ,y+ ; save it in output cmpa #'" ; end of string? bne tokenize4 ; brif not bra tokenize0 ; brif tokenize5 cmpa #': ; end of statement? bne tokenize6 ; brif not clr 1,s ; reset "in data" flag bra tokenize0a ; stash it and continue tokenize6 cmpa #0x20 ; is it a space? beq tokenize0a ; brif so - stash it unmodified tst 1,s ; are we "in data"? bne tokenize0a ; brif so - don't tokenize it cmpa #'' ; ' shortcut for remark? bne tokenize9 ; brif not ldd #':*256+tok_apos ; put token for ' and an implied colon std ,y++ ; stash it tokenize8 lda ,x+ ; fetch byte from input sta ,y+ ; stash in output bne tokenize8 ; brif not end of input bra tokenize0b ; go finish up tokenize9 bsr setcifdigit ; is it a digit? bcs tokenize0a ; brif so - pass it through tsta ; is the high bit set? bmi tokenize0 ; ignore it if so ldu #primarydict ; point to keyword table leax -1,x ; back up input to start of potential token clrb ; initialize the token number clra ; initialize secondary table flag pshs d,x ; save start of input token and the token counter tokenize10 ldb ,u ; are we at the end of the table? bne tokenize11 ; brif not ldu #secondarydict ; point to secondary token dictionary clr ,s ; reset token counter com 1,s ; flip to secondary token flag bne tokenize10 ; brif we haven't already done the secondaries puls d,x ; get back input pointer and clear stack temporaries com ,s ; set "not token flag" lda ,x+ ; get character bra tokenize0a ; stash it and continue tokenize11 ldx 2,s ; get back start of input token tokenize12 ldb ,x+ ; get input character cmpb #'z ; is it above lower case Z? bhi tokenize13 ; brif so cmpb #'a ; is it below lower case A? blo tokenize13 ; brif so subb #0x20 ; convert to upper case tokenize13 subb ,u+ ; does it match? beq tokenize12 ; brif so - check another cmpb #0x80 ; did it match with high bit set? beq tokenize15 ; brif so - exact match leau -1,u ; back up to current test character tokenize14 ldb ,u+ ; end of token? bpl tokenize14 ; brif not inc ,s ; bump token counter bra tokenize10 ; go check another one tokenize15 orb ,s+ ; merge token number with the high bit (bit 7 set from above) lda ,s+ ; get back secondary flag and set flags on it leas 2,s ; clean up saved input pointer from stack bpl tokenize17 ; brif primary token skip2 tokenize18 lda #': ; for putting implied colons in tokenize16 std ,y++ ; put output into buffer jmp tokenize0 ; go handle more input tokenize17 cmpb #tok_else ; is it ELSE? beq tokenize18 ; brif so - stash it with colon cmpb #tok_data ; is it DATA? bne tokenize18a ; brif not stb 1,s ; set "in data" flag tokenize20 stb ,y+ ; stash token jmp tokenize0 ; go handle more tokenize18a cmpb #tok_rem ; is it REM? beq tokenize19 ; brif so cmpb #tok_apos ; apostrophe REM? bne tokenize20 ; brif not - stash token and continue lda #': ; stash the implied colon sta ,y+ bra tokenize19 tokenize19a ldb ,x+ ; fetch next input character tokenize19 stb ,y+ ; stash the character bne tokenize19a ; brif not end of input - do another jmp tokenize0b ; stash end of buffer and handle cleanup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Keyword dictionaries and jump tables. These are defined by several macros which ensure that each command or function ; entry has an associated jump table entry. These macros are: ; ; defcmd string,symbase ; deffunc string,symbase,flags ; cmdtab ; functab ; cmdjump ; funcjump ; defcmd and deffunc will add an entry into the relevant dictionary table as well as adding one to the relevant jump ; tables. The cmdtab, functab, cmdjump, and funcjump will output the table definitions. *pragmapush list *pragma nolist __cmdnum set 0x80 __funcnum set 0x80 defcmd macro noexpand setstr __cmdtab="%(__cmdtab)\tfcs {1}\n" setstr __cmdjump="%(__cmdjump)\tfdb cmd_{2}\n" tok_{2} equ __cmdnum __cmdnum set __cmdnum+1 endm deffunc macro noexpand setstr __functab="%(__functab)\tfcs {1}\n" setstr __funcjump="%(__funcjump)\tfcb {3}\n\tfdb func_{2}\n" tok_{2} equ __funcnum __funcnum set __funcnum+1 endm cmdtab macro *pragmapush list *pragma nolist includestr "%(__cmdtab)" *pragmapop list fcb 0 ; flag end of table endm functab macro *pragmapush list *pragma nolist includestr "%(__functab)" *pragmapop list fcb 0 ; flag end of table endm cmdjump macro *pragmapush nolist *pragma nolist includestr "%(__cmdjump)" *pragmapop list endm funcjump macro *pragmapush nolist *pragma nolist includestr "%(__funcjump)" *pragmapop list endm *pragmapop list defcmd 'REM',rem defcmd /'/,apos defcmd 'DATA',data defcmd 'ELSE',else defcmd 'END',end defcmd 'STOP',stop defcmd 'LET',let primarydict cmdtab secondarydict functab primaryjump cmdjump secondaryjump funcjump ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Need to ensure the vectors are at 0xbff2 zmb 0xbff2-* ; pad ROM up to the vector point fdb SW3VEC ; SWI3 vector fdb SW2VEC ; SWI2 vector fdb FRQVEC ; FIRQ vector fdb IRQVEC ; IRQ vector fdb SWIVEC ; SWI vector fdb NMIVEC ; NMI vector fdb START ; RESET vector (ROM entry point) endc ifdef COCO3 zmb 0xfff2-* ; pad ROM to bottom of vectors fdb INT.SWI3 ; SWI3 vector fdb INT.SWI2 ; SWI2 vector fdb INT.FIRQ ; FIRQ vector fdb INT.IRQ ; IRQ vector fdb INT.SWI ; SWI vector fdb INT.NMI ; NMI vector fdb START ; RESET vector (ROM entry point) else zmb 0x10000-* ; pad ROM to full size endc