From 9b1fcac8ee29a17df68ecea7bf503635a5e7ab58 Mon Sep 17 00:00:00 2001 From: Joppe Blondel Date: Mon, 28 Sep 2026 15:42:07 +0200 Subject: [PATCH] Added tinybasic --- Makefile | 39 +- README.md | 80 +- boot.asm | 50 ++ main.c | 46 +- tinybasic_sdas.asm | 1836 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 2026 insertions(+), 25 deletions(-) create mode 100644 tinybasic_sdas.asm diff --git a/Makefile b/Makefile index a52fc4c..b971da6 100644 --- a/Makefile +++ b/Makefile @@ -9,7 +9,7 @@ METAL_RELFILES := $(METAL_ASM_SRCFILES:%.asm=$(BUILDDIR)/metal/%.rel) \ METAL_CC := sdcc METAL_AS := sdasz80 METAL_MAKEBIN := makebin -METAL_FLAGS := -mz80 --no-std-crt0 --code-loc 0xC080 --code-size 0x2F80 --data-loc 0xF000 +METAL_FLAGS := -mz80 --no-std-crt0 --code-loc 0xC080 --code-size 0x0F80 --data-loc 0xF000 METAL_CPPFLAGS := -I src -I $(BUILDDIR)/metal/generated --disable-warning 283 METAL_BIN_SIZE := 32768 METAL_RAM_SIZE := 16384 @@ -17,6 +17,11 @@ METAL_IMAGE_SIZE := 65536 MONITOR_BASE := 0xC000 MONITOR_ROM_OFFSET := 128 +TINYBASIC_BASE := 0xD000 +TINYBASIC_ROM_OFFSET := 4096 +TINYBASIC_SRC := tinybasic_sdas.asm +TINYBASIC_BUILD := $(BUILDDIR)/tinybasic + .DEFAULT_GOAL := metal .PHONY: all metal clean @@ -31,9 +36,9 @@ metal: $(BUILDDIR)/metal/$(TARGET).ihx $(BUILDDIR)/metal/$(TARGET).bin $(BUILDDI END { \ printf "\nMemory usage:\n"; \ printf " ROM storage: %5u / %5u bytes (%5.1f%%)\n", stored, rom_capacity, 100 * stored / rom_capacity; \ - printf " Runtime RAM: %5u / %5u bytes (%5.1f%%), %5u bytes for growth/stack\n", code + data, ram_capacity, 100 * (code + data) / ram_capacity, ram_capacity - code - data; \ - printf " code/vector: %5u bytes; static data: %5u bytes\n", code, data; \ + printf " Monitor linked: %5u bytes (%5u code/vector + %5u static data)\n", code + data, code, data; \ }' $(BUILDDIR)/metal/$(TARGET).map + @printf " Tiny BASIC: %5u bytes at D000\n" $$(wc -c < $(TINYBASIC_BUILD)/tinybasic.bin) $(BUILDDIR)/metal/$(TARGET).ihx: $(METAL_RELFILES) @mkdir -p $(@D) @@ -42,12 +47,13 @@ $(BUILDDIR)/metal/$(TARGET).ihx: $(METAL_RELFILES) $(BUILDDIR)/metal/$(TARGET).flat.bin: $(BUILDDIR)/metal/$(TARGET).ihx $(METAL_MAKEBIN) -s $(METAL_IMAGE_SIZE) $< $@ -$(BUILDDIR)/metal/$(TARGET).prog.bin: $(BUILDDIR)/metal/$(TARGET).flat.bin +$(BUILDDIR)/metal/$(TARGET).prog.bin: $(BUILDDIR)/metal/$(TARGET).flat.bin $(TINYBASIC_BUILD)/tinybasic.bin @payload_end=$$(awk '$$1 == "DEF" && $$2 == "monitor_image_end" { print $$3 }' $(BUILDDIR)/metal/$(TARGET).noi); \ payload_size=$$((payload_end - $(MONITOR_BASE))); \ test $$payload_size -gt 0; \ - dd if=$< of=$@ bs=1 count=$(MONITOR_ROM_OFFSET) status=none; \ - dd if=$< of=$@ bs=1 skip=$$(( $(MONITOR_BASE) )) seek=$(MONITOR_ROM_OFFSET) count=$$payload_size conv=notrunc status=none + dd if=$< of=$@ bs=1 count=$(TINYBASIC_ROM_OFFSET) status=none; \ + dd if=$< of=$@ bs=1 skip=$$(( $(MONITOR_BASE) )) seek=$(MONITOR_ROM_OFFSET) count=$$payload_size conv=notrunc status=none; \ + dd if=$(TINYBASIC_BUILD)/tinybasic.bin of=$@ bs=1 seek=$(TINYBASIC_ROM_OFFSET) conv=notrunc status=none $(BUILDDIR)/metal/$(TARGET).bin: $(BUILDDIR)/metal/$(TARGET).flat.bin $(BUILDDIR)/metal/$(TARGET).prog.bin dd if=$< of=$@ bs=$(METAL_BIN_SIZE) count=1 status=none @@ -58,9 +64,30 @@ $(BUILDDIR)/metal/%.rel: %.c $(METAL_CC) $(METAL_FLAGS) $(METAL_CPPFLAGS) -o $@ -c $< $(BUILDDIR)/metal/%.rel: %.asm + @mkdir -p $(@D) + $(METAL_AS) -I$(BUILDDIR)/metal/generated -plosgff -o $@ $< + +$(BUILDDIR)/metal/boot.rel: $(BUILDDIR)/metal/generated/tinybasic.inc + +$(TINYBASIC_BUILD)/tinybasic.rel: $(TINYBASIC_SRC) @mkdir -p $(@D) $(METAL_AS) -plosgff -o $@ $< +$(TINYBASIC_BUILD)/tinybasic.ihx: $(TINYBASIC_BUILD)/tinybasic.rel + sdldz80 -n -i -m -j $(basename $@) $< + +$(TINYBASIC_BUILD)/tinybasic.flat.bin: $(TINYBASIC_BUILD)/tinybasic.ihx + $(METAL_MAKEBIN) -s $(METAL_IMAGE_SIZE) $< $@ + +$(TINYBASIC_BUILD)/tinybasic.bin: $(TINYBASIC_BUILD)/tinybasic.flat.bin + @tiny_size=$$(awk '$$1 == "TINYBASIC0" { print $$5 + 0 }' $(TINYBASIC_BUILD)/tinybasic.map); \ + test $$tiny_size -gt 0; \ + dd if=$< of=$@ bs=1 skip=$$(( $(TINYBASIC_BASE) )) count=$$tiny_size status=none + +$(BUILDDIR)/metal/generated/tinybasic.inc: $(TINYBASIC_BUILD)/tinybasic.ihx + @mkdir -p $(@D) + @awk '$$1 == "TINYBASIC0" { printf "TINYBASIC_SIZE = 0x%04X\n", $$5 }' $(TINYBASIC_BUILD)/tinybasic.map > $@ + clean: rm -rf $(BUILDDIR) diff --git a/README.md b/README.md index 1a4e992..d75fb11 100644 --- a/README.md +++ b/README.md @@ -1,12 +1,12 @@ # Z80 UART monitor -This ROM provides a small interactive monitor on the UART/CTC card at I/O base -`20`. At reset, a small ROM bootstrap copies the monitor into the top 16 KiB of -RAM at `C000-FFFF` and starts it there. Only the occupied vector/code bytes are -stored and copied; uninitialized data is cleared directly in high RAM. The low ROM can subsequently be disabled -without taking the monitor, its data, or its interrupt table away. Runtime code -and vectors occupy the lower part of this window, globals begin at `F000`, and -the stack grows downward from `FFFF`; no RAM below `C000` is used. +This ROM provides a small interactive monitor and a bundled Z80 Tiny BASIC +interpreter on the UART/CTC card at I/O base `20`. At reset, a small ROM +bootstrap copies both programs into the top 16 KiB of RAM and starts the +monitor. Only occupied code/vector bytes are stored and copied; uninitialized +data is cleared directly in high RAM. The low ROM can subsequently be disabled +without taking away the monitor, Tiny BASIC, monitor data, or interrupt table. +No runtime RAM below `C000` is used. Connect a terminal at **2400 baud, 8 data bits, no parity, 1 stop bit**. Commands are case-insensitive and all numeric arguments are hexadecimal; an @@ -20,6 +20,8 @@ optional `0x` prefix is accepted. | `I 20` | Read I/O port 20 | | `O 20 57` | Write 57 to I/O port 20 | | `G 8000` | Execute code at address 8000 | +| `G D000` | Start the bundled Z80 Tiny BASIC interpreter | +| `B` or `BASIC` | Shortcut for `G D000` | | `HELP` | Show the command summary | `G` transfers control with a return address on the stack, so code ending in @@ -32,13 +34,65 @@ Build the ROM and programmer-format images with: make ``` -The outputs are `build/metal/monitor.bin` (32 KiB ROM image) and -`build/metal/monitor.prog.bin` (compact programmer image). The ROM layout is: +The outputs are: + +- `build/metal/monitor.bin`: complete 32 KiB ROM image +- `build/metal/monitor.prog.bin`: compact image ending at the last occupied byte +- `build/tinybasic/tinybasic.bin`: standalone relocated Tiny BASIC payload + +The current compact image is 6,157 bytes. Its ROM layout is: - `0000-007F`: reset/copy bootstrap -- `0080...`: compact vector/code image copied to RAM starting at `C000` -- Remaining bytes: unused and available for additional ROM content +- `0080-0F6E`: monitor image copied to RAM at `C000-CEEE` +- `0F6F-0FFF`: unused space reserved for monitor growth +- `1000-180C`: Tiny BASIC image copied to RAM at `D000-D80C` +- `180D-7FFF`: unused space available for additional ROM content The monitor executable starts at `C080`; its IM 2 vector table is at `C040`. -`monitor.prog.bin` ends immediately after the occupied payload, while -`monitor.bin` remains a complete 32 KiB chip image. +The bootstrap obtains both copy lengths from generated/linker symbols, so the +copied sizes track changes to the programs automatically. + +The resulting high-RAM layout is: + +- `C000-CEEE`: monitor vectors, services, and code +- `CEEF-CFFF`: free +- `D000-D80C`: Tiny BASIC code +- `D80D-DFFF`: free +- `E000-E7FF`: Tiny BASIC workspace and BASIC program text +- `E800-E877`: Tiny BASIC variables and input buffer +- `E878-EFFF`: Tiny BASIC stack space +- `F000-FFFF`: monitor globals and monitor stack + +## Tiny BASIC + +The original GNU-z80asm listing is retained as `tinybasic/tinybasic.asm`. Its +`sdasz80` port is `tinybasic/tinybasic_sdas.asm` and is built automatically. +The port replaces fixed low-page `RST` calls with relocatable calls and uses a +marker-based command table so addresses in the `D000` page work correctly. + +At reset the bootstrap copies Tiny BASIC from ROM offset `1000` to `D000`. +Start it from the monitor with: + +```text +B +``` + +`BASIC` and `G D000` are equivalent alternatives. + +Tiny BASIC calls the monitor ABI at `C050` for output and `C053` for +non-blocking input. The assembly ABI wrappers preserve the working registers, +and Tiny BASIC keeps interrupts enabled so it can share the monitor's configured +interrupt-driven UART. + +Line editing accepts either `BS` (`08`) or `DEL` (`7F`) for backspace and emits +`BS SPACE BS` so ANSI-style terminals erase the character visually. Ctrl-U +clears the complete input line. + +During execution, Ctrl-O toggles output suppression without stopping the BASIC +program. Press Ctrl-O again to resume output. Ctrl-C stops execution and +returns to the Tiny BASIC prompt. + +Tiny BASIC resets the stack pointer when it starts, so it does not currently +return through the monitor's `G` call. Reset the machine to return to the +monitor. The first currently unused ROM byte is `180D`; `1900` is a convenient +aligned starting point for another ROM payload. diff --git a/boot.asm b/boot.asm index 5b9b665..2dd08e9 100644 --- a/boot.asm +++ b/boot.asm @@ -2,6 +2,10 @@ STACK_TOP = 0xFFFF DELAY_LOOPS_PER_MS = 40 MONITOR_BASE = 0xC000 MONITOR_ROM_SOURCE = 0x0080 +TINYBASIC_BASE = 0xD000 +TINYBASIC_ROM_SOURCE = 0x1000 + + .include "tinybasic.inc" .globl _main .globl _delay_ms @@ -10,6 +14,8 @@ MONITOR_ROM_SOURCE = 0x0080 .globl _enable_interrupts .globl _disable_interrupts .globl _jump_to + .globl _monitor_uart_putc + .globl _monitor_uart_getc .globl monitor_image_end .globl s__DATA .globl l__DATA @@ -29,6 +35,11 @@ boot_copy: ld de, #MONITOR_BASE ld bc, #(monitor_image_end - MONITOR_BASE) ldir + + ld hl, #TINYBASIC_ROM_SOURCE + ld de, #TINYBASIC_BASE + ld bc, #TINYBASIC_SIZE + ldir jp init .area _ITABLE (ABS) @@ -58,6 +69,13 @@ boot_copy: .dw ctc_isr ; CTC channel 2: vector 0x44 .dw uart_isr ; CTC channel 3: vector 0x46 +; Stable entry points for programs living alongside the monitor. +; C050: write the character in A. C053: return a character in A, or 0. +.org MONITOR_BASE + 0x50 + jp monitor_service_putc +.org MONITOR_BASE + 0x53 + jp monitor_service_getc + .area _HOME init: di @@ -110,6 +128,38 @@ monitor_image_end: .area _CODE +; Monitor ABI services preserve all working registers. PUTC also preserves AF; +; GETC returns the received byte (or zero) in A. +monitor_service_putc: + push af + push bc + push de + push hl + push ix + push iy + call _monitor_uart_putc + pop iy + pop ix + pop hl + pop de + pop bc + pop af + ret + +monitor_service_getc: + push bc + push de + push hl + push ix + push iy + call _monitor_uart_getc + pop iy + pop ix + pop hl + pop de + pop bc + ret + .macro MAKE_ISR entry, handler .globl handler entry: diff --git a/main.c b/main.c index 0313a4d..773c0a5 100644 --- a/main.c +++ b/main.c @@ -45,6 +45,23 @@ static void uart_putc(char c) uart_kick(); } +/* Stable monitor ABI implementations, reached through the jump table at C050. */ +void monitor_uart_putc(char c) +{ + uart_putc(c); +} + +uint8_t monitor_uart_getc(void) +{ + char c; + uint8_t received; + + disable_interrupts(); + received = buffer_dequeue(&rx_buf, &c); + enable_interrupts(); + return received ? (uint8_t)c : 0; +} + static void uart_puts(const char *s) { while (*s) uart_putc(*s++); @@ -182,6 +199,7 @@ static void print_help(void) " I|IN port Read an I/O port\r\n" " O|OUT port byte Write an I/O port\r\n" " G|GO address Execute code; RET returns here\r\n" + " B|BASIC Start Tiny BASIC at D000\r\n" " H|HELP|? Show this help\r\n"); } @@ -265,6 +283,16 @@ static void command_out(uint8_t argc, char **argv) uart_puts("OK\r\n"); } +static void execute_address(uint16_t address) +{ + uart_puts("Executing at "); + print_hex16(address); + uart_puts("...\r\n"); + uart_flush(); + jump_to(address); + uart_puts("Returned to monitor\r\n"); +} + static void command_go(uint8_t argc, char **argv) { uint16_t address; @@ -273,12 +301,16 @@ static void command_go(uint8_t argc, char **argv) uart_puts("Usage: G address\r\n"); return; } - uart_puts("Executing at "); - print_hex16(address); - uart_puts("...\r\n"); - uart_flush(); - jump_to(address); - uart_puts("Returned to monitor\r\n"); + execute_address(address); +} + +static void command_basic(uint8_t argc) +{ + if (argc != 1) { + uart_puts("Usage: B\r\n"); + return; + } + execute_address(0xd000); } static void execute_line(char *line) @@ -300,6 +332,8 @@ static void execute_line(char *line) command_out(argc, argv); } else if (strings_equal(argv[0], "g") || strings_equal(argv[0], "go")) { command_go(argc, argv); + } else if (strings_equal(argv[0], "b") || strings_equal(argv[0], "basic")) { + command_basic(argc); } else { uart_puts("Unknown command; type HELP\r\n"); } diff --git a/tinybasic_sdas.asm b/tinybasic_sdas.asm new file mode 100644 index 0000000..2c0c861 --- /dev/null +++ b/tinybasic_sdas.asm @@ -0,0 +1,1836 @@ +;************************************************************* +; +; TINY BASIC FOR ZILOG Z80 +; VERSION 2.0 +; BY LI-CHEN WANG +; +; MODIFIED AND TRANSLATED +; TO INTEL MNEMONICS +; BY ROGER RAUSKOLB +; 10 OCTOBER,1976 +; +; MODIFIED AND TRANSLATED +; TO ZILOG MNEMONICS +; BY DOUG GABBARD +; www.retrodepot.net +; +; RELEASED TO THE PUBLIC +; 10 OCTOBER,2017 +; YEAH, 41 YEARS LATER.... +; +; @COPYLEFT +; ALL WRONGS RESERVED +; +;************************************************************* +; This code is derived from the original 8080 Tiny Basic. +; It was first compiled in 8080 Mnemonics, then disassembled +; into Zilog Mnemonics. And then checked against the original +; to ensure accuracy. It was then partially enhanced with z80 +; specific code. And once done, it was then modified to work +; with the G80-S Micro Computer. However, that portion of the +; code has been left out in order to make this code a little +; more portable. There are only three routines that one needs +; to write, and specifing the serial port's I/O address, in +; order to make this version work with your own DIY computer. +; Those routines can be found at the end of the source code. +; +; I hope you find good use for this relic. However, I would +; ask that if you do find use for it, please put a reference +; to me in your work. And please, distribute freely. +;************************************************************* +; Notes for JTFrame version: +; Adapted to work with GNU z80asm +; Added interrupt handling +; Notes for this monitor port: +; Converted to sdasz80 syntax and relocated to D000. +; Fixed-page RST calls were converted to local CALLs. +; UART access uses the monitor ABI at C050/C053. + +; Monitor ABI jump table. These entry points remain stable across monitor builds. +MONITOR_PUTC = 0xC050 +MONITOR_GETC = 0xC053 + + +SPACE = 0x020 ; Space +TAB = 0x09 ; HORIZONTAL TAB +CTRLC = 0x03 ; Control "C" +CTRLG = 0x07 ; Control "G" +BKSP = 0x08 ; Back space +LF = 0x0A ; Line feed +CS = 0x0C ; Clear screen +CR = 0x0D ; Carriage return +CTRLO = 0x0F ; Control "O" +CTRLQ = 0x011 ; Control "Q" +CTRLR = 0x012 ; Control "R" +CTRLS = 0x013 ; Control "S" +CTRLU = 0x015 ; Control "U" +ESC = 0x01B ; Escape +DEL = 0x07F ; Delete + +; Adjust to fit RAM mapping +STACK = 0xEFFF ; Tiny BASIC stack grows down below monitor data +OCSW = 0xE000 ;SWITCH FOR OUTPUT +CURRNT = OCSW+1 ;POINTS FOR OUTPUT +STKGOS = OCSW+3 ;SAVES SP IN 'GOSUB' +VARNXT = OCSW+5 ;TEMP STORAGE +STKINP = OCSW+7 ;SAVES SP IN 'INPUT' +LOPVAR = OCSW+9 ;'FOR' LOOP SAVE AREA +LOPINC = OCSW+11 ;INCREMENT +LOPLMT = OCSW+13 ;LIMIT +LOPLN = OCSW+15 ;LINE NUMBER +LOPPT = OCSW+17 ;TEXT POINTER +RANPNT = OCSW+19 ;RANDOM NUMBER POINTER +TXTUNF = OCSW+21 ;->UNFILLED TEXT AREA +TXTBGN = OCSW+23 ;TEXT SAVE AREA BEGINS + +TXTEND = 0xE800 ;TEXT SAVE AREA ENDS +VARBGN = 0xE800 ;VARIABLE @(0) +BUFFER = 0xE837 ;55-byte variable area ends here +BUFEND = 0xE877 ;64-byte input buffer ends here +STKLMT = 0xE878 ;LOWEST ALLOWED STACK ADDRESS + + +;************************************************************* +; *** ZERO PAGE SUBROUTINES *** +; +; THE Z80 INSTRUCTION SET ALLOWS FOR 8 ROUTINES IN LOW MEMORY +; THAT MAY BE CALLED BY RST 0x00, 0x08, 0x10, 0x18, 0x20, 0x28, 0x30, +; AND 0x38. THIS IS A ONE BYTE INSTRUCTION, AND IS FUNCTIONALLY +; SIMILAR TO THE THREE BYTE INSTRUCTION 'CALL XXXX'. TINY BASIC +; WILL USE THE RST INSTRUCTION FOR THE 7 MOST FREQUENTLY USED +; SUBROUTINES. TWO OTHER SUBROUTINES (CRLF & TSTNUM) ARE ALSO +; IN THIS SECTION. THEY CAN BE REACHED WITH 'CALL'. +;************************************************************* + +.area TINYBASIC (ABS) + .org 0xD000 +main: +START: + LD SP,#STACK ;*** COLD START *** + LD A,#0x0FF + LD (OCSW),A ;OUTPUT ENABLED INITIALLY + JP INIT + +RST08: EX (SP),HL ;*** TSTC OR CALL RST08 *** + CALL RST28 ;IGNORE BLANKS AND + CP (HL) ;TEST CHARACTER + JP TC1 ;REST OF THIS IS AT TC1 + +CRLF: + LD A,#CR ;*** CRLF *** + +RST10: PUSH AF ;*** OUTC OR CALL RST10 *** + LD A,(OCSW) ;PRINT CHARACTER ONLY + OR A ;IF OCSW SWITCH IS ON + JP OUTC ;REST OF THIS AT OUTC + +RST18: CALL EXPR2 ;*** EXPR OR CALL RST18 *** + PUSH HL ;EVALUATE AN EXPRESSION + JP EXPR1 ;REST OF IT AT EXPR1 + .db 'W' + +RST20: LD A,H ;*** COMP OR CALL RST20 *** + CP D ;COMPARE HL WITH DE + RET NZ ;RETURN CORRECT C AND + LD A,L ;Z FLAGS + CP E ;BUT OLD A IS LOST + RET + .ascii "AN" + +SS1: +RST28: LD A,(DE) ;*** IGNBLK/CALL RST28 *** + CP #0x20 ;IGNORE BLANKS + RET NZ ;IN TEXT (WHERE DE->) + INC DE ;AND RETURN THE FIRST + JP SS1 ;NON-BLANK CHAR. IN A + +RST30: POP AF ;*** FINISH/CALL RST30 *** + CALL FIN ;CHECK END OF COMMAND + JP QWHAT ;PRINT "WHAT?" IF WRONG + .db 'G' + +RST38: CALL RST28 ;*** TSTV OR CALL RST38 *** + SUB #0x40 ;TEST VARIABLES + RET C ;C:NOT A VARIABLE + JR NZ,TV1 ;NOT "@" ARRAY + INC DE ;IT IS THE "@" ARRAY + CALL PARN ;@ SHOULD BE FOLLOWED + ADD HL,HL ;BY (EXPR) AS ITS INDEX + JR C,QHOW ;IS INDEX TOO BIG? + PUSH DE ;WILL IT OVERWRITE + EX DE,HL ;TEXT? + CALL SIZE ;FIND SIZE OF FREE + CALL RST20 ;AND CHECK THAT + JP C,ASORRY ;IF SO, SAY "SORRY" + LD HL,#VARBGN ;IF NOT GET ADDRESS + CALL SUBDE ;OF @(EXPR) AND PUT IT + POP DE ;IN HL + RET ;C FLAG IS CLEARED + +TV1: + CP #0x1B ;NOT @, IS IT A TO Z? + CCF ;IF NOT RETURN C FLAG + RET C + INC DE ;IF A THROUGH Z + LD HL,#VARBGN ;COMPUTE ADDRESS OF + RLCA ;THAT VARIABLE + ADD A,L ;AND RETURN IT IN HL + LD L,A ;WITH C FLAG CLEARED + LD A,#0x00 + ADC A,H + LD H,A + RET + +NMI66: ;MUST BE AT 0x66 + RETI + +TC1: + INC HL ;COMPARE THE BYTE THAT + JR Z,TC2 ;FOLLOWS THE RST INST. + PUSH BC ;WITH THE TEXT (DE->) + LD C,(HL) ;IF NOT =, ADD THE 2ND + LD B,#0x00 ;BYTE THAT FOLLOWS THE + ADD HL,BC ;RST TO THE OLD PC + POP BC ;I.E., DO A RELATIVE + DEC DE ;JUMP IF NOT = + +TC2: + INC DE ;IF =, SKIP THOSE BYTES + INC HL ;AND CONTINUE + EX (SP),HL + RET + +TSTNUM: + LD HL,#0x0000 ;*** TSTNUM *** + LD B,H ;TEST IF THE TEXT IS + CALL RST28 ;A NUMBER + +TN1: + CP #0x30 ;IF NOT, RETURN 0 IN + RET C ;B AND HL + CP #0x3A ;IF NUMBERS, CONVERT + RET NC ;TO BINARY IN HL AND + LD A,#0x0F0 ;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 #0x0F ;CODE + ADD A,L + LD L,A + LD A,#0x00 + 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_ROUTINE + + +HOW: .ascii "HOW?" + .db CR +OK: .ascii "OK" + .db CR +WHAT: .ascii "WHAT?" + .db CR +SORRY: .ascii "SORRY" + .db CR + +;************************************************************* +; +; *** MAIN *** +; +; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM +; AND STORES IT IN THE MEMORY. +; +; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE +; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS +; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO +; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER +; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) +; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE +; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF +; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED +; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. +; +; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM +; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE +; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE +; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT". +; +; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION +; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS +; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED +; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". +; +; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER +; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN +; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND +; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0. +;************************************************************* + +RSTART: + LD SP,#STACK + +ST1: + CALL CRLF ;AND JUMP TO HERE + LD DE,#OK ;DE->STRING + SUB A ;A=0 + CALL PRTSTG ;PRINT STRING UNTIL CR + LD HL,#ST2+1 ;LITERAL 0 + LD (CURRNT),HL ;CURRENT->LINE # = 0 + +ST2: + LD HL,#0x0000 + LD (LOPVAR),HL + LD (STKGOS),HL + +ST3: + LD A,#'>' ;PROMPT '>' AND + CALL GETLN ;READ A LINE + PUSH DE ;DE->END OF LINE + LD DE,#BUFFER ;DE->BEGINNING OF LINE + CALL TSTNUM ;TEST IF IT IS A NUMBER + CALL RST28 + LD A,H ;HL=VALUE OF THE # OR + OR L ;0 IF NO # WAS FOUND + POP BC ;BC->END OF LINE + JP Z,DIRECT + DEC DE ;BACKUP DE AND SAVE + LD A,H ;VALUE OF LINE # THERE + LD (DE),A + DEC DE + LD A,L + LD (DE),A + PUSH BC ;BC,DE->BEGIN, END + PUSH DE + LD A,C + SUB E + + PUSH AF ;A=# OF BYTES IN LINE + CALL FNDLN ;FIND THIS LINE IN SAVE + PUSH DE ;AREA, DE->SAVE AREA + JR NZ,ST4 ;NZ:NOT FOUND, INSERT + PUSH DE ;Z:FOUND, DELETE IT + CALL FNDNXT ;FIND NEXT LINE + ;DE->NEXT LINE + POP BC ;BC->LINE TO BE DELETED + LD HL,(TXTUNF) ;HL->UNFILLED SAVE AREA + CALL MVUP ;MOVE UP TO DELETE + LD H,B ;TXTUNF->UNFILLED ARA + LD L,C + LD (TXTUNF),HL ;UPDATE + +ST4: + POP BC ;GET READY TO INSERT + LD HL,(TXTUNF) ;BUT FIRST CHECK IF + POP AF ;THE LENGTH OF NEW LINE + PUSH HL ;IS 3 (LINE # AND CR) + CP #0x03 ;THEN DO NOT INSERT + JR Z,RSTART ;MUST CLEAR THE STACK + ADD A,L ;COMPUTE NEW TXTUNF + LD L,A + LD A,#0x00 + ADC A,H + LD H,A ;HL->NEW UNFILLED AREA + LD DE,#TXTEND ;CHECK TO SEE IF THERE + CALL RST20 ;IS ENOUGH SPACE + JP NC,QSORRY ;SORRY, NO ROOM FOR IT + LD (TXTUNF),HL ;OK, UPDATE TXTUNF + POP DE ;DE->OLD UNFILLED AREA + CALL MVDOWN + POP DE ;DE->BEGIN, HL->END + POP HL + CALL MVUP ;MOVE NEW LINE TO SAVE + JR ST3 ;AREA + +;************************************************************* +; +; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT +; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE +; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST +; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS +; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: +; +; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART' +; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE +; GO BACK TO 'RSTART'. +; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. +; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. +; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE +; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) +;************************************************************* +; +; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** +; +; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' +; +; 'STOP(CR)' GOES BACK TO 'RSTART' +; +; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN +; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE +; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. +; +; THERE ARE 3 MORE ENTRIES IN 'RUN': +; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. +; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. +; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. +; +; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET +; LINE, AND JUMP TO 'RUNTSL' TO DO IT. +;************************************************************* + +NEW: + CALL ENDCHK ;*** NEW(CR) *** + LD HL,#TXTBGN + LD (TXTUNF),HL +STOP: + CALL ENDCHK ;*** STOP(CR) *** + JP RSTART +RUN: + CALL ENDCHK ;*** RUN(CR) *** + LD DE,#TXTBGN ;FIRST SAVED LINE +RUNNXL: + LD HL,#0x00 ;*** RUNNXL *** + CALL FNDLP ;FIND WHATEVER LINE # + JP C,RSTART ;C:PASSED TXTUNF, QUIT +RUNTSL: + EX DE,HL ;*** RUNTSL *** + LD (CURRNT),HL ;SET 'CURRENT'->LINE # + EX DE,HL + INC DE ;BUMP PASS LINE # + INC DE +RUNSML: + CALL CHKIO ;*** RUNSML *** + LD HL,#TAB2-1 ;FIND COMMAND IN TAB2 + JP EXEC ;AND EXECUTE IT +GOTO: + CALL RST18 ;*** GOTO EXPR *** + PUSH DE ;SAVE FOR ERROR ROUTINE + CALL ENDCHK ;MUST FIND A CR + CALL FNDLN ;FIND THE TARGET LINE + JP NZ,AHOW ;NO SUCH LINE # + POP AF ;CLEAR THE PUSH DE + JR RUNTSL ;GO DO IT + +;************************************************************* +; +; *** LIST *** & PRINT *** +; +; LIST HAS TWO FORMS: +; 'LIST(CR)' LISTS ALL SAVED LINES +; 'LIST #(CR)' START LIST AT THIS LINE # +; YOU CAN STOP THE LISTING BY CONTROL C KEY +; +; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)' +; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK- +; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. +; +; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS +; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO +; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT +; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS +; SPECIFIED, 6 POSITIONS WILL BE USED. +; +; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF +; DOUBLE QUOTES. +; +; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) +; +; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN +; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST +; ENDED WITH A COMMA, NO (CRLF) IS GENERATED. +;************************************************************* + +LIST: + CALL TSTNUM ;TEST IF THERE IS A # + CALL ENDCHK ;IF NO # WE GET A 0 + CALL FNDLN ;FIND THIS OR NEXT LINE +LS1: + JP C,RSTART ;C:PASSED TXTUNF + CALL PRTLN ;PRINT THE LINE + CALL CHKIO ;STOP IF HIT CONTROL-C + CALL FNDLP ;FIND NEXT LINE + JR LS1 ;AND LOOP BACK +PRINT: + LD C,#0x06 ;C = # OF SPACES + CALL RST08 ;F NULL LIST & ";" + .db 0x3B + .db PR2-.-1 + CALL CRLF ;GIVE CR-LF AND + JR RUNSML ;CONTINUE SAME LINE +PR2: + CALL RST08 ;IF NULL LIST (CR) + .db CR + .db PR0-.-1 + CALL CRLF ;ALSO GIVE CR-LF AND + JR RUNNXL ;GO TO NEXT LINE +PR0: + CALL RST08 ;ELSE IS IT FORMAT? + .db '#' + .db PR1-.-1 + CALL RST18 ;YES, EVALUATE EXPR. + LD C,L ;AND SAVE IT IN C + JR PR3 ;LOOK FOR MORE TO PRINT +PR1: + CALL QTSTG ;OR IS IT A STRING? + JR PR8 ;IF NOT, MUST BE EXPR. +PR3: + CALL RST08 ;IF ",", GO FIND NEXT + .db ',' + .db PR6-.-1 + CALL FIN ;IN THE LIST. + JR PR0 ;LIST CONTINUES +PR6: + CALL CRLF ;LIST ENDS + CALL RST30 +PR8: + CALL RST18 ;EVALUATE THE EXPR + PUSH BC + CALL PRTNUM ;PRINT THE VALUE + POP BC + JR PR3 ;MORE TO PRINT? + +;************************************************************* +; +; *** GOSUB *** & RETURN *** +; +; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' +; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER +; ETC. ARE SAVE 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 THE CODE), +; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S. +; +; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS +; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT +; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE +; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR. +;************************************************************* + +GOSUB: + CALL PUSHA ;SAVE THE CURRENT "FOR" + CALL RST18 ;PARAMETERS + PUSH DE ;AND TEXT POINTER + CALL FNDLN ;FIND THE TARGET LINE + JP NZ,AHOW ;NOT THERE. SAY "HOW?" + LD HL,(CURRNT) ;FOUND IT, SAVE OLD. + PUSH HL ;'CURRNT' OLD 'STKGOS' + LD HL,(STKGOS) + PUSH HL + LD HL,#0x0000 ;AND LOAD NEW ONES + LD (LOPVAR),HL + ADD HL,SP + LD (STKGOS),HL + JP RUNTSL ;THEN RUN THAT LINE +RETURN: + CALL ENDCHK ;THERE MUST BE A CR + LD HL,(STKGOS) ;OLD STACK POINTER + LD A,H ;0 MEANS NOT EXIST + OR L + JP Z,QWHAT ;SO, WE SAY: "WHAT?" + LD SP,HL ;ELSE, RESTORE IT + POP HL + LD (STKGOS),HL ;AND THE OLD "STKGOS" + POP HL + LD (CURRNT),HL ;AND THE OLD 'CURRNT' + POP DE ;OLD TEXT POINTER + CALL POPA ;OLD "FOR" PARAMETERS + CALL RST30 ;AND WE ARE BACK HOME + +;************************************************************* +; +; *** 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 SAVE 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 SOME- +; THING IN THE SAVE AREA (THIS IS 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 NECESSARILLY 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 CHECK THE RESULT WITH THE LIMIT. IF IT +; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND +; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA +; IS PURGED AND EXECUTION CONTINUES. +;************************************************************* + +FOR: + CALL PUSHA ;SAVE THE OLD SAVE AREA + CALL SETVAL ;SET THE CONTROL VAR. + DEC HL ;HL IS ITS ADDRESS + LD (LOPVAR),HL ;SAVE THAT + LD HL,#TAB5-1 ;USE 'EXEC' TO LOOK + JP EXEC ;FOR THE WORK 'TO' +FR1: + CALL RST18 ;EVALUATE THE LIMITE + LD (LOPLMT),HL ;SAVE THAT + LD HL,#TAB6-1 ;USE 'EXEC' TO LOOK + JP EXEC ;FOR THE WORD 'STEP' +FR2: + CALL RST18 ;FOUND IT, GET STEP + JR FR4 +FR3: + LD HL,#0x0001 ;NOT FOUND, SET TO 1 +FR4: + LD (LOPINC),HL ;SAVE THAT TOO +FR5: + LD HL,(CURRNT) ;SAVE CURRENT LINE # + LD (LOPLN),HL + EX DE,HL ;AND TEXT POINTER + LD (LOPPT),HL + LD BC,#0x0A ;DIG INTO STACK TO + LD HL,(LOPVAR) ;FIND 'LOPVAR' + EX DE,HL + LD H,B + LD L,B ;HL=0 NOW + ADD HL,SP ;HERE IS THE STACK + .db 0x3E ;DISASSEMBLY SAID "ld a,09h" +FR7: + ADD HL,BC ;EACH LEVEL IS 10 DEEP - DIS = 09 + LD A,(HL) ;GET THAT OLD 'LOPVAR' + INC HL + OR (HL) + JR Z,FR8 ;0 SAYS NO MORE IN IT + LD A,(HL) + DEC HL + CP D ;SAME AS THIS ONE? + JR NZ,FR7 + LD A,(HL) ;THE OTHER HALF? + CP E + JR NZ,FR7 + EX DE,HL ;YES, FOUND ONE + LD HL,#0x0000 + ADD HL,SP ;TRY TO MOVE SP + LD B,H + LD C,L + LD HL,#0x000A + ADD HL,DE + CALL MVDOWN ;AND PURGE 10 WORDS + LD SP,HL ;IN THE STACK +FR8: + LD HL,(LOPPT) ;JOB DONE, RESTORE DE + EX DE,HL + CALL RST30 ;AND CONTINUE +; +NEXT: + CALL RST38 ;GET ADDRESS OF VAR. + JP C,QWHAT ;NO VARIABLE, "WHAT?" + LD (VARNXT),HL ;YES, SAVE IT +NX0: + PUSH DE ;SAVE TEXT POINTER + EX DE,HL + LD HL,(LOPVAR) ;GET VAR. IN 'FOR' + LD A,H + OR L ;0 SAYS NEVER HAD ONE + JP Z,AWHAT ;SO WE ASK: "WHAT?" + CALL RST20 ;ELSE WE CHECK THEM + JR Z,NX3 ;OK, THEY AGREE + POP DE ;NO, LET'S SEE + CALL POPA ;PURGE CURRENT LOOP + LD HL,(VARNXT) ;AND POP ONE LEVEL + JR NX0 ;GO CHECK AGAIN +NX3: + LD E,(HL) ;COME HERE WHEN AGREED + INC HL + LD D,(HL) ;DE=VALUE OF VAR. + LD HL,(LOPINC) + PUSH HL + LD A,H + XOR D + LD A,D + ADD HL,DE ;ADD ONE STEP + JP M,NX4 + XOR H + JP M,NX5 +NX4: + EX DE,HL + LD HL,(LOPVAR) ;PUT IT BACK + LD (HL),E + INC HL + LD (HL),D + LD HL,(LOPLMT) ;HL->LIMIT + POP AF ;OLD HL + OR A + JP P,NX1 ;STEP > 0 + EX DE,HL ;STEP < 0 +NX1: + CALL CKHLDE ;COMPARE WITH LIMIT + POP DE ;RESTORE TEXT POINTER + JR C,NX2 ;OUTSIDE LIMIT + LD HL,(LOPLN) ;WITHIN LIMIT, GO + LD (CURRNT),HL ;BACK TO THE SAVED + LD HL,(LOPPT) ;'CURRNT' AND TEXT + EX DE,HL ;POINTER + CALL RST30 +NX5: + POP HL + POP DE +NX2: + CALL POPA ;PURGE THIS LOOP + CALL RST30 + +;************************************************************* +; +; *** REM *** IF *** INPUT *** & LET (& DEFLT) *** +; +; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. +; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. +; +; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE +; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED 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 FOLLOWS 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 SINGLE OR +; DOUBLE QUOTES, OR IS A BACK-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 SET THE VARIABLE TO THE VALUE OF THE EXPR. +; +; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", +; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. +; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. +; THIS IS HANDLED IN 'INPERR'. +; +; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. +; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. +; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. +; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. +; THIS IS DONE BY 'DEFLT'. +;************************************************************* + +REM: + LD HL,#0x0000 ;*** REM *** + .db 0x3E ;THIS IS LIKE 'IF 0' +IFF: + CALL RST18 ;*** IF *** + LD A,H ;IS THE EXPR.=0? + OR L + JP NZ,RUNSML ;NO, CONTINUE + CALL FNDSKP ;YES, SKIP REST OF LINE + JP NC,RUNTSL ;AND RUN THE NEXT LINE + JP RSTART ;IF NO NEXT, RE-START +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 +INPUT: ;*** INPUT *** +IP1: + PUSH DE ;SAVE IN CASE OF ERROR + CALL QTSTG ;IS NEXT ITEM A STRING? + JR IP2 ;NO + CALL RST38 ;YES, BUT FOLLOWED BY A + JR C,IP4 ;VARIABLE? NO. + JR IP3 ;YES. INPUT VARIABLE +IP2: + PUSH DE ;SAVE FOR 'PRTSTG' + CALL RST38 ;MUST BE VARIABLE NOW + JP C,QWHAT ;"WHAT?" IT IS NOT? + LD A,(DE) ;GET READY FOR 'PRTSTR' + LD C,A + SUB A + LD (DE),A + POP DE + CALL PRTSTG ;PRINT STRING AS PROMPT + LD A,C ;RESTORE TEXT + DEC DE + LD (DE),A +IP3: + PUSH DE ;SAVE TEXT POINTER + 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,#0x0000 ;SAVE SP TOO + ADD HL,SP + LD (STKINP),HL + PUSH DE ;OLD HL + LD A,#0x3A ;PRINT THIS TOO + CALL GETLN ;AND GET A LINE + LD DE,#BUFFER ;POINTS TO BUFFER + CALL RST18 ;EVALUATE INPUT + NOP ;CAN BE 'CALL ENDCHK' + NOP + NOP + POP DE ;OK,GET OLD HL + EX DE,HL + LD (HL),E ;SAVE VALUE IN VAR. + INC HL + LD (HL),D + POP HL ;GET OLD 'CURRNT' + LD (CURRNT),HL + POP DE ;AND OLD TEXT POINTER +IP4: + POP AF ;PURGE JUNK IN STACK + CALL RST08 ;IS NEXT CH. ','? + .db ',' + .db IP5-.-1 + JR IP1 ;YES, MORE ITEMS. +IP5: + CALL RST30 +DEFLT: + LD A,(DE) ;*** DEFLT *** + CP #CR ;EMPTY LINE IS OK + JR Z,LT1 ;ELSE IT IS 'LET' +LET: + CALL SETVAL ;*** LET *** + CALL RST08 ;SET VALUE TO VAR + .db ',' ;---DISASSEMBLE = INC L + .db LT1-.-1 ;---DISASSEMBLE = INC BC + JR LET ;ITEM BY ITEM +LT1: + CALL RST30 ;UNTIL FINISH +;************************************************************* +; +; *** EXPR *** +; +; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. +; :: +; +; WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE +; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. +; ::=(+ OR -)(+ OR -)(....) +; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. +; ::=(* OR />)(....) +; ::= +; +; () +; IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN +; AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND +; CAN BE AN IN PARANTHESE. +;************************************************************* + +EXPR1: + LD HL,#TAB8-1 ;LOOKUP REL.OP. + JP EXEC ;GO DO IT +XP11: + CALL XP18 ;REL.OP.">=" + RET C ;NO, RETURN HL=0 + LD L,A ;YES, RETURN HL=1 + RET +XP12: + CALL XP18 ;REL.OP."#" + RET Z ;FALSE, RETURN HL=0 + LD L,A ;TRUE, RETURN HL=1 + RET +XP13: + CALL XP18 ;REL.OP.">" + RET Z ;FALSE + RET C ;ALSO FALSE, HL=0 + LD L,A ;TRUE, HL=1 + RET +XP14: + CALL XP18 ;REL.OP."<=" + LD L,A ;SET HL=1 + RET Z ;REL. TRUE, RETURN + RET C + LD L,H ;ELSE SET HL=0 + RET +XP15: + CALL XP18 ;REL.OP."=" + RET NZ ;FALSE, RETURN HL=0 + LD L,A ;ELSE SET HL=1 + RET +XP16: + CALL XP18 ;REL.OP."<" + RET NC ;FALSE, RETURN HL=0 + LD L,A ;ELSE SET HL=1 + RET +XP17: + POP HL ;NOT .REL.OP + RET ;RETURN HL= +XP18: + 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 EXPR2 ;GET 2ND + EX DE,HL ;VALUE IN DE NOW + EX (SP),HL ;1ST IN HL + CALL CKHLDE ;COMPARE 1ST WITH 2ND + POP DE ;RESTORE TEXT POINTER + LD HL,#0x0000 ;SET HL=0, A=1 + LD A,#0x01 + RET +EXPR2: + CALL RST08 ;NEGATIVE SIGN? + .db '-' + .db XP21-.-1 + LD HL,#0x0000 ;YES, FAKE '0-' + JR XP26 ;TREAT LIKE SUBTRACT +XP21: + CALL RST08 ;POSITIVE SIGN? IGNORE + .db '+' + .db XP22-.-1 +XP22: + CALL EXPR3 ;1ST +XP23: + CALL RST08 ;ADD? + .db '+' + .db XP25-.-1 + PUSH HL ;YES, SAVE VALUE + CALL EXPR3 ;GET 2ND +XP24: + 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 TEXT POINTER + JP M,XP23 ;1ST AND 2ND SIGN DIFFER + XOR H ;1ST AND 2ND SIGN EQUAL + JP P,XP23 ;SO IS RESULT + JP QHOW ;ELSE WE HAVE OVERFLOW +XP25: + CALL RST08 ;SUBTRACT? + .db '-' + .db XP42-.-1 +XP26: + PUSH HL ;YES, SAVE 1ST + CALL EXPR3 ;GET 2ND + CALL CHGSGN ;NEGATE + JR XP24 ;AND ADD THEM +; +EXPR3: + CALL EXPR4 ;GET 1ST +XP31: + CALL RST08 ;MULTIPLY? + .db '*' + .db XP34-.-1 + PUSH HL ;YES, SAVE 1ST + CALL EXPR4 ;AND GET 2ND + LD B,#0x00 ;CLEAR B FOR SIGN + CALL CHKSGN ;CHECK SIGN + EX (SP),HL ;1ST IN HL + CALL CHKSGN ;CHECK SIGN OF 1ST + EX DE,HL + EX (SP),HL + LD A,H ;IS HL > 255 ? + OR A + JR Z,XP32 ;NO + LD A,D ;YES, HOW ABOUT DE + OR D + EX DE,HL ;PUT SMALLER IN HL + JP NZ,AHOW ;ALSO >, WILL OVERFLOW +XP32: + LD A,L ;THIS IS DUMB + LD HL,#0x0000 ;CLEAR RESULT + OR A ;ADD AND COUNT + JR Z,XP35 +XP33: + ADD HL,DE + JP C,AHOW ;OVERFLOW + DEC A + JR NZ,XP33 + JR XP35 ;FINISHED +XP34: + CALL RST08 ;DIVIDE? + .db '/' + .db XP42-.-1 + PUSH HL ;YES, SAVE 1ST + CALL EXPR4 ;AND GET THE SECOND ONE + LD B,#0x00 ;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 + LD H,B ;RESULT IN HL NOW + LD L,C + POP BC ;GET SIGN BACK +XP35: + POP DE ;AND TEXT POINTER + 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 XP31 ;LOOK FOR MORE TERMS +EXPR4: + LD HL,#TAB4-1 ;FIND FUNCTION IN TAB4 + JP EXEC ;AND GO DO IT +XP40: + CALL RST38 ;NO, NOT A FUNCTION + JR C,XP41 ;NOR A VARIABLE + LD A,(HL) ;VARIABLE + INC HL + LD H,(HL) ;VALUE IN HL + LD L,A + RET +XP41: + CALL TSTNUM ;OR IS IT A NUMBER + LD A,B ;# OF DIGIT + OR A + RET NZ ;OK +PARN: + CALL RST08 + .db '(' + .db XP43-.-1 + CALL RST18 ;"(EXPR)" + CALL RST08 + .db ')' + .db XP43-.-1 +XP42: + RET +XP43: + JP QWHAT ;ELSE SAY: "WHAT?" +RND: + CALL PARN ;*** RND(EXPR) *** + LD A,H ;EXPR MUST BE + + OR A + JP M,QHOW + OR L ;AND NON-ZERO + JP Z,QHOW + PUSH DE ;SAVE BOTH + PUSH HL + LD HL,(RANPNT) ;GET MEMORY AS RANDOM + LD DE,#LSTROM ;NUMBER + CALL RST20 + JR C,RA1 ;WRAP AROUND IF LAST + LD HL,#START +RA1: + LD E,(HL) + INC HL + LD D,(HL) + LD (RANPNT),HL + POP HL + EX DE,HL + PUSH BC + CALL DIVIDE ;RND (N)=MOD(M,N)+1 + POP BC + POP DE + INC HL + RET +ABS: + CALL PARN ;*** ABS (EXPR) *** + DEC DE + CALL CHKSGN ;CHECK SIGN + INC DE + RET +SIZE: + LD HL,(TXTUNF) ;*** SIZE *** + PUSH DE ;GET THE NUMBER OF FREE + EX DE,HL ;BYTES BETWEEN 'TXTUNF' + LD HL,#VARBGN ;AND 'VARBGN' + CALL SUBDE + POP DE + RET +;************************************************************* +; +; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** +; +; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL +; +; 'SUBDE' SUBSTRACTS DE FROM HL +; +; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE +; SIGN AND FLIP SIGN OF B. +; +; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY. +; +; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE +; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER +; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. +;************************************************************* + +DIVIDE: + PUSH HL ;*** DIVIDE *** + LD L,H ;DIVIDE H BY DE + LD H,#0x00 + CALL DV1 + LD B,C ;SAVE RESULT IN B + LD A,L ;(REMAINDER+L)/DE + POP HL + LD H,A +DV1: + LD C,#0x0FF ;RESULT IN C +DV2: + INC C ;DUMB ROUTINE + CALL SUBDE ;DIVIDE BY SUBTRACT + JR NC,DV2 ;AND COUNT + ADD HL,DE + RET +SUBDE: + LD A,L ;*** SUBDE *** + SUB E ;SUBSTRACT DE FROM + LD L,A ;HL + LD A,H + SBC A,D + LD H,A + RET +CHKSGN: + LD A,H ;*** CHKSGN *** + OR A ;CHECK SIGN OF HL + RET P +CHGSGN: + LD A,H ;*** CHGSGN *** + PUSH AF + CPL ;CHANGE SIGN OF HL + LD H,A + LD A,L + CPL + LD L,A + INC HL + POP AF + XOR H + JP P,QHOW + LD A,B ;AND ALSO FLIP B + XOR #0x80 + LD B,A + RET +CKHLDE: + LD A,H ;SAME SIGN? + XOR D ;YES, COMPARE + JP P,CK1 ;NO, XCHANGE AND COMP + EX DE,HL +CK1: + CALL RST20 + RET +;************************************************************* +; +; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** +; +; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND +; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET 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 CONTINUE FROM THERE. +; +; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS +; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) +; +; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). +; IT THEN PRINTS THE LINE POINTED BY '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 POINTER IN STACK AND GET MESSAGE "WHAT?" +; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'. +; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. +; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS. +;************************************************************* + +SETVAL: + CALL RST38 ;*** SETVAL *** + JP C,QWHAT ;"WHAT?" NO VARIABLE + PUSH HL ;SAVE ADDRESS OF VAR. + CALL RST08 ;PASS "=" SIGN + .db '=' + .db SV1-.-1 + CALL RST18 ;EVALUATE EXPR. + LD B,H ;VALUE IS IN BC NOW + LD C,L + POP HL ;GET ADDRESS + LD (HL),C ;SAVE VALUE + INC HL + LD (HL),B + RET +SV1: + JP QWHAT ;NO "=" SIGN +FIN: + CALL RST08 ;*** FIN *** + .db 0x3B + .db FI1-.-1 + POP AF ;";", PURGE RET. ADDR. + JP RUNSML ;CONTINUE SAME LINE +FI1: + CALL RST08 ;NOT ";", IS IT CR? + .db CR + .db FI2-.-1 + POP AF ;YES, PURGE RET. ADDR. + JP RUNNXL ;RUN NEXT LINE +FI2: + RET ;ELSE RETURN TO CALLER +ENDCHK: + CALL RST28 ;*** ENDCHK *** + CP #CR ;END WITH CR? + RET Z ;OK, ELSE SAY: "WHAT?" +QWHAT: + PUSH DE ;*** QWHAT *** +AWHAT: + LD DE,#WHAT ;*** AWHAT *** +ERROR_ROUTINE: + SUB A ;*** ERROR *** + CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' + POP DE ;OR 'SORRY' + LD A,(DE) ;SAVE THE CHARACTER + PUSH AF ;AT WHERE OLD DE -> + SUB A ;AND PUT A 0 THERE + LD (DE),A + LD HL,(CURRNT) ;GET CURRENT LINE # + PUSH HL + LD A,(HL) ;CHECK THE VALUE + INC HL + OR (HL) + POP DE + JP Z,RSTART ;IF ZERO, JUST RESTART + LD A,(HL) ;IF NEGATIVE, + OR A + JP M,INPERR ;REDO INPUT + CALL PRTLN ;ELSE PRINT THE LINE + DEC DE ;UPTO WHERE THE 0 IS + POP AF ;RESTORE THE CHARACTER + LD (DE),A + LD A,#0x3F ;PRINT A "?" + CALL RST10 + SUB A ;AND THE REST OF THE + CALL PRTSTG ;LINE + JP RSTART ;THEN RESTART +QSORRY: + PUSH DE ;*** QSORRY *** +ASORRY: + LD DE,#SORRY ;*** ASORRY *** + JR ERROR_ROUTINE +;************************************************************* +; +; *** GETLN *** FNDLN (& FRIENDS) *** +; +; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT +; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS +; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL +; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE +; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO +; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. +; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN. +; +; '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. +; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #. +; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH. +; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH. +;************************************************************* + +GETLN: + CALL RST10 ;*** GETLN *** + LD DE,#BUFFER ;PROMPT AND INIT. +GL1: + ;-- Z80-FPGA: Testing! + CALL CHKIO ;CHECK KEYBOARD + JR Z,GL1 ;NO INPUT, WAIT + CP #DEL ;DELETE LAST CHARACTER? + JR Z,GL3 ;YES + CP #BKSP ;SOME TERMINALS SEND BS + JR Z,GL3 + CP #CTRLU ;DELETE THE WHOLE LINE? + JR Z,GL4 + CALL RST10 ;INPUT, ECHO BACK + CP #0x0A ;IGNORE LF + JR Z,GL1 + OR A ;IGNORE NULL + JR Z,GL1 + LD (DE),A ;ELSE SAVE INPUT + INC DE ;AND BUMP POINTER + CP #0x0D ;WAS IT CR + RET Z ;YES, END OF LINE + LD A,E ;ELSE MORE FREE ROOM? + CP #BUFEND & 0x0FF + JR NZ,GL1 ;YES, GET NEXT INPUT +GL3: + LD A,E ;DELETE LAST CHARACTER + CP #BUFFER & 0x0FF ;BUT DO WE HAVE ANY? + JR Z,GL1 ;NO, IGNORE IT + DEC DE ;YES, BACKUP POINTER + LD A,#BKSP ;VISUALLY ERASE IT + CALL RST10 + LD A,#SPACE + CALL RST10 + LD A,#BKSP + CALL RST10 + JR GL1 ;GO GET NEXT INPUT +GL4: + CALL CRLF ;REDO ENTIRE LINE + LD A,#0x05E ;CR, LF AND UP-ARROW + JR GETLN +FNDLN: + LD A,H ;*** FNDLN *** + OR A ;CHECK SIGN OF HL + JP M,QHOW ;IT CANNOT BE - + LD DE,#TXTBGN ;INIT TEXT POINTER +FNDLP: ;*** FDLNP *** +FL1: + PUSH HL ;SAVE LINE # + LD HL,(TXTUNF) ;CHECK IF WE PASSED END + DEC HL + CALL RST20 + POP HL ;GET LINE # BACK + RET C ;C,NZ PASSED END + LD A,(DE) ;WE DID NOT, GET BYTE 1 + SUB L ;IS THIS THE LINE? + LD B,A ;COMPARE LOW ORDER + INC DE + LD A,(DE) ;GET BYTE 2 + SBC A,H ;COMPARE HIGH ORDER + JR C,FL2 ;NO, NOT THERE YET + DEC DE ;ELSE WE EITHER FOUND + OR B ;IT, OR IT IS NOT THERE + RET ;NC,Z;FOUND, NC,NZ:NO +FNDNXT: ;*** FNDNXT *** + INC DE ;FIND NEXT LINE +FL2: + INC DE ;JUST PASSED BYTE 1 & 2 +FNDSKP: + LD A,(DE) ;*** FNDSKP *** + CP #CR ;TRY TO FIND CR + JR NZ,FL2 ;KEEP LOOKING + INC DE ;FOUND CR, SKIP OVER + JR FL1 ;CHECK IF END OF TEXT +;************************************************************* +; +; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN *** +; +; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING +; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN +; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE +; CALLER). OLD A IS STORED IN B, OLD B IS LOST. +; +; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE +; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW, +; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT +; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. +; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED +; OVER (USUALLY A JUMP INSTRUCTION. +; +; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED +; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. +; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN +; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO +; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT. +; +; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL. +;************************************************************* + +PRTSTG: + LD B,A ;*** PRTSTG *** +PS1: + LD A,(DE) ;GET A CHARACTER + INC DE ;BUMP POINTER + CP B ;SAME AS OLD A? + RET Z ;YES, RETURN + CALL RST10 ;NO, NEXT + CP #CR ;WAS IT A CR? + JR NZ,PS1 ;NO, NEXT + RET ;YES, RETURN +QTSTG: + CALL RST08 ;*** QTSTG *** + .db '"' + .db QT3-.-1 + LD A,#0x22 ;IT IS A " +QT1: + CALL PRTSTG ;PRINT UNTIL ANOTHER + CP #CR ;WAS LAST ONE A CR? + POP HL ;RETURN ADDRESS + JP Z,RUNNXL ;WAS CR, RUN NEXT LINE +QT2: + INC HL ;SKIP 3 BYTES ON RETURN + INC HL + INC HL + JP (HL) ;RETURN +QT3: + CALL RST08 ;IS IT A '? + .db 0x27 + .db QT4-.-1 + LD A,#0x27 ;YES, DO THE SAME + JR QT1 ;AS IN "" +QT4: + CALL RST08 ;IS IT BACK-ARROW? + .db 0x5F + .db QT5-.-1 + LD A,#0x8D ;YES, CR WITHOUT LF + CALL RST10 ;DO IT TWICE TO GIVE + CALL RST10 ;TTY ENOUGH TIME + POP HL ;RETURN ADDRESS + JR QT2 +QT5: + RET ;NONE OF ABOVE +; +PRTNUM: + LD B,#0x00 ;*** PRTNUM *** + CALL CHKSGN ;CHECK SIGN + JP P,PN1 ;NO SIGN + LD B,#'-' ;B=SIGN + DEC C ;'-' TAKES SPACE +PN1: + PUSH DE ;SAVE + LD DE,#0x000A ;DECIMAL + PUSH DE ;SAVE AS FLAG + DEC C ;C=SPACES + PUSH BC ;SAVE SIGN & SPACE +PN2: + CALL DIVIDE ;DIVIDE HL BY 10 + LD A,B ;RESULT 0? + OR C + JR Z,PN3 ;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 PN2 ;AND DIVIDE BY 10 +PN3: + POP BC ;WE GOT ALL DIGITS IN +PN4: + DEC C ;THE STACK + LD A,C ;LOOK AT SPACE COUNT + OR A + JP M,PN5 ;NO LEADING BLANKS + LD A,#0x20 ;LEADING BLANKS + CALL RST10 + JR PN4 ;MORE? +PN5: + LD A,B ;PRINT SIGN + OR A + CALL NZ,0x0010 + LD E,L ;LAST REMAINDER IN E +PN6: + LD A,E ;CHECK DIGIT IN E + CP #0x0A ;10 IS FLAG FOR NO MORE + POP DE + RET Z ;IF SO, RETURN + ADD A,#0x30 ;ELSE, CONVERT TO ASCII + CALL RST10 ;PRINT THE DIGIT + JR PN6 ;GO BACK FOR MORE +PRTLN: + LD A,(DE) ;*** PRTLN *** + LD L,A ;LOW ORDER LINE # + INC DE + LD A,(DE) ;HIGH ORDER + LD H,A + INC DE + LD C,#0x04 ;PRINT 4 DIGIT LINE # + CALL PRTNUM + LD A,#0x20 ;FOLLOWED BY A BLANK + CALL RST10 + SUB A ;AND THEN THE NEXT + CALL PRTSTG + RET +;************************************************************* +; +; *** MVUP *** MVDOWN *** POPA *** & 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 RST20 ;*** MVUP *** + RET Z ;DE = HL, RETURN + LD A,(DE) ;GET ONE BYTE + LD (BC),A ;MOVE IT + INC DE ;INCREASE BOTH POINTERS + INC BC + JR MVUP ;UNTIL DONE +MVDOWN: + LD A,B ;*** MVDOWN *** + SUB D ;TEST IF DE = BC + JP 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 + LD A,(DE) ;BOTH POINTERS AND + LD (HL),A ;THEN DO IT + JR MVDOWN ;LOOP BACK +POPA: + POP BC ;BC = RETURN ADDR. + POP HL ;RESTORE LOPVAR, BUT + LD (LOPVAR),HL ;=0 MEANS NO MORE + LD A,H + OR L + JR Z,PP1 ;YEP, GO RETURN + POP HL ;NOP, 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 *** + CALL CHGSGN + POP BC ;BC=RETURN ADDRESS + 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 +;************************************************************* +; +; *** OUTC *** & CHKIO *** +; +; THESE ARE THE ONLY I/O ROUTINES IN TBI. +; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0 +; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, +; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO +; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. +; ARE RESTORED. +; +; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO +; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG +; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE +; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND +; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL +; RESTART TBI AND DO NOT RETURN TO THE CALLER. +; +; Do not modify these routines. Routines requiring +; modification are : SERIAL_INIT, RX_RDY, and TX_RDY. +;************************************************************* + +INIT: + EI + CALL SERIAL_INIT ;INITIALIZE THE SIO + + + LD D,#0x19 +PATLOP: + CALL CRLF + DEC D + JR NZ,PATLOP + SUB A + LD DE,#MSG1 ;PRINT THE BOOT MESSAGES + CALL PRTSTG + LD DE,#MSG2 + CALL PRTSTG + LD HL,#START + LD (RANPNT),HL + LD HL,#TXTBGN + LD (TXTUNF),HL + JP RSTART +OUTC: + JR NZ,OUTC2 ;OUTPUT SWITCH IS ON + POP AF ;IT IS OFF + RET ;RESTORE AF AND RETURN +OUTC2: + CALL TX_RDY ;SEE IF TRANSMIT IS AVAILABLE + POP AF ;RESTORE THE REGISTER + CALL MONITOR_PUTC ;SEND THE BYTE THROUGH MONITOR UART + CP #CR + RET NZ + LD A,#LF + CALL RST10 + LD A,#CR + RET +CHKIO: + CALL RX_RDY ;CHECK IF CHARACTER AVAILABLE + RET Z ;RETURN IF NO CHARACTER AVAILABLE + + PUSH BC ;IF IT'S A LF, IGNORE AND RETURN + LD B,A ; AS IF THERE WAS NO CHARACTER. + SUB #LF + JR Z,CHKIO2 + LD A,B ;OTHERWISE RESTORE 'A' AND 'BC' + POP BC ; AND CONTINUE ON. + + CP #0x0F ;IS IT CONTROL-0? + JR NZ,CI1 ;NO, MORE CHECKING + LD A,(OCSW) ;CONTROL-0 FLIPS OCSW + CPL ;ON TO OFF, OFF TO ON + LD (OCSW),A + JR CHKIO ;GET ANOTHER INPUT +CHKIO2: + LD A,#0x00 ;CLEAR A + OR A ;ZET THE Z-FLAG + POP BC ;RESTORE THE 'BC' PAIR + RET ;RETURN WITH 'Z' SET. +CI1: + CP #0x03 ;IS IT CONTROL-C? + RET NZ ;NO, RETURN "NZ" + JP RSTART ;YES, RESTART TBI + + +MSG1: .db ESC + .ascii "[2J" + .db ESC + .ascii "[H" ;SCREEN CLEAR + .ascii "Z80 TINY BASIC 2.0g" + .db CR ;BOOT MESSAGE +MSG2: .ascii "PORTED BY DOUG GABBARD, 2017" + .db CR + +;************************************************************* +; +; *** TABLES *** DIRECT *** & EXEC *** +; +; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. +; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION +; OF CODE ACCORDING TO THE TABLE. +; +; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT +; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING. +; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF +; ALL DIRECT AND STATEMENT COMMANDS. +; +; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL +; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.', +; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'. +; +; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM +; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND +; A 0xFF MARKER FOLLOWED BY A LITTLE-endian jump address. +; +; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE +; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL +; MATCH THIS NULL ITEM AS DEFAULT. +;************************************************************* + +TAB1: ;DIRECT COMMANDS + .ascii "LIST" + .db 0xff + .dw LIST + .ascii "RUN" + .db 0xff + .dw RUN + .ascii "NEW" + .db 0xff + .dw NEW +TAB2: ;DIRECT/STATEMENT + .ascii "NEXT" + .db 0xff + .dw NEXT + .ascii "LET" + .db 0xff + .dw LET + .ascii "IF" + .db 0xff + .dw IFF + .ascii "GOTO" + .db 0xff + .dw GOTO + .ascii "GOSUB" + .db 0xff + .dw GOSUB + .ascii "RETURN" + .db 0xff + .dw RETURN + .ascii "REM" + .db 0xff + .dw REM + .ascii "FOR" + .db 0xff + .dw FOR + .ascii "INPUT" + .db 0xff + .dw INPUT + .ascii "PRINT" + .db 0xff + .dw PRINT + .ascii "STOP" + .db 0xff + .dw STOP + .db 0xff + .dw DEFLT +TAB4: ;FUNCTIONS + .ascii "RND" + .db 0xff + .dw RND + .ascii "ABS" + .db 0xff + .dw ABS + .ascii "SIZE" + .db 0xff + .dw SIZE + .db 0xff + .dw XP40 +TAB5: ;"TO" IN "FOR" + .ascii "TO" + .db 0xff + .dw FR1 + .db 0xff + .dw QWHAT +TAB6: ;"STEP" IN "FOR" + .ascii "STEP" + .db 0xff + .dw FR2 + .db 0xff + .dw FR3 +TAB8: ;RELATION OPERATORS + .ascii ">=" + .db 0xff + .dw XP11 + .db '#' + .db 0xff + .dw XP12 + .db '>' + .db 0xff + .dw XP13 + .db '=' + .db 0xff + .dw XP15 + .ascii "<=" + .db 0xff + .dw XP14 + .db '<' + .db 0xff + .dw XP16 + .db 0xff + .dw XP17 +DIRECT: LD HL,#TAB1-1 ;*** DIRECT *** +EXEC: ;*** EXEC *** +EX0: CALL RST28 ;IGNORE LEADING BLANKS + PUSH DE ;SAVE POINTER +EX1: + LD A,(DE) ;IF FOUND '.' IN STRING + INC DE ;BEFORE ANY MISMATCH + CP #'.' ;WE DECLARE A PARTIAL MATCH + JR Z,EX3 + INC HL ;HL->TABLE + CP (HL) ;IF MATCH, TEST NEXT + JR Z,EX1 + LD A,#0x7F ;ELSE SEE IF BIT 7 + DEC DE ;OF TABLE IS SET, WHICH + CP (HL) ;IS THE JUMP ADDR. (HI) + JR C,EX5 ;C:YES, MATCHED +EX2: + INC HL ;NC:NO, FIND JUMP ADDR. + CP (HL) + JR NC,EX2 + INC HL ;SKIP MARKER AND ADDRESS + INC HL + POP DE ;RESTORE STRING POINTER + JR EX0 ;TEST AGAINST NEXT ITEM +EX3: + LD A,#0x7F ;PARTIAL MATCH, FIND +EX4: + INC HL ;JUMP ADDR., WHICH IS + CP (HL) ;FLAGGED BY BIT 7 + JR NC,EX4 +EX5: + INC HL ;SKIP ADDRESS MARKER + LD A,(HL) ;LOAD HL WITH THE JUMP + INC HL ;ADDRESS FROM THE TABLE + LD H,(HL) + LD L,A + POP AF ;CLEAN UP THE GABAGE + JP (HL) ;AND WE GO DO IT +;------------------------------------------------------------------------------- +;/////////////////////////////////////////////////////////////////////////////// +;------------------------------------------------------------------------------- +;COMPUTER SPECIFIC ROUTINES. +;------------------------------------------------------------------------------- +SERIAL_INIT: + + ; This routine is for initializing your serial port. + + RET +;------------------------------------------------------------------------------- +TX_RDY: + ; This routine is checking if the Serial Port is ready to send + ; a character. + + RET + +;------------------------------------------------------------------------------- +RX_RDY: + + ; This routine is for checking if a character is available over + ; serial. If a character is available, it returns to the calling + ; function with the character in 'A' and the Z-flag reset. + ; However, if a character is not available, it returns with the + ; Z-flag set. + + CALL MONITOR_GETC + OR A + RET +;------------------------------------------------------------------------------- +;/////////////////////////////////////////////////////////////////////////////// +;------------------------------------------------------------------------------- + +LSTROM: ;ALL ABOVE CAN BE ROM