diff --git a/.gitignore b/.gitignore index c095e69..378eac2 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1 @@ build -__pycache__/ diff --git a/Makefile b/Makefile index c366c01..1e5ff47 100644 --- a/Makefile +++ b/Makefile @@ -1,157 +1,55 @@ -TARGET := monitor -BUILDDIR := build -LAYOUT_CONFIG := rom_layout.mk -LAYOUT_BUILD := $(BUILDDIR)/generated -LAYOUT_HEADER := $(LAYOUT_BUILD)/rom_layout.h -LAYOUT_INCLUDE := $(LAYOUT_BUILD)/rom_layout.inc +.SILENT: +include memory.mk -include $(LAYOUT_CONFIG) +ASM := zasm +ASMFLAGS := -w -b +BUILDDIR := build -METAL_C_SRCFILES := $(wildcard *.c) -METAL_ASM_SRCFILES := boot.asm -METAL_RELFILES := $(METAL_ASM_SRCFILES:%.asm=$(BUILDDIR)/metal/%.rel) \ - $(METAL_C_SRCFILES:%.c=$(BUILDDIR)/metal/%.rel) +FILES := bios -METAL_CC := sdcc -METAL_AS := sdasz80 -METAL_MAKEBIN := makebin -METAL_FLAGS := -mz80 --no-std-crt0 --code-loc $(RESIDENT_CODE_BASE) --code-size $(RESIDENT_CODE_SIZE) --data-loc $(RESIDENT_DATA_BASE) --opt-code-size -METAL_CPPFLAGS := -I src -I $(LAYOUT_BUILD) --disable-warning 283 -METAL_BIN_SIZE := $(ROM_SIZE) -METAL_RAM_SIZE := 16384 -METAL_IMAGE_SIZE := 65536 +SOURCES := $(addprefix ./, $(addsuffix .asm, $(FILES))) +TARGETS := $(addprefix $(BUILDDIR)/, $(addsuffix .bin, $(FILES))) -TINYBASIC_SRC := apps/tinybasic/tinybasic.asm -TINYBASIC_BUILD := $(BUILDDIR)/tinybasic -TAPE_LOADER_SRC := apps/casette/tape_loader.asm -TAPE_LOADER_BUILD := $(BUILDDIR)/casette -NASCOM_BASIC_SRC := apps/nascom_basic/basic.asm -NASCOM_BASIC_BUILD := $(BUILDDIR)/nascom_basic +TOPTARGETS := all clean size +$(TOPTARGETS): $(SUBDIRS) -.DEFAULT_GOAL := metal - -.PHONY: all metal clean - -all: metal - -metal: $(BUILDDIR)/metal/$(TARGET).ihx $(BUILDDIR)/metal/$(TARGET).bin $(BUILDDIR)/metal/$(TARGET).prog.bin - @stored=$$(wc -c < $(BUILDDIR)/metal/$(TARGET).prog.bin); \ - awk -v rom_capacity=$(METAL_BIN_SIZE) -v stored=$$stored -v ram_capacity=$(METAL_RAM_SIZE) '\ - $$1 ~ /^_(CODE|HOME|GSINIT|GSFINAL|INITIALIZER)$$/ || $$1 ~ /^_ITABLE/ { code += $$5 } \ - $$1 ~ /^_(DATA|INITIALIZED|BSEG|BSS|HEAP)$$/ { data += $$5 } \ - END { \ - printf "\nMemory usage:\n"; \ - printf " ROM storage: %5u / %5u bytes (%5.1f%%)\n", stored, rom_capacity, 100 * stored / rom_capacity; \ - printf " Resident BIOS+monitor: %5u bytes (%5u code/vector + %5u static data)\n", code + data, code, data; \ - }' $(BUILDDIR)/metal/$(TARGET).map - @printf " Tiny BASIC: %5u ROM bytes at %04X\n" \ - $$(wc -c < $(TINYBASIC_BUILD)/tinybasic.bin) \ - $$(( $(TINYBASIC_ROM_ADDRESS) )) - @printf " Tape loader: %5u ROM bytes at %04X\n" \ - $$(wc -c < $(TAPE_LOADER_BUILD)/tape_loader.bin) \ - $$(( $(TAPE_LOADER_ROM_ADDRESS) )) - @printf " NASCOM BASIC: %5u ROM bytes at %04X\n" \ - $$(wc -c < $(NASCOM_BASIC_BUILD)/nascom_basic.bin) \ - $$(( $(NASCOM_BASIC_ROM_ADDRESS) )) - -$(BUILDDIR)/metal/$(TARGET).ihx: $(METAL_RELFILES) - @mkdir -p $(@D) - $(METAL_CC) $(METAL_FLAGS) -o $@ $(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 $(TINYBASIC_BUILD)/tinybasic.bin $(TAPE_LOADER_BUILD)/tape_loader.bin $(NASCOM_BASIC_BUILD)/nascom_basic.bin - @set -e; \ - payload_end=$$(awk '$$1 == "DEF" && $$2 == "resident_image_end" { print $$3 }' $(BUILDDIR)/metal/$(TARGET).noi); \ - payload_size=$$((payload_end - $(RESIDENT_RAM_BASE))); \ - payload_rom_end=$$(( $(RESIDENT_ROM_OFFSET) + payload_size )); \ - tiny_size=$$(wc -c < $(TINYBASIC_BUILD)/tinybasic.bin); \ - tape_size=$$(wc -c < $(TAPE_LOADER_BUILD)/tape_loader.bin); \ - nascom_size=$$(wc -c < $(NASCOM_BASIC_BUILD)/nascom_basic.bin); \ - if test $$payload_size -le 0; then \ - echo "error: resident image is empty or has an invalid end symbol" >&2; exit 1; \ - fi; \ - if test $$payload_rom_end -gt $$(( $(TINYBASIC_ROM_ADDRESS) )); then \ - printf "error: resident ROM image ends at %04X, beyond Tiny BASIC origin %04X\n" \ - $$payload_rom_end $$(( $(TINYBASIC_ROM_ADDRESS) )) >&2; exit 1; \ - fi; \ - if test $$(( $(TINYBASIC_ROM_ADDRESS) + tiny_size )) -gt $$(( $(TAPE_LOADER_ROM_ADDRESS) )); then \ - printf "error: Tiny BASIC ends at %04X, beyond tape-loader origin %04X\n" \ - $$(( $(TINYBASIC_ROM_ADDRESS) + tiny_size )) $$(( $(TAPE_LOADER_ROM_ADDRESS) )) >&2; exit 1; \ - fi; \ - if test $$(( $(TAPE_LOADER_ROM_ADDRESS) + tape_size )) -gt $$(( $(NASCOM_BASIC_ROM_ADDRESS) )); then \ - printf "error: tape loader ends at %04X, beyond NASCOM BASIC origin %04X\n" \ - $$(( $(TAPE_LOADER_ROM_ADDRESS) + tape_size )) $$(( $(NASCOM_BASIC_ROM_ADDRESS) )) >&2; exit 1; \ - fi; \ - if test $$(( $(NASCOM_BASIC_ROM_ADDRESS) + nascom_size )) -gt $$(( $(ROM_SIZE) )); then \ - printf "error: NASCOM BASIC ends at %04X, beyond ROM size %04X\n" \ - $$(( $(NASCOM_BASIC_ROM_ADDRESS) + nascom_size )) $$(( $(ROM_SIZE) )) >&2; exit 1; \ - fi; \ - dd if=$< of=$@ bs=1 count=$$(( $(NASCOM_BASIC_ROM_ADDRESS) )) status=none; \ - dd if=$< of=$@ bs=1 skip=$$(( $(RESIDENT_RAM_BASE) )) seek=$$(( $(RESIDENT_ROM_OFFSET) )) count=$$payload_size conv=notrunc status=none; \ - dd if=$(TINYBASIC_BUILD)/tinybasic.bin of=$@ bs=1 seek=$$(( $(TINYBASIC_ROM_ADDRESS) )) conv=notrunc status=none; \ - dd if=$(TAPE_LOADER_BUILD)/tape_loader.bin of=$@ bs=1 seek=$$(( $(TAPE_LOADER_ROM_ADDRESS) )) conv=notrunc status=none; \ - dd if=$(NASCOM_BASIC_BUILD)/nascom_basic.bin of=$@ bs=1 seek=$$(( $(NASCOM_BASIC_ROM_ADDRESS) )) 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 - dd if=$(BUILDDIR)/metal/$(TARGET).prog.bin of=$@ conv=notrunc status=none - -$(BUILDDIR)/metal/%.rel: %.c $(LAYOUT_HEADER) - @mkdir -p $(@D) - $(METAL_CC) $(METAL_FLAGS) $(METAL_CPPFLAGS) -o $@ -c $< - -$(BUILDDIR)/metal/%.rel: %.asm $(LAYOUT_INCLUDE) - @mkdir -p $(@D) - $(METAL_AS) -Iinclude -I$(LAYOUT_BUILD) -plosgff -o $@ $< - -$(TINYBASIC_BUILD)/tinybasic.rel: $(TINYBASIC_SRC) $(LAYOUT_INCLUDE) - @mkdir -p $(@D) - $(METAL_AS) -Iinclude -I$(LAYOUT_BUILD) -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_ROM_ADDRESS) )) count=$$tiny_size status=none - -$(TAPE_LOADER_BUILD)/tape_loader.rel: $(TAPE_LOADER_SRC) $(LAYOUT_INCLUDE) - @mkdir -p $(@D) - $(METAL_AS) -Iinclude -I$(LAYOUT_BUILD) -plosgff -o $@ $< - -$(TAPE_LOADER_BUILD)/tape_loader.ihx: $(TAPE_LOADER_BUILD)/tape_loader.rel - sdldz80 -n -i -m -j $(basename $@) $< - -$(TAPE_LOADER_BUILD)/tape_loader.flat.bin: $(TAPE_LOADER_BUILD)/tape_loader.ihx - $(METAL_MAKEBIN) -s $(METAL_IMAGE_SIZE) $< $@ - -$(TAPE_LOADER_BUILD)/tape_loader.bin: $(TAPE_LOADER_BUILD)/tape_loader.flat.bin - @loader_size=$$(awk '$$1 == "TAPELOAD0" { print $$5 + 0 }' $(TAPE_LOADER_BUILD)/tape_loader.map); \ - test $$loader_size -gt 0; \ - dd if=$< of=$@ bs=1 skip=$$(( $(TAPE_LOADER_ROM_ADDRESS) )) count=$$loader_size status=none - -$(NASCOM_BASIC_BUILD)/nascom_basic.bin: $(NASCOM_BASIC_SRC) - @mkdir -p $(@D) - zasm --z80 $< -o $@ -l0 - -$(LAYOUT_HEADER): $(LAYOUT_CONFIG) - @mkdir -p $(@D) - @awk 'BEGIN { print "#ifndef ROM_LAYOUT_H"; print "#define ROM_LAYOUT_H"; print "" } \ - /^[A-Z][A-Z0-9_]*[[:space:]]*:=[[:space:]]*/ { print "#define " $$1 " " $$3 } \ - END { print ""; print "#endif" }' $< > $@ - -$(LAYOUT_INCLUDE): $(LAYOUT_CONFIG) - @mkdir -p $(@D) - @awk 'BEGIN { print "; Generated from rom_layout.mk; do not edit." } \ - /^[A-Z][A-Z0-9_]*[[:space:]]*:=[[:space:]]*/ { print $$1 " = " $$3 }' $< > $@ +all: $(BUILDDIR) $(BUILDDIR)/rom.bin size clean: rm -rf $(BUILDDIR) --include $(EMU_DEPFILES) +$(BUILDDIR): + mkdir -p $(BUILDDIR) + +$(BUILDDIR)/%.bin: ./%.asm $(BUILDDIR)/memory.inc + echo '>$<' + $(ASM) $(ASMFLAGS) $< $@ + +size: + @for file in $(TARGETS); do \ + if [ -f "$$file" ]; then \ + echo "$$file: $$(wc -c < "$$file") bytes"; \ + else \ + echo "$$file: Not built yet (run 'make')"; \ + fi \ + done + $(MAKE) -C apps/basic size --no-print-directory + +$(BUILDDIR)/basic.bin: + $(MAKE) -C apps/basic $(or $(MAKECMDGOALS),all) --no-print-directory + +$(BUILDDIR)/memory.inc: memory.mk + @mkdir -p $(@D) + @awk 'BEGIN { print "; Generated from rom_layout.mk; do not edit." } \ + /^[A-Z][A-Z0-9_]*[[:space:]]*:=[[:space:]]*/ { print $$1 " .equ " $$3 }' $< > $@ + +$(BUILDDIR)/rom.bin: $(BUILDDIR)/bios.bin $(BUILDDIR)/basic.bin + objcopy --pad-to=$$(($(BIOS_ROM_START)+$(BIOS_ROM_SIZE))) \ + -I binary $(BUILDDIR)/bios.bin -O binary $(BUILDDIR)/bios_padded.bin + objcopy --pad-to=$(BASIC_ROM_SIZE) \ + -I binary $(BUILDDIR)/basic.bin -O binary $(BUILDDIR)/basic_padded.bin + cat $(BUILDDIR)/bios_padded.bin $(BUILDDIR)/basic_padded.bin > $(BUILDDIR)/rom.bin + + +.PHONY: $(TOPTARGETS) $(SUBDIRS) + diff --git a/new/README b/README similarity index 100% rename from new/README rename to README diff --git a/README.md b/README.md deleted file mode 100644 index 2ea9f11..0000000 --- a/README.md +++ /dev/null @@ -1,214 +0,0 @@ -# Z80 UART monitor - -This project provides a resident BIOS, an interactive monitor, and ROM-resident -applications for a Z80 system with a UART/CTC card at I/O base `20`. - -At reset, a small ROM bootstrap copies only the BIOS and monitor into the top -16 KiB at `C000`. Before copying, it writes `06` to banking port `00`: ROM -remains enabled, banking is enabled, and `C000-FFFF` maps to the upper physical -16 KiB. The BIOS then initializes interrupt mode 2 and the UART and starts the -monitor. Applications remain in ROM and execute in place while calling the -stable BIOS jump table in high RAM. Tiny BASIC is linked at ROM address `1400`, -and the tape loader is linked at `3000`. - -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 -optional `0x` prefix is accepted. - -| Command | Action | -| --- | --- | -| `D 8000` | Dump 40 bytes starting at address 8000 | -| `D 8000 20` | Dump 20 bytes starting at address 8000 | -| `C 8000 BFFF` | Compute the 16-bit additive checksum of an inclusive range | -| `W 8000 3E 41 D3 25 C9` | Write bytes starting at address 8000 | -| `I 20` | Read I/O port 20 | -| `O 20 57` | Write 57 to I/O port 20 | -| `K 0` or `BANK 0` | Select lower physical 48K plus upper physical 16K | -| `K 1` or `BANK 1` | Select the complete upper physical 64K | -| `R ON` or `ROM ON` | Enable ROM while preserving the RAM bank selection | -| `R OFF` or `ROM OFF` | Disable ROM while preserving the RAM bank selection | -| `G 8000` | Execute code at address 8000 | -| `G 1400` | Start the ROM-resident Z80 Tiny BASIC interpreter | -| `B` or `BASIC` | Shortcut for `G 1400` | -| `T` or `TAPE` | Start the ROM-resident tape loader at `3000` | -| `HELP` | Show the command summary | - -`G` transfers control with a return address on the stack, so code ending in -`RET` returns to the monitor. Code that changes the stack pointer, interrupt -mode, or UART/CTC setup must restore it before returning. - -`C` adds every byte from the start through the end address, inclusive, and -prints the low 16 bits of the sum as four hexadecimal digits. The end address -must be greater than or equal to the start address. - -`D` prints 16 bytes per row followed by an ASCII column. Bytes outside the -printable ASCII range are shown as `.`. - -Build the ROM and programmer-format images with: - -```sh -make -``` - -## Uploading Intel HEX files - -`program_ihex.py` can write an Intel HEX file to memory through the running -monitor. It sends data in small blocks with `W`, checks every block with `C`, -and retries a failed write or checksum before giving up. It requires Python 3 -and [pySerial](https://pyserial.readthedocs.io/). - -```sh -python3 -m pip install pyserial -python3 program_ihex.py /dev/ttyUSB0 program.hex -``` - -The default connection is 2400 baud, the default block size is 16 bytes, and -three retries are allowed after the initial attempt. Characters are paced with -a 5 ms delay because the monitor UART can lose bytes from an uninterrupted USB -serial burst. For example: - -```sh -python3 program_ihex.py /dev/ttyUSB0 program.hex --retries 5 --block-size 24 -``` - -Use `--char-delay 0.01` if commands still arrive with missing characters. A -smaller value uploads faster; `--char-delay 0` disables host-side pacing. - -Use a Windows port such as `COM3` in place of `/dev/ttyUSB0`. Run -`python3 program_ihex.py --help` for all options. The monitor must be sitting at -its `>` prompt before starting the upload. Only data records present in the HEX -file are written; gaps are left unchanged. The HEX addresses must refer to -writable memory and must not overwrite the running monitor at `C000-FFFF`. - -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 -- `build/casette/tape_loader.bin`: standalone relocated tape-loader payload - -The current compact image is 12,967 bytes. Its ROM layout is: - -- `0000-007F`: reset/copy bootstrap -- `0080-12DD`: packed BIOS+monitor image copied to RAM at `C000-D25D` -- `12DE-13FF`: unused space reserved for the resident image to grow -- `1400-1C0C`: Tiny BASIC, executed directly from ROM -- `1C0D-2FFF`: unused ROM -- `3000-32A6`: tape loader, executed directly from ROM -- `32A7-7FFF`: unused space available for additional ROM content - -The resident image starts at `C000`, its IM 2 vector table is at `C040`, and -linked code starts at `C080`. The bootstrap obtains the resident copy length -from a linker symbol, so it tracks BIOS and monitor changes automatically. - -The resulting RAM layout is: - -- `8000-AFFF`: Tiny BASIC workspace and BASIC program text -- `B000-B077`: Tiny BASIC variables and input buffer -- `B078-BFFF`: Tiny BASIC stack space -- `C000-D25D`: resident BIOS, vectors, services, and monitor -- `D25E-EFFF`: free space for resident-image growth -- `F000-FFFF`: BIOS globals, UART buffers, and monitor stack - -The BIOS and monitor continue to work if low ROM is disabled. ROM-resident -applications naturally require ROM to remain mapped while they execute. - -The banking latch bits used by the bootstrap are bit 0 `ROM_DISABLE`, bit 1 -`BANK_SELECT`, and bit 2 `BANK_ENABLE`. Its initial value `06` leaves ROM on and -selects the lower physical 48 KiB plus the upper physical 16 KiB. Writing `07` -later disables ROM without changing that split mapping. Writing `05` selects -the complete upper physical 64 KiB; the monitor remains available because its -`C000-FFFF` image was placed in that upper bank during boot. - -## BIOS interface - -Assembly applications include `include/bios.inc` and call these fixed entries: - -| Address | Service | Interface | -| --- | --- | --- | -| `C050` | `BIOS_PUTC` | Write character in `A` | -| `C053` | `BIOS_TRY_GETC` | Return character in `A`, or zero | -| `C056` | `BIOS_GETC` | Wait for and return a character in `A` | -| `C059` | `BIOS_IO_OUT` | Write `L` to port `A` | -| `C05C` | `BIOS_IO_IN` | Read port `A`, returning the value in `A` | -| `C05F` | `BIOS_DELAY_MS` | Delay approximately `HL` milliseconds | -| `C062` | `BIOS_MONITOR` | Warm-start the monitor; does not return | -| `C065` | `BIOS_BANK` | `A=0`: split lower 48K/upper 16K; otherwise select upper 64K | -| `C068` | `BIOS_ROM_DISABLE` | Disable ROM while retaining the selected RAM mapping | -| `C06B` | `BIOS_ROM_ENABLE` | Enable ROM while retaining the selected RAM mapping | -| `C06E` | `BIOS_FLUSH` | Wait until the UART output queue is empty | - -The service wrappers preserve working registers except for documented return -values. The monitor uses the corresponding C API declared in `bios.h`. - -The banking latch at port `00` is write-only, so the BIOS keeps a persistent -shadow byte initialized to `06` by the copied resident image. `BIOS_BANK` -always leaves banking enabled and changes only the bank selection while -retaining the shadowed ROM-disable bit and auxiliary-output bits. -`BIOS_ROM_DISABLE` sets the ROM-disable bit and `BIOS_ROM_ENABLE` clears it; -both are idempotent. Code should not write port `00` through `BIOS_IO_OUT` or -the monitor's `O` command after using these services, because such writes -bypass the BIOS shadow state. Use the monitor's `BANK` and `ROM` commands -instead. - -The equivalent C API is `bios_bank(uint8_t bank)` and -`bios_rom_disable(void)` / `bios_rom_enable(void)`. A ROM-resident caller cannot -return normally after selecting the complete upper 64 KiB or disabling ROM, -because its return address is no longer mapped; it must arrange its -continuation in RAM. - -Project organization: - -- `boot.asm`: ROM bootstrap, high vectors, BIOS jump table, and assembly glue -- `bios.c` / `bios.h`: UART, buffers, interrupts, and resident BIOS API -- `monitor.c`: command interpreter implemented on the BIOS API -- `rom_layout.mk`: authoritative ROM and resident-memory addresses -- `apps/tinybasic/tinybasic.asm`: Tiny BASIC ROM application -- `apps/casette/tape_loader.asm`: tape-loader ROM application -- `apps/README.md`: ROM application memory and integration contract -- `include/bios.inc`: stable assembly interface for ROM applications - -The build generates `rom_layout.h` for C and `rom_layout.inc` for assembly from -`rom_layout.mk`. Change application origins and resident-memory addresses only -in `rom_layout.mk`; the generated files are removed by `make clean`. - -## Tiny BASIC - -Tiny BASIC is built from `apps/tinybasic/tinybasic.asm`. The port replaces fixed -low-page `RST` calls with relocatable calls and uses a marker-based command -table so it can be linked at a nonzero ROM address. - -Tiny BASIC is linked at and runs directly from ROM address `1400`. Start it from -the monitor with: - -```text -B -``` - -`BASIC` and `G 1400` are equivalent alternatives. - -Tiny BASIC calls the BIOS at `C050` for output and `C053` for non-blocking -input. Tiny BASIC keeps interrupts enabled so it can share the BIOS-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 tape loader occupies the later ROM slot at `3000-32A6`; the first -unused byte after it is `32A7`. - -## Tape loader - -The tape-loader image is built from `apps/casette/tape_loader.asm`, linked at -`3000`, and included in both ROM images. Start it with `T`, `TAPE`, or `G 3000`. -The current image polls the comparator input and prints its state through the -resident BIOS console service. Signal acquisition is bounded; a missing, -unstable, or permanently high signal reports `TAPE SIGNAL TIMEOUT` and returns -to the monitor instead of waiting forever with interrupts disabled. diff --git a/apps/README.md b/apps/README.md deleted file mode 100644 index 610a19a..0000000 --- a/apps/README.md +++ /dev/null @@ -1,35 +0,0 @@ -# ROM applications - -Applications in this directory execute directly from ROM; the reset bootstrap -does not copy them. Each application must have its own non-overlapping `ORG` -below `8000` and should include `bios.inc` from the project's `include` -directory instead of accessing the UART hardware directly. - -The current allocation is: - -- `1400-1C0C`: Tiny BASIC -- `1C0D-2FFF`: available -- `3000-32A6`: tape loader -- `32A7-7FFF`: available for more applications (`3300` is the next convenient - aligned origin) - -The resident BIOS and monitor own high RAM at `C000-FFFF`. Tiny BASIC owns -`8000-BFFF` for its workspace and stack. Applications may reuse this lower-RAM -allocation because they run one at a time, but they must leave `C000-FFFF` -untouched. - -Applications using the interrupt-driven console must leave interrupt mode 2, -the `I` register, and the BIOS UART/CTC configuration intact. They may return -normally if they preserve the caller's stack, or jump to `BIOS_MONITOR` for a -non-returning monitor warm start after replacing the stack pointer. - -Use `BIOS_BANK`, `BIOS_ROM_DISABLE`, and `BIOS_ROM_ENABLE` for the write-only -banking latch rather than writing port `00` directly. The BIOS keeps the -ROM-disable state when the RAM bank selection changes. A ROM application must -not expect a normal `RET` after it maps out the ROM containing its return -address. - -Application origins and the resident-memory layout are defined centrally in -`rom_layout.mk`. The build turns that file into C and assembly includes. To add -an application, add its address there, add its build and overlay rules to the -Makefile, and add a monitor command or use `G address` to launch it. diff --git a/new/apps/basic/Makefile b/apps/basic/Makefile similarity index 100% rename from new/apps/basic/Makefile rename to apps/basic/Makefile diff --git a/new/apps/basic/basic.asm b/apps/basic/basic.asm similarity index 100% rename from new/apps/basic/basic.asm rename to apps/basic/basic.asm diff --git a/apps/nascom_basic/nascom8kbasic.asm b/apps/basic/nascom8kbasic.asm similarity index 100% rename from apps/nascom_basic/nascom8kbasic.asm rename to apps/basic/nascom8kbasic.asm diff --git a/apps/nascom_basic/searle8kbasic.asm b/apps/basic/searle8kbasic.asm similarity index 100% rename from apps/nascom_basic/searle8kbasic.asm rename to apps/basic/searle8kbasic.asm diff --git a/apps/nascom_basic/searle8kinit.asm b/apps/basic/searle8kinit.asm similarity index 100% rename from apps/nascom_basic/searle8kinit.asm rename to apps/basic/searle8kinit.asm diff --git a/apps/casette/CUPL.PLD b/apps/casette/CUPL.PLD deleted file mode 100644 index 8ef1851..0000000 --- a/apps/casette/CUPL.PLD +++ /dev/null @@ -1,199 +0,0 @@ -Name casette; -PartNo 00; -Date 2026-10-03; -Revision 01; -Designer joppe; -Company unknown; -Assembly None; -Location unknown; -Device g22v10; - - -/* ------------------------------------------------------------ - Constants - ------------------------------------------------------------ */ - -ar = 'b'0; -sp = 'b'0; - - -/* ------------------------------------------------------------ - Pin assignments - - Physical signals IOSEL, RD and WR are active-low. - Their polarity is expressed in the equations with !. - ------------------------------------------------------------ */ - -/* inputs */ - -PIN 1 = CLK; - -PIN 2 = A1; -PIN 3 = A2; - -PIN 4 = IOSEL; -PIN 5 = RD; -PIN 6 = A0; - -PIN 7 = COMP; -PIN 8 = WR; - - -/* data bus */ - -PIN 14 = D0; -PIN 15 = D1; -PIN 16 = D2; -PIN 17 = D3; -PIN 18 = D4; -PIN 19 = D5; -PIN 20 = D6; -PIN 21 = D7; - - -/* registered output */ - -PIN 22 = LED; - - -/* ------------------------------------------------------------ - Read register at offset 0 - - Conditions: - - /IOSEL = 0 - /RD = 0 - /WR = 1 - A2:A0 = 000 - - Result: - - D0 = COMP - D7..D1 = 0 - ------------------------------------------------------------ */ - -D0 = COMP; - -D1 = 'b'0; -D2 = 'b'0; -D3 = 'b'0; -D4 = 'b'0; -D5 = 'b'0; -D6 = 'b'0; -D7 = 'b'0; - - -D0.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D1.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D2.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D3.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D4.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D5.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D6.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - -D7.OE = - !IOSEL - & !RD - & WR - & !A2 - & !A1 - & !A0; - - -/* ------------------------------------------------------------ - Writable LED register - - Write conditions: - - /IOSEL = 0 - /RD = 1 - /WR = 0 - A2:A0 = 000 - - During such a write: - - LED.D = D0 - - Otherwise: - - LED.D = LED - - Pin 1 (CLK) clocks the registered macrocell. - ------------------------------------------------------------ */ - -LED.D = - ( - !IOSEL - & RD - & !WR - & !A2 - & !A1 - & !A0 - & D0 - ) - - # - - ( - ( - IOSEL - # !RD - # WR - # A2 - # A1 - # A0 - ) - & LED - ); - - -LED.ar = ar; -LED.sp = sp; \ No newline at end of file diff --git a/apps/casette/casette.jed b/apps/casette/casette.jed deleted file mode 100644 index 4ae757a..0000000 --- a/apps/casette/casette.jed +++ /dev/null @@ -1,54 +0,0 @@ - -CUPL(WM) 5.0a Serial# MW-10400000 -Device g22v10 Library DLIB-h-40-1 -Created Sat Oct 03 16:22:02 2026 -Name casette -Partno 00 -Revision 01 -Date 2026-10-03 -Designer joppe -Company unknown -Assembly None -Location unknown -*QP24 -*QF5892 -*G1 -*F0 -*L00416 00000000000000000000000011111111 -*L00448 11111111111111111111111111111111 -*L00480 11111111101110111011011110111111 -*L00512 10111111110111111111111011110111 -*L00544 11111111111111111111111111111111 -*L00576 11101111111110111111111111111111 -*L00608 11111111111111101111111111111111 -*L00640 11110111111111111111111111100111 -*L00672 11111111111111111111111111111111 -*L00704 11110110111111111111111111111111 -*L00736 11111111111111111110111111111111 -*L00768 01111111111111111111111100000000 -*L00896 00000000000000000000000000001111 -*L00928 10111011101110111011111101111111 -*L00960 11111111000000000000000000000000 -*L01472 00000000000000000000000011111011 -*L01504 10111011101110111111011111111111 -*L01536 11110000000000000000000000000000 -*L02144 00000000000011111011101110111011 -*L02176 10111111011111111111111100000000 -*L02880 00000000000000000000000011111011 -*L02912 10111011101110111111011111111111 -*L02944 11110000000000000000000000000000 -*L03648 00001111101110111011101110111111 -*L03680 01111111111111110000000000000000 -*L04288 00000000000000000000000011111011 -*L04320 10111011101110111111011111111111 -*L04352 11110000000000000000000000000000 -*L04864 00000000000000000000111110111011 -*L04896 10111011101111110111111111111111 -*L05344 00000000000000000000000011111011 -*L05376 10111011101110111111011111111111 -*L05408 11111111111111111111111111110111 -*L05440 11111111111111110000000000000000 -*L05792 00000000000000000010111111111111 -*L05824 11110011000000110000000000000000 -*C5BE4 -*6A87 \ No newline at end of file diff --git a/apps/casette/encode.py b/apps/casette/encode.py deleted file mode 100644 index 55a4d37..0000000 --- a/apps/casette/encode.py +++ /dev/null @@ -1,135 +0,0 @@ -#!/usr/bin/env python3 -from __future__ import annotations - -import argparse -import struct -import wave -from pathlib import Path - - -class PulseWriter: - def __init__( - self, - sample_rate: int, - t_short_us: float, - t_long_us: float, - amplitude: float, - ) -> None: - self.sample_rate = sample_rate - self.short_samples = self._duration_samples(t_short_us) - self.long_samples = self._duration_samples(t_long_us) - self.high = round(32767 * amplitude) - self.low = -self.high - self.samples = bytearray() - - self.space(0.1) - - def space(self, time: float) -> None: - self._level(0, int(time*self.sample_rate)) - - def _duration_samples(self, duration_us: float) -> int: - sample_count = round(duration_us * self.sample_rate / 1_000_000) - if sample_count < 1: - raise ValueError( - f"pulse duration {duration_us:g} us is shorter than one sample" - ) - return sample_count - - def _level(self, value: int, sample_count: int) -> None: - self.samples.extend(struct.pack(" None: - self._level(self.high, self.short_samples) - self._level(self.low, self.long_samples) - - def long_pulse(self) -> None: - self._level(self.high, self.long_samples) - self._level(self.low, self.short_samples) - - def marker(self) -> None: - self._level(self.high, 2*self.long_samples) - self._level(self.low, 2*self.long_samples) - - def bit(self, value: int) -> None: - if value: - self.long_pulse() - else: - self.short_pulse() - - def byte(self, value: int) -> None: - # Transmit bytes most-significant bit first. - for bit_number in range(7, -1, -1): - self.bit((value >> bit_number) & 1) - - def bytes(self, value: bytes) -> None: - for byte in value: - self.byte(byte) - - def leader(self) -> None: - self.space(0.2) - for _ in range(50): - self._level(self.high, self.short_samples) - self._level(self.low, self.short_samples) - for _ in range(50): - self._level(self.high, self.long_samples) - self._level(self.low, self.long_samples) - self.marker() - for value in (0x55, 0x5A, 0xC3): - self.byte(value) - - -def main() -> None: - parser = argparse.ArgumentParser( - description="Generate the pulse-width encoded tape leader" - ) - parser.add_argument("output", type=Path, help="output WAV file") - parser.add_argument("--sample-rate", type=int, default=48_000) - parser.add_argument( - "--t-short", - type=float, - default=250.0, - metavar="MICROSECONDS", - help="short pulse interval in microseconds (default: 250)", - ) - parser.add_argument( - "--t-long", - type=float, - default=500.0, - metavar="MICROSECONDS", - help="long pulse interval in microseconds (default: 500)", - ) - parser.add_argument("--amplitude", type=float, default=0.75) - args = parser.parse_args() - - if args.sample_rate <= 0: - parser.error("--sample-rate must be positive") - if args.t_short <= 0 or args.t_long <= 0: - parser.error("pulse intervals must be positive") - if args.t_short >= args.t_long: - parser.error("--t-short must be less than --t-long") - if not 0.0 <= args.amplitude <= 1.0: - parser.error("--amplitude must be between 0 and 1") - - try: - pulses = PulseWriter( - args.sample_rate, - args.t_short, - args.t_long, - args.amplitude, - ) - except ValueError as error: - parser.error(str(error)) - - pulses.leader() - pulses.bytes(b'Hello world!\0') - - pulses.space(1.0) - with wave.open(str(args.output), "wb") as wav: - wav.setnchannels(1) - wav.setsampwidth(2) - wav.setframerate(args.sample_rate) - wav.writeframes(pulses.samples) - - -if __name__ == "__main__": - main() diff --git a/apps/casette/tape_loader.asm b/apps/casette/tape_loader.asm deleted file mode 100644 index eecb3ba..0000000 --- a/apps/casette/tape_loader.asm +++ /dev/null @@ -1,569 +0,0 @@ -.include "bios.inc" - -.area TAPELOAD (ABS) -.org TAPE_LOADER_ROM_ADDRESS - -.macro print_var arg1 - ld a, (arg1) - ei - call print_hex8 - call print_crlf - di -.endm - -.macro error_ret arg1,arg2 -arg1: - ld a,#arg2 - scf - ret -.endm - -TAPE_PORT = 0x18 -MAX_BLOCK_SIZE = 0x100 - -STACK_TOP = 0xBFFF -WORK_BASE = 0xB000 - -OLD_SP = WORK_BASE + 0x00 ; word -OLD_IFF = WORK_BASE + 0x02 ; byte -SHORT_AVG = WORK_BASE + 0x03 ; byte -SHORT_MAX = WORK_BASE + 0x04 ; byte -SHORT_MIN = WORK_BASE + 0x05 ; byte -LONG_AVG = WORK_BASE + 0x06 ; byte -LONG_MAX = WORK_BASE + 0x07 ; byte -LONG_MIN = WORK_BASE + 0x08 ; byte - -BLOCK_BUFFER = WORK_BASE + 0x100 ; MAX_BLOCK_SIZE - -; #################################################3 -; Entry -; #################################################3 -tape_loader: - ld (OLD_SP),sp - ; Save interrupt state. - ld a,i - jp po,iff_was_off - ld a,#1 - jr save_iff -iff_was_off: - xor a -save_iff: - ld (OLD_IFF),a - di - ld sp,#STACK_TOP - -main: - ; Initial message. - ld hl,#msg_start - call print_string_ei - - ; Calibrate reader - call calibrate - jr nc,1$ - ei - call print_hex8 - call print_crlf - ld hl,#msg_cal_fail - call print_string - di - jp exit -1$: - ; try to read the sync bytes - call read_sync - jr nc,2$ - ld hl,#msg_sync_error - call print_string_ei - jp exit -2$: - - ; Test, read Hello World!\0 (13 bytes) - exx - ld e,#0 - ld hl,#BLOCK_BUFFER - exx -4$: - call read_byte - jr nc,5$ - ld hl,#msg_read_error - call print_string_ei - exx - ei - call print_hex16 - call print_crlf - di - exx - jp exit -5$: - exx - ld (hl),a - inc hl - inc e - ld a,e - cp a,#13 - exx - jr nz,4$ - -; #################################################3 -; Exit -; #################################################3 -exit: - ei - call BIOS_FLUSH - di - ld sp,(OLD_SP) - ; Return code 0 - ld a,#0 - ld c,a - ; Restore caller's interrupt state. - ld a,(OLD_IFF) - or a - ld a,c - jr z,return_di - ei - ret -return_di: - ret - -; #################################################3 -; Measure edge-to-edge pulse -; needs d (comparator state) -; returns b (loop count) -; carry is timeout -; uses a -; loop is 36T, extra 22T (0.6 loops) -; #################################################3 -measure_pulse: - ld b,#0 ; 4T -1$: - ; Use b as timeout counter (256 loops) - inc b ; 4T - jr z,9$ ; 12/7T - in a,(TAPE_PORT) ; 11T - cp a,d ; 4T - jp z,1$ ; 10T - ; loop has 36T - ; Edge found - ld d,a ; 4T - or a,a ; 4T - ret ; 10T -9$: - scf - ret - -; #################################################3 -; Ignore one pulse then measure next pulse -; needs d (comparator state) -; returns b (loop count) -; carry is timeout -; uses a -; loop is 36T, extra 26T (0.7 loops) -; #################################################3 -sample_pulse: - ; wait for first edge - ld b,#0 ; 4T -1$: - ; Use b as timeout counter (256 loops) - inc b ; 4T - jr z,9$ ; 12/7T - in a,(TAPE_PORT) ; 11T - cp a,d ; 4T - jp z,1$ ; 10T - ; loop has 36T - ; Edge found - ld d,a ; 4T - ; start timing pulse length - ld b,#0 ; 4T -2$: - ; Use b as timeout counter (256 loops) - inc b ; 4T - jr z,9$ ; 12/7T - in a,(TAPE_PORT) ; 11T - cp a,d ; 4T - jp z,2$ ; 10T - ; loop has 36T - ; Edge found - ld d,a ; 4T - or a,a ; 4T - ret ; 10T -9$: - scf - ret - -; #################################################3 -; Average 8 pulse measurements -; needs d (comparator state) -; returns a (average) -; carry is timeout -; uses b,e,h -; #################################################3 -average8: - ld e,#0 - ld h,#8 -1$: - ; synchronize to next pulse - ; ignore first measurement - ; contains part of the calculations - call sample_pulse - call sample_pulse - ; when timeout just return with carry - ret c - ; Add loop count to e - ld a,e - add a,b - ld e,a - ; repeat 8 times - dec h - jr nz,1$ - ; divide by 8 - ld a,e - srl a - srl a - srl a - ; clear carry - or a,a - ret - -; #################################################3 -; Make +/-25% window around a -; needs a (average) -; returns b (minimum) c (maximum) -; uses e,h -; NOTE: USES 8 BIT COUNTER -; @1MHZ t_long<1.14ms -; @2MHZ t_long<571us -; @4MHZ t_long<285us -; TODO: Check feasibility of using 16bit accumulator -; #################################################3 -make_window: - ld e,a - ; get 25% - srl a - srl a - ld h,a - ; a-25% - ld a,e - sub h - ld b,a - ; a+25% - ld a,e - add a,h - ld c,a - ret - -; #################################################3 -; Calibration -; #################################################3 -calibrate: - ; Get current comparator state - in a,(TAPE_PORT) - ld d,a - - ; make sure we start in silence - call sample_pulse - ; should timeout - jp nc,cal_fail_no_silence - - ; Wait for first edge - ld l,#0 -1$: - call sample_pulse - jr nc,2$ - ; Use b as timeout counter (256 loops) - ; inc l - ; jr nz,1$ - jr 1$ - ; timeout - ;jp cal_fail_no_short_leader ; TODO IGNORED TIMEOUT FOR NOW HERE -2$: - ; edge found - - ; get short leader timing - call average8 - jr c,cal_fail_short - ld (SHORT_AVG),a - - call make_window - ld a,b - ld (SHORT_MIN),a - ld a,c - ld (SHORT_MAX),a - - ; find long leader - ; need 4 consecutive pulses > short*1.5 - ld a,(SHORT_AVG) - ld c,a - srl a - add a,c - ld c,a - ; c = short*1.5 - - ; TODO no overal timeout here. a continuous - ; short pulse leader will keep on waiting - ; forever -3$: - ld e,#4 -4$: - ; ignore first to get accurate measurement - call sample_pulse - call sample_pulse - jr c,cal_fail_find_long - ld a,b - ; if it is no long pulse try again - cp a,c - jr c,3$ - ; long pulse found - dec e - jr nz,4$ - ; 4 (or well... 8) long pulses found - - ; get long leader timning - call average8 - jr c,cal_fail_long - ld (LONG_AVG),a - - call make_window - ld a,b - ld (LONG_MIN),a - ld a,c - ld (LONG_MAX),a - - ; A quick sanity check - ; long > 1.5*short - ld a,(SHORT_AVG) - ld c,a - srl a - add a,c - ld c,a - ; c = 1.5*short - ld a,(LONG_AVG) - cp a,c - jr c,cal_fail_sanity - - ; Find the marker - ; marker is 2*long high 2*long low - ; threshold is 1.5*long - ld a,(LONG_AVG) - ld c,a - srl a - add a,c - ld c,a - ; c = 1.5*long - - ; Find two consecutive marker-width intervals. -5$: - ld e,#0 -6$: - call measure_pulse - jr c,cal_fail - ld a,b - cp a,c - jr c,5$ - inc e - ld a,e - cp a,#2 - jr c,6$ - ; Both marker halves consumed. We are now at the - ; beginning of the first data pulse. - - ; next pulse is first pulse of training byte - ; must decode as 0x55 - call read_byte - jr c,cal_fail_read_error - cp a,#0x55 - jr nz,cal_fail_training_byte - - ld a,#0 - or a,a - ret - -error_ret cal_fail 0 -error_ret cal_fail_short 1 -error_ret cal_fail_find_long 2 -error_ret cal_fail_long 3 -error_ret cal_fail_sanity 4 -error_ret cal_fail_training_byte 5 -error_ret cal_fail_no_silence 6 -error_ret cal_fail_no_short_leader 7 -error_ret cal_fail_read_error 8 - -; #################################################3 -; Read single bit -; needs d (comparator state) -; valid: z=1 c=bit -; error: z=0 -; uses a,b,c -; #################################################3 -read_bit: - ; entry may be late into first pulse - ; wait for first edge to measure - ld b,#0 -1$: - inc b - jr z,bit_bad - in a,(TAPE_PORT) - cp a,d - jp z,1$ - ld d,a - ; ignored first edge - ; measure second pulse - ld b,#0 -2$: - inc b - jr z,bit_bad - in a,(TAPE_PORT) - cp a,d - jp z,2$ - ld d,a - ; if in short window (second half is short pulse) - ; 1 - ld a,(SHORT_MIN) - ld c,a - ld a,b - cp a,c - jr c,bit_bad ; pulse'+80H - .BYTE '='+80H - .BYTE '<'+80H - - .BYTE 'S'+80H,"GN" - .BYTE 'I'+80H,"NT" - .BYTE 'A'+80H,"BS" - .BYTE 'U'+80H,"SR" - .BYTE 'F'+80H,"RE" - .BYTE 'I'+80H,"NP" - .BYTE 'P'+80H,"OS" - .BYTE 'S'+80H,"QR" - .BYTE 'R'+80H,"ND" - .BYTE 'L'+80H,"OG" - .BYTE 'E'+80H,"XP" - .BYTE 'C'+80H,"OS" - .BYTE 'S'+80H,"IN" - .BYTE 'T'+80H,"AN" - .BYTE 'A'+80H,"TN" - .BYTE 'P'+80H,"EEK" - .BYTE 'D'+80H,"EEK" - .BYTE 'P'+80H,"OINT" - .BYTE 'L'+80H,"EN" - .BYTE 'S'+80H,"TR$" - .BYTE 'V'+80H,"AL" - .BYTE 'A'+80H,"SC" - .BYTE 'C'+80H,"HR$" - .BYTE 'H'+80H,"EX$" - .BYTE 'B'+80H,"IN$" - .BYTE 'L'+80H,"EFT$" - .BYTE 'R'+80H,"IGHT$" - .BYTE 'M'+80H,"ID$" - .BYTE 80H ; End of list marker - -; KEYWORD ADDRESS TABLE - -WORDTB: .WORD PEND - .WORD FOR - .WORD NEXT - .WORD DATA - .WORD INPUT - .WORD DIM - .WORD READ - .WORD LET - .WORD GOTO - .WORD RUN - .WORD IF - .WORD RESTOR - .WORD GOSUB - .WORD RETURN - .WORD REM - .WORD STOP - .WORD POUT - .WORD ON - .WORD NULL - .WORD WAIT - .WORD DEF - .WORD POKE - .WORD DOKE - .WORD REM - .WORD LINES - .WORD CLS - .WORD WIDTH - .WORD MONITR - .WORD PSET - .WORD RESET - .WORD PRINT - .WORD CONT - .WORD LIST - .WORD CLEAR - .WORD FCERR - .WORD FCERR - .WORD NEW - -; RESERVED WORD TOKEN VALUES - -ZEND .EQU 080H ; END -ZFOR .EQU 081H ; FOR -ZDATA .EQU 083H ; DATA -ZGOTO .EQU 088H ; GOTO -ZGOSUB .EQU 08CH ; GOSUB -ZREM .EQU 08EH ; REM -ZPRINT .EQU 09EH ; PRINT -ZNEW .EQU 0A4H ; NEW - -ZTAB .EQU 0A5H ; TAB -ZTO .EQU 0A6H ; TO -ZFN .EQU 0A7H ; FN -ZSPC .EQU 0A8H ; SPC -ZTHEN .EQU 0A9H ; THEN -ZNOT .EQU 0AAH ; NOT -ZSTEP .EQU 0ABH ; STEP - -ZPLUS .EQU 0ACH ; + -ZMINUS .EQU 0ADH ; - -ZTIMES .EQU 0AEH ; * -ZDIV .EQU 0AFH ; / -ZOR .EQU 0B2H ; OR -ZGTR .EQU 0B3H ; > -ZEQUAL .EQU 0B4H ; M -ZLTH .EQU 0B5H ; < -ZSGN .EQU 0B6H ; SGN -ZPOINT .EQU 0C7H ; POINT -ZLEFT .EQU 0CDH +2 ; LEFT$ - -; ARITHMETIC PRECEDENCE TABLE - -PRITAB: .BYTE 79H ; Precedence value - .WORD PADD ; FPREG = + FPREG - - .BYTE 79H ; Precedence value - .WORD PSUB ; FPREG = - FPREG - - .BYTE 7CH ; Precedence value - .WORD MULT ; PPREG = * FPREG - - .BYTE 7CH ; Precedence value - .WORD DIV ; FPREG = / FPREG - - .BYTE 7FH ; Precedence value - .WORD POWER ; FPREG = ^ FPREG - - .BYTE 50H ; Precedence value - .WORD PAND ; FPREG = AND FPREG - - .BYTE 46H ; Precedence value - .WORD POR ; FPREG = OR FPREG - -; BASIC ERROR CODE LIST - -ERRORS: .BYTE "NF" ; NEXT without FOR - .BYTE "SN" ; Syntax error - .BYTE "RG" ; RETURN without GOSUB - .BYTE "OD" ; Out of DATA - .BYTE "FC" ; Illegal function call - .BYTE "OV" ; Overflow error - .BYTE "OM" ; Out of memory - .BYTE "UL" ; Undefined line - .BYTE "BS" ; Bad subscript - .BYTE "DD" ; Re-DIMensioned array - .BYTE "/0" ; Division by zero - .BYTE "ID" ; Illegal direct - .BYTE "TM" ; Type mis-match - .BYTE "OS" ; Out of string space - .BYTE "LS" ; String too long - .BYTE "ST" ; String formula too complex - .BYTE "CN" ; Can't CONTinue - .BYTE "UF" ; Undefined FN function - .BYTE "MO" ; Missing operand - .BYTE "HX" ; HEX error - .BYTE "BN" ; BIN error - -; INITIALISATION TABLE ------------------------------------------------------- - -INITAB: JP WARMST ; Warm start jump - JP FCERR ; "USR (X)" jump (Set to Error) - OUT (0),A ; "OUT p,n" skeleton - RET - SUB 0 ; Division support routine - LD L,A - LD A,H - SBC A,0 - LD H,A - LD A,B - SBC A,0 - LD B,A - LD A,0 - RET - .BYTE 0,0,0 ; Random number seed table used by RND - .BYTE 035H,04AH,0CAH,099H ;-2.65145E+07 - .BYTE 039H,01CH,076H,098H ; 1.61291E+07 - .BYTE 022H,095H,0B3H,098H ;-1.17691E+07 - .BYTE 00AH,0DDH,047H,098H ; 1.30983E+07 - .BYTE 053H,0D1H,099H,099H ;-2-01612E+07 - .BYTE 00AH,01AH,09FH,098H ;-1.04269E+07 - .BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07 - .BYTE 0D6H,077H,03EH,098H ; 1.24825E+07 - .BYTE 052H,0C7H,04FH,080H ; Last random number - IN A,(0) ; INP (x) skeleton - RET - .BYTE 1 ; POS (x) number (1) - .BYTE 255 ; Terminal width (255 = no auto CRLF) - .BYTE 28 ; Width for commas (3 columns) - .BYTE 0 ; No nulls after input bytes - .BYTE 0 ; Output enabled (^O off) - .WORD 20 ; Initial lines counter - .WORD 20 ; Initial lines number - .WORD 0 ; Array load/save check sum - .BYTE 0 ; Break not by NMI - .BYTE 0 ; Break flag - JP TTYLIN ; Input reflection (set to TTY) - JP FCERR ; POINT reflection (unsupported) - JP FCERR ; SET reflection (unsupported) - JP FCERR ; RESET reflection (unsupported) - .WORD STLOOK ; Temp string space - .WORD -2 ; Current line number (cold) - .WORD PROGST+1 ; Start of program text -INITBE: - -; END OF INITIALISATION TABLE --------------------------------------------------- - -ERRMSG: .BYTE " Error",0 -INMSG: .BYTE " in ",0 -ZERBYT .EQU $-1 ; A zero byte -OKMSG: .BYTE "Ok",CR,LF,0,0 -BRKMSG: .BYTE "Break",0 - -BAKSTK: LD HL,4 ; Look for "FOR" block with - ADD HL,SP ; same index as specified -LOKFOR: LD A,(HL) ; Get block ID - INC HL ; Point to index address - CP ZFOR ; Is it a "FOR" token - RET NZ ; No - exit - LD C,(HL) ; BC = Address of "FOR" index - INC HL - LD B,(HL) - INC HL ; Point to sign of STEP - PUSH HL ; Save pointer to sign - LD L,C ; HL = address of "FOR" index - LD H,B - LD A,D ; See if an index was specified - OR E ; DE = 0 if no index specified - EX DE,HL ; Specified index into HL - JP Z,INDFND ; Skip if no index given - EX DE,HL ; Index back into DE - CALL CPDEHL ; Compare index with one given -INDFND: LD BC,16-3 ; Offset to next block - POP HL ; Restore pointer to sign - RET Z ; Return if block found - ADD HL,BC ; Point to next block - JP LOKFOR ; Keep on looking - -MOVUP: CALL ENFMEM ; See if enough memory -MOVSTR: PUSH BC ; Save end of source - EX (SP),HL ; Swap source and dest" end - POP BC ; Get end of destination -MOVLP: CALL CPDEHL ; See if list moved - LD A,(HL) ; Get byte - LD (BC),A ; Move it - RET Z ; Exit if all done - DEC BC ; Next byte to move to - DEC HL ; Next byte to move - JP MOVLP ; Loop until all bytes moved - -CHKSTK: PUSH HL ; Save code string address - LD HL,(ARREND) ; Lowest free memory - LD B,0 ; BC = Number of levels to test - ADD HL,BC ; 2 Bytes for each level - ADD HL,BC - .BYTE 3EH ; Skip "PUSH HL" -ENFMEM: PUSH HL ; Save code string address - LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM - SUB L - LD L,A - LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM - SBC A,H - JP C,OMERR ; Not enough - ?OM Error - LD H,A - ADD HL,SP ; Test if stack is overflowed - POP HL ; Restore code string address - RET C ; Return if enough mmory -OMERR: LD E,OM ; ?OM Error - JP ERROR - -DATSNR: LD HL,(DATLIN) ; Get line of current DATA item - LD (LINEAT),HL ; Save as current line -SNERR: LD E,SN ; ?SN Error - .BYTE 01H ; Skip "LD E,DZ" -DZERR: LD E,DZ ; ?/0 Error - .BYTE 01H ; Skip "LD E,NF" -NFERR: LD E,NF ; ?NF Error - .BYTE 01H ; Skip "LD E,DD" -DDERR: LD E,DD ; ?DD Error - .BYTE 01H ; Skip "LD E,UF" -UFERR: LD E,UF ; ?UF Error - .BYTE 01H ; Skip "LD E,OV -OVERR: LD E,OV ; ?OV Error - .BYTE 01H ; Skip "LD E,TM" -TMERR: LD E,TM ; ?TM Error - -ERROR: CALL CLREG ; Clear registers and stack - LD (CTLOFG),A ; Enable output (A is 0) - CALL STTLIN ; Start new line - LD HL,ERRORS ; Point to error codes - LD D,A ; D = 0 (A is 0) - LD A,'?' - CALL OUTC ; Output '?' - ADD HL,DE ; Offset to correct error code - LD A,(HL) ; First character - CALL OUTC ; Output it - CALL GETCHR ; Get next character - CALL OUTC ; Output it - LD HL,ERRMSG ; "Error" message -ERRIN: CALL PRS ; Output message - LD HL,(LINEAT) ; Get line of error - LD DE,-2 ; Cold start error if -2 - CALL CPDEHL ; See if cold start error - JP Z,CSTART ; Cold start error - Restart - LD A,H ; Was it a direct error? - AND L ; Line = -1 if direct error - INC A - CALL NZ,LINEIN ; No - output line of error - .BYTE 3EH ; Skip "POP BC" -POPNOK: POP BC ; Drop address in input buffer - -PRNTOK: XOR A ; Output "Ok" and get command - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start new line - LD HL,OKMSG ; "Ok" message - CALL PRS ; Output "Ok" -GETCMD: LD HL,-1 ; Flag direct mode - LD (LINEAT),HL ; Save as current line - CALL GETLIN ; Get an input line - JP C,GETCMD ; Get line again if break - CALL GETCHR ; Get first character - INC A ; Test if end of line - DEC A ; Without affecting Carry - JP Z,GETCMD ; Nothing entered - Get another - PUSH AF ; Save Carry status - CALL ATOH ; Get line number into DE - PUSH DE ; Save line number - CALL CRUNCH ; Tokenise rest of line - LD B,A ; Length of tokenised line - POP DE ; Restore line number - POP AF ; Restore Carry - JP NC,EXCUTE ; No line number - Direct mode - PUSH DE ; Save line number - PUSH BC ; Save length of tokenised line - XOR A - LD (LSTBIN),A ; Clear last byte input - CALL GETCHR ; Get next character - OR A ; Set flags - PUSH AF ; And save them - CALL SRCHLN ; Search for line number in DE - JP C,LINFND ; Jump if line found - POP AF ; Get status - PUSH AF ; And re-save - JP Z,ULERR ; Nothing after number - Error - OR A ; Clear Carry -LINFND: PUSH BC ; Save address of line in prog - JP NC,INEWLN ; Line not found - Insert new - EX DE,HL ; Next line address in DE - LD HL,(PROGND) ; End of program -SFTPRG: LD A,(DE) ; Shift rest of program down - LD (BC),A - INC BC ; Next destination - INC DE ; Next source - CALL CPDEHL ; All done? - JP NZ,SFTPRG ; More to do - LD H,B ; HL - New end of program - LD L,C - LD (PROGND),HL ; Update end of program - -INEWLN: POP DE ; Get address of line, - POP AF ; Get status - JP Z,SETPTR ; No text - Set up pointers - LD HL,(PROGND) ; Get end of program - EX (SP),HL ; Get length of input line - POP BC ; End of program to BC - ADD HL,BC ; Find new end - PUSH HL ; Save new end - CALL MOVUP ; Make space for line - POP HL ; Restore new end - LD (PROGND),HL ; Update end of program pointer - EX DE,HL ; Get line to move up in HL - LD (HL),H ; Save MSB - POP DE ; Get new line number - INC HL ; Skip pointer - INC HL - LD (HL),E ; Save LSB of line number - INC HL - LD (HL),D ; Save MSB of line number - INC HL ; To first byte in line - LD DE,BUFFER ; Copy buffer to program -MOVBUF: LD A,(DE) ; Get source - LD (HL),A ; Save destinations - INC HL ; Next source - INC DE ; Next destination - OR A ; Done? - JP NZ,MOVBUF ; No - Repeat -SETPTR: CALL RUNFST ; Set line pointers - INC HL ; To LSB of pointer - EX DE,HL ; Address to DE -PTRLP: LD H,D ; Address to HL - LD L,E - LD A,(HL) ; Get LSB of pointer - INC HL ; To MSB of pointer - OR (HL) ; Compare with MSB pointer - JP Z,GETCMD ; Get command line if end - INC HL ; To LSB of line number - INC HL ; Skip line number - INC HL ; Point to first byte in line - XOR A ; Looking for 00 byte -FNDEND: CP (HL) ; Found end of line? - INC HL ; Move to next byte - JP NZ,FNDEND ; No - Keep looking - EX DE,HL ; Next line address to HL - LD (HL),E ; Save LSB of pointer - INC HL - LD (HL),D ; Save MSB of pointer - JP PTRLP ; Do next line - -SRCHLN: LD HL,(BASTXT) ; Start of program text -SRCHLP: LD B,H ; BC = Address to look at - LD C,L - LD A,(HL) ; Get address of next line - INC HL - OR (HL) ; End of program found? - DEC HL - RET Z ; Yes - Line not found - INC HL - INC HL - LD A,(HL) ; Get LSB of line number - INC HL - LD H,(HL) ; Get MSB of line number - LD L,A - CALL CPDEHL ; Compare with line in DE - LD H,B ; HL = Start of this line - LD L,C - LD A,(HL) ; Get LSB of next line address - INC HL - LD H,(HL) ; Get MSB of next line address - LD L,A ; Next line to HL - CCF - RET Z ; Lines found - Exit - CCF - RET NC ; Line not found,at line after - JP SRCHLP ; Keep looking - -NEW: RET NZ ; Return if any more on line -CLRPTR: LD HL,(BASTXT) ; Point to start of program - XOR A ; Set program area to empty - LD (HL),A ; Save LSB = 00 - INC HL - LD (HL),A ; Save MSB = 00 - INC HL - LD (PROGND),HL ; Set program end - -RUNFST: LD HL,(BASTXT) ; Clear all variables - DEC HL - -INTVAR: LD (BRKLIN),HL ; Initialise RUN variables - LD HL,(LSTRAM) ; Get end of RAM - LD (STRBOT),HL ; Clear string space - XOR A - CALL RESTOR ; Reset DATA pointers - LD HL,(PROGND) ; Get end of program - LD (VAREND),HL ; Clear variables - LD (ARREND),HL ; Clear arrays - -CLREG: POP BC ; Save return address - LD HL,(STRSPC) ; Get end of working RAN - LD SP,HL ; Set stack - LD HL,TMSTPL ; Temporary string pool - LD (TMSTPT),HL ; Reset temporary string ptr - XOR A ; A = 00 - LD L,A ; HL = 0000 - LD H,A - LD (CONTAD),HL ; No CONTinue - LD (FORFLG),A ; Clear FOR flag - LD (FNRGNM),HL ; Clear FN argument - PUSH HL ; HL = 0000 - PUSH BC ; Put back return -DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN - RET ; Return to execution driver - -PROMPT: LD A,'?' ; '?' - CALL OUTC ; Output character - LD A,' ' ; Space - CALL OUTC ; Output character - JP RINPUT ; Get input line - -CRUNCH: XOR A ; Tokenise line @ HL to BUFFER - LD (DATFLG),A ; Reset literal flag - LD C,2+3 ; 2 byte number and 3 nulls - LD DE,BUFFER ; Start of input buffer -CRNCLP: LD A,(HL) ; Get byte - CP ' ' ; Is it a space? - JP Z,MOVDIR ; Yes - Copy direct - LD B,A ; Save character - CP '"' ; Is it a quote? - JP Z,CPYLIT ; Yes - Copy literal string - OR A ; Is it end of buffer? - JP Z,ENDBUF ; Yes - End buffer - LD A,(DATFLG) ; Get data type - OR A ; Literal? - LD A,(HL) ; Get byte to copy - JP NZ,MOVDIR ; Literal - Copy direct - CP '?' ; Is it '?' short for PRINT - LD A,ZPRINT ; "PRINT" token - JP Z,MOVDIR ; Yes - replace it - LD A,(HL) ; Get byte again - CP '0' ; Is it less than '0' - JP C,FNDWRD ; Yes - Look for reserved words - CP 60; ";"+1 ; Is it "0123456789:;" ? - JP C,MOVDIR ; Yes - copy it direct -FNDWRD: PUSH DE ; Look for reserved words - LD DE,WORDS-1 ; Point to table - PUSH BC ; Save count - LD BC,RETNAD ; Where to return to - PUSH BC ; Save return address - LD B,ZEND-1 ; First token value -1 - LD A,(HL) ; Get byte - CP 'a' ; Less than 'a' ? - JP C,SEARCH ; Yes - search for words - CP 'z'+1 ; Greater than 'z' ? - JP NC,SEARCH ; Yes - search for words - AND 01011111B ; Force upper case - LD (HL),A ; Replace byte -SEARCH: LD C,(HL) ; Search for a word - EX DE,HL -GETNXT: INC HL ; Get next reserved word - OR (HL) ; Start of word? - JP P,GETNXT ; No - move on - INC B ; Increment token value - LD A, (HL) ; Get byte from table - AND 01111111B ; Strip bit 7 - RET Z ; Return if end of list - CP C ; Same character as in buffer? - JP NZ,GETNXT ; No - get next word - EX DE,HL - PUSH HL ; Save start of word - -NXTBYT: INC DE ; Look through rest of word - LD A,(DE) ; Get byte from table - OR A ; End of word ? - JP M,MATCH ; Yes - Match found - LD C,A ; Save it - LD A,B ; Get token value - CP ZGOTO ; Is it "GOTO" token ? - JP NZ,NOSPC ; No - Don't allow spaces - CALL GETCHR ; Get next character - DEC HL ; Cancel increment from GETCHR -NOSPC: INC HL ; Next byte - LD A,(HL) ; Get byte - CP 'a' ; Less than 'a' ? - JP C,NOCHNG ; Yes - don't change - AND 01011111B ; Make upper case -NOCHNG: CP C ; Same as in buffer ? - JP Z,NXTBYT ; Yes - keep testing - POP HL ; Get back start of word - JP SEARCH ; Look at next word - -MATCH: LD C,B ; Word found - Save token value - POP AF ; Throw away return - EX DE,HL - RET ; Return to "RETNAD" -RETNAD: EX DE,HL ; Get address in string - LD A,C ; Get token value - POP BC ; Restore buffer length - POP DE ; Get destination address -MOVDIR: INC HL ; Next source in buffer - LD (DE),A ; Put byte in buffer - INC DE ; Move up buffer - INC C ; Increment length of buffer - SUB ':' ; End of statement? - JP Z,SETLIT ; Jump if multi-statement line - CP ZDATA-3AH ; Is it DATA statement ? - JP NZ,TSTREM ; No - see if REM -SETLIT: LD (DATFLG),A ; Set literal flag -TSTREM: SUB ZREM-3AH ; Is it REM? - JP NZ,CRNCLP ; No - Leave flag - LD B,A ; Copy rest of buffer -NXTCHR: LD A,(HL) ; Get byte - OR A ; End of line ? - JP Z,ENDBUF ; Yes - Terminate buffer - CP B ; End of statement ? - JP Z,MOVDIR ; Yes - Get next one -CPYLIT: INC HL ; Move up source string - LD (DE),A ; Save in destination - INC C ; Increment length - INC DE ; Move up destination - JP NXTCHR ; Repeat - -ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer - LD (DE),A ; Mark end of buffer (A = 00) - INC DE - LD (DE),A ; A = 00 - INC DE - LD (DE),A ; A = 00 - RET - -DODEL: LD A,(NULFLG) ; Get null flag status - OR A ; Is it zero? - LD A,0 ; Zero A - Leave flags - LD (NULFLG),A ; Zero null flag - JP NZ,ECHDEL ; Set - Echo it - DEC B ; Decrement length - JP Z,GETLIN ; Get line again if empty - CALL OUTC ; Output null character - .BYTE 3EH ; Skip "DEC B" -ECHDEL: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - JP Z,OTKLN ; No buffer - Try again - LD A,(HL) ; Get deleted byte - CALL OUTC ; Echo it - JP MORINP ; Get more input - -DELCHR: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - CALL OUTC ; Output character in A - JP NZ,MORINP ; Not end - Get more -OTKLN: CALL OUTC ; Output character in A -KILIN: CALL PRNTCRLF ; Output CRLF - JP TTYLIN ; Get line again - -GETLIN: -TTYLIN: LD HL,BUFFER ; Get a line by character - LD B,1 ; Set buffer as empty - XOR A - LD (NULFLG),A ; Clear null flag -MORINP: CALL CLOTST ; Get character and test ^O - LD C,A ; Save character in C - CP DEL ; Delete character? - JP Z,DODEL ; Yes - Process it - LD A,(NULFLG) ; Get null flag - OR A ; Test null flag status - JP Z,PROCES ; Reset - Process character - LD A,0 ; Set a null - CALL OUTC ; Output null - XOR A ; Clear A - LD (NULFLG),A ; Reset null flag -PROCES: LD A,C ; Get character - CP CTRLG ; Bell? - JP Z,PUTCTL ; Yes - Save it - CP CTRLC ; Is it control "C"? - CALL Z,PRNTCRLF ; Yes - Output CRLF - SCF ; Flag break - RET Z ; Return if control "C" - CP CR ; Is it enter? - JP Z,ENDINP ; Yes - Terminate input - CP CTRLU ; Is it control "U"? - JP Z,KILIN ; Yes - Get another line - CP '@' ; Is it "kill line"? - JP Z,OTKLN ; Yes - Kill line - CP '_' ; Is it delete? - JP Z,DELCHR ; Yes - Delete character - CP BKSP ; Is it backspace? - JP Z,DELCHR ; Yes - Delete character - CP CTRLR ; Is it control "R"? - JP NZ,PUTBUF ; No - Put in buffer - PUSH BC ; Save buffer length - PUSH DE ; Save DE - PUSH HL ; Save buffer address - LD (HL),0 ; Mark end of buffer - CALL OUTNCR ; Output and do CRLF - LD HL,BUFFER ; Point to buffer start - CALL PRS ; Output buffer - POP HL ; Restore buffer address - POP DE ; Restore DE - POP BC ; Restore buffer length - JP MORINP ; Get another character - -PUTBUF: CP ' ' ; Is it a control code? - JP C,MORINP ; Yes - Ignore -PUTCTL: LD A,B ; Get number of bytes in buffer - CP 72+1 ; Test for line overflow - LD A,CTRLG ; Set a bell - JP NC,OUTNBS ; Ring bell if buffer full - LD A,C ; Get character - LD (HL),C ; Save in buffer - LD (LSTBIN),A ; Save last input byte - INC HL ; Move up buffer - INC B ; Increment length -OUTIT: CALL OUTC ; Output the character entered - JP MORINP ; Get another character - -OUTNBS: CALL OUTC ; Output bell and back over it - LD A,BKSP ; Set back space - JP OUTIT ; Output it and get more - -CPDEHL: LD A,H ; Get H - SUB D ; Compare with D - RET NZ ; Different - Exit - LD A,L ; Get L - SUB E ; Compare with E - RET ; Return status - -CHKSYN: LD A,(HL) ; Check syntax of character - EX (SP),HL ; Address of test byte - CP (HL) ; Same as in code string? - INC HL ; Return address - EX (SP),HL ; Put it back - JP Z,GETCHR ; Yes - Get next character - JP SNERR ; Different - ?SN Error - -OUTC: PUSH AF ; Save character - LD A,(CTLOFG) ; Get control "O" flag - OR A ; Is it set? - JP NZ,POPAF ; Yes - don't output - POP AF ; Restore character - PUSH BC ; Save buffer length - PUSH AF ; Save character - CP ' ' ; Is it a control code? - JP C,DINPOS ; Yes - Don't INC POS(X) - LD A,(LWIDTH) ; Get line width - LD B,A ; To B - LD A,(CURPOS) ; Get cursor position - INC B ; Width 255? - JP Z,INCLEN ; Yes - No width limit - DEC B ; Restore width - CP B ; At end of line? - CALL Z,PRNTCRLF ; Yes - output CRLF -INCLEN: INC A ; Move on one character - LD (CURPOS),A ; Save new position -DINPOS: POP AF ; Restore character - POP BC ; Restore buffer length - CALL MONOUT ; Send it - RET - -CLOTST: CALL GETINP ; Get input character - AND 01111111B ; Strip bit 7 - CP CTRLO ; Is it control "O"? - RET NZ ; No don't flip flag - LD A,(CTLOFG) ; Get flag - CPL ; Flip it - LD (CTLOFG),A ; Put it back - XOR A ; Null character - RET - -LIST: CALL ATOH ; ASCII number to DE - RET NZ ; Return if anything extra - POP BC ; Rubbish - Not needed - CALL SRCHLN ; Search for line number in DE - PUSH BC ; Save address of line - CALL SETLIN ; Set up lines counter -LISTLP: POP HL ; Restore address of line - LD C,(HL) ; Get LSB of next line - INC HL - LD B,(HL) ; Get MSB of next line - INC HL - LD A,B ; BC = 0 (End of program)? - OR C - JP Z,PRNTOK ; Yes - Go to command mode - CALL COUNT ; Count lines - CALL TSTBRK ; Test for break key - PUSH BC ; Save address of next line - CALL PRNTCRLF ; Output CRLF - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - INC HL - PUSH HL ; Save address of line start - EX DE,HL ; Line number to HL - CALL PRNTHL ; Output line number in decimal - LD A,' ' ; Space after line number - POP HL ; Restore start of line address -LSTLP2: CALL OUTC ; Output character in A -LSTLP3: LD A,(HL) ; Get next byte in line - OR A ; End of line? - INC HL ; To next byte in line - JP Z,LISTLP ; Yes - get next line - JP P,LSTLP2 ; No token - output it - SUB ZEND-1 ; Find and output word - LD C,A ; Token offset+1 to C - LD DE,WORDS ; Reserved word list -FNDTOK: LD A,(DE) ; Get character in list - INC DE ; Move on to next - OR A ; Is it start of word? - JP P,FNDTOK ; No - Keep looking for word - DEC C ; Count words - JP NZ,FNDTOK ; Not there - keep looking -OUTWRD: AND 01111111B ; Strip bit 7 - CALL OUTC ; Output first character - LD A,(DE) ; Get next character - INC DE ; Move on to next - OR A ; Is it end of word? - JP P,OUTWRD ; No - output the rest - JP LSTLP3 ; Next byte in line - -SETLIN: PUSH HL ; Set up LINES counter - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Save in LINES counter - POP HL - RET - -COUNT: PUSH HL ; Save code string address - PUSH DE - LD HL,(LINESC) ; Get LINES counter - LD DE,-1 - ADC HL,DE ; Decrement - LD (LINESC),HL ; Put it back - POP DE - POP HL ; Restore code string address - RET P ; Return if more lines to go - PUSH HL ; Save code string address - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - CALL GETINP ; Get input character - CP CTRLC ; Is it control "C"? - JP Z,RSLNBK ; Yes - Reset LINES and break - POP HL ; Restore code string address - JP COUNT ; Keep on counting - -RSLNBK: LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - JP BRKRET ; Go and output "Break" - -FOR: LD A,64H ; Flag "FOR" assignment - LD (FORFLG),A ; Save "FOR" flag - CALL LET ; Set up initial index - POP BC ; Drop RETurn address - PUSH HL ; Save code string address - CALL DATA ; Get next statement address - LD (LOOPST),HL ; Save it for start of loop - LD HL,2 ; Offset for "FOR" block - ADD HL,SP ; Point to it -FORSLP: CALL LOKFOR ; Look for existing "FOR" block - POP DE ; Get code string address - JP NZ,FORFND ; No nesting found - ADD HL,BC ; Move into "FOR" block - PUSH DE ; Save code string address - DEC HL - LD D,(HL) ; Get MSB of loop statement - DEC HL - LD E,(HL) ; Get LSB of loop statement - INC HL - INC HL - PUSH HL ; Save block address - LD HL,(LOOPST) ; Get address of loop statement - CALL CPDEHL ; Compare the FOR loops - POP HL ; Restore block address - JP NZ,FORSLP ; Different FORs - Find another - POP DE ; Restore code string address - LD SP,HL ; Remove all nested loops - -FORFND: EX DE,HL ; Code string address to HL - LD C,8 - CALL CHKSTK ; Check for 8 levels of stack - PUSH HL ; Save code string address - LD HL,(LOOPST) ; Get first statement of loop - EX (SP),HL ; Save and restore code string - PUSH HL ; Re-save code string address - LD HL,(LINEAT) ; Get current line number - EX (SP),HL ; Save and restore code string - CALL TSTNUM ; Make sure it's a number - CALL CHKSYN ; Make sure "TO" is next - .BYTE ZTO ; "TO" token - CALL GETNUM ; Get "TO" expression value - PUSH HL ; Save code string address - CALL BCDEFP ; Move "TO" value to BCDE - POP HL ; Restore code string address - PUSH BC ; Save "TO" value in block - PUSH DE - LD BC,8100H ; BCDE - 1 (default STEP) - LD D,C ; C=0 - LD E,D ; D=0 - LD A,(HL) ; Get next byte in code string - CP ZSTEP ; See if "STEP" is stated - LD A,1 ; Sign of step = 1 - JP NZ,SAVSTP ; No STEP given - Default to 1 - CALL GETCHR ; Jump over "STEP" token - CALL GETNUM ; Get step value - PUSH HL ; Save code string address - CALL BCDEFP ; Move STEP to BCDE - CALL TSTSGN ; Test sign of FPREG - POP HL ; Restore code string address -SAVSTP: PUSH BC ; Save the STEP value in block - PUSH DE - PUSH AF ; Save sign of STEP - INC SP ; Don't save flags - PUSH HL ; Save code string address - LD HL,(BRKLIN) ; Get address of index variable - EX (SP),HL ; Save and restore code string -PUTFID: LD B,ZFOR ; "FOR" block marker - PUSH BC ; Save it - INC SP ; Don't save C - -RUNCNT: CALL TSTBRK ; Execution driver - Test break - LD (BRKLIN),HL ; Save code address for break - LD A,(HL) ; Get next byte in code string - CP ':' ; Multi statement line? - JP Z,EXCUTE ; Yes - Execute it - OR A ; End of line? - JP NZ,SNERR ; No - Syntax error - INC HL ; Point to address of next line - LD A,(HL) ; Get LSB of line pointer - INC HL - OR (HL) ; Is it zero (End of prog)? - JP Z,ENDPRG ; Yes - Terminate execution - INC HL ; Point to line number - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - EX DE,HL ; Line number to HL - LD (LINEAT),HL ; Save as current line number - EX DE,HL ; Line number back to DE -EXCUTE: CALL GETCHR ; Get key word - LD DE,RUNCNT ; Where to RETurn to - PUSH DE ; Save for RETurn -IFJMP: RET Z ; Go to RUNCNT if end of STMT -ONJMP: SUB ZEND ; Is it a token? - JP C,LET ; No - try to assign it - CP ZNEW+1-ZEND ; END to NEW ? - JP NC,SNERR ; Not a key word - ?SN Error - RLCA ; Double it - LD C,A ; BC = Offset into table - LD B,0 - EX DE,HL ; Save code string address - LD HL,WORDTB ; Keyword address table - ADD HL,BC ; Point to routine address - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - PUSH BC ; Save routine address - EX DE,HL ; Restore code string address - -GETCHR: INC HL ; Point to next character - LD A,(HL) ; Get next code string byte - CP ':' ; Z if ':' - RET NC ; NC if > "9" - CP ' ' - JP Z,GETCHR ; Skip over spaces - CP '0' - CCF ; NC if < '0' - INC A ; Test for zero - Leave carry - DEC A ; Z if Null - RET - -RESTOR: EX DE,HL ; Save code string address - LD HL,(BASTXT) ; Point to start of program - JP Z,RESTNL ; Just RESTORE - reset pointer - EX DE,HL ; Restore code string address - CALL ATOH ; Get line number to DE - PUSH HL ; Save code string address - CALL SRCHLN ; Search for line number in DE - LD H,B ; HL = Address of line - LD L,C - POP DE ; Restore code string address - JP NC,ULERR ; ?UL Error if not found -RESTNL: DEC HL ; Byte before DATA statement -UPDATA: LD (NXTDAT),HL ; Update DATA pointer - EX DE,HL ; Restore code string address - RET - - -TSTBRK: ;RST 18H ; Check input status - CALL MC_BIOS_TRY_GETC - OR A - RET Z ; No key, go back - ;RST 10H ; Get the key into A - CP ESC ; Escape key? - JR Z,BRK ; Yes, break - CP CTRLC ; - JR Z,BRK ; Yes, break - CP CTRLS ; Stop scrolling? - RET NZ ; Other key, ignore - - -STALL: ;RST 10H ; Wait for key - CALL MC_BIOS_GETC - CP CTRLQ ; Resume scrolling? - RET Z ; Release the chokehold - CP CTRLC ; Second break? - JR Z,STOP ; Break during hold exits prog - JR STALL ; Loop until or - -BRK LD A,$FF ; Set BRKFLG - LD (BRKFLG),A ; Store it - - -STOP: RET NZ ; Exit if anything else - .BYTE 0F6H ; Flag "STOP" -PEND: RET NZ ; Exit if anything else - LD (BRKLIN),HL ; Save point of break - .BYTE 21H ; Skip "OR 11111111B" -INPBRK: OR 11111111B ; Flag "Break" wanted - POP BC ; Return not needed and more -ENDPRG: LD HL,(LINEAT) ; Get current line number - PUSH AF ; Save STOP / END status - LD A,L ; Is it direct break? - AND H - INC A ; Line is -1 if direct break - JP Z,NOLIN ; Yes - No line number - LD (ERRLIN),HL ; Save line of break - LD HL,(BRKLIN) ; Get point of break - LD (CONTAD),HL ; Save point to CONTinue -NOLIN: XOR A - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start a new line - POP AF ; Restore STOP / END status - LD HL,BRKMSG ; "Break" message - JP NZ,ERRIN ; "in line" wanted? - JP PRNTOK ; Go to command mode - -CONT: LD HL,(CONTAD) ; Get CONTinue address - LD A,H ; Is it zero? - OR L - LD E,CN ; ?CN Error - JP Z,ERROR ; Yes - output "?CN Error" - EX DE,HL ; Save code string address - LD HL,(ERRLIN) ; Get line of last break - LD (LINEAT),HL ; Set up current line number - EX DE,HL ; Restore code string address - RET ; CONTinue where left off - -NULL: CALL GETINT ; Get integer 0-255 - RET NZ ; Return if bad value - LD (NULLS),A ; Set nulls number - RET - - -ACCSUM: PUSH HL ; Save address in array - LD HL,(CHKSUM) ; Get check sum - LD B,0 ; BC - Value of byte - LD C,A - ADD HL,BC ; Add byte to check sum - LD (CHKSUM),HL ; Re-save check sum - POP HL ; Restore address in array - RET - -CHKLTR: LD A,(HL) ; Get byte - CP 'A' ; < 'a' ? - RET C ; Carry set if not letter - CP 'Z'+1 ; > 'z' ? - CCF - RET ; Carry set if not letter - -FPSINT: CALL GETCHR ; Get next character -POSINT: CALL GETNUM ; Get integer 0 to 32767 -DEPINT: CALL TSTSGN ; Test sign of FPREG - JP M,FCERR ; Negative - ?FC Error -DEINT: LD A,(FPEXP) ; Get integer value to DE - CP 80H+16 ; Exponent in range (16 bits)? - JP C,FPINT ; Yes - convert it - LD BC,9080H ; BCDE = -32768 - LD DE,0000 - PUSH HL ; Save code string address - CALL CMPNUM ; Compare FPREG with BCDE - POP HL ; Restore code string address - LD D,C ; MSB to D - RET Z ; Return if in range -FCERR: LD E,FC ; ?FC Error - JP ERROR ; Output error- - -ATOH: DEC HL ; ASCII number to DE binary -GETLN: LD DE,0 ; Get number to DE -GTLNLP: CALL GETCHR ; Get next character - RET NC ; Exit if not a digit - PUSH HL ; Save code string address - PUSH AF ; Save digit - LD HL,65529/10 ; Largest number 65529 - CALL CPDEHL ; Number in range? - JP C,SNERR ; No - ?SN Error - LD H,D ; HL = Number - LD L,E - ADD HL,DE ; Times 2 - ADD HL,HL ; Times 4 - ADD HL,DE ; Times 5 - ADD HL,HL ; Times 10 - POP AF ; Restore digit - SUB '0' ; Make it 0 to 9 - LD E,A ; DE = Value of digit - LD D,0 - ADD HL,DE ; Add to number - EX DE,HL ; Number to DE - POP HL ; Restore code string address - JP GTLNLP ; Go to next character - -CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters - CALL POSINT ; Get integer 0 to 32767 to DE - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - PUSH HL ; Save code string address - LD HL,(LSTRAM) ; Get end of RAM - JP Z,STORED ; No value given - Use stored - POP HL ; Restore code string address - CALL CHKSYN ; Check for comma - .BYTE ',' - PUSH DE ; Save number - CALL POSINT ; Get integer 0 to 32767 - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - JP NZ,SNERR ; ?SN Error if more on line - EX (SP),HL ; Save code string address - EX DE,HL ; Number to DE -STORED: LD A,L ; Get LSB of new RAM top - SUB E ; Subtract LSB of string space - LD E,A ; Save LSB - LD A,H ; Get MSB of new RAM top - SBC A,D ; Subtract MSB of string space - LD D,A ; Save MSB - JP C,OMERR ; ?OM Error if not enough mem - PUSH HL ; Save RAM top - LD HL,(PROGND) ; Get program end - LD BC,40 ; 40 Bytes minimum working RAM - ADD HL,BC ; Get lowest address - CALL CPDEHL ; Enough memory? - JP NC,OMERR ; No - ?OM Error - EX DE,HL ; RAM top to HL - LD (STRSPC),HL ; Set new string space - POP HL ; End of memory to use - LD (LSTRAM),HL ; Set new top of RAM - POP HL ; Restore code string address - JP INTVAR ; Initialise variables - -RUN: JP Z,RUNFST ; RUN from start if just RUN - CALL INTVAR ; Initialise variables - LD BC,RUNCNT ; Execution driver loop - JP RUNLIN ; RUN from line number - -GOSUB: LD C,3 ; 3 Levels of stack needed - CALL CHKSTK ; Check for 3 levels of stack - POP BC ; Get return address - PUSH HL ; Save code string for RETURN - PUSH HL ; And for GOSUB routine - LD HL,(LINEAT) ; Get current line - EX (SP),HL ; Into stack - Code string out - LD A,ZGOSUB ; "GOSUB" token - PUSH AF ; Save token - INC SP ; Don't save flags - -RUNLIN: PUSH BC ; Save return address -GOTO: CALL ATOH ; ASCII number to DE binary - CALL REM ; Get end of line - PUSH HL ; Save end of line - LD HL,(LINEAT) ; Get current line - CALL CPDEHL ; Line after current? - POP HL ; Restore end of line - INC HL ; Start of next line - CALL C,SRCHLP ; Line is after current line - CALL NC,SRCHLN ; Line is before current line - LD H,B ; Set up code string address - LD L,C - DEC HL ; Incremented after - RET C ; Line found -ULERR: LD E,UL ; ?UL Error - JP ERROR ; Output error message - -RETURN: RET NZ ; Return if not just RETURN - LD D,-1 ; Flag "GOSUB" search - CALL BAKSTK ; Look "GOSUB" block - LD SP,HL ; Kill all FORs in subroutine - CP ZGOSUB ; Test for "GOSUB" token - LD E,RG ; ?RG Error - JP NZ,ERROR ; Error if no "GOSUB" found - POP HL ; Get RETURN line number - LD (LINEAT),HL ; Save as current - INC HL ; Was it from direct statement? - LD A,H - OR L ; Return to line - JP NZ,RETLIN ; No - Return to line - LD A,(LSTBIN) ; Any INPUT in subroutine? - OR A ; If so buffer is corrupted - JP NZ,POPNOK ; Yes - Go to command mode -RETLIN: LD HL,RUNCNT ; Execution driver loop - EX (SP),HL ; Into stack - Code string out - .BYTE 3EH ; Skip "POP HL" -NXTDTA: POP HL ; Restore code string address - -DATA: .BYTE 01H,3AH ; ':' End of statement -REM: LD C,0 ; 00 End of statement - LD B,0 -NXTSTL: LD A,C ; Statement and byte - LD C,B - LD B,A ; Statement end byte -NXTSTT: LD A,(HL) ; Get byte - OR A ; End of line? - RET Z ; Yes - Exit - CP B ; End of statement? - RET Z ; Yes - Exit - INC HL ; Next byte - CP '"' ; Literal string? - JP Z,NXTSTL ; Yes - Look for another '"' - JP NXTSTT ; Keep looking - -LET: CALL GETVAR ; Get variable name - CALL CHKSYN ; Make sure "=" follows - .BYTE ZEQUAL ; "=" token - PUSH DE ; Save address of variable - LD A,(TYPE) ; Get data type - PUSH AF ; Save type - CALL EVAL ; Evaluate expression - POP AF ; Restore type - EX (SP),HL ; Save code - Get var addr - LD (BRKLIN),HL ; Save address of variable - RRA ; Adjust type - CALL CHKTYP ; Check types are the same - JP Z,LETNUM ; Numeric - Move value -LETSTR: PUSH HL ; Save address of string var - LD HL,(FPREG) ; Pointer to string entry - PUSH HL ; Save it on stack - INC HL ; Skip over length - INC HL - LD E,(HL) ; LSB of string address - INC HL - LD D,(HL) ; MSB of string address - LD HL,(BASTXT) ; Point to start of program - CALL CPDEHL ; Is string before program? - JP NC,CRESTR ; Yes - Create string entry - LD HL,(STRSPC) ; Point to string space - CALL CPDEHL ; Is string literal in program? - POP DE ; Restore address of string - JP NC,MVSTPT ; Yes - Set up pointer - LD HL,TMPSTR ; Temporary string pool - CALL CPDEHL ; Is string in temporary pool? - JP NC,MVSTPT ; No - Set up pointer - .BYTE 3EH ; Skip "POP DE" -CRESTR: POP DE ; Restore address of string - CALL BAKTMP ; Back to last tmp-str entry - EX DE,HL ; Address of string entry - CALL SAVSTR ; Save string in string area -MVSTPT: CALL BAKTMP ; Back to last tmp-str entry - POP HL ; Get string pointer - CALL DETHL4 ; Move string pointer to var - POP HL ; Restore code string address - RET - -LETNUM: PUSH HL ; Save address of variable - CALL FPTHL ; Move value to variable - POP DE ; Restore address of variable - POP HL ; Restore code string address - RET - -ON: CALL GETINT ; Get integer 0-255 - LD A,(HL) ; Get "GOTO" or "GOSUB" token - LD B,A ; Save in B - CP ZGOSUB ; "GOSUB" token? - JP Z,ONGO ; Yes - Find line number - CALL CHKSYN ; Make sure it's "GOTO" - .BYTE ZGOTO ; "GOTO" token - DEC HL ; Cancel increment -ONGO: LD C,E ; Integer of branch value -ONGOLP: DEC C ; Count branches - LD A,B ; Get "GOTO" or "GOSUB" token - JP Z,ONJMP ; Go to that line if right one - CALL GETLN ; Get line number to DE - CP ',' ; Another line number? - RET NZ ; No - Drop through - JP ONGOLP ; Yes - loop - -IF: CALL EVAL ; Evaluate expression - LD A,(HL) ; Get token - CP ZGOTO ; "GOTO" token? - JP Z,IFGO ; Yes - Get line - CALL CHKSYN ; Make sure it's "THEN" - .BYTE ZTHEN ; "THEN" token - DEC HL ; Cancel increment -IFGO: CALL TSTNUM ; Make sure it's numeric - CALL TSTSGN ; Test state of expression - JP Z,REM ; False - Drop through - CALL GETCHR ; Get next character - JP C,GOTO ; Number - GOTO that line - JP IFJMP ; Otherwise do statement - -MRPRNT: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character -PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT -PRNTLP: RET Z ; End of list - Exit - CP ZTAB ; "TAB(" token? - JP Z,DOTAB ; Yes - Do TAB routine - CP ZSPC ; "SPC(" token? - JP Z,DOTAB ; Yes - Do SPC routine - PUSH HL ; Save code string address - CP ',' ; Comma? - JP Z,DOCOM ; Yes - Move to next zone - CP 59 ;";" ; Semi-colon? - JP Z,NEXITM ; Do semi-colon routine - POP BC ; Code string address to BC - CALL EVAL ; Evaluate expression - PUSH HL ; Save code string address - LD A,(TYPE) ; Get variable type - OR A ; Is it a string variable? - JP NZ,PRNTST ; Yes - Output string contents - CALL NUMASC ; Convert number to text - CALL CRTST ; Create temporary string - LD (HL),' ' ; Followed by a space - LD HL,(FPREG) ; Get length of output - INC (HL) ; Plus 1 for the space - LD HL,(FPREG) ; < Not needed > - LD A,(LWIDTH) ; Get width of line - LD B,A ; To B - INC B ; Width 255 (No limit)? - JP Z,PRNTNB ; Yes - Output number string - INC B ; Adjust it - LD A,(CURPOS) ; Get cursor position - ADD A,(HL) ; Add length of string - DEC A ; Adjust it - CP B ; Will output fit on this line? - CALL NC,PRNTCRLF ; No - CRLF first -PRNTNB: CALL PRS1 ; Output string at (HL) - XOR A ; Skip CALL by setting 'z' flag -PRNTST: CALL NZ,PRS1 ; Output string at (HL) - POP HL ; Restore code string address - JP MRPRNT ; See if more to PRINT - -STTLIN: LD A,(CURPOS) ; Make sure on new line - OR A ; Already at start? - RET Z ; Yes - Do nothing - JP PRNTCRLF ; Start a new line - -ENDINP: LD (HL),0 ; Mark end of buffer - LD HL,BUFFER-1 ; Point to buffer -PRNTCRLF: LD A,CR ; Load a CR - CALL OUTC ; Output character - LD A,LF ; Load a LF - CALL OUTC ; Output character -DONULL: XOR A ; Set to position 0 - LD (CURPOS),A ; Store it - LD A,(NULLS) ; Get number of nulls -NULLP: DEC A ; Count them - RET Z ; Return if done - PUSH AF ; Save count - XOR A ; Load a null - CALL OUTC ; Output it - POP AF ; Restore count - JP NULLP ; Keep counting - -DOCOM: LD A,(COMMAN) ; Get comma width - LD B,A ; Save in B - LD A,(CURPOS) ; Get current position - CP B ; Within the limit? - CALL NC,PRNTCRLF ; No - output CRLF - JP NC,NEXITM ; Get next item -ZONELP: SUB 14 ; Next zone of 14 characters - JP NC,ZONELP ; Repeat if more zones - CPL ; Number of spaces to output - JP ASPCS ; Output them - -DOTAB: PUSH AF ; Save token - CALL FNDNUM ; Evaluate expression - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - DEC HL ; Back space on to ")" - POP AF ; Restore token - SUB ZSPC ; Was it "SPC(" ? - PUSH HL ; Save code string address - JP Z,DOSPC ; Yes - Do 'E' spaces - LD A,(CURPOS) ; Get current position -DOSPC: CPL ; Number of spaces to print to - ADD A,E ; Total number to print - JP NC,NEXITM ; TAB < Current POS(X) -ASPCS: INC A ; Output A spaces - LD B,A ; Save number to print - LD A,' ' ; Space -SPCLP: CALL OUTC ; Output character in A - DEC B ; Count them - JP NZ,SPCLP ; Repeat if more -NEXITM: POP HL ; Restore code string address - CALL GETCHR ; Get next character - JP PRNTLP ; More to print - -REDO: .BYTE "?Redo from start",CR,LF,0 - -BADINP: LD A,(READFG) ; READ or INPUT? - OR A - JP NZ,DATSNR ; READ - ?SN Error - POP BC ; Throw away code string addr - LD HL,REDO ; "Redo from start" message - CALL PRS ; Output string - JP DOAGN ; Do last INPUT again - -INPUT: CALL IDTEST ; Test for illegal direct - LD A,(HL) ; Get character after "INPUT" - CP '"' ; Is there a prompt string? - LD A,0 ; Clear A and leave flags - LD (CTLOFG),A ; Enable output - JP NZ,NOPMPT ; No prompt - get input - CALL QTSTR ; Get string terminated by '"' - CALL CHKSYN ; Check for ';' after prompt - .BYTE ';' - PUSH HL ; Save code string address - CALL PRS1 ; Output prompt string - .BYTE 3EH ; Skip "PUSH HL" -NOPMPT: PUSH HL ; Save code string address - CALL PROMPT ; Get input with "? " prompt - POP BC ; Restore code string address - JP C,INPBRK ; Break pressed - Exit - INC HL ; Next byte - LD A,(HL) ; Get it - OR A ; End of line? - DEC HL ; Back again - PUSH BC ; Re-save code string address - JP Z,NXTDTA ; Yes - Find next DATA stmt - LD (HL),',' ; Store comma as separator - JP NXTITM ; Get next item - -READ: PUSH HL ; Save code string address - LD HL,(NXTDAT) ; Next DATA statement - .BYTE 0F6H ; Flag "READ" -NXTITM: XOR A ; Flag "INPUT" - LD (READFG),A ; Save "READ"/"INPUT" flag - EX (SP),HL ; Get code str' , Save pointer - JP GTVLUS ; Get values - -NEDMOR: CALL CHKSYN ; Check for comma between items - .BYTE ',' -GTVLUS: CALL GETVAR ; Get variable name - EX (SP),HL ; Save code str" , Get pointer - PUSH DE ; Save variable address - LD A,(HL) ; Get next "INPUT"/"DATA" byte - CP ',' ; Comma? - JP Z,ANTVLU ; Yes - Get another value - LD A,(READFG) ; Is it READ? - OR A - JP NZ,FDTLP ; Yes - Find next DATA stmt - LD A,'?' ; More INPUT needed - CALL OUTC ; Output character - CALL PROMPT ; Get INPUT with prompt - POP DE ; Variable address - POP BC ; Code string address - JP C,INPBRK ; Break pressed - INC HL ; Point to next DATA byte - LD A,(HL) ; Get byte - OR A ; Is it zero (No input) ? - DEC HL ; Back space INPUT pointer - PUSH BC ; Save code string address - JP Z,NXTDTA ; Find end of buffer - PUSH DE ; Save variable address -ANTVLU: LD A,(TYPE) ; Check data type - OR A ; Is it numeric? - JP Z,INPBIN ; Yes - Convert to binary - CALL GETCHR ; Get next character - LD D,A ; Save input character - LD B,A ; Again - CP '"' ; Start of literal sting? - JP Z,STRENT ; Yes - Create string entry - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - LD D,A ; Save 00 if "INPUT" - JP Z,ITMSEP ; "INPUT" - End with 00 - LD D,':' ; "DATA" - End with 00 or ':' -ITMSEP: LD B,',' ; Item separator - DEC HL ; Back space for DTSTR -STRENT: CALL DTSTR ; Get string terminated by D - EX DE,HL ; String address to DE - LD HL,LTSTND ; Where to go after LETSTR - EX (SP),HL ; Save HL , get input pointer - PUSH DE ; Save address of string - JP LETSTR ; Assign string to variable - -INPBIN: CALL GETCHR ; Get next character - CALL ASCTFP ; Convert ASCII to FP number - EX (SP),HL ; Save input ptr, Get var addr - CALL FPTHL ; Move FPREG to variable - POP HL ; Restore input pointer -LTSTND: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,MORDT ; End of line - More needed? - CP ',' ; Another value? - JP NZ,BADINP ; No - Bad input -MORDT: EX (SP),HL ; Get code string address - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,NEDMOR ; More needed - Get it - POP DE ; Restore DATA pointer - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - EX DE,HL ; DATA pointer to HL - JP NZ,UPDATA ; Update DATA pointer if "READ" - PUSH DE ; Save code string address - OR (HL) ; More input given? - LD HL,EXTIG ; "?Extra ignored" message - CALL NZ,PRS ; Output string if extra given - POP HL ; Restore code string address - RET - -EXTIG: .BYTE "?Extra ignored",CR,LF,0 - -FDTLP: CALL DATA ; Get next statement - OR A ; End of line? - JP NZ,FANDT ; No - See if DATA statement - INC HL - LD A,(HL) ; End of program? - INC HL - OR (HL) ; 00 00 Ends program - LD E,OD ; ?OD Error - JP Z,ERROR ; Yes - Out of DATA - INC HL - LD E,(HL) ; LSB of line number - INC HL - LD D,(HL) ; MSB of line number - EX DE,HL - LD (DATLIN),HL ; Set line of current DATA item - EX DE,HL -FANDT: CALL GETCHR ; Get next character - CP ZDATA ; "DATA" token - JP NZ,FDTLP ; No "DATA" - Keep looking - JP ANTVLU ; Found - Convert input - -NEXT: LD DE,0 ; In case no index given -NEXT1: CALL NZ,GETVAR ; Get index address - LD (BRKLIN),HL ; Save code string address - CALL BAKSTK ; Look for "FOR" block - JP NZ,NFERR ; No "FOR" - ?NF Error - LD SP,HL ; Clear nested loops - PUSH DE ; Save index address - LD A,(HL) ; Get sign of STEP - INC HL - PUSH AF ; Save sign of STEP - PUSH DE ; Save index address - CALL PHLTFP ; Move index value to FPREG - EX (SP),HL ; Save address of TO value - PUSH HL ; Save address of index - CALL ADDPHL ; Add STEP to index value - POP HL ; Restore address of index - CALL FPTHL ; Move value to index variable - POP HL ; Restore address of TO value - CALL LOADFP ; Move TO value to BCDE - PUSH HL ; Save address of line of FOR - CALL CMPNUM ; Compare index with TO value - POP HL ; Restore address of line num - POP BC ; Address of sign of STEP - SUB B ; Compare with expected sign - CALL LOADFP ; BC = Loop stmt,DE = Line num - JP Z,KILFOR ; Loop finished - Terminate it - EX DE,HL ; Loop statement line number - LD (LINEAT),HL ; Set loop line number - LD L,C ; Set code string to loop - LD H,B - JP PUTFID ; Put back "FOR" and continue - -KILFOR: LD SP,HL ; Remove "FOR" block - LD HL,(BRKLIN) ; Code string after "NEXT" - LD A,(HL) ; Get next byte in code string - CP ',' ; More NEXTs ? - JP NZ,RUNCNT ; No - Do next statement - CALL GETCHR ; Position to index name - CALL NEXT1 ; Re-enter NEXT routine -; < will not RETurn to here , Exit to RUNCNT or Loop > - -GETNUM: CALL EVAL ; Get a numeric expression -TSTNUM: .BYTE 0F6H ; Clear carry (numeric) -TSTSTR: SCF ; Set carry (string) -CHKTYP: LD A,(TYPE) ; Check types match - ADC A,A ; Expected + actual - OR A ; Clear carry , set parity - RET PE ; Even parity - Types match - JP TMERR ; Different types - Error - -OPNPAR: CALL CHKSYN ; Make sure "(" follows - .BYTE "(" -EVAL: DEC HL ; Evaluate expression & save - LD D,0 ; Precedence value -EVAL1: PUSH DE ; Save precedence - LD C,1 - CALL CHKSTK ; Check for 1 level of stack - CALL OPRND ; Get next expression value -EVAL2: LD (NXTOPR),HL ; Save address of next operator -EVAL3: LD HL,(NXTOPR) ; Restore address of next opr - POP BC ; Precedence value and operator - LD A,B ; Get precedence value - CP 78H ; "AND" or "OR" ? - CALL NC,TSTNUM ; No - Make sure it's a number - LD A,(HL) ; Get next operator / function - LD D,0 ; Clear Last relation -RLTLP: SUB ZGTR ; ">" Token - JP C,FOPRND ; + - * / ^ AND OR - Test it - CP ZLTH+1-ZGTR ; < = > - JP NC,FOPRND ; Function - Call it - CP ZEQUAL-ZGTR ; "=" - RLA ; <- Test for legal - XOR D ; <- combinations of < = > - CP D ; <- by combining last token - LD D,A ; <- with current one - JP C,SNERR ; Error if "<<' '==" or ">>" - LD (CUROPR),HL ; Save address of current token - CALL GETCHR ; Get next character - JP RLTLP ; Treat the two as one - -FOPRND: LD A,D ; < = > found ? - OR A - JP NZ,TSTRED ; Yes - Test for reduction - LD A,(HL) ; Get operator token - LD (CUROPR),HL ; Save operator address - SUB ZPLUS ; Operator or function? - RET C ; Neither - Exit - CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? - RET NC ; No - Exit - LD E,A ; Coded operator - LD A,(TYPE) ; Get data type - DEC A ; FF = numeric , 00 = string - OR E ; Combine with coded operator - LD A,E ; Get coded operator - JP Z,CONCAT ; String concatenation - RLCA ; Times 2 - ADD A,E ; Times 3 - LD E,A ; To DE (D is 0) - LD HL,PRITAB ; Precedence table - ADD HL,DE ; To the operator concerned - LD A,B ; Last operator precedence - LD D,(HL) ; Get evaluation precedence - CP D ; Compare with eval precedence - RET NC ; Exit if higher precedence - INC HL ; Point to routine address - CALL TSTNUM ; Make sure it's a number - -STKTHS: PUSH BC ; Save last precedence & token - LD BC,EVAL3 ; Where to go on prec' break - PUSH BC ; Save on stack for return - LD B,E ; Save operator - LD C,D ; Save precedence - CALL STAKFP ; Move value to stack - LD E,B ; Restore operator - LD D,C ; Restore precedence - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - INC HL - PUSH BC ; Save routine address - LD HL,(CUROPR) ; Address of current operator - JP EVAL1 ; Loop until prec' break - -OPRND: XOR A ; Get operand routine - LD (TYPE),A ; Set numeric expected - CALL GETCHR ; Get next character - LD E,MO ; ?MO Error - JP Z,ERROR ; No operand - Error - JP C,ASCTFP ; Number - Get value - CALL CHKLTR ; See if a letter - JP NC,CONVAR ; Letter - Find variable - CP '&' ; &H = HEX, &B = BINARY - JR NZ, NOTAMP - CALL GETCHR ; Get next character - CP 'H' ; Hex number indicated? [function added] - JP Z,HEXTFP ; Convert Hex to FPREG - CP 'B' ; Binary number indicated? [function added] - JP Z,BINTFP ; Convert Bin to FPREG - LD E,SN ; If neither then a ?SN Error - JP Z,ERROR ; -NOTAMP: CP ZPLUS ; '+' Token ? - JP Z,OPRND ; Yes - Look for operand - CP '.' ; '.' ? - JP Z,ASCTFP ; Yes - Create FP number - CP ZMINUS ; '-' Token ? - JP Z,MINUS ; Yes - Do minus - CP '"' ; Literal string ? - JP Z,QTSTR ; Get string terminated by '"' - CP ZNOT ; "NOT" Token ? - JP Z,EVNOT ; Yes - Eval NOT expression - CP ZFN ; "FN" Token ? - JP Z,DOFN ; Yes - Do FN routine - SUB ZSGN ; Is it a function? - JP NC,FNOFST ; Yes - Evaluate function -EVLPAR: CALL OPNPAR ; Evaluate expression in "()" - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - RET - -MINUS: LD D,7DH ; '-' precedence - CALL EVAL1 ; Evaluate until prec' break - LD HL,(NXTOPR) ; Get next operator address - PUSH HL ; Save next operator address - CALL INVSGN ; Negate value -RETNUM: CALL TSTNUM ; Make sure it's a number - POP HL ; Restore next operator address - RET - -CONVAR: CALL GETVAR ; Get variable address to DE -FRMEVL: PUSH HL ; Save code string address - EX DE,HL ; Variable address to HL - LD (FPREG),HL ; Save address of variable - LD A,(TYPE) ; Get type - OR A ; Numeric? - CALL Z,PHLTFP ; Yes - Move contents to FPREG - POP HL ; Restore code string address - RET - -FNOFST: LD B,0 ; Get address of function - RLCA ; Double function offset - LD C,A ; BC = Offset in function table - PUSH BC ; Save adjusted token value - CALL GETCHR ; Get next character - LD A,C ; Get adjusted token value - CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? - JP C,FNVAL ; No - Do function - CALL OPNPAR ; Evaluate expression (X,... - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL TSTSTR ; Make sure it's a string - EX DE,HL ; Save code string address - LD HL,(FPREG) ; Get address of string - EX (SP),HL ; Save address of string - PUSH HL ; Save adjusted token value - EX DE,HL ; Restore code string address - CALL GETINT ; Get integer 0-255 - EX DE,HL ; Save code string address - EX (SP),HL ; Save integer,HL = adj' token - JP GOFUNC ; Jump to string function - -FNVAL: CALL EVLPAR ; Evaluate expression - EX (SP),HL ; HL = Adjusted token value - LD DE,RETNUM ; Return number from function - PUSH DE ; Save on stack -GOFUNC: LD BC,FNCTAB ; Function routine addresses - ADD HL,BC ; Point to right address - LD C,(HL) ; Get LSB of address - INC HL ; - LD H,(HL) ; Get MSB of address - LD L,C ; Address to HL - JP (HL) ; Jump to function - -SGNEXP: DEC D ; Dee to flag negative exponent - CP ZMINUS ; '-' token ? - RET Z ; Yes - Return - CP '-' ; '-' ASCII ? - RET Z ; Yes - Return - INC D ; Inc to flag positive exponent - CP '+' ; '+' ASCII ? - RET Z ; Yes - Return - CP ZPLUS ; '+' token ? - RET Z ; Yes - Return - DEC HL ; DEC 'cos GETCHR INCs - RET ; Return "NZ" - -POR: .BYTE 0F6H ; Flag "OR" -PAND: XOR A ; Flag "AND" - PUSH AF ; Save "AND" / "OR" flag - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - EX DE,HL ; <- Get last - POP BC ; <- value - EX (SP),HL ; <- from - EX DE,HL ; <- stack - CALL FPBCDE ; Move last value to FPREG - PUSH AF ; Save "AND" / "OR" flag - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - POP BC ; Get value - LD A,C ; Get LSB - LD HL,ACPASS ; Address of save AC as current - JP NZ,POR1 ; Jump if OR - AND E ; "AND" LSBs - LD C,A ; Save LSB - LD A,B ; Get MBS - AND D ; "AND" MSBs - JP (HL) ; Save AC as current (ACPASS) - -POR1: OR E ; "OR" LSBs - LD C,A ; Save LSB - LD A,B ; Get MSB - OR D ; "OR" MSBs - JP (HL) ; Save AC as current (ACPASS) - -TSTRED: LD HL,CMPLOG ; Logical compare routine - LD A,(TYPE) ; Get data type - RRA ; Carry set = string - LD A,D ; Get last precedence value - RLA ; Times 2 plus carry - LD E,A ; To E - LD D,64H ; Relational precedence - LD A,B ; Get current precedence - CP D ; Compare with last - RET NC ; Eval if last was rel' or log' - JP STKTHS ; Stack this one and get next - -CMPLOG: .WORD CMPLG1 ; Compare two values / strings -CMPLG1: LD A,C ; Get data type - OR A - RRA - POP BC ; Get last expression to BCDE - POP DE - PUSH AF ; Save status - CALL CHKTYP ; Check that types match - LD HL,CMPRES ; Result to comparison - PUSH HL ; Save for RETurn - JP Z,CMPNUM ; Compare values if numeric - XOR A ; Compare two strings - LD (TYPE),A ; Set type to numeric - PUSH DE ; Save string name - CALL GSTRCU ; Get current string - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - POP DE ; Restore string name - PUSH BC ; Save address of string - PUSH AF ; Save length of string - CALL GSTRDE ; Get second string - CALL LOADFP ; Get address of second string - POP AF ; Restore length of string 1 - LD D,A ; Length to D - POP HL ; Restore address of string 1 -CMPSTR: LD A,E ; Bytes of string 2 to do - OR D ; Bytes of string 1 to do - RET Z ; Exit if all bytes compared - LD A,D ; Get bytes of string 1 to do - SUB 1 - RET C ; Exit if end of string 1 - XOR A - CP E ; Bytes of string 2 to do - INC A - RET NC ; Exit if end of string 2 - DEC D ; Count bytes in string 1 - DEC E ; Count bytes in string 2 - LD A,(BC) ; Byte in string 2 - CP (HL) ; Compare to byte in string 1 - INC HL ; Move up string 1 - INC BC ; Move up string 2 - JP Z,CMPSTR ; Same - Try next bytes - CCF ; Flag difference (">" or "<") - JP FLGDIF ; "<" gives -1 , ">" gives +1 - -CMPRES: INC A ; Increment current value - ADC A,A ; Double plus carry - POP BC ; Get other value - AND B ; Combine them - ADD A,-1 ; Carry set if different - SBC A,A ; 00 - Equal , FF - Different - JP FLGREL ; Set current value & continue - -EVNOT: LD D,5AH ; Precedence value for "NOT" - CALL EVAL1 ; Eval until precedence break - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 - 32767 - LD A,E ; Get LSB - CPL ; Invert LSB - LD C,A ; Save "NOT" of LSB - LD A,D ; Get MSB - CPL ; Invert MSB - CALL ACPASS ; Save AC as current - POP BC ; Clean up stack - JP EVAL3 ; Continue evaluation - -DIMRET: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - RET Z ; End of DIM statement - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' -DIM: LD BC,DIMRET ; Return to "DIMRET" - PUSH BC ; Save on stack - .BYTE 0F6H ; Flag "Create" variable -GETVAR: XOR A ; Find variable address,to DE - LD (LCRFLG),A ; Set locate / create flag - LD B,(HL) ; Get First byte of name -GTFNAM: CALL CHKLTR ; See if a letter - JP C,SNERR ; ?SN Error if not a letter - XOR A - LD C,A ; Clear second byte of name - LD (TYPE),A ; Set type to numeric - CALL GETCHR ; Get next character - JP C,SVNAM2 ; Numeric - Save in name - CALL CHKLTR ; See if a letter - JP C,CHARTY ; Not a letter - Check type -SVNAM2: LD C,A ; Save second byte of name -ENDNAM: CALL GETCHR ; Get next character - JP C,ENDNAM ; Numeric - Get another - CALL CHKLTR ; See if a letter - JP NC,ENDNAM ; Letter - Get another -CHARTY: SUB '$' ; String variable? - JP NZ,NOTSTR ; No - Numeric variable - INC A ; A = 1 (string type) - LD (TYPE),A ; Set type to string - RRCA ; A = 80H , Flag for string - ADD A,C ; 2nd byte of name has bit 7 on - LD C,A ; Resave second byte on name - CALL GETCHR ; Get next character -NOTSTR: LD A,(FORFLG) ; Array name needed ? - DEC A - JP Z,ARLDSV ; Yes - Get array name - JP P,NSCFOR ; No array with "FOR" or "FN" - LD A,(HL) ; Get byte again - SUB '(' ; Subscripted variable? - JP Z,SBSCPT ; Yes - Sort out subscript - -NSCFOR: XOR A ; Simple variable - LD (FORFLG),A ; Clear "FOR" flag - PUSH HL ; Save code string address - LD D,B ; DE = Variable name to find - LD E,C - LD HL,(FNRGNM) ; FN argument name - CALL CPDEHL ; Is it the FN argument? - LD DE,FNARG ; Point to argument value - JP Z,POPHRT ; Yes - Return FN argument value - LD HL,(VAREND) ; End of variables - EX DE,HL ; Address of end of search - LD HL,(PROGND) ; Start of variables address -FNDVAR: CALL CPDEHL ; End of variable list table? - JP Z,CFEVAL ; Yes - Called from EVAL? - LD A,C ; Get second byte of name - SUB (HL) ; Compare with name in list - INC HL ; Move on to first byte - JP NZ,FNTHR ; Different - Find another - LD A,B ; Get first byte of name - SUB (HL) ; Compare with name in list -FNTHR: INC HL ; Move on to LSB of value - JP Z,RETADR ; Found - Return address - INC HL ; <- Skip - INC HL ; <- over - INC HL ; <- F.P. - INC HL ; <- value - JP FNDVAR ; Keep looking - -CFEVAL: POP HL ; Restore code string address - EX (SP),HL ; Get return address - PUSH DE ; Save address of variable - LD DE,FRMEVL ; Return address in EVAL - CALL CPDEHL ; Called from EVAL ? - POP DE ; Restore address of variable - JP Z,RETNUL ; Yes - Return null variable - EX (SP),HL ; Put back return - PUSH HL ; Save code string address - PUSH BC ; Save variable name - LD BC,6 ; 2 byte name plus 4 byte data - LD HL,(ARREND) ; End of arrays - PUSH HL ; Save end of arrays - ADD HL,BC ; Move up 6 bytes - POP BC ; Source address in BC - PUSH HL ; Save new end address - CALL MOVUP ; Move arrays up - POP HL ; Restore new end address - LD (ARREND),HL ; Set new end address - LD H,B ; End of variables to HL - LD L,C - LD (VAREND),HL ; Set new end address - -ZEROLP: DEC HL ; Back through to zero variable - LD (HL),0 ; Zero byte in variable - CALL CPDEHL ; Done them all? - JP NZ,ZEROLP ; No - Keep on going - POP DE ; Get variable name - LD (HL),E ; Store second character - INC HL - LD (HL),D ; Store first character - INC HL -RETADR: EX DE,HL ; Address of variable in DE - POP HL ; Restore code string address - RET - -RETNUL: LD (FPEXP),A ; Set result to zero - LD HL,ZERBYT ; Also set a null string - LD (FPREG),HL ; Save for EVAL - POP HL ; Restore code string address - RET - -SBSCPT: PUSH HL ; Save code string address - LD HL,(LCRFLG) ; Locate/Create and Type - EX (SP),HL ; Save and get code string - LD D,A ; Zero number of dimensions -SCPTLP: PUSH DE ; Save number of dimensions - PUSH BC ; Save array name - CALL FPSINT ; Get subscript (0-32767) - POP BC ; Restore array name - POP AF ; Get number of dimensions - EX DE,HL - EX (SP),HL ; Save subscript value - PUSH HL ; Save LCRFLG and TYPE - EX DE,HL - INC A ; Count dimensions - LD D,A ; Save in D - LD A,(HL) ; Get next byte in code string - CP ',' ; Comma (more to come)? - JP Z,SCPTLP ; Yes - More subscripts - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - LD (NXTOPR),HL ; Save code string address - POP HL ; Get LCRFLG and TYPE - LD (LCRFLG),HL ; Restore Locate/create & type - LD E,0 ; Flag not CSAVE* or CLOAD* - PUSH DE ; Save number of dimensions (D) - .BYTE 11H ; Skip "PUSH HL" and "PUSH AF' - -ARLDSV: PUSH HL ; Save code string address - PUSH AF ; A = 00 , Flags set = Z,N - LD HL,(VAREND) ; Start of arrays - .BYTE 3EH ; Skip "ADD HL,DE" -FNDARY: ADD HL,DE ; Move to next array start - EX DE,HL - LD HL,(ARREND) ; End of arrays - EX DE,HL ; Current array pointer - CALL CPDEHL ; End of arrays found? - JP Z,CREARY ; Yes - Create array - LD A,(HL) ; Get second byte of name - CP C ; Compare with name given - INC HL ; Move on - JP NZ,NXTARY ; Different - Find next array - LD A,(HL) ; Get first byte of name - CP B ; Compare with name given -NXTARY: INC HL ; Move on - LD E,(HL) ; Get LSB of next array address - INC HL - LD D,(HL) ; Get MSB of next array address - INC HL - JP NZ,FNDARY ; Not found - Keep looking - LD A,(LCRFLG) ; Found Locate or Create it? - OR A - JP NZ,DDERR ; Create - ?DD Error - POP AF ; Locate - Get number of dim'ns - LD B,H ; BC Points to array dim'ns - LD C,L - JP Z,POPHRT ; Jump if array load/save - SUB (HL) ; Same number of dimensions? - JP Z,FINDEL ; Yes - Find element -BSERR: LD E,BS ; ?BS Error - JP ERROR ; Output error - -CREARY: LD DE,4 ; 4 Bytes per entry - POP AF ; Array to save or 0 dim'ns? - JP Z,FCERR ; Yes - ?FC Error - LD (HL),C ; Save second byte of name - INC HL - LD (HL),B ; Save first byte of name - INC HL - LD C,A ; Number of dimensions to C - CALL CHKSTK ; Check if enough memory - INC HL ; Point to number of dimensions - INC HL - LD (CUROPR),HL ; Save address of pointer - LD (HL),C ; Set number of dimensions - INC HL - LD A,(LCRFLG) ; Locate of Create? - RLA ; Carry set = Create - LD A,C ; Get number of dimensions -CRARLP: LD BC,10+1 ; Default dimension size 10 - JP NC,DEFSIZ ; Locate - Set default size - POP BC ; Get specified dimension size - INC BC ; Include zero element -DEFSIZ: LD (HL),C ; Save LSB of dimension size - INC HL - LD (HL),B ; Save MSB of dimension size - INC HL - PUSH AF ; Save num' of dim'ns an status - PUSH HL ; Save address of dim'n size - CALL MLDEBC ; Multiply DE by BC to find - EX DE,HL ; amount of mem needed (to DE) - POP HL ; Restore address of dimension - POP AF ; Restore number of dimensions - DEC A ; Count them - JP NZ,CRARLP ; Do next dimension if more - PUSH AF ; Save locate/create flag - LD B,D ; MSB of memory needed - LD C,E ; LSB of memory needed - EX DE,HL - ADD HL,DE ; Add bytes to array start - JP C,OMERR ; Too big - Error - CALL ENFMEM ; See if enough memory - LD (ARREND),HL ; Save new end of array - -ZERARY: DEC HL ; Back through array data - LD (HL),0 ; Set array element to zero - CALL CPDEHL ; All elements zeroed? - JP NZ,ZERARY ; No - Keep on going - INC BC ; Number of bytes + 1 - LD D,A ; A=0 - LD HL,(CUROPR) ; Get address of array - LD E,(HL) ; Number of dimensions - EX DE,HL ; To HL - ADD HL,HL ; Two bytes per dimension size - ADD HL,BC ; Add number of bytes - EX DE,HL ; Bytes needed to DE - DEC HL - DEC HL - LD (HL),E ; Save LSB of bytes needed - INC HL - LD (HL),D ; Save MSB of bytes needed - INC HL - POP AF ; Locate / Create? - JP C,ENDDIM ; A is 0 , End if create -FINDEL: LD B,A ; Find array element - LD C,A - LD A,(HL) ; Number of dimensions - INC HL - .BYTE 16H ; Skip "POP HL" -FNDELP: POP HL ; Address of next dim' size - LD E,(HL) ; Get LSB of dim'n size - INC HL - LD D,(HL) ; Get MSB of dim'n size - INC HL - EX (SP),HL ; Save address - Get index - PUSH AF ; Save number of dim'ns - CALL CPDEHL ; Dimension too large? - JP NC,BSERR ; Yes - ?BS Error - PUSH HL ; Save index - CALL MLDEBC ; Multiply previous by size - POP DE ; Index supplied to DE - ADD HL,DE ; Add index to pointer - POP AF ; Number of dimensions - DEC A ; Count them - LD B,H ; MSB of pointer - LD C,L ; LSB of pointer - JP NZ,FNDELP ; More - Keep going - ADD HL,HL ; 4 Bytes per element - ADD HL,HL - POP BC ; Start of array - ADD HL,BC ; Point to element - EX DE,HL ; Address of element to DE -ENDDIM: LD HL,(NXTOPR) ; Got code string address - RET - -FRE: LD HL,(ARREND) ; Start of free memory - EX DE,HL ; To DE - LD HL,0 ; End of free memory - ADD HL,SP ; Current stack value - LD A,(TYPE) ; Dummy argument type - OR A - JP Z,FRENUM ; Numeric - Free variable space - CALL GSTRCU ; Current string to pool - CALL GARBGE ; Garbage collection - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string space -FRENUM: LD A,L ; Get LSB of end - SUB E ; Subtract LSB of beginning - LD C,A ; Save difference if C - LD A,H ; Get MSB of end - SBC A,D ; Subtract MSB of beginning -ACPASS: LD B,C ; Return integer AC -ABPASS: LD D,B ; Return integer AB - LD E,0 - LD HL,TYPE ; Point to type - LD (HL),E ; Set type to numeric - LD B,80H+16 ; 16 bit integer - JP RETINT ; Return the integr - -POS: LD A,(CURPOS) ; Get cursor position -PASSA: LD B,A ; Put A into AB - XOR A ; Zero A - JP ABPASS ; Return integer AB - -DEF: CALL CHEKFN ; Get "FN" and name - CALL IDTEST ; Test for illegal direct - LD BC,DATA ; To get next statement - PUSH BC ; Save address for RETurn - PUSH DE ; Save address of function ptr - CALL CHKSYN ; Make sure "(" follows - .BYTE "(" - CALL GETVAR ; Get argument variable name - PUSH HL ; Save code string address - EX DE,HL ; Argument address to HL - DEC HL - LD D,(HL) ; Get first byte of arg name - DEC HL - LD E,(HL) ; Get second byte of arg name - POP HL ; Restore code string address - CALL TSTNUM ; Make sure numeric argument - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - CALL CHKSYN ; Make sure "=" follows - .BYTE ZEQUAL ; "=" token - LD B,H ; Code string address to BC - LD C,L - EX (SP),HL ; Save code str , Get FN ptr - LD (HL),C ; Save LSB of FN code string - INC HL - LD (HL),B ; Save MSB of FN code string - JP SVSTAD ; Save address and do function - -DOFN: CALL CHEKFN ; Make sure FN follows - PUSH DE ; Save function pointer address - CALL EVLPAR ; Evaluate expression in "()" - CALL TSTNUM ; Make sure numeric result - EX (SP),HL ; Save code str , Get FN ptr - LD E,(HL) ; Get LSB of FN code string - INC HL - LD D,(HL) ; Get MSB of FN code string - INC HL - LD A,D ; And function DEFined? - OR E - JP Z,UFERR ; No - ?UF Error - LD A,(HL) ; Get LSB of argument address - INC HL - LD H,(HL) ; Get MSB of argument address - LD L,A ; HL = Arg variable address - PUSH HL ; Save it - LD HL,(FNRGNM) ; Get old argument name - EX (SP),HL ; ; Save old , Get new - LD (FNRGNM),HL ; Set new argument name - LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value - PUSH HL ; Save it - LD HL,(FNARG) ; Get MSB,EXP of old arg value - PUSH HL ; Save it - LD HL,FNARG ; HL = Value of argument - PUSH DE ; Save FN code string address - CALL FPTHL ; Move FPREG to argument - POP HL ; Get FN code string address - CALL GETNUM ; Get value from function - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,SNERR ; Bad character in FN - Error - POP HL ; Get MSB,EXP of old arg - LD (FNARG),HL ; Restore it - POP HL ; Get LSB,NLSB of old arg - LD (FNARG+2),HL ; Restore it - POP HL ; Get name of old arg - LD (FNRGNM),HL ; Restore it - POP HL ; Restore code string address - RET - -IDTEST: PUSH HL ; Save code string address - LD HL,(LINEAT) ; Get current line number - INC HL ; -1 means direct statement - LD A,H - OR L - POP HL ; Restore code string address - RET NZ ; Return if in program - LD E,ID ; ?ID Error - JP ERROR - -CHEKFN: CALL CHKSYN ; Make sure FN follows - .BYTE ZFN ; "FN" token - LD A,80H - LD (FORFLG),A ; Flag FN name to find - OR (HL) ; FN name has bit 7 set - LD B,A ; in first byte of name - CALL GTFNAM ; Get FN name - JP TSTNUM ; Make sure numeric function - -STR: CALL TSTNUM ; Make sure it's a number - CALL NUMASC ; Turn number into text -STR1: CALL CRTST ; Create string entry for it - CALL GSTRCU ; Current string to pool - LD BC,TOPOOL ; Save in string pool - PUSH BC ; Save address on stack - -SAVSTR: LD A,(HL) ; Get string length - INC HL - INC HL - PUSH HL ; Save pointer to string - CALL TESTR ; See if enough string space - POP HL ; Restore pointer to string - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - CALL CRTMST ; Create string entry - PUSH HL ; Save pointer to MSB of addr - LD L,A ; Length of string - CALL TOSTRA ; Move to string area - POP DE ; Restore pointer to MSB - RET - -MKTMST: CALL TESTR ; See if enough string space -CRTMST: LD HL,TMPSTR ; Temporary string - PUSH HL ; Save it - LD (HL),A ; Save length of string - INC HL -SVSTAD: INC HL - LD (HL),E ; Save LSB of address - INC HL - LD (HL),D ; Save MSB of address - POP HL ; Restore pointer - RET - -CRTST: DEC HL ; DEC - INCed after -QTSTR: LD B,'"' ; Terminating quote - LD D,B ; Quote to D -DTSTR: PUSH HL ; Save start - LD C,-1 ; Set counter to -1 -QTSTLP: INC HL ; Move on - LD A,(HL) ; Get byte - INC C ; Count bytes - OR A ; End of line? - JP Z,CRTSTE ; Yes - Create string entry - CP D ; Terminator D found? - JP Z,CRTSTE ; Yes - Create string entry - CP B ; Terminator B found? - JP NZ,QTSTLP ; No - Keep looking -CRTSTE: CP '"' ; End with '"'? - CALL Z,GETCHR ; Yes - Get next character - EX (SP),HL ; Starting quote - INC HL ; First byte of string - EX DE,HL ; To DE - LD A,C ; Get length - CALL CRTMST ; Create string entry -TSTOPL: LD DE,TMPSTR ; Temporary string - LD HL,(TMSTPT) ; Temporary string pool pointer - LD (FPREG),HL ; Save address of string ptr - LD A,1 - LD (TYPE),A ; Set type to string - CALL DETHL4 ; Move string to pool - CALL CPDEHL ; Out of string pool? - LD (TMSTPT),HL ; Save new pointer - POP HL ; Restore code string address - LD A,(HL) ; Get next code byte - RET NZ ; Return if pool OK - LD E,ST ; ?ST Error - JP ERROR ; String pool overflow - -PRNUMS: INC HL ; Skip leading space -PRS: CALL CRTST ; Create string entry for it -PRS1: CALL GSTRCU ; Current string to pool - CALL LOADFP ; Move string block to BCDE - INC E ; Length + 1 -PRSLP: DEC E ; Count characters - RET Z ; End of string - LD A,(BC) ; Get byte to output - CALL OUTC ; Output character in A - CP CR ; Return? - CALL Z,DONULL ; Yes - Do nulls - INC BC ; Next byte in string - JP PRSLP ; More characters to output - -TESTR: OR A ; Test if enough room - .BYTE 0EH ; No garbage collection done -GRBDON: POP AF ; Garbage collection done - PUSH AF ; Save status - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string area - CPL ; Negate length (Top down) - LD C,A ; -Length to BC - LD B,-1 ; BC = -ve length of string - ADD HL,BC ; Add to bottom of space in use - INC HL ; Plus one for 2's complement - CALL CPDEHL ; Below string RAM area? - JP C,TESTOS ; Tidy up if not done else err - LD (STRBOT),HL ; Save new bottom of area - INC HL ; Point to first byte of string - EX DE,HL ; Address to DE -POPAF: POP AF ; Throw away status push - RET - -TESTOS: POP AF ; Garbage collect been done? - LD E,OS ; ?OS Error - JP Z,ERROR ; Yes - Not enough string apace - CP A ; Flag garbage collect done - PUSH AF ; Save status - LD BC,GRBDON ; Garbage collection done - PUSH BC ; Save for RETurn -GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer -GARBLP: LD (STRBOT),HL ; Reset string pointer - LD HL,0 - PUSH HL ; Flag no string found - LD HL,(STRSPC) ; Get bottom of string space - PUSH HL ; Save bottom of string space - LD HL,TMSTPL ; Temporary string pool -GRBLP: EX DE,HL - LD HL,(TMSTPT) ; Temporary string pool pointer - EX DE,HL - CALL CPDEHL ; Temporary string pool done? - LD BC,GRBLP ; Loop until string pool done - JP NZ,STPOOL ; No - See if in string area - LD HL,(PROGND) ; Start of simple variables -SMPVAR: EX DE,HL - LD HL,(VAREND) ; End of simple variables - EX DE,HL - CALL CPDEHL ; All simple strings done? - JP Z,ARRLP ; Yes - Do string arrays - LD A,(HL) ; Get type of variable - INC HL - INC HL - OR A ; "S" flag set if string - CALL STRADD ; See if string in string area - JP SMPVAR ; Loop until simple ones done - -GNXARY: POP BC ; Scrap address of this array -ARRLP: EX DE,HL - LD HL,(ARREND) ; End of string arrays - EX DE,HL - CALL CPDEHL ; All string arrays done? - JP Z,SCNEND ; Yes - Move string if found - CALL LOADFP ; Get array name to BCDE - LD A,E ; Get type of array - PUSH HL ; Save address of num of dim'ns - ADD HL,BC ; Start of next array - OR A ; Test type of array - JP P,GNXARY ; Numeric array - Ignore it - LD (CUROPR),HL ; Save address of next array - POP HL ; Get address of num of dim'ns - LD C,(HL) ; BC = Number of dimensions - LD B,0 - ADD HL,BC ; Two bytes per dimension size - ADD HL,BC - INC HL ; Plus one for number of dim'ns -GRBARY: EX DE,HL - LD HL,(CUROPR) ; Get address of next array - EX DE,HL - CALL CPDEHL ; Is this array finished? - JP Z,ARRLP ; Yes - Get next one - LD BC,GRBARY ; Loop until array all done -STPOOL: PUSH BC ; Save return address - OR 80H ; Flag string type -STRADD: LD A,(HL) ; Get string length - INC HL - INC HL - LD E,(HL) ; Get LSB of string address - INC HL - LD D,(HL) ; Get MSB of string address - INC HL - RET P ; Not a string - Return - OR A ; Set flags on string length - RET Z ; Null string - Return - LD B,H ; Save variable pointer - LD C,L - LD HL,(STRBOT) ; Bottom of new area - CALL CPDEHL ; String been done? - LD H,B ; Restore variable pointer - LD L,C - RET C ; String done - Ignore - POP HL ; Return address - EX (SP),HL ; Lowest available string area - CALL CPDEHL ; String within string area? - EX (SP),HL ; Lowest available string area - PUSH HL ; Re-save return address - LD H,B ; Restore variable pointer - LD L,C - RET NC ; Outside string area - Ignore - POP BC ; Get return , Throw 2 away - POP AF ; - POP AF ; - PUSH HL ; Save variable pointer - PUSH DE ; Save address of current - PUSH BC ; Put back return address - RET ; Go to it - -SCNEND: POP DE ; Addresses of strings - POP HL ; - LD A,L ; HL = 0 if no more to do - OR H - RET Z ; No more to do - Return - DEC HL - LD B,(HL) ; MSB of address of string - DEC HL - LD C,(HL) ; LSB of address of string - PUSH HL ; Save variable address - DEC HL - DEC HL - LD L,(HL) ; HL = Length of string - LD H,0 - ADD HL,BC ; Address of end of string+1 - LD D,B ; String address to DE - LD E,C - DEC HL ; Last byte in string - LD B,H ; Address to BC - LD C,L - LD HL,(STRBOT) ; Current bottom of string area - CALL MOVSTR ; Move string to new address - POP HL ; Restore variable address - LD (HL),C ; Save new LSB of address - INC HL - LD (HL),B ; Save new MSB of address - LD L,C ; Next string area+1 to HL - LD H,B - DEC HL ; Next string area address - JP GARBLP ; Look for more strings - -CONCAT: PUSH BC ; Save prec' opr & code string - PUSH HL ; - LD HL,(FPREG) ; Get first string - EX (SP),HL ; Save first string - CALL OPRND ; Get second string - EX (SP),HL ; Restore first string - CALL TSTSTR ; Make sure it's a string - LD A,(HL) ; Get length of second string - PUSH HL ; Save first string - LD HL,(FPREG) ; Get second string - PUSH HL ; Save second string - ADD A,(HL) ; Add length of second string - LD E,LS ; ?LS Error - JP C,ERROR ; String too long - Error - CALL MKTMST ; Make temporary string - POP DE ; Get second string to DE - CALL GSTRDE ; Move to string pool if needed - EX (SP),HL ; Get first string - CALL GSTRHL ; Move to string pool if needed - PUSH HL ; Save first string - LD HL,(TMPSTR+2) ; Temporary string address - EX DE,HL ; To DE - CALL SSTSA ; First string to string area - CALL SSTSA ; Second string to string area - LD HL,EVAL2 ; Return to evaluation loop - EX (SP),HL ; Save return,get code string - PUSH HL ; Save code string address - JP TSTOPL ; To temporary string to pool - -SSTSA: POP HL ; Return address - EX (SP),HL ; Get string block,save return - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of string address - INC HL - LD B,(HL) ; Get MSB of string address - LD L,A ; Length to L -TOSTRA: INC L ; INC - DECed after -TSALP: DEC L ; Count bytes moved - RET Z ; End of string - Return - LD A,(BC) ; Get source - LD (DE),A ; Save destination - INC BC ; Next source - INC DE ; Next destination - JP TSALP ; Loop until string moved - -GETSTR: CALL TSTSTR ; Make sure it's a string -GSTRCU: LD HL,(FPREG) ; Get current string -GSTRHL: EX DE,HL ; Save DE -GSTRDE: CALL BAKTMP ; Was it last tmp-str? - EX DE,HL ; Restore DE - RET NZ ; No - Return - PUSH DE ; Save string - LD D,B ; String block address to DE - LD E,C - DEC DE ; Point to length - LD C,(HL) ; Get string length - LD HL,(STRBOT) ; Current bottom of string area - CALL CPDEHL ; Last one in string area? - JP NZ,POPHL ; No - Return - LD B,A ; Clear B (A=0) - ADD HL,BC ; Remove string from str' area - LD (STRBOT),HL ; Save new bottom of str' area -POPHL: POP HL ; Restore string - RET - -BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top - DEC HL ; Back - LD B,(HL) ; Get MSB of address - DEC HL ; Back - LD C,(HL) ; Get LSB of address - DEC HL ; Back - DEC HL ; Back - CALL CPDEHL ; String last in string pool? - RET NZ ; Yes - Leave it - LD (TMSTPT),HL ; Save new string pool top - RET - -LEN: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GETLEN: CALL GETSTR ; Get string and its length - XOR A - LD D,A ; Clear D - LD (TYPE),A ; Set type to numeric - LD A,(HL) ; Get length of string - OR A ; Set status flags - RET - -ASC: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GTFLNM: CALL GETLEN ; Get length of string - JP Z,FCERR ; Null string - Error - INC HL - INC HL - LD E,(HL) ; Get LSB of address - INC HL - LD D,(HL) ; Get MSB of address - LD A,(DE) ; Get first byte of string - RET - -CHR: LD A,1 ; One character string - CALL MKTMST ; Make a temporary string - CALL MAKINT ; Make it integer A - LD HL,(TMPSTR+2) ; Get address of string - LD (HL),E ; Save character -TOPOOL: POP BC ; Clean up stack - JP TSTOPL ; Temporary string to pool - -LEFT: CALL LFRGNM ; Get number and ending ")" - XOR A ; Start at first byte in string -RIGHT1: EX (SP),HL ; Save code string,Get string - LD C,A ; Starting position in string -MID1: PUSH HL ; Save string block address - LD A,(HL) ; Get length of string - CP B ; Compare with number given - JP C,ALLFOL ; All following bytes required - LD A,B ; Get new length - .BYTE 11H ; Skip "LD C,0" -ALLFOL: LD C,0 ; First byte of string - PUSH BC ; Save position in string - CALL TESTR ; See if enough string space - POP BC ; Get position in string - POP HL ; Restore string block address - PUSH HL ; And re-save it - INC HL - INC HL - LD B,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,B ; HL = address of string - LD B,0 ; BC = starting address - ADD HL,BC ; Point to that byte - LD B,H ; BC = source string - LD C,L - CALL CRTMST ; Create a string entry - LD L,A ; Length of new string - CALL TOSTRA ; Move string to string area - POP DE ; Clear stack - CALL GSTRDE ; Move to string pool if needed - JP TSTOPL ; Temporary string to pool - -RIGHT: CALL LFRGNM ; Get number and ending ")" - POP DE ; Get string length - PUSH DE ; And re-save - LD A,(DE) ; Get length - SUB B ; Move back N bytes - JP RIGHT1 ; Go and get sub-string - -MID: EX DE,HL ; Get code string address - LD A,(HL) ; Get next byte ',' or ")" - CALL MIDNUM ; Get number supplied - INC B ; Is it character zero? - DEC B - JP Z,FCERR ; Yes - Error - PUSH BC ; Save starting position - LD E,255 ; All of string - CP ')' ; Any length given? - JP Z,RSTSTR ; No - Rest of string - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETINT ; Get integer 0-255 -RSTSTR: CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - POP AF ; Restore starting position - EX (SP),HL ; Get string,8ave code string - LD BC,MID1 ; Continuation of MID$ routine - PUSH BC ; Save for return - DEC A ; Starting position-1 - CP (HL) ; Compare with length - LD B,0 ; Zero bytes length - RET NC ; Null string if start past end - LD C,A ; Save starting position-1 - LD A,(HL) ; Get length of string - SUB C ; Subtract start - CP E ; Enough string for it? - LD B,A ; Save maximum length available - RET C ; Truncate string if needed - LD B,E ; Set specified length - RET ; Go and create string - -VAL: CALL GETLEN ; Get length of string - JP Z,RESZER ; Result zero - LD E,A ; Save length - INC HL - INC HL - LD A,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,A ; HL = String address - PUSH HL ; Save string address - ADD HL,DE - LD B,(HL) ; Get end of string+1 byte - LD (HL),D ; Zero it to terminate - EX (SP),HL ; Save string end,get start - PUSH BC ; Save end+1 byte - LD A,(HL) ; Get starting byte - CP '$' ; Hex number indicated? [function added] - JP NZ,VAL1 - CALL HEXTFP ; Convert Hex to FPREG - JR VAL3 -VAL1: CP '%' ; Binary number indicated? [function added] - JP NZ,VAL2 - CALL BINTFP ; Convert Bin to FPREG - JR VAL3 -VAL2: CALL ASCTFP ; Convert ASCII string to FP -VAL3: POP BC ; Restore end+1 byte - POP HL ; Restore end+1 address - LD (HL),B ; Put back original byte - RET - -LFRGNM: EX DE,HL ; Code string address to HL - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" -MIDNUM: POP BC ; Get return address - POP DE ; Get number supplied - PUSH BC ; Re-save return address - LD B,E ; Number to B - RET - -INP: CALL MAKINT ; Make it integer A - LD (INPORT),A ; Set input port - CALL INPSUB ; Get input from port - JP PASSA ; Return integer A - -POUT: CALL SETIO ; Set up port number - JP OUTSUB ; Output data and return - -WAIT: CALL SETIO ; Set up port number - PUSH AF ; Save AND mask - LD E,0 ; Assume zero if none given - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,NOXOR ; No XOR byte given - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETINT ; Get integer 0-255 to XOR with -NOXOR: POP BC ; Restore AND mask -WAITLP: CALL INPSUB ; Get input - XOR E ; Flip selected bits - AND B ; Result non-zero? - JP Z,WAITLP ; No = keep waiting - RET - -SETIO: CALL GETINT ; Get integer 0-255 - LD (INPORT),A ; Set input port - LD (OTPORT),A ; Set output port - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - JP GETINT ; Get integer 0-255 and return - -FNDNUM: CALL GETCHR ; Get next character -GETINT: CALL GETNUM ; Get a number from 0 to 255 -MAKINT: CALL DEPINT ; Make sure value 0 - 255 - LD A,D ; Get MSB of number - OR A ; Zero? - JP NZ,FCERR ; No - Error - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - LD A,E ; Get number to A - RET - -PEEK: CALL DEINT ; Get memory address - LD A,(DE) ; Get byte in memory - JP PASSA ; Return integer A - -POKE: CALL GETNUM ; Get memory address - CALL DEINT ; Get integer -32768 to 3276 - PUSH DE ; Save memory address - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETINT ; Get integer 0-255 - POP DE ; Restore memory address - LD (DE),A ; Load it into memory - RET - -ROUND: LD HL,HALF ; Add 0.5 to FPREG -ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE - JP FPADD ; Add BCDE to FPREG - -SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL - .BYTE 21H ; Skip "POP BC" and "POP DE" -PSUB: POP BC ; Get FP number from stack - POP DE -SUBCDE: CALL INVSGN ; Negate FPREG -FPADD: LD A,B ; Get FP exponent - OR A ; Is number zero? - RET Z ; Yes - Nothing to add - LD A,(FPEXP) ; Get FPREG exponent - OR A ; Is this number zero? - JP Z,FPBCDE ; Yes - Move BCDE to FPREG - SUB B ; BCDE number larger? - JP NC,NOSWAP ; No - Don't swap them - CPL ; Two's complement - INC A ; FP exponent - EX DE,HL - CALL STAKFP ; Put FPREG on stack - EX DE,HL - CALL FPBCDE ; Move BCDE to FPREG - POP BC ; Restore number from stack - POP DE -NOSWAP: CP 24+1 ; Second number insignificant? - RET NC ; Yes - First number is result - PUSH AF ; Save number of bits to scale - CALL SIGNS ; Set MSBs & sign of result - LD H,A ; Save sign of result - POP AF ; Restore scaling factor - CALL SCALE ; Scale BCDE to same exponent - OR H ; Result to be positive? - LD HL,FPREG ; Point to FPREG - JP P,MINCDE ; No - Subtract FPREG from CDE - CALL PLUCDE ; Add FPREG to CDE - JP NC,RONDUP ; No overflow - Round it up - INC HL ; Point to exponent - INC (HL) ; Increment it - JP Z,OVERR ; Number overflowed - Error - LD L,1 ; 1 bit to shift right - CALL SHRT1 ; Shift result right - JP RONDUP ; Round it up - -MINCDE: XOR A ; Clear A and carry - SUB B ; Negate exponent - LD B,A ; Re-save exponent - LD A,(HL) ; Get LSB of FPREG - SBC A, E ; Subtract LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - SBC A,D ; Subtract NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - SBC A,C ; Subtract MSB of BCDE - LD C,A ; Save MSB of BCDE -CONPOS: CALL C,COMPL ; Overflow - Make it positive - -BNORM: LD L,B ; L = Exponent - LD H,E ; H = LSB - XOR A -BNRMLP: LD B,A ; Save bit count - LD A,C ; Get MSB - OR A ; Is it zero? - JP NZ,PNORM ; No - Do it bit at a time - LD C,D ; MSB = NMSB - LD D,H ; NMSB= LSB - LD H,L ; LSB = VLSB - LD L,A ; VLSB= 0 - LD A,B ; Get exponent - SUB 8 ; Count 8 bits - CP -24-8 ; Was number zero? - JP NZ,BNRMLP ; No - Keep normalising -RESZER: XOR A ; Result is zero -SAVEXP: LD (FPEXP),A ; Save result as zero - RET - -NORMAL: DEC B ; Count bits - ADD HL,HL ; Shift HL left - LD A,D ; Get NMSB - RLA ; Shift left with last bit - LD D,A ; Save NMSB - LD A,C ; Get MSB - ADC A,A ; Shift left with last bit - LD C,A ; Save MSB -PNORM: JP P,NORMAL ; Not done - Keep going - LD A,B ; Number of bits shifted - LD E,H ; Save HL in EB - LD B,L - OR A ; Any shifting done? - JP Z,RONDUP ; No - Round it up - LD HL,FPEXP ; Point to exponent - ADD A,(HL) ; Add shifted bits - LD (HL),A ; Re-save exponent - JP NC,RESZER ; Underflow - Result is zero - RET Z ; Result is zero -RONDUP: LD A,B ; Get VLSB of number -RONDB: LD HL,FPEXP ; Point to exponent - OR A ; Any rounding? - CALL M,FPROND ; Yes - Round number up - LD B,(HL) ; B = Exponent - INC HL - LD A,(HL) ; Get sign of result - AND 10000000B ; Only bit 7 needed - XOR C ; Set correct sign - LD C,A ; Save correct sign in number - JP FPBCDE ; Move BCDE to FPREG - -FPROND: INC E ; Round LSB - RET NZ ; Return if ok - INC D ; Round NMSB - RET NZ ; Return if ok - INC C ; Round MSB - RET NZ ; Return if ok - LD C,80H ; Set normal value - INC (HL) ; Increment exponent - RET NZ ; Return if ok - JP OVERR ; Overflow error - -PLUCDE: LD A,(HL) ; Get LSB of FPREG - ADD A,E ; Add LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - ADC A,D ; Add NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - ADC A,C ; Add MSB of BCDE - LD C,A ; Save MSB of BCDE - RET - -COMPL: LD HL,SGNRES ; Sign of result - LD A,(HL) ; Get sign of result - CPL ; Negate it - LD (HL),A ; Put it back - XOR A - LD L,A ; Set L to zero - SUB B ; Negate exponent,set carry - LD B,A ; Re-save exponent - LD A,L ; Load zero - SBC A,E ; Negate LSB - LD E,A ; Re-save LSB - LD A,L ; Load zero - SBC A,D ; Negate NMSB - LD D,A ; Re-save NMSB - LD A,L ; Load zero - SBC A,C ; Negate MSB - LD C,A ; Re-save MSB - RET - -SCALE: LD B,0 ; Clear underflow -SCALLP: SUB 8 ; 8 bits (a whole byte)? - JP C,SHRITE ; No - Shift right A bits - LD B,E ; <- Shift - LD E,D ; <- right - LD D,C ; <- eight - LD C,0 ; <- bits - JP SCALLP ; More bits to shift - -SHRITE: ADD A,8+1 ; Adjust count - LD L,A ; Save bits to shift -SHRLP: XOR A ; Flag for all done - DEC L ; All shifting done? - RET Z ; Yes - Return - LD A,C ; Get MSB -SHRT1: RRA ; Shift it right - LD C,A ; Re-save - LD A,D ; Get NMSB - RRA ; Shift right with last bit - LD D,A ; Re-save it - LD A,E ; Get LSB - RRA ; Shift right with last bit - LD E,A ; Re-save it - LD A,B ; Get underflow - RRA ; Shift right with last bit - LD B,A ; Re-save underflow - JP SHRLP ; More bits to do - -UNITY: .BYTE 000H,000H,000H,081H ; 1.00000 - -LOGTAB: .BYTE 3 ; Table used by LOG - .BYTE 0AAH,056H,019H,080H ; 0.59898 - .BYTE 0F1H,022H,076H,080H ; 0.96147 - .BYTE 045H,0AAH,038H,082H ; 2.88539 - -LOG: CALL TSTSGN ; Test sign of value - OR A - JP PE,FCERR ; ?FC Error if <= zero - LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - LD BC,8035H ; BCDE = SQR(1/2) - LD DE,04F3H - SUB B ; Scale value to be < 1 - PUSH AF ; Save scale factor - LD (HL),B ; Save new exponent - PUSH DE ; Save SQR(1/2) - PUSH BC - CALL FPADD ; Add SQR(1/2) to value - POP BC ; Restore SQR(1/2) - POP DE - INC B ; Make it SQR(2) - CALL DVBCDE ; Divide by SQR(2) - LD HL,UNITY ; Point to 1. - CALL SUBPHL ; Subtract FPREG from 1 - LD HL,LOGTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD BC,8080H ; BCDE = -0.5 - LD DE,0000H - CALL FPADD ; Subtract 0.5 from FPREG - POP AF ; Restore scale factor - CALL RSCALE ; Re-scale number -MULLN2: LD BC,8031H ; BCDE = Ln(2) - LD DE,7218H - .BYTE 21H ; Skip "POP BC" and "POP DE" - -MULT: POP BC ; Get number from stack - POP DE -FPMULT: CALL TSTSGN ; Test sign of FPREG - RET Z ; Return zero if zero - LD L,0 ; Flag add exponents - CALL ADDEXP ; Add exponents - LD A,C ; Get MSB of multiplier - LD (MULVAL),A ; Save MSB of multiplier - EX DE,HL - LD (MULVAL+1),HL ; Save rest of multiplier - LD BC,0 ; Partial product (BCDE) = zero - LD D,B - LD E,B - LD HL,BNORM ; Address of normalise - PUSH HL ; Save for return - LD HL,MULT8 ; Address of 8 bit multiply - PUSH HL ; Save for NMSB,MSB - PUSH HL ; - LD HL,FPREG ; Point to number -MULT8: LD A,(HL) ; Get LSB of number - INC HL ; Point to NMSB - OR A ; Test LSB - JP Z,BYTSFT ; Zero - shift to next byte - PUSH HL ; Save address of number - LD L,8 ; 8 bits to multiply by -MUL8LP: RRA ; Shift LSB right - LD H,A ; Save LSB - LD A,C ; Get MSB - JP NC,NOMADD ; Bit was zero - Don't add - PUSH HL ; Save LSB and count - LD HL,(MULVAL+1) ; Get LSB and NMSB - ADD HL,DE ; Add NMSB and LSB - EX DE,HL ; Leave sum in DE - POP HL ; Restore MSB and count - LD A,(MULVAL) ; Get MSB of multiplier - ADC A,C ; Add MSB -NOMADD: RRA ; Shift MSB right - LD C,A ; Re-save MSB - LD A,D ; Get NMSB - RRA ; Shift NMSB right - LD D,A ; Re-save NMSB - LD A,E ; Get LSB - RRA ; Shift LSB right - LD E,A ; Re-save LSB - LD A,B ; Get VLSB - RRA ; Shift VLSB right - LD B,A ; Re-save VLSB - DEC L ; Count bits multiplied - LD A,H ; Get LSB of multiplier - JP NZ,MUL8LP ; More - Do it -POPHRT: POP HL ; Restore address of number - RET - -BYTSFT: LD B,E ; Shift partial product left - LD E,D - LD D,C - LD C,A - RET - -DIV10: CALL STAKFP ; Save FPREG on stack - LD BC,8420H ; BCDE = 10. - LD DE,0000H - CALL FPBCDE ; Move 10 to FPREG - -DIV: POP BC ; Get number from stack - POP DE -DVBCDE: CALL TSTSGN ; Test sign of FPREG - JP Z,DZERR ; Error if division by zero - LD L,-1 ; Flag subtract exponents - CALL ADDEXP ; Subtract exponents - INC (HL) ; Add 2 to exponent to adjust - INC (HL) - DEC HL ; Point to MSB - LD A,(HL) ; Get MSB of dividend - LD (DIV3),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get NMSB of dividend - LD (DIV2),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get MSB of dividend - LD (DIV1),A ; Save for subtraction - LD B,C ; Get MSB - EX DE,HL ; NMSB,LSB to HL - XOR A - LD C,A ; Clear MSB of quotient - LD D,A ; Clear NMSB of quotient - LD E,A ; Clear LSB of quotient - LD (DIV4),A ; Clear overflow count -DIVLP: PUSH HL ; Save divisor - PUSH BC - LD A,L ; Get LSB of number - CALL DIVSUP ; Subt' divisor from dividend - SBC A,0 ; Count for overflows - CCF - JP NC,RESDIV ; Restore divisor if borrow - LD (DIV4),A ; Re-save overflow count - POP AF ; Scrap divisor - POP AF - SCF ; Set carry to - .BYTE 0D2H ; Skip "POP BC" and "POP HL" - -RESDIV: POP BC ; Restore divisor - POP HL - LD A,C ; Get MSB of quotient - INC A - DEC A - RRA ; Bit 0 to bit 7 - JP M,RONDB ; Done - Normalise result - RLA ; Restore carry - LD A,E ; Get LSB of quotient - RLA ; Double it - LD E,A ; Put it back - LD A,D ; Get NMSB of quotient - RLA ; Double it - LD D,A ; Put it back - LD A,C ; Get MSB of quotient - RLA ; Double it - LD C,A ; Put it back - ADD HL,HL ; Double NMSB,LSB of divisor - LD A,B ; Get MSB of divisor - RLA ; Double it - LD B,A ; Put it back - LD A,(DIV4) ; Get VLSB of quotient - RLA ; Double it - LD (DIV4),A ; Put it back - LD A,C ; Get MSB of quotient - OR D ; Merge NMSB - OR E ; Merge LSB - JP NZ,DIVLP ; Not done - Keep dividing - PUSH HL ; Save divisor - LD HL,FPEXP ; Point to exponent - DEC (HL) ; Divide by 2 - POP HL ; Restore divisor - JP NZ,DIVLP ; Ok - Keep going - JP OVERR ; Overflow error - -ADDEXP: LD A,B ; Get exponent of dividend - OR A ; Test it - JP Z,OVTST3 ; Zero - Result zero - LD A,L ; Get add/subtract flag - LD HL,FPEXP ; Point to exponent - XOR (HL) ; Add or subtract it - ADD A,B ; Add the other exponent - LD B,A ; Save new exponent - RRA ; Test exponent for overflow - XOR B - LD A,B ; Get exponent - JP P,OVTST2 ; Positive - Test for overflow - ADD A,80H ; Add excess 128 - LD (HL),A ; Save new exponent - JP Z,POPHRT ; Zero - Result zero - CALL SIGNS ; Set MSBs and sign of result - LD (HL),A ; Save new exponent - DEC HL ; Point to MSB - RET - -OVTST1: CALL TSTSGN ; Test sign of FPREG - CPL ; Invert sign - POP HL ; Clean up stack -OVTST2: OR A ; Test if new exponent zero -OVTST3: POP HL ; Clear off return address - JP P,RESZER ; Result zero - JP OVERR ; Overflow error - -MLSP10: CALL BCDEFP ; Move FPREG to BCDE - LD A,B ; Get exponent - OR A ; Is it zero? - RET Z ; Yes - Result is zero - ADD A,2 ; Multiply by 4 - JP C,OVERR ; Overflow - ?OV Error - LD B,A ; Re-save exponent - CALL FPADD ; Add BCDE to FPREG (Times 5) - LD HL,FPEXP ; Point to exponent - INC (HL) ; Double number (Times 10) - RET NZ ; Ok - Return - JP OVERR ; Overflow error - -TSTSGN: LD A,(FPEXP) ; Get sign of FPREG - OR A - RET Z ; RETurn if number is zero - LD A,(FPREG+2) ; Get MSB of FPREG - .BYTE 0FEH ; Test sign -RETREL: CPL ; Invert sign - RLA ; Sign bit to carry -FLGDIF: SBC A,A ; Carry to all bits of A - RET NZ ; Return -1 if negative - INC A ; Bump to +1 - RET ; Positive - Return +1 - -SGN: CALL TSTSGN ; Test sign of FPREG -FLGREL: LD B,80H+8 ; 8 bit integer in exponent - LD DE,0 ; Zero NMSB and LSB -RETINT: LD HL,FPEXP ; Point to exponent - LD C,A ; CDE = MSB,NMSB and LSB - LD (HL),B ; Save exponent - LD B,0 ; CDE = integer to normalise - INC HL ; Point to sign of result - LD (HL),80H ; Set sign of result - RLA ; Carry = sign of integer - JP CONPOS ; Set sign of result - -ABS: CALL TSTSGN ; Test sign of FPREG - RET P ; Return if positive -INVSGN: LD HL,FPREG+2 ; Point to MSB - LD A,(HL) ; Get sign of mantissa - XOR 80H ; Invert sign of mantissa - LD (HL),A ; Re-save sign of mantissa - RET - -STAKFP: EX DE,HL ; Save code string address - LD HL,(FPREG) ; LSB,NLSB of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - LD HL,(FPREG+2) ; MSB and exponent of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - EX DE,HL ; Restore code string address - RET - -PHLTFP: CALL LOADFP ; Number at HL to BCDE -FPBCDE: EX DE,HL ; Save code string address - LD (FPREG),HL ; Save LSB,NLSB of number - LD H,B ; Exponent of number - LD L,C ; MSB of number - LD (FPREG+2),HL ; Save MSB and exponent - EX DE,HL ; Restore code string address - RET - -BCDEFP: LD HL,FPREG ; Point to FPREG -LOADFP: LD E,(HL) ; Get LSB of number - INC HL - LD D,(HL) ; Get NMSB of number - INC HL - LD C,(HL) ; Get MSB of number - INC HL - LD B,(HL) ; Get exponent of number -INCHL: INC HL ; Used for conditional "INC HL" - RET - -FPTHL: LD DE,FPREG ; Point to FPREG -DETHL4: LD B,4 ; 4 bytes to move -DETHLB: LD A,(DE) ; Get source - LD (HL),A ; Save destination - INC DE ; Next source - INC HL ; Next destination - DEC B ; Count bytes - JP NZ,DETHLB ; Loop if more - RET - -SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG - LD A,(HL) ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD (HL),A ; Save new MSB - CCF ; Complement sign - RRA ; Old sign to carry - INC HL - INC HL - LD (HL),A ; Set sign of result - LD A,C ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD C,A ; Save MSB - RRA - XOR (HL) ; New sign of result - RET - -CMPNUM: LD A,B ; Get exponent of number - OR A - JP Z,TSTSGN ; Zero - Test sign of FPREG - LD HL,RETREL ; Return relation routine - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD A,C ; Get MSB of number - RET Z ; FPREG zero - Number's MSB - LD HL,FPREG+2 ; MSB of FPREG - XOR (HL) ; Combine signs - LD A,C ; Get MSB of number - RET M ; Exit if signs different - CALL CMPFP ; Compare FP numbers - RRA ; Get carry to sign - XOR C ; Combine with MSB of number - RET - -CMPFP: INC HL ; Point to exponent - LD A,B ; Get exponent - CP (HL) ; Compare exponents - RET NZ ; Different - DEC HL ; Point to MBS - LD A,C ; Get MSB - CP (HL) ; Compare MSBs - RET NZ ; Different - DEC HL ; Point to NMSB - LD A,D ; Get NMSB - CP (HL) ; Compare NMSBs - RET NZ ; Different - DEC HL ; Point to LSB - LD A,E ; Get LSB - SUB (HL) ; Compare LSBs - RET NZ ; Different - POP HL ; Drop RETurn - POP HL ; Drop another RETurn - RET - -FPINT: LD B,A ; <- Move - LD C,A ; <- exponent - LD D,A ; <- to all - LD E,A ; <- bits - OR A ; Test exponent - RET Z ; Zero - Return zero - PUSH HL ; Save pointer to number - CALL BCDEFP ; Move FPREG to BCDE - CALL SIGNS ; Set MSBs & sign of result - XOR (HL) ; Combine with sign of FPREG - LD H,A ; Save combined signs - CALL M,DCBCDE ; Negative - Decrement BCDE - LD A,80H+24 ; 24 bits - SUB B ; Bits to shift - CALL SCALE ; Shift BCDE - LD A,H ; Get combined sign - RLA ; Sign to carry - CALL C,FPROND ; Negative - Round number up - LD B,0 ; Zero exponent - CALL C,COMPL ; If negative make positive - POP HL ; Restore pointer to number - RET - -DCBCDE: DEC DE ; Decrement BCDE - LD A,D ; Test LSBs - AND E - INC A - RET NZ ; Exit if LSBs not FFFF - DEC BC ; Decrement MSBs - RET - -INT: LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - CP 80H+24 ; Integer accuracy only? - LD A,(FPREG) ; Get LSB - RET NC ; Yes - Already integer - LD A,(HL) ; Get exponent - CALL FPINT ; F.P to integer - LD (HL),80H+24 ; Save 24 bit integer - LD A,E ; Get LSB of number - PUSH AF ; Save LSB - LD A,C ; Get MSB of number - RLA ; Sign to carry - CALL CONPOS ; Set sign of result - POP AF ; Restore LSB of number - RET - -MLDEBC: LD HL,0 ; Clear partial product - LD A,B ; Test multiplier - OR C - RET Z ; Return zero if zero - LD A,16 ; 16 bits -MLDBLP: ADD HL,HL ; Shift P.P left - JP C,BSERR ; ?BS Error if overflow - EX DE,HL - ADD HL,HL ; Shift multiplier left - EX DE,HL - JP NC,NOMLAD ; Bit was zero - No add - ADD HL,BC ; Add multiplicand - JP C,BSERR ; ?BS Error if overflow -NOMLAD: DEC A ; Count bits - JP NZ,MLDBLP ; More - RET - -ASCTFP: CP '-' ; Negative? - PUSH AF ; Save it and flags - JP Z,CNVNUM ; Yes - Convert number - CP '+' ; Positive? - JP Z,CNVNUM ; Yes - Convert number - DEC HL ; DEC 'cos GETCHR INCs -CNVNUM: CALL RESZER ; Set result to zero - LD B,A ; Digits after point counter - LD D,A ; Sign of exponent - LD E,A ; Exponent of ten - CPL - LD C,A ; Before or after point flag -MANLP: CALL GETCHR ; Get next character - JP C,ADDIG ; Digit - Add to number - CP '.' - JP Z,DPOINT ; '.' - Flag point - CP 'E' - JP NZ,CONEXP ; Not 'E' - Scale number - CALL GETCHR ; Get next character - CALL SGNEXP ; Get sign of exponent -EXPLP: CALL GETCHR ; Get next character - JP C,EDIGIT ; Digit - Add to exponent - INC D ; Is sign negative? - JP NZ,CONEXP ; No - Scale number - XOR A - SUB E ; Negate exponent - LD E,A ; And re-save it - INC C ; Flag end of number -DPOINT: INC C ; Flag point passed - JP Z,MANLP ; Zero - Get another digit -CONEXP: PUSH HL ; Save code string address - LD A,E ; Get exponent - SUB B ; Subtract digits after point -SCALMI: CALL P,SCALPL ; Positive - Multiply number - JP P,ENDCON ; Positive - All done - PUSH AF ; Save number of times to /10 - CALL DIV10 ; Divide by 10 - POP AF ; Restore count - INC A ; Count divides - -ENDCON: JP NZ,SCALMI ; More to do - POP DE ; Restore code string address - POP AF ; Restore sign of number - CALL Z,INVSGN ; Negative - Negate number - EX DE,HL ; Code string address to HL - RET - -SCALPL: RET Z ; Exit if no scaling needed -MULTEN: PUSH AF ; Save count - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore count - DEC A ; Count multiplies - RET - -ADDIG: PUSH DE ; Save sign of exponent - LD D,A ; Save digit - LD A,B ; Get digits after point - ADC A,C ; Add one if after point - LD B,A ; Re-save counter - PUSH BC ; Save point flags - PUSH HL ; Save code string address - PUSH DE ; Save digit - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore digit - SUB '0' ; Make it absolute - CALL RSCALE ; Re-scale number - POP HL ; Restore code string address - POP BC ; Restore point flags - POP DE ; Restore sign of exponent - JP MANLP ; Get another digit - -RSCALE: CALL STAKFP ; Put number on stack - CALL FLGREL ; Digit to add to FPREG -PADD: POP BC ; Restore number - POP DE - JP FPADD ; Add BCDE to FPREG and return - -EDIGIT: LD A,E ; Get digit - RLCA ; Times 2 - RLCA ; Times 4 - ADD A,E ; Times 5 - RLCA ; Times 10 - ADD A,(HL) ; Add next digit - SUB '0' ; Make it absolute - LD E,A ; Save new digit - JP EXPLP ; Look for another digit - -LINEIN: PUSH HL ; Save code string address - LD HL,INMSG ; Output " in " - CALL PRS ; Output string at HL - POP HL ; Restore code string address -PRNTHL: EX DE,HL ; Code string address to DE - XOR A - LD B,80H+24 ; 24 bits - CALL RETINT ; Return the integer - LD HL,PRNUMS ; Print number string - PUSH HL ; Save for return -NUMASC: LD HL,PBUFF ; Convert number to ASCII - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD (HL),' ' ; Space at start - JP P,SPCFST ; Positive - Space to start - LD (HL),'-' ; '-' sign at start -SPCFST: INC HL ; First byte of number - LD (HL),'0' ; '0' if zero - JP Z,JSTZER ; Return '0' if zero - PUSH HL ; Save buffer address - CALL M,INVSGN ; Negate FPREG if negative - XOR A ; Zero A - PUSH AF ; Save it - CALL RNGTST ; Test number is in range -SIXDIG: LD BC,9143H ; BCDE - 99999.9 - LD DE,4FF8H - CALL CMPNUM ; Compare numbers - OR A - JP PO,INRNG ; > 99999.9 - Sort it out - POP AF ; Restore count - CALL MULTEN ; Multiply by ten - PUSH AF ; Re-save count - JP SIXDIG ; Test it again - -GTSIXD: CALL DIV10 ; Divide by 10 - POP AF ; Get count - INC A ; Count divides - PUSH AF ; Re-save count - CALL RNGTST ; Test number is in range -INRNG: CALL ROUND ; Add 0.5 to FPREG - INC A - CALL FPINT ; F.P to integer - CALL FPBCDE ; Move BCDE to FPREG - LD BC,0306H ; 1E+06 to 1E-03 range - POP AF ; Restore count - ADD A,C ; 6 digits before point - INC A ; Add one - JP M,MAKNUM ; Do it in 'E' form if < 1E-02 - CP 6+1+1 ; More than 999999 ? - JP NC,MAKNUM ; Yes - Do it in 'E' form - INC A ; Adjust for exponent - LD B,A ; Exponent of number - LD A,2 ; Make it zero after - -MAKNUM: DEC A ; Adjust for digits to do - DEC A - POP HL ; Restore buffer address - PUSH AF ; Save count - LD DE,POWERS ; Powers of ten - DEC B ; Count digits before point - JP NZ,DIGTXT ; Not zero - Do number - LD (HL),'.' ; Save point - INC HL ; Move on - LD (HL),'0' ; Save zero - INC HL ; Move on -DIGTXT: DEC B ; Count digits before point - LD (HL),'.' ; Save point in case - CALL Z,INCHL ; Last digit - move on - PUSH BC ; Save digits before point - PUSH HL ; Save buffer address - PUSH DE ; Save powers of ten - CALL BCDEFP ; Move FPREG to BCDE - POP HL ; Powers of ten table - LD B, '0'-1 ; ASCII '0' - 1 -TRYAGN: INC B ; Count subtractions - LD A,E ; Get LSB - SUB (HL) ; Subtract LSB - LD E,A ; Save LSB - INC HL - LD A,D ; Get NMSB - SBC A,(HL) ; Subtract NMSB - LD D,A ; Save NMSB - INC HL - LD A,C ; Get MSB - SBC A,(HL) ; Subtract MSB - LD C,A ; Save MSB - DEC HL ; Point back to start - DEC HL - JP NC,TRYAGN ; No overflow - Try again - CALL PLUCDE ; Restore number - INC HL ; Start of next number - CALL FPBCDE ; Move BCDE to FPREG - EX DE,HL ; Save point in table - POP HL ; Restore buffer address - LD (HL),B ; Save digit in buffer - INC HL ; And move on - POP BC ; Restore digit count - DEC C ; Count digits - JP NZ,DIGTXT ; More - Do them - DEC B ; Any decimal part? - JP Z,DOEBIT ; No - Do 'E' bit -SUPTLZ: DEC HL ; Move back through buffer - LD A,(HL) ; Get character - CP '0' ; '0' character? - JP Z,SUPTLZ ; Yes - Look back for more - CP '.' ; A decimal point? - CALL NZ,INCHL ; Move back over digit - -DOEBIT: POP AF ; Get 'E' flag - JP Z,NOENED ; No 'E' needed - End buffer - LD (HL),'E' ; Put 'E' in buffer - INC HL ; And move on - LD (HL),'+' ; Put '+' in buffer - JP P,OUTEXP ; Positive - Output exponent - LD (HL),'-' ; Put '-' in buffer - CPL ; Negate exponent - INC A -OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 -EXPTEN: INC B ; Count subtractions - SUB 10 ; Tens digit - JP NC,EXPTEN ; More to do - ADD A,'0'+10 ; Restore and make ASCII - INC HL ; Move on - LD (HL),B ; Save MSB of exponent -JSTZER: INC HL ; - LD (HL),A ; Save LSB of exponent - INC HL -NOENED: LD (HL),C ; Mark end of buffer - POP HL ; Restore code string address - RET - -RNGTST: LD BC,9474H ; BCDE = 999999. - LD DE,23F7H - CALL CMPNUM ; Compare numbers - OR A - POP HL ; Return address to HL - JP PO,GTSIXD ; Too big - Divide by ten - JP (HL) ; Otherwise return to caller - -HALF: .BYTE 00H,00H,00H,80H ; 0.5 - -POWERS: .BYTE 0A0H,086H,001H ; 100000 - .BYTE 010H,027H,000H ; 10000 - .BYTE 0E8H,003H,000H ; 1000 - .BYTE 064H,000H,000H ; 100 - .BYTE 00AH,000H,000H ; 10 - .BYTE 001H,000H,000H ; 1 - -NEGAFT: LD HL,INVSGN ; Negate result - EX (SP),HL ; To be done after caller - JP (HL) ; Return to caller - -SQR: CALL STAKFP ; Put value on stack - LD HL,HALF ; Set power to 1/2 - CALL PHLTFP ; Move 1/2 to FPREG - -POWER: POP BC ; Get base - POP DE - CALL TSTSGN ; Test sign of power - LD A,B ; Get exponent of base - JP Z,EXP ; Make result 1 if zero - JP P,POWER1 ; Positive base - Ok - OR A ; Zero to negative power? - JP Z,DZERR ; Yes - ?/0 Error -POWER1: OR A ; Base zero? - JP Z,SAVEXP ; Yes - Return zero - PUSH DE ; Save base - PUSH BC - LD A,C ; Get MSB of base - OR 01111111B ; Get sign status - CALL BCDEFP ; Move power to BCDE - JP P,POWER2 ; Positive base - Ok - PUSH DE ; Save power - PUSH BC - CALL INT ; Get integer of power - POP BC ; Restore power - POP DE - PUSH AF ; MSB of base - CALL CMPNUM ; Power an integer? - POP HL ; Restore MSB of base - LD A,H ; but don't affect flags - RRA ; Exponent odd or even? -POWER2: POP HL ; Restore MSB and exponent - LD (FPREG+2),HL ; Save base in FPREG - POP HL ; LSBs of base - LD (FPREG),HL ; Save in FPREG - CALL C,NEGAFT ; Odd power - Negate result - CALL Z,INVSGN ; Negative base - Negate it - PUSH DE ; Save power - PUSH BC - CALL LOG ; Get LOG of base - POP BC ; Restore power - POP DE - CALL FPMULT ; Multiply LOG by power - -EXP: CALL STAKFP ; Put value on stack - LD BC,08138H ; BCDE = 1/Ln(2) - LD DE,0AA3BH - CALL FPMULT ; Multiply value by 1/LN(2) - LD A,(FPEXP) ; Get exponent - CP 80H+8 ; Is it in range? - JP NC,OVTST1 ; No - Test for overflow - CALL INT ; Get INT of FPREG - ADD A,80H ; For excess 128 - ADD A,2 ; Exponent > 126? - JP C,OVTST1 ; Yes - Test for overflow - PUSH AF ; Save scaling factor - LD HL,UNITY ; Point to 1. - CALL ADDPHL ; Add 1 to FPREG - CALL MULLN2 ; Multiply by LN(2) - POP AF ; Restore scaling factor - POP BC ; Restore exponent - POP DE - PUSH AF ; Save scaling factor - CALL SUBCDE ; Subtract exponent from FPREG - CALL INVSGN ; Negate result - LD HL,EXPTAB ; Coefficient table - CALL SMSER1 ; Sum the series - LD DE,0 ; Zero LSBs - POP BC ; Scaling factor - LD C,D ; Zero MSB - JP FPMULT ; Scale result to correct value - -EXPTAB: .BYTE 8 ; Table used by EXP - .BYTE 040H,02EH,094H,074H ; -1/7! (-1/5040) - .BYTE 070H,04FH,02EH,077H ; 1/6! ( 1/720) - .BYTE 06EH,002H,088H,07AH ; -1/5! (-1/120) - .BYTE 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) - .BYTE 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) - .BYTE 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) - .BYTE 000H,000H,080H,081H ; -1/1! (-1/1) - .BYTE 000H,000H,000H,081H ; 1/0! ( 1/1) - -SUMSER: CALL STAKFP ; Put FPREG on stack - LD DE,MULT ; Multiply by "X" - PUSH DE ; To be done after - PUSH HL ; Save address of table - CALL BCDEFP ; Move FPREG to BCDE - CALL FPMULT ; Square the value - POP HL ; Restore address of table -SMSER1: CALL STAKFP ; Put value on stack - LD A,(HL) ; Get number of coefficients - INC HL ; Point to start of table - CALL PHLTFP ; Move coefficient to FPREG - .BYTE 06H ; Skip "POP AF" -SUMLP: POP AF ; Restore count - POP BC ; Restore number - POP DE - DEC A ; Cont coefficients - RET Z ; All done - PUSH DE ; Save number - PUSH BC - PUSH AF ; Save count - PUSH HL ; Save address in table - CALL FPMULT ; Multiply FPREG by BCDE - POP HL ; Restore address in table - CALL LOADFP ; Number at HL to BCDE - PUSH HL ; Save address in table - CALL FPADD ; Add coefficient to FPREG - POP HL ; Restore address in table - JP SUMLP ; More coefficients - -RND: CALL TSTSGN ; Test sign of FPREG - LD HL,SEED+2 ; Random number seed - JP M,RESEED ; Negative - Re-seed - LD HL,LSTRND ; Last random number - CALL PHLTFP ; Move last RND to FPREG - LD HL,SEED+2 ; Random number seed - RET Z ; Return if RND(0) - ADD A,(HL) ; Add (SEED)+2) - AND 00000111B ; 0 to 7 - LD B,0 - LD (HL),A ; Re-save seed - INC HL ; Move to coefficient table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to coefficient - CALL LOADFP ; Coefficient to BCDE - CALL FPMULT ; ; Multiply FPREG by coefficient - LD A,(SEED+1) ; Get (SEED+1) - INC A ; Add 1 - AND 00000011B ; 0 to 3 - LD B,0 - CP 1 ; Is it zero? - ADC A,B ; Yes - Make it 1 - LD (SEED+1),A ; Re-save seed - LD HL,RNDTAB-4 ; Addition table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to value - CALL ADDPHL ; Add value to FPREG -RND1: CALL BCDEFP ; Move FPREG to BCDE - LD A,E ; Get LSB - LD E,C ; LSB = MSB - XOR 01001111B ; Fiddle around - LD C,A ; New MSB - LD (HL),80H ; Set exponent - DEC HL ; Point to MSB - LD B,(HL) ; Get MSB - LD (HL),80H ; Make value -0.5 - LD HL,SEED ; Random number seed - INC (HL) ; Count seed - LD A,(HL) ; Get seed - SUB 171 ; Do it modulo 171 - JP NZ,RND2 ; Non-zero - Ok - LD (HL),A ; Zero seed - INC C ; Fillde about - DEC D ; with the - INC E ; number -RND2: CALL BNORM ; Normalise number - LD HL,LSTRND ; Save random number - JP FPTHL ; Move FPREG to last and return - -RESEED: LD (HL),A ; Re-seed random numbers - DEC HL - LD (HL),A - DEC HL - LD (HL),A - JP RND1 ; Return RND seed - -RNDTAB: .BYTE 068H,0B1H,046H,068H ; Table used by RND - .BYTE 099H,0E9H,092H,069H - .BYTE 010H,0D1H,075H,068H - -COS: LD HL,HALFPI ; Point to PI/2 - CALL ADDPHL ; Add it to PPREG -SIN: CALL STAKFP ; Put angle on stack - LD BC,8349H ; BCDE = 2 PI - LD DE,0FDBH - CALL FPBCDE ; Move 2 PI to FPREG - POP BC ; Restore angle - POP DE - CALL DVBCDE ; Divide angle by 2 PI - CALL STAKFP ; Put it on stack - CALL INT ; Get INT of result - POP BC ; Restore number - POP DE - CALL SUBCDE ; Make it 0 <= value < 1 - LD HL,QUARTR ; Point to 0.25 - CALL SUBPHL ; Subtract value from 0.25 - CALL TSTSGN ; Test sign of value - SCF ; Flag positive - JP P,SIN1 ; Positive - Ok - CALL ROUND ; Add 0.5 to value - CALL TSTSGN ; Test sign of value - OR A ; Flag negative -SIN1: PUSH AF ; Save sign - CALL P,INVSGN ; Negate value if positive - LD HL,QUARTR ; Point to 0.25 - CALL ADDPHL ; Add 0.25 to value - POP AF ; Restore sign - CALL NC,INVSGN ; Negative - Make positive - LD HL,SINTAB ; Coefficient table - JP SUMSER ; Evaluate sum of series - -HALFPI: .BYTE 0DBH,00FH,049H,081H ; 1.5708 (PI/2) - -QUARTR: .BYTE 000H,000H,000H,07FH ; 0.25 - -SINTAB: .BYTE 5 ; Table used by SIN - .BYTE 0BAH,0D7H,01EH,086H ; 39.711 - .BYTE 064H,026H,099H,087H ;-76.575 - .BYTE 058H,034H,023H,087H ; 81.602 - .BYTE 0E0H,05DH,0A5H,086H ;-41.342 - .BYTE 0DAH,00FH,049H,083H ; 6.2832 - -TAN: CALL STAKFP ; Put angle on stack - CALL SIN ; Get SIN of angle - POP BC ; Restore angle - POP HL - CALL STAKFP ; Save SIN of angle - EX DE,HL ; BCDE = Angle - CALL FPBCDE ; Angle to FPREG - CALL COS ; Get COS of angle - JP DIV ; TAN = SIN / COS - -ATN: CALL TSTSGN ; Test sign of value - CALL M,NEGAFT ; Negate result after if -ve - CALL M,INVSGN ; Negate value if -ve - LD A,(FPEXP) ; Get exponent - CP 81H ; Number less than 1? - JP C,ATN1 ; Yes - Get arc tangnt - LD BC,8100H ; BCDE = 1 - LD D,C - LD E,C - CALL DVBCDE ; Get reciprocal of number - LD HL,SUBPHL ; Sub angle from PI/2 - PUSH HL ; Save for angle > 1 -ATN1: LD HL,ATNTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD HL,HALFPI ; PI/2 - angle in case > 1 - RET ; Number > 1 - Sub from PI/2 - -ATNTAB: .BYTE 9 ; Table used by ATN - .BYTE 04AH,0D7H,03BH,078H ; 1/17 - .BYTE 002H,06EH,084H,07BH ;-1/15 - .BYTE 0FEH,0C1H,02FH,07CH ; 1/13 - .BYTE 074H,031H,09AH,07DH ;-1/11 - .BYTE 084H,03DH,05AH,07DH ; 1/9 - .BYTE 0C8H,07FH,091H,07EH ;-1/7 - .BYTE 0E4H,0BBH,04CH,07EH ; 1/5 - .BYTE 06CH,0AAH,0AAH,07FH ;-1/3 - .BYTE 000H,000H,000H,081H ; 1/1 - - -ARET: RET ; A RETurn instruction - -GETINP: JP MC_BIOS_GETC ;input a character - -CLS: - LD A,CS ; ASCII Clear screen - JP MONOUT ; Output character - -WIDTH: CALL GETINT ; Get integer 0-255 - LD A,E ; Width to A - LD (LWIDTH),A ; Set width - RET - -LINES: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - LD (LINESC),DE ; Set lines counter - LD (LINESN),DE ; Set lines number - RET - -DEEK: CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save number - POP HL ; Number to HL - LD B,(HL) ; Get LSB of contents - INC HL - LD A,(HL) ; Get MSB of contents - JP ABPASS ; Return integer AB - -DOKE: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save address - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - EX (SP),HL ; Save value,get address - LD (HL),E ; Save LSB of value - INC HL - LD (HL),D ; Save MSB of value - POP HL ; Restore code string address - RET - - -; HEX$(nn) Convert 16 bit number to Hexadecimal string - -HEX: CALL TSTNUM ; Verify it's a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH BC ; Save contents of BC - LD HL,PBUFF - LD A,D ; Get high order into A - CP $0 - JR Z,HEX2 ; Skip output if both high digits are zero - CALL BYT2ASC ; Convert D to ASCII - LD A,B - CP '0' - JR Z,HEX1 ; Don't store high digit if zero - LD (HL),B ; Store it to PBUFF - INC HL ; Next location -HEX1: LD (HL),C ; Store C to PBUFF+1 - INC HL ; Next location -HEX2: LD A,E ; Get lower byte - CALL BYT2ASC ; Convert E to ASCII - LD A,D - CP $0 - JR NZ,HEX3 ; If upper byte was not zero then always print lower byte - LD A,B - CP '0' ; If high digit of lower byte is zero then don't print - JR Z,HEX4 -HEX3: LD (HL),B ; to PBUFF+2 - INC HL ; Next location -HEX4: LD (HL),C ; to PBUFF+3 - INC HL ; PBUFF+4 to zero - XOR A ; Terminating character - LD (HL),A ; Store zero to terminate - INC HL ; Make sure PBUFF is terminated - LD (HL),A ; Store the double zero there - POP BC ; Get BC back - LD HL,PBUFF ; Reset to start of PBUFF - JP STR1 ; Convert the PBUFF to a string and return it - -BYT2ASC LD B,A ; Save original value - AND $0F ; Strip off upper nybble - CP $0A ; 0-9? - JR C,ADD30 ; If A-F, add 7 more - ADD A,$07 ; Bring value up to ASCII A-F -ADD30 ADD A,$30 ; And make ASCII - LD C,A ; Save converted char to C - LD A,B ; Retrieve original value - RRCA ; and Rotate it right - RRCA - RRCA - RRCA - AND $0F ; Mask off upper nybble - CP $0A ; 0-9? < A hex? - JR C,ADD301 ; Skip Add 7 - ADD A,$07 ; Bring it up to ASCII A-F -ADD301 ADD A,$30 ; And make it full ASCII - LD B,A ; Store high order byte - RET - -; Convert "&Hnnnn" to FPREG -; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" -; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 -HEXTFP EX DE,HL ; Move code string pointer to DE - LD HL,$0000 ; Zero out the value - CALL GETHEX ; Check the number for valid hex - JP C,HXERR ; First value wasn't hex, HX error - JR HEXLP1 ; Convert first character -HEXLP CALL GETHEX ; Get second and addtional characters - JR C,HEXIT ; Exit if not a hex character -HEXLP1 ADD HL,HL ; Rotate 4 bits to the left - ADD HL,HL - ADD HL,HL - ADD HL,HL - OR L ; Add in D0-D3 into L - LD L,A ; Save new value - JR HEXLP ; And continue until all hex characters are in - -GETHEX INC DE ; Next location - LD A,(DE) ; Load character at pointer - CP ' ' - JP Z,GETHEX ; Skip spaces - SUB $30 ; Get absolute value - RET C ; < "0", error - CP $0A - JR C,NOSUB7 ; Is already in the range 0-9 - SUB $07 ; Reduce to A-F - CP $0A ; Value should be $0A-$0F at this point - RET C ; CY set if was : ; < = > ? @ -NOSUB7 CP $10 ; > Greater than "F"? - CCF - RET ; CY set if it wasn't valid hex - -HEXIT EX DE,HL ; Value into DE, Code string into HL - LD A,D ; Load DE into AC - LD C,E ; For prep to - PUSH HL - CALL ACPASS ; ACPASS to set AC as integer into FPREG - POP HL - RET - -HXERR: LD E,HX ; ?HEX Error - JP ERROR - -; BIN$(NN) Convert integer to a 1-16 char binary string -BIN: CALL TSTNUM ; Verify it's a number - CALL DEINT ; Get integer -32768 to 32767 -BIN2: PUSH BC ; Save contents of BC - LD HL,PBUFF - LD B,17 ; One higher than max char count -ZEROSUP: ; Suppress leading zeros - DEC B ; Max 16 chars - LD A,B - CP $01 - JR Z,BITOUT ; Always output at least one character - RL E - RL D - JR NC,ZEROSUP - JR BITOUT2 -BITOUT: - RL E - RL D ; Top bit now in carry -BITOUT2: - LD A,'0' ; Char for '0' - ADC A,0 ; If carry set then '0' --> '1' - LD (HL),A - INC HL - DEC B - JR NZ,BITOUT - XOR A ; Terminating character - LD (HL),A ; Store zero to terminate - INC HL ; Make sure PBUFF is terminated - LD (HL),A ; Store the double zero there - POP BC - LD HL,PBUFF - JP STR1 - -; Convert "&Bnnnn" to FPREG -; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" -BINTFP: EX DE,HL ; Move code string pointer to DE - LD HL,$0000 ; Zero out the value - CALL CHKBIN ; Check the number for valid bin - JP C,BINERR ; First value wasn't bin, HX error -BINIT: SUB '0' - ADD HL,HL ; Rotate HL left - OR L - LD L,A - CALL CHKBIN ; Get second and addtional characters - JR NC,BINIT ; Process if a bin character - EX DE,HL ; Value into DE, Code string into HL - LD A,D ; Load DE into AC - LD C,E ; For prep to - PUSH HL - CALL ACPASS ; ACPASS to set AC as integer into FPREG - POP HL - RET - -; Char is in A, NC if char is 0 or 1 -CHKBIN: INC DE - LD A,(DE) - CP ' ' - JP Z,CHKBIN ; Skip spaces - CP '0' ; Set C if < '0' - RET C - CP '2' - CCF ; Set C if > '1' - RET - -BINERR: LD E,BN ; ?BIN Error - JP ERROR - - -JJUMP1: LD IX,-1 ; Flag cold start - JP CSTART ; Go and initialise - -MONOUT: JP MC_BIOS_PUTC ; output a char - - -MONITR: CALL MC_BIOS_FLUSH - JP MC_BIOS_MONITOR ; Restart (Normally Monitor Start) - - -INITST: LD A,0 ; Clear break flag - LD (BRKFLG),A - JP INIT - -ARETN: RETN ; Return from NMI - - -TSTBIT: PUSH AF ; Save bit mask - AND B ; Get common bits - POP BC ; Restore bit mask - CP B ; Same bit set? - LD A,0 ; Return 0 in A - RET - -OUTNCR: CALL OUTC ; Output character in A - JP PRNTCRLF ; Output CRLF - -.end - diff --git a/apps/tinybasic/tinybasic.asm b/apps/tinybasic/tinybasic.asm deleted file mode 100644 index a123fe0..0000000 --- a/apps/tinybasic/tinybasic.asm +++ /dev/null @@ -1,1835 +0,0 @@ -;************************************************************* -; -; 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 linked as a ROM application at 2200. -; Fixed-page RST calls were converted to local CALLs. -; UART access uses the resident BIOS ABI at C050/C053. - - .include "bios.inc" - - -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 - -; Tiny BASIC owns lower RAM 8000-BFFF. The resident BIOS and monitor own -; C000-FFFF, so BASIC cannot overwrite them even when its stack is deep. -STACK = 0xBFFF ; Tiny BASIC stack grows down through B078-BFFF -OCSW = 0x8000 ;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 = 0xB000 ;TEXT SAVE AREA ENDS -VARBGN = 0xB000 ;VARIABLE @(0) -BUFFER = 0xB037 ;55-byte variable area ends here -BUFEND = 0xB077 ;64-byte input buffer ends here -STKLMT = 0xB078 ;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 TINYBASIC_ROM_ADDRESS -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 BIOS_PUTC ;SEND THE BYTE THROUGH BIOS 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 BIOS_TRY_GETC - OR A - RET -;------------------------------------------------------------------------------- -;/////////////////////////////////////////////////////////////////////////////// -;------------------------------------------------------------------------------- - -LSTROM: ;ALL ABOVE CAN BE ROM diff --git a/new/bios.asm b/bios.asm similarity index 100% rename from new/bios.asm rename to bios.asm diff --git a/bios.c b/bios.c deleted file mode 100644 index b44e15f..0000000 --- a/bios.c +++ /dev/null @@ -1,124 +0,0 @@ -#include -#include "bios.h" -#include "circ_buf.h" - -#define UART_CTC_CARD_BASE 0x20 -#define CTC_BASE (UART_CTC_CARD_BASE + 0x00) -#define CTC_CHANNEL_0 (CTC_BASE + 0) -#define CTC_CHANNEL_1 (CTC_BASE + 1) -#define CTC_CHANNEL_2 (CTC_BASE + 2) -#define CTC_CHANNEL_3 (CTC_BASE + 3) -#define UART_BASE (UART_CTC_CARD_BASE + 0x04) -#define UART_CONTROL (UART_BASE + 0) -#define UART_DATA (UART_BASE + 1) - -static volatile uint8_t uart_tx_busy; -static volatile circular_buffer_t rx_buf; -static volatile circular_buffer_t tx_buf; - -static void uart_kick(void) -{ - char c; - - disable_interrupts(); - if (!uart_tx_busy && buffer_dequeue(&tx_buf, &c)) { - uart_tx_busy = 1; - io_out(UART_DATA, c); - io_out(UART_CONTROL, 0b10110101); - } - enable_interrupts(); -} - -void bios_putc(char c) -{ - uint8_t queued; - - do { - disable_interrupts(); - queued = buffer_enqueue(&tx_buf, c); - enable_interrupts(); - if (!queued) uart_kick(); - } while (!queued); - uart_kick(); -} - -void bios_puts(const char *s) -{ - while (*s) bios_putc(*s++); -} - -uint8_t bios_try_getc(void) -{ - char c; - uint8_t received; - - disable_interrupts(); - received = buffer_dequeue(&rx_buf, &c); - enable_interrupts(); - return received ? (uint8_t)c : 0; -} - -char bios_getc(void) -{ - uint8_t c; - - do { - c = bios_try_getc(); - } while (!c); - return (char)c; -} - -void bios_flush(void) -{ - while (uart_tx_busy || !buffer_is_empty(&tx_buf)) uart_kick(); -} - -void bios_init(void) -{ - buffer_init(&rx_buf); - buffer_init(&tx_buf); - - /* A CPU-only reset does not necessarily reset the external CTC. Stop and - disable every channel before rebuilding the UART clock/IRQ path. */ - io_out(CTC_CHANNEL_0, 0x03); - io_out(CTC_CHANNEL_1, 0x03); - io_out(CTC_CHANNEL_2, 0x03); - io_out(CTC_CHANNEL_3, 0x03); - - /* The 6850 has no reset input; CR1:CR0 = 11 is its master reset. */ - io_out(UART_CONTROL, 0b00000011); - - io_out(CTC_CHANNEL_0, 0x57); - io_out(CTC_CHANNEL_0, 13); - io_out(CTC_CHANNEL_3, 0b11001111); - io_out(CTC_CHANNEL_3, 1); - io_out(CTC_CHANNEL_0, 0x00); - io_out(CTC_CHANNEL_0, 0x40); - - uart_tx_busy = 0; - io_out(UART_CONTROL, 0b10010101); - enable_interrupts(); -} - -void uart_interrupt(void) -{ - uint8_t status = io_in(UART_CONTROL); - - if ((status & 0x21) != 0) { - char c = io_in(UART_DATA); - if ((status & 0x01) != 0) buffer_enqueue(&rx_buf, c); - } - if ((status & 0x02) != 0 && uart_tx_busy) { - char c; - if (buffer_dequeue(&tx_buf, &c)) { - io_out(UART_DATA, c); - } else { - io_out(UART_CONTROL, 0b10010101); - uart_tx_busy = 0; - } - } -} - -void ctc_interrupt(void) -{ -} diff --git a/bios.h b/bios.h deleted file mode 100644 index 6968a0e..0000000 --- a/bios.h +++ /dev/null @@ -1,27 +0,0 @@ -#ifndef BIOS_H -#define BIOS_H - -#include - -/* Resident BIOS API used by the monitor. */ -void bios_init(void); -void bios_putc(char c); -void bios_puts(const char *s); -char bios_getc(void); -uint8_t bios_try_getc(void); -void bios_flush(void); - -/* Write-only banking latch services. */ -void bios_bank(uint8_t bank); -void bios_rom_disable(void); -void bios_rom_enable(void); - -/* Low-level routines implemented by the resident assembly BIOS. */ -void io_out(uint8_t port, uint8_t value); -uint8_t io_in(uint8_t port); -void delay_ms(uint16_t milliseconds); -void enable_interrupts(void); -void disable_interrupts(void); -void jump_to(uint16_t address); - -#endif diff --git a/new/bios.inc b/bios.inc similarity index 100% rename from new/bios.inc rename to bios.inc diff --git a/boot.asm b/boot.asm deleted file mode 100644 index 934dcf4..0000000 --- a/boot.asm +++ /dev/null @@ -1,413 +0,0 @@ -STACK_TOP = 0xFFFF -DELAY_LOOPS_PER_MS = 40 -BANK_CONTROL_PORT = 0x00 -BOOT_BANK_MAPPING = 0x06 ; ROM on, banking on, upper 16K at C000-FFFF -ROM_DISABLE_BIT = 0x01 -BANK_SELECT_BIT = 0x02 -BANK_ENABLE_BIT = 0x04 -BANK_MODE_CLEAR_MASK = 0xF9 ; preserve ROM-disable and auxiliary outputs - - .include "bios.inc" - - .globl _main - .globl _delay_ms - .globl _io_out - .globl _io_in - .globl _enable_interrupts - .globl _disable_interrupts - .globl _jump_to - .globl _bios_putc - .globl _bios_try_getc - .globl _bios_getc - .globl _bios_flush - .globl _bios_init - .globl _bios_bank - .globl _bios_rom_disable - .globl _bios_rom_enable - .globl _bank_control_shadow - .globl resident_image_end - .globl s__DATA - .globl l__DATA - .globl s__INITIALIZER - .globl s__INITIALIZED - .globl l__INITIALIZER - -.area _BOOT (ABS) - -.org 0x00 - jp boot_copy -.org 0x08 -boot_copy: - di - ; Keep ROM enabled while mapping the upper physical 16K at C000-FFFF. - ; The resident copy therefore survives either banked mode after boot. - ld a, #BOOT_BANK_MAPPING - out (BANK_CONTROL_PORT), a - ld sp, #STACK_TOP - ld hl, #RESIDENT_ROM_OFFSET - ld de, #RESIDENT_RAM_BASE - ld bc, #(resident_image_end - RESIDENT_RAM_BASE) - ldir - jp init - -.area _ITABLE (ABS) - -; The executable vector page is part of the image copied to high RAM. -.org RESIDENT_RAM_BASE - jp init -.org RESIDENT_RAM_BASE + 0x08 - reti -.org RESIDENT_RAM_BASE + 0x10 - reti -.org RESIDENT_RAM_BASE + 0x18 - reti -.org RESIDENT_RAM_BASE + 0x20 - reti -.org RESIDENT_RAM_BASE + 0x28 - reti -.org RESIDENT_RAM_BASE + 0x30 - reti -.org RESIDENT_RAM_BASE + 0x38 - reti - -; IM 2 table: the CTC supplies vectors 40, 42, 44, and 46. -.org RESIDENT_RAM_BASE + 0x40 - .dw ctc_isr ; CTC channel 0: vector 0x40 - .dw ctc_isr ; CTC channel 1: vector 0x42 - .dw ctc_isr ; CTC channel 2: vector 0x44 - .dw uart_isr ; CTC channel 3: vector 0x46 - -; Stable BIOS jump table for ROM-resident applications. -; C050 putc(A), C053 try_getc(), C056 getc(), C059 io_out(A,L), -; C05C io_in(A), C05F delay_ms(HL), C062 monitor warm start, -; C065 bank(A), C068 disable ROM, C06B enable ROM, C06E flush output. -.org BIOS_PUTC - jp bios_service_putc -.org BIOS_TRY_GETC - jp bios_service_try_getc -.org BIOS_GETC - jp bios_service_getc -.org BIOS_IO_OUT - jp bios_service_io_out -.org BIOS_IO_IN - jp bios_service_io_in -.org BIOS_DELAY_MS - jp bios_service_delay_ms -.org BIOS_MONITOR - jp init -.org BIOS_BANK - jp _bios_bank -.org BIOS_ROM_DISABLE - jp _bios_rom_disable -.org BIOS_ROM_ENABLE - jp _bios_rom_enable -.org BIOS_FLUSH - jp bios_service_flush - -; Port 00 is write-only. Keep its last BIOS-managed value outside the C data -; areas so a monitor warm start does not reset it. The bootstrap establishes -; this same value in the hardware before the resident image is copied. -.org RESIDENT_RAM_BASE + 0x73 -_bank_control_shadow:: - .db BOOT_BANK_MAPPING - -.area _HOME -init: - di - ld sp, #STACK_TOP - - ; A reset may have interrupted a CTC service routine without executing - ; RETI. Release any stale daisy-chain in-service latches before the - ; channels are reinitialized. RETI acts as RET for each CALL while - ; also signalling end-of-interrupt to daisy-chained peripherals. - call release_daisy_chain - call release_daisy_chain - call release_daisy_chain - call release_daisy_chain - - call gsinit - - ; Setup interrupt mode 2 - ld a, #0xC0 - ld i, a - im 2 - call _bios_init - call _main - -hang: - jr hang - -release_daisy_chain: - reti - -.area _GSINIT -gsinit: - ld bc, #l__INITIALIZER - ld a, b - or c - jr z, zero_data - - ld de, #s__INITIALIZED - ld hl, #s__INITIALIZER - ldir - -zero_data: - ld bc, #l__DATA - ld a, b - or c - jr z, gsinit_done - - ld hl, #s__DATA - xor a - -clear_loop: - xor a ; BC loop test below changes A - ld (hl), a - inc hl - dec bc - ld a, b - or c - jr nz, clear_loop - -gsinit_done: -.area _GSFINAL - ret -resident_image_end: - -.area _CODE - -; Select a RAM mapping while retaining the shadowed ROM-disable bit. -; Input: A=0 selects lower 48K + upper 16K; any other value selects upper 64K. -; Both modes keep banking enabled. A and flags are preserved. -_bios_bank:: - push af - or a - jr z, bios_bank_split - - ld a, (_bank_control_shadow) - and #BANK_MODE_CLEAR_MASK - or #BANK_ENABLE_BIT - jr bios_bank_update - -bios_bank_split: - ld a, (_bank_control_shadow) - and #BANK_MODE_CLEAR_MASK - or #(BANK_ENABLE_BIT | BANK_SELECT_BIT) - -bios_bank_update: - ld (_bank_control_shadow), a - out (BANK_CONTROL_PORT), a - pop af - ret - -; Hide ROM while preserving the selected RAM mapping. -; A and flags are preserved. -_bios_rom_disable:: - push af - ld a, (_bank_control_shadow) - or #ROM_DISABLE_BIT - jr bios_bank_update - -; Make ROM visible again while preserving the selected RAM mapping. -; A and flags are preserved. -_bios_rom_enable:: - push af - ld a, (_bank_control_shadow) - and #0xFE - jr bios_bank_update - -; BIOS ABI services preserve registers except documented return values. -bios_service_putc: - push af - push bc - push de - push hl - push ix - push iy - call _bios_putc - pop iy - pop ix - pop hl - pop de - pop bc - pop af - ret - -bios_service_try_getc: - push bc - push de - push hl - push ix - push iy - call _bios_try_getc - pop iy - pop ix - pop hl - pop de - pop bc - ret - -bios_service_getc: - push bc - push de - push hl - push ix - push iy - call _bios_getc - pop iy - pop ix - pop hl - pop de - pop bc - ret - -bios_service_flush: - push af - push bc - push de - push hl - push ix - push iy - call _bios_flush - pop iy - pop ix - pop hl - pop de - pop bc - pop af - ret - -bios_service_io_out: - push af - push bc - push de - push hl - push ix - push iy - call _io_out - pop iy - pop ix - pop hl - pop de - pop bc - pop af - ret - -bios_service_io_in: - push bc - push de - push hl - push ix - push iy - call _io_in - pop iy - pop ix - pop hl - pop de - pop bc - ret - -bios_service_delay_ms: - push af - push bc - push de - push hl - push ix - push iy - call _delay_ms - pop iy - pop ix - pop hl - pop de - pop bc - pop af - ret - -.macro MAKE_ISR entry, handler - .globl handler -entry: - push af - push bc - push de - push hl - push ix - push iy - - ex af, af' - push af - exx - push bc - push de - push hl - - call handler - - pop hl - pop de - pop bc - exx - pop af - ex af, af' - - pop iy - pop ix - pop hl - pop de - pop bc - pop af - ei - reti -.endm - -MAKE_ISR ctc_isr, _ctc_interrupt -MAKE_ISR uart_isr, _uart_interrupt - -_enable_interrupts:: - ei - ret - -_disable_interrupts:: - di - ret - -; Write a byte to an I/O port. -; Input: A = port address, L = data byte. -_io_out:: - ld c, a - ld a, l - out (c), a - ret - -; Read a byte from an I/O port. -; Input: A = port address. -; Return: A = data byte. -_io_in:: - ld c, a - in a, (c) - ret - -; Execute code at HL. Because this routine is entered with CALL, a RET in the -; target returns to the monitor immediately after jump_to(). -_jump_to:: - jp (hl) - -; Approximate millisecond delay. -; Input: HL = delay in milliseconds. -_delay_ms:: - ld a, h - or l - ret z -delay_ms_outer$: - push hl - ld hl, #DELAY_LOOPS_PER_MS -delay_ms_inner$: - dec hl - ld a, h - or l - jr nz, delay_ms_inner$ - pop hl - dec hl - ld a, h - or l - jr nz, delay_ms_outer$ - ret diff --git a/circ_buf.c b/circ_buf.c deleted file mode 100644 index 4c0a739..0000000 --- a/circ_buf.c +++ /dev/null @@ -1,33 +0,0 @@ -#include "circ_buf.h" - -void buffer_init(volatile circular_buffer_t* b){ - b->count = 0; - b->head = 0; - b->tail = 0; -} - -uint8_t buffer_is_full(volatile circular_buffer_t* b){ - return b->count == BUFFER_SIZE; -} - -uint8_t buffer_is_empty(volatile circular_buffer_t* b){ - return b->count == 0; -} - -uint8_t buffer_enqueue(volatile circular_buffer_t* b, char c){ - if(buffer_is_full(b)) - return 0; - b->data[b->head] = c; - b->head = (b->head+1)%BUFFER_SIZE; - b->count++; - return 1; -} - -uint8_t buffer_dequeue(volatile circular_buffer_t* b, char* c){ - if(buffer_is_empty(b)) - return 0; - *c = b->data[b->tail]; - b->tail = (b->tail+1)%BUFFER_SIZE; - b->count--; - return 1; -} diff --git a/circ_buf.h b/circ_buf.h deleted file mode 100644 index 9a1cf7e..0000000 --- a/circ_buf.h +++ /dev/null @@ -1,21 +0,0 @@ -#ifndef __H_CIRC_BUF -#define __H_CIRC_BUF - -#include - -#define BUFFER_SIZE 64 - -typedef struct { - char data[BUFFER_SIZE]; - uint8_t head; - uint8_t tail; - uint8_t count; -} circular_buffer_t; - -void buffer_init(volatile circular_buffer_t* b); -uint8_t buffer_is_full(volatile circular_buffer_t* b); -uint8_t buffer_is_empty(volatile circular_buffer_t* b); -uint8_t buffer_enqueue(volatile circular_buffer_t* b, char c); -uint8_t buffer_dequeue(volatile circular_buffer_t* b, char* c); - -#endif diff --git a/new/hardware.inc b/hardware.inc similarity index 100% rename from new/hardware.inc rename to hardware.inc diff --git a/include/bios.inc b/include/bios.inc deleted file mode 100644 index 8598e7c..0000000 --- a/include/bios.inc +++ /dev/null @@ -1,14 +0,0 @@ - .include "rom_layout.inc" - -; Stable assembly ABI exported by the resident BIOS. -BIOS_PUTC = RESIDENT_RAM_BASE + 0x50 ; A = character; preserves all registers -BIOS_TRY_GETC = RESIDENT_RAM_BASE + 0x53 ; returns A = character or 0; preserves BC..IY -BIOS_GETC = RESIDENT_RAM_BASE + 0x56 ; blocking; returns character in A -BIOS_IO_OUT = RESIDENT_RAM_BASE + 0x59 ; A = port, L = value; preserves all registers -BIOS_IO_IN = RESIDENT_RAM_BASE + 0x5C ; A = port; returns value in A -BIOS_DELAY_MS = RESIDENT_RAM_BASE + 0x5F ; HL = milliseconds; preserves all registers -BIOS_MONITOR = RESIDENT_RAM_BASE + 0x62 ; warm-start the monitor; does not return -BIOS_BANK = RESIDENT_RAM_BASE + 0x65 ; A=0 split 48K/16K, otherwise upper 64K -BIOS_ROM_DISABLE = RESIDENT_RAM_BASE + 0x68 ; disable ROM while preserving the bank selection -BIOS_ROM_ENABLE = RESIDENT_RAM_BASE + 0x6B ; enable ROM while preserving the bank selection -BIOS_FLUSH = RESIDENT_RAM_BASE + 0x6E ; wait until all queued UART output is sent diff --git a/new/memory.mk b/memory.mk similarity index 100% rename from new/memory.mk rename to memory.mk diff --git a/monitor.c b/monitor.c deleted file mode 100644 index a5df9a5..0000000 --- a/monitor.c +++ /dev/null @@ -1,362 +0,0 @@ -#include -#include "bios.h" -#include "rom_layout.h" - -#define LINE_SIZE 80 -#define MAX_ARGS 40 -#define DEFAULT_DUMP_LENGTH 0x40 -#define MAX_DUMP_LENGTH 0x100 - -static char hex_digit(uint8_t value) -{ - value &= 0x0f; - return value < 10 ? (char)('0' + value) : (char)('A' + value - 10); -} - -static void print_hex8(uint8_t value) -{ - bios_putc(hex_digit(value >> 4)); - bios_putc(hex_digit(value)); -} - -static void print_hex16(uint16_t value) -{ - print_hex8((uint8_t)(value >> 8)); - print_hex8((uint8_t)value); -} - -static uint8_t hex_value(char c, uint8_t *value) -{ - if (c >= '0' && c <= '9') { - *value = (uint8_t)(c - '0'); - return 1; - } - if (c >= 'a' && c <= 'f') { - *value = (uint8_t)(c - 'a' + 10); - return 1; - } - if (c >= 'A' && c <= 'F') { - *value = (uint8_t)(c - 'A' + 10); - return 1; - } - return 0; -} - -static uint8_t parse_hex(const char *text, uint16_t *result) -{ - uint16_t value = 0; - uint8_t digit; - uint8_t digits = 0; - - if (text[0] == '0' && (text[1] == 'x' || text[1] == 'X')) text += 2; - while (*text) { - if (digits == 4 || !hex_value(*text++, &digit)) return 0; - value = (uint16_t)((value << 4) | digit); - ++digits; - } - if (digits == 0) return 0; - *result = value; - return 1; -} - -static uint8_t strings_equal(const char *a, const char *b) -{ - char ca; - char cb; - - do { - ca = *a++; - cb = *b++; - if (ca >= 'A' && ca <= 'Z') ca += 'a' - 'A'; - if (cb >= 'A' && cb <= 'Z') cb += 'a' - 'A'; - if (ca != cb) return 0; - } while (ca); - return 1; -} - -static uint8_t split_line(char *line, char **argv) -{ - uint8_t argc = 0; - - while (*line) { - while (*line == ' ' || *line == '\t') ++line; - if (!*line) break; - if (argc == MAX_ARGS) return argc; - argv[argc++] = line; - while (*line && *line != ' ' && *line != '\t') ++line; - if (*line) *line++ = 0; - } - return argc; -} - -static void print_help(void) -{ - bios_puts( - "Commands (hex numbers):\r\n" - " D addr [len] Dump memory\r\n" - " C start end 16-bit checksum, inclusive\r\n" - " W addr byte... Write memory\r\n" - " I port Read I/O\r\n" - " O port byte Write I/O\r\n" - " K bank Bank: 0=split, 1=upper 64K\r\n" - " R ON|OFF Enable or disable ROM\r\n" - " G addr Execute\r\n" - " B Tiny BASIC\r\n" - " T Tape loader\r\n" - " H Help\r\n"); -} - -static void command_dump(uint8_t argc, char **argv) -{ - uint16_t address; - uint16_t length = DEFAULT_DUMP_LENGTH; - uint16_t offset = 0; - - if (argc < 2 || argc > 3 || !parse_hex(argv[1], &address) || - (argc == 3 && !parse_hex(argv[2], &length))) { - bios_puts("Usage: D address [length]\r\n"); - return; - } - if (length > MAX_DUMP_LENGTH) { - bios_puts("Length must be 0100 or less\r\n"); - return; - } - while (offset < length) { - uint8_t column; - uint8_t row_length = (uint8_t)((length - offset) > 16 ? 16 : (length - offset)); - - print_hex16((uint16_t)(address + offset)); - bios_puts(": "); - for (column = 0; column < row_length; ++column) { - print_hex8(*(volatile uint8_t *)(address + offset + column)); - bios_putc(' '); - } - for (; column < 16; ++column) { - bios_puts(" "); - } - bios_putc('|'); - for (column = 0; column < row_length; ++column) { - uint8_t value = *(volatile uint8_t *)(address + offset + column); - bios_putc(value >= ' ' && value <= '~' ? (char)value : '.'); - } - bios_putc('|'); - bios_puts("\r\n"); - offset += row_length; - } -} - -static void command_checksum(uint8_t argc, char **argv) -{ - uint16_t address; - uint16_t end; - uint16_t checksum = 0; - - if (argc != 3 || !parse_hex(argv[1], &address) || - !parse_hex(argv[2], &end) || end < address) { - bios_puts("Usage: C start end\r\n"); - return; - } - - for (;;) { - checksum = (uint16_t)(checksum + *(volatile uint8_t *)address); - if (address == end) break; - ++address; - } - - print_hex16(checksum); - bios_puts("\r\n"); -} - -static void command_write(uint8_t argc, char **argv) -{ - uint16_t address; - uint16_t value; - uint8_t i; - - if (argc < 3 || !parse_hex(argv[1], &address)) { - bios_puts("Usage: W address byte [byte ...]\r\n"); - return; - } - for (i = 2; i < argc; ++i) { - if (!parse_hex(argv[i], &value) || value > 0xff) { - bios_puts("Bad byte: "); - bios_puts(argv[i]); - bios_puts("\r\n"); - return; - } - *(volatile uint8_t *)address++ = (uint8_t)value; - } - bios_puts("OK\r\n"); -} - -static void command_in(uint8_t argc, char **argv) -{ - uint16_t port; - - if (argc != 2 || !parse_hex(argv[1], &port) || port > 0xff) { - bios_puts("Usage: I port\r\n"); - return; - } - print_hex8((uint8_t)port); - bios_puts(": "); - print_hex8(io_in((uint8_t)port)); - bios_puts("\r\n"); -} - -static void command_out(uint8_t argc, char **argv) -{ - uint16_t port; - uint16_t value; - - if (argc != 3 || !parse_hex(argv[1], &port) || port > 0xff || - !parse_hex(argv[2], &value) || value > 0xff) { - bios_puts("Usage: O port byte\r\n"); - return; - } - io_out((uint8_t)port, (uint8_t)value); - bios_puts("OK\r\n"); -} - -static void command_bank(uint8_t argc, char **argv) -{ - uint16_t bank; - - if (argc != 2 || !parse_hex(argv[1], &bank) || bank > 1) { - bios_puts("Usage: BANK 0|1\r\n"); - return; - } - bios_bank((uint8_t)bank); - bios_puts("OK\r\n"); -} - -static void command_rom(uint8_t argc, char **argv) -{ - if (argc != 2) { - bios_puts("Usage: ROM ON|OFF\r\n"); - return; - } - if (strings_equal(argv[1], "on")) { - bios_rom_enable(); - } else if (strings_equal(argv[1], "off")) { - bios_rom_disable(); - } else { - bios_puts("Usage: ROM ON|OFF\r\n"); - return; - } - bios_puts("OK\r\n"); -} - -static void execute_address(uint16_t address) -{ - bios_puts("Executing at "); - print_hex16(address); - bios_puts("...\r\n"); - bios_flush(); - jump_to(address); - bios_puts("Returned to monitor\r\n"); -} - -static void command_go(uint8_t argc, char **argv) -{ - uint16_t address; - - if (argc != 2 || !parse_hex(argv[1], &address)) { - bios_puts("Usage: G address\r\n"); - return; - } - execute_address(address); -} - -static void command_basic(uint8_t argc) -{ - if (argc != 1) { - bios_puts("Usage: B\r\n"); - return; - } - execute_address(TINYBASIC_ROM_ADDRESS); -} - -static void command_tape(uint8_t argc) -{ - if (argc != 1) { - bios_puts("Usage: T\r\n"); - return; - } - execute_address(TAPE_LOADER_ROM_ADDRESS); -} - -static void execute_line(char *line) -{ - char *argv[MAX_ARGS]; - uint8_t argc = split_line(line, argv); - - if (!argc) return; - if (strings_equal(argv[0], "h") || strings_equal(argv[0], "help") || - strings_equal(argv[0], "?")) { - print_help(); - } else if (strings_equal(argv[0], "d") || strings_equal(argv[0], "dump")) { - command_dump(argc, argv); - } else if (strings_equal(argv[0], "c") || strings_equal(argv[0], "checksum")) { - command_checksum(argc, argv); - } else if (strings_equal(argv[0], "w") || strings_equal(argv[0], "write")) { - command_write(argc, argv); - } else if (strings_equal(argv[0], "i") || strings_equal(argv[0], "in")) { - command_in(argc, argv); - } else if (strings_equal(argv[0], "o") || strings_equal(argv[0], "out")) { - command_out(argc, argv); - } else if (strings_equal(argv[0], "k") || strings_equal(argv[0], "bank")) { - command_bank(argc, argv); - } else if (strings_equal(argv[0], "r") || strings_equal(argv[0], "rom")) { - command_rom(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 if (strings_equal(argv[0], "t") || strings_equal(argv[0], "tape")) { - command_tape(argc); - } else { - bios_puts("Unknown command; type HELP\r\n"); - } -} - -void main(void) -{ - char line[LINE_SIZE]; - uint8_t length = 0; - uint8_t ignore_lf = 0; - - bios_puts("\r\nZ80 monitor - v1\r\nType HELP for commands.\r\n> "); - - for (;;) { - char c = bios_getc(); - - if (c == '\n' && ignore_lf) { - ignore_lf = 0; - continue; - } - ignore_lf = 0; - if (c == '\r' || c == '\n') { - ignore_lf = (c == '\r'); - line[length] = 0; - bios_puts("\r\n"); - execute_line(line); - length = 0; - bios_puts("> "); - } else if (c == '\b' || c == 0x7f) { - if (length) { - --length; - bios_puts("\b \b"); - } - } else if (c == 0x15) { - while (length) { - --length; - bios_puts("\b \b"); - } - } else if (c >= ' ' && c <= '~' && length < LINE_SIZE - 1) { - line[length++] = c; - bios_putc(c); - } else if (c >= ' ' && c <= '~') { - bios_putc('\a'); - } - } -} diff --git a/new/.gitignore b/new/.gitignore deleted file mode 100644 index 378eac2..0000000 --- a/new/.gitignore +++ /dev/null @@ -1 +0,0 @@ -build diff --git a/new/Makefile b/new/Makefile deleted file mode 100644 index 1e5ff47..0000000 --- a/new/Makefile +++ /dev/null @@ -1,55 +0,0 @@ -.SILENT: -include memory.mk - -ASM := zasm -ASMFLAGS := -w -b -BUILDDIR := build - -FILES := bios - -SOURCES := $(addprefix ./, $(addsuffix .asm, $(FILES))) -TARGETS := $(addprefix $(BUILDDIR)/, $(addsuffix .bin, $(FILES))) - -TOPTARGETS := all clean size -$(TOPTARGETS): $(SUBDIRS) - -all: $(BUILDDIR) $(BUILDDIR)/rom.bin size - -clean: - rm -rf $(BUILDDIR) - -$(BUILDDIR): - mkdir -p $(BUILDDIR) - -$(BUILDDIR)/%.bin: ./%.asm $(BUILDDIR)/memory.inc - echo '>$<' - $(ASM) $(ASMFLAGS) $< $@ - -size: - @for file in $(TARGETS); do \ - if [ -f "$$file" ]; then \ - echo "$$file: $$(wc -c < "$$file") bytes"; \ - else \ - echo "$$file: Not built yet (run 'make')"; \ - fi \ - done - $(MAKE) -C apps/basic size --no-print-directory - -$(BUILDDIR)/basic.bin: - $(MAKE) -C apps/basic $(or $(MAKECMDGOALS),all) --no-print-directory - -$(BUILDDIR)/memory.inc: memory.mk - @mkdir -p $(@D) - @awk 'BEGIN { print "; Generated from rom_layout.mk; do not edit." } \ - /^[A-Z][A-Z0-9_]*[[:space:]]*:=[[:space:]]*/ { print $$1 " .equ " $$3 }' $< > $@ - -$(BUILDDIR)/rom.bin: $(BUILDDIR)/bios.bin $(BUILDDIR)/basic.bin - objcopy --pad-to=$$(($(BIOS_ROM_START)+$(BIOS_ROM_SIZE))) \ - -I binary $(BUILDDIR)/bios.bin -O binary $(BUILDDIR)/bios_padded.bin - objcopy --pad-to=$(BASIC_ROM_SIZE) \ - -I binary $(BUILDDIR)/basic.bin -O binary $(BUILDDIR)/basic_padded.bin - cat $(BUILDDIR)/bios_padded.bin $(BUILDDIR)/basic_padded.bin > $(BUILDDIR)/rom.bin - - -.PHONY: $(TOPTARGETS) $(SUBDIRS) - diff --git a/new/apps/basic/nascom8kbasic.asm b/new/apps/basic/nascom8kbasic.asm deleted file mode 100644 index 24130f2..0000000 --- a/new/apps/basic/nascom8kbasic.asm +++ /dev/null @@ -1,4855 +0,0 @@ -; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft -; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 -; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) -; Adapted for the freeware Zilog Macro Assembler 2.10 to produce -; the original ROM code (checksum A934H). PA - -; MONITOR EQUATES (RESTART INSTRUCTIONS) - -_ROUT EQU 0F7H ; ROUT - Output char in A -_BLNK EQU 07BDFH ; SCAL BLINK - Get input char in A -_INLN EQU 063DFH ; SCAL INLIN - Get input line -_MFLP EQU 05FDFH ; SCAL MFLP - Toggle tape drv LED -_MRET EQU 05BDFH ; SCAL MRET - Return to monitor -_READ EQU 052DFH ; SCAL READ -_RIN EQU 062DFH ; SCAL RIN - Scan for input char -_VRFY EQU 056DFH ; SCAL VERIFY -_WRIT EQU 057DFH ; SCAL WRITE - -; GENERAL EQUATES - -UARTD EQU 01H ; UART data port -UARTS EQU 02H ; UART status port -CTRLC EQU 03H ; Control "C" -CTRLG EQU 07H ; Control "G" -BKSP EQU 08H ; Back space -LF EQU 0AH ; Line feed -CS EQU 0CH ; Clear screen -CR EQU 0DH ; Carriage return -CTRLO EQU 0FH ; Control "O" -CTRLR EQU 12H ; Control "R" -CTRLS EQU 13H ; Control "S" -CTRLU EQU 15H ; Control "U" -CTRLZ EQU 1AH ; Control "Z" -ESC EQU 1BH ; Escape -TBRK EQU 1CH ; "T" monitor break -TBS EQU 1DH ; "T" monitor back space -TCS EQU 1EH ; "T" monitor clear screen -TCR EQU 1FH ; "T" monitor carriage return -DEL EQU 7FH ; Delete - -; MONITOR LOCATIONS - -MONSTT EQU 0000H ; Start of monitor -STMON EQU 000DH ; NAS-SYS initialisation -MFLP EQU 0051H ; Flip tape LED ("T") -MONTYP EQU 008DH ; Type of "T" monitor -T2DUMP EQU 03D1H ; "T2" Dump routine -T4WR EQU 0400H ; "T4" Write routine -T4READ EQU 070CH ; "T4" Read routine -VDU EQU 0800H ; NASCOM Video RAM base - -; MONITOR WORK SPACE LOCATIONS - -PORT0 EQU 0C00H ; Copy of output port 0 -ARG1 EQU 0C0CH ; Argument 1 -ARG2 EQU 0C0EH ; Argument 2 -TCUR EQU 0C18H ; "T" monitor cursor -CURSOR EQU 0C29H ; NAS-SYS Cursor -ARGN EQU 0C2BH ; Number of ARGS -TOUT EQU 0C4AH ; "T" Output reflection -TIN EQU 0C4DH ; "T" Input reflection -CIN EQU 0C75H ; NAS-SYS Input table -NMI EQU 0C7EH ; NAS-SYS NMI Jump - -; BASIC WORK SPACE LOCATIONS - -WRKSPC EQU 1000H ; BASIC Work space -USR EQU 1003H ; "USR (x)" jump -OUTSUB EQU 1006H ; "OUT p,n" -OTPORT EQU 1007H ; Port (p) -DIVSUP EQU 1009H ; Division support routine -DIV1 EQU 100AH ; <- Values -DIV2 EQU 100EH ; <- to -DIV3 EQU 1012H ; <- be -DIV4 EQU 1015H ; <-inserted -SEED EQU 1017H ; Random number seed -LSTRND EQU 103AH ; Last random number -INPSUB EQU 103EH ; #INP (x)" Routine -INPORT EQU 103FH ; PORT (x) -NULLS EQU 1041H ; Number of nulls -LWIDTH EQU 1042H ; Terminal width -COMMAN EQU 1043H ; Width for commas -NULFLG EQU 1044H ; Null after input byte flag -CTLOFG EQU 1045H ; Control "O" flag -LINESC EQU 1046H ; Lines counter -LINESN EQU 1048H ; Lines number -CHKSUM EQU 104AH ; Array load/save check sum -NMIFLG EQU 104CH ; Flag for NMI break routine -BRKFLG EQU 104DH ; Break flag -RINPUT EQU 104EH ; Input reflection -POINT EQU 1051H ; "POINT" reflection (unused) -PSET EQU 1054H ; "SET" reflection -RESET EQU 1057H ; "RESET" reflection -STRSPC EQU 105AH ; Bottom of string space -LINEAT EQU 105CH ; Current line number -BASTXT EQU 105EH ; Pointer to start of program -BUFFER EQU 1061H ; Input buffer -STACK EQU 1066H ; Initial stack -CURPOS EQU 10ABH ; Character position on line -LCRFLG EQU 10ACH ; Locate/Create flag -TYPE EQU 10ADH ; Data type flag -DATFLG EQU 10AEH ; Literal statement flag -LSTRAM EQU 10AFH ; Last available RAM -TMSTPT EQU 10B1H ; Temporary string pointer -TMSTPL EQU 10B3H ; Temporary string pool -TMPSTR EQU 10BFH ; Temporary string -STRBOT EQU 10C3H ; Bottom of string space -CUROPR EQU 10C5H ; Current operator in EVAL -LOOPST EQU 10C7H ; First statement of loop -DATLIN EQU 10C9H ; Line of current DATA item -FORFLG EQU 10CBH ; "FOR" loop flag -LSTBIN EQU 10CCH ; Last byte entered -READFG EQU 10CDH ; Read/Input flag -BRKLIN EQU 10CEH ; Line of break -NXTOPR EQU 10D0H ; Next operator in EVAL -ERRLIN EQU 10D2H ; Line of error -CONTAD EQU 10D4H ; Where to CONTinue -PROGND EQU 10D6H ; End of program -VAREND EQU 10D8H ; End of variables -ARREND EQU 10DAH ; End of arrays -NXTDAT EQU 10DCH ; Next data item -FNRGNM EQU 10DEH ; Name of FN argument -FNARG EQU 10E0H ; FN argument value -FPREG EQU 10E4H ; Floating point register -FPEXP EQU FPREG+3 ; Floating point exponent -SGNRES EQU 10E8H ; Sign of result -PBUFF EQU 10E9H ; Number print buffer -MULVAL EQU 10F6H ; Multiplier -PROGST EQU 10F9H ; Start of program text area -STLOOK EQU 115DH ; Start of memory test - -; BASIC ERROR CODE VALUES - -NF EQU 00H ; NEXT without FOR -SN EQU 02H ; Syntax error -RG EQU 04H ; RETURN without GOSUB -OD EQU 06H ; Out of DATA -FC EQU 08H ; Function call error -OV EQU 0AH ; Overflow -OM EQU 0CH ; Out of memory -UL EQU 0EH ; Undefined line number -BS EQU 10H ; Bad subscript -DD EQU 12H ; Re-DIMensioned array -DZ EQU 14H ; Division by zero (/0) -ID EQU 16H ; Illegal direct -TM EQU 18H ; Type miss-match -OS EQU 1AH ; Out of string space -LS EQU 1CH ; String too long -ST EQU 1EH ; String formula too complex -CN EQU 20H ; Can't CONTinue -UF EQU 22H ; UnDEFined FN function -MO EQU 24H ; Missing operand - - ORG 0E000H - -START: JP STARTB ; Jump for restart jump -STARTB: DI ; No interrupts - LD IX,0 ; Flag cold start - JP CSTART ; Jump to initialise - - DW DEINT ; Get integer -32768 to 32767 - DW ABPASS ; Return integer in AB - - JP LDNMI1 ; << NO REFERENCE TO HERE >> - -CSTART: LD HL,WRKSPC ; Start of workspace RAM - LD SP,HL ; Set up a temporary stack - JP INITST ; Go to initialise - -INIT: LD DE,INITAB ; Initialise workspace - LD B,INITBE-INITAB+3; Bytes to copy - LD HL,WRKSPC ; Into workspace RAM -COPY: LD A,(DE) ; Get source - LD (HL),A ; To destination - INC HL ; Next destination - INC DE ; Next source - DEC B ; Count bytes - JP NZ,COPY ; More to move - LD SP,HL ; Temporary stack - CALL CLREG ; Clear registers and stack - CALL PRNTCR ; Output CRLF - LD (BUFFER+72+1),A ; Mark end of buffer - LD (PROGST),A ; Initialise program area -MSIZE: LD HL,MEMMSG ; Point to message - CALL PRS ; Output "Memory size" - CALL PROMPT ; Get input with "?" - CALL GETCHR ; Get next character - OR A ; Set flags - JP NZ,TSTMEM ; If number - Test if RAM there - LD HL,STLOOK ; Point to start of RAM -MLOOP: INC HL ; Next byte - LD A,H ; Above address FFFF ? - OR L - JP Z,SETTOP ; Yes - 64K RAM - LD A,(HL) ; Get contents - LD B,A ; Save it - CPL ; Flip all bits - LD (HL),A ; Put it back - CP (HL) ; RAM there if same - LD (HL),B ; Restore old contents - JP Z,MLOOP ; If RAM - test next byte - JP SETTOP ; Top of RAM found - -TSTMEM: CALL ATOH ; Get high memory into DE - OR A ; Set flags on last byte - JP NZ,SNERR ; ?SN Error if bad character - EX DE,HL ; Address into HL - DEC HL ; Back one byte - LD A,11011001B ; Test byte - LD B,(HL) ; Get old contents - LD (HL),A ; Load test byte - CP (HL) ; RAM there if same - LD (HL),B ; Restore old contents - JP NZ,MSIZE ; Ask again if no RAM - -SETTOP: DEC HL ; Back one byte - LD DE,STLOOK-1 ; See if enough RAM - CALL CPDEHL ; Compare DE with HL - JP C,MSIZE ; Ask again if not enough RAM - NOP - NOP - NOP - NOP - NOP - NOP - NOP - NOP - NOP - LD DE,0-50 ; 50 Bytes string space - LD (LSTRAM),HL ; Save last available RAM - ADD HL,DE ; Allocate string space - LD (STRSPC),HL ; Save string space - CALL CLRPTR ; Clear program area - LD HL,(STRSPC) ; Get end of memory - LD DE,0-17 ; Offset for free bytes - ADD HL,DE ; Adjust HL - LD DE,PROGST ; Start of program text - LD A,L ; Get LSB - SUB E ; Adjust it - LD L,A ; Re-save - LD A,H ; Get MSB - SBC A,D ; Adjust it - LD H,A ; Re-save - PUSH HL ; Save bytes free - LD HL,SIGNON ; Sign-on message - CALL PRS ; Output string - POP HL ; Get bytes free back - CALL PRNTHL ; Output amount of free memory - LD HL,BFREE ; " Bytes free" message - CALL PRS ; Output string - -WARMST: LD SP,STACK ; Temporary stack -BRKRET: CALL CLREG ; Clear registers and stack - JP PRNTOK ; Go to get command line - -BFREE: DB " Bytes free",CR,0,0 - -SIGNON: DB "NASCOM ROM BASIC Ver 4.7 ",CR - DB "Copyright (C) 1978 by Microsoft",CR,0,0 - -MEMMSG: DB "Memory size",0 - -; FUNCTION ADDRESS TABLE - -FNCTAB: DW SGN - DW INT - DW ABS - DW USR - DW FRE - DW INP - DW POS - DW SQR - DW RND - DW LOG - DW EXP - DW COS - DW SIN - DW TAN - DW ATN - DW PEEK - DW DEEK - DW POINT - DW LEN - DW STR - DW VAL - DW ASC - DW CHR - DW LEFT - DW RIGHT - DW MID - -; RESERVED WORD LIST - -WORDS: DB "E"+80H,"ND" - DB "F"+80H,"OR" - DB "N"+80H,"EXT" - DB "D"+80H,"ATA" - DB "I"+80H,"NPUT" - DB "D"+80H,"IM" - DB "R"+80H,"EAD" - DB "L"+80H,"ET" - DB "G"+80H,"OTO" - DB "R"+80H,"UN" - DB "I"+80H,"F" - DB "R"+80H,"ESTORE" - DB "G"+80H,"OSUB" - DB "R"+80H,"ETURN" - DB "R"+80H,"EM" - DB "S"+80H,"TOP" - DB "O"+80H,"UT" - DB "O"+80H,"N" - DB "N"+80H,"ULL" - DB "W"+80H,"AIT" - DB "D"+80H,"EF" - DB "P"+80H,"OKE" - DB "D"+80H,"OKE" - DB "S"+80H,"CREEN" - DB "L"+80H,"INES" - DB "C"+80H,"LS" - DB "W"+80H,"IDTH" - DB "M"+80H,"ONITOR" - DB "S"+80H,"ET" - DB "R"+80H,"ESET" - DB "P"+80H,"RINT" - DB "C"+80H,"ONT" - DB "L"+80H,"IST" - DB "C"+80H,"LEAR" - DB "C"+80H,"LOAD" - DB "C"+80H,"SAVE" - DB "N"+80H,"EW" - DB "T"+80H,"AB(" - DB "T"+80H,"O" - DB "F"+80H,"N" - DB "S"+80H,"PC(" - DB "T"+80H,"HEN" - DB "N"+80H,"OT" - DB "S"+80H,"TEP" - - DB "+"+80H - DB "-"+80H - DB "*"+80H - DB "/"+80H - DB "^"+80H - DB "A"+80H,"ND" - DB "O"+80H,"R" - DB ">"+80H - DB "="+80H - DB "<"+80H - - DB "S"+80H,"GN" - DB "I"+80H,"NT" - DB "A"+80H,"BS" - DB "U"+80H,"SR" - DB "F"+80H,"RE" - DB "I"+80H,"NP" - DB "P"+80H,"OS" - DB "S"+80H,"QR" - DB "R"+80H,"ND" - DB "L"+80H,"OG" - DB "E"+80H,"XP" - DB "C"+80H,"OS" - DB "S"+80H,"IN" - DB "T"+80H,"AN" - DB "A"+80H,"TN" - DB "P"+80H,"EEK" - DB "D"+80H,"EEK" - DB "P"+80H,"OINT" - DB "L"+80H,"EN" - DB "S"+80H,"TR$" - DB "V"+80H,"AL" - DB "A"+80H,"SC" - DB "C"+80H,"HR$" - DB "L"+80H,"EFT$" - DB "R"+80H,"IGHT$" - DB "M"+80H,"ID$" - DB 80H ; End of list marker - -; KEYWORD ADDRESS TABLE - -WORDTB: DW PEND - DW FOR - DW NEXT - DW DATA - DW INPUT - DW DIM - DW READ - DW LET - DW GOTO - DW RUN - DW IF - DW RESTOR - DW GOSUB - DW RETURN - DW REM - DW STOP - DW POUT - DW ON - DW NULL - DW WAIT - DW DEF - DW POKE - DW DOKE - DW SCREEN - DW LINES - DW CLS - DW WIDTH - DW MONITR - DW PSET - DW RESET - DW PRINT - DW CONT - DW LIST - DW CLEAR - DW CLOAD - DW CSAVE - DW NEW - -; RESERVED WORD TOKEN VALUES - -ZEND EQU 080H ; END -ZFOR EQU 081H ; FOR -ZDATA EQU 083H ; DATA -ZGOTO EQU 088H ; GOTO -ZGOSUB EQU 08CH ; GOSUB -ZREM EQU 08EH ; REM -ZPRINT EQU 09EH ; PRINT -ZNEW EQU 0A4H ; NEW - -ZTAB EQU 0A5H ; TAB -ZTO EQU 0A6H ; TO -ZFN EQU 0A7H ; FN -ZSPC EQU 0A8H ; SPC -ZTHEN EQU 0A9H ; THEN -ZNOT EQU 0AAH ; NOT -ZSTEP EQU 0ABH ; STEP - -ZPLUS EQU 0ACH ; + -ZMINUS EQU 0ADH ; - -ZTIMES EQU 0AEH ; * -ZDIV EQU 0AFH ; / -ZOR EQU 0B2H ; OR -ZGTR EQU 0B3H ; > -ZEQUAL EQU 0B4H ; M -ZLTH EQU 0B5H ; < -ZSGN EQU 0B6H ; SGN -ZPOINT EQU 0C7H ; POINT -ZLEFT EQU 0CDH ; LEFT$ - -; ARITHMETIC PRECEDENCE TABLE - -PRITAB: DB 79H ; Precedence value - DW PADD ; FPREG = + FPREG - - DB 79H ; Precedence value - DW PSUB ; FPREG = - FPREG - - DB 7CH ; Precedence value - DW MULT ; PPREG = * FPREG - - DB 7CH ; Precedence value - DW DIV ; FPREG = / FPREG - - DB 7FH ; Precedence value - DW POWER ; FPREG = ^ FPREG - - DB 50H ; Precedence value - DW PAND ; FPREG = AND FPREG - - DB 46H ; Precedence value - DW POR ; FPREG = OR FPREG - -; BASIC ERROR CODE LIST - -ERRORS: DB "NF" ; NEXT without FOR - DB "SN" ; Syntax error - DB "RG" ; RETURN without GOSUB - DB "OD" ; Out of DATA - DB "FC" ; Illegal function call - DB "OV" ; Overflow error - DB "OM" ; Out of memory - DB "UL" ; Undefined line - DB "BS" ; Bad subscript - DB "DD" ; Re-DIMensioned array - DB "/0" ; Division by zero - DB "ID" ; Illegal direct - DB "TM" ; Type mis-match - DB "OS" ; Out of string space - DB "LS" ; String too long - DB "ST" ; String formula too complex - DB "CN" ; Can't CONTinue - DB "UF" ; Undefined FN function - DB "MO" ; Missing operand - -; INITIALISATION TABLE - -INITAB: JP WARMST ; Warm start jump - JP FCERR ; "USR (X)" jump (Set to Error) - - OUT (0),A ; "OUT p,n" skeleton - RET - - SUB 0 ; Division support routine - LD L,A - LD A,H - SBC A,0 - LD H,A - LD A,B - SBC A,0 - LD B,A - LD A,0 - RET - - DB 0,0,0 ; Random number seed - ; Table used by RND - DB 035H,04AH,0CAH,099H ;-2.65145E+07 - DB 039H,01CH,076H,098H ; 1.61291E+07 - DB 022H,095H,0B3H,098H ;-1.17691E+07 - DB 00AH,0DDH,047H,098H ; 1.30983E+07 - DB 053H,0D1H,099H,099H ;-2-01612E+07 - DB 00AH,01AH,09FH,098H ;-1.04269E+07 - DB 065H,0BCH,0CDH,098H ;-1.34831E+07 - DB 0D6H,077H,03EH,098H ; 1.24825E+07 - DB 052H,0C7H,04FH,080H ; Last random number - - IN A,(0) ; INP (x) skeleton - RET - - DB 1 ; POS (x) number (1) - DB 47 ; Terminal width (47) - DB 28 ; Width for commas (3 columns) - DB 0 ; No nulls after input bytes - DB 0 ; Output enabled (^O off) - - DW 5 ; Initial lines counter - DW 5 ; Initial lines number - DW 0 ; Array load/save check sum - - DB 0 ; Break not by NMI - DB 0 ; Break flag - - JP TTYLIN ; Input reflection (set to TTY) - JP POINTB ; POINT reflection unused - JP SETB ; SET reflection - JP RESETB ; RESET reflection - - DW STLOOK ; Temp string space - DW -2 ; Current line number (cold) - DW PROGST+1 ; Start of program text -INITBE: ; END OF INITIALISATION TABLE - -ERRMSG: DB " Error",0 -INMSG: DB " in ",0 -ZERBYT EQU $-1 ; A zero byte -OKMSG: DB "Ok",CR,0,0 -BRKMSG: DB "Break",0 - -BAKSTK: LD HL,4 ; Look for "FOR" block with - ADD HL,SP ; same index as specified -LOKFOR: LD A,(HL) ; Get block ID - INC HL ; Point to index address - CP ZFOR ; Is it a "FOR" token - RET NZ ; No - exit - LD C,(HL) ; BC = Address of "FOR" index - INC HL - LD B,(HL) - INC HL ; Point to sign of STEP - PUSH HL ; Save pointer to sign - LD L,C ; HL = address of "FOR" index - LD H,B - LD A,D ; See if an index was specified - OR E ; DE = 0 if no index specified - EX DE,HL ; Specified index into HL - JP Z,INDFND ; Skip if no index given - EX DE,HL ; Index back into DE - CALL CPDEHL ; Compare index with one given -INDFND: LD BC,16-3 ; Offset to next block - POP HL ; Restore pointer to sign - RET Z ; Return if block found - ADD HL,BC ; Point to next block - JP LOKFOR ; Keep on looking - -MOVUP: CALL ENFMEM ; See if enough memory -MOVSTR: PUSH BC ; Save end of source - EX (SP),HL ; Swap source and dest" end - POP BC ; Get end of destination -MOVLP: CALL CPDEHL ; See if list moved - LD A,(HL) ; Get byte - LD (BC),A ; Move it - RET Z ; Exit if all done - DEC BC ; Next byte to move to - DEC HL ; Next byte to move - JP MOVLP ; Loop until all bytes moved - -CHKSTK: PUSH HL ; Save code string address - LD HL,(ARREND) ; Lowest free memory - LD B,0 ; BC = Number of levels to test - ADD HL,BC ; 2 Bytes for each level - ADD HL,BC - DB 3EH ; Skip "PUSH HL" -ENFMEM: PUSH HL ; Save code string address - LD A,LOW -48 ; 48 Bytes minimum RAM - SUB L - LD L,A - LD A,HIGH -48 ; 48 Bytes minimum RAM - SBC A,H - JP C,OMERR ; Not enough - ?OM Error - LD H,A - ADD HL,SP ; Test if stack is overflowed - POP HL ; Restore code string address - RET C ; Return if enough mmory -OMERR: LD E,OM ; ?OM Error - JP ERROR - -DATSNR: LD HL,(DATLIN) ; Get line of current DATA item - LD (LINEAT),HL ; Save as current line -SNERR: LD E,SN ; ?SN Error - DB 01H ; Skip "LD E,DZ" -DZERR: LD E,DZ ; ?/0 Error - DB 01H ; Skip "LD E,NF" -NFERR: LD E,NF ; ?NF Error - DB 01H ; Skip "LD E,DD" -DDERR: LD E,DD ; ?DD Error - DB 01H ; Skip "LD E,UF" -UFERR: LD E,UF ; ?UF Error - DB 01H ; Skip "LD E,OV -OVERR: LD E,OV ; ?OV Error - DB 01H ; Skip "LD E,TM" -TMERR: LD E,TM ; ?TM Error - -ERROR: CALL CLREG ; Clear registers and stack - LD (CTLOFG),A ; Enable output (A is 0) - CALL STTLIN ; Start new line - LD HL,ERRORS ; Point to error codes - LD D,A ; D = 0 (A is 0) - LD A,"?" - CALL OUTC ; Output "?" - ADD HL,DE ; Offset to correct error code - LD A,(HL) ; First character - CALL OUTC ; Output it - CALL GETCHR ; Get next character - CALL OUTC ; Output it - LD HL,ERRMSG ; "Error" message -ERRIN: CALL PRS ; Output message - LD HL,(LINEAT) ; Get line of error - LD DE,-2 ; Cold start error if -2 - CALL CPDEHL ; See if cold start error - JP Z,CSTART ; Cold start error - Restart - LD A,H ; Was it a direct error? - AND L ; Line = -1 if direct error - INC A - CALL NZ,LINEIN ; No - output line of error - DB 3EH ; Skip "POP BC" -POPNOK: POP BC ; Drop address in input buffer - -PRNTOK: XOR A ; Output "Ok" and get command - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start new line - LD HL,OKMSG ; "Ok" message - CALL PRS ; Output "Ok" -GETCMD: LD HL,-1 ; Flag direct mode - LD (LINEAT),HL ; Save as current line - CALL GETLIN ; Get an input line - JP C,GETCMD ; Get line again if break - CALL GETCHR ; Get first character - INC A ; Test if end of line - DEC A ; Without affecting Carry - JP Z,GETCMD ; Nothing entered - Get another - PUSH AF ; Save Carry status - CALL ATOH ; Get line number into DE - PUSH DE ; Save line number - CALL CRUNCH ; Tokenise rest of line - LD B,A ; Length of tokenised line - POP DE ; Restore line number - POP AF ; Restore Carry - JP NC,EXCUTE ; No line number - Direct mode - PUSH DE ; Save line number - PUSH BC ; Save length of tokenised line - XOR A - LD (LSTBIN),A ; Clear last byte input - CALL GETCHR ; Get next character - OR A ; Set flags - PUSH AF ; And save them - CALL SRCHLN ; Search for line number in DE - JP C,LINFND ; Jump if line found - POP AF ; Get status - PUSH AF ; And re-save - JP Z,ULERR ; Nothing after number - Error - OR A ; Clear Carry -LINFND: PUSH BC ; Save address of line in prog - JP NC,INEWLN ; Line not found - Insert new - EX DE,HL ; Next line address in DE - LD HL,(PROGND) ; End of program -SFTPRG: LD A,(DE) ; Shift rest of program down - LD (BC),A - INC BC ; Next destination - INC DE ; Next source - CALL CPDEHL ; All done? - JP NZ,SFTPRG ; More to do - LD H,B ; HL - New end of program - LD L,C - LD (PROGND),HL ; Update end of program - -INEWLN: POP DE ; Get address of line, - POP AF ; Get status - JP Z,SETPTR ; No text - Set up pointers - LD HL,(PROGND) ; Get end of program - EX (SP),HL ; Get length of input line - POP BC ; End of program to BC - ADD HL,BC ; Find new end - PUSH HL ; Save new end - CALL MOVUP ; Make space for line - POP HL ; Restore new end - LD (PROGND),HL ; Update end of program pointer - EX DE,HL ; Get line to move up in HL - LD (HL),H ; Save MSB - POP DE ; Get new line number - INC HL ; Skip pointer - INC HL - LD (HL),E ; Save LSB of line number - INC HL - LD (HL),D ; Save MSB of line number - INC HL ; To first byte in line - LD DE,BUFFER ; Copy buffer to program -MOVBUF: LD A,(DE) ; Get source - LD (HL),A ; Save destinations - INC HL ; Next source - INC DE ; Next destination - OR A ; Done? - JP NZ,MOVBUF ; No - Repeat -SETPTR: CALL RUNFST ; Set line pointers - INC HL ; To LSB of pointer - EX DE,HL ; Address to DE -PTRLP: LD H,D ; Address to HL - LD L,E - LD A,(HL) ; Get LSB of pointer - INC HL ; To MSB of pointer - OR (HL) ; Compare with MSB pointer - JP Z,GETCMD ; Get command line if end - INC HL ; To LSB of line number - INC HL ; Skip line number - INC HL ; Point to first byte in line - XOR A ; Looking for 00 byte -FNDEND: CP (HL) ; Found end of line? - INC HL ; Move to next byte - JP NZ,FNDEND ; No - Keep looking - EX DE,HL ; Next line address to HL - LD (HL),E ; Save LSB of pointer - INC HL - LD (HL),D ; Save MSB of pointer - JP PTRLP ; Do next line - -SRCHLN: LD HL,(BASTXT) ; Start of program text -SRCHLP: LD B,H ; BC = Address to look at - LD C,L - LD A,(HL) ; Get address of next line - INC HL - OR (HL) ; End of program found? - DEC HL - RET Z ; Yes - Line not found - INC HL - INC HL - LD A,(HL) ; Get LSB of line number - INC HL - LD H,(HL) ; Get MSB of line number - LD L,A - CALL CPDEHL ; Compare with line in DE - LD H,B ; HL = Start of this line - LD L,C - LD A,(HL) ; Get LSB of next line address - INC HL - LD H,(HL) ; Get MSB of next line address - LD L,A ; Next line to HL - CCF - RET Z ; Lines found - Exit - CCF - RET NC ; Line not found,at line after - JP SRCHLP ; Keep looking - -NEW: RET NZ ; Return if any more on line -CLRPTR: LD HL,(BASTXT) ; Point to start of program - XOR A ; Set program area to empty - LD (HL),A ; Save LSB = 00 - INC HL - LD (HL),A ; Save MSB = 00 - INC HL - LD (PROGND),HL ; Set program end - -RUNFST: LD HL,(BASTXT) ; Clear all variables - DEC HL - -INTVAR: LD (BRKLIN),HL ; Initialise RUN variables - LD HL,(LSTRAM) ; Get end of RAM - LD (STRBOT),HL ; Clear string space - XOR A - CALL RESTOR ; Reset DATA pointers - LD HL,(PROGND) ; Get end of program - LD (VAREND),HL ; Clear variables - LD (ARREND),HL ; Clear arrays - -CLREG: POP BC ; Save return address - LD HL,(STRSPC) ; Get end of working RAN - LD SP,HL ; Set stack - LD HL,TMSTPL ; Temporary string pool - LD (TMSTPT),HL ; Reset temporary string ptr - XOR A ; A = 00 - LD L,A ; HL = 0000 - LD H,A - LD (CONTAD),HL ; No CONTinue - LD (FORFLG),A ; Clear FOR flag - LD (FNRGNM),HL ; Clear FN argument - PUSH HL ; HL = 0000 - PUSH BC ; Put back return -DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN - RET ; Return to execution driver - -PROMPT: LD A,"?" ; "?" - CALL OUTC ; Output character - LD A," " ; Space - CALL OUTC ; Output character - JP RINPUT ; Get input line - -CRUNCH: XOR A ; Tokenise line @ HL to BUFFER - LD (DATFLG),A ; Reset literal flag - LD C,2+3 ; 2 byte number and 3 nulls - LD DE,BUFFER ; Start of input buffer -CRNCLP: LD A,(HL) ; Get byte - CP " " ; Is it a space? - JP Z,MOVDIR ; Yes - Copy direct - LD B,A ; Save character - CP '"' ; Is it a quote? - JP Z,CPYLIT ; Yes - Copy literal string - OR A ; Is it end of buffer? - JP Z,ENDBUF ; Yes - End buffer - LD A,(DATFLG) ; Get data type - OR A ; Literal? - LD A,(HL) ; Get byte to copy - JP NZ,MOVDIR ; Literal - Copy direct - CP "?" ; Is it "?" short for PRINT - LD A,ZPRINT ; "PRINT" token - JP Z,MOVDIR ; Yes - replace it - LD A,(HL) ; Get byte again - CP "0" ; Is it less than "0" - JP C,FNDWRD ; Yes - Look for reserved words - CP ";"+1 ; Is it "0123456789:;" ? - JP C,MOVDIR ; Yes - copy it direct -FNDWRD: PUSH DE ; Look for reserved words - LD DE,WORDS-1 ; Point to table - PUSH BC ; Save count - LD BC,RETNAD ; Where to return to - PUSH BC ; Save return address - LD B,ZEND-1 ; First token value -1 - LD A,(HL) ; Get byte - CP "a" ; Less than "a" ? - JP C,SEARCH ; Yes - search for words - CP "z"+1 ; Greater than "z" ? - JP NC,SEARCH ; Yes - search for words - AND 01011111B ; Force upper case - LD (HL),A ; Replace byte -SEARCH: LD C,(HL) ; Search for a word - EX DE,HL -GETNXT: INC HL ; Get next reserved word - OR (HL) ; Start of word? - JP P,GETNXT ; No - move on - INC B ; Increment token value - LD A, (HL) ; Get byte from table - AND 01111111B ; Strip bit 7 - RET Z ; Return if end of list - CP C ; Same character as in buffer? - JP NZ,GETNXT ; No - get next word - EX DE,HL - PUSH HL ; Save start of word - -NXTBYT: INC DE ; Look through rest of word - LD A,(DE) ; Get byte from table - OR A ; End of word ? - JP M,MATCH ; Yes - Match found - LD C,A ; Save it - LD A,B ; Get token value - CP ZGOTO ; Is it "GOTO" token ? - JP NZ,NOSPC ; No - Don't allow spaces - CALL GETCHR ; Get next character - DEC HL ; Cancel increment from GETCHR -NOSPC: INC HL ; Next byte - LD A,(HL) ; Get byte - CP "a" ; Less than "a" ? - JP C,NOCHNG ; Yes - don't change - AND 01011111B ; Make upper case -NOCHNG: CP C ; Same as in buffer ? - JP Z,NXTBYT ; Yes - keep testing - POP HL ; Get back start of word - JP SEARCH ; Look at next word - -MATCH: LD C,B ; Word found - Save token value - POP AF ; Throw away return - EX DE,HL - RET ; Return to "RETNAD" -RETNAD: EX DE,HL ; Get address in string - LD A,C ; Get token value - POP BC ; Restore buffer length - POP DE ; Get destination address -MOVDIR: INC HL ; Next source in buffer - LD (DE),A ; Put byte in buffer - INC DE ; Move up buffer - INC C ; Increment length of buffer - SUB ":" ; End of statement? - JP Z,SETLIT ; Jump if multi-statement line - CP ZDATA-3AH ; Is it DATA statement ? - JP NZ,TSTREM ; No - see if REM -SETLIT: LD (DATFLG),A ; Set literal flag -TSTREM: SUB ZREM-3AH ; Is it REM? - JP NZ,CRNCLP ; No - Leave flag - LD B,A ; Copy rest of buffer -NXTCHR: LD A,(HL) ; Get byte - OR A ; End of line ? - JP Z,ENDBUF ; Yes - Terminate buffer - CP B ; End of statement ? - JP Z,MOVDIR ; Yes - Get next one -CPYLIT: INC HL ; Move up source string - LD (DE),A ; Save in destination - INC C ; Increment length - INC DE ; Move up destination - JP NXTCHR ; Repeat - -ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer - LD (DE),A ; Mark end of buffer (A = 00) - INC DE - LD (DE),A ; A = 00 - INC DE - LD (DE),A ; A = 00 - RET - -DODEL: LD A,(NULFLG) ; Get null flag status - OR A ; Is it zero? - LD A,0 ; Zero A - Leave flags - LD (NULFLG),A ; Zero null flag - JP NZ,ECHDEL ; Set - Echo it - DEC B ; Decrement length - JP Z,GETLIN ; Get line again if empty - CALL OUTC ; Output null character - DB 3EH ; Skip "DEC B" -ECHDEL: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - JP Z,OTKLN ; No buffer - Try again - LD A,(HL) ; Get deleted byte - CALL OUTC ; Echo it - JP MORINP ; Get more input - -DELCHR: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - CALL OUTC ; Output character in A - JP NZ,MORINP ; Not end - Get more -OTKLN: CALL OUTC ; Output character in A -KILIN: CALL PRNTCR ; Output CRLF - JP TTYLIN ; Get line again - -GETLIN: CALL MONTST ; Is it NAS-SYS? - JP Z,TTYLIN ; No - Character input - LD HL,(CIN) ; Point to NAS-SYS input table - LD A,(HL) ; Get input mode - CP 74H ; Is it "X" mode? - JP Z,TTYLIN ; Yes - Teletype line input - CALL INLINE ; Get a line from NAS-SYS - JP DONULL ; POS(X)=0 and do nulls - -TTYLIN: LD HL,BUFFER ; Get a line by character - LD B,1 ; Set buffer as empty - XOR A - LD (NULFLG),A ; Clear null flag -MORINP: CALL CLOTST ; Get character and test ^O - LD C,A ; Save character in C - CP DEL ; Delete character? - JP Z,DODEL ; Yes - Process it - LD A,(NULFLG) ; Get null flag - OR A ; Test null flag status - JP Z,PROCES ; Reset - Process character - LD A,0 ; Set a null - CALL OUTC ; Output null - XOR A ; Clear A - LD (NULFLG),A ; Reset null flag -PROCES: LD A,C ; Get character - CP CTRLG ; Bell? - JP Z,PUTCTL ; Yes - Save it - CP CTRLC ; Is it control "C"? - CALL Z,PRNTCR ; Yes - Output CRLF - SCF ; Flag break - RET Z ; Return if control "C" - CP CR ; Is it enter? - JP Z,ENDINP ; Yes - Terminate input - CP CTRLU ; Is it control "U"? - JP Z,KILIN ; Yes - Get another line - CP "@" ; Is it "kill line"? - JP Z,OTKLN ; Yes - Kill line - CP "_" ; Is it delete? - JP Z,DELCHR ; Yes - Delete character - CP BKSP ; Is it backspace? - JP Z,DELCHR ; Yes - Delete character - CP CTRLR ; Is it control "R"? - JP NZ,PUTBUF ; No - Put in buffer - PUSH BC ; Save buffer length - PUSH DE ; Save DE - PUSH HL ; Save buffer address - LD (HL),0 ; Mark end of buffer - CALL OUTNCR ; Output and do CRLF - LD HL,BUFFER ; Point to buffer start - CALL PRS ; Output buffer - POP HL ; Restore buffer address - POP DE ; Restore DE - POP BC ; Restore buffer length - JP MORINP ; Get another character - -PUTBUF: CP " " ; Is it a control code? - JP C,MORINP ; Yes - Ignore -PUTCTL: LD A,B ; Get number of bytes in buffer - CP 72+1 ; Test for line overflow - LD A,CTRLG ; Set a bell - JP NC,OUTNBS ; Ring bell if buffer full - LD A,C ; Get character - LD (HL),C ; Save in buffer - LD (LSTBIN),A ; Save last input byte - INC HL ; Move up buffer - INC B ; Increment length -OUTIT: CALL OUTC ; Output the character entered - JP MORINP ; Get another character - -OUTNBS: CALL OUTC ; Output bell and back over it - LD A,BKSP ; Set back space - JP OUTIT ; Output it and get more - -CPDEHL: LD A,H ; Get H - SUB D ; Compare with D - RET NZ ; Different - Exit - LD A,L ; Get L - SUB E ; Compare with E - RET ; Return status - -CHKSYN: LD A,(HL) ; Check syntax of character - EX (SP),HL ; Address of test byte - CP (HL) ; Same as in code string? - INC HL ; Return address - EX (SP),HL ; Put it back - JP Z,GETCHR ; Yes - Get next character - JP SNERR ; Different - ?SN Error - -OUTC: PUSH AF ; Save character - LD A,(CTLOFG) ; Get control "O" flag - OR A ; Is it set? - JP NZ,POPAF ; Yes - don't output - POP AF ; Restore character - PUSH BC ; Save buffer length - PUSH AF ; Save character - CP " " ; Is it a control code? - JP C,DINPOS ; Yes - Don't INC POS(X) - LD A,(LWIDTH) ; Get line width - LD B,A ; To B - LD A,(CURPOS) ; Get cursor position - INC B ; Width 255? - JP Z,INCLEN ; Yes - No width limit - DEC B ; Restore width - CP B ; At end of line? - CALL Z,PRNTCR ; Yes - output CRLF -INCLEN: INC A ; Move on one character - LD (CURPOS),A ; Save new position -DINPOS: POP AF ; Restore character - POP BC ; Restore buffer length - PUSH AF ; << This sequence >> - POP AF ; << is not needed >> - PUSH AF ; Save character - PUSH BC ; Save buffer length - LD C,A ; Character to C - CALL CONMON ; Send it - POP BC ; Restore buffer length - POP AF ; Restore character - RET - -CLOTST: CALL GETINP ; Get input character - AND 01111111B ; Strip bit 7 - CP CTRLO ; Is it control "O"? - RET NZ ; No don't flip flag - LD A,(CTLOFG) ; Get flag - CPL ; Flip it - LD (CTLOFG),A ; Put it back - XOR A ; Null character - RET - -LIST: CALL ATOH ; ASCII number to DE - RET NZ ; Return if anything extra - POP BC ; Rubbish - Not needed - CALL SRCHLN ; Search for line number in DE - PUSH BC ; Save address of line - CALL SETLIN ; Set up lines counter -LISTLP: POP HL ; Restore address of line - LD C,(HL) ; Get LSB of next line - INC HL - LD B,(HL) ; Get MSB of next line - INC HL - LD A,B ; BC = 0 (End of program)? - OR C - JP Z,PRNTOK ; Yes - Go to command mode - CALL COUNT ; Count lines - CALL TSTBRK ; Test for break key - PUSH BC ; Save address of next line - CALL PRNTCR ; Output CRLF - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - INC HL - PUSH HL ; Save address of line start - EX DE,HL ; Line number to HL - CALL PRNTHL ; Output line number in decimal - LD A," " ; Space after line number - POP HL ; Restore start of line address -LSTLP2: CALL OUTC ; Output character in A -LSTLP3: LD A,(HL) ; Get next byte in line - OR A ; End of line? - INC HL ; To next byte in line - JP Z,LISTLP ; Yes - get next line - JP P,LSTLP2 ; No token - output it - SUB ZEND-1 ; Find and output word - LD C,A ; Token offset+1 to C - LD DE,WORDS ; Reserved word list -FNDTOK: LD A,(DE) ; Get character in list - INC DE ; Move on to next - OR A ; Is it start of word? - JP P,FNDTOK ; No - Keep looking for word - DEC C ; Count words - JP NZ,FNDTOK ; Not there - keep looking -OUTWRD: AND 01111111B ; Strip bit 7 - CALL OUTC ; Output first character - LD A,(DE) ; Get next character - INC DE ; Move on to next - OR A ; Is it end of word? - JP P,OUTWRD ; No - output the rest - JP LSTLP3 ; Next byte in line - -SETLIN: PUSH HL ; Set up LINES counter - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Save in LINES counter - POP HL - RET - -LDNMI1: LD HL,BREAK ; Break routine - LD (NMI),HL ; NMI forces break - JP PRNTOK ; Go to command mode - - DB 0FEH ; <<< NO REFERENCE TO HERE >>> - -COUNT: PUSH HL ; Save code string address - PUSH DE - LD HL,(LINESC) ; Get LINES counter - LD DE,-1 - ADC HL,DE ; Decrement - LD (LINESC),HL ; Put it back - POP DE - POP HL ; Restore code string address - RET P ; Return if more lines to go - PUSH HL ; Save code string address - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - LD A,(NMIFLG) ; Break by NMI? - OR A - JP NZ,ARETN ; Yes - "RETN" - CALL GETINP ; Get input character - CP CTRLC ; Is it control "C"? - JP Z,RSLNBK ; Yes - Reset LINES an break - POP HL ; Restore code string address - JP COUNT ; Keep on counting - -RSLNBK: LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - JP BRKRET ; Go and output "Break" - -FOR: LD A,64H ; Flag "FOR" assignment - LD (FORFLG),A ; Save "FOR" flag - CALL LET ; Set up initial index - POP BC ; Drop RETurn address - PUSH HL ; Save code string address - CALL DATA ; Get next statement address - LD (LOOPST),HL ; Save it for start of loop - LD HL,2 ; Offset for "FOR" block - ADD HL,SP ; Point to it -FORSLP: CALL LOKFOR ; Look for existing "FOR" block - POP DE ; Get code string address - JP NZ,FORFND ; No nesting found - ADD HL,BC ; Move into "FOR" block - PUSH DE ; Save code string address - DEC HL - LD D,(HL) ; Get MSB of loop statement - DEC HL - LD E,(HL) ; Get LSB of loop statement - INC HL - INC HL - PUSH HL ; Save block address - LD HL,(LOOPST) ; Get address of loop statement - CALL CPDEHL ; Compare the FOR loops - POP HL ; Restore block address - JP NZ,FORSLP ; Different FORs - Find another - POP DE ; Restore code string address - LD SP,HL ; Remove all nested loops - -FORFND: EX DE,HL ; Code string address to HL - LD C,8 - CALL CHKSTK ; Check for 8 levels of stack - PUSH HL ; Save code string address - LD HL,(LOOPST) ; Get first statement of loop - EX (SP),HL ; Save and restore code string - PUSH HL ; Re-save code string address - LD HL,(LINEAT) ; Get current line number - EX (SP),HL ; Save and restore code string - CALL TSTNUM ; Make sure it's a number - CALL CHKSYN ; Make sure "TO" is next - DB ZTO ; "TO" token - CALL GETNUM ; Get "TO" expression value - PUSH HL ; Save code string address - CALL BCDEFP ; Move "TO" value to BCDE - POP HL ; Restore code string address - PUSH BC ; Save "TO" value in block - PUSH DE - LD BC,8100H ; BCDE - 1 (default STEP) - LD D,C ; C=0 - LD E,D ; D=0 - LD A,(HL) ; Get next byte in code string - CP ZSTEP ; See if "STEP" is stated - LD A,1 ; Sign of step = 1 - JP NZ,SAVSTP ; No STEP given - Default to 1 - CALL GETCHR ; Jump over "STEP" token - CALL GETNUM ; Get step value - PUSH HL ; Save code string address - CALL BCDEFP ; Move STEP to BCDE - CALL TSTSGN ; Test sign of FPREG - POP HL ; Restore code string address -SAVSTP: PUSH BC ; Save the STEP value in block - PUSH DE - PUSH AF ; Save sign of STEP - INC SP ; Don't save flags - PUSH HL ; Save code string address - LD HL,(BRKLIN) ; Get address of index variable - EX (SP),HL ; Save and restore code string -PUTFID: LD B,ZFOR ; "FOR" block marker - PUSH BC ; Save it - INC SP ; Don't save C - -RUNCNT: CALL CHKBRK ; Execution driver - Test break - OR A ; Break key hit? - CALL NZ,STALL ; Yes - Pause for a key - LD (BRKLIN),HL ; Save code address for break - LD A,(HL) ; Get next byte in code string - CP ":" ; Multi statement line? - JP Z,EXCUTE ; Yes - Execute it - OR A ; End of line? - JP NZ,SNERR ; No - Syntax error - INC HL ; Point to address of next line - LD A,(HL) ; Get LSB of line pointer - INC HL - OR (HL) ; Is it zero (End of prog)? - JP Z,ENDPRG ; Yes - Terminate execution - INC HL ; Point to line number - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - EX DE,HL ; Line number to HL - LD (LINEAT),HL ; Save as current line number - EX DE,HL ; Line number back to DE -EXCUTE: CALL GETCHR ; Get key word - LD DE,RUNCNT ; Where to RETurn to - PUSH DE ; Save for RETurn -IFJMP: RET Z ; Go to RUNCNT if end of STMT -ONJMP: SUB ZEND ; Is it a token? - JP C,LET ; No - try to assign it - CP ZNEW+1-ZEND ; END to NEW ? - JP NC,SNERR ; Not a key word - ?SN Error - RLCA ; Double it - LD C,A ; BC = Offset into table - LD B,0 - EX DE,HL ; Save code string address - LD HL,WORDTB ; Keyword address table - ADD HL,BC ; Point to routine address - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - PUSH BC ; Save routine address - EX DE,HL ; Restore code string address - -GETCHR: INC HL ; Point to next character - LD A,(HL) ; Get next code string byte - CP ":" ; Z if ":" - RET NC ; NC if > "9" - CP " " - JP Z,GETCHR ; Skip over spaces - CP "0" - CCF ; NC if < "0" - INC A ; Test for zero - Leave carry - DEC A ; Z if Null - RET - -RESTOR: EX DE,HL ; Save code string address - LD HL,(BASTXT) ; Point to start of program - JP Z,RESTNL ; Just RESTORE - reset pointer - EX DE,HL ; Restore code string address - CALL ATOH ; Get line number to DE - PUSH HL ; Save code string address - CALL SRCHLN ; Search for line number in DE - LD H,B ; HL = Address of line - LD L,C - POP DE ; Restore code string address - JP NC,ULERR ; ?UL Error if not found -RESTNL: DEC HL ; Byte before DATA statement -UPDATA: LD (NXTDAT),HL ; Update DATA pointer - EX DE,HL ; Restore code string address - RET - -TSTBRK: CALL CHKBRK ; Test for interrupts - OR A - RET Z ; Return if no key pressed -STALL: CALL CLOTST ; Get input and test for ^O - CP CTRLS ; Is it control "S" - CALL Z,CLOTST ; Yes - Get another character - CP CTRLC ; Return if not control "C" -STOP: RET NZ ; Exit if anything else - DB 0F6H ; Flag "STOP" -PEND: RET NZ ; Exit if anything else - LD (BRKLIN),HL ; Save point of break - DB 21H ; Skip "OR 11111111B" -INPBRK: OR 11111111B ; Flag "Break" wanted - POP BC ; Return not needed and more -ENDPRG: LD HL,(LINEAT) ; Get current line number - PUSH AF ; Save STOP / END status - LD A,L ; Is it direct break? - AND H - INC A ; Line is -1 if direct break - JP Z,NOLIN ; Yes - No line number - LD (ERRLIN),HL ; Save line of break - LD HL,(BRKLIN) ; Get point of break - LD (CONTAD),HL ; Save point to CONTinue -NOLIN: XOR A - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start a new line - POP AF ; Restore STOP / END status - LD HL,BRKMSG ; "Break" message - JP NZ,ERRIN ; "in line" wanted? - JP PRNTOK ; Go to command mode - -CONT: LD HL,(CONTAD) ; Get CONTinue address - LD A,H ; Is it zero? - OR L - LD E,CN ; ?CN Error - JP Z,ERROR ; Yes - output "?CN Error" - EX DE,HL ; Save code string address - LD HL,(ERRLIN) ; Get line of last break - LD (LINEAT),HL ; Set up current line number - EX DE,HL ; Restore code string address - RET ; CONTinue where left off - -NULL: CALL GETINT ; Get integer 0-255 - RET NZ ; Return if bad value - LD (NULLS),A ; Set nulls number - RET - -ARRLD1: LD B,-1 ; Flag array load -ARRSV1: CALL GETCHR ; Skip "*" - LD A,B ; CLOAD* or CSAVE* - LD (BRKLIN),A ; Save it - LD A,1 ; It's an array - LD (FORFLG),A ; Flag array name - CALL GETVAR ; Get address of array name - PUSH HL ; Save code string address - LD (FORFLG),A ; Clear flag - LD H,B ; Address of array to HL - LD L,C - DEC BC ; Back space - DEC BC ; to point - DEC BC ; to the - DEC BC ; array name - LD A,(BRKLIN) ; CLOAD* or CSAVE* ? - OR A - PUSH AF ; Save CLOAD* / CSAVE* status - EX DE,HL ; Array data length - ADD HL,DE ; End of data - EX DE,HL ; To DE - LD C,(HL) ; Get dimension bytes - LD B,0 - ADD HL,BC ; 2 Bytes each dimension - ADD HL,BC - INC HL ; Over number of dimensions - PUSH HL ; Address of array data - PUSH DE ; End of array data - PUSH BC ; Number of dimensions - LD A,(BRKLIN) ; CLOAD* or CSAVE* ? - CP -1 - CALL Z,CASFF ; CLOAD* - Cassette on - LD A,(BRKLIN) ; CLOAD* or CSAVE* ? - CP -1 - CALL NZ,CASFFW ; CSAVE* - Cassette on and wait - NOP - NOP - NOP - LD HL,0 - LD (CHKSUM),HL ; Zero check sum - POP BC ; Number of dimensions - POP DE ; End of array data - POP HL ; Address of array data - LD B,11010010B ; Header byte - JP JPLDSV ; CSAVE-SNDHDR , CLOAD-GETHDR - -SNDHDR: LD A,B ; Get header byte - CALL WUART2 ; Send 2 bytes to UART - CALL WUART2 ; Send 2 bytes to UART - JP SNDARY ; Send array data - -GETHDR: LD C,4 ; 4 Bytes to check -HDRLP: CALL RUART ; Read byte from UART - CP B ; Same as header? - JP NZ,GETHDR ; No - Wait for another - DEC C ; Count bytes - JP NZ,HDRLP ; More needed -SNDARY: CALL TSTNUM ; Check it's a numerical array -ARYLP: CALL CPDEHL ; All array data done - JP Z,SUMOFF ; Yes - Do check sum - POP AF ; CLOAD* or CSAVE* ? - PUSH AF ; Re-save flags - LD A,(HL) ; Get byte - CALL P,WUART ; CSAVE* - Write byte - CALL M,RUART ; CLOAD* - Read byte - LD (HL),A ; Save byte in case of CLOAD* - CALL ACCSUM ; Accumulate check sum - INC HL ; Next byte - JP ARYLP ; Repeat - -SUMOFF: CALL DOSUM ; Do check sum - CALL CASFF ; Cassette off - POP AF ; Not needed any more - POP HL ; Restore code string address - RET - -ACCSUM: PUSH HL ; Save address in array - LD HL,(CHKSUM) ; Get check sum - LD B,0 ; BC - Value of byte - LD C,A - ADD HL,BC ; Add byte to check sum - LD (CHKSUM),HL ; Re-save check sum - POP HL ; Restore address in array - RET - -DOSUM: LD A,(BRKLIN) ; CLOAD* or CSAVE* ? - OR A - JP M,CHSUMS ; CLOAD* - Check if sums match - LD A,(CHKSUM) ; Get LSB of check sum - CALL WUART ; Write to UART - LD A,(CHKSUM+1) ; Get MSB of check sum - JP WUART ; Write to UART and return - -CHSUMS: CALL RUART ; Read LSB of check sum - PUSH AF ; Save it - CALL RUART ; Read MSB of check sum - POP BC ; LSB to B - LD E,B ; LSB to E - LD D,A ; MSB to D - LD HL,(CHKSUM) ; Get accumulated check sum - CALL CPDEHL ; Are they the same? - RET Z ; Yes - End CLOAD* - CALL CASFF ; Cassette off - JP OUTBAD ; Different - Output "Bad" - -CHKLTR: LD A,(HL) ; Get byte - CP "A" ; < "A" ? - RET C ; Carry set if not letter - CP "Z"+1 ; > "Z" ? - CCF - RET ; Carry set if not letter - -FPSINT: CALL GETCHR ; Get next character -POSINT: CALL GETNUM ; Get integer 0 to 32767 -DEPINT: CALL TSTSGN ; Test sign of FPREG - JP M,FCERR ; Negative - ?FC Error -DEINT: LD A,(FPEXP) ; Get integer value to DE - CP 80H+16 ; Exponent in range (16 bits)? - JP C,FPINT ; Yes - convert it - LD BC,9080H ; BCDE = -32768 - LD DE,0000 - PUSH HL ; Save code string address - CALL CMPNUM ; Compare FPREG with BCDE - POP HL ; Restore code string address - LD D,C ; MSB to D - RET Z ; Return if in range -FCERR: LD E,FC ; ?FC Error - JP ERROR ; Output error- - -ATOH: DEC HL ; ASCII number to DE binary -GETLN: LD DE,0 ; Get number to DE -GTLNLP: CALL GETCHR ; Get next character - RET NC ; Exit if not a digit - PUSH HL ; Save code string address - PUSH AF ; Save digit - LD HL,65529/10 ; Largest number 65529 - CALL CPDEHL ; Number in range? - JP C,SNERR ; No - ?SN Error - LD H,D ; HL = Number - LD L,E - ADD HL,DE ; Times 2 - ADD HL,HL ; Times 4 - ADD HL,DE ; Times 5 - ADD HL,HL ; Times 10 - POP AF ; Restore digit - SUB "0" ; Make it 0 to 9 - LD E,A ; DE = Value of digit - LD D,0 - ADD HL,DE ; Add to number - EX DE,HL ; Number to DE - POP HL ; Restore code string address - JP GTLNLP ; Go to next character - -CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters - CALL POSINT ; Get integer 0 to 32767 to DE - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - PUSH HL ; Save code string address - LD HL,(LSTRAM) ; Get end of RAM - JP Z,STORED ; No value given - Use stored - POP HL ; Restore code string address - CALL CHKSYN ; Check for comma - DB "," - PUSH DE ; Save number - CALL POSINT ; Get integer 0 to 32767 - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - JP NZ,SNERR ; ?SN Error if more on line - EX (SP),HL ; Save code string address - EX DE,HL ; Number to DE -STORED: LD A,L ; Get LSB of new RAM top - SUB E ; Subtract LSB of string space - LD E,A ; Save LSB - LD A,H ; Get MSB of new RAM top - SBC A,D ; Subtract MSB of string space - LD D,A ; Save MSB - JP C,OMERR ; ?OM Error if not enough mem - PUSH HL ; Save RAM top - LD HL,(PROGND) ; Get program end - LD BC,40 ; 40 Bytes minimum working RAM - ADD HL,BC ; Get lowest address - CALL CPDEHL ; Enough memory? - JP NC,OMERR ; No - ?OM Error - EX DE,HL ; RAM top to HL - LD (STRSPC),HL ; Set new string space - POP HL ; End of memory to use - LD (LSTRAM),HL ; Set new top of RAM - POP HL ; Restore code string address - JP INTVAR ; Initialise variables - -RUN: JP Z,RUNFST ; RUN from start if just RUN - CALL INTVAR ; Initialise variables - LD BC,RUNCNT ; Execution driver loop - JP RUNLIN ; RUN from line number - -GOSUB: LD C,3 ; 3 Levels of stack needed - CALL CHKSTK ; Check for 3 levels of stack - POP BC ; Get return address - PUSH HL ; Save code string for RETURN - PUSH HL ; And for GOSUB routine - LD HL,(LINEAT) ; Get current line - EX (SP),HL ; Into stack - Code string out - LD A,ZGOSUB ; "GOSUB" token - PUSH AF ; Save token - INC SP ; Don't save flags - -RUNLIN: PUSH BC ; Save return address -GOTO: CALL ATOH ; ASCII number to DE binary - CALL REM ; Get end of line - PUSH HL ; Save end of line - LD HL,(LINEAT) ; Get current line - CALL CPDEHL ; Line after current? - POP HL ; Restore end of line - INC HL ; Start of next line - CALL C,SRCHLP ; Line is after current line - CALL NC,SRCHLN ; Line is before current line - LD H,B ; Set up code string address - LD L,C - DEC HL ; Incremented after - RET C ; Line found -ULERR: LD E,UL ; ?UL Error - JP ERROR ; Output error message - -RETURN: RET NZ ; Return if not just RETURN - LD D,-1 ; Flag "GOSUB" search - CALL BAKSTK ; Look "GOSUB" block - LD SP,HL ; Kill all FORs in subroutine - CP ZGOSUB ; Test for "GOSUB" token - LD E,RG ; ?RG Error - JP NZ,ERROR ; Error if no "GOSUB" found - POP HL ; Get RETURN line number - LD (LINEAT),HL ; Save as current - INC HL ; Was it from direct statement? - LD A,H - OR L ; Return to line - JP NZ,RETLIN ; No - Return to line - LD A,(LSTBIN) ; Any INPUT in subroutine? - OR A ; If so buffer is corrupted - JP NZ,POPNOK ; Yes - Go to command mode -RETLIN: LD HL,RUNCNT ; Execution driver loop - EX (SP),HL ; Into stack - Code string out - DB 3EH ; Skip "POP HL" -NXTDTA: POP HL ; Restore code string address - -DATA: DB 01H,3AH ; ":" End of statement -REM: LD C,0 ; 00 End of statement - LD B,0 -NXTSTL: LD A,C ; Statement and byte - LD C,B - LD B,A ; Statement end byte -NXTSTT: LD A,(HL) ; Get byte - OR A ; End of line? - RET Z ; Yes - Exit - CP B ; End of statement? - RET Z ; Yes - Exit - INC HL ; Next byte - CP '"' ; Literal string? - JP Z,NXTSTL ; Yes - Look for another '"' - JP NXTSTT ; Keep looking - -LET: CALL GETVAR ; Get variable name - CALL CHKSYN ; Make sure "=" follows - DB ZEQUAL ; "=" token - PUSH DE ; Save address of variable - LD A,(TYPE) ; Get data type - PUSH AF ; Save type - CALL EVAL ; Evaluate expression - POP AF ; Restore type - EX (SP),HL ; Save code - Get var addr - LD (BRKLIN),HL ; Save address of variable - RRA ; Adjust type - CALL CHKTYP ; Check types are the same - JP Z,LETNUM ; Numeric - Move value -LETSTR: PUSH HL ; Save address of string var - LD HL,(FPREG) ; Pointer to string entry - PUSH HL ; Save it on stack - INC HL ; Skip over length - INC HL - LD E,(HL) ; LSB of string address - INC HL - LD D,(HL) ; MSB of string address - LD HL,(BASTXT) ; Point to start of program - CALL CPDEHL ; Is string before program? - JP NC,CRESTR ; Yes - Create string entry - LD HL,(STRSPC) ; Point to string space - CALL CPDEHL ; Is string literal in program? - POP DE ; Restore address of string - JP NC,MVSTPT ; Yes - Set up pointer - LD HL,TMPSTR ; Temporary string pool - CALL CPDEHL ; Is string in temporary pool? - JP NC,MVSTPT ; No - Set up pointer - DB 3EH ; Skip "POP DE" -CRESTR: POP DE ; Restore address of string - CALL BAKTMP ; Back to last tmp-str entry - EX DE,HL ; Address of string entry - CALL SAVSTR ; Save string in string area -MVSTPT: CALL BAKTMP ; Back to last tmp-str entry - POP HL ; Get string pointer - CALL DETHL4 ; Move string pointer to var - POP HL ; Restore code string address - RET - -LETNUM: PUSH HL ; Save address of variable - CALL FPTHL ; Move value to variable - POP DE ; Restore address of variable - POP HL ; Restore code string address - RET - -ON: CALL GETINT ; Get integer 0-255 - LD A,(HL) ; Get "GOTO" or "GOSUB" token - LD B,A ; Save in B - CP ZGOSUB ; "GOSUB" token? - JP Z,ONGO ; Yes - Find line number - CALL CHKSYN ; Make sure it's "GOTO" - DB ZGOTO ; "GOTO" token - DEC HL ; Cancel increment -ONGO: LD C,E ; Integer of branch value -ONGOLP: DEC C ; Count branches - LD A,B ; Get "GOTO" or "GOSUB" token - JP Z,ONJMP ; Go to that line if right one - CALL GETLN ; Get line number to DE - CP "," ; Another line number? - RET NZ ; No - Drop through - JP ONGOLP ; Yes - loop - -IF: CALL EVAL ; Evaluate expression - LD A,(HL) ; Get token - CP ZGOTO ; "GOTO" token? - JP Z,IFGO ; Yes - Get line - CALL CHKSYN ; Make sure it's "THEN" - DB ZTHEN ; "THEN" token - DEC HL ; Cancel increment -IFGO: CALL TSTNUM ; Make sure it's numeric - CALL TSTSGN ; Test state of expression - JP Z,REM ; False - Drop through - CALL GETCHR ; Get next character - JP C,GOTO ; Number - GOTO that line - JP IFJMP ; Otherwise do statement - -MRPRNT: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character -PRINT: JP Z,PRNTCR ; CRLF if just PRINT -PRNTLP: RET Z ; End of list - Exit - CP ZTAB ; "TAB(" token? - JP Z,DOTAB ; Yes - Do TAB routine - CP ZSPC ; "SPC(" token? - JP Z,DOTAB ; Yes - Do SPC routine - PUSH HL ; Save code string address - CP "," ; Comma? - JP Z,DOCOM ; Yes - Move to next zone - CP ";" ; Semi-colon? - JP Z,NEXITM ; Do semi-colon routine - POP BC ; Code string address to BC - CALL EVAL ; Evaluate expression - PUSH HL ; Save code string address - LD A,(TYPE) ; Get variable type - OR A ; Is it a string variable? - JP NZ,PRNTST ; Yes - Output string contents - CALL NUMASC ; Convert number to text - CALL CRTST ; Create temporary string - LD (HL)," " ; Followed by a space - LD HL,(FPREG) ; Get length of output - INC (HL) ; Plus 1 for the space - LD HL,(FPREG) ; < Not needed > - LD A,(LWIDTH) ; Get width of line - LD B,A ; To B - INC B ; Width 255 (No limit)? - JP Z,PRNTNB ; Yes - Output number string - INC B ; Adjust it - LD A,(CURPOS) ; Get cursor position - ADD A,(HL) ; Add length of string - DEC A ; Adjust it - CP B ; Will output fit on this line? - CALL NC,PRNTCR ; No - CRLF first -PRNTNB: CALL PRS1 ; Output string at (HL) - XOR A ; Skip CALL by setting "Z" flag -PRNTST: CALL NZ,PRS1 ; Output string at (HL) - POP HL ; Restore code string address - JP MRPRNT ; See if more to PRINT - -STTLIN: LD A,(CURPOS) ; Make sure on new line - OR A ; Already at start? - RET Z ; Yes - Do nothing - JP PRNTCR ; Start a new line - -ENDINP: LD (HL),0 ; Mark end of buffer - LD HL,BUFFER-1 ; Point to buffer -PRNTCR: LD A,CR ; Load a CR - CALL OUTC ; Output character -DONULL: XOR A ; Set to position 0 - LD (CURPOS),A ; Store it - LD A,(NULLS) ; Get number of nulls -NULLP: DEC A ; Count them - RET Z ; Return if done - PUSH AF ; Save count - XOR A ; Load a null - CALL OUTC ; Output it - POP AF ; Restore count - JP NULLP ; Keep counting - -DOCOM: LD A,(COMMAN) ; Get comma width - LD B,A ; Save in B - LD A,(CURPOS) ; Get current position - CP B ; Within the limit? - CALL NC,PRNTCR ; No - output CRLF - JP NC,NEXITM ; Get next item -ZONELP: SUB 14 ; Next zone of 14 characters - JP NC,ZONELP ; Repeat if more zones - CPL ; Number of spaces to output - JP ASPCS ; Output them - -DOTAB: PUSH AF ; Save token - CALL FNDNUM ; Evaluate expression - CALL CHKSYN ; Make sure ")" follows - DB ")" - DEC HL ; Back space on to ")" - POP AF ; Restore token - SUB ZSPC ; Was it "SPC(" ? - PUSH HL ; Save code string address - JP Z,DOSPC ; Yes - Do "E" spaces - LD A,(CURPOS) ; Get current position -DOSPC: CPL ; Number of spaces to print to - ADD A,E ; Total number to print - JP NC,NEXITM ; TAB < Current POS(X) -ASPCS: INC A ; Output A spaces - LD B,A ; Save number to print - LD A," " ; Space -SPCLP: CALL OUTC ; Output character in A - DEC B ; Count them - JP NZ,SPCLP ; Repeat if more -NEXITM: POP HL ; Restore code string address - CALL GETCHR ; Get next character - JP PRNTLP ; More to print - -REDO: DB "?Redo from start",CR,LF,0 - -BADINP: LD A,(READFG) ; READ or INPUT? - OR A - JP NZ,DATSNR ; READ - ?SN Error - POP BC ; Throw away code string addr - LD HL,REDO ; "Redo from start" message - CALL PRS ; Output string - JP DOAGN ; Do last INPUT again - -INPUT: CALL IDTEST ; Test for illegal direct - LD A,(HL) ; Get character after "INPUT" - CP '"' ; Is there a prompt string? - LD A,0 ; Clear A and leave flags - LD (CTLOFG),A ; Enable output - JP NZ,NOPMPT ; No prompt - get input - CALL QTSTR ; Get string terminated by '"' - CALL CHKSYN ; Check for ";" after prompt - DB ";" - PUSH HL ; Save code string address - CALL PRS1 ; Output prompt string - DB 3EH ; Skip "PUSH HL" -NOPMPT: PUSH HL ; Save code string address - CALL PROMPT ; Get input with "? " prompt - POP BC ; Restore code string address - JP C,INPBRK ; Break pressed - Exit - INC HL ; Next byte - LD A,(HL) ; Get it - OR A ; End of line? - DEC HL ; Back again - PUSH BC ; Re-save code string address - JP Z,NXTDTA ; Yes - Find next DATA stmt - LD (HL),"," ; Store comma as separator - JP NXTITM ; Get next item - -READ: PUSH HL ; Save code string address - LD HL,(NXTDAT) ; Next DATA statement - DB 0F6H ; Flag "READ" -NXTITM: XOR A ; Flag "INPUT" - LD (READFG),A ; Save "READ"/"INPUT" flag - EX (SP),HL ; Get code str' , Save pointer - JP GTVLUS ; Get values - -NEDMOR: CALL CHKSYN ; Check for comma between items - DB "," -GTVLUS: CALL GETVAR ; Get variable name - EX (SP),HL ; Save code str" , Get pointer - PUSH DE ; Save variable address - LD A,(HL) ; Get next "INPUT"/"DATA" byte - CP "," ; Comma? - JP Z,ANTVLU ; Yes - Get another value - LD A,(READFG) ; Is it READ? - OR A - JP NZ,FDTLP ; Yes - Find next DATA stmt - LD A,"?" ; More INPUT needed - CALL OUTC ; Output character - CALL PROMPT ; Get INPUT with prompt - POP DE ; Variable address - POP BC ; Code string address - JP C,INPBRK ; Break pressed - INC HL ; Point to next DATA byte - LD A,(HL) ; Get byte - OR A ; Is it zero (No input) ? - DEC HL ; Back space INPUT pointer - PUSH BC ; Save code string address - JP Z,NXTDTA ; Find end of buffer - PUSH DE ; Save variable address -ANTVLU: LD A,(TYPE) ; Check data type - OR A ; Is it numeric? - JP Z,INPBIN ; Yes - Convert to binary - CALL GETCHR ; Get next character - LD D,A ; Save input character - LD B,A ; Again - CP '"' ; Start of literal sting? - JP Z,STRENT ; Yes - Create string entry - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - LD D,A ; Save 00 if "INPUT" - JP Z,ITMSEP ; "INPUT" - End with 00 - LD D,":" ; "DATA" - End with 00 or ":" -ITMSEP: LD B,"," ; Item separator - DEC HL ; Back space for DTSTR -STRENT: CALL DTSTR ; Get string terminated by D - EX DE,HL ; String address to DE - LD HL,LTSTND ; Where to go after LETSTR - EX (SP),HL ; Save HL , get input pointer - PUSH DE ; Save address of string - JP LETSTR ; Assign string to variable - -INPBIN: CALL GETCHR ; Get next character - CALL ASCTFP ; Convert ASCII to FP number - EX (SP),HL ; Save input ptr, Get var addr - CALL FPTHL ; Move FPREG to variable - POP HL ; Restore input pointer -LTSTND: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,MORDT ; End of line - More needed? - CP "," ; Another value? - JP NZ,BADINP ; No - Bad input -MORDT: EX (SP),HL ; Get code string address - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,NEDMOR ; More needed - Get it - POP DE ; Restore DATA pointer - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - EX DE,HL ; DATA pointer to HL - JP NZ,UPDATA ; Update DATA pointer if "READ" - PUSH DE ; Save code string address - OR (HL) ; More input given? - LD HL,EXTIG ; "?Extra ignored" message - CALL NZ,PRS ; Output string if extra given - POP HL ; Restore code string address - RET - -EXTIG: DB "?Extra ignored",CR,LF,0 - -FDTLP: CALL DATA ; Get next statement - OR A ; End of line? - JP NZ,FANDT ; No - See if DATA statement - INC HL - LD A,(HL) ; End of program? - INC HL - OR (HL) ; 00 00 Ends program - LD E,OD ; ?OD Error - JP Z,ERROR ; Yes - Out of DATA - INC HL - LD E,(HL) ; LSB of line number - INC HL - LD D,(HL) ; MSB of line number - EX DE,HL - LD (DATLIN),HL ; Set line of current DATA item - EX DE,HL -FANDT: CALL GETCHR ; Get next character - CP ZDATA ; "DATA" token - JP NZ,FDTLP ; No "DATA" - Keep looking - JP ANTVLU ; Found - Convert input - -NEXT: LD DE,0 ; In case no index given -NEXT1: CALL NZ,GETVAR ; Get index address - LD (BRKLIN),HL ; Save code string address - CALL BAKSTK ; Look for "FOR" block - JP NZ,NFERR ; No "FOR" - ?NF Error - LD SP,HL ; Clear nested loops - PUSH DE ; Save index address - LD A,(HL) ; Get sign of STEP - INC HL - PUSH AF ; Save sign of STEP - PUSH DE ; Save index address - CALL PHLTFP ; Move index value to FPREG - EX (SP),HL ; Save address of TO value - PUSH HL ; Save address of index - CALL ADDPHL ; Add STEP to index value - POP HL ; Restore address of index - CALL FPTHL ; Move value to index variable - POP HL ; Restore address of TO value - CALL LOADFP ; Move TO value to BCDE - PUSH HL ; Save address of line of FOR - CALL CMPNUM ; Compare index with TO value - POP HL ; Restore address of line num - POP BC ; Address of sign of STEP - SUB B ; Compare with expected sign - CALL LOADFP ; BC = Loop stmt,DE = Line num - JP Z,KILFOR ; Loop finished - Terminate it - EX DE,HL ; Loop statement line number - LD (LINEAT),HL ; Set loop line number - LD L,C ; Set code string to loop - LD H,B - JP PUTFID ; Put back "FOR" and continue - -KILFOR: LD SP,HL ; Remove "FOR" block - LD HL,(BRKLIN) ; Code string after "NEXT" - LD A,(HL) ; Get next byte in code string - CP "," ; More NEXTs ? - JP NZ,RUNCNT ; No - Do next statement - CALL GETCHR ; Position to index name - CALL NEXT1 ; Re-enter NEXT routine -; < will not RETurn to here , Exit to RUNCNT or Loop > - -GETNUM: CALL EVAL ; Get a numeric expression -TSTNUM: DB 0F6H ; Clear carry (numeric) -TSTSTR: SCF ; Set carry (string) -CHKTYP: LD A,(TYPE) ; Check types match - ADC A,A ; Expected + actual - OR A ; Clear carry , set parity - RET PE ; Even parity - Types match - JP TMERR ; Different types - Error - -; <<< NO REFERENCE TO HERE >>> - - CALL CHKSYN ; Make sure "=" follows - DB ZEQUAL ; "=" - JP EVAL ; Evaluate expression - -OPNPAR: CALL CHKSYN ; Make sure "(" follows - DB "(" -EVAL: DEC HL ; Evaluate expression & save - LD D,0 ; Precedence value -EVAL1: PUSH DE ; Save precedence - LD C,1 - CALL CHKSTK ; Check for 1 level of stack - CALL OPRND ; Get next expression value -EVAL2: LD (NXTOPR),HL ; Save address of next operator -EVAL3: LD HL,(NXTOPR) ; Restore address of next opr - POP BC ; Precedence value and operator - LD A,B ; Get precedence value - CP 78H ; "AND" or "OR" ? - CALL NC,TSTNUM ; No - Make sure it's a number - LD A,(HL) ; Get next operator / function - LD D,0 ; Clear Last relation -RLTLP: SUB ZGTR ; ">" Token - JP C,FOPRND ; + - * / ^ AND OR - Test it - CP ZLTH+1-ZGTR ; < = > - JP NC,FOPRND ; Function - Call it - CP ZEQUAL-ZGTR ; "=" - RLA ; <- Test for legal - XOR D ; <- combinations of < = > - CP D ; <- by combining last token - LD D,A ; <- with current one - JP C,SNERR ; Error if "<<" "==" or ">>" - LD (CUROPR),HL ; Save address of current token - CALL GETCHR ; Get next character - JP RLTLP ; Treat the two as one - -FOPRND: LD A,D ; < = > found ? - OR A - JP NZ,TSTRED ; Yes - Test for reduction - LD A,(HL) ; Get operator token - LD (CUROPR),HL ; Save operator address - SUB ZPLUS ; Operator or function? - RET C ; Neither - Exit - CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? - RET NC ; No - Exit - LD E,A ; Coded operator - LD A,(TYPE) ; Get data type - DEC A ; FF = numeric , 00 = string - OR E ; Combine with coded operator - LD A,E ; Get coded operator - JP Z,CONCAT ; String concatenation - RLCA ; Times 2 - ADD A,E ; Times 3 - LD E,A ; To DE (D is 0) - LD HL,PRITAB ; Precedence table - ADD HL,DE ; To the operator concerned - LD A,B ; Last operator precedence - LD D,(HL) ; Get evaluation precedence - CP D ; Compare with eval precedence - RET NC ; Exit if higher precedence - INC HL ; Point to routine address - CALL TSTNUM ; Make sure it's a number - -STKTHS: PUSH BC ; Save last precedence & token - LD BC,EVAL3 ; Where to go on prec' break - PUSH BC ; Save on stack for return - LD B,E ; Save operator - LD C,D ; Save precedence - CALL STAKFP ; Move value to stack - LD E,B ; Restore operator - LD D,C ; Restore precedence - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - INC HL - PUSH BC ; Save routine address - LD HL,(CUROPR) ; Address of current operator - JP EVAL1 ; Loop until prec' break - -OPRND: XOR A ; Get operand routine - LD (TYPE),A ; Set numeric expected - CALL GETCHR ; Get next character - LD E,MO ; ?MO Error - JP Z,ERROR ; No operand - Error - JP C,ASCTFP ; Number - Get value - CALL CHKLTR ; See if a letter - JP NC,CONVAR ; Letter - Find variable - CP ZPLUS ; "+" Token ? - JP Z,OPRND ; Yes - Look for operand - CP "." ; "." ? - JP Z,ASCTFP ; Yes - Create FP number - CP ZMINUS ; "-" Token ? - JP Z,MINUS ; Yes - Do minus - CP '"' ; Literal string ? - JP Z,QTSTR ; Get string terminated by '"' - CP ZNOT ; "NOT" Token ? - JP Z,EVNOT ; Yes - Eval NOT expression - CP ZFN ; "FN" Token ? - JP Z,DOFN ; Yes - Do FN routine - SUB ZSGN ; Is it a function? - JP NC,FNOFST ; Yes - Evaluate function -EVLPAR: CALL OPNPAR ; Evaluate expression in "()" - CALL CHKSYN ; Make sure ")" follows - DB ")" - RET - -MINUS: LD D,7DH ; "-" precedence - CALL EVAL1 ; Evaluate until prec' break - LD HL,(NXTOPR) ; Get next operator address - PUSH HL ; Save next operator address - CALL INVSGN ; Negate value -RETNUM: CALL TSTNUM ; Make sure it's a number - POP HL ; Restore next operator address - RET - -CONVAR: CALL GETVAR ; Get variable address to DE -FRMEVL: PUSH HL ; Save code string address - EX DE,HL ; Variable address to HL - LD (FPREG),HL ; Save address of variable - LD A,(TYPE) ; Get type - OR A ; Numeric? - CALL Z,PHLTFP ; Yes - Move contents to FPREG - POP HL ; Restore code string address - RET - -FNOFST: LD B,0 ; Get address of function - RLCA ; Double function offset - LD C,A ; BC = Offset in function table - PUSH BC ; Save adjusted token value - CALL GETCHR ; Get next character - LD A,C ; Get adjusted token value - CP 2*(ZPOINT-ZSGN) ; Adjusted "POINT" token? - JP Z,POINTB ; Yes - Do "POINT" (not POINTB) - CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? - JP C,FNVAL ; No - Do function - CALL OPNPAR ; Evaluate expression (X,... - CALL CHKSYN ; Make sure "," follows - DB "," - CALL TSTSTR ; Make sure it's a string - EX DE,HL ; Save code string address - LD HL,(FPREG) ; Get address of string - EX (SP),HL ; Save address of string - PUSH HL ; Save adjusted token value - EX DE,HL ; Restore code string address - CALL GETINT ; Get integer 0-255 - EX DE,HL ; Save code string address - EX (SP),HL ; Save integer,HL = adj' token - JP GOFUNC ; Jump to string function - -FNVAL: CALL EVLPAR ; Evaluate expression - EX (SP),HL ; HL = Adjusted token value - LD DE,RETNUM ; Return number from function - PUSH DE ; Save on stack -GOFUNC: LD BC,FNCTAB ; Function routine addresses - ADD HL,BC ; Point to right address - LD C,(HL) ; Get LSB of address - INC HL ; - LD H,(HL) ; Get MSB of address - LD L,C ; Address to HL - JP (HL) ; Jump to function - -SGNEXP: DEC D ; Dee to flag negative exponent - CP ZMINUS ; "-" token ? - RET Z ; Yes - Return - CP "-" ; "-" ASCII ? - RET Z ; Yes - Return - INC D ; Inc to flag positive exponent - CP "+" ; "+" ASCII ? - RET Z ; Yes - Return - CP ZPLUS ; "+" token ? - RET Z ; Yes - Return - DEC HL ; DEC 'cos GETCHR INCs - RET ; Return "NZ" - -POR: DB 0F6H ; Flag "OR" -PAND: XOR A ; Flag "AND" - PUSH AF ; Save "AND" / "OR" flag - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - EX DE,HL ; <- Get last - POP BC ; <- value - EX (SP),HL ; <- from - EX DE,HL ; <- stack - CALL FPBCDE ; Move last value to FPREG - PUSH AF ; Save "AND" / "OR" flag - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - POP BC ; Get value - LD A,C ; Get LSB - LD HL,ACPASS ; Address of save AC as current - JP NZ,POR1 ; Jump if OR - AND E ; "AND" LSBs - LD C,A ; Save LSB - LD A,B ; Get MBS - AND D ; "AND" MSBs - JP (HL) ; Save AC as current (ACPASS) - -POR1: OR E ; "OR" LSBs - LD C,A ; Save LSB - LD A,B ; Get MSB - OR D ; "OR" MSBs - JP (HL) ; Save AC as current (ACPASS) - -TSTRED: LD HL,CMPLOG ; Logical compare routine - LD A,(TYPE) ; Get data type - RRA ; Carry set = string - LD A,D ; Get last precedence value - RLA ; Times 2 plus carry - LD E,A ; To E - LD D,64H ; Relational precedence - LD A,B ; Get current precedence - CP D ; Compare with last - RET NC ; Eval if last was rel' or log' - JP STKTHS ; Stack this one and get next - -CMPLOG: DW CMPLG1 ; Compare two values / strings -CMPLG1: LD A,C ; Get data type - OR A - RRA - POP BC ; Get last expression to BCDE - POP DE - PUSH AF ; Save status - CALL CHKTYP ; Check that types match - LD HL,CMPRES ; Result to comparison - PUSH HL ; Save for RETurn - JP Z,CMPNUM ; Compare values if numeric - XOR A ; Compare two strings - LD (TYPE),A ; Set type to numeric - PUSH DE ; Save string name - CALL GSTRCU ; Get current string - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - POP DE ; Restore string name - PUSH BC ; Save address of string - PUSH AF ; Save length of string - CALL GSTRDE ; Get second string - CALL LOADFP ; Get address of second string - POP AF ; Restore length of string 1 - LD D,A ; Length to D - POP HL ; Restore address of string 1 -CMPSTR: LD A,E ; Bytes of string 2 to do - OR D ; Bytes of string 1 to do - RET Z ; Exit if all bytes compared - LD A,D ; Get bytes of string 1 to do - SUB 1 - RET C ; Exit if end of string 1 - XOR A - CP E ; Bytes of string 2 to do - INC A - RET NC ; Exit if end of string 2 - DEC D ; Count bytes in string 1 - DEC E ; Count bytes in string 2 - LD A,(BC) ; Byte in string 2 - CP (HL) ; Compare to byte in string 1 - INC HL ; Move up string 1 - INC BC ; Move up string 2 - JP Z,CMPSTR ; Same - Try next bytes - CCF ; Flag difference (">" or "<") - JP FLGDIF ; "<" gives -1 , ">" gives +1 - -CMPRES: INC A ; Increment current value - ADC A,A ; Double plus carry - POP BC ; Get other value - AND B ; Combine them - ADD A,-1 ; Carry set if different - SBC A,A ; 00 - Equal , FF - Different - JP FLGREL ; Set current value & continue - -EVNOT: LD D,5AH ; Precedence value for "NOT" - CALL EVAL1 ; Eval until precedence break - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 - 32767 - LD A,E ; Get LSB - CPL ; Invert LSB - LD C,A ; Save "NOT" of LSB - LD A,D ; Get MSB - CPL ; Invert MSB - CALL ACPASS ; Save AC as current - POP BC ; Clean up stack - JP EVAL3 ; Continue evaluation - -DIMRET: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - RET Z ; End of DIM statement - CALL CHKSYN ; Make sure "," follows - DB "," -DIM: LD BC,DIMRET ; Return to "DIMRET" - PUSH BC ; Save on stack - DB 0F6H ; Flag "Create" variable -GETVAR: XOR A ; Find variable address,to DE - LD (LCRFLG),A ; Set locate / create flag - LD B,(HL) ; Get First byte of name -GTFNAM: CALL CHKLTR ; See if a letter - JP C,SNERR ; ?SN Error if not a letter - XOR A - LD C,A ; Clear second byte of name - LD (TYPE),A ; Set type to numeric - CALL GETCHR ; Get next character - JP C,SVNAM2 ; Numeric - Save in name - CALL CHKLTR ; See if a letter - JP C,CHARTY ; Not a letter - Check type -SVNAM2: LD C,A ; Save second byte of name -ENDNAM: CALL GETCHR ; Get next character - JP C,ENDNAM ; Numeric - Get another - CALL CHKLTR ; See if a letter - JP NC,ENDNAM ; Letter - Get another -CHARTY: SUB "$" ; String variable? - JP NZ,NOTSTR ; No - Numeric variable - INC A ; A = 1 (string type) - LD (TYPE),A ; Set type to string - RRCA ; A = 80H , Flag for string - ADD A,C ; 2nd byte of name has bit 7 on - LD C,A ; Resave second byte on name - CALL GETCHR ; Get next character -NOTSTR: LD A,(FORFLG) ; Array name needed ? - DEC A - JP Z,ARLDSV ; Yes - Get array name - JP P,NSCFOR ; No array with "FOR" or "FN" - LD A,(HL) ; Get byte again - SUB "(" ; Subscripted variable? - JP Z,SBSCPT ; Yes - Sort out subscript - -NSCFOR: XOR A ; Simple variable - LD (FORFLG),A ; Clear "FOR" flag - PUSH HL ; Save code string address - LD D,B ; DE = Variable name to find - LD E,C - LD HL,(FNRGNM) ; FN argument name - CALL CPDEHL ; Is it the FN argument? - LD DE,FNARG ; Point to argument value - JP Z,POPHRT ; Yes - Return FN argument value - LD HL,(VAREND) ; End of variables - EX DE,HL ; Address of end of search - LD HL,(PROGND) ; Start of variables address -FNDVAR: CALL CPDEHL ; End of variable list table? - JP Z,CFEVAL ; Yes - Called from EVAL? - LD A,C ; Get second byte of name - SUB (HL) ; Compare with name in list - INC HL ; Move on to first byte - JP NZ,FNTHR ; Different - Find another - LD A,B ; Get first byte of name - SUB (HL) ; Compare with name in list -FNTHR: INC HL ; Move on to LSB of value - JP Z,RETADR ; Found - Return address - INC HL ; <- Skip - INC HL ; <- over - INC HL ; <- F.P. - INC HL ; <- value - JP FNDVAR ; Keep looking - -CFEVAL: POP HL ; Restore code string address - EX (SP),HL ; Get return address - PUSH DE ; Save address of variable - LD DE,FRMEVL ; Return address in EVAL - CALL CPDEHL ; Called from EVAL ? - POP DE ; Restore address of variable - JP Z,RETNUL ; Yes - Return null variable - EX (SP),HL ; Put back return - PUSH HL ; Save code string address - PUSH BC ; Save variable name - LD BC,6 ; 2 byte name plus 4 byte data - LD HL,(ARREND) ; End of arrays - PUSH HL ; Save end of arrays - ADD HL,BC ; Move up 6 bytes - POP BC ; Source address in BC - PUSH HL ; Save new end address - CALL MOVUP ; Move arrays up - POP HL ; Restore new end address - LD (ARREND),HL ; Set new end address - LD H,B ; End of variables to HL - LD L,C - LD (VAREND),HL ; Set new end address - -ZEROLP: DEC HL ; Back through to zero variable - LD (HL),0 ; Zero byte in variable - CALL CPDEHL ; Done them all? - JP NZ,ZEROLP ; No - Keep on going - POP DE ; Get variable name - LD (HL),E ; Store second character - INC HL - LD (HL),D ; Store first character - INC HL -RETADR: EX DE,HL ; Address of variable in DE - POP HL ; Restore code string address - RET - -RETNUL: LD (FPEXP),A ; Set result to zero - LD HL,ZERBYT ; Also set a null string - LD (FPREG),HL ; Save for EVAL - POP HL ; Restore code string address - RET - -SBSCPT: PUSH HL ; Save code string address - LD HL,(LCRFLG) ; Locate/Create and Type - EX (SP),HL ; Save and get code string - LD D,A ; Zero number of dimensions -SCPTLP: PUSH DE ; Save number of dimensions - PUSH BC ; Save array name - CALL FPSINT ; Get subscript (0-32767) - POP BC ; Restore array name - POP AF ; Get number of dimensions - EX DE,HL - EX (SP),HL ; Save subscript value - PUSH HL ; Save LCRFLG and TYPE - EX DE,HL - INC A ; Count dimensions - LD D,A ; Save in D - LD A,(HL) ; Get next byte in code string - CP "," ; Comma (more to come)? - JP Z,SCPTLP ; Yes - More subscripts - CALL CHKSYN ; Make sure ")" follows - DB ")" - LD (NXTOPR),HL ; Save code string address - POP HL ; Get LCRFLG and TYPE - LD (LCRFLG),HL ; Restore Locate/create & type - LD E,0 ; Flag not CSAVE* or CLOAD* - PUSH DE ; Save number of dimensions (D) - DB 11H ; Skip "PUSH HL" and "PUSH AF' - -ARLDSV: PUSH HL ; Save code string address - PUSH AF ; A = 00 , Flags set = Z,N - LD HL,(VAREND) ; Start of arrays - DB 3EH ; Skip "ADD HL,DE" -FNDARY: ADD HL,DE ; Move to next array start - EX DE,HL - LD HL,(ARREND) ; End of arrays - EX DE,HL ; Current array pointer - CALL CPDEHL ; End of arrays found? - JP Z,CREARY ; Yes - Create array - LD A,(HL) ; Get second byte of name - CP C ; Compare with name given - INC HL ; Move on - JP NZ,NXTARY ; Different - Find next array - LD A,(HL) ; Get first byte of name - CP B ; Compare with name given -NXTARY: INC HL ; Move on - LD E,(HL) ; Get LSB of next array address - INC HL - LD D,(HL) ; Get MSB of next array address - INC HL - JP NZ,FNDARY ; Not found - Keep looking - LD A,(LCRFLG) ; Found Locate or Create it? - OR A - JP NZ,DDERR ; Create - ?DD Error - POP AF ; Locate - Get number of dim'ns - LD B,H ; BC Points to array dim'ns - LD C,L - JP Z,POPHRT ; Jump if array load/save - SUB (HL) ; Same number of dimensions? - JP Z,FINDEL ; Yes - Find element -BSERR: LD E,BS ; ?BS Error - JP ERROR ; Output error - -CREARY: LD DE,4 ; 4 Bytes per entry - POP AF ; Array to save or 0 dim'ns? - JP Z,FCERR ; Yes - ?FC Error - LD (HL),C ; Save second byte of name - INC HL - LD (HL),B ; Save first byte of name - INC HL - LD C,A ; Number of dimensions to C - CALL CHKSTK ; Check if enough memory - INC HL ; Point to number of dimensions - INC HL - LD (CUROPR),HL ; Save address of pointer - LD (HL),C ; Set number of dimensions - INC HL - LD A,(LCRFLG) ; Locate of Create? - RLA ; Carry set = Create - LD A,C ; Get number of dimensions -CRARLP: LD BC,10+1 ; Default dimension size 10 - JP NC,DEFSIZ ; Locate - Set default size - POP BC ; Get specified dimension size - INC BC ; Include zero element -DEFSIZ: LD (HL),C ; Save LSB of dimension size - INC HL - LD (HL),B ; Save MSB of dimension size - INC HL - PUSH AF ; Save num' of dim'ns an status - PUSH HL ; Save address of dim'n size - CALL MLDEBC ; Multiply DE by BC to find - EX DE,HL ; amount of mem needed (to DE) - POP HL ; Restore address of dimension - POP AF ; Restore number of dimensions - DEC A ; Count them - JP NZ,CRARLP ; Do next dimension if more - PUSH AF ; Save locate/create flag - LD B,D ; MSB of memory needed - LD C,E ; LSB of memory needed - EX DE,HL - ADD HL,DE ; Add bytes to array start - JP C,OMERR ; Too big - Error - CALL ENFMEM ; See if enough memory - LD (ARREND),HL ; Save new end of array - -ZERARY: DEC HL ; Back through array data - LD (HL),0 ; Set array element to zero - CALL CPDEHL ; All elements zeroed? - JP NZ,ZERARY ; No - Keep on going - INC BC ; Number of bytes + 1 - LD D,A ; A=0 - LD HL,(CUROPR) ; Get address of array - LD E,(HL) ; Number of dimensions - EX DE,HL ; To HL - ADD HL,HL ; Two bytes per dimension size - ADD HL,BC ; Add number of bytes - EX DE,HL ; Bytes needed to DE - DEC HL - DEC HL - LD (HL),E ; Save LSB of bytes needed - INC HL - LD (HL),D ; Save MSB of bytes needed - INC HL - POP AF ; Locate / Create? - JP C,ENDDIM ; A is 0 , End if create -FINDEL: LD B,A ; Find array element - LD C,A - LD A,(HL) ; Number of dimensions - INC HL - DB 16H ; Skip "POP HL" -FNDELP: POP HL ; Address of next dim' size - LD E,(HL) ; Get LSB of dim'n size - INC HL - LD D,(HL) ; Get MSB of dim'n size - INC HL - EX (SP),HL ; Save address - Get index - PUSH AF ; Save number of dim'ns - CALL CPDEHL ; Dimension too large? - JP NC,BSERR ; Yes - ?BS Error - PUSH HL ; Save index - CALL MLDEBC ; Multiply previous by size - POP DE ; Index supplied to DE - ADD HL,DE ; Add index to pointer - POP AF ; Number of dimensions - DEC A ; Count them - LD B,H ; MSB of pointer - LD C,L ; LSB of pointer - JP NZ,FNDELP ; More - Keep going - ADD HL,HL ; 4 Bytes per element - ADD HL,HL - POP BC ; Start of array - ADD HL,BC ; Point to element - EX DE,HL ; Address of element to DE -ENDDIM: LD HL,(NXTOPR) ; Got code string address - RET - -FRE: LD HL,(ARREND) ; Start of free memory - EX DE,HL ; To DE - LD HL,0 ; End of free memory - ADD HL,SP ; Current stack value - LD A,(TYPE) ; Dummy argument type - OR A - JP Z,FRENUM ; Numeric - Free variable space - CALL GSTRCU ; Current string to pool - CALL GARBGE ; Garbage collection - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string space -FRENUM: LD A,L ; Get LSB of end - SUB E ; Subtract LSB of beginning - LD C,A ; Save difference if C - LD A,H ; Get MSB of end - SBC A,D ; Subtract MSB of beginning -ACPASS: LD B,C ; Return integer AC -ABPASS: LD D,B ; Return integer AB - LD E,0 - LD HL,TYPE ; Point to type - LD (HL),E ; Set type to numeric - LD B,80H+16 ; 16 bit integer - JP RETINT ; Return the integr - -POS: LD A,(CURPOS) ; Get cursor position -PASSA: LD B,A ; Put A into AB - XOR A ; Zero A - JP ABPASS ; Return integer AB - -DEF: CALL CHEKFN ; Get "FN" and name - CALL IDTEST ; Test for illegal direct - LD BC,DATA ; To get next statement - PUSH BC ; Save address for RETurn - PUSH DE ; Save address of function ptr - CALL CHKSYN ; Make sure "(" follows - DB "(" - CALL GETVAR ; Get argument variable name - PUSH HL ; Save code string address - EX DE,HL ; Argument address to HL - DEC HL - LD D,(HL) ; Get first byte of arg name - DEC HL - LD E,(HL) ; Get second byte of arg name - POP HL ; Restore code string address - CALL TSTNUM ; Make sure numeric argument - CALL CHKSYN ; Make sure ")" follows - DB ")" - CALL CHKSYN ; Make sure "=" follows - DB ZEQUAL ; "=" token - LD B,H ; Code string address to BC - LD C,L - EX (SP),HL ; Save code str , Get FN ptr - LD (HL),C ; Save LSB of FN code string - INC HL - LD (HL),B ; Save MSB of FN code string - JP SVSTAD ; Save address and do function - -DOFN: CALL CHEKFN ; Make sure FN follows - PUSH DE ; Save function pointer address - CALL EVLPAR ; Evaluate expression in "()" - CALL TSTNUM ; Make sure numeric result - EX (SP),HL ; Save code str , Get FN ptr - LD E,(HL) ; Get LSB of FN code string - INC HL - LD D,(HL) ; Get MSB of FN code string - INC HL - LD A,D ; And function DEFined? - OR E - JP Z,UFERR ; No - ?UF Error - LD A,(HL) ; Get LSB of argument address - INC HL - LD H,(HL) ; Get MSB of argument address - LD L,A ; HL = Arg variable address - PUSH HL ; Save it - LD HL,(FNRGNM) ; Get old argument name - EX (SP),HL ; ; Save old , Get new - LD (FNRGNM),HL ; Set new argument name - LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value - PUSH HL ; Save it - LD HL,(FNARG) ; Get MSB,EXP of old arg value - PUSH HL ; Save it - LD HL,FNARG ; HL = Value of argument - PUSH DE ; Save FN code string address - CALL FPTHL ; Move FPREG to argument - POP HL ; Get FN code string address - CALL GETNUM ; Get value from function - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,SNERR ; Bad character in FN - Error - POP HL ; Get MSB,EXP of old arg - LD (FNARG),HL ; Restore it - POP HL ; Get LSB,NLSB of old arg - LD (FNARG+2),HL ; Restore it - POP HL ; Get name of old arg - LD (FNRGNM),HL ; Restore it - POP HL ; Restore code string address - RET - -IDTEST: PUSH HL ; Save code string address - LD HL,(LINEAT) ; Get current line number - INC HL ; -1 means direct statement - LD A,H - OR L - POP HL ; Restore code string address - RET NZ ; Return if in program - LD E,ID ; ?ID Error - JP ERROR - -CHEKFN: CALL CHKSYN ; Make sure FN follows - DB ZFN ; "FN" token - LD A,80H - LD (FORFLG),A ; Flag FN name to find - OR (HL) ; FN name has bit 7 set - LD B,A ; in first byte of name - CALL GTFNAM ; Get FN name - JP TSTNUM ; Make sure numeric function - -STR: CALL TSTNUM ; Make sure it's a number - CALL NUMASC ; Turn number into text - CALL CRTST ; Create string entry for it - CALL GSTRCU ; Current string to pool - LD BC,TOPOOL ; Save in string pool - PUSH BC ; Save address on stack - -SAVSTR: LD A,(HL) ; Get string length - INC HL - INC HL - PUSH HL ; Save pointer to string - CALL TESTR ; See if enough string space - POP HL ; Restore pointer to string - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - CALL CRTMST ; Create string entry - PUSH HL ; Save pointer to MSB of addr - LD L,A ; Length of string - CALL TOSTRA ; Move to string area - POP DE ; Restore pointer to MSB - RET - -MKTMST: CALL TESTR ; See if enough string space -CRTMST: LD HL,TMPSTR ; Temporary string - PUSH HL ; Save it - LD (HL),A ; Save length of string - INC HL -SVSTAD: INC HL - LD (HL),E ; Save LSB of address - INC HL - LD (HL),D ; Save MSB of address - POP HL ; Restore pointer - RET - -CRTST: DEC HL ; DEC - INCed after -QTSTR: LD B,'"' ; Terminating quote - LD D,B ; Quote to D -DTSTR: PUSH HL ; Save start - LD C,-1 ; Set counter to -1 -QTSTLP: INC HL ; Move on - LD A,(HL) ; Get byte - INC C ; Count bytes - OR A ; End of line? - JP Z,CRTSTE ; Yes - Create string entry - CP D ; Terminator D found? - JP Z,CRTSTE ; Yes - Create string entry - CP B ; Terminator B found? - JP NZ,QTSTLP ; No - Keep looking -CRTSTE: CP '"' ; End with '"'? - CALL Z,GETCHR ; Yes - Get next character - EX (SP),HL ; Starting quote - INC HL ; First byte of string - EX DE,HL ; To DE - LD A,C ; Get length - CALL CRTMST ; Create string entry -TSTOPL: LD DE,TMPSTR ; Temporary string - LD HL,(TMSTPT) ; Temporary string pool pointer - LD (FPREG),HL ; Save address of string ptr - LD A,1 - LD (TYPE),A ; Set type to string - CALL DETHL4 ; Move string to pool - CALL CPDEHL ; Out of string pool? - LD (TMSTPT),HL ; Save new pointer - POP HL ; Restore code string address - LD A,(HL) ; Get next code byte - RET NZ ; Return if pool OK - LD E,ST ; ?ST Error - JP ERROR ; String pool overflow - -PRNUMS: INC HL ; Skip leading space -PRS: CALL CRTST ; Create string entry for it -PRS1: CALL GSTRCU ; Current string to pool - CALL LOADFP ; Move string block to BCDE - INC E ; Length + 1 -PRSLP: DEC E ; Count characters - RET Z ; End of string - LD A,(BC) ; Get byte to output - CALL OUTC ; Output character in A - CP CR ; Return? - CALL Z,DONULL ; Yes - Do nulls - INC BC ; Next byte in string - JP PRSLP ; More characters to output - -TESTR: OR A ; Test if enough room - DB 0EH ; No garbage collection done -GRBDON: POP AF ; Garbage collection done - PUSH AF ; Save status - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string area - CPL ; Negate length (Top down) - LD C,A ; -Length to BC - LD B,-1 ; BC = -ve length of string - ADD HL,BC ; Add to bottom of space in use - INC HL ; Plus one for 2's complement - CALL CPDEHL ; Below string RAM area? - JP C,TESTOS ; Tidy up if not done else err - LD (STRBOT),HL ; Save new bottom of area - INC HL ; Point to first byte of string - EX DE,HL ; Address to DE -POPAF: POP AF ; Throw away status push - RET - -TESTOS: POP AF ; Garbage collect been done? - LD E,OS ; ?OS Error - JP Z,ERROR ; Yes - Not enough string apace - CP A ; Flag garbage collect done - PUSH AF ; Save status - LD BC,GRBDON ; Garbage collection done - PUSH BC ; Save for RETurn -GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer -GARBLP: LD (STRBOT),HL ; Reset string pointer - LD HL,0 - PUSH HL ; Flag no string found - LD HL,(STRSPC) ; Get bottom of string space - PUSH HL ; Save bottom of string space - LD HL,TMSTPL ; Temporary string pool -GRBLP: EX DE,HL - LD HL,(TMSTPT) ; Temporary string pool pointer - EX DE,HL - CALL CPDEHL ; Temporary string pool done? - LD BC,GRBLP ; Loop until string pool done - JP NZ,STPOOL ; No - See if in string area - LD HL,(PROGND) ; Start of simple variables -SMPVAR: EX DE,HL - LD HL,(VAREND) ; End of simple variables - EX DE,HL - CALL CPDEHL ; All simple strings done? - JP Z,ARRLP ; Yes - Do string arrays - LD A,(HL) ; Get type of variable - INC HL - INC HL - OR A ; "S" flag set if string - CALL STRADD ; See if string in string area - JP SMPVAR ; Loop until simple ones done - -GNXARY: POP BC ; Scrap address of this array -ARRLP: EX DE,HL - LD HL,(ARREND) ; End of string arrays - EX DE,HL - CALL CPDEHL ; All string arrays done? - JP Z,SCNEND ; Yes - Move string if found - CALL LOADFP ; Get array name to BCDE - LD A,E ; Get type of array - PUSH HL ; Save address of num of dim'ns - ADD HL,BC ; Start of next array - OR A ; Test type of array - JP P,GNXARY ; Numeric array - Ignore it - LD (CUROPR),HL ; Save address of next array - POP HL ; Get address of num of dim'ns - LD C,(HL) ; BC = Number of dimensions - LD B,0 - ADD HL,BC ; Two bytes per dimension size - ADD HL,BC - INC HL ; Plus one for number of dim'ns -GRBARY: EX DE,HL - LD HL,(CUROPR) ; Get address of next array - EX DE,HL - CALL CPDEHL ; Is this array finished? - JP Z,ARRLP ; Yes - Get next one - LD BC,GRBARY ; Loop until array all done -STPOOL: PUSH BC ; Save return address - OR 80H ; Flag string type -STRADD: LD A,(HL) ; Get string length - INC HL - INC HL - LD E,(HL) ; Get LSB of string address - INC HL - LD D,(HL) ; Get MSB of string address - INC HL - RET P ; Not a string - Return - OR A ; Set flags on string length - RET Z ; Null string - Return - LD B,H ; Save variable pointer - LD C,L - LD HL,(STRBOT) ; Bottom of new area - CALL CPDEHL ; String been done? - LD H,B ; Restore variable pointer - LD L,C - RET C ; String done - Ignore - POP HL ; Return address - EX (SP),HL ; Lowest available string area - CALL CPDEHL ; String within string area? - EX (SP),HL ; Lowest available string area - PUSH HL ; Re-save return address - LD H,B ; Restore variable pointer - LD L,C - RET NC ; Outside string area - Ignore - POP BC ; Get return , Throw 2 away - POP AF ; - POP AF ; - PUSH HL ; Save variable pointer - PUSH DE ; Save address of current - PUSH BC ; Put back return address - RET ; Go to it - -SCNEND: POP DE ; Addresses of strings - POP HL ; - LD A,L ; HL = 0 if no more to do - OR H - RET Z ; No more to do - Return - DEC HL - LD B,(HL) ; MSB of address of string - DEC HL - LD C,(HL) ; LSB of address of string - PUSH HL ; Save variable address - DEC HL - DEC HL - LD L,(HL) ; HL = Length of string - LD H,0 - ADD HL,BC ; Address of end of string+1 - LD D,B ; String address to DE - LD E,C - DEC HL ; Last byte in string - LD B,H ; Address to BC - LD C,L - LD HL,(STRBOT) ; Current bottom of string area - CALL MOVSTR ; Move string to new address - POP HL ; Restore variable address - LD (HL),C ; Save new LSB of address - INC HL - LD (HL),B ; Save new MSB of address - LD L,C ; Next string area+1 to HL - LD H,B - DEC HL ; Next string area address - JP GARBLP ; Look for more strings - -CONCAT: PUSH BC ; Save prec' opr & code string - PUSH HL ; - LD HL,(FPREG) ; Get first string - EX (SP),HL ; Save first string - CALL OPRND ; Get second string - EX (SP),HL ; Restore first string - CALL TSTSTR ; Make sure it's a string - LD A,(HL) ; Get length of second string - PUSH HL ; Save first string - LD HL,(FPREG) ; Get second string - PUSH HL ; Save second string - ADD A,(HL) ; Add length of second string - LD E,LS ; ?LS Error - JP C,ERROR ; String too long - Error - CALL MKTMST ; Make temporary string - POP DE ; Get second string to DE - CALL GSTRDE ; Move to string pool if needed - EX (SP),HL ; Get first string - CALL GSTRHL ; Move to string pool if needed - PUSH HL ; Save first string - LD HL,(TMPSTR+2) ; Temporary string address - EX DE,HL ; To DE - CALL SSTSA ; First string to string area - CALL SSTSA ; Second string to string area - LD HL,EVAL2 ; Return to evaluation loop - EX (SP),HL ; Save return,get code string - PUSH HL ; Save code string address - JP TSTOPL ; To temporary string to pool - -SSTSA: POP HL ; Return address - EX (SP),HL ; Get string block,save return - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of string address - INC HL - LD B,(HL) ; Get MSB of string address - LD L,A ; Length to L -TOSTRA: INC L ; INC - DECed after -TSALP: DEC L ; Count bytes moved - RET Z ; End of string - Return - LD A,(BC) ; Get source - LD (DE),A ; Save destination - INC BC ; Next source - INC DE ; Next destination - JP TSALP ; Loop until string moved - -GETSTR: CALL TSTSTR ; Make sure it's a string -GSTRCU: LD HL,(FPREG) ; Get current string -GSTRHL: EX DE,HL ; Save DE -GSTRDE: CALL BAKTMP ; Was it last tmp-str? - EX DE,HL ; Restore DE - RET NZ ; No - Return - PUSH DE ; Save string - LD D,B ; String block address to DE - LD E,C - DEC DE ; Point to length - LD C,(HL) ; Get string length - LD HL,(STRBOT) ; Current bottom of string area - CALL CPDEHL ; Last one in string area? - JP NZ,POPHL ; No - Return - LD B,A ; Clear B (A=0) - ADD HL,BC ; Remove string from str' area - LD (STRBOT),HL ; Save new bottom of str' area -POPHL: POP HL ; Restore string - RET - -BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top - DEC HL ; Back - LD B,(HL) ; Get MSB of address - DEC HL ; Back - LD C,(HL) ; Get LSB of address - DEC HL ; Back - DEC HL ; Back - CALL CPDEHL ; String last in string pool? - RET NZ ; Yes - Leave it - LD (TMSTPT),HL ; Save new string pool top - RET - -LEN: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GETLEN: CALL GETSTR ; Get string and its length - XOR A - LD D,A ; Clear D - LD (TYPE),A ; Set type to numeric - LD A,(HL) ; Get length of string - OR A ; Set status flags - RET - -ASC: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GTFLNM: CALL GETLEN ; Get length of string - JP Z,FCERR ; Null string - Error - INC HL - INC HL - LD E,(HL) ; Get LSB of address - INC HL - LD D,(HL) ; Get MSB of address - LD A,(DE) ; Get first byte of string - RET - -CHR: LD A,1 ; One character string - CALL MKTMST ; Make a temporary string - CALL MAKINT ; Make it integer A - LD HL,(TMPSTR+2) ; Get address of string - LD (HL),E ; Save character -TOPOOL: POP BC ; Clean up stack - JP TSTOPL ; Temporary string to pool - -LEFT: CALL LFRGNM ; Get number and ending ")" - XOR A ; Start at first byte in string -RIGHT1: EX (SP),HL ; Save code string,Get string - LD C,A ; Starting position in string -MID1: PUSH HL ; Save string block address - LD A,(HL) ; Get length of string - CP B ; Compare with number given - JP C,ALLFOL ; All following bytes required - LD A,B ; Get new length - DB 11H ; Skip "LD C,0" -ALLFOL: LD C,0 ; First byte of string - PUSH BC ; Save position in string - CALL TESTR ; See if enough string space - POP BC ; Get position in string - POP HL ; Restore string block address - PUSH HL ; And re-save it - INC HL - INC HL - LD B,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,B ; HL = address of string - LD B,0 ; BC = starting address - ADD HL,BC ; Point to that byte - LD B,H ; BC = source string - LD C,L - CALL CRTMST ; Create a string entry - LD L,A ; Length of new string - CALL TOSTRA ; Move string to string area - POP DE ; Clear stack - CALL GSTRDE ; Move to string pool if needed - JP TSTOPL ; Temporary string to pool - -RIGHT: CALL LFRGNM ; Get number and ending ")" - POP DE ; Get string length - PUSH DE ; And re-save - LD A,(DE) ; Get length - SUB B ; Move back N bytes - JP RIGHT1 ; Go and get sub-string - -MID: EX DE,HL ; Get code string address - LD A,(HL) ; Get next byte "," or ")" - CALL MIDNUM ; Get number supplied - INC B ; Is it character zero? - DEC B - JP Z,FCERR ; Yes - Error - PUSH BC ; Save starting position - LD E,255 ; All of string - CP ")" ; Any length given? - JP Z,RSTSTR ; No - Rest of string - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETINT ; Get integer 0-255 -RSTSTR: CALL CHKSYN ; Make sure ")" follows - DB ")" - POP AF ; Restore starting position - EX (SP),HL ; Get string,8ave code string - LD BC,MID1 ; Continuation of MID$ routine - PUSH BC ; Save for return - DEC A ; Starting position-1 - CP (HL) ; Compare with length - LD B,0 ; Zero bytes length - RET NC ; Null string if start past end - LD C,A ; Save starting position-1 - LD A,(HL) ; Get length of string - SUB C ; Subtract start - CP E ; Enough string for it? - LD B,A ; Save maximum length available - RET C ; Truncate string if needed - LD B,E ; Set specified length - RET ; Go and create string - -VAL: CALL GETLEN ; Get length of string - JP Z,RESZER ; Result zero - LD E,A ; Save length - INC HL - INC HL - LD A,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,A ; HL = String address - PUSH HL ; Save string address - ADD HL,DE - LD B,(HL) ; Get end of string+1 byte - LD (HL),D ; Zero it to terminate - EX (SP),HL ; Save string end,get start - PUSH BC ; Save end+1 byte - LD A,(HL) ; Get starting byte - CALL ASCTFP ; Convert ASCII string to FP - POP BC ; Restore end+1 byte - POP HL ; Restore end+1 address - LD (HL),B ; Put back original byte - RET - -LFRGNM: EX DE,HL ; Code string address to HL - CALL CHKSYN ; Make sure ")" follows - DB ")" -MIDNUM: POP BC ; Get return address - POP DE ; Get number supplied - PUSH BC ; Re-save return address - LD B,E ; Number to B - RET - -INP: CALL MAKINT ; Make it integer A - LD (INPORT),A ; Set input port - CALL INPSUB ; Get input from port - JP PASSA ; Return integer A - -POUT: CALL SETIO ; Set up port number - JP OUTSUB ; Output data and return - -WAIT: CALL SETIO ; Set up port number - PUSH AF ; Save AND mask - LD E,0 ; Assume zero if none given - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,NOXOR ; No XOR byte given - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETINT ; Get integer 0-255 to XOR with -NOXOR: POP BC ; Restore AND mask -WAITLP: CALL INPSUB ; Get input - XOR E ; Flip selected bits - AND B ; Result non-zero? - JP Z,WAITLP ; No = keep waiting - RET - -SETIO: CALL GETINT ; Get integer 0-255 - LD (INPORT),A ; Set input port - LD (OTPORT),A ; Set output port - CALL CHKSYN ; Make sure "," follows - DB "," - JP GETINT ; Get integer 0-255 and return - -FNDNUM: CALL GETCHR ; Get next character -GETINT: CALL GETNUM ; Get a number from 0 to 255 -MAKINT: CALL DEPINT ; Make sure value 0 - 255 - LD A,D ; Get MSB of number - OR A ; Zero? - JP NZ,FCERR ; No - Error - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - LD A,E ; Get number to A - RET - -; << NO REFERENCE TO THIS SECTION OF CODE >> -; << Set up another program area (can be in ROM) >> - - LD HL,(BASTXT) ; Get start of program text - LD (PROGND),HL ; Set more variable space - LD HL,8000H ; Address of new program - LD E,(HL) ; Get LSB of new RAM end - INC HL - LD D,(HL) ; Get MSB of new RAM end - INC HL - INC HL ; Null at start of program - LD (BASTXT),HL ; New program text area 8003H - EX DE,HL ; New RAM end to HL - LD (LSTRAM),HL ; Set new RAM end - LD (STRSPC),HL ; Clear string space - LD BC,RUNCNT ; Execution driver loop - PUSH BC ; Save for return - JP RUNFST ; Clear variables and continue - -RUART: JP GUART ; Get a byte from UART - -WUART2: CALL WUART ; Send 2 Bytes to UART -WUART: PUSH AF ; Save byte - PUSH BC ; Save BC - LD C,A ; Byte to C - CALL SUART ; Send byte to UART - POP BC ; Restore BC - POP AF ; Restore byte - RET - -CSAVE: LD B,1 ; Flag "CSAVE" - CP ZTIMES ; "*" token? ("CSAVE*") - JP Z,ARRSV1 ; Yes - Array save - CALL EVAL ; Evaluate expression - PUSH HL ; Save code string address - CALL GTFLNM ; Get file name - PUSH DE ; Save file name - CALL CASFFW ; Turn on motor and wait - POP DE ; Restore file name - LD A,11010011B ; Header byte - CALL WUART ; Send byte to UART - CALL WUART2 ; Send byte twice more - LD A,(DE) ; Get file name - CALL WUART ; Send it to UART - NOP - NOP - NOP - LD HL,PROGND ; Start of program information - LD (ARG1),HL ; Save for monitor save routine - LD HL,(PROGND) ; End of program information - LD (ARG2),HL ; Save for monitor save routine - CALL SAVE ; Save program to tape - CALL ARET ; Not much there! - POP HL ; Restore code string address - RET - -CLOAD: LD A,(HL) ; Get byte after "CLOAD" - CP ZTIMES ; "*" token? ("CLOAD*") - JP Z,ARRLD1 ; Yes - Array load - CALL SMOTOR ; Start motor and get "?" - SUB ZPRINT ; "?" ("PRINT" token) Verify? - JP Z,FLGVER ; Yes - Flag "verify" - XOR A ; Flag "load" - DB 01H ; Skip "CPL" and "INC HL" -FLGVER: CPL ; Flag "verify" - INC HL ; Skip over "?" - PUSH AF ; Save verify flag - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - LD A,0 ; Any file will do - JP Z,ANYNAM ; No name given - Any will do - CALL EVAL ; Evaluate expression - CALL GTFLNM ; Get file name - LD A,(DE) ; Get first byte of name -ANYNAM: LD L,A ; Save name to find - POP AF ; Get verify flag - PUSH AF ; And re-save - OR A ; Verify of load? - LD H,A - LD (FPREG),HL ; Save nam of file to find - CALL Z,CLRPTR ; Load - Clear pointers - LD HL,(FPREG) ; Get name of program to find - EX DE,HL ; Name to DE -CLOAD1: LD B,3 ; 3 Header bytes -CLOAD2: CALL RUART ; Get a byte from UART - SUB 11010011B ; Header byte? - JP NZ,CLOAD1 ; Look for header - DEC B ; Count header bytes - JP NZ,CLOAD2 ; More to find? - CALL RUART ; Get name of file - CALL FILFND ; Display "file X found" - INC E ; Any file name given? - DEC E - JP Z,THSFIL ; No - This file will do - CP E ; Has file been found? - JP NZ,CLOAD1 ; No - Look for another -THSFIL: NOP - NOP - NOP - POP AF ; Get verify flag - OR A ; Load or verify? - JP NZ,CLOADV ; Verify program - CALL MONLD ; Use monitor to load program - LD HL,(PROGND) ; Get end of program - CALL ENFMEM ; See if enough memory - JP CLOADE ; "Ok" and set up pointers - -CLOADV: CALL MONVE ; Use monitor to verify program -CLOADE: LD HL,OKMSG ; "Ok" message - CALL PRS ; Output string - CALL ARET ; Not a lot there! - JP SETPTR ; Set up line pointers - -OUTBAD: LD HL,BAD ; "Bad" message - CALL PRS ; Output string - JP ERRIN ; In line message - -FILFND: PUSH BC ; <- Save - PUSH HL ; <- all - PUSH DE ; <- the - PUSH AF ; <- registers - LD HL,FILE ; "File" message - CALL PRS ; Output string - POP AF ; Get file name - PUSH AF ; And re-save - CALL CONMON ; Output file name to screen - LD HL,FOUND ; "Found" message - CALL PRS ; Output string - POP AF ; <- Restore - POP DE ; <- all - POP HL ; <- the - POP BC ; <- registers - RET - -FILE: DB "File ",0 -FOUND: DB " Found",CR,LF,0 -BAD: DB "Bad",0,0,0 - -PEEK: CALL DEINT ; Get memory address - LD A,(DE) ; Get byte in memory - JP PASSA ; Return integer A - -POKE: CALL GETNUM ; Get memory address - CALL DEINT ; Get integer -32768 to 3276 - PUSH DE ; Save memory address - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETINT ; Get integer 0-255 - POP DE ; Restore memory address - LD (DE),A ; Load it into memory - RET - -ROUND: LD HL,HALF ; Add 0.5 to FPREG -ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE - JP FPADD ; Add BCDE to FPREG - -SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL - DB 21H ; Skip "POP BC" and "POP DE" -PSUB: POP BC ; Get FP number from stack - POP DE -SUBCDE: CALL INVSGN ; Negate FPREG -FPADD: LD A,B ; Get FP exponent - OR A ; Is number zero? - RET Z ; Yes - Nothing to add - LD A,(FPEXP) ; Get FPREG exponent - OR A ; Is this number zero? - JP Z,FPBCDE ; Yes - Move BCDE to FPREG - SUB B ; BCDE number larger? - JP NC,NOSWAP ; No - Don't swap them - CPL ; Two's complement - INC A ; FP exponent - EX DE,HL - CALL STAKFP ; Put FPREG on stack - EX DE,HL - CALL FPBCDE ; Move BCDE to FPREG - POP BC ; Restore number from stack - POP DE -NOSWAP: CP 24+1 ; Second number insignificant? - RET NC ; Yes - First number is result - PUSH AF ; Save number of bits to scale - CALL SIGNS ; Set MSBs & sign of result - LD H,A ; Save sign of result - POP AF ; Restore scaling factor - CALL SCALE ; Scale BCDE to same exponent - OR H ; Result to be positive? - LD HL,FPREG ; Point to FPREG - JP P,MINCDE ; No - Subtract FPREG from CDE - CALL PLUCDE ; Add FPREG to CDE - JP NC,RONDUP ; No overflow - Round it up - INC HL ; Point to exponent - INC (HL) ; Increment it - JP Z,OVERR ; Number overflowed - Error - LD L,1 ; 1 bit to shift right - CALL SHRT1 ; Shift result right - JP RONDUP ; Round it up - -MINCDE: XOR A ; Clear A and carry - SUB B ; Negate exponent - LD B,A ; Re-save exponent - LD A,(HL) ; Get LSB of FPREG - SBC A, E ; Subtract LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - SBC A,D ; Subtract NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - SBC A,C ; Subtract MSB of BCDE - LD C,A ; Save MSB of BCDE -CONPOS: CALL C,COMPL ; Overflow - Make it positive - -BNORM: LD L,B ; L = Exponent - LD H,E ; H = LSB - XOR A -BNRMLP: LD B,A ; Save bit count - LD A,C ; Get MSB - OR A ; Is it zero? - JP NZ,PNORM ; No - Do it bit at a time - LD C,D ; MSB = NMSB - LD D,H ; NMSB= LSB - LD H,L ; LSB = VLSB - LD L,A ; VLSB= 0 - LD A,B ; Get exponent - SUB 8 ; Count 8 bits - CP -24-8 ; Was number zero? - JP NZ,BNRMLP ; No - Keep normalising -RESZER: XOR A ; Result is zero -SAVEXP: LD (FPEXP),A ; Save result as zero - RET - -NORMAL: DEC B ; Count bits - ADD HL,HL ; Shift HL left - LD A,D ; Get NMSB - RLA ; Shift left with last bit - LD D,A ; Save NMSB - LD A,C ; Get MSB - ADC A,A ; Shift left with last bit - LD C,A ; Save MSB -PNORM: JP P,NORMAL ; Not done - Keep going - LD A,B ; Number of bits shifted - LD E,H ; Save HL in EB - LD B,L - OR A ; Any shifting done? - JP Z,RONDUP ; No - Round it up - LD HL,FPEXP ; Point to exponent - ADD A,(HL) ; Add shifted bits - LD (HL),A ; Re-save exponent - JP NC,RESZER ; Underflow - Result is zero - RET Z ; Result is zero -RONDUP: LD A,B ; Get VLSB of number -RONDB: LD HL,FPEXP ; Point to exponent - OR A ; Any rounding? - CALL M,FPROND ; Yes - Round number up - LD B,(HL) ; B = Exponent - INC HL - LD A,(HL) ; Get sign of result - AND 10000000B ; Only bit 7 needed - XOR C ; Set correct sign - LD C,A ; Save correct sign in number - JP FPBCDE ; Move BCDE to FPREG - -FPROND: INC E ; Round LSB - RET NZ ; Return if ok - INC D ; Round NMSB - RET NZ ; Return if ok - INC C ; Round MSB - RET NZ ; Return if ok - LD C,80H ; Set normal value - INC (HL) ; Increment exponent - RET NZ ; Return if ok - JP OVERR ; Overflow error - -PLUCDE: LD A,(HL) ; Get LSB of FPREG - ADD A,E ; Add LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - ADC A,D ; Add NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - ADC A,C ; Add MSB of BCDE - LD C,A ; Save MSB of BCDE - RET - -COMPL: LD HL,SGNRES ; Sign of result - LD A,(HL) ; Get sign of result - CPL ; Negate it - LD (HL),A ; Put it back - XOR A - LD L,A ; Set L to zero - SUB B ; Negate exponent,set carry - LD B,A ; Re-save exponent - LD A,L ; Load zero - SBC A,E ; Negate LSB - LD E,A ; Re-save LSB - LD A,L ; Load zero - SBC A,D ; Negate NMSB - LD D,A ; Re-save NMSB - LD A,L ; Load zero - SBC A,C ; Negate MSB - LD C,A ; Re-save MSB - RET - -SCALE: LD B,0 ; Clear underflow -SCALLP: SUB 8 ; 8 bits (a whole byte)? - JP C,SHRITE ; No - Shift right A bits - LD B,E ; <- Shift - LD E,D ; <- right - LD D,C ; <- eight - LD C,0 ; <- bits - JP SCALLP ; More bits to shift - -SHRITE: ADD A,8+1 ; Adjust count - LD L,A ; Save bits to shift -SHRLP: XOR A ; Flag for all done - DEC L ; All shifting done? - RET Z ; Yes - Return - LD A,C ; Get MSB -SHRT1: RRA ; Shift it right - LD C,A ; Re-save - LD A,D ; Get NMSB - RRA ; Shift right with last bit - LD D,A ; Re-save it - LD A,E ; Get LSB - RRA ; Shift right with last bit - LD E,A ; Re-save it - LD A,B ; Get underflow - RRA ; Shift right with last bit - LD B,A ; Re-save underflow - JP SHRLP ; More bits to do - -UNITY: DB 000H,000H,000H,081H ; 1.00000 - -LOGTAB: DB 3 ; Table used by LOG - DB 0AAH,056H,019H,080H ; 0.59898 - DB 0F1H,022H,076H,080H ; 0.96147 - DB 045H,0AAH,038H,082H ; 2.88539 - -LOG: CALL TSTSGN ; Test sign of value - OR A - JP PE,FCERR ; ?FC Error if <= zero - LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - LD BC,8035H ; BCDE = SQR(1/2) - LD DE,04F3H - SUB B ; Scale value to be < 1 - PUSH AF ; Save scale factor - LD (HL),B ; Save new exponent - PUSH DE ; Save SQR(1/2) - PUSH BC - CALL FPADD ; Add SQR(1/2) to value - POP BC ; Restore SQR(1/2) - POP DE - INC B ; Make it SQR(2) - CALL DVBCDE ; Divide by SQR(2) - LD HL,UNITY ; Point to 1. - CALL SUBPHL ; Subtract FPREG from 1 - LD HL,LOGTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD BC,8080H ; BCDE = -0.5 - LD DE,0000H - CALL FPADD ; Subtract 0.5 from FPREG - POP AF ; Restore scale factor - CALL RSCALE ; Re-scale number -MULLN2: LD BC,8031H ; BCDE = Ln(2) - LD DE,7218H - DB 21H ; Skip "POP BC" and "POP DE" - -MULT: POP BC ; Get number from stack - POP DE -FPMULT: CALL TSTSGN ; Test sign of FPREG - RET Z ; Return zero if zero - LD L,0 ; Flag add exponents - CALL ADDEXP ; Add exponents - LD A,C ; Get MSB of multiplier - LD (MULVAL),A ; Save MSB of multiplier - EX DE,HL - LD (MULVAL+1),HL ; Save rest of multiplier - LD BC,0 ; Partial product (BCDE) = zero - LD D,B - LD E,B - LD HL,BNORM ; Address of normalise - PUSH HL ; Save for return - LD HL,MULT8 ; Address of 8 bit multiply - PUSH HL ; Save for NMSB,MSB - PUSH HL ; - LD HL,FPREG ; Point to number -MULT8: LD A,(HL) ; Get LSB of number - INC HL ; Point to NMSB - OR A ; Test LSB - JP Z,BYTSFT ; Zero - shift to next byte - PUSH HL ; Save address of number - LD L,8 ; 8 bits to multiply by -MUL8LP: RRA ; Shift LSB right - LD H,A ; Save LSB - LD A,C ; Get MSB - JP NC,NOMADD ; Bit was zero - Don't add - PUSH HL ; Save LSB and count - LD HL,(MULVAL+1) ; Get LSB and NMSB - ADD HL,DE ; Add NMSB and LSB - EX DE,HL ; Leave sum in DE - POP HL ; Restore MSB and count - LD A,(MULVAL) ; Get MSB of multiplier - ADC A,C ; Add MSB -NOMADD: RRA ; Shift MSB right - LD C,A ; Re-save MSB - LD A,D ; Get NMSB - RRA ; Shift NMSB right - LD D,A ; Re-save NMSB - LD A,E ; Get LSB - RRA ; Shift LSB right - LD E,A ; Re-save LSB - LD A,B ; Get VLSB - RRA ; Shift VLSB right - LD B,A ; Re-save VLSB - DEC L ; Count bits multiplied - LD A,H ; Get LSB of multiplier - JP NZ,MUL8LP ; More - Do it -POPHRT: POP HL ; Restore address of number - RET - -BYTSFT: LD B,E ; Shift partial product left - LD E,D - LD D,C - LD C,A - RET - -DIV10: CALL STAKFP ; Save FPREG on stack - LD BC,8420H ; BCDE = 10. - LD DE,0000H - CALL FPBCDE ; Move 10 to FPREG - -DIV: POP BC ; Get number from stack - POP DE -DVBCDE: CALL TSTSGN ; Test sign of FPREG - JP Z,DZERR ; Error if division by zero - LD L,-1 ; Flag subtract exponents - CALL ADDEXP ; Subtract exponents - INC (HL) ; Add 2 to exponent to adjust - INC (HL) - DEC HL ; Point to MSB - LD A,(HL) ; Get MSB of dividend - LD (DIV3),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get NMSB of dividend - LD (DIV2),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get MSB of dividend - LD (DIV1),A ; Save for subtraction - LD B,C ; Get MSB - EX DE,HL ; NMSB,LSB to HL - XOR A - LD C,A ; Clear MSB of quotient - LD D,A ; Clear NMSB of quotient - LD E,A ; Clear LSB of quotient - LD (DIV4),A ; Clear overflow count -DIVLP: PUSH HL ; Save divisor - PUSH BC - LD A,L ; Get LSB of number - CALL DIVSUP ; Subt' divisor from dividend - SBC A,0 ; Count for overflows - CCF - JP NC,RESDIV ; Restore divisor if borrow - LD (DIV4),A ; Re-save overflow count - POP AF ; Scrap divisor - POP AF - SCF ; Set carry to - DB 0D2H ; Skip "POP BC" and "POP HL" - -RESDIV: POP BC ; Restore divisor - POP HL - LD A,C ; Get MSB of quotient - INC A - DEC A - RRA ; Bit 0 to bit 7 - JP M,RONDB ; Done - Normalise result - RLA ; Restore carry - LD A,E ; Get LSB of quotient - RLA ; Double it - LD E,A ; Put it back - LD A,D ; Get NMSB of quotient - RLA ; Double it - LD D,A ; Put it back - LD A,C ; Get MSB of quotient - RLA ; Double it - LD C,A ; Put it back - ADD HL,HL ; Double NMSB,LSB of divisor - LD A,B ; Get MSB of divisor - RLA ; Double it - LD B,A ; Put it back - LD A,(DIV4) ; Get VLSB of quotient - RLA ; Double it - LD (DIV4),A ; Put it back - LD A,C ; Get MSB of quotient - OR D ; Merge NMSB - OR E ; Merge LSB - JP NZ,DIVLP ; Not done - Keep dividing - PUSH HL ; Save divisor - LD HL,FPEXP ; Point to exponent - DEC (HL) ; Divide by 2 - POP HL ; Restore divisor - JP NZ,DIVLP ; Ok - Keep going - JP OVERR ; Overflow error - -ADDEXP: LD A,B ; Get exponent of dividend - OR A ; Test it - JP Z,OVTST3 ; Zero - Result zero - LD A,L ; Get add/subtract flag - LD HL,FPEXP ; Point to exponent - XOR (HL) ; Add or subtract it - ADD A,B ; Add the other exponent - LD B,A ; Save new exponent - RRA ; Test exponent for overflow - XOR B - LD A,B ; Get exponent - JP P,OVTST2 ; Positive - Test for overflow - ADD A,80H ; Add excess 128 - LD (HL),A ; Save new exponent - JP Z,POPHRT ; Zero - Result zero - CALL SIGNS ; Set MSBs and sign of result - LD (HL),A ; Save new exponent - DEC HL ; Point to MSB - RET - -OVTST1: CALL TSTSGN ; Test sign of FPREG - CPL ; Invert sign - POP HL ; Clean up stack -OVTST2: OR A ; Test if new exponent zero -OVTST3: POP HL ; Clear off return address - JP P,RESZER ; Result zero - JP OVERR ; Overflow error - -MLSP10: CALL BCDEFP ; Move FPREG to BCDE - LD A,B ; Get exponent - OR A ; Is it zero? - RET Z ; Yes - Result is zero - ADD A,2 ; Multiply by 4 - JP C,OVERR ; Overflow - ?OV Error - LD B,A ; Re-save exponent - CALL FPADD ; Add BCDE to FPREG (Times 5) - LD HL,FPEXP ; Point to exponent - INC (HL) ; Double number (Times 10) - RET NZ ; Ok - Return - JP OVERR ; Overflow error - -TSTSGN: LD A,(FPEXP) ; Get sign of FPREG - OR A - RET Z ; RETurn if number is zero - LD A,(FPREG+2) ; Get MSB of FPREG - DB 0FEH ; Test sign -RETREL: CPL ; Invert sign - RLA ; Sign bit to carry -FLGDIF: SBC A,A ; Carry to all bits of A - RET NZ ; Return -1 if negative - INC A ; Bump to +1 - RET ; Positive - Return +1 - -SGN: CALL TSTSGN ; Test sign of FPREG -FLGREL: LD B,80H+8 ; 8 bit integer in exponent - LD DE,0 ; Zero NMSB and LSB -RETINT: LD HL,FPEXP ; Point to exponent - LD C,A ; CDE = MSB,NMSB and LSB - LD (HL),B ; Save exponent - LD B,0 ; CDE = integer to normalise - INC HL ; Point to sign of result - LD (HL),80H ; Set sign of result - RLA ; Carry = sign of integer - JP CONPOS ; Set sign of result - -ABS: CALL TSTSGN ; Test sign of FPREG - RET P ; Return if positive -INVSGN: LD HL,FPREG+2 ; Point to MSB - LD A,(HL) ; Get sign of mantissa - XOR 80H ; Invert sign of mantissa - LD (HL),A ; Re-save sign of mantissa - RET - -STAKFP: EX DE,HL ; Save code string address - LD HL,(FPREG) ; LSB,NLSB of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - LD HL,(FPREG+2) ; MSB and exponent of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - EX DE,HL ; Restore code string address - RET - -PHLTFP: CALL LOADFP ; Number at HL to BCDE -FPBCDE: EX DE,HL ; Save code string address - LD (FPREG),HL ; Save LSB,NLSB of number - LD H,B ; Exponent of number - LD L,C ; MSB of number - LD (FPREG+2),HL ; Save MSB and exponent - EX DE,HL ; Restore code string address - RET - -BCDEFP: LD HL,FPREG ; Point to FPREG -LOADFP: LD E,(HL) ; Get LSB of number - INC HL - LD D,(HL) ; Get NMSB of number - INC HL - LD C,(HL) ; Get MSB of number - INC HL - LD B,(HL) ; Get exponent of number -INCHL: INC HL ; Used for conditional "INC HL" - RET - -FPTHL: LD DE,FPREG ; Point to FPREG -DETHL4: LD B,4 ; 4 bytes to move -DETHLB: LD A,(DE) ; Get source - LD (HL),A ; Save destination - INC DE ; Next source - INC HL ; Next destination - DEC B ; Count bytes - JP NZ,DETHLB ; Loop if more - RET - -SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG - LD A,(HL) ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD (HL),A ; Save new MSB - CCF ; Complement sign - RRA ; Old sign to carry - INC HL - INC HL - LD (HL),A ; Set sign of result - LD A,C ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD C,A ; Save MSB - RRA - XOR (HL) ; New sign of result - RET - -CMPNUM: LD A,B ; Get exponent of number - OR A - JP Z,TSTSGN ; Zero - Test sign of FPREG - LD HL,RETREL ; Return relation routine - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD A,C ; Get MSB of number - RET Z ; FPREG zero - Number's MSB - LD HL,FPREG+2 ; MSB of FPREG - XOR (HL) ; Combine signs - LD A,C ; Get MSB of number - RET M ; Exit if signs different - CALL CMPFP ; Compare FP numbers - RRA ; Get carry to sign - XOR C ; Combine with MSB of number - RET - -CMPFP: INC HL ; Point to exponent - LD A,B ; Get exponent - CP (HL) ; Compare exponents - RET NZ ; Different - DEC HL ; Point to MBS - LD A,C ; Get MSB - CP (HL) ; Compare MSBs - RET NZ ; Different - DEC HL ; Point to NMSB - LD A,D ; Get NMSB - CP (HL) ; Compare NMSBs - RET NZ ; Different - DEC HL ; Point to LSB - LD A,E ; Get LSB - SUB (HL) ; Compare LSBs - RET NZ ; Different - POP HL ; Drop RETurn - POP HL ; Drop another RETurn - RET - -FPINT: LD B,A ; <- Move - LD C,A ; <- exponent - LD D,A ; <- to all - LD E,A ; <- bits - OR A ; Test exponent - RET Z ; Zero - Return zero - PUSH HL ; Save pointer to number - CALL BCDEFP ; Move FPREG to BCDE - CALL SIGNS ; Set MSBs & sign of result - XOR (HL) ; Combine with sign of FPREG - LD H,A ; Save combined signs - CALL M,DCBCDE ; Negative - Decrement BCDE - LD A,80H+24 ; 24 bits - SUB B ; Bits to shift - CALL SCALE ; Shift BCDE - LD A,H ; Get combined sign - RLA ; Sign to carry - CALL C,FPROND ; Negative - Round number up - LD B,0 ; Zero exponent - CALL C,COMPL ; If negative make positive - POP HL ; Restore pointer to number - RET - -DCBCDE: DEC DE ; Decrement BCDE - LD A,D ; Test LSBs - AND E - INC A - RET NZ ; Exit if LSBs not FFFF - DEC BC ; Decrement MSBs - RET - -INT: LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - CP 80H+24 ; Integer accuracy only? - LD A,(FPREG) ; Get LSB - RET NC ; Yes - Already integer - LD A,(HL) ; Get exponent - CALL FPINT ; F.P to integer - LD (HL),80H+24 ; Save 24 bit integer - LD A,E ; Get LSB of number - PUSH AF ; Save LSB - LD A,C ; Get MSB of number - RLA ; Sign to carry - CALL CONPOS ; Set sign of result - POP AF ; Restore LSB of number - RET - -MLDEBC: LD HL,0 ; Clear partial product - LD A,B ; Test multiplier - OR C - RET Z ; Return zero if zero - LD A,16 ; 16 bits -MLDBLP: ADD HL,HL ; Shift P.P left - JP C,BSERR ; ?BS Error if overflow - EX DE,HL - ADD HL,HL ; Shift multiplier left - EX DE,HL - JP NC,NOMLAD ; Bit was zero - No add - ADD HL,BC ; Add multiplicand - JP C,BSERR ; ?BS Error if overflow -NOMLAD: DEC A ; Count bits - JP NZ,MLDBLP ; More - RET - -ASCTFP: CP "-" ; Negative? - PUSH AF ; Save it and flags - JP Z,CNVNUM ; Yes - Convert number - CP "+" ; Positive? - JP Z,CNVNUM ; Yes - Convert number - DEC HL ; DEC 'cos GETCHR INCs -CNVNUM: CALL RESZER ; Set result to zero - LD B,A ; Digits after point counter - LD D,A ; Sign of exponent - LD E,A ; Exponent of ten - CPL - LD C,A ; Before or after point flag -MANLP: CALL GETCHR ; Get next character - JP C,ADDIG ; Digit - Add to number - CP "." - JP Z,DPOINT ; "." - Flag point - CP "E" - JP NZ,CONEXP ; Not "E" - Scale number - CALL GETCHR ; Get next character - CALL SGNEXP ; Get sign of exponent -EXPLP: CALL GETCHR ; Get next character - JP C,EDIGIT ; Digit - Add to exponent - INC D ; Is sign negative? - JP NZ,CONEXP ; No - Scale number - XOR A - SUB E ; Negate exponent - LD E,A ; And re-save it - INC C ; Flag end of number -DPOINT: INC C ; Flag point passed - JP Z,MANLP ; Zero - Get another digit -CONEXP: PUSH HL ; Save code string address - LD A,E ; Get exponent - SUB B ; Subtract digits after point -SCALMI: CALL P,SCALPL ; Positive - Multiply number - JP P,ENDCON ; Positive - All done - PUSH AF ; Save number of times to /10 - CALL DIV10 ; Divide by 10 - POP AF ; Restore count - INC A ; Count divides - -ENDCON: JP NZ,SCALMI ; More to do - POP DE ; Restore code string address - POP AF ; Restore sign of number - CALL Z,INVSGN ; Negative - Negate number - EX DE,HL ; Code string address to HL - RET - -SCALPL: RET Z ; Exit if no scaling needed -MULTEN: PUSH AF ; Save count - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore count - DEC A ; Count multiplies - RET - -ADDIG: PUSH DE ; Save sign of exponent - LD D,A ; Save digit - LD A,B ; Get digits after point - ADC A,C ; Add one if after point - LD B,A ; Re-save counter - PUSH BC ; Save point flags - PUSH HL ; Save code string address - PUSH DE ; Save digit - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore digit - SUB "0" ; Make it absolute - CALL RSCALE ; Re-scale number - POP HL ; Restore code string address - POP BC ; Restore point flags - POP DE ; Restore sign of exponent - JP MANLP ; Get another digit - -RSCALE: CALL STAKFP ; Put number on stack - CALL FLGREL ; Digit to add to FPREG -PADD: POP BC ; Restore number - POP DE - JP FPADD ; Add BCDE to FPREG and return - -EDIGIT: LD A,E ; Get digit - RLCA ; Times 2 - RLCA ; Times 4 - ADD A,E ; Times 5 - RLCA ; Times 10 - ADD A,(HL) ; Add next digit - SUB "0" ; Make it absolute - LD E,A ; Save new digit - JP EXPLP ; Look for another digit - -LINEIN: PUSH HL ; Save code string address - LD HL,INMSG ; Output " in " - CALL PRS ; Output string at HL - POP HL ; Restore code string address -PRNTHL: EX DE,HL ; Code string address to DE - XOR A - LD B,80H+24 ; 24 bits - CALL RETINT ; Return the integer - LD HL,PRNUMS ; Print number string - PUSH HL ; Save for return -NUMASC: LD HL,PBUFF ; Convert number to ASCII - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD (HL)," " ; Space at start - JP P,SPCFST ; Positive - Space to start - LD (HL),"-" ; "-" sign at start -SPCFST: INC HL ; First byte of number - LD (HL),"0" ; "0" if zero - JP Z,JSTZER ; Return "0" if zero - PUSH HL ; Save buffer address - CALL M,INVSGN ; Negate FPREG if negative - XOR A ; Zero A - PUSH AF ; Save it - CALL RNGTST ; Test number is in range -SIXDIG: LD BC,9143H ; BCDE - 99999.9 - LD DE,4FF8H - CALL CMPNUM ; Compare numbers - OR A - JP PO,INRNG ; > 99999.9 - Sort it out - POP AF ; Restore count - CALL MULTEN ; Multiply by ten - PUSH AF ; Re-save count - JP SIXDIG ; Test it again - -GTSIXD: CALL DIV10 ; Divide by 10 - POP AF ; Get count - INC A ; Count divides - PUSH AF ; Re-save count - CALL RNGTST ; Test number is in range -INRNG: CALL ROUND ; Add 0.5 to FPREG - INC A - CALL FPINT ; F.P to integer - CALL FPBCDE ; Move BCDE to FPREG - LD BC,0306H ; 1E+06 to 1E-03 range - POP AF ; Restore count - ADD A,C ; 6 digits before point - INC A ; Add one - JP M,MAKNUM ; Do it in "E" form if < 1E-02 - CP 6+1+1 ; More than 999999 ? - JP NC,MAKNUM ; Yes - Do it in "E" form - INC A ; Adjust for exponent - LD B,A ; Exponent of number - LD A,2 ; Make it zero after - -MAKNUM: DEC A ; Adjust for digits to do - DEC A - POP HL ; Restore buffer address - PUSH AF ; Save count - LD DE,POWERS ; Powers of ten - DEC B ; Count digits before point - JP NZ,DIGTXT ; Not zero - Do number - LD (HL),"." ; Save point - INC HL ; Move on - LD (HL),"0" ; Save zero - INC HL ; Move on -DIGTXT: DEC B ; Count digits before point - LD (HL),"." ; Save point in case - CALL Z,INCHL ; Last digit - move on - PUSH BC ; Save digits before point - PUSH HL ; Save buffer address - PUSH DE ; Save powers of ten - CALL BCDEFP ; Move FPREG to BCDE - POP HL ; Powers of ten table - LD B, "0"-1 ; ASCII "0" - 1 -TRYAGN: INC B ; Count subtractions - LD A,E ; Get LSB - SUB (HL) ; Subtract LSB - LD E,A ; Save LSB - INC HL - LD A,D ; Get NMSB - SBC A,(HL) ; Subtract NMSB - LD D,A ; Save NMSB - INC HL - LD A,C ; Get MSB - SBC A,(HL) ; Subtract MSB - LD C,A ; Save MSB - DEC HL ; Point back to start - DEC HL - JP NC,TRYAGN ; No overflow - Try again - CALL PLUCDE ; Restore number - INC HL ; Start of next number - CALL FPBCDE ; Move BCDE to FPREG - EX DE,HL ; Save point in table - POP HL ; Restore buffer address - LD (HL),B ; Save digit in buffer - INC HL ; And move on - POP BC ; Restore digit count - DEC C ; Count digits - JP NZ,DIGTXT ; More - Do them - DEC B ; Any decimal part? - JP Z,DOEBIT ; No - Do "E" bit -SUPTLZ: DEC HL ; Move back through buffer - LD A,(HL) ; Get character - CP "0" ; "0" character? - JP Z,SUPTLZ ; Yes - Look back for more - CP "." ; A decimal point? - CALL NZ,INCHL ; Move back over digit - -DOEBIT: POP AF ; Get "E" flag - JP Z,NOENED ; No "E" needed - End buffer - LD (HL),"E" ; Put "E" in buffer - INC HL ; And move on - LD (HL),"+" ; Put '+' in buffer - JP P,OUTEXP ; Positive - Output exponent - LD (HL),"-" ; Put "-" in buffer - CPL ; Negate exponent - INC A -OUTEXP: LD B,"0"-1 ; ASCII "0" - 1 -EXPTEN: INC B ; Count subtractions - SUB 10 ; Tens digit - JP NC,EXPTEN ; More to do - ADD A,"0"+10 ; Restore and make ASCII - INC HL ; Move on - LD (HL),B ; Save MSB of exponent -JSTZER: INC HL ; - LD (HL),A ; Save LSB of exponent - INC HL -NOENED: LD (HL),C ; Mark end of buffer - POP HL ; Restore code string address - RET - -RNGTST: LD BC,9474H ; BCDE = 999999. - LD DE,23F7H - CALL CMPNUM ; Compare numbers - OR A - POP HL ; Return address to HL - JP PO,GTSIXD ; Too big - Divide by ten - JP (HL) ; Otherwise return to caller - -HALF: DB 00H,00H,00H,80H ; 0.5 - -POWERS: DB 0A0H,086H,001H ; 100000 - DB 010H,027H,000H ; 10000 - DB 0E8H,003H,000H ; 1000 - DB 064H,000H,000H ; 100 - DB 00AH,000H,000H ; 10 - DB 001H,000H,000H ; 1 - -NEGAFT: LD HL,INVSGN ; Negate result - EX (SP),HL ; To be done after caller - JP (HL) ; Return to caller - -SQR: CALL STAKFP ; Put value on stack - LD HL,HALF ; Set power to 1/2 - CALL PHLTFP ; Move 1/2 to FPREG - -POWER: POP BC ; Get base - POP DE - CALL TSTSGN ; Test sign of power - LD A,B ; Get exponent of base - JP Z,EXP ; Make result 1 if zero - JP P,POWER1 ; Positive base - Ok - OR A ; Zero to negative power? - JP Z,DZERR ; Yes - ?/0 Error -POWER1: OR A ; Base zero? - JP Z,SAVEXP ; Yes - Return zero - PUSH DE ; Save base - PUSH BC - LD A,C ; Get MSB of base - OR 01111111B ; Get sign status - CALL BCDEFP ; Move power to BCDE - JP P,POWER2 ; Positive base - Ok - PUSH DE ; Save power - PUSH BC - CALL INT ; Get integer of power - POP BC ; Restore power - POP DE - PUSH AF ; MSB of base - CALL CMPNUM ; Power an integer? - POP HL ; Restore MSB of base - LD A,H ; but don't affect flags - RRA ; Exponent odd or even? -POWER2: POP HL ; Restore MSB and exponent - LD (FPREG+2),HL ; Save base in FPREG - POP HL ; LSBs of base - LD (FPREG),HL ; Save in FPREG - CALL C,NEGAFT ; Odd power - Negate result - CALL Z,INVSGN ; Negative base - Negate it - PUSH DE ; Save power - PUSH BC - CALL LOG ; Get LOG of base - POP BC ; Restore power - POP DE - CALL FPMULT ; Multiply LOG by power - -EXP: CALL STAKFP ; Put value on stack - LD BC,08138H ; BCDE = 1/Ln(2) - LD DE,0AA3BH - CALL FPMULT ; Multiply value by 1/LN(2) - LD A,(FPEXP) ; Get exponent - CP 80H+8 ; Is it in range? - JP NC,OVTST1 ; No - Test for overflow - CALL INT ; Get INT of FPREG - ADD A,80H ; For excess 128 - ADD A,2 ; Exponent > 126? - JP C,OVTST1 ; Yes - Test for overflow - PUSH AF ; Save scaling factor - LD HL,UNITY ; Point to 1. - CALL ADDPHL ; Add 1 to FPREG - CALL MULLN2 ; Multiply by LN(2) - POP AF ; Restore scaling factor - POP BC ; Restore exponent - POP DE - PUSH AF ; Save scaling factor - CALL SUBCDE ; Subtract exponent from FPREG - CALL INVSGN ; Negate result - LD HL,EXPTAB ; Coefficient table - CALL SMSER1 ; Sum the series - LD DE,0 ; Zero LSBs - POP BC ; Scaling factor - LD C,D ; Zero MSB - JP FPMULT ; Scale result to correct value - -EXPTAB: DB 8 ; Table used by EXP - DB 040H,02EH,094H,074H ; -1/7! (-1/5040) - DB 070H,04FH,02EH,077H ; 1/6! ( 1/720) - DB 06EH,002H,088H,07AH ; -1/5! (-1/120) - DB 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) - DB 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) - DB 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) - DB 000H,000H,080H,081H ; -1/1! (-1/1) - DB 000H,000H,000H,081H ; 1/0! ( 1/1) - -SUMSER: CALL STAKFP ; Put FPREG on stack - LD DE,MULT ; Multiply by "X" - PUSH DE ; To be done after - PUSH HL ; Save address of table - CALL BCDEFP ; Move FPREG to BCDE - CALL FPMULT ; Square the value - POP HL ; Restore address of table -SMSER1: CALL STAKFP ; Put value on stack - LD A,(HL) ; Get number of coefficients - INC HL ; Point to start of table - CALL PHLTFP ; Move coefficient to FPREG - DB 06H ; Skip "POP AF" -SUMLP: POP AF ; Restore count - POP BC ; Restore number - POP DE - DEC A ; Cont coefficients - RET Z ; All done - PUSH DE ; Save number - PUSH BC - PUSH AF ; Save count - PUSH HL ; Save address in table - CALL FPMULT ; Multiply FPREG by BCDE - POP HL ; Restore address in table - CALL LOADFP ; Number at HL to BCDE - PUSH HL ; Save address in table - CALL FPADD ; Add coefficient to FPREG - POP HL ; Restore address in table - JP SUMLP ; More coefficients - -RND: CALL TSTSGN ; Test sign of FPREG - LD HL,SEED+2 ; Random number seed - JP M,RESEED ; Negative - Re-seed - LD HL,LSTRND ; Last random number - CALL PHLTFP ; Move last RND to FPREG - LD HL,SEED+2 ; Random number seed - RET Z ; Return if RND(0) - ADD A,(HL) ; Add (SEED)+2) - AND 00000111B ; 0 to 7 - LD B,0 - LD (HL),A ; Re-save seed - INC HL ; Move to coefficient table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to coefficient - CALL LOADFP ; Coefficient to BCDE - CALL FPMULT ; ; Multiply FPREG by coefficient - LD A,(SEED+1) ; Get (SEED+1) - INC A ; Add 1 - AND 00000011B ; 0 to 3 - LD B,0 - CP 1 ; Is it zero? - ADC A,B ; Yes - Make it 1 - LD (SEED+1),A ; Re-save seed - LD HL,RNDTAB-4 ; Addition table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to value - CALL ADDPHL ; Add value to FPREG -RND1: CALL BCDEFP ; Move FPREG to BCDE - LD A,E ; Get LSB - LD E,C ; LSB = MSB - XOR 01001111B ; Fiddle around - LD C,A ; New MSB - LD (HL),80H ; Set exponent - DEC HL ; Point to MSB - LD B,(HL) ; Get MSB - LD (HL),80H ; Make value -0.5 - LD HL,SEED ; Random number seed - INC (HL) ; Count seed - LD A,(HL) ; Get seed - SUB 171 ; Do it modulo 171 - JP NZ,RND2 ; Non-zero - Ok - LD (HL),A ; Zero seed - INC C ; Fillde about - DEC D ; with the - INC E ; number -RND2: CALL BNORM ; Normalise number - LD HL,LSTRND ; Save random number - JP FPTHL ; Move FPREG to last and return - -RESEED: LD (HL),A ; Re-seed random numbers - DEC HL - LD (HL),A - DEC HL - LD (HL),A - JP RND1 ; Return RND seed - -RNDTAB: DB 068H,0B1H,046H,068H ; Table used by RND - DB 099H,0E9H,092H,069H - DB 010H,0D1H,075H,068H - -COS: LD HL,HALFPI ; Point to PI/2 - CALL ADDPHL ; Add it to PPREG -SIN: CALL STAKFP ; Put angle on stack - LD BC,8349H ; BCDE = 2 PI - LD DE,0FDBH - CALL FPBCDE ; Move 2 PI to FPREG - POP BC ; Restore angle - POP DE - CALL DVBCDE ; Divide angle by 2 PI - CALL STAKFP ; Put it on stack - CALL INT ; Get INT of result - POP BC ; Restore number - POP DE - CALL SUBCDE ; Make it 0 <= value < 1 - LD HL,QUARTR ; Point to 0.25 - CALL SUBPHL ; Subtract value from 0.25 - CALL TSTSGN ; Test sign of value - SCF ; Flag positive - JP P,SIN1 ; Positive - Ok - CALL ROUND ; Add 0.5 to value - CALL TSTSGN ; Test sign of value - OR A ; Flag negative -SIN1: PUSH AF ; Save sign - CALL P,INVSGN ; Negate value if positive - LD HL,QUARTR ; Point to 0.25 - CALL ADDPHL ; Add 0.25 to value - POP AF ; Restore sign - CALL NC,INVSGN ; Negative - Make positive - LD HL,SINTAB ; Coefficient table - JP SUMSER ; Evaluate sum of series - -HALFPI: DB 0DBH,00FH,049H,081H ; 1.5708 (PI/2) - -QUARTR: DB 000H,000H,000H,07FH ; 0.25 - -SINTAB: DB 5 ; Table used by SIN - DB 0BAH,0D7H,01EH,086H ; 39.711 - DB 064H,026H,099H,087H ;-76.575 - DB 058H,034H,023H,087H ; 81.602 - DB 0E0H,05DH,0A5H,086H ;-41.342 - DB 0DAH,00FH,049H,083H ; 6.2832 - -TAN: CALL STAKFP ; Put angle on stack - CALL SIN ; Get SIN of angle - POP BC ; Restore angle - POP HL - CALL STAKFP ; Save SIN of angle - EX DE,HL ; BCDE = Angle - CALL FPBCDE ; Angle to FPREG - CALL COS ; Get COS of angle - JP DIV ; TAN = SIN / COS - -ATN: CALL TSTSGN ; Test sign of value - CALL M,NEGAFT ; Negate result after if -ve - CALL M,INVSGN ; Negate value if -ve - LD A,(FPEXP) ; Get exponent - CP 81H ; Number less than 1? - JP C,ATN1 ; Yes - Get arc tangnt - LD BC,8100H ; BCDE = 1 - LD D,C - LD E,C - CALL DVBCDE ; Get reciprocal of number - LD HL,SUBPHL ; Sub angle from PI/2 - PUSH HL ; Save for angle > 1 -ATN1: LD HL,ATNTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD HL,HALFPI ; PI/2 - angle in case > 1 - RET ; Number > 1 - Sub from PI/2 - -ATNTAB: DB 9 ; Table used by ATN - DB 04AH,0D7H,03BH,078H ; 1/17 - DB 002H,06EH,084H,07BH ;-1/15 - DB 0FEH,0C1H,02FH,07CH ; 1/13 - DB 074H,031H,09AH,07DH ;-1/11 - DB 084H,03DH,05AH,07DH ; 1/9 - DB 0C8H,07FH,091H,07EH ;-1/7 - DB 0E4H,0BBH,04CH,07EH ; 1/5 - DB 06CH,0AAH,0AAH,07FH ;-1/3 - DB 000H,000H,000H,081H ; 1/1 - -CASFFW: CALL FLPLED ; Turn on cassette - LD B,0 ; Set 1 second delay -DELAYB: CALL DELAY ; Wait a bit - DEC B ; Count - JP NZ,DELAYB ; More delay needed - RET - -CASFF: JP FLPLED ; Flip tape LED - -ARET: RET ; A RETurn instruction - -CONMON: PUSH HL ; Output character to screen - PUSH BC ; - PUSH DE ; - PUSH AF ; - CALL MONTST ; See if NAS-SYS - JP NZ,NASOUT ; NAS-SYS - Output ASCII - POP AF ; Get character - PUSH AF ; And re-save - CP LF ; ASCII Line feed? - JP Z,IGCHR ; Yes - Ignore it - CP BKSP ; ASCII back space? - JP NZ,CONOT1 ; No - Test for CR - LD A,TBS ; NASBUG back space -CONOT1: CP CR ; ASCII CR? - JP NZ,OUTCHR ; No - Output character - LD A,TCR ; NASBUG CR - JP OUTCHR ; Output it - -NASOUT: POP AF ; Get character - PUSH AF ; And re-save -OUTCHR: CALL MONOUT ; Output it -IGCHR: POP AF ; Restore character - POP DE ; - POP BC ; - POP HL ; - RET - -GETINP: PUSH HL ; Get an input character - PUSH BC ; - PUSH DE ; - CALL MONTST ; See if NAS-SYS - JP Z,GETTIN ; "T" monitor - Get input - DW _BLNK - JP CONVIN ; Convert to ASCII - -GETTIN: CALL TIN ; "T" input a character - JP NC,GETTIN ; No input - wait -CONVIN: CP TBS ; NASBUG back space? - JP NZ,CNVIN1 ; No - Test for break - LD A,BKSP ; ASCII back space -CNVIN1: CP TBRK ; NASBUG break? - JP NZ,CNVIN2 ; No - Test for control Z - LD A,CTRLC ; Control C -CNVIN2: CP CTRLZ ; ^Z? - JP NZ,CNVIN3 ; No - Test for escape - LD A,DEL ; Delete -CNVIN3: CP ESC ; "ESC" ? - JP NZ,CNVIN4 ; No - Test for CR - LD A,CTRLC ; Control C -CNVIN4: CP TCR ; NASBUG CR? - JP NZ,CNVIN5 ; No - Return character - LD A,CR ; ASCII CR -CNVIN5: POP DE - POP BC - POP HL - RET - -CHKBRK: XOR A ; Check for break - CALL SFTENT ; Test for shift/enter - JP Z,TBRK2 ; Yes - Test for second break - LD A,(BRKFLG) ; Get break flag - OR A ; Break flag set? - JP NZ,TBRK2 ; Yes - Test for second break - XOR A ; Flag no break - RET - -TBRK2: CALL BREAK2 ; Second break? - LD A,-1 ; Flag break - RET - -GUART: IN A,(UARTS) ; Get UART status - RLA ; Any data ready? - JP NC,GUART ; No - wait until there is - IN A,(UARTD) ; Get data from UART - RET - -UARTOT: OUT (UARTD),A ; Send data to UART -URTOLP: IN A,(UARTS) ; Get status - ADD A,A ; Byte sent? - RET M ; Yes - Return - JP URTOLP ; Keep waiting - -SUART: PUSH AF ; Save A - CALL UARTOT ; Send it to UART - POP AF ; Restore A - RET - - NOP - NOP - -SFTENT: PUSH HL ; Test for Shift Enter from KBD - LD A,00000010B ; Reset KBD counter mask - LD HL,PORT0 ; Get old contents - XOR (HL) ; Toggle bit - OUT (0),A ; Reset KBD counter - XOR 00000001B ; Toggle bit - OUT (0),A ; Next row - XOR 00000010B - OUT (0),A ; Clear "clear" strobe - LD A,(HL) ; Get old value - OUT (0),A ; Original contents - ADD HL,DE ; ?? WHAT ?? - POP HL ; Restore HL - IN A,(0) ; Read in row - AND 00010010B ; Mask SHIFT and ENTER - RET - -CLS: CALL MONTST ; See if NAS-SYS - JP Z,TCLS ; "T" CLS - LD A,CS ; ASCII Clear screen - JP CONMON ; Output character - -TCLS: LD A,TCS ; NASBUG Clear screen - JP CONMON ; Output character - -DELAY: XOR A ; Delay routine -DELAY1: PUSH AF ; PUSHes and POPs delay - POP AF - PUSH AF - POP AF - DEC A ; Count delays - JP NZ,DELAY1 ; More delay - RET - -WIDTH: CALL GETINT ; Get integer 0-255 - LD A,E ; Width to A - LD (LWIDTH),A ; Set width - RET - -LINES: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - EX DE,HL - LD (LINESC),HL ; Set lines counter - LD (LINESN),HL ; Set lines number - EX DE,HL ; Restore code string address - RET - -DEEK: CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save number - POP HL ; Number to HL - LD B,(HL) ; Get LSB of contents - INC HL - LD A,(HL) ; Get MSB of contents - JP ABPASS ; Return integer AB - -DOKE: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save address - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - EX (SP),HL ; Save value,get address - LD (HL),E ; Save LSB of value - INC HL - LD (HL),D ; Save MSB of value - POP HL ; Restore code string address - RET - -JJUMP1: DI ; Disable interrupts - LD IX,-1 ; Flag cold start - JP CSTART ; Go and initialise - -SCREEN: CALL GETINT ; Get integer 0 to 255 - PUSH AF ; Save column - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETINT ; Get integer 0 to 255 - POP BC ; Column to B - PUSH HL ; Save code string address - PUSH BC ; Save column - CALL SCRADR ; Calculate screen address - PUSH HL ; Save screen address - CALL MONTST ; See if NAS-SYS - JP Z,TMNCUR ; "T" monitor - "T" cursor - POP HL ; Restore screen address - LD (CURSOR),HL ; Set new cursor position - POP HL ; Rstore code string address - RET - -TMNCUR: LD HL,(TCUR) ; Get address or cursor - LD (HL)," " ; Remove cursor - POP HL ; Get new cursor address - LD (TCUR),HL ; Set new cursor - LD (HL),"_" ; Put it on screen - POP HL ; Restore code string address - RET - -SCRADR: LD HL,VDU+10-65 ; SCREEN VDU address (0,0) - LD B,0 - LD C,A ; Line to BC - OR A ; Test it - JP Z,FCERR ; Zero - ?FC Error - CP 16+1 ; 16 lines - JP P,FCERR ; > 16 - ?FC Error - POP DE ; RETurn address - POP AF ; Get column - PUSH DE ; Re-save RETurn - LD D,0 - LD E,A ; Column to DE - OR A ; Test it - JP Z,FCERR ; Zero - ?FC Error - CP 48+1 ; 48 characters per line - JP P,FCERR ; > 48 - ?FC Error - ADD HL,DE ; Add column to address - LD D,0 - LD E,C ; Line to DE - LD B,64 ; 64 Bytes per line -ADD64X: ADD HL,DE ; Add line - DJNZ ADD64X ; SIXTY FOUR TIMES!!! - RET - -FLPLED: CALL MONTST ; See if NAS-SYS - JP Z,TMFLP ; "T" MFLP - DW _MFLP - RET - -TMFLP: JP MFLP ; Flip drive LED - -MONOUT: PUSH AF ; Save character - CALL MONTST ; See if NAS-SYS - JP Z,TMNOUT ; "T" output - POP AF ; Restore character - DB _ROUT ; Output it - RET - -TMNOUT: POP AF ; Restore character - JP TOUT ; "T" output - -BREAK2: LD A,(BRKFLG) ; Break flag set? - JP NZ,RETCTC ; Yes - Return ^C - CALL MONTST ; See if NAS-SYS - JP Z,TCHINP ; Get "T" character input - DW _RIN ; Scan for a character - RET - -TCHINP: JP TIN ; "T" input a character - -RETCTC: LD A,0 ; Clear Break flag - LD (BRKFLG),A - LD A,CTRLC ; Return ^C - RET - -MONTST: LD A,(MONSTT+1) ; "T" monitor or NAS-SYS? - CP 33H ; 31 00 10 / 31 33 0C - RET - -SAVE: CALL FLPLED ; Flip tape LED - CALL MONTST ; See if NAS-SYS - JP Z,TSAVE ; "T" save - DW _WRIT ; Save program - RET - -TSAVE: LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) - JP Z,T4WR ; T4 Write - JP T2DUMP ; T2 Dump - -MONLD: CALL FLPLED ; Flip tape LED - CALL MONTST ; See if NAS-SYS - JP Z,TLOAD ; "T" load - LD A,"R" ; Set READ - LD (ARGN),A - DW _READ ; Load program - RET - -TLOAD: LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) - JP Z,T4READ ; T4 Read - JP T2DUMP ; T2 Dump ?????????? - -MONITR: CALL MONTST ; See if NAS-SYS - JP Z,MONSTT ; Jump to zero if "T" - DW _MRET ; Return to NAS-SYS - -MONVE: CALL FLPLED ; Flip tape LED - CALL MONTST ; See if NAS-SYS - JP Z,FCERR ; Verify not available on "T" - LD A,"V" ; Set VERIFY - LD (ARGN),A - DW _VRFY ; Verify tape - RET - -INITST: LD A,0 ; Clear break flag - LD (BRKFLG),A - CALL MONTST ; See if NAS-SYS - JP Z,INIT ; "T" - No NMI vector - LD HL,BREAK ; Set NMI gives break - LD (NMI),HL - PUSH IX ; Get start up condition - POP AF ; "Z" set if cold , Else clear - OR A ; "Cold" or "Cool" start? - JP NZ,INIT ; "Cool" don't init NAS-SYS - LD B,15 ; Delay for keyboard clear - CALL DELAYB ; Allow time for key release - CALL STMON ; Initialise NAS-SYS - JP INIT ; Initialise BASIC - -BREAK: PUSH AF ; Save character - LD A,-1 - LD (BRKFLG),A ; Flag break - POP AF ; Restore character -ARETN: RETN ; Return from NMI - - NOP - -INLINE: DW _INLN ; Get an input line - PUSH DE ; Save cursor address - PUSH DE ; Cursor address to HL - POP HL - LD DE,48-1 ; Length of line-1 - ADD HL,DE ; Point to end of line -ENDLIN: LD A,(HL) ; Get end of line - CP " " ; Space? - JP NZ,LINTBF ; No - Copy to buffer - DEC E ; Back 1 character - LD A,0 ; Wasteful test on E - OR E - JP Z,LINTBF ; Start of line - Copy it - DEC HL ; Back 1 character - JP ENDLIN ; Keep looking for end - -LINTBF: PUSH DE ; Line length to BC - POP BC - INC BC ; Length +1 - LD DE,BUFFER ; Input buffer - POP HL ; Line start - PUSH BC ; Save length - LDIR ; Move line to buffer - LD A,0 - LD (DE),A ; Mark end of buffer with 00 - POP BC ; Restore buffer length - LD B,C ; Length returned in B - LD HL,BUFFER-1 ; Point to start of buffer-1 - RET - -GETXYA: CALL CHKSYN ; Make sure "(" follows - DB "(" - CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save "X" - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETNUM ; Get a number - CALL CHKSYN ; Make sure ")" follows - DB ")" - CALL DEINT ; Get integer -32768 to 32767 - PUSH HL ; Save code string address - POP IY ; In IY - CALL XYPOS ; Address and bit mask - PUSH AF ; Save mask - CALL ADJCOL ; Adjust column - CALL SCRADR ; Get VDU address - POP AF ; Restore bit mask - LD B,11000000B ; Block graphics base - OR B ; Set bits 7 & 6 - RET - -SETB: CALL GETXYA ; Get co-ords and VDU address - PUSH AF ; Save bit mask - LD A,(HL) ; Get character from screen - CP 11000000B ; Is it a block graphic? - JP NC,SETOR ; Yes - OR new bit - POP AF ; Restore bit mask -PUTBIT: LD (HL),A ; Put character on screen -RESCSA: PUSH IY ; Restore code string address - POP HL ; From IY - RET - -SETOR: POP BC ; Restore bit mask - OR B ; Merge the bits - JP PUTBIT ; Save on screen - -RESETB: CALL GETXYA ; Get co-ords and VDU address - PUSH AF ; Save bit mask - LD A,(HL) ; Get byte from screen - CP 11000000B ; Is it a block graphic? - JP C,NORES ; No - Leave it - LD B,00111111B ; Six bits per block - AND B ; Clear bits 7 & 6 - POP BC ; Get bit mask - AND B ; Test for common bit - JP Z,RESCSA ; None - Leave it - LD A,(HL) ; Get byte from screen - AND 00111111B ; Isolate bit - XOR B ; Clear that bit - CP 11000000B ; Is it a graphic blank? - JP NZ,PUTBIT ; No - Save character - LD A," " ; Put a space there - JP PUTBIT ; Save the space - -NORES: POP BC ; Drop bit mask - JP RESCSA ; Restore code string address - -POINTB: CALL GETXYA ; Get co-ords and VDU address - LD B,(HL) ; Get character from screen - CALL TSTBIT ; Test if bit is set - JP NZ,POINT0 ; Different - Return zero - LD A,0 - LD B,1 ; Integer AB = 1 -POINTX: POP HL ; Drop return - PUSH IY ; PUSH code string address - LD DE,RETNUM ; To return a number - PUSH DE ; Save for return - JP ABPASS ; Return integer AB - -POINT0: LD B,0 ; Set zero - JP POINTX ; Return value - -XYPOS: POP BC ; Get return address - POP HL ; Get column - PUSH HL ; And re-save - PUSH BC ; Put back return address - LD A,L ; Get column - LD B,00000001B ; 2 bits per character - AND B ; Odd or even bit - PUSH AF ; Save it - PUSH DE ; Get row - POP HL ; to HL - LD DE,0 ; Zero line count - LD BC,3 ; 3 blocks per line - INC HL -DIV3LP: SBC HL,BC ; Subtract 3 - INC DE ; Count the subtractions - JP Z,DIV3EX ; Exactly - Exit - JP P,DIV3LP ; More to do - -DIV3EX: ADD HL,BC ; Restore number - POP AF ; Restore column and odd/even - OR A ; Set flags (NZ or Z) - LD A,L ; Get remainder from /3 - JP Z,NOREMD ; No remainder - ADD A,3 ; Adjust remainder -NOREMD: LD B,A ; Bit number+1 to B - LD A,00000001B ; Bit to rotate -SHFTBT: RLCA ; Shift bit left - DJNZ SHFTBT ; Count shifts - RRA ; Restore correct place - RET - -ADJCOL: POP BC ; Restore return address - POP AF ; Get bit mask - POP HL ; Get column - PUSH AF ; Re-save but mask - LD A,L ; Get column - RRA ; Divide by 2 - ADD A,1 ; Start at column 1 - AND 00111111B ; 0 to 63 - LD H,A ; Save column in H - PUSH HL ; Re-save column - PUSH BC ; Put back return - LD A,E ; Get row - RET - -SMOTOR: CALL CASFF ; Flip tape drive - LD A,(HL) ; Get byte - RET - -JPLDSV: LD A,(BRKLIN) ; CLOAD or CSAVE? - CP -1 - JP NZ,SNDHDR ; CSAVE - Send header - JP GETHDR ; CLOAD - Get header - -CRLIN1: CALL PRNTCR ; Output CRLF - JP GETLIN ; Get an input line - -CRLIN: CALL PRNTCR ; Output CRLF - JP GETLIN ; Get an input line - -TSTBIT: PUSH AF ; Save bit mask - AND B ; Get common bits - POP BC ; Restore bit mask - CP B ; Same bit set? - LD A,0 ; Return 0 in A - RET - -OUTNCR: CALL OUTC ; Output character in A - JP PRNTCR ; Output CRLF - -JJUMP: JP JJUMP1 ; "Cool" start - -ZJUMP: JP BRKRET ; Warm start - END diff --git a/new/apps/basic/searle8kbasic.asm b/new/apps/basic/searle8kbasic.asm deleted file mode 100644 index 933df7a..0000000 --- a/new/apps/basic/searle8kbasic.asm +++ /dev/null @@ -1,4341 +0,0 @@ -;================================================================================== -; The updates to the original BASIC within this file are copyright Grant Searle -; -; You have permission to use this for NON COMMERCIAL USE ONLY -; If you wish to use it elsewhere, please include an acknowledgement to myself. -; -; http://searle.hostei.com/grant/index.html -; -; eMail: home.micros01@btinternet.com -; -; If the above don't work, please perform an Internet search to see if I have -; updated the web page hosting service. -; -;================================================================================== - -; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft -; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 -; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) -; Adapted for the freeware Zilog Macro Assembler 2.10 to produce -; the original ROM code (checksum A934H). PA - -; GENERAL EQUATES - -CTRLC .EQU 03H ; Control "C" -CTRLG .EQU 07H ; Control "G" -BKSP .EQU 08H ; Back space -LF .EQU 0AH ; Line feed -CS .EQU 0CH ; Clear screen -CR .EQU 0DH ; Carriage return -CTRLO .EQU 0FH ; Control "O" -CTRLQ .EQU 11H ; Control "Q" -CTRLR .EQU 12H ; Control "R" -CTRLS .EQU 13H ; Control "S" -CTRLU .EQU 15H ; Control "U" -ESC .EQU 1BH ; Escape -DEL .EQU 7FH ; Delete - -; BASIC WORK SPACE LOCATIONS - -WRKSPC .EQU 2045H ; BASIC Work space -USR .EQU WRKSPC+3H ; "USR (x)" jump -OUTSUB .EQU WRKSPC+6H ; "OUT p,n" -OTPORT .EQU WRKSPC+7H ; Port (p) -DIVSUP .EQU WRKSPC+9H ; Division support routine -DIV1 .EQU WRKSPC+0AH ; <- Values -DIV2 .EQU WRKSPC+0EH ; <- to -DIV3 .EQU WRKSPC+12H ; <- be -DIV4 .EQU WRKSPC+15H ; <-inserted -SEED .EQU WRKSPC+17H ; Random number seed -LSTRND .EQU WRKSPC+3AH ; Last random number -INPSUB .EQU WRKSPC+3EH ; #INP (x)" Routine -INPORT .EQU WRKSPC+3FH ; PORT (x) -NULLS .EQU WRKSPC+41H ; Number of nulls -LWIDTH .EQU WRKSPC+42H ; Terminal width -COMMAN .EQU WRKSPC+43H ; Width for commas -NULFLG .EQU WRKSPC+44H ; Null after input byte flag -CTLOFG .EQU WRKSPC+45H ; Control "O" flag -LINESC .EQU WRKSPC+46H ; Lines counter -LINESN .EQU WRKSPC+48H ; Lines number -CHKSUM .EQU WRKSPC+4AH ; Array load/save check sum -NMIFLG .EQU WRKSPC+4CH ; Flag for NMI break routine -BRKFLG .EQU WRKSPC+4DH ; Break flag -RINPUT .EQU WRKSPC+4EH ; Input reflection -POINT .EQU WRKSPC+51H ; "POINT" reflection (unused) -PSET .EQU WRKSPC+54H ; "SET" reflection -RESET .EQU WRKSPC+57H ; "RESET" reflection -STRSPC .EQU WRKSPC+5AH ; Bottom of string space -LINEAT .EQU WRKSPC+5CH ; Current line number -BASTXT .EQU WRKSPC+5EH ; Pointer to start of program -BUFFER .EQU WRKSPC+61H ; Input buffer -STACK .EQU WRKSPC+66H ; Initial stack -CURPOS .EQU WRKSPC+0ABH ; Character position on line -LCRFLG .EQU WRKSPC+0ACH ; Locate/Create flag -TYPE .EQU WRKSPC+0ADH ; Data type flag -DATFLG .EQU WRKSPC+0AEH ; Literal statement flag -LSTRAM .EQU WRKSPC+0AFH ; Last available RAM -TMSTPT .EQU WRKSPC+0B1H ; Temporary string pointer -TMSTPL .EQU WRKSPC+0B3H ; Temporary string pool -TMPSTR .EQU WRKSPC+0BFH ; Temporary string -STRBOT .EQU WRKSPC+0C3H ; Bottom of string space -CUROPR .EQU WRKSPC+0C5H ; Current operator in EVAL -LOOPST .EQU WRKSPC+0C7H ; First statement of loop -DATLIN .EQU WRKSPC+0C9H ; Line of current DATA item -FORFLG .EQU WRKSPC+0CBH ; "FOR" loop flag -LSTBIN .EQU WRKSPC+0CCH ; Last byte entered -READFG .EQU WRKSPC+0CDH ; Read/Input flag -BRKLIN .EQU WRKSPC+0CEH ; Line of break -NXTOPR .EQU WRKSPC+0D0H ; Next operator in EVAL -ERRLIN .EQU WRKSPC+0D2H ; Line of error -CONTAD .EQU WRKSPC+0D4H ; Where to CONTinue -PROGND .EQU WRKSPC+0D6H ; End of program -VAREND .EQU WRKSPC+0D8H ; End of variables -ARREND .EQU WRKSPC+0DAH ; End of arrays -NXTDAT .EQU WRKSPC+0DCH ; Next data item -FNRGNM .EQU WRKSPC+0DEH ; Name of FN argument -FNARG .EQU WRKSPC+0E0H ; FN argument value -FPREG .EQU WRKSPC+0E4H ; Floating point register -FPEXP .EQU FPREG+3 ; Floating point exponent -SGNRES .EQU WRKSPC+0E8H ; Sign of result -PBUFF .EQU WRKSPC+0E9H ; Number print buffer -MULVAL .EQU WRKSPC+0F6H ; Multiplier -PROGST .EQU WRKSPC+0F9H ; Start of program text area -STLOOK .EQU WRKSPC+15DH ; Start of memory test - -; BASIC ERROR CODE VALUES - -NF .EQU 00H ; NEXT without FOR -SN .EQU 02H ; Syntax error -RG .EQU 04H ; RETURN without GOSUB -OD .EQU 06H ; Out of DATA -FC .EQU 08H ; Function call error -OV .EQU 0AH ; Overflow -OM .EQU 0CH ; Out of memory -UL .EQU 0EH ; Undefined line number -BS .EQU 10H ; Bad subscript -DD .EQU 12H ; Re-DIMensioned array -DZ .EQU 14H ; Division by zero (/0) -ID .EQU 16H ; Illegal direct -TM .EQU 18H ; Type miss-match -OS .EQU 1AH ; Out of string space -LS .EQU 1CH ; String too long -ST .EQU 1EH ; String formula too complex -CN .EQU 20H ; Can't CONTinue -UF .EQU 22H ; UnDEFined FN function -MO .EQU 24H ; Missing operand -HX .EQU 26H ; HEX error -BN .EQU 28H ; BIN error - - .ORG 00150H - -COLD: JP STARTB ; Jump for cold start -WARM: JP WARMST ; Jump for warm start -STARTB: - LD IX,0 ; Flag cold start - JP CSTART ; Jump to initialise - - .WORD DEINT ; Get integer -32768 to 32767 - .WORD ABPASS ; Return integer in AB - - -CSTART: LD HL,WRKSPC ; Start of workspace RAM - LD SP,HL ; Set up a temporary stack - JP INITST ; Go to initialise - -INIT: LD DE,INITAB ; Initialise workspace - LD B,INITBE-INITAB+3; Bytes to copy - LD HL,WRKSPC ; Into workspace RAM -COPY: LD A,(DE) ; Get source - LD (HL),A ; To destination - INC HL ; Next destination - INC DE ; Next source - DEC B ; Count bytes - JP NZ,COPY ; More to move - LD SP,HL ; Temporary stack - CALL CLREG ; Clear registers and stack - CALL PRNTCRLF ; Output CRLF - LD (BUFFER+72+1),A ; Mark end of buffer - LD (PROGST),A ; Initialise program area -MSIZE: LD HL,MEMMSG ; Point to message - CALL PRS ; Output "Memory size" - CALL PROMPT ; Get input with '?' - CALL GETCHR ; Get next character - OR A ; Set flags - JP NZ,TSTMEM ; If number - Test if RAM there - LD HL,STLOOK ; Point to start of RAM -MLOOP: INC HL ; Next byte - LD A,H ; Above address FFFF ? - OR L - JP Z,SETTOP ; Yes - 64K RAM - LD A,(HL) ; Get contents - LD B,A ; Save it - CPL ; Flip all bits - LD (HL),A ; Put it back - CP (HL) ; RAM there if same - LD (HL),B ; Restore old contents - JP Z,MLOOP ; If RAM - test next byte - JP SETTOP ; Top of RAM found - -TSTMEM: CALL ATOH ; Get high memory into DE - OR A ; Set flags on last byte - JP NZ,SNERR ; ?SN Error if bad character - EX DE,HL ; Address into HL - DEC HL ; Back one byte - LD A,11011001B ; Test byte - LD B,(HL) ; Get old contents - LD (HL),A ; Load test byte - CP (HL) ; RAM there if same - LD (HL),B ; Restore old contents - JP NZ,MSIZE ; Ask again if no RAM - -SETTOP: DEC HL ; Back one byte - LD DE,STLOOK-1 ; See if enough RAM - CALL CPDEHL ; Compare DE with HL - JP C,MSIZE ; Ask again if not enough RAM - LD DE,0-50 ; 50 Bytes string space - LD (LSTRAM),HL ; Save last available RAM - ADD HL,DE ; Allocate string space - LD (STRSPC),HL ; Save string space - CALL CLRPTR ; Clear program area - LD HL,(STRSPC) ; Get end of memory - LD DE,0-17 ; Offset for free bytes - ADD HL,DE ; Adjust HL - LD DE,PROGST ; Start of program text - LD A,L ; Get LSB - SUB E ; Adjust it - LD L,A ; Re-save - LD A,H ; Get MSB - SBC A,D ; Adjust it - LD H,A ; Re-save - PUSH HL ; Save bytes free - LD HL,SIGNON ; Sign-on message - CALL PRS ; Output string - POP HL ; Get bytes free back - CALL PRNTHL ; Output amount of free memory - LD HL,BFREE ; " Bytes free" message - CALL PRS ; Output string - -WARMST: LD SP,STACK ; Temporary stack -BRKRET: CALL CLREG ; Clear registers and stack - JP PRNTOK ; Go to get command line - -BFREE: .BYTE " Bytes free",CR,LF,0,0 - -SIGNON: .BYTE "Z80 BASIC Ver 4.7b",CR,LF - .BYTE "Copyright ",40,"C",41 - .BYTE " 1978 by Microsoft",CR,LF,0,0 - -MEMMSG: .BYTE "Memory top",0 - -; FUNCTION ADDRESS TABLE - -FNCTAB: .WORD SGN - .WORD INT - .WORD ABS - .WORD USR - .WORD FRE - .WORD INP - .WORD POS - .WORD SQR - .WORD RND - .WORD LOG - .WORD EXP - .WORD COS - .WORD SIN - .WORD TAN - .WORD ATN - .WORD PEEK - .WORD DEEK - .WORD POINT - .WORD LEN - .WORD STR - .WORD VAL - .WORD ASC - .WORD CHR - .WORD HEX - .WORD BIN - .WORD LEFT - .WORD RIGHT - .WORD MID - -; RESERVED WORD LIST - -WORDS: .BYTE 'E'+80H,"ND" - .BYTE 'F'+80H,"OR" - .BYTE 'N'+80H,"EXT" - .BYTE 'D'+80H,"ATA" - .BYTE 'I'+80H,"NPUT" - .BYTE 'D'+80H,"IM" - .BYTE 'R'+80H,"EAD" - .BYTE 'L'+80H,"ET" - .BYTE 'G'+80H,"OTO" - .BYTE 'R'+80H,"UN" - .BYTE 'I'+80H,"F" - .BYTE 'R'+80H,"ESTORE" - .BYTE 'G'+80H,"OSUB" - .BYTE 'R'+80H,"ETURN" - .BYTE 'R'+80H,"EM" - .BYTE 'S'+80H,"TOP" - .BYTE 'O'+80H,"UT" - .BYTE 'O'+80H,"N" - .BYTE 'N'+80H,"ULL" - .BYTE 'W'+80H,"AIT" - .BYTE 'D'+80H,"EF" - .BYTE 'P'+80H,"OKE" - .BYTE 'D'+80H,"OKE" - .BYTE 'S'+80H,"CREEN" - .BYTE 'L'+80H,"INES" - .BYTE 'C'+80H,"LS" - .BYTE 'W'+80H,"IDTH" - .BYTE 'M'+80H,"ONITOR" - .BYTE 'S'+80H,"ET" - .BYTE 'R'+80H,"ESET" - .BYTE 'P'+80H,"RINT" - .BYTE 'C'+80H,"ONT" - .BYTE 'L'+80H,"IST" - .BYTE 'C'+80H,"LEAR" - .BYTE 'C'+80H,"LOAD" - .BYTE 'C'+80H,"SAVE" - .BYTE 'N'+80H,"EW" - - .BYTE 'T'+80H,"AB(" - .BYTE 'T'+80H,"O" - .BYTE 'F'+80H,"N" - .BYTE 'S'+80H,"PC(" - .BYTE 'T'+80H,"HEN" - .BYTE 'N'+80H,"OT" - .BYTE 'S'+80H,"TEP" - - .BYTE '+'+80H - .BYTE '-'+80H - .BYTE '*'+80H - .BYTE '/'+80H - .BYTE '^'+80H - .BYTE 'A'+80H,"ND" - .BYTE 'O'+80H,"R" - .BYTE '>'+80H - .BYTE '='+80H - .BYTE '<'+80H - - .BYTE 'S'+80H,"GN" - .BYTE 'I'+80H,"NT" - .BYTE 'A'+80H,"BS" - .BYTE 'U'+80H,"SR" - .BYTE 'F'+80H,"RE" - .BYTE 'I'+80H,"NP" - .BYTE 'P'+80H,"OS" - .BYTE 'S'+80H,"QR" - .BYTE 'R'+80H,"ND" - .BYTE 'L'+80H,"OG" - .BYTE 'E'+80H,"XP" - .BYTE 'C'+80H,"OS" - .BYTE 'S'+80H,"IN" - .BYTE 'T'+80H,"AN" - .BYTE 'A'+80H,"TN" - .BYTE 'P'+80H,"EEK" - .BYTE 'D'+80H,"EEK" - .BYTE 'P'+80H,"OINT" - .BYTE 'L'+80H,"EN" - .BYTE 'S'+80H,"TR$" - .BYTE 'V'+80H,"AL" - .BYTE 'A'+80H,"SC" - .BYTE 'C'+80H,"HR$" - .BYTE 'H'+80H,"EX$" - .BYTE 'B'+80H,"IN$" - .BYTE 'L'+80H,"EFT$" - .BYTE 'R'+80H,"IGHT$" - .BYTE 'M'+80H,"ID$" - .BYTE 80H ; End of list marker - -; KEYWORD ADDRESS TABLE - -WORDTB: .WORD PEND - .WORD FOR - .WORD NEXT - .WORD DATA - .WORD INPUT - .WORD DIM - .WORD READ - .WORD LET - .WORD GOTO - .WORD RUN - .WORD IF - .WORD RESTOR - .WORD GOSUB - .WORD RETURN - .WORD REM - .WORD STOP - .WORD POUT - .WORD ON - .WORD NULL - .WORD WAIT - .WORD DEF - .WORD POKE - .WORD DOKE - .WORD REM - .WORD LINES - .WORD CLS - .WORD WIDTH - .WORD MONITR - .WORD PSET - .WORD RESET - .WORD PRINT - .WORD CONT - .WORD LIST - .WORD CLEAR - .WORD REM - .WORD REM - .WORD NEW - -; RESERVED WORD TOKEN VALUES - -ZEND .EQU 080H ; END -ZFOR .EQU 081H ; FOR -ZDATA .EQU 083H ; DATA -ZGOTO .EQU 088H ; GOTO -ZGOSUB .EQU 08CH ; GOSUB -ZREM .EQU 08EH ; REM -ZPRINT .EQU 09EH ; PRINT -ZNEW .EQU 0A4H ; NEW - -ZTAB .EQU 0A5H ; TAB -ZTO .EQU 0A6H ; TO -ZFN .EQU 0A7H ; FN -ZSPC .EQU 0A8H ; SPC -ZTHEN .EQU 0A9H ; THEN -ZNOT .EQU 0AAH ; NOT -ZSTEP .EQU 0ABH ; STEP - -ZPLUS .EQU 0ACH ; + -ZMINUS .EQU 0ADH ; - -ZTIMES .EQU 0AEH ; * -ZDIV .EQU 0AFH ; / -ZOR .EQU 0B2H ; OR -ZGTR .EQU 0B3H ; > -ZEQUAL .EQU 0B4H ; M -ZLTH .EQU 0B5H ; < -ZSGN .EQU 0B6H ; SGN -ZPOINT .EQU 0C7H ; POINT -ZLEFT .EQU 0CDH +2 ; LEFT$ - -; ARITHMETIC PRECEDENCE TABLE - -PRITAB: .BYTE 79H ; Precedence value - .WORD PADD ; FPREG = + FPREG - - .BYTE 79H ; Precedence value - .WORD PSUB ; FPREG = - FPREG - - .BYTE 7CH ; Precedence value - .WORD MULT ; PPREG = * FPREG - - .BYTE 7CH ; Precedence value - .WORD DIV ; FPREG = / FPREG - - .BYTE 7FH ; Precedence value - .WORD POWER ; FPREG = ^ FPREG - - .BYTE 50H ; Precedence value - .WORD PAND ; FPREG = AND FPREG - - .BYTE 46H ; Precedence value - .WORD POR ; FPREG = OR FPREG - -; BASIC ERROR CODE LIST - -ERRORS: .BYTE "NF" ; NEXT without FOR - .BYTE "SN" ; Syntax error - .BYTE "RG" ; RETURN without GOSUB - .BYTE "OD" ; Out of DATA - .BYTE "FC" ; Illegal function call - .BYTE "OV" ; Overflow error - .BYTE "OM" ; Out of memory - .BYTE "UL" ; Undefined line - .BYTE "BS" ; Bad subscript - .BYTE "DD" ; Re-DIMensioned array - .BYTE "/0" ; Division by zero - .BYTE "ID" ; Illegal direct - .BYTE "TM" ; Type mis-match - .BYTE "OS" ; Out of string space - .BYTE "LS" ; String too long - .BYTE "ST" ; String formula too complex - .BYTE "CN" ; Can't CONTinue - .BYTE "UF" ; Undefined FN function - .BYTE "MO" ; Missing operand - .BYTE "HX" ; HEX error - .BYTE "BN" ; BIN error - -; INITIALISATION TABLE ------------------------------------------------------- - -INITAB: JP WARMST ; Warm start jump - JP FCERR ; "USR (X)" jump (Set to Error) - OUT (0),A ; "OUT p,n" skeleton - RET - SUB 0 ; Division support routine - LD L,A - LD A,H - SBC A,0 - LD H,A - LD A,B - SBC A,0 - LD B,A - LD A,0 - RET - .BYTE 0,0,0 ; Random number seed table used by RND - .BYTE 035H,04AH,0CAH,099H ;-2.65145E+07 - .BYTE 039H,01CH,076H,098H ; 1.61291E+07 - .BYTE 022H,095H,0B3H,098H ;-1.17691E+07 - .BYTE 00AH,0DDH,047H,098H ; 1.30983E+07 - .BYTE 053H,0D1H,099H,099H ;-2-01612E+07 - .BYTE 00AH,01AH,09FH,098H ;-1.04269E+07 - .BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07 - .BYTE 0D6H,077H,03EH,098H ; 1.24825E+07 - .BYTE 052H,0C7H,04FH,080H ; Last random number - IN A,(0) ; INP (x) skeleton - RET - .BYTE 1 ; POS (x) number (1) - .BYTE 255 ; Terminal width (255 = no auto CRLF) - .BYTE 28 ; Width for commas (3 columns) - .BYTE 0 ; No nulls after input bytes - .BYTE 0 ; Output enabled (^O off) - .WORD 20 ; Initial lines counter - .WORD 20 ; Initial lines number - .WORD 0 ; Array load/save check sum - .BYTE 0 ; Break not by NMI - .BYTE 0 ; Break flag - JP TTYLIN ; Input reflection (set to TTY) - JP $0000 ; POINT reflection unused - JP $0000 ; SET reflection - JP $0000 ; RESET reflection - .WORD STLOOK ; Temp string space - .WORD -2 ; Current line number (cold) - .WORD PROGST+1 ; Start of program text -INITBE: - -; END OF INITIALISATION TABLE --------------------------------------------------- - -ERRMSG: .BYTE " Error",0 -INMSG: .BYTE " in ",0 -ZERBYT .EQU $-1 ; A zero byte -OKMSG: .BYTE "Ok",CR,LF,0,0 -BRKMSG: .BYTE "Break",0 - -BAKSTK: LD HL,4 ; Look for "FOR" block with - ADD HL,SP ; same index as specified -LOKFOR: LD A,(HL) ; Get block ID - INC HL ; Point to index address - CP ZFOR ; Is it a "FOR" token - RET NZ ; No - exit - LD C,(HL) ; BC = Address of "FOR" index - INC HL - LD B,(HL) - INC HL ; Point to sign of STEP - PUSH HL ; Save pointer to sign - LD L,C ; HL = address of "FOR" index - LD H,B - LD A,D ; See if an index was specified - OR E ; DE = 0 if no index specified - EX DE,HL ; Specified index into HL - JP Z,INDFND ; Skip if no index given - EX DE,HL ; Index back into DE - CALL CPDEHL ; Compare index with one given -INDFND: LD BC,16-3 ; Offset to next block - POP HL ; Restore pointer to sign - RET Z ; Return if block found - ADD HL,BC ; Point to next block - JP LOKFOR ; Keep on looking - -MOVUP: CALL ENFMEM ; See if enough memory -MOVSTR: PUSH BC ; Save end of source - EX (SP),HL ; Swap source and dest" end - POP BC ; Get end of destination -MOVLP: CALL CPDEHL ; See if list moved - LD A,(HL) ; Get byte - LD (BC),A ; Move it - RET Z ; Exit if all done - DEC BC ; Next byte to move to - DEC HL ; Next byte to move - JP MOVLP ; Loop until all bytes moved - -CHKSTK: PUSH HL ; Save code string address - LD HL,(ARREND) ; Lowest free memory - LD B,0 ; BC = Number of levels to test - ADD HL,BC ; 2 Bytes for each level - ADD HL,BC - .BYTE 3EH ; Skip "PUSH HL" -ENFMEM: PUSH HL ; Save code string address - LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM - SUB L - LD L,A - LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM - SBC A,H - JP C,OMERR ; Not enough - ?OM Error - LD H,A - ADD HL,SP ; Test if stack is overflowed - POP HL ; Restore code string address - RET C ; Return if enough mmory -OMERR: LD E,OM ; ?OM Error - JP ERROR - -DATSNR: LD HL,(DATLIN) ; Get line of current DATA item - LD (LINEAT),HL ; Save as current line -SNERR: LD E,SN ; ?SN Error - .BYTE 01H ; Skip "LD E,DZ" -DZERR: LD E,DZ ; ?/0 Error - .BYTE 01H ; Skip "LD E,NF" -NFERR: LD E,NF ; ?NF Error - .BYTE 01H ; Skip "LD E,DD" -DDERR: LD E,DD ; ?DD Error - .BYTE 01H ; Skip "LD E,UF" -UFERR: LD E,UF ; ?UF Error - .BYTE 01H ; Skip "LD E,OV -OVERR: LD E,OV ; ?OV Error - .BYTE 01H ; Skip "LD E,TM" -TMERR: LD E,TM ; ?TM Error - -ERROR: CALL CLREG ; Clear registers and stack - LD (CTLOFG),A ; Enable output (A is 0) - CALL STTLIN ; Start new line - LD HL,ERRORS ; Point to error codes - LD D,A ; D = 0 (A is 0) - LD A,'?' - CALL OUTC ; Output '?' - ADD HL,DE ; Offset to correct error code - LD A,(HL) ; First character - CALL OUTC ; Output it - CALL GETCHR ; Get next character - CALL OUTC ; Output it - LD HL,ERRMSG ; "Error" message -ERRIN: CALL PRS ; Output message - LD HL,(LINEAT) ; Get line of error - LD DE,-2 ; Cold start error if -2 - CALL CPDEHL ; See if cold start error - JP Z,CSTART ; Cold start error - Restart - LD A,H ; Was it a direct error? - AND L ; Line = -1 if direct error - INC A - CALL NZ,LINEIN ; No - output line of error - .BYTE 3EH ; Skip "POP BC" -POPNOK: POP BC ; Drop address in input buffer - -PRNTOK: XOR A ; Output "Ok" and get command - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start new line - LD HL,OKMSG ; "Ok" message - CALL PRS ; Output "Ok" -GETCMD: LD HL,-1 ; Flag direct mode - LD (LINEAT),HL ; Save as current line - CALL GETLIN ; Get an input line - JP C,GETCMD ; Get line again if break - CALL GETCHR ; Get first character - INC A ; Test if end of line - DEC A ; Without affecting Carry - JP Z,GETCMD ; Nothing entered - Get another - PUSH AF ; Save Carry status - CALL ATOH ; Get line number into DE - PUSH DE ; Save line number - CALL CRUNCH ; Tokenise rest of line - LD B,A ; Length of tokenised line - POP DE ; Restore line number - POP AF ; Restore Carry - JP NC,EXCUTE ; No line number - Direct mode - PUSH DE ; Save line number - PUSH BC ; Save length of tokenised line - XOR A - LD (LSTBIN),A ; Clear last byte input - CALL GETCHR ; Get next character - OR A ; Set flags - PUSH AF ; And save them - CALL SRCHLN ; Search for line number in DE - JP C,LINFND ; Jump if line found - POP AF ; Get status - PUSH AF ; And re-save - JP Z,ULERR ; Nothing after number - Error - OR A ; Clear Carry -LINFND: PUSH BC ; Save address of line in prog - JP NC,INEWLN ; Line not found - Insert new - EX DE,HL ; Next line address in DE - LD HL,(PROGND) ; End of program -SFTPRG: LD A,(DE) ; Shift rest of program down - LD (BC),A - INC BC ; Next destination - INC DE ; Next source - CALL CPDEHL ; All done? - JP NZ,SFTPRG ; More to do - LD H,B ; HL - New end of program - LD L,C - LD (PROGND),HL ; Update end of program - -INEWLN: POP DE ; Get address of line, - POP AF ; Get status - JP Z,SETPTR ; No text - Set up pointers - LD HL,(PROGND) ; Get end of program - EX (SP),HL ; Get length of input line - POP BC ; End of program to BC - ADD HL,BC ; Find new end - PUSH HL ; Save new end - CALL MOVUP ; Make space for line - POP HL ; Restore new end - LD (PROGND),HL ; Update end of program pointer - EX DE,HL ; Get line to move up in HL - LD (HL),H ; Save MSB - POP DE ; Get new line number - INC HL ; Skip pointer - INC HL - LD (HL),E ; Save LSB of line number - INC HL - LD (HL),D ; Save MSB of line number - INC HL ; To first byte in line - LD DE,BUFFER ; Copy buffer to program -MOVBUF: LD A,(DE) ; Get source - LD (HL),A ; Save destinations - INC HL ; Next source - INC DE ; Next destination - OR A ; Done? - JP NZ,MOVBUF ; No - Repeat -SETPTR: CALL RUNFST ; Set line pointers - INC HL ; To LSB of pointer - EX DE,HL ; Address to DE -PTRLP: LD H,D ; Address to HL - LD L,E - LD A,(HL) ; Get LSB of pointer - INC HL ; To MSB of pointer - OR (HL) ; Compare with MSB pointer - JP Z,GETCMD ; Get command line if end - INC HL ; To LSB of line number - INC HL ; Skip line number - INC HL ; Point to first byte in line - XOR A ; Looking for 00 byte -FNDEND: CP (HL) ; Found end of line? - INC HL ; Move to next byte - JP NZ,FNDEND ; No - Keep looking - EX DE,HL ; Next line address to HL - LD (HL),E ; Save LSB of pointer - INC HL - LD (HL),D ; Save MSB of pointer - JP PTRLP ; Do next line - -SRCHLN: LD HL,(BASTXT) ; Start of program text -SRCHLP: LD B,H ; BC = Address to look at - LD C,L - LD A,(HL) ; Get address of next line - INC HL - OR (HL) ; End of program found? - DEC HL - RET Z ; Yes - Line not found - INC HL - INC HL - LD A,(HL) ; Get LSB of line number - INC HL - LD H,(HL) ; Get MSB of line number - LD L,A - CALL CPDEHL ; Compare with line in DE - LD H,B ; HL = Start of this line - LD L,C - LD A,(HL) ; Get LSB of next line address - INC HL - LD H,(HL) ; Get MSB of next line address - LD L,A ; Next line to HL - CCF - RET Z ; Lines found - Exit - CCF - RET NC ; Line not found,at line after - JP SRCHLP ; Keep looking - -NEW: RET NZ ; Return if any more on line -CLRPTR: LD HL,(BASTXT) ; Point to start of program - XOR A ; Set program area to empty - LD (HL),A ; Save LSB = 00 - INC HL - LD (HL),A ; Save MSB = 00 - INC HL - LD (PROGND),HL ; Set program end - -RUNFST: LD HL,(BASTXT) ; Clear all variables - DEC HL - -INTVAR: LD (BRKLIN),HL ; Initialise RUN variables - LD HL,(LSTRAM) ; Get end of RAM - LD (STRBOT),HL ; Clear string space - XOR A - CALL RESTOR ; Reset DATA pointers - LD HL,(PROGND) ; Get end of program - LD (VAREND),HL ; Clear variables - LD (ARREND),HL ; Clear arrays - -CLREG: POP BC ; Save return address - LD HL,(STRSPC) ; Get end of working RAN - LD SP,HL ; Set stack - LD HL,TMSTPL ; Temporary string pool - LD (TMSTPT),HL ; Reset temporary string ptr - XOR A ; A = 00 - LD L,A ; HL = 0000 - LD H,A - LD (CONTAD),HL ; No CONTinue - LD (FORFLG),A ; Clear FOR flag - LD (FNRGNM),HL ; Clear FN argument - PUSH HL ; HL = 0000 - PUSH BC ; Put back return -DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN - RET ; Return to execution driver - -PROMPT: LD A,'?' ; '?' - CALL OUTC ; Output character - LD A,' ' ; Space - CALL OUTC ; Output character - JP RINPUT ; Get input line - -CRUNCH: XOR A ; Tokenise line @ HL to BUFFER - LD (DATFLG),A ; Reset literal flag - LD C,2+3 ; 2 byte number and 3 nulls - LD DE,BUFFER ; Start of input buffer -CRNCLP: LD A,(HL) ; Get byte - CP ' ' ; Is it a space? - JP Z,MOVDIR ; Yes - Copy direct - LD B,A ; Save character - CP '"' ; Is it a quote? - JP Z,CPYLIT ; Yes - Copy literal string - OR A ; Is it end of buffer? - JP Z,ENDBUF ; Yes - End buffer - LD A,(DATFLG) ; Get data type - OR A ; Literal? - LD A,(HL) ; Get byte to copy - JP NZ,MOVDIR ; Literal - Copy direct - CP '?' ; Is it '?' short for PRINT - LD A,ZPRINT ; "PRINT" token - JP Z,MOVDIR ; Yes - replace it - LD A,(HL) ; Get byte again - CP '0' ; Is it less than '0' - JP C,FNDWRD ; Yes - Look for reserved words - CP 60; ";"+1 ; Is it "0123456789:;" ? - JP C,MOVDIR ; Yes - copy it direct -FNDWRD: PUSH DE ; Look for reserved words - LD DE,WORDS-1 ; Point to table - PUSH BC ; Save count - LD BC,RETNAD ; Where to return to - PUSH BC ; Save return address - LD B,ZEND-1 ; First token value -1 - LD A,(HL) ; Get byte - CP 'a' ; Less than 'a' ? - JP C,SEARCH ; Yes - search for words - CP 'z'+1 ; Greater than 'z' ? - JP NC,SEARCH ; Yes - search for words - AND 01011111B ; Force upper case - LD (HL),A ; Replace byte -SEARCH: LD C,(HL) ; Search for a word - EX DE,HL -GETNXT: INC HL ; Get next reserved word - OR (HL) ; Start of word? - JP P,GETNXT ; No - move on - INC B ; Increment token value - LD A, (HL) ; Get byte from table - AND 01111111B ; Strip bit 7 - RET Z ; Return if end of list - CP C ; Same character as in buffer? - JP NZ,GETNXT ; No - get next word - EX DE,HL - PUSH HL ; Save start of word - -NXTBYT: INC DE ; Look through rest of word - LD A,(DE) ; Get byte from table - OR A ; End of word ? - JP M,MATCH ; Yes - Match found - LD C,A ; Save it - LD A,B ; Get token value - CP ZGOTO ; Is it "GOTO" token ? - JP NZ,NOSPC ; No - Don't allow spaces - CALL GETCHR ; Get next character - DEC HL ; Cancel increment from GETCHR -NOSPC: INC HL ; Next byte - LD A,(HL) ; Get byte - CP 'a' ; Less than 'a' ? - JP C,NOCHNG ; Yes - don't change - AND 01011111B ; Make upper case -NOCHNG: CP C ; Same as in buffer ? - JP Z,NXTBYT ; Yes - keep testing - POP HL ; Get back start of word - JP SEARCH ; Look at next word - -MATCH: LD C,B ; Word found - Save token value - POP AF ; Throw away return - EX DE,HL - RET ; Return to "RETNAD" -RETNAD: EX DE,HL ; Get address in string - LD A,C ; Get token value - POP BC ; Restore buffer length - POP DE ; Get destination address -MOVDIR: INC HL ; Next source in buffer - LD (DE),A ; Put byte in buffer - INC DE ; Move up buffer - INC C ; Increment length of buffer - SUB ':' ; End of statement? - JP Z,SETLIT ; Jump if multi-statement line - CP ZDATA-3AH ; Is it DATA statement ? - JP NZ,TSTREM ; No - see if REM -SETLIT: LD (DATFLG),A ; Set literal flag -TSTREM: SUB ZREM-3AH ; Is it REM? - JP NZ,CRNCLP ; No - Leave flag - LD B,A ; Copy rest of buffer -NXTCHR: LD A,(HL) ; Get byte - OR A ; End of line ? - JP Z,ENDBUF ; Yes - Terminate buffer - CP B ; End of statement ? - JP Z,MOVDIR ; Yes - Get next one -CPYLIT: INC HL ; Move up source string - LD (DE),A ; Save in destination - INC C ; Increment length - INC DE ; Move up destination - JP NXTCHR ; Repeat - -ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer - LD (DE),A ; Mark end of buffer (A = 00) - INC DE - LD (DE),A ; A = 00 - INC DE - LD (DE),A ; A = 00 - RET - -DODEL: LD A,(NULFLG) ; Get null flag status - OR A ; Is it zero? - LD A,0 ; Zero A - Leave flags - LD (NULFLG),A ; Zero null flag - JP NZ,ECHDEL ; Set - Echo it - DEC B ; Decrement length - JP Z,GETLIN ; Get line again if empty - CALL OUTC ; Output null character - .BYTE 3EH ; Skip "DEC B" -ECHDEL: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - JP Z,OTKLN ; No buffer - Try again - LD A,(HL) ; Get deleted byte - CALL OUTC ; Echo it - JP MORINP ; Get more input - -DELCHR: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - CALL OUTC ; Output character in A - JP NZ,MORINP ; Not end - Get more -OTKLN: CALL OUTC ; Output character in A -KILIN: CALL PRNTCRLF ; Output CRLF - JP TTYLIN ; Get line again - -GETLIN: -TTYLIN: LD HL,BUFFER ; Get a line by character - LD B,1 ; Set buffer as empty - XOR A - LD (NULFLG),A ; Clear null flag -MORINP: CALL CLOTST ; Get character and test ^O - LD C,A ; Save character in C - CP DEL ; Delete character? - JP Z,DODEL ; Yes - Process it - LD A,(NULFLG) ; Get null flag - OR A ; Test null flag status - JP Z,PROCES ; Reset - Process character - LD A,0 ; Set a null - CALL OUTC ; Output null - XOR A ; Clear A - LD (NULFLG),A ; Reset null flag -PROCES: LD A,C ; Get character - CP CTRLG ; Bell? - JP Z,PUTCTL ; Yes - Save it - CP CTRLC ; Is it control "C"? - CALL Z,PRNTCRLF ; Yes - Output CRLF - SCF ; Flag break - RET Z ; Return if control "C" - CP CR ; Is it enter? - JP Z,ENDINP ; Yes - Terminate input - CP CTRLU ; Is it control "U"? - JP Z,KILIN ; Yes - Get another line - CP '@' ; Is it "kill line"? - JP Z,OTKLN ; Yes - Kill line - CP '_' ; Is it delete? - JP Z,DELCHR ; Yes - Delete character - CP BKSP ; Is it backspace? - JP Z,DELCHR ; Yes - Delete character - CP CTRLR ; Is it control "R"? - JP NZ,PUTBUF ; No - Put in buffer - PUSH BC ; Save buffer length - PUSH DE ; Save DE - PUSH HL ; Save buffer address - LD (HL),0 ; Mark end of buffer - CALL OUTNCR ; Output and do CRLF - LD HL,BUFFER ; Point to buffer start - CALL PRS ; Output buffer - POP HL ; Restore buffer address - POP DE ; Restore DE - POP BC ; Restore buffer length - JP MORINP ; Get another character - -PUTBUF: CP ' ' ; Is it a control code? - JP C,MORINP ; Yes - Ignore -PUTCTL: LD A,B ; Get number of bytes in buffer - CP 72+1 ; Test for line overflow - LD A,CTRLG ; Set a bell - JP NC,OUTNBS ; Ring bell if buffer full - LD A,C ; Get character - LD (HL),C ; Save in buffer - LD (LSTBIN),A ; Save last input byte - INC HL ; Move up buffer - INC B ; Increment length -OUTIT: CALL OUTC ; Output the character entered - JP MORINP ; Get another character - -OUTNBS: CALL OUTC ; Output bell and back over it - LD A,BKSP ; Set back space - JP OUTIT ; Output it and get more - -CPDEHL: LD A,H ; Get H - SUB D ; Compare with D - RET NZ ; Different - Exit - LD A,L ; Get L - SUB E ; Compare with E - RET ; Return status - -CHKSYN: LD A,(HL) ; Check syntax of character - EX (SP),HL ; Address of test byte - CP (HL) ; Same as in code string? - INC HL ; Return address - EX (SP),HL ; Put it back - JP Z,GETCHR ; Yes - Get next character - JP SNERR ; Different - ?SN Error - -OUTC: PUSH AF ; Save character - LD A,(CTLOFG) ; Get control "O" flag - OR A ; Is it set? - JP NZ,POPAF ; Yes - don't output - POP AF ; Restore character - PUSH BC ; Save buffer length - PUSH AF ; Save character - CP ' ' ; Is it a control code? - JP C,DINPOS ; Yes - Don't INC POS(X) - LD A,(LWIDTH) ; Get line width - LD B,A ; To B - LD A,(CURPOS) ; Get cursor position - INC B ; Width 255? - JP Z,INCLEN ; Yes - No width limit - DEC B ; Restore width - CP B ; At end of line? - CALL Z,PRNTCRLF ; Yes - output CRLF -INCLEN: INC A ; Move on one character - LD (CURPOS),A ; Save new position -DINPOS: POP AF ; Restore character - POP BC ; Restore buffer length - CALL MONOUT ; Send it - RET - -CLOTST: CALL GETINP ; Get input character - AND 01111111B ; Strip bit 7 - CP CTRLO ; Is it control "O"? - RET NZ ; No don't flip flag - LD A,(CTLOFG) ; Get flag - CPL ; Flip it - LD (CTLOFG),A ; Put it back - XOR A ; Null character - RET - -LIST: CALL ATOH ; ASCII number to DE - RET NZ ; Return if anything extra - POP BC ; Rubbish - Not needed - CALL SRCHLN ; Search for line number in DE - PUSH BC ; Save address of line - CALL SETLIN ; Set up lines counter -LISTLP: POP HL ; Restore address of line - LD C,(HL) ; Get LSB of next line - INC HL - LD B,(HL) ; Get MSB of next line - INC HL - LD A,B ; BC = 0 (End of program)? - OR C - JP Z,PRNTOK ; Yes - Go to command mode - CALL COUNT ; Count lines - CALL TSTBRK ; Test for break key - PUSH BC ; Save address of next line - CALL PRNTCRLF ; Output CRLF - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - INC HL - PUSH HL ; Save address of line start - EX DE,HL ; Line number to HL - CALL PRNTHL ; Output line number in decimal - LD A,' ' ; Space after line number - POP HL ; Restore start of line address -LSTLP2: CALL OUTC ; Output character in A -LSTLP3: LD A,(HL) ; Get next byte in line - OR A ; End of line? - INC HL ; To next byte in line - JP Z,LISTLP ; Yes - get next line - JP P,LSTLP2 ; No token - output it - SUB ZEND-1 ; Find and output word - LD C,A ; Token offset+1 to C - LD DE,WORDS ; Reserved word list -FNDTOK: LD A,(DE) ; Get character in list - INC DE ; Move on to next - OR A ; Is it start of word? - JP P,FNDTOK ; No - Keep looking for word - DEC C ; Count words - JP NZ,FNDTOK ; Not there - keep looking -OUTWRD: AND 01111111B ; Strip bit 7 - CALL OUTC ; Output first character - LD A,(DE) ; Get next character - INC DE ; Move on to next - OR A ; Is it end of word? - JP P,OUTWRD ; No - output the rest - JP LSTLP3 ; Next byte in line - -SETLIN: PUSH HL ; Set up LINES counter - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Save in LINES counter - POP HL - RET - -COUNT: PUSH HL ; Save code string address - PUSH DE - LD HL,(LINESC) ; Get LINES counter - LD DE,-1 - ADC HL,DE ; Decrement - LD (LINESC),HL ; Put it back - POP DE - POP HL ; Restore code string address - RET P ; Return if more lines to go - PUSH HL ; Save code string address - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - CALL GETINP ; Get input character - CP CTRLC ; Is it control "C"? - JP Z,RSLNBK ; Yes - Reset LINES and break - POP HL ; Restore code string address - JP COUNT ; Keep on counting - -RSLNBK: LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - JP BRKRET ; Go and output "Break" - -FOR: LD A,64H ; Flag "FOR" assignment - LD (FORFLG),A ; Save "FOR" flag - CALL LET ; Set up initial index - POP BC ; Drop RETurn address - PUSH HL ; Save code string address - CALL DATA ; Get next statement address - LD (LOOPST),HL ; Save it for start of loop - LD HL,2 ; Offset for "FOR" block - ADD HL,SP ; Point to it -FORSLP: CALL LOKFOR ; Look for existing "FOR" block - POP DE ; Get code string address - JP NZ,FORFND ; No nesting found - ADD HL,BC ; Move into "FOR" block - PUSH DE ; Save code string address - DEC HL - LD D,(HL) ; Get MSB of loop statement - DEC HL - LD E,(HL) ; Get LSB of loop statement - INC HL - INC HL - PUSH HL ; Save block address - LD HL,(LOOPST) ; Get address of loop statement - CALL CPDEHL ; Compare the FOR loops - POP HL ; Restore block address - JP NZ,FORSLP ; Different FORs - Find another - POP DE ; Restore code string address - LD SP,HL ; Remove all nested loops - -FORFND: EX DE,HL ; Code string address to HL - LD C,8 - CALL CHKSTK ; Check for 8 levels of stack - PUSH HL ; Save code string address - LD HL,(LOOPST) ; Get first statement of loop - EX (SP),HL ; Save and restore code string - PUSH HL ; Re-save code string address - LD HL,(LINEAT) ; Get current line number - EX (SP),HL ; Save and restore code string - CALL TSTNUM ; Make sure it's a number - CALL CHKSYN ; Make sure "TO" is next - .BYTE ZTO ; "TO" token - CALL GETNUM ; Get "TO" expression value - PUSH HL ; Save code string address - CALL BCDEFP ; Move "TO" value to BCDE - POP HL ; Restore code string address - PUSH BC ; Save "TO" value in block - PUSH DE - LD BC,8100H ; BCDE - 1 (default STEP) - LD D,C ; C=0 - LD E,D ; D=0 - LD A,(HL) ; Get next byte in code string - CP ZSTEP ; See if "STEP" is stated - LD A,1 ; Sign of step = 1 - JP NZ,SAVSTP ; No STEP given - Default to 1 - CALL GETCHR ; Jump over "STEP" token - CALL GETNUM ; Get step value - PUSH HL ; Save code string address - CALL BCDEFP ; Move STEP to BCDE - CALL TSTSGN ; Test sign of FPREG - POP HL ; Restore code string address -SAVSTP: PUSH BC ; Save the STEP value in block - PUSH DE - PUSH AF ; Save sign of STEP - INC SP ; Don't save flags - PUSH HL ; Save code string address - LD HL,(BRKLIN) ; Get address of index variable - EX (SP),HL ; Save and restore code string -PUTFID: LD B,ZFOR ; "FOR" block marker - PUSH BC ; Save it - INC SP ; Don't save C - -RUNCNT: CALL TSTBRK ; Execution driver - Test break - LD (BRKLIN),HL ; Save code address for break - LD A,(HL) ; Get next byte in code string - CP ':' ; Multi statement line? - JP Z,EXCUTE ; Yes - Execute it - OR A ; End of line? - JP NZ,SNERR ; No - Syntax error - INC HL ; Point to address of next line - LD A,(HL) ; Get LSB of line pointer - INC HL - OR (HL) ; Is it zero (End of prog)? - JP Z,ENDPRG ; Yes - Terminate execution - INC HL ; Point to line number - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - EX DE,HL ; Line number to HL - LD (LINEAT),HL ; Save as current line number - EX DE,HL ; Line number back to DE -EXCUTE: CALL GETCHR ; Get key word - LD DE,RUNCNT ; Where to RETurn to - PUSH DE ; Save for RETurn -IFJMP: RET Z ; Go to RUNCNT if end of STMT -ONJMP: SUB ZEND ; Is it a token? - JP C,LET ; No - try to assign it - CP ZNEW+1-ZEND ; END to NEW ? - JP NC,SNERR ; Not a key word - ?SN Error - RLCA ; Double it - LD C,A ; BC = Offset into table - LD B,0 - EX DE,HL ; Save code string address - LD HL,WORDTB ; Keyword address table - ADD HL,BC ; Point to routine address - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - PUSH BC ; Save routine address - EX DE,HL ; Restore code string address - -GETCHR: INC HL ; Point to next character - LD A,(HL) ; Get next code string byte - CP ':' ; Z if ':' - RET NC ; NC if > "9" - CP ' ' - JP Z,GETCHR ; Skip over spaces - CP '0' - CCF ; NC if < '0' - INC A ; Test for zero - Leave carry - DEC A ; Z if Null - RET - -RESTOR: EX DE,HL ; Save code string address - LD HL,(BASTXT) ; Point to start of program - JP Z,RESTNL ; Just RESTORE - reset pointer - EX DE,HL ; Restore code string address - CALL ATOH ; Get line number to DE - PUSH HL ; Save code string address - CALL SRCHLN ; Search for line number in DE - LD H,B ; HL = Address of line - LD L,C - POP DE ; Restore code string address - JP NC,ULERR ; ?UL Error if not found -RESTNL: DEC HL ; Byte before DATA statement -UPDATA: LD (NXTDAT),HL ; Update DATA pointer - EX DE,HL ; Restore code string address - RET - - -TSTBRK: RST 18H ; Check input status - RET Z ; No key, go back - RST 10H ; Get the key into A - CP ESC ; Escape key? - JR Z,BRK ; Yes, break - CP CTRLC ; - JR Z,BRK ; Yes, break - CP CTRLS ; Stop scrolling? - RET NZ ; Other key, ignore - - -STALL: RST 10H ; Wait for key - CP CTRLQ ; Resume scrolling? - RET Z ; Release the chokehold - CP CTRLC ; Second break? - JR Z,STOP ; Break during hold exits prog - JR STALL ; Loop until or - -BRK LD A,$FF ; Set BRKFLG - LD (BRKFLG),A ; Store it - - -STOP: RET NZ ; Exit if anything else - .BYTE 0F6H ; Flag "STOP" -PEND: RET NZ ; Exit if anything else - LD (BRKLIN),HL ; Save point of break - .BYTE 21H ; Skip "OR 11111111B" -INPBRK: OR 11111111B ; Flag "Break" wanted - POP BC ; Return not needed and more -ENDPRG: LD HL,(LINEAT) ; Get current line number - PUSH AF ; Save STOP / END status - LD A,L ; Is it direct break? - AND H - INC A ; Line is -1 if direct break - JP Z,NOLIN ; Yes - No line number - LD (ERRLIN),HL ; Save line of break - LD HL,(BRKLIN) ; Get point of break - LD (CONTAD),HL ; Save point to CONTinue -NOLIN: XOR A - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start a new line - POP AF ; Restore STOP / END status - LD HL,BRKMSG ; "Break" message - JP NZ,ERRIN ; "in line" wanted? - JP PRNTOK ; Go to command mode - -CONT: LD HL,(CONTAD) ; Get CONTinue address - LD A,H ; Is it zero? - OR L - LD E,CN ; ?CN Error - JP Z,ERROR ; Yes - output "?CN Error" - EX DE,HL ; Save code string address - LD HL,(ERRLIN) ; Get line of last break - LD (LINEAT),HL ; Set up current line number - EX DE,HL ; Restore code string address - RET ; CONTinue where left off - -NULL: CALL GETINT ; Get integer 0-255 - RET NZ ; Return if bad value - LD (NULLS),A ; Set nulls number - RET - - -ACCSUM: PUSH HL ; Save address in array - LD HL,(CHKSUM) ; Get check sum - LD B,0 ; BC - Value of byte - LD C,A - ADD HL,BC ; Add byte to check sum - LD (CHKSUM),HL ; Re-save check sum - POP HL ; Restore address in array - RET - -CHKLTR: LD A,(HL) ; Get byte - CP 'A' ; < 'a' ? - RET C ; Carry set if not letter - CP 'Z'+1 ; > 'z' ? - CCF - RET ; Carry set if not letter - -FPSINT: CALL GETCHR ; Get next character -POSINT: CALL GETNUM ; Get integer 0 to 32767 -DEPINT: CALL TSTSGN ; Test sign of FPREG - JP M,FCERR ; Negative - ?FC Error -DEINT: LD A,(FPEXP) ; Get integer value to DE - CP 80H+16 ; Exponent in range (16 bits)? - JP C,FPINT ; Yes - convert it - LD BC,9080H ; BCDE = -32768 - LD DE,0000 - PUSH HL ; Save code string address - CALL CMPNUM ; Compare FPREG with BCDE - POP HL ; Restore code string address - LD D,C ; MSB to D - RET Z ; Return if in range -FCERR: LD E,FC ; ?FC Error - JP ERROR ; Output error- - -ATOH: DEC HL ; ASCII number to DE binary -GETLN: LD DE,0 ; Get number to DE -GTLNLP: CALL GETCHR ; Get next character - RET NC ; Exit if not a digit - PUSH HL ; Save code string address - PUSH AF ; Save digit - LD HL,65529/10 ; Largest number 65529 - CALL CPDEHL ; Number in range? - JP C,SNERR ; No - ?SN Error - LD H,D ; HL = Number - LD L,E - ADD HL,DE ; Times 2 - ADD HL,HL ; Times 4 - ADD HL,DE ; Times 5 - ADD HL,HL ; Times 10 - POP AF ; Restore digit - SUB '0' ; Make it 0 to 9 - LD E,A ; DE = Value of digit - LD D,0 - ADD HL,DE ; Add to number - EX DE,HL ; Number to DE - POP HL ; Restore code string address - JP GTLNLP ; Go to next character - -CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters - CALL POSINT ; Get integer 0 to 32767 to DE - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - PUSH HL ; Save code string address - LD HL,(LSTRAM) ; Get end of RAM - JP Z,STORED ; No value given - Use stored - POP HL ; Restore code string address - CALL CHKSYN ; Check for comma - .BYTE ',' - PUSH DE ; Save number - CALL POSINT ; Get integer 0 to 32767 - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - JP NZ,SNERR ; ?SN Error if more on line - EX (SP),HL ; Save code string address - EX DE,HL ; Number to DE -STORED: LD A,L ; Get LSB of new RAM top - SUB E ; Subtract LSB of string space - LD E,A ; Save LSB - LD A,H ; Get MSB of new RAM top - SBC A,D ; Subtract MSB of string space - LD D,A ; Save MSB - JP C,OMERR ; ?OM Error if not enough mem - PUSH HL ; Save RAM top - LD HL,(PROGND) ; Get program end - LD BC,40 ; 40 Bytes minimum working RAM - ADD HL,BC ; Get lowest address - CALL CPDEHL ; Enough memory? - JP NC,OMERR ; No - ?OM Error - EX DE,HL ; RAM top to HL - LD (STRSPC),HL ; Set new string space - POP HL ; End of memory to use - LD (LSTRAM),HL ; Set new top of RAM - POP HL ; Restore code string address - JP INTVAR ; Initialise variables - -RUN: JP Z,RUNFST ; RUN from start if just RUN - CALL INTVAR ; Initialise variables - LD BC,RUNCNT ; Execution driver loop - JP RUNLIN ; RUN from line number - -GOSUB: LD C,3 ; 3 Levels of stack needed - CALL CHKSTK ; Check for 3 levels of stack - POP BC ; Get return address - PUSH HL ; Save code string for RETURN - PUSH HL ; And for GOSUB routine - LD HL,(LINEAT) ; Get current line - EX (SP),HL ; Into stack - Code string out - LD A,ZGOSUB ; "GOSUB" token - PUSH AF ; Save token - INC SP ; Don't save flags - -RUNLIN: PUSH BC ; Save return address -GOTO: CALL ATOH ; ASCII number to DE binary - CALL REM ; Get end of line - PUSH HL ; Save end of line - LD HL,(LINEAT) ; Get current line - CALL CPDEHL ; Line after current? - POP HL ; Restore end of line - INC HL ; Start of next line - CALL C,SRCHLP ; Line is after current line - CALL NC,SRCHLN ; Line is before current line - LD H,B ; Set up code string address - LD L,C - DEC HL ; Incremented after - RET C ; Line found -ULERR: LD E,UL ; ?UL Error - JP ERROR ; Output error message - -RETURN: RET NZ ; Return if not just RETURN - LD D,-1 ; Flag "GOSUB" search - CALL BAKSTK ; Look "GOSUB" block - LD SP,HL ; Kill all FORs in subroutine - CP ZGOSUB ; Test for "GOSUB" token - LD E,RG ; ?RG Error - JP NZ,ERROR ; Error if no "GOSUB" found - POP HL ; Get RETURN line number - LD (LINEAT),HL ; Save as current - INC HL ; Was it from direct statement? - LD A,H - OR L ; Return to line - JP NZ,RETLIN ; No - Return to line - LD A,(LSTBIN) ; Any INPUT in subroutine? - OR A ; If so buffer is corrupted - JP NZ,POPNOK ; Yes - Go to command mode -RETLIN: LD HL,RUNCNT ; Execution driver loop - EX (SP),HL ; Into stack - Code string out - .BYTE 3EH ; Skip "POP HL" -NXTDTA: POP HL ; Restore code string address - -DATA: .BYTE 01H,3AH ; ':' End of statement -REM: LD C,0 ; 00 End of statement - LD B,0 -NXTSTL: LD A,C ; Statement and byte - LD C,B - LD B,A ; Statement end byte -NXTSTT: LD A,(HL) ; Get byte - OR A ; End of line? - RET Z ; Yes - Exit - CP B ; End of statement? - RET Z ; Yes - Exit - INC HL ; Next byte - CP '"' ; Literal string? - JP Z,NXTSTL ; Yes - Look for another '"' - JP NXTSTT ; Keep looking - -LET: CALL GETVAR ; Get variable name - CALL CHKSYN ; Make sure "=" follows - .BYTE ZEQUAL ; "=" token - PUSH DE ; Save address of variable - LD A,(TYPE) ; Get data type - PUSH AF ; Save type - CALL EVAL ; Evaluate expression - POP AF ; Restore type - EX (SP),HL ; Save code - Get var addr - LD (BRKLIN),HL ; Save address of variable - RRA ; Adjust type - CALL CHKTYP ; Check types are the same - JP Z,LETNUM ; Numeric - Move value -LETSTR: PUSH HL ; Save address of string var - LD HL,(FPREG) ; Pointer to string entry - PUSH HL ; Save it on stack - INC HL ; Skip over length - INC HL - LD E,(HL) ; LSB of string address - INC HL - LD D,(HL) ; MSB of string address - LD HL,(BASTXT) ; Point to start of program - CALL CPDEHL ; Is string before program? - JP NC,CRESTR ; Yes - Create string entry - LD HL,(STRSPC) ; Point to string space - CALL CPDEHL ; Is string literal in program? - POP DE ; Restore address of string - JP NC,MVSTPT ; Yes - Set up pointer - LD HL,TMPSTR ; Temporary string pool - CALL CPDEHL ; Is string in temporary pool? - JP NC,MVSTPT ; No - Set up pointer - .BYTE 3EH ; Skip "POP DE" -CRESTR: POP DE ; Restore address of string - CALL BAKTMP ; Back to last tmp-str entry - EX DE,HL ; Address of string entry - CALL SAVSTR ; Save string in string area -MVSTPT: CALL BAKTMP ; Back to last tmp-str entry - POP HL ; Get string pointer - CALL DETHL4 ; Move string pointer to var - POP HL ; Restore code string address - RET - -LETNUM: PUSH HL ; Save address of variable - CALL FPTHL ; Move value to variable - POP DE ; Restore address of variable - POP HL ; Restore code string address - RET - -ON: CALL GETINT ; Get integer 0-255 - LD A,(HL) ; Get "GOTO" or "GOSUB" token - LD B,A ; Save in B - CP ZGOSUB ; "GOSUB" token? - JP Z,ONGO ; Yes - Find line number - CALL CHKSYN ; Make sure it's "GOTO" - .BYTE ZGOTO ; "GOTO" token - DEC HL ; Cancel increment -ONGO: LD C,E ; Integer of branch value -ONGOLP: DEC C ; Count branches - LD A,B ; Get "GOTO" or "GOSUB" token - JP Z,ONJMP ; Go to that line if right one - CALL GETLN ; Get line number to DE - CP ',' ; Another line number? - RET NZ ; No - Drop through - JP ONGOLP ; Yes - loop - -IF: CALL EVAL ; Evaluate expression - LD A,(HL) ; Get token - CP ZGOTO ; "GOTO" token? - JP Z,IFGO ; Yes - Get line - CALL CHKSYN ; Make sure it's "THEN" - .BYTE ZTHEN ; "THEN" token - DEC HL ; Cancel increment -IFGO: CALL TSTNUM ; Make sure it's numeric - CALL TSTSGN ; Test state of expression - JP Z,REM ; False - Drop through - CALL GETCHR ; Get next character - JP C,GOTO ; Number - GOTO that line - JP IFJMP ; Otherwise do statement - -MRPRNT: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character -PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT -PRNTLP: RET Z ; End of list - Exit - CP ZTAB ; "TAB(" token? - JP Z,DOTAB ; Yes - Do TAB routine - CP ZSPC ; "SPC(" token? - JP Z,DOTAB ; Yes - Do SPC routine - PUSH HL ; Save code string address - CP ',' ; Comma? - JP Z,DOCOM ; Yes - Move to next zone - CP 59 ;";" ; Semi-colon? - JP Z,NEXITM ; Do semi-colon routine - POP BC ; Code string address to BC - CALL EVAL ; Evaluate expression - PUSH HL ; Save code string address - LD A,(TYPE) ; Get variable type - OR A ; Is it a string variable? - JP NZ,PRNTST ; Yes - Output string contents - CALL NUMASC ; Convert number to text - CALL CRTST ; Create temporary string - LD (HL),' ' ; Followed by a space - LD HL,(FPREG) ; Get length of output - INC (HL) ; Plus 1 for the space - LD HL,(FPREG) ; < Not needed > - LD A,(LWIDTH) ; Get width of line - LD B,A ; To B - INC B ; Width 255 (No limit)? - JP Z,PRNTNB ; Yes - Output number string - INC B ; Adjust it - LD A,(CURPOS) ; Get cursor position - ADD A,(HL) ; Add length of string - DEC A ; Adjust it - CP B ; Will output fit on this line? - CALL NC,PRNTCRLF ; No - CRLF first -PRNTNB: CALL PRS1 ; Output string at (HL) - XOR A ; Skip CALL by setting 'z' flag -PRNTST: CALL NZ,PRS1 ; Output string at (HL) - POP HL ; Restore code string address - JP MRPRNT ; See if more to PRINT - -STTLIN: LD A,(CURPOS) ; Make sure on new line - OR A ; Already at start? - RET Z ; Yes - Do nothing - JP PRNTCRLF ; Start a new line - -ENDINP: LD (HL),0 ; Mark end of buffer - LD HL,BUFFER-1 ; Point to buffer -PRNTCRLF: LD A,CR ; Load a CR - CALL OUTC ; Output character - LD A,LF ; Load a LF - CALL OUTC ; Output character -DONULL: XOR A ; Set to position 0 - LD (CURPOS),A ; Store it - LD A,(NULLS) ; Get number of nulls -NULLP: DEC A ; Count them - RET Z ; Return if done - PUSH AF ; Save count - XOR A ; Load a null - CALL OUTC ; Output it - POP AF ; Restore count - JP NULLP ; Keep counting - -DOCOM: LD A,(COMMAN) ; Get comma width - LD B,A ; Save in B - LD A,(CURPOS) ; Get current position - CP B ; Within the limit? - CALL NC,PRNTCRLF ; No - output CRLF - JP NC,NEXITM ; Get next item -ZONELP: SUB 14 ; Next zone of 14 characters - JP NC,ZONELP ; Repeat if more zones - CPL ; Number of spaces to output - JP ASPCS ; Output them - -DOTAB: PUSH AF ; Save token - CALL FNDNUM ; Evaluate expression - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - DEC HL ; Back space on to ")" - POP AF ; Restore token - SUB ZSPC ; Was it "SPC(" ? - PUSH HL ; Save code string address - JP Z,DOSPC ; Yes - Do 'E' spaces - LD A,(CURPOS) ; Get current position -DOSPC: CPL ; Number of spaces to print to - ADD A,E ; Total number to print - JP NC,NEXITM ; TAB < Current POS(X) -ASPCS: INC A ; Output A spaces - LD B,A ; Save number to print - LD A,' ' ; Space -SPCLP: CALL OUTC ; Output character in A - DEC B ; Count them - JP NZ,SPCLP ; Repeat if more -NEXITM: POP HL ; Restore code string address - CALL GETCHR ; Get next character - JP PRNTLP ; More to print - -REDO: .BYTE "?Redo from start",CR,LF,0 - -BADINP: LD A,(READFG) ; READ or INPUT? - OR A - JP NZ,DATSNR ; READ - ?SN Error - POP BC ; Throw away code string addr - LD HL,REDO ; "Redo from start" message - CALL PRS ; Output string - JP DOAGN ; Do last INPUT again - -INPUT: CALL IDTEST ; Test for illegal direct - LD A,(HL) ; Get character after "INPUT" - CP '"' ; Is there a prompt string? - LD A,0 ; Clear A and leave flags - LD (CTLOFG),A ; Enable output - JP NZ,NOPMPT ; No prompt - get input - CALL QTSTR ; Get string terminated by '"' - CALL CHKSYN ; Check for ';' after prompt - .BYTE ';' - PUSH HL ; Save code string address - CALL PRS1 ; Output prompt string - .BYTE 3EH ; Skip "PUSH HL" -NOPMPT: PUSH HL ; Save code string address - CALL PROMPT ; Get input with "? " prompt - POP BC ; Restore code string address - JP C,INPBRK ; Break pressed - Exit - INC HL ; Next byte - LD A,(HL) ; Get it - OR A ; End of line? - DEC HL ; Back again - PUSH BC ; Re-save code string address - JP Z,NXTDTA ; Yes - Find next DATA stmt - LD (HL),',' ; Store comma as separator - JP NXTITM ; Get next item - -READ: PUSH HL ; Save code string address - LD HL,(NXTDAT) ; Next DATA statement - .BYTE 0F6H ; Flag "READ" -NXTITM: XOR A ; Flag "INPUT" - LD (READFG),A ; Save "READ"/"INPUT" flag - EX (SP),HL ; Get code str' , Save pointer - JP GTVLUS ; Get values - -NEDMOR: CALL CHKSYN ; Check for comma between items - .BYTE ',' -GTVLUS: CALL GETVAR ; Get variable name - EX (SP),HL ; Save code str" , Get pointer - PUSH DE ; Save variable address - LD A,(HL) ; Get next "INPUT"/"DATA" byte - CP ',' ; Comma? - JP Z,ANTVLU ; Yes - Get another value - LD A,(READFG) ; Is it READ? - OR A - JP NZ,FDTLP ; Yes - Find next DATA stmt - LD A,'?' ; More INPUT needed - CALL OUTC ; Output character - CALL PROMPT ; Get INPUT with prompt - POP DE ; Variable address - POP BC ; Code string address - JP C,INPBRK ; Break pressed - INC HL ; Point to next DATA byte - LD A,(HL) ; Get byte - OR A ; Is it zero (No input) ? - DEC HL ; Back space INPUT pointer - PUSH BC ; Save code string address - JP Z,NXTDTA ; Find end of buffer - PUSH DE ; Save variable address -ANTVLU: LD A,(TYPE) ; Check data type - OR A ; Is it numeric? - JP Z,INPBIN ; Yes - Convert to binary - CALL GETCHR ; Get next character - LD D,A ; Save input character - LD B,A ; Again - CP '"' ; Start of literal sting? - JP Z,STRENT ; Yes - Create string entry - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - LD D,A ; Save 00 if "INPUT" - JP Z,ITMSEP ; "INPUT" - End with 00 - LD D,':' ; "DATA" - End with 00 or ':' -ITMSEP: LD B,',' ; Item separator - DEC HL ; Back space for DTSTR -STRENT: CALL DTSTR ; Get string terminated by D - EX DE,HL ; String address to DE - LD HL,LTSTND ; Where to go after LETSTR - EX (SP),HL ; Save HL , get input pointer - PUSH DE ; Save address of string - JP LETSTR ; Assign string to variable - -INPBIN: CALL GETCHR ; Get next character - CALL ASCTFP ; Convert ASCII to FP number - EX (SP),HL ; Save input ptr, Get var addr - CALL FPTHL ; Move FPREG to variable - POP HL ; Restore input pointer -LTSTND: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,MORDT ; End of line - More needed? - CP ',' ; Another value? - JP NZ,BADINP ; No - Bad input -MORDT: EX (SP),HL ; Get code string address - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,NEDMOR ; More needed - Get it - POP DE ; Restore DATA pointer - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - EX DE,HL ; DATA pointer to HL - JP NZ,UPDATA ; Update DATA pointer if "READ" - PUSH DE ; Save code string address - OR (HL) ; More input given? - LD HL,EXTIG ; "?Extra ignored" message - CALL NZ,PRS ; Output string if extra given - POP HL ; Restore code string address - RET - -EXTIG: .BYTE "?Extra ignored",CR,LF,0 - -FDTLP: CALL DATA ; Get next statement - OR A ; End of line? - JP NZ,FANDT ; No - See if DATA statement - INC HL - LD A,(HL) ; End of program? - INC HL - OR (HL) ; 00 00 Ends program - LD E,OD ; ?OD Error - JP Z,ERROR ; Yes - Out of DATA - INC HL - LD E,(HL) ; LSB of line number - INC HL - LD D,(HL) ; MSB of line number - EX DE,HL - LD (DATLIN),HL ; Set line of current DATA item - EX DE,HL -FANDT: CALL GETCHR ; Get next character - CP ZDATA ; "DATA" token - JP NZ,FDTLP ; No "DATA" - Keep looking - JP ANTVLU ; Found - Convert input - -NEXT: LD DE,0 ; In case no index given -NEXT1: CALL NZ,GETVAR ; Get index address - LD (BRKLIN),HL ; Save code string address - CALL BAKSTK ; Look for "FOR" block - JP NZ,NFERR ; No "FOR" - ?NF Error - LD SP,HL ; Clear nested loops - PUSH DE ; Save index address - LD A,(HL) ; Get sign of STEP - INC HL - PUSH AF ; Save sign of STEP - PUSH DE ; Save index address - CALL PHLTFP ; Move index value to FPREG - EX (SP),HL ; Save address of TO value - PUSH HL ; Save address of index - CALL ADDPHL ; Add STEP to index value - POP HL ; Restore address of index - CALL FPTHL ; Move value to index variable - POP HL ; Restore address of TO value - CALL LOADFP ; Move TO value to BCDE - PUSH HL ; Save address of line of FOR - CALL CMPNUM ; Compare index with TO value - POP HL ; Restore address of line num - POP BC ; Address of sign of STEP - SUB B ; Compare with expected sign - CALL LOADFP ; BC = Loop stmt,DE = Line num - JP Z,KILFOR ; Loop finished - Terminate it - EX DE,HL ; Loop statement line number - LD (LINEAT),HL ; Set loop line number - LD L,C ; Set code string to loop - LD H,B - JP PUTFID ; Put back "FOR" and continue - -KILFOR: LD SP,HL ; Remove "FOR" block - LD HL,(BRKLIN) ; Code string after "NEXT" - LD A,(HL) ; Get next byte in code string - CP ',' ; More NEXTs ? - JP NZ,RUNCNT ; No - Do next statement - CALL GETCHR ; Position to index name - CALL NEXT1 ; Re-enter NEXT routine -; < will not RETurn to here , Exit to RUNCNT or Loop > - -GETNUM: CALL EVAL ; Get a numeric expression -TSTNUM: .BYTE 0F6H ; Clear carry (numeric) -TSTSTR: SCF ; Set carry (string) -CHKTYP: LD A,(TYPE) ; Check types match - ADC A,A ; Expected + actual - OR A ; Clear carry , set parity - RET PE ; Even parity - Types match - JP TMERR ; Different types - Error - -OPNPAR: CALL CHKSYN ; Make sure "(" follows - .BYTE "(" -EVAL: DEC HL ; Evaluate expression & save - LD D,0 ; Precedence value -EVAL1: PUSH DE ; Save precedence - LD C,1 - CALL CHKSTK ; Check for 1 level of stack - CALL OPRND ; Get next expression value -EVAL2: LD (NXTOPR),HL ; Save address of next operator -EVAL3: LD HL,(NXTOPR) ; Restore address of next opr - POP BC ; Precedence value and operator - LD A,B ; Get precedence value - CP 78H ; "AND" or "OR" ? - CALL NC,TSTNUM ; No - Make sure it's a number - LD A,(HL) ; Get next operator / function - LD D,0 ; Clear Last relation -RLTLP: SUB ZGTR ; ">" Token - JP C,FOPRND ; + - * / ^ AND OR - Test it - CP ZLTH+1-ZGTR ; < = > - JP NC,FOPRND ; Function - Call it - CP ZEQUAL-ZGTR ; "=" - RLA ; <- Test for legal - XOR D ; <- combinations of < = > - CP D ; <- by combining last token - LD D,A ; <- with current one - JP C,SNERR ; Error if "<<' '==" or ">>" - LD (CUROPR),HL ; Save address of current token - CALL GETCHR ; Get next character - JP RLTLP ; Treat the two as one - -FOPRND: LD A,D ; < = > found ? - OR A - JP NZ,TSTRED ; Yes - Test for reduction - LD A,(HL) ; Get operator token - LD (CUROPR),HL ; Save operator address - SUB ZPLUS ; Operator or function? - RET C ; Neither - Exit - CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? - RET NC ; No - Exit - LD E,A ; Coded operator - LD A,(TYPE) ; Get data type - DEC A ; FF = numeric , 00 = string - OR E ; Combine with coded operator - LD A,E ; Get coded operator - JP Z,CONCAT ; String concatenation - RLCA ; Times 2 - ADD A,E ; Times 3 - LD E,A ; To DE (D is 0) - LD HL,PRITAB ; Precedence table - ADD HL,DE ; To the operator concerned - LD A,B ; Last operator precedence - LD D,(HL) ; Get evaluation precedence - CP D ; Compare with eval precedence - RET NC ; Exit if higher precedence - INC HL ; Point to routine address - CALL TSTNUM ; Make sure it's a number - -STKTHS: PUSH BC ; Save last precedence & token - LD BC,EVAL3 ; Where to go on prec' break - PUSH BC ; Save on stack for return - LD B,E ; Save operator - LD C,D ; Save precedence - CALL STAKFP ; Move value to stack - LD E,B ; Restore operator - LD D,C ; Restore precedence - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - INC HL - PUSH BC ; Save routine address - LD HL,(CUROPR) ; Address of current operator - JP EVAL1 ; Loop until prec' break - -OPRND: XOR A ; Get operand routine - LD (TYPE),A ; Set numeric expected - CALL GETCHR ; Get next character - LD E,MO ; ?MO Error - JP Z,ERROR ; No operand - Error - JP C,ASCTFP ; Number - Get value - CALL CHKLTR ; See if a letter - JP NC,CONVAR ; Letter - Find variable - CP '&' ; &H = HEX, &B = BINARY - JR NZ, NOTAMP - CALL GETCHR ; Get next character - CP 'H' ; Hex number indicated? [function added] - JP Z,HEXTFP ; Convert Hex to FPREG - CP 'B' ; Binary number indicated? [function added] - JP Z,BINTFP ; Convert Bin to FPREG - LD E,SN ; If neither then a ?SN Error - JP Z,ERROR ; -NOTAMP: CP ZPLUS ; '+' Token ? - JP Z,OPRND ; Yes - Look for operand - CP '.' ; '.' ? - JP Z,ASCTFP ; Yes - Create FP number - CP ZMINUS ; '-' Token ? - JP Z,MINUS ; Yes - Do minus - CP '"' ; Literal string ? - JP Z,QTSTR ; Get string terminated by '"' - CP ZNOT ; "NOT" Token ? - JP Z,EVNOT ; Yes - Eval NOT expression - CP ZFN ; "FN" Token ? - JP Z,DOFN ; Yes - Do FN routine - SUB ZSGN ; Is it a function? - JP NC,FNOFST ; Yes - Evaluate function -EVLPAR: CALL OPNPAR ; Evaluate expression in "()" - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - RET - -MINUS: LD D,7DH ; '-' precedence - CALL EVAL1 ; Evaluate until prec' break - LD HL,(NXTOPR) ; Get next operator address - PUSH HL ; Save next operator address - CALL INVSGN ; Negate value -RETNUM: CALL TSTNUM ; Make sure it's a number - POP HL ; Restore next operator address - RET - -CONVAR: CALL GETVAR ; Get variable address to DE -FRMEVL: PUSH HL ; Save code string address - EX DE,HL ; Variable address to HL - LD (FPREG),HL ; Save address of variable - LD A,(TYPE) ; Get type - OR A ; Numeric? - CALL Z,PHLTFP ; Yes - Move contents to FPREG - POP HL ; Restore code string address - RET - -FNOFST: LD B,0 ; Get address of function - RLCA ; Double function offset - LD C,A ; BC = Offset in function table - PUSH BC ; Save adjusted token value - CALL GETCHR ; Get next character - LD A,C ; Get adjusted token value - CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? - JP C,FNVAL ; No - Do function - CALL OPNPAR ; Evaluate expression (X,... - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL TSTSTR ; Make sure it's a string - EX DE,HL ; Save code string address - LD HL,(FPREG) ; Get address of string - EX (SP),HL ; Save address of string - PUSH HL ; Save adjusted token value - EX DE,HL ; Restore code string address - CALL GETINT ; Get integer 0-255 - EX DE,HL ; Save code string address - EX (SP),HL ; Save integer,HL = adj' token - JP GOFUNC ; Jump to string function - -FNVAL: CALL EVLPAR ; Evaluate expression - EX (SP),HL ; HL = Adjusted token value - LD DE,RETNUM ; Return number from function - PUSH DE ; Save on stack -GOFUNC: LD BC,FNCTAB ; Function routine addresses - ADD HL,BC ; Point to right address - LD C,(HL) ; Get LSB of address - INC HL ; - LD H,(HL) ; Get MSB of address - LD L,C ; Address to HL - JP (HL) ; Jump to function - -SGNEXP: DEC D ; Dee to flag negative exponent - CP ZMINUS ; '-' token ? - RET Z ; Yes - Return - CP '-' ; '-' ASCII ? - RET Z ; Yes - Return - INC D ; Inc to flag positive exponent - CP '+' ; '+' ASCII ? - RET Z ; Yes - Return - CP ZPLUS ; '+' token ? - RET Z ; Yes - Return - DEC HL ; DEC 'cos GETCHR INCs - RET ; Return "NZ" - -POR: .BYTE 0F6H ; Flag "OR" -PAND: XOR A ; Flag "AND" - PUSH AF ; Save "AND" / "OR" flag - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - EX DE,HL ; <- Get last - POP BC ; <- value - EX (SP),HL ; <- from - EX DE,HL ; <- stack - CALL FPBCDE ; Move last value to FPREG - PUSH AF ; Save "AND" / "OR" flag - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - POP BC ; Get value - LD A,C ; Get LSB - LD HL,ACPASS ; Address of save AC as current - JP NZ,POR1 ; Jump if OR - AND E ; "AND" LSBs - LD C,A ; Save LSB - LD A,B ; Get MBS - AND D ; "AND" MSBs - JP (HL) ; Save AC as current (ACPASS) - -POR1: OR E ; "OR" LSBs - LD C,A ; Save LSB - LD A,B ; Get MSB - OR D ; "OR" MSBs - JP (HL) ; Save AC as current (ACPASS) - -TSTRED: LD HL,CMPLOG ; Logical compare routine - LD A,(TYPE) ; Get data type - RRA ; Carry set = string - LD A,D ; Get last precedence value - RLA ; Times 2 plus carry - LD E,A ; To E - LD D,64H ; Relational precedence - LD A,B ; Get current precedence - CP D ; Compare with last - RET NC ; Eval if last was rel' or log' - JP STKTHS ; Stack this one and get next - -CMPLOG: .WORD CMPLG1 ; Compare two values / strings -CMPLG1: LD A,C ; Get data type - OR A - RRA - POP BC ; Get last expression to BCDE - POP DE - PUSH AF ; Save status - CALL CHKTYP ; Check that types match - LD HL,CMPRES ; Result to comparison - PUSH HL ; Save for RETurn - JP Z,CMPNUM ; Compare values if numeric - XOR A ; Compare two strings - LD (TYPE),A ; Set type to numeric - PUSH DE ; Save string name - CALL GSTRCU ; Get current string - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - POP DE ; Restore string name - PUSH BC ; Save address of string - PUSH AF ; Save length of string - CALL GSTRDE ; Get second string - CALL LOADFP ; Get address of second string - POP AF ; Restore length of string 1 - LD D,A ; Length to D - POP HL ; Restore address of string 1 -CMPSTR: LD A,E ; Bytes of string 2 to do - OR D ; Bytes of string 1 to do - RET Z ; Exit if all bytes compared - LD A,D ; Get bytes of string 1 to do - SUB 1 - RET C ; Exit if end of string 1 - XOR A - CP E ; Bytes of string 2 to do - INC A - RET NC ; Exit if end of string 2 - DEC D ; Count bytes in string 1 - DEC E ; Count bytes in string 2 - LD A,(BC) ; Byte in string 2 - CP (HL) ; Compare to byte in string 1 - INC HL ; Move up string 1 - INC BC ; Move up string 2 - JP Z,CMPSTR ; Same - Try next bytes - CCF ; Flag difference (">" or "<") - JP FLGDIF ; "<" gives -1 , ">" gives +1 - -CMPRES: INC A ; Increment current value - ADC A,A ; Double plus carry - POP BC ; Get other value - AND B ; Combine them - ADD A,-1 ; Carry set if different - SBC A,A ; 00 - Equal , FF - Different - JP FLGREL ; Set current value & continue - -EVNOT: LD D,5AH ; Precedence value for "NOT" - CALL EVAL1 ; Eval until precedence break - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 - 32767 - LD A,E ; Get LSB - CPL ; Invert LSB - LD C,A ; Save "NOT" of LSB - LD A,D ; Get MSB - CPL ; Invert MSB - CALL ACPASS ; Save AC as current - POP BC ; Clean up stack - JP EVAL3 ; Continue evaluation - -DIMRET: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - RET Z ; End of DIM statement - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' -DIM: LD BC,DIMRET ; Return to "DIMRET" - PUSH BC ; Save on stack - .BYTE 0F6H ; Flag "Create" variable -GETVAR: XOR A ; Find variable address,to DE - LD (LCRFLG),A ; Set locate / create flag - LD B,(HL) ; Get First byte of name -GTFNAM: CALL CHKLTR ; See if a letter - JP C,SNERR ; ?SN Error if not a letter - XOR A - LD C,A ; Clear second byte of name - LD (TYPE),A ; Set type to numeric - CALL GETCHR ; Get next character - JP C,SVNAM2 ; Numeric - Save in name - CALL CHKLTR ; See if a letter - JP C,CHARTY ; Not a letter - Check type -SVNAM2: LD C,A ; Save second byte of name -ENDNAM: CALL GETCHR ; Get next character - JP C,ENDNAM ; Numeric - Get another - CALL CHKLTR ; See if a letter - JP NC,ENDNAM ; Letter - Get another -CHARTY: SUB '$' ; String variable? - JP NZ,NOTSTR ; No - Numeric variable - INC A ; A = 1 (string type) - LD (TYPE),A ; Set type to string - RRCA ; A = 80H , Flag for string - ADD A,C ; 2nd byte of name has bit 7 on - LD C,A ; Resave second byte on name - CALL GETCHR ; Get next character -NOTSTR: LD A,(FORFLG) ; Array name needed ? - DEC A - JP Z,ARLDSV ; Yes - Get array name - JP P,NSCFOR ; No array with "FOR" or "FN" - LD A,(HL) ; Get byte again - SUB '(' ; Subscripted variable? - JP Z,SBSCPT ; Yes - Sort out subscript - -NSCFOR: XOR A ; Simple variable - LD (FORFLG),A ; Clear "FOR" flag - PUSH HL ; Save code string address - LD D,B ; DE = Variable name to find - LD E,C - LD HL,(FNRGNM) ; FN argument name - CALL CPDEHL ; Is it the FN argument? - LD DE,FNARG ; Point to argument value - JP Z,POPHRT ; Yes - Return FN argument value - LD HL,(VAREND) ; End of variables - EX DE,HL ; Address of end of search - LD HL,(PROGND) ; Start of variables address -FNDVAR: CALL CPDEHL ; End of variable list table? - JP Z,CFEVAL ; Yes - Called from EVAL? - LD A,C ; Get second byte of name - SUB (HL) ; Compare with name in list - INC HL ; Move on to first byte - JP NZ,FNTHR ; Different - Find another - LD A,B ; Get first byte of name - SUB (HL) ; Compare with name in list -FNTHR: INC HL ; Move on to LSB of value - JP Z,RETADR ; Found - Return address - INC HL ; <- Skip - INC HL ; <- over - INC HL ; <- F.P. - INC HL ; <- value - JP FNDVAR ; Keep looking - -CFEVAL: POP HL ; Restore code string address - EX (SP),HL ; Get return address - PUSH DE ; Save address of variable - LD DE,FRMEVL ; Return address in EVAL - CALL CPDEHL ; Called from EVAL ? - POP DE ; Restore address of variable - JP Z,RETNUL ; Yes - Return null variable - EX (SP),HL ; Put back return - PUSH HL ; Save code string address - PUSH BC ; Save variable name - LD BC,6 ; 2 byte name plus 4 byte data - LD HL,(ARREND) ; End of arrays - PUSH HL ; Save end of arrays - ADD HL,BC ; Move up 6 bytes - POP BC ; Source address in BC - PUSH HL ; Save new end address - CALL MOVUP ; Move arrays up - POP HL ; Restore new end address - LD (ARREND),HL ; Set new end address - LD H,B ; End of variables to HL - LD L,C - LD (VAREND),HL ; Set new end address - -ZEROLP: DEC HL ; Back through to zero variable - LD (HL),0 ; Zero byte in variable - CALL CPDEHL ; Done them all? - JP NZ,ZEROLP ; No - Keep on going - POP DE ; Get variable name - LD (HL),E ; Store second character - INC HL - LD (HL),D ; Store first character - INC HL -RETADR: EX DE,HL ; Address of variable in DE - POP HL ; Restore code string address - RET - -RETNUL: LD (FPEXP),A ; Set result to zero - LD HL,ZERBYT ; Also set a null string - LD (FPREG),HL ; Save for EVAL - POP HL ; Restore code string address - RET - -SBSCPT: PUSH HL ; Save code string address - LD HL,(LCRFLG) ; Locate/Create and Type - EX (SP),HL ; Save and get code string - LD D,A ; Zero number of dimensions -SCPTLP: PUSH DE ; Save number of dimensions - PUSH BC ; Save array name - CALL FPSINT ; Get subscript (0-32767) - POP BC ; Restore array name - POP AF ; Get number of dimensions - EX DE,HL - EX (SP),HL ; Save subscript value - PUSH HL ; Save LCRFLG and TYPE - EX DE,HL - INC A ; Count dimensions - LD D,A ; Save in D - LD A,(HL) ; Get next byte in code string - CP ',' ; Comma (more to come)? - JP Z,SCPTLP ; Yes - More subscripts - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - LD (NXTOPR),HL ; Save code string address - POP HL ; Get LCRFLG and TYPE - LD (LCRFLG),HL ; Restore Locate/create & type - LD E,0 ; Flag not CSAVE* or CLOAD* - PUSH DE ; Save number of dimensions (D) - .BYTE 11H ; Skip "PUSH HL" and "PUSH AF' - -ARLDSV: PUSH HL ; Save code string address - PUSH AF ; A = 00 , Flags set = Z,N - LD HL,(VAREND) ; Start of arrays - .BYTE 3EH ; Skip "ADD HL,DE" -FNDARY: ADD HL,DE ; Move to next array start - EX DE,HL - LD HL,(ARREND) ; End of arrays - EX DE,HL ; Current array pointer - CALL CPDEHL ; End of arrays found? - JP Z,CREARY ; Yes - Create array - LD A,(HL) ; Get second byte of name - CP C ; Compare with name given - INC HL ; Move on - JP NZ,NXTARY ; Different - Find next array - LD A,(HL) ; Get first byte of name - CP B ; Compare with name given -NXTARY: INC HL ; Move on - LD E,(HL) ; Get LSB of next array address - INC HL - LD D,(HL) ; Get MSB of next array address - INC HL - JP NZ,FNDARY ; Not found - Keep looking - LD A,(LCRFLG) ; Found Locate or Create it? - OR A - JP NZ,DDERR ; Create - ?DD Error - POP AF ; Locate - Get number of dim'ns - LD B,H ; BC Points to array dim'ns - LD C,L - JP Z,POPHRT ; Jump if array load/save - SUB (HL) ; Same number of dimensions? - JP Z,FINDEL ; Yes - Find element -BSERR: LD E,BS ; ?BS Error - JP ERROR ; Output error - -CREARY: LD DE,4 ; 4 Bytes per entry - POP AF ; Array to save or 0 dim'ns? - JP Z,FCERR ; Yes - ?FC Error - LD (HL),C ; Save second byte of name - INC HL - LD (HL),B ; Save first byte of name - INC HL - LD C,A ; Number of dimensions to C - CALL CHKSTK ; Check if enough memory - INC HL ; Point to number of dimensions - INC HL - LD (CUROPR),HL ; Save address of pointer - LD (HL),C ; Set number of dimensions - INC HL - LD A,(LCRFLG) ; Locate of Create? - RLA ; Carry set = Create - LD A,C ; Get number of dimensions -CRARLP: LD BC,10+1 ; Default dimension size 10 - JP NC,DEFSIZ ; Locate - Set default size - POP BC ; Get specified dimension size - INC BC ; Include zero element -DEFSIZ: LD (HL),C ; Save LSB of dimension size - INC HL - LD (HL),B ; Save MSB of dimension size - INC HL - PUSH AF ; Save num' of dim'ns an status - PUSH HL ; Save address of dim'n size - CALL MLDEBC ; Multiply DE by BC to find - EX DE,HL ; amount of mem needed (to DE) - POP HL ; Restore address of dimension - POP AF ; Restore number of dimensions - DEC A ; Count them - JP NZ,CRARLP ; Do next dimension if more - PUSH AF ; Save locate/create flag - LD B,D ; MSB of memory needed - LD C,E ; LSB of memory needed - EX DE,HL - ADD HL,DE ; Add bytes to array start - JP C,OMERR ; Too big - Error - CALL ENFMEM ; See if enough memory - LD (ARREND),HL ; Save new end of array - -ZERARY: DEC HL ; Back through array data - LD (HL),0 ; Set array element to zero - CALL CPDEHL ; All elements zeroed? - JP NZ,ZERARY ; No - Keep on going - INC BC ; Number of bytes + 1 - LD D,A ; A=0 - LD HL,(CUROPR) ; Get address of array - LD E,(HL) ; Number of dimensions - EX DE,HL ; To HL - ADD HL,HL ; Two bytes per dimension size - ADD HL,BC ; Add number of bytes - EX DE,HL ; Bytes needed to DE - DEC HL - DEC HL - LD (HL),E ; Save LSB of bytes needed - INC HL - LD (HL),D ; Save MSB of bytes needed - INC HL - POP AF ; Locate / Create? - JP C,ENDDIM ; A is 0 , End if create -FINDEL: LD B,A ; Find array element - LD C,A - LD A,(HL) ; Number of dimensions - INC HL - .BYTE 16H ; Skip "POP HL" -FNDELP: POP HL ; Address of next dim' size - LD E,(HL) ; Get LSB of dim'n size - INC HL - LD D,(HL) ; Get MSB of dim'n size - INC HL - EX (SP),HL ; Save address - Get index - PUSH AF ; Save number of dim'ns - CALL CPDEHL ; Dimension too large? - JP NC,BSERR ; Yes - ?BS Error - PUSH HL ; Save index - CALL MLDEBC ; Multiply previous by size - POP DE ; Index supplied to DE - ADD HL,DE ; Add index to pointer - POP AF ; Number of dimensions - DEC A ; Count them - LD B,H ; MSB of pointer - LD C,L ; LSB of pointer - JP NZ,FNDELP ; More - Keep going - ADD HL,HL ; 4 Bytes per element - ADD HL,HL - POP BC ; Start of array - ADD HL,BC ; Point to element - EX DE,HL ; Address of element to DE -ENDDIM: LD HL,(NXTOPR) ; Got code string address - RET - -FRE: LD HL,(ARREND) ; Start of free memory - EX DE,HL ; To DE - LD HL,0 ; End of free memory - ADD HL,SP ; Current stack value - LD A,(TYPE) ; Dummy argument type - OR A - JP Z,FRENUM ; Numeric - Free variable space - CALL GSTRCU ; Current string to pool - CALL GARBGE ; Garbage collection - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string space -FRENUM: LD A,L ; Get LSB of end - SUB E ; Subtract LSB of beginning - LD C,A ; Save difference if C - LD A,H ; Get MSB of end - SBC A,D ; Subtract MSB of beginning -ACPASS: LD B,C ; Return integer AC -ABPASS: LD D,B ; Return integer AB - LD E,0 - LD HL,TYPE ; Point to type - LD (HL),E ; Set type to numeric - LD B,80H+16 ; 16 bit integer - JP RETINT ; Return the integr - -POS: LD A,(CURPOS) ; Get cursor position -PASSA: LD B,A ; Put A into AB - XOR A ; Zero A - JP ABPASS ; Return integer AB - -DEF: CALL CHEKFN ; Get "FN" and name - CALL IDTEST ; Test for illegal direct - LD BC,DATA ; To get next statement - PUSH BC ; Save address for RETurn - PUSH DE ; Save address of function ptr - CALL CHKSYN ; Make sure "(" follows - .BYTE "(" - CALL GETVAR ; Get argument variable name - PUSH HL ; Save code string address - EX DE,HL ; Argument address to HL - DEC HL - LD D,(HL) ; Get first byte of arg name - DEC HL - LD E,(HL) ; Get second byte of arg name - POP HL ; Restore code string address - CALL TSTNUM ; Make sure numeric argument - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - CALL CHKSYN ; Make sure "=" follows - .BYTE ZEQUAL ; "=" token - LD B,H ; Code string address to BC - LD C,L - EX (SP),HL ; Save code str , Get FN ptr - LD (HL),C ; Save LSB of FN code string - INC HL - LD (HL),B ; Save MSB of FN code string - JP SVSTAD ; Save address and do function - -DOFN: CALL CHEKFN ; Make sure FN follows - PUSH DE ; Save function pointer address - CALL EVLPAR ; Evaluate expression in "()" - CALL TSTNUM ; Make sure numeric result - EX (SP),HL ; Save code str , Get FN ptr - LD E,(HL) ; Get LSB of FN code string - INC HL - LD D,(HL) ; Get MSB of FN code string - INC HL - LD A,D ; And function DEFined? - OR E - JP Z,UFERR ; No - ?UF Error - LD A,(HL) ; Get LSB of argument address - INC HL - LD H,(HL) ; Get MSB of argument address - LD L,A ; HL = Arg variable address - PUSH HL ; Save it - LD HL,(FNRGNM) ; Get old argument name - EX (SP),HL ; ; Save old , Get new - LD (FNRGNM),HL ; Set new argument name - LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value - PUSH HL ; Save it - LD HL,(FNARG) ; Get MSB,EXP of old arg value - PUSH HL ; Save it - LD HL,FNARG ; HL = Value of argument - PUSH DE ; Save FN code string address - CALL FPTHL ; Move FPREG to argument - POP HL ; Get FN code string address - CALL GETNUM ; Get value from function - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,SNERR ; Bad character in FN - Error - POP HL ; Get MSB,EXP of old arg - LD (FNARG),HL ; Restore it - POP HL ; Get LSB,NLSB of old arg - LD (FNARG+2),HL ; Restore it - POP HL ; Get name of old arg - LD (FNRGNM),HL ; Restore it - POP HL ; Restore code string address - RET - -IDTEST: PUSH HL ; Save code string address - LD HL,(LINEAT) ; Get current line number - INC HL ; -1 means direct statement - LD A,H - OR L - POP HL ; Restore code string address - RET NZ ; Return if in program - LD E,ID ; ?ID Error - JP ERROR - -CHEKFN: CALL CHKSYN ; Make sure FN follows - .BYTE ZFN ; "FN" token - LD A,80H - LD (FORFLG),A ; Flag FN name to find - OR (HL) ; FN name has bit 7 set - LD B,A ; in first byte of name - CALL GTFNAM ; Get FN name - JP TSTNUM ; Make sure numeric function - -STR: CALL TSTNUM ; Make sure it's a number - CALL NUMASC ; Turn number into text -STR1: CALL CRTST ; Create string entry for it - CALL GSTRCU ; Current string to pool - LD BC,TOPOOL ; Save in string pool - PUSH BC ; Save address on stack - -SAVSTR: LD A,(HL) ; Get string length - INC HL - INC HL - PUSH HL ; Save pointer to string - CALL TESTR ; See if enough string space - POP HL ; Restore pointer to string - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - CALL CRTMST ; Create string entry - PUSH HL ; Save pointer to MSB of addr - LD L,A ; Length of string - CALL TOSTRA ; Move to string area - POP DE ; Restore pointer to MSB - RET - -MKTMST: CALL TESTR ; See if enough string space -CRTMST: LD HL,TMPSTR ; Temporary string - PUSH HL ; Save it - LD (HL),A ; Save length of string - INC HL -SVSTAD: INC HL - LD (HL),E ; Save LSB of address - INC HL - LD (HL),D ; Save MSB of address - POP HL ; Restore pointer - RET - -CRTST: DEC HL ; DEC - INCed after -QTSTR: LD B,'"' ; Terminating quote - LD D,B ; Quote to D -DTSTR: PUSH HL ; Save start - LD C,-1 ; Set counter to -1 -QTSTLP: INC HL ; Move on - LD A,(HL) ; Get byte - INC C ; Count bytes - OR A ; End of line? - JP Z,CRTSTE ; Yes - Create string entry - CP D ; Terminator D found? - JP Z,CRTSTE ; Yes - Create string entry - CP B ; Terminator B found? - JP NZ,QTSTLP ; No - Keep looking -CRTSTE: CP '"' ; End with '"'? - CALL Z,GETCHR ; Yes - Get next character - EX (SP),HL ; Starting quote - INC HL ; First byte of string - EX DE,HL ; To DE - LD A,C ; Get length - CALL CRTMST ; Create string entry -TSTOPL: LD DE,TMPSTR ; Temporary string - LD HL,(TMSTPT) ; Temporary string pool pointer - LD (FPREG),HL ; Save address of string ptr - LD A,1 - LD (TYPE),A ; Set type to string - CALL DETHL4 ; Move string to pool - CALL CPDEHL ; Out of string pool? - LD (TMSTPT),HL ; Save new pointer - POP HL ; Restore code string address - LD A,(HL) ; Get next code byte - RET NZ ; Return if pool OK - LD E,ST ; ?ST Error - JP ERROR ; String pool overflow - -PRNUMS: INC HL ; Skip leading space -PRS: CALL CRTST ; Create string entry for it -PRS1: CALL GSTRCU ; Current string to pool - CALL LOADFP ; Move string block to BCDE - INC E ; Length + 1 -PRSLP: DEC E ; Count characters - RET Z ; End of string - LD A,(BC) ; Get byte to output - CALL OUTC ; Output character in A - CP CR ; Return? - CALL Z,DONULL ; Yes - Do nulls - INC BC ; Next byte in string - JP PRSLP ; More characters to output - -TESTR: OR A ; Test if enough room - .BYTE 0EH ; No garbage collection done -GRBDON: POP AF ; Garbage collection done - PUSH AF ; Save status - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string area - CPL ; Negate length (Top down) - LD C,A ; -Length to BC - LD B,-1 ; BC = -ve length of string - ADD HL,BC ; Add to bottom of space in use - INC HL ; Plus one for 2's complement - CALL CPDEHL ; Below string RAM area? - JP C,TESTOS ; Tidy up if not done else err - LD (STRBOT),HL ; Save new bottom of area - INC HL ; Point to first byte of string - EX DE,HL ; Address to DE -POPAF: POP AF ; Throw away status push - RET - -TESTOS: POP AF ; Garbage collect been done? - LD E,OS ; ?OS Error - JP Z,ERROR ; Yes - Not enough string apace - CP A ; Flag garbage collect done - PUSH AF ; Save status - LD BC,GRBDON ; Garbage collection done - PUSH BC ; Save for RETurn -GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer -GARBLP: LD (STRBOT),HL ; Reset string pointer - LD HL,0 - PUSH HL ; Flag no string found - LD HL,(STRSPC) ; Get bottom of string space - PUSH HL ; Save bottom of string space - LD HL,TMSTPL ; Temporary string pool -GRBLP: EX DE,HL - LD HL,(TMSTPT) ; Temporary string pool pointer - EX DE,HL - CALL CPDEHL ; Temporary string pool done? - LD BC,GRBLP ; Loop until string pool done - JP NZ,STPOOL ; No - See if in string area - LD HL,(PROGND) ; Start of simple variables -SMPVAR: EX DE,HL - LD HL,(VAREND) ; End of simple variables - EX DE,HL - CALL CPDEHL ; All simple strings done? - JP Z,ARRLP ; Yes - Do string arrays - LD A,(HL) ; Get type of variable - INC HL - INC HL - OR A ; "S" flag set if string - CALL STRADD ; See if string in string area - JP SMPVAR ; Loop until simple ones done - -GNXARY: POP BC ; Scrap address of this array -ARRLP: EX DE,HL - LD HL,(ARREND) ; End of string arrays - EX DE,HL - CALL CPDEHL ; All string arrays done? - JP Z,SCNEND ; Yes - Move string if found - CALL LOADFP ; Get array name to BCDE - LD A,E ; Get type of array - PUSH HL ; Save address of num of dim'ns - ADD HL,BC ; Start of next array - OR A ; Test type of array - JP P,GNXARY ; Numeric array - Ignore it - LD (CUROPR),HL ; Save address of next array - POP HL ; Get address of num of dim'ns - LD C,(HL) ; BC = Number of dimensions - LD B,0 - ADD HL,BC ; Two bytes per dimension size - ADD HL,BC - INC HL ; Plus one for number of dim'ns -GRBARY: EX DE,HL - LD HL,(CUROPR) ; Get address of next array - EX DE,HL - CALL CPDEHL ; Is this array finished? - JP Z,ARRLP ; Yes - Get next one - LD BC,GRBARY ; Loop until array all done -STPOOL: PUSH BC ; Save return address - OR 80H ; Flag string type -STRADD: LD A,(HL) ; Get string length - INC HL - INC HL - LD E,(HL) ; Get LSB of string address - INC HL - LD D,(HL) ; Get MSB of string address - INC HL - RET P ; Not a string - Return - OR A ; Set flags on string length - RET Z ; Null string - Return - LD B,H ; Save variable pointer - LD C,L - LD HL,(STRBOT) ; Bottom of new area - CALL CPDEHL ; String been done? - LD H,B ; Restore variable pointer - LD L,C - RET C ; String done - Ignore - POP HL ; Return address - EX (SP),HL ; Lowest available string area - CALL CPDEHL ; String within string area? - EX (SP),HL ; Lowest available string area - PUSH HL ; Re-save return address - LD H,B ; Restore variable pointer - LD L,C - RET NC ; Outside string area - Ignore - POP BC ; Get return , Throw 2 away - POP AF ; - POP AF ; - PUSH HL ; Save variable pointer - PUSH DE ; Save address of current - PUSH BC ; Put back return address - RET ; Go to it - -SCNEND: POP DE ; Addresses of strings - POP HL ; - LD A,L ; HL = 0 if no more to do - OR H - RET Z ; No more to do - Return - DEC HL - LD B,(HL) ; MSB of address of string - DEC HL - LD C,(HL) ; LSB of address of string - PUSH HL ; Save variable address - DEC HL - DEC HL - LD L,(HL) ; HL = Length of string - LD H,0 - ADD HL,BC ; Address of end of string+1 - LD D,B ; String address to DE - LD E,C - DEC HL ; Last byte in string - LD B,H ; Address to BC - LD C,L - LD HL,(STRBOT) ; Current bottom of string area - CALL MOVSTR ; Move string to new address - POP HL ; Restore variable address - LD (HL),C ; Save new LSB of address - INC HL - LD (HL),B ; Save new MSB of address - LD L,C ; Next string area+1 to HL - LD H,B - DEC HL ; Next string area address - JP GARBLP ; Look for more strings - -CONCAT: PUSH BC ; Save prec' opr & code string - PUSH HL ; - LD HL,(FPREG) ; Get first string - EX (SP),HL ; Save first string - CALL OPRND ; Get second string - EX (SP),HL ; Restore first string - CALL TSTSTR ; Make sure it's a string - LD A,(HL) ; Get length of second string - PUSH HL ; Save first string - LD HL,(FPREG) ; Get second string - PUSH HL ; Save second string - ADD A,(HL) ; Add length of second string - LD E,LS ; ?LS Error - JP C,ERROR ; String too long - Error - CALL MKTMST ; Make temporary string - POP DE ; Get second string to DE - CALL GSTRDE ; Move to string pool if needed - EX (SP),HL ; Get first string - CALL GSTRHL ; Move to string pool if needed - PUSH HL ; Save first string - LD HL,(TMPSTR+2) ; Temporary string address - EX DE,HL ; To DE - CALL SSTSA ; First string to string area - CALL SSTSA ; Second string to string area - LD HL,EVAL2 ; Return to evaluation loop - EX (SP),HL ; Save return,get code string - PUSH HL ; Save code string address - JP TSTOPL ; To temporary string to pool - -SSTSA: POP HL ; Return address - EX (SP),HL ; Get string block,save return - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of string address - INC HL - LD B,(HL) ; Get MSB of string address - LD L,A ; Length to L -TOSTRA: INC L ; INC - DECed after -TSALP: DEC L ; Count bytes moved - RET Z ; End of string - Return - LD A,(BC) ; Get source - LD (DE),A ; Save destination - INC BC ; Next source - INC DE ; Next destination - JP TSALP ; Loop until string moved - -GETSTR: CALL TSTSTR ; Make sure it's a string -GSTRCU: LD HL,(FPREG) ; Get current string -GSTRHL: EX DE,HL ; Save DE -GSTRDE: CALL BAKTMP ; Was it last tmp-str? - EX DE,HL ; Restore DE - RET NZ ; No - Return - PUSH DE ; Save string - LD D,B ; String block address to DE - LD E,C - DEC DE ; Point to length - LD C,(HL) ; Get string length - LD HL,(STRBOT) ; Current bottom of string area - CALL CPDEHL ; Last one in string area? - JP NZ,POPHL ; No - Return - LD B,A ; Clear B (A=0) - ADD HL,BC ; Remove string from str' area - LD (STRBOT),HL ; Save new bottom of str' area -POPHL: POP HL ; Restore string - RET - -BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top - DEC HL ; Back - LD B,(HL) ; Get MSB of address - DEC HL ; Back - LD C,(HL) ; Get LSB of address - DEC HL ; Back - DEC HL ; Back - CALL CPDEHL ; String last in string pool? - RET NZ ; Yes - Leave it - LD (TMSTPT),HL ; Save new string pool top - RET - -LEN: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GETLEN: CALL GETSTR ; Get string and its length - XOR A - LD D,A ; Clear D - LD (TYPE),A ; Set type to numeric - LD A,(HL) ; Get length of string - OR A ; Set status flags - RET - -ASC: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GTFLNM: CALL GETLEN ; Get length of string - JP Z,FCERR ; Null string - Error - INC HL - INC HL - LD E,(HL) ; Get LSB of address - INC HL - LD D,(HL) ; Get MSB of address - LD A,(DE) ; Get first byte of string - RET - -CHR: LD A,1 ; One character string - CALL MKTMST ; Make a temporary string - CALL MAKINT ; Make it integer A - LD HL,(TMPSTR+2) ; Get address of string - LD (HL),E ; Save character -TOPOOL: POP BC ; Clean up stack - JP TSTOPL ; Temporary string to pool - -LEFT: CALL LFRGNM ; Get number and ending ")" - XOR A ; Start at first byte in string -RIGHT1: EX (SP),HL ; Save code string,Get string - LD C,A ; Starting position in string -MID1: PUSH HL ; Save string block address - LD A,(HL) ; Get length of string - CP B ; Compare with number given - JP C,ALLFOL ; All following bytes required - LD A,B ; Get new length - .BYTE 11H ; Skip "LD C,0" -ALLFOL: LD C,0 ; First byte of string - PUSH BC ; Save position in string - CALL TESTR ; See if enough string space - POP BC ; Get position in string - POP HL ; Restore string block address - PUSH HL ; And re-save it - INC HL - INC HL - LD B,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,B ; HL = address of string - LD B,0 ; BC = starting address - ADD HL,BC ; Point to that byte - LD B,H ; BC = source string - LD C,L - CALL CRTMST ; Create a string entry - LD L,A ; Length of new string - CALL TOSTRA ; Move string to string area - POP DE ; Clear stack - CALL GSTRDE ; Move to string pool if needed - JP TSTOPL ; Temporary string to pool - -RIGHT: CALL LFRGNM ; Get number and ending ")" - POP DE ; Get string length - PUSH DE ; And re-save - LD A,(DE) ; Get length - SUB B ; Move back N bytes - JP RIGHT1 ; Go and get sub-string - -MID: EX DE,HL ; Get code string address - LD A,(HL) ; Get next byte ',' or ")" - CALL MIDNUM ; Get number supplied - INC B ; Is it character zero? - DEC B - JP Z,FCERR ; Yes - Error - PUSH BC ; Save starting position - LD E,255 ; All of string - CP ')' ; Any length given? - JP Z,RSTSTR ; No - Rest of string - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETINT ; Get integer 0-255 -RSTSTR: CALL CHKSYN ; Make sure ")" follows - .BYTE ")" - POP AF ; Restore starting position - EX (SP),HL ; Get string,8ave code string - LD BC,MID1 ; Continuation of MID$ routine - PUSH BC ; Save for return - DEC A ; Starting position-1 - CP (HL) ; Compare with length - LD B,0 ; Zero bytes length - RET NC ; Null string if start past end - LD C,A ; Save starting position-1 - LD A,(HL) ; Get length of string - SUB C ; Subtract start - CP E ; Enough string for it? - LD B,A ; Save maximum length available - RET C ; Truncate string if needed - LD B,E ; Set specified length - RET ; Go and create string - -VAL: CALL GETLEN ; Get length of string - JP Z,RESZER ; Result zero - LD E,A ; Save length - INC HL - INC HL - LD A,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,A ; HL = String address - PUSH HL ; Save string address - ADD HL,DE - LD B,(HL) ; Get end of string+1 byte - LD (HL),D ; Zero it to terminate - EX (SP),HL ; Save string end,get start - PUSH BC ; Save end+1 byte - LD A,(HL) ; Get starting byte - CP '$' ; Hex number indicated? [function added] - JP NZ,VAL1 - CALL HEXTFP ; Convert Hex to FPREG - JR VAL3 -VAL1: CP '%' ; Binary number indicated? [function added] - JP NZ,VAL2 - CALL BINTFP ; Convert Bin to FPREG - JR VAL3 -VAL2: CALL ASCTFP ; Convert ASCII string to FP -VAL3: POP BC ; Restore end+1 byte - POP HL ; Restore end+1 address - LD (HL),B ; Put back original byte - RET - -LFRGNM: EX DE,HL ; Code string address to HL - CALL CHKSYN ; Make sure ")" follows - .BYTE ")" -MIDNUM: POP BC ; Get return address - POP DE ; Get number supplied - PUSH BC ; Re-save return address - LD B,E ; Number to B - RET - -INP: CALL MAKINT ; Make it integer A - LD (INPORT),A ; Set input port - CALL INPSUB ; Get input from port - JP PASSA ; Return integer A - -POUT: CALL SETIO ; Set up port number - JP OUTSUB ; Output data and return - -WAIT: CALL SETIO ; Set up port number - PUSH AF ; Save AND mask - LD E,0 ; Assume zero if none given - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,NOXOR ; No XOR byte given - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETINT ; Get integer 0-255 to XOR with -NOXOR: POP BC ; Restore AND mask -WAITLP: CALL INPSUB ; Get input - XOR E ; Flip selected bits - AND B ; Result non-zero? - JP Z,WAITLP ; No = keep waiting - RET - -SETIO: CALL GETINT ; Get integer 0-255 - LD (INPORT),A ; Set input port - LD (OTPORT),A ; Set output port - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - JP GETINT ; Get integer 0-255 and return - -FNDNUM: CALL GETCHR ; Get next character -GETINT: CALL GETNUM ; Get a number from 0 to 255 -MAKINT: CALL DEPINT ; Make sure value 0 - 255 - LD A,D ; Get MSB of number - OR A ; Zero? - JP NZ,FCERR ; No - Error - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - LD A,E ; Get number to A - RET - -PEEK: CALL DEINT ; Get memory address - LD A,(DE) ; Get byte in memory - JP PASSA ; Return integer A - -POKE: CALL GETNUM ; Get memory address - CALL DEINT ; Get integer -32768 to 3276 - PUSH DE ; Save memory address - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETINT ; Get integer 0-255 - POP DE ; Restore memory address - LD (DE),A ; Load it into memory - RET - -ROUND: LD HL,HALF ; Add 0.5 to FPREG -ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE - JP FPADD ; Add BCDE to FPREG - -SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL - .BYTE 21H ; Skip "POP BC" and "POP DE" -PSUB: POP BC ; Get FP number from stack - POP DE -SUBCDE: CALL INVSGN ; Negate FPREG -FPADD: LD A,B ; Get FP exponent - OR A ; Is number zero? - RET Z ; Yes - Nothing to add - LD A,(FPEXP) ; Get FPREG exponent - OR A ; Is this number zero? - JP Z,FPBCDE ; Yes - Move BCDE to FPREG - SUB B ; BCDE number larger? - JP NC,NOSWAP ; No - Don't swap them - CPL ; Two's complement - INC A ; FP exponent - EX DE,HL - CALL STAKFP ; Put FPREG on stack - EX DE,HL - CALL FPBCDE ; Move BCDE to FPREG - POP BC ; Restore number from stack - POP DE -NOSWAP: CP 24+1 ; Second number insignificant? - RET NC ; Yes - First number is result - PUSH AF ; Save number of bits to scale - CALL SIGNS ; Set MSBs & sign of result - LD H,A ; Save sign of result - POP AF ; Restore scaling factor - CALL SCALE ; Scale BCDE to same exponent - OR H ; Result to be positive? - LD HL,FPREG ; Point to FPREG - JP P,MINCDE ; No - Subtract FPREG from CDE - CALL PLUCDE ; Add FPREG to CDE - JP NC,RONDUP ; No overflow - Round it up - INC HL ; Point to exponent - INC (HL) ; Increment it - JP Z,OVERR ; Number overflowed - Error - LD L,1 ; 1 bit to shift right - CALL SHRT1 ; Shift result right - JP RONDUP ; Round it up - -MINCDE: XOR A ; Clear A and carry - SUB B ; Negate exponent - LD B,A ; Re-save exponent - LD A,(HL) ; Get LSB of FPREG - SBC A, E ; Subtract LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - SBC A,D ; Subtract NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - SBC A,C ; Subtract MSB of BCDE - LD C,A ; Save MSB of BCDE -CONPOS: CALL C,COMPL ; Overflow - Make it positive - -BNORM: LD L,B ; L = Exponent - LD H,E ; H = LSB - XOR A -BNRMLP: LD B,A ; Save bit count - LD A,C ; Get MSB - OR A ; Is it zero? - JP NZ,PNORM ; No - Do it bit at a time - LD C,D ; MSB = NMSB - LD D,H ; NMSB= LSB - LD H,L ; LSB = VLSB - LD L,A ; VLSB= 0 - LD A,B ; Get exponent - SUB 8 ; Count 8 bits - CP -24-8 ; Was number zero? - JP NZ,BNRMLP ; No - Keep normalising -RESZER: XOR A ; Result is zero -SAVEXP: LD (FPEXP),A ; Save result as zero - RET - -NORMAL: DEC B ; Count bits - ADD HL,HL ; Shift HL left - LD A,D ; Get NMSB - RLA ; Shift left with last bit - LD D,A ; Save NMSB - LD A,C ; Get MSB - ADC A,A ; Shift left with last bit - LD C,A ; Save MSB -PNORM: JP P,NORMAL ; Not done - Keep going - LD A,B ; Number of bits shifted - LD E,H ; Save HL in EB - LD B,L - OR A ; Any shifting done? - JP Z,RONDUP ; No - Round it up - LD HL,FPEXP ; Point to exponent - ADD A,(HL) ; Add shifted bits - LD (HL),A ; Re-save exponent - JP NC,RESZER ; Underflow - Result is zero - RET Z ; Result is zero -RONDUP: LD A,B ; Get VLSB of number -RONDB: LD HL,FPEXP ; Point to exponent - OR A ; Any rounding? - CALL M,FPROND ; Yes - Round number up - LD B,(HL) ; B = Exponent - INC HL - LD A,(HL) ; Get sign of result - AND 10000000B ; Only bit 7 needed - XOR C ; Set correct sign - LD C,A ; Save correct sign in number - JP FPBCDE ; Move BCDE to FPREG - -FPROND: INC E ; Round LSB - RET NZ ; Return if ok - INC D ; Round NMSB - RET NZ ; Return if ok - INC C ; Round MSB - RET NZ ; Return if ok - LD C,80H ; Set normal value - INC (HL) ; Increment exponent - RET NZ ; Return if ok - JP OVERR ; Overflow error - -PLUCDE: LD A,(HL) ; Get LSB of FPREG - ADD A,E ; Add LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - ADC A,D ; Add NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - ADC A,C ; Add MSB of BCDE - LD C,A ; Save MSB of BCDE - RET - -COMPL: LD HL,SGNRES ; Sign of result - LD A,(HL) ; Get sign of result - CPL ; Negate it - LD (HL),A ; Put it back - XOR A - LD L,A ; Set L to zero - SUB B ; Negate exponent,set carry - LD B,A ; Re-save exponent - LD A,L ; Load zero - SBC A,E ; Negate LSB - LD E,A ; Re-save LSB - LD A,L ; Load zero - SBC A,D ; Negate NMSB - LD D,A ; Re-save NMSB - LD A,L ; Load zero - SBC A,C ; Negate MSB - LD C,A ; Re-save MSB - RET - -SCALE: LD B,0 ; Clear underflow -SCALLP: SUB 8 ; 8 bits (a whole byte)? - JP C,SHRITE ; No - Shift right A bits - LD B,E ; <- Shift - LD E,D ; <- right - LD D,C ; <- eight - LD C,0 ; <- bits - JP SCALLP ; More bits to shift - -SHRITE: ADD A,8+1 ; Adjust count - LD L,A ; Save bits to shift -SHRLP: XOR A ; Flag for all done - DEC L ; All shifting done? - RET Z ; Yes - Return - LD A,C ; Get MSB -SHRT1: RRA ; Shift it right - LD C,A ; Re-save - LD A,D ; Get NMSB - RRA ; Shift right with last bit - LD D,A ; Re-save it - LD A,E ; Get LSB - RRA ; Shift right with last bit - LD E,A ; Re-save it - LD A,B ; Get underflow - RRA ; Shift right with last bit - LD B,A ; Re-save underflow - JP SHRLP ; More bits to do - -UNITY: .BYTE 000H,000H,000H,081H ; 1.00000 - -LOGTAB: .BYTE 3 ; Table used by LOG - .BYTE 0AAH,056H,019H,080H ; 0.59898 - .BYTE 0F1H,022H,076H,080H ; 0.96147 - .BYTE 045H,0AAH,038H,082H ; 2.88539 - -LOG: CALL TSTSGN ; Test sign of value - OR A - JP PE,FCERR ; ?FC Error if <= zero - LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - LD BC,8035H ; BCDE = SQR(1/2) - LD DE,04F3H - SUB B ; Scale value to be < 1 - PUSH AF ; Save scale factor - LD (HL),B ; Save new exponent - PUSH DE ; Save SQR(1/2) - PUSH BC - CALL FPADD ; Add SQR(1/2) to value - POP BC ; Restore SQR(1/2) - POP DE - INC B ; Make it SQR(2) - CALL DVBCDE ; Divide by SQR(2) - LD HL,UNITY ; Point to 1. - CALL SUBPHL ; Subtract FPREG from 1 - LD HL,LOGTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD BC,8080H ; BCDE = -0.5 - LD DE,0000H - CALL FPADD ; Subtract 0.5 from FPREG - POP AF ; Restore scale factor - CALL RSCALE ; Re-scale number -MULLN2: LD BC,8031H ; BCDE = Ln(2) - LD DE,7218H - .BYTE 21H ; Skip "POP BC" and "POP DE" - -MULT: POP BC ; Get number from stack - POP DE -FPMULT: CALL TSTSGN ; Test sign of FPREG - RET Z ; Return zero if zero - LD L,0 ; Flag add exponents - CALL ADDEXP ; Add exponents - LD A,C ; Get MSB of multiplier - LD (MULVAL),A ; Save MSB of multiplier - EX DE,HL - LD (MULVAL+1),HL ; Save rest of multiplier - LD BC,0 ; Partial product (BCDE) = zero - LD D,B - LD E,B - LD HL,BNORM ; Address of normalise - PUSH HL ; Save for return - LD HL,MULT8 ; Address of 8 bit multiply - PUSH HL ; Save for NMSB,MSB - PUSH HL ; - LD HL,FPREG ; Point to number -MULT8: LD A,(HL) ; Get LSB of number - INC HL ; Point to NMSB - OR A ; Test LSB - JP Z,BYTSFT ; Zero - shift to next byte - PUSH HL ; Save address of number - LD L,8 ; 8 bits to multiply by -MUL8LP: RRA ; Shift LSB right - LD H,A ; Save LSB - LD A,C ; Get MSB - JP NC,NOMADD ; Bit was zero - Don't add - PUSH HL ; Save LSB and count - LD HL,(MULVAL+1) ; Get LSB and NMSB - ADD HL,DE ; Add NMSB and LSB - EX DE,HL ; Leave sum in DE - POP HL ; Restore MSB and count - LD A,(MULVAL) ; Get MSB of multiplier - ADC A,C ; Add MSB -NOMADD: RRA ; Shift MSB right - LD C,A ; Re-save MSB - LD A,D ; Get NMSB - RRA ; Shift NMSB right - LD D,A ; Re-save NMSB - LD A,E ; Get LSB - RRA ; Shift LSB right - LD E,A ; Re-save LSB - LD A,B ; Get VLSB - RRA ; Shift VLSB right - LD B,A ; Re-save VLSB - DEC L ; Count bits multiplied - LD A,H ; Get LSB of multiplier - JP NZ,MUL8LP ; More - Do it -POPHRT: POP HL ; Restore address of number - RET - -BYTSFT: LD B,E ; Shift partial product left - LD E,D - LD D,C - LD C,A - RET - -DIV10: CALL STAKFP ; Save FPREG on stack - LD BC,8420H ; BCDE = 10. - LD DE,0000H - CALL FPBCDE ; Move 10 to FPREG - -DIV: POP BC ; Get number from stack - POP DE -DVBCDE: CALL TSTSGN ; Test sign of FPREG - JP Z,DZERR ; Error if division by zero - LD L,-1 ; Flag subtract exponents - CALL ADDEXP ; Subtract exponents - INC (HL) ; Add 2 to exponent to adjust - INC (HL) - DEC HL ; Point to MSB - LD A,(HL) ; Get MSB of dividend - LD (DIV3),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get NMSB of dividend - LD (DIV2),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get MSB of dividend - LD (DIV1),A ; Save for subtraction - LD B,C ; Get MSB - EX DE,HL ; NMSB,LSB to HL - XOR A - LD C,A ; Clear MSB of quotient - LD D,A ; Clear NMSB of quotient - LD E,A ; Clear LSB of quotient - LD (DIV4),A ; Clear overflow count -DIVLP: PUSH HL ; Save divisor - PUSH BC - LD A,L ; Get LSB of number - CALL DIVSUP ; Subt' divisor from dividend - SBC A,0 ; Count for overflows - CCF - JP NC,RESDIV ; Restore divisor if borrow - LD (DIV4),A ; Re-save overflow count - POP AF ; Scrap divisor - POP AF - SCF ; Set carry to - .BYTE 0D2H ; Skip "POP BC" and "POP HL" - -RESDIV: POP BC ; Restore divisor - POP HL - LD A,C ; Get MSB of quotient - INC A - DEC A - RRA ; Bit 0 to bit 7 - JP M,RONDB ; Done - Normalise result - RLA ; Restore carry - LD A,E ; Get LSB of quotient - RLA ; Double it - LD E,A ; Put it back - LD A,D ; Get NMSB of quotient - RLA ; Double it - LD D,A ; Put it back - LD A,C ; Get MSB of quotient - RLA ; Double it - LD C,A ; Put it back - ADD HL,HL ; Double NMSB,LSB of divisor - LD A,B ; Get MSB of divisor - RLA ; Double it - LD B,A ; Put it back - LD A,(DIV4) ; Get VLSB of quotient - RLA ; Double it - LD (DIV4),A ; Put it back - LD A,C ; Get MSB of quotient - OR D ; Merge NMSB - OR E ; Merge LSB - JP NZ,DIVLP ; Not done - Keep dividing - PUSH HL ; Save divisor - LD HL,FPEXP ; Point to exponent - DEC (HL) ; Divide by 2 - POP HL ; Restore divisor - JP NZ,DIVLP ; Ok - Keep going - JP OVERR ; Overflow error - -ADDEXP: LD A,B ; Get exponent of dividend - OR A ; Test it - JP Z,OVTST3 ; Zero - Result zero - LD A,L ; Get add/subtract flag - LD HL,FPEXP ; Point to exponent - XOR (HL) ; Add or subtract it - ADD A,B ; Add the other exponent - LD B,A ; Save new exponent - RRA ; Test exponent for overflow - XOR B - LD A,B ; Get exponent - JP P,OVTST2 ; Positive - Test for overflow - ADD A,80H ; Add excess 128 - LD (HL),A ; Save new exponent - JP Z,POPHRT ; Zero - Result zero - CALL SIGNS ; Set MSBs and sign of result - LD (HL),A ; Save new exponent - DEC HL ; Point to MSB - RET - -OVTST1: CALL TSTSGN ; Test sign of FPREG - CPL ; Invert sign - POP HL ; Clean up stack -OVTST2: OR A ; Test if new exponent zero -OVTST3: POP HL ; Clear off return address - JP P,RESZER ; Result zero - JP OVERR ; Overflow error - -MLSP10: CALL BCDEFP ; Move FPREG to BCDE - LD A,B ; Get exponent - OR A ; Is it zero? - RET Z ; Yes - Result is zero - ADD A,2 ; Multiply by 4 - JP C,OVERR ; Overflow - ?OV Error - LD B,A ; Re-save exponent - CALL FPADD ; Add BCDE to FPREG (Times 5) - LD HL,FPEXP ; Point to exponent - INC (HL) ; Double number (Times 10) - RET NZ ; Ok - Return - JP OVERR ; Overflow error - -TSTSGN: LD A,(FPEXP) ; Get sign of FPREG - OR A - RET Z ; RETurn if number is zero - LD A,(FPREG+2) ; Get MSB of FPREG - .BYTE 0FEH ; Test sign -RETREL: CPL ; Invert sign - RLA ; Sign bit to carry -FLGDIF: SBC A,A ; Carry to all bits of A - RET NZ ; Return -1 if negative - INC A ; Bump to +1 - RET ; Positive - Return +1 - -SGN: CALL TSTSGN ; Test sign of FPREG -FLGREL: LD B,80H+8 ; 8 bit integer in exponent - LD DE,0 ; Zero NMSB and LSB -RETINT: LD HL,FPEXP ; Point to exponent - LD C,A ; CDE = MSB,NMSB and LSB - LD (HL),B ; Save exponent - LD B,0 ; CDE = integer to normalise - INC HL ; Point to sign of result - LD (HL),80H ; Set sign of result - RLA ; Carry = sign of integer - JP CONPOS ; Set sign of result - -ABS: CALL TSTSGN ; Test sign of FPREG - RET P ; Return if positive -INVSGN: LD HL,FPREG+2 ; Point to MSB - LD A,(HL) ; Get sign of mantissa - XOR 80H ; Invert sign of mantissa - LD (HL),A ; Re-save sign of mantissa - RET - -STAKFP: EX DE,HL ; Save code string address - LD HL,(FPREG) ; LSB,NLSB of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - LD HL,(FPREG+2) ; MSB and exponent of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - EX DE,HL ; Restore code string address - RET - -PHLTFP: CALL LOADFP ; Number at HL to BCDE -FPBCDE: EX DE,HL ; Save code string address - LD (FPREG),HL ; Save LSB,NLSB of number - LD H,B ; Exponent of number - LD L,C ; MSB of number - LD (FPREG+2),HL ; Save MSB and exponent - EX DE,HL ; Restore code string address - RET - -BCDEFP: LD HL,FPREG ; Point to FPREG -LOADFP: LD E,(HL) ; Get LSB of number - INC HL - LD D,(HL) ; Get NMSB of number - INC HL - LD C,(HL) ; Get MSB of number - INC HL - LD B,(HL) ; Get exponent of number -INCHL: INC HL ; Used for conditional "INC HL" - RET - -FPTHL: LD DE,FPREG ; Point to FPREG -DETHL4: LD B,4 ; 4 bytes to move -DETHLB: LD A,(DE) ; Get source - LD (HL),A ; Save destination - INC DE ; Next source - INC HL ; Next destination - DEC B ; Count bytes - JP NZ,DETHLB ; Loop if more - RET - -SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG - LD A,(HL) ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD (HL),A ; Save new MSB - CCF ; Complement sign - RRA ; Old sign to carry - INC HL - INC HL - LD (HL),A ; Set sign of result - LD A,C ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD C,A ; Save MSB - RRA - XOR (HL) ; New sign of result - RET - -CMPNUM: LD A,B ; Get exponent of number - OR A - JP Z,TSTSGN ; Zero - Test sign of FPREG - LD HL,RETREL ; Return relation routine - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD A,C ; Get MSB of number - RET Z ; FPREG zero - Number's MSB - LD HL,FPREG+2 ; MSB of FPREG - XOR (HL) ; Combine signs - LD A,C ; Get MSB of number - RET M ; Exit if signs different - CALL CMPFP ; Compare FP numbers - RRA ; Get carry to sign - XOR C ; Combine with MSB of number - RET - -CMPFP: INC HL ; Point to exponent - LD A,B ; Get exponent - CP (HL) ; Compare exponents - RET NZ ; Different - DEC HL ; Point to MBS - LD A,C ; Get MSB - CP (HL) ; Compare MSBs - RET NZ ; Different - DEC HL ; Point to NMSB - LD A,D ; Get NMSB - CP (HL) ; Compare NMSBs - RET NZ ; Different - DEC HL ; Point to LSB - LD A,E ; Get LSB - SUB (HL) ; Compare LSBs - RET NZ ; Different - POP HL ; Drop RETurn - POP HL ; Drop another RETurn - RET - -FPINT: LD B,A ; <- Move - LD C,A ; <- exponent - LD D,A ; <- to all - LD E,A ; <- bits - OR A ; Test exponent - RET Z ; Zero - Return zero - PUSH HL ; Save pointer to number - CALL BCDEFP ; Move FPREG to BCDE - CALL SIGNS ; Set MSBs & sign of result - XOR (HL) ; Combine with sign of FPREG - LD H,A ; Save combined signs - CALL M,DCBCDE ; Negative - Decrement BCDE - LD A,80H+24 ; 24 bits - SUB B ; Bits to shift - CALL SCALE ; Shift BCDE - LD A,H ; Get combined sign - RLA ; Sign to carry - CALL C,FPROND ; Negative - Round number up - LD B,0 ; Zero exponent - CALL C,COMPL ; If negative make positive - POP HL ; Restore pointer to number - RET - -DCBCDE: DEC DE ; Decrement BCDE - LD A,D ; Test LSBs - AND E - INC A - RET NZ ; Exit if LSBs not FFFF - DEC BC ; Decrement MSBs - RET - -INT: LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - CP 80H+24 ; Integer accuracy only? - LD A,(FPREG) ; Get LSB - RET NC ; Yes - Already integer - LD A,(HL) ; Get exponent - CALL FPINT ; F.P to integer - LD (HL),80H+24 ; Save 24 bit integer - LD A,E ; Get LSB of number - PUSH AF ; Save LSB - LD A,C ; Get MSB of number - RLA ; Sign to carry - CALL CONPOS ; Set sign of result - POP AF ; Restore LSB of number - RET - -MLDEBC: LD HL,0 ; Clear partial product - LD A,B ; Test multiplier - OR C - RET Z ; Return zero if zero - LD A,16 ; 16 bits -MLDBLP: ADD HL,HL ; Shift P.P left - JP C,BSERR ; ?BS Error if overflow - EX DE,HL - ADD HL,HL ; Shift multiplier left - EX DE,HL - JP NC,NOMLAD ; Bit was zero - No add - ADD HL,BC ; Add multiplicand - JP C,BSERR ; ?BS Error if overflow -NOMLAD: DEC A ; Count bits - JP NZ,MLDBLP ; More - RET - -ASCTFP: CP '-' ; Negative? - PUSH AF ; Save it and flags - JP Z,CNVNUM ; Yes - Convert number - CP '+' ; Positive? - JP Z,CNVNUM ; Yes - Convert number - DEC HL ; DEC 'cos GETCHR INCs -CNVNUM: CALL RESZER ; Set result to zero - LD B,A ; Digits after point counter - LD D,A ; Sign of exponent - LD E,A ; Exponent of ten - CPL - LD C,A ; Before or after point flag -MANLP: CALL GETCHR ; Get next character - JP C,ADDIG ; Digit - Add to number - CP '.' - JP Z,DPOINT ; '.' - Flag point - CP 'E' - JP NZ,CONEXP ; Not 'E' - Scale number - CALL GETCHR ; Get next character - CALL SGNEXP ; Get sign of exponent -EXPLP: CALL GETCHR ; Get next character - JP C,EDIGIT ; Digit - Add to exponent - INC D ; Is sign negative? - JP NZ,CONEXP ; No - Scale number - XOR A - SUB E ; Negate exponent - LD E,A ; And re-save it - INC C ; Flag end of number -DPOINT: INC C ; Flag point passed - JP Z,MANLP ; Zero - Get another digit -CONEXP: PUSH HL ; Save code string address - LD A,E ; Get exponent - SUB B ; Subtract digits after point -SCALMI: CALL P,SCALPL ; Positive - Multiply number - JP P,ENDCON ; Positive - All done - PUSH AF ; Save number of times to /10 - CALL DIV10 ; Divide by 10 - POP AF ; Restore count - INC A ; Count divides - -ENDCON: JP NZ,SCALMI ; More to do - POP DE ; Restore code string address - POP AF ; Restore sign of number - CALL Z,INVSGN ; Negative - Negate number - EX DE,HL ; Code string address to HL - RET - -SCALPL: RET Z ; Exit if no scaling needed -MULTEN: PUSH AF ; Save count - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore count - DEC A ; Count multiplies - RET - -ADDIG: PUSH DE ; Save sign of exponent - LD D,A ; Save digit - LD A,B ; Get digits after point - ADC A,C ; Add one if after point - LD B,A ; Re-save counter - PUSH BC ; Save point flags - PUSH HL ; Save code string address - PUSH DE ; Save digit - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore digit - SUB '0' ; Make it absolute - CALL RSCALE ; Re-scale number - POP HL ; Restore code string address - POP BC ; Restore point flags - POP DE ; Restore sign of exponent - JP MANLP ; Get another digit - -RSCALE: CALL STAKFP ; Put number on stack - CALL FLGREL ; Digit to add to FPREG -PADD: POP BC ; Restore number - POP DE - JP FPADD ; Add BCDE to FPREG and return - -EDIGIT: LD A,E ; Get digit - RLCA ; Times 2 - RLCA ; Times 4 - ADD A,E ; Times 5 - RLCA ; Times 10 - ADD A,(HL) ; Add next digit - SUB '0' ; Make it absolute - LD E,A ; Save new digit - JP EXPLP ; Look for another digit - -LINEIN: PUSH HL ; Save code string address - LD HL,INMSG ; Output " in " - CALL PRS ; Output string at HL - POP HL ; Restore code string address -PRNTHL: EX DE,HL ; Code string address to DE - XOR A - LD B,80H+24 ; 24 bits - CALL RETINT ; Return the integer - LD HL,PRNUMS ; Print number string - PUSH HL ; Save for return -NUMASC: LD HL,PBUFF ; Convert number to ASCII - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD (HL),' ' ; Space at start - JP P,SPCFST ; Positive - Space to start - LD (HL),'-' ; '-' sign at start -SPCFST: INC HL ; First byte of number - LD (HL),'0' ; '0' if zero - JP Z,JSTZER ; Return '0' if zero - PUSH HL ; Save buffer address - CALL M,INVSGN ; Negate FPREG if negative - XOR A ; Zero A - PUSH AF ; Save it - CALL RNGTST ; Test number is in range -SIXDIG: LD BC,9143H ; BCDE - 99999.9 - LD DE,4FF8H - CALL CMPNUM ; Compare numbers - OR A - JP PO,INRNG ; > 99999.9 - Sort it out - POP AF ; Restore count - CALL MULTEN ; Multiply by ten - PUSH AF ; Re-save count - JP SIXDIG ; Test it again - -GTSIXD: CALL DIV10 ; Divide by 10 - POP AF ; Get count - INC A ; Count divides - PUSH AF ; Re-save count - CALL RNGTST ; Test number is in range -INRNG: CALL ROUND ; Add 0.5 to FPREG - INC A - CALL FPINT ; F.P to integer - CALL FPBCDE ; Move BCDE to FPREG - LD BC,0306H ; 1E+06 to 1E-03 range - POP AF ; Restore count - ADD A,C ; 6 digits before point - INC A ; Add one - JP M,MAKNUM ; Do it in 'E' form if < 1E-02 - CP 6+1+1 ; More than 999999 ? - JP NC,MAKNUM ; Yes - Do it in 'E' form - INC A ; Adjust for exponent - LD B,A ; Exponent of number - LD A,2 ; Make it zero after - -MAKNUM: DEC A ; Adjust for digits to do - DEC A - POP HL ; Restore buffer address - PUSH AF ; Save count - LD DE,POWERS ; Powers of ten - DEC B ; Count digits before point - JP NZ,DIGTXT ; Not zero - Do number - LD (HL),'.' ; Save point - INC HL ; Move on - LD (HL),'0' ; Save zero - INC HL ; Move on -DIGTXT: DEC B ; Count digits before point - LD (HL),'.' ; Save point in case - CALL Z,INCHL ; Last digit - move on - PUSH BC ; Save digits before point - PUSH HL ; Save buffer address - PUSH DE ; Save powers of ten - CALL BCDEFP ; Move FPREG to BCDE - POP HL ; Powers of ten table - LD B, '0'-1 ; ASCII '0' - 1 -TRYAGN: INC B ; Count subtractions - LD A,E ; Get LSB - SUB (HL) ; Subtract LSB - LD E,A ; Save LSB - INC HL - LD A,D ; Get NMSB - SBC A,(HL) ; Subtract NMSB - LD D,A ; Save NMSB - INC HL - LD A,C ; Get MSB - SBC A,(HL) ; Subtract MSB - LD C,A ; Save MSB - DEC HL ; Point back to start - DEC HL - JP NC,TRYAGN ; No overflow - Try again - CALL PLUCDE ; Restore number - INC HL ; Start of next number - CALL FPBCDE ; Move BCDE to FPREG - EX DE,HL ; Save point in table - POP HL ; Restore buffer address - LD (HL),B ; Save digit in buffer - INC HL ; And move on - POP BC ; Restore digit count - DEC C ; Count digits - JP NZ,DIGTXT ; More - Do them - DEC B ; Any decimal part? - JP Z,DOEBIT ; No - Do 'E' bit -SUPTLZ: DEC HL ; Move back through buffer - LD A,(HL) ; Get character - CP '0' ; '0' character? - JP Z,SUPTLZ ; Yes - Look back for more - CP '.' ; A decimal point? - CALL NZ,INCHL ; Move back over digit - -DOEBIT: POP AF ; Get 'E' flag - JP Z,NOENED ; No 'E' needed - End buffer - LD (HL),'E' ; Put 'E' in buffer - INC HL ; And move on - LD (HL),'+' ; Put '+' in buffer - JP P,OUTEXP ; Positive - Output exponent - LD (HL),'-' ; Put '-' in buffer - CPL ; Negate exponent - INC A -OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 -EXPTEN: INC B ; Count subtractions - SUB 10 ; Tens digit - JP NC,EXPTEN ; More to do - ADD A,'0'+10 ; Restore and make ASCII - INC HL ; Move on - LD (HL),B ; Save MSB of exponent -JSTZER: INC HL ; - LD (HL),A ; Save LSB of exponent - INC HL -NOENED: LD (HL),C ; Mark end of buffer - POP HL ; Restore code string address - RET - -RNGTST: LD BC,9474H ; BCDE = 999999. - LD DE,23F7H - CALL CMPNUM ; Compare numbers - OR A - POP HL ; Return address to HL - JP PO,GTSIXD ; Too big - Divide by ten - JP (HL) ; Otherwise return to caller - -HALF: .BYTE 00H,00H,00H,80H ; 0.5 - -POWERS: .BYTE 0A0H,086H,001H ; 100000 - .BYTE 010H,027H,000H ; 10000 - .BYTE 0E8H,003H,000H ; 1000 - .BYTE 064H,000H,000H ; 100 - .BYTE 00AH,000H,000H ; 10 - .BYTE 001H,000H,000H ; 1 - -NEGAFT: LD HL,INVSGN ; Negate result - EX (SP),HL ; To be done after caller - JP (HL) ; Return to caller - -SQR: CALL STAKFP ; Put value on stack - LD HL,HALF ; Set power to 1/2 - CALL PHLTFP ; Move 1/2 to FPREG - -POWER: POP BC ; Get base - POP DE - CALL TSTSGN ; Test sign of power - LD A,B ; Get exponent of base - JP Z,EXP ; Make result 1 if zero - JP P,POWER1 ; Positive base - Ok - OR A ; Zero to negative power? - JP Z,DZERR ; Yes - ?/0 Error -POWER1: OR A ; Base zero? - JP Z,SAVEXP ; Yes - Return zero - PUSH DE ; Save base - PUSH BC - LD A,C ; Get MSB of base - OR 01111111B ; Get sign status - CALL BCDEFP ; Move power to BCDE - JP P,POWER2 ; Positive base - Ok - PUSH DE ; Save power - PUSH BC - CALL INT ; Get integer of power - POP BC ; Restore power - POP DE - PUSH AF ; MSB of base - CALL CMPNUM ; Power an integer? - POP HL ; Restore MSB of base - LD A,H ; but don't affect flags - RRA ; Exponent odd or even? -POWER2: POP HL ; Restore MSB and exponent - LD (FPREG+2),HL ; Save base in FPREG - POP HL ; LSBs of base - LD (FPREG),HL ; Save in FPREG - CALL C,NEGAFT ; Odd power - Negate result - CALL Z,INVSGN ; Negative base - Negate it - PUSH DE ; Save power - PUSH BC - CALL LOG ; Get LOG of base - POP BC ; Restore power - POP DE - CALL FPMULT ; Multiply LOG by power - -EXP: CALL STAKFP ; Put value on stack - LD BC,08138H ; BCDE = 1/Ln(2) - LD DE,0AA3BH - CALL FPMULT ; Multiply value by 1/LN(2) - LD A,(FPEXP) ; Get exponent - CP 80H+8 ; Is it in range? - JP NC,OVTST1 ; No - Test for overflow - CALL INT ; Get INT of FPREG - ADD A,80H ; For excess 128 - ADD A,2 ; Exponent > 126? - JP C,OVTST1 ; Yes - Test for overflow - PUSH AF ; Save scaling factor - LD HL,UNITY ; Point to 1. - CALL ADDPHL ; Add 1 to FPREG - CALL MULLN2 ; Multiply by LN(2) - POP AF ; Restore scaling factor - POP BC ; Restore exponent - POP DE - PUSH AF ; Save scaling factor - CALL SUBCDE ; Subtract exponent from FPREG - CALL INVSGN ; Negate result - LD HL,EXPTAB ; Coefficient table - CALL SMSER1 ; Sum the series - LD DE,0 ; Zero LSBs - POP BC ; Scaling factor - LD C,D ; Zero MSB - JP FPMULT ; Scale result to correct value - -EXPTAB: .BYTE 8 ; Table used by EXP - .BYTE 040H,02EH,094H,074H ; -1/7! (-1/5040) - .BYTE 070H,04FH,02EH,077H ; 1/6! ( 1/720) - .BYTE 06EH,002H,088H,07AH ; -1/5! (-1/120) - .BYTE 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) - .BYTE 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) - .BYTE 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) - .BYTE 000H,000H,080H,081H ; -1/1! (-1/1) - .BYTE 000H,000H,000H,081H ; 1/0! ( 1/1) - -SUMSER: CALL STAKFP ; Put FPREG on stack - LD DE,MULT ; Multiply by "X" - PUSH DE ; To be done after - PUSH HL ; Save address of table - CALL BCDEFP ; Move FPREG to BCDE - CALL FPMULT ; Square the value - POP HL ; Restore address of table -SMSER1: CALL STAKFP ; Put value on stack - LD A,(HL) ; Get number of coefficients - INC HL ; Point to start of table - CALL PHLTFP ; Move coefficient to FPREG - .BYTE 06H ; Skip "POP AF" -SUMLP: POP AF ; Restore count - POP BC ; Restore number - POP DE - DEC A ; Cont coefficients - RET Z ; All done - PUSH DE ; Save number - PUSH BC - PUSH AF ; Save count - PUSH HL ; Save address in table - CALL FPMULT ; Multiply FPREG by BCDE - POP HL ; Restore address in table - CALL LOADFP ; Number at HL to BCDE - PUSH HL ; Save address in table - CALL FPADD ; Add coefficient to FPREG - POP HL ; Restore address in table - JP SUMLP ; More coefficients - -RND: CALL TSTSGN ; Test sign of FPREG - LD HL,SEED+2 ; Random number seed - JP M,RESEED ; Negative - Re-seed - LD HL,LSTRND ; Last random number - CALL PHLTFP ; Move last RND to FPREG - LD HL,SEED+2 ; Random number seed - RET Z ; Return if RND(0) - ADD A,(HL) ; Add (SEED)+2) - AND 00000111B ; 0 to 7 - LD B,0 - LD (HL),A ; Re-save seed - INC HL ; Move to coefficient table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to coefficient - CALL LOADFP ; Coefficient to BCDE - CALL FPMULT ; ; Multiply FPREG by coefficient - LD A,(SEED+1) ; Get (SEED+1) - INC A ; Add 1 - AND 00000011B ; 0 to 3 - LD B,0 - CP 1 ; Is it zero? - ADC A,B ; Yes - Make it 1 - LD (SEED+1),A ; Re-save seed - LD HL,RNDTAB-4 ; Addition table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to value - CALL ADDPHL ; Add value to FPREG -RND1: CALL BCDEFP ; Move FPREG to BCDE - LD A,E ; Get LSB - LD E,C ; LSB = MSB - XOR 01001111B ; Fiddle around - LD C,A ; New MSB - LD (HL),80H ; Set exponent - DEC HL ; Point to MSB - LD B,(HL) ; Get MSB - LD (HL),80H ; Make value -0.5 - LD HL,SEED ; Random number seed - INC (HL) ; Count seed - LD A,(HL) ; Get seed - SUB 171 ; Do it modulo 171 - JP NZ,RND2 ; Non-zero - Ok - LD (HL),A ; Zero seed - INC C ; Fillde about - DEC D ; with the - INC E ; number -RND2: CALL BNORM ; Normalise number - LD HL,LSTRND ; Save random number - JP FPTHL ; Move FPREG to last and return - -RESEED: LD (HL),A ; Re-seed random numbers - DEC HL - LD (HL),A - DEC HL - LD (HL),A - JP RND1 ; Return RND seed - -RNDTAB: .BYTE 068H,0B1H,046H,068H ; Table used by RND - .BYTE 099H,0E9H,092H,069H - .BYTE 010H,0D1H,075H,068H - -COS: LD HL,HALFPI ; Point to PI/2 - CALL ADDPHL ; Add it to PPREG -SIN: CALL STAKFP ; Put angle on stack - LD BC,8349H ; BCDE = 2 PI - LD DE,0FDBH - CALL FPBCDE ; Move 2 PI to FPREG - POP BC ; Restore angle - POP DE - CALL DVBCDE ; Divide angle by 2 PI - CALL STAKFP ; Put it on stack - CALL INT ; Get INT of result - POP BC ; Restore number - POP DE - CALL SUBCDE ; Make it 0 <= value < 1 - LD HL,QUARTR ; Point to 0.25 - CALL SUBPHL ; Subtract value from 0.25 - CALL TSTSGN ; Test sign of value - SCF ; Flag positive - JP P,SIN1 ; Positive - Ok - CALL ROUND ; Add 0.5 to value - CALL TSTSGN ; Test sign of value - OR A ; Flag negative -SIN1: PUSH AF ; Save sign - CALL P,INVSGN ; Negate value if positive - LD HL,QUARTR ; Point to 0.25 - CALL ADDPHL ; Add 0.25 to value - POP AF ; Restore sign - CALL NC,INVSGN ; Negative - Make positive - LD HL,SINTAB ; Coefficient table - JP SUMSER ; Evaluate sum of series - -HALFPI: .BYTE 0DBH,00FH,049H,081H ; 1.5708 (PI/2) - -QUARTR: .BYTE 000H,000H,000H,07FH ; 0.25 - -SINTAB: .BYTE 5 ; Table used by SIN - .BYTE 0BAH,0D7H,01EH,086H ; 39.711 - .BYTE 064H,026H,099H,087H ;-76.575 - .BYTE 058H,034H,023H,087H ; 81.602 - .BYTE 0E0H,05DH,0A5H,086H ;-41.342 - .BYTE 0DAH,00FH,049H,083H ; 6.2832 - -TAN: CALL STAKFP ; Put angle on stack - CALL SIN ; Get SIN of angle - POP BC ; Restore angle - POP HL - CALL STAKFP ; Save SIN of angle - EX DE,HL ; BCDE = Angle - CALL FPBCDE ; Angle to FPREG - CALL COS ; Get COS of angle - JP DIV ; TAN = SIN / COS - -ATN: CALL TSTSGN ; Test sign of value - CALL M,NEGAFT ; Negate result after if -ve - CALL M,INVSGN ; Negate value if -ve - LD A,(FPEXP) ; Get exponent - CP 81H ; Number less than 1? - JP C,ATN1 ; Yes - Get arc tangnt - LD BC,8100H ; BCDE = 1 - LD D,C - LD E,C - CALL DVBCDE ; Get reciprocal of number - LD HL,SUBPHL ; Sub angle from PI/2 - PUSH HL ; Save for angle > 1 -ATN1: LD HL,ATNTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD HL,HALFPI ; PI/2 - angle in case > 1 - RET ; Number > 1 - Sub from PI/2 - -ATNTAB: .BYTE 9 ; Table used by ATN - .BYTE 04AH,0D7H,03BH,078H ; 1/17 - .BYTE 002H,06EH,084H,07BH ;-1/15 - .BYTE 0FEH,0C1H,02FH,07CH ; 1/13 - .BYTE 074H,031H,09AH,07DH ;-1/11 - .BYTE 084H,03DH,05AH,07DH ; 1/9 - .BYTE 0C8H,07FH,091H,07EH ;-1/7 - .BYTE 0E4H,0BBH,04CH,07EH ; 1/5 - .BYTE 06CH,0AAH,0AAH,07FH ;-1/3 - .BYTE 000H,000H,000H,081H ; 1/1 - - -ARET: RET ; A RETurn instruction - -GETINP: RST 10H ;input a character - RET - -CLS: - LD A,CS ; ASCII Clear screen - JP MONOUT ; Output character - -WIDTH: CALL GETINT ; Get integer 0-255 - LD A,E ; Width to A - LD (LWIDTH),A ; Set width - RET - -LINES: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - LD (LINESC),DE ; Set lines counter - LD (LINESN),DE ; Set lines number - RET - -DEEK: CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save number - POP HL ; Number to HL - LD B,(HL) ; Get LSB of contents - INC HL - LD A,(HL) ; Get MSB of contents - JP ABPASS ; Return integer AB - -DOKE: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save address - CALL CHKSYN ; Make sure ',' follows - .BYTE ',' - CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - EX (SP),HL ; Save value,get address - LD (HL),E ; Save LSB of value - INC HL - LD (HL),D ; Save MSB of value - POP HL ; Restore code string address - RET - - -; HEX$(nn) Convert 16 bit number to Hexadecimal string - -HEX: CALL TSTNUM ; Verify it's a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH BC ; Save contents of BC - LD HL,PBUFF - LD A,D ; Get high order into A - CP $0 - JR Z,HEX2 ; Skip output if both high digits are zero - CALL BYT2ASC ; Convert D to ASCII - LD A,B - CP '0' - JR Z,HEX1 ; Don't store high digit if zero - LD (HL),B ; Store it to PBUFF - INC HL ; Next location -HEX1: LD (HL),C ; Store C to PBUFF+1 - INC HL ; Next location -HEX2: LD A,E ; Get lower byte - CALL BYT2ASC ; Convert E to ASCII - LD A,D - CP $0 - JR NZ,HEX3 ; If upper byte was not zero then always print lower byte - LD A,B - CP '0' ; If high digit of lower byte is zero then don't print - JR Z,HEX4 -HEX3: LD (HL),B ; to PBUFF+2 - INC HL ; Next location -HEX4: LD (HL),C ; to PBUFF+3 - INC HL ; PBUFF+4 to zero - XOR A ; Terminating character - LD (HL),A ; Store zero to terminate - INC HL ; Make sure PBUFF is terminated - LD (HL),A ; Store the double zero there - POP BC ; Get BC back - LD HL,PBUFF ; Reset to start of PBUFF - JP STR1 ; Convert the PBUFF to a string and return it - -BYT2ASC LD B,A ; Save original value - AND $0F ; Strip off upper nybble - CP $0A ; 0-9? - JR C,ADD30 ; If A-F, add 7 more - ADD A,$07 ; Bring value up to ASCII A-F -ADD30 ADD A,$30 ; And make ASCII - LD C,A ; Save converted char to C - LD A,B ; Retrieve original value - RRCA ; and Rotate it right - RRCA - RRCA - RRCA - AND $0F ; Mask off upper nybble - CP $0A ; 0-9? < A hex? - JR C,ADD301 ; Skip Add 7 - ADD A,$07 ; Bring it up to ASCII A-F -ADD301 ADD A,$30 ; And make it full ASCII - LD B,A ; Store high order byte - RET - -; Convert "&Hnnnn" to FPREG -; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" -; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 -HEXTFP EX DE,HL ; Move code string pointer to DE - LD HL,$0000 ; Zero out the value - CALL GETHEX ; Check the number for valid hex - JP C,HXERR ; First value wasn't hex, HX error - JR HEXLP1 ; Convert first character -HEXLP CALL GETHEX ; Get second and addtional characters - JR C,HEXIT ; Exit if not a hex character -HEXLP1 ADD HL,HL ; Rotate 4 bits to the left - ADD HL,HL - ADD HL,HL - ADD HL,HL - OR L ; Add in D0-D3 into L - LD L,A ; Save new value - JR HEXLP ; And continue until all hex characters are in - -GETHEX INC DE ; Next location - LD A,(DE) ; Load character at pointer - CP ' ' - JP Z,GETHEX ; Skip spaces - SUB $30 ; Get absolute value - RET C ; < "0", error - CP $0A - JR C,NOSUB7 ; Is already in the range 0-9 - SUB $07 ; Reduce to A-F - CP $0A ; Value should be $0A-$0F at this point - RET C ; CY set if was : ; < = > ? @ -NOSUB7 CP $10 ; > Greater than "F"? - CCF - RET ; CY set if it wasn't valid hex - -HEXIT EX DE,HL ; Value into DE, Code string into HL - LD A,D ; Load DE into AC - LD C,E ; For prep to - PUSH HL - CALL ACPASS ; ACPASS to set AC as integer into FPREG - POP HL - RET - -HXERR: LD E,HX ; ?HEX Error - JP ERROR - -; BIN$(NN) Convert integer to a 1-16 char binary string -BIN: CALL TSTNUM ; Verify it's a number - CALL DEINT ; Get integer -32768 to 32767 -BIN2: PUSH BC ; Save contents of BC - LD HL,PBUFF - LD B,17 ; One higher than max char count -ZEROSUP: ; Suppress leading zeros - DEC B ; Max 16 chars - LD A,B - CP $01 - JR Z,BITOUT ; Always output at least one character - RL E - RL D - JR NC,ZEROSUP - JR BITOUT2 -BITOUT: - RL E - RL D ; Top bit now in carry -BITOUT2: - LD A,'0' ; Char for '0' - ADC A,0 ; If carry set then '0' --> '1' - LD (HL),A - INC HL - DEC B - JR NZ,BITOUT - XOR A ; Terminating character - LD (HL),A ; Store zero to terminate - INC HL ; Make sure PBUFF is terminated - LD (HL),A ; Store the double zero there - POP BC - LD HL,PBUFF - JP STR1 - -; Convert "&Bnnnn" to FPREG -; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" -BINTFP: EX DE,HL ; Move code string pointer to DE - LD HL,$0000 ; Zero out the value - CALL CHKBIN ; Check the number for valid bin - JP C,BINERR ; First value wasn't bin, HX error -BINIT: SUB '0' - ADD HL,HL ; Rotate HL left - OR L - LD L,A - CALL CHKBIN ; Get second and addtional characters - JR NC,BINIT ; Process if a bin character - EX DE,HL ; Value into DE, Code string into HL - LD A,D ; Load DE into AC - LD C,E ; For prep to - PUSH HL - CALL ACPASS ; ACPASS to set AC as integer into FPREG - POP HL - RET - -; Char is in A, NC if char is 0 or 1 -CHKBIN: INC DE - LD A,(DE) - CP ' ' - JP Z,CHKBIN ; Skip spaces - CP '0' ; Set C if < '0' - RET C - CP '2' - CCF ; Set C if > '1' - RET - -BINERR: LD E,BN ; ?BIN Error - JP ERROR - - -JJUMP1: - LD IX,-1 ; Flag cold start - JP CSTART ; Go and initialise - -MONOUT: - JP $0008 ; output a char - - -MONITR: - JP $0000 ; Restart (Normally Monitor Start) - - -INITST: LD A,0 ; Clear break flag - LD (BRKFLG),A - JP INIT - -ARETN: RETN ; Return from NMI - - -TSTBIT: PUSH AF ; Save bit mask - AND B ; Get common bits - POP BC ; Restore bit mask - CP B ; Same bit set? - LD A,0 ; Return 0 in A - RET - -OUTNCR: CALL OUTC ; Output character in A - JP PRNTCRLF ; Output CRLF - -.end - diff --git a/new/apps/basic/searle8kinit.asm b/new/apps/basic/searle8kinit.asm deleted file mode 100644 index c0c79c6..0000000 --- a/new/apps/basic/searle8kinit.asm +++ /dev/null @@ -1,202 +0,0 @@ -;================================================================================== -; Contents of this file are copyright Grant Searle -; -; You have permission to use this for NON COMMERCIAL USE ONLY -; If you wish to use it elsewhere, please include an acknowledgement to myself. -; -; http://searle.hostei.com/grant/index.html -; -; eMail: home.micros01@btinternet.com -; -; If the above don't work, please perform an Internet search to see if I have -; updated the web page hosting service. -; -;================================================================================== - -; Minimum 6850 ACIA interrupt driven serial I/O to run modified NASCOM Basic 4.7 -; Full input buffering with incoming data hardware handshaking -; Handshake shows full before the buffer is totally filled to allow run-on from the sender - -SER_BUFSIZE .EQU 3FH -SER_FULLSIZE .EQU 30H -SER_EMPTYSIZE .EQU 5 - -RTS_HIGH .EQU 0D6H -RTS_LOW .EQU 096H - -serBuf .EQU $2000 -serInPtr .EQU serBuf+SER_BUFSIZE -serRdPtr .EQU serInPtr+2 -serBufUsed .EQU serRdPtr+2 -basicStarted .EQU serBufUsed+1 -TEMPSTACK .EQU $20ED ; Top of BASIC line input buffer so is "free ram" when BASIC resets - -CR .EQU 0DH -LF .EQU 0AH -CS .EQU 0CH ; Clear screen - - .ORG $0000 -;------------------------------------------------------------------------------ -; Reset - -RST00 DI ;Disable interrupts - JP INIT ;Initialize Hardware and go - -;------------------------------------------------------------------------------ -; TX a character over RS232 - - .ORG 0008H -RST08 JP TXA - -;------------------------------------------------------------------------------ -; RX a character over RS232 Channel A [Console], hold here until char ready. - - .ORG 0010H -RST10 JP RXA - -;------------------------------------------------------------------------------ -; Check serial status - - .ORG 0018H -RST18 JP CKINCHAR - -;------------------------------------------------------------------------------ -; RST 38 - INTERRUPT VECTOR [ for IM 1 ] - - .ORG 0038H -RST38 JR serialInt - -;------------------------------------------------------------------------------ -serialInt: PUSH AF - PUSH HL - - IN A,($80) - AND $01 ; Check if interupt due to read buffer full - JR Z,rts0 ; if not, ignore - - IN A,($81) - PUSH AF - LD A,(serBufUsed) - CP SER_BUFSIZE ; If full then ignore - JR NZ,notFull - POP AF - JR rts0 - -notFull: LD HL,(serInPtr) - INC HL - LD A,L ; Only need to check low byte becasuse buffer<256 bytes - CP (serBuf+SER_BUFSIZE) & $FF - JR NZ, notWrap - LD HL,serBuf -notWrap: LD (serInPtr),HL - POP AF - LD (HL),A - LD A,(serBufUsed) - INC A - LD (serBufUsed),A - CP SER_FULLSIZE - JR C,rts0 - LD A,RTS_HIGH - OUT ($80),A -rts0: POP HL - POP AF - EI - RETI - -;------------------------------------------------------------------------------ -RXA: -waitForChar: LD A,(serBufUsed) - CP $00 - JR Z, waitForChar - PUSH HL - LD HL,(serRdPtr) - INC HL - LD A,L ; Only need to check low byte becasuse buffer<256 bytes - CP (serBuf+SER_BUFSIZE) & $FF - JR NZ, notRdWrap - LD HL,serBuf -notRdWrap: DI - LD (serRdPtr),HL - LD A,(serBufUsed) - DEC A - LD (serBufUsed),A - CP SER_EMPTYSIZE - JR NC,rts1 - LD A,RTS_LOW - OUT ($80),A -rts1: - LD A,(HL) - EI - POP HL - RET ; Char ready in A - -;------------------------------------------------------------------------------ -TXA: PUSH AF ; Store character -conout1: IN A,($80) ; Status byte - BIT 1,A ; Set Zero flag if still transmitting character - JR Z,conout1 ; Loop until flag signals ready - POP AF ; Retrieve character - OUT ($81),A ; Output the character - RET - -;------------------------------------------------------------------------------ -CKINCHAR LD A,(serBufUsed) - CP $0 - RET - -PRINT: LD A,(HL) ; Get character - OR A ; Is it $00 ? - RET Z ; Then RETurn on terminator - RST 08H ; Print it - INC HL ; Next Character - JR PRINT ; Continue until $00 - RET -;------------------------------------------------------------------------------ -INIT: - LD HL,TEMPSTACK ; Temp stack - LD SP,HL ; Set up a temporary stack - LD HL,serBuf - LD (serInPtr),HL - LD (serRdPtr),HL - XOR A ;0 to accumulator - LD (serBufUsed),A - LD A,RTS_LOW - OUT ($80),A ; Initialise ACIA - IM 1 - EI - LD HL,SIGNON1 ; Sign-on message - CALL PRINT ; Output string - LD A,(basicStarted); Check the BASIC STARTED flag - CP 'Y' ; to see if this is power-up - JR NZ,COLDSTART ; If not BASIC started then always do cold start - LD HL,SIGNON2 ; Cold/warm message - CALL PRINT ; Output string -CORW: - CALL RXA - AND %11011111 ; lower to uppercase - CP 'C' - JR NZ, CHECKWARM - RST 08H - LD A,$0D - RST 08H - LD A,$0A - RST 08H -COLDSTART: LD A,'Y' ; Set the BASIC STARTED flag - LD (basicStarted),A - JP $0150 ; Start BASIC COLD -CHECKWARM: - CP 'W' - JR NZ, CORW - RST 08H - LD A,$0D - RST 08H - LD A,$0A - RST 08H - JP $0153 ; Start BASIC WARM - -SIGNON1: .BYTE CS - .BYTE "Z80 SBC By Grant Searle",CR,LF,0 -SIGNON2: .BYTE CR,LF - .BYTE "Cold or warm start (C or W)? ",0 - -.END diff --git a/program_ihex.py b/program_ihex.py deleted file mode 100755 index 95372e0..0000000 --- a/program_ihex.py +++ /dev/null @@ -1,319 +0,0 @@ -#!/usr/bin/env python3 -"""Program an Intel HEX file through the Z80 UART monitor.""" - -from __future__ import annotations - -import argparse -import re -import sys -import time -from pathlib import Path - -try: - import serial -except ImportError: - print( - "error: pySerial is required; install it with: " - "python3 -m pip install pyserial", - file=sys.stderr, - ) - raise SystemExit(2) - - -MAX_BLOCK_SIZE = 24 # Largest W command that fits the monitor's 80-byte line. - - -class ProgramError(Exception): - pass - - -def load_ihex(path: Path) -> dict[int, int]: - """Return the 16-bit-addressed data contained in an Intel HEX file.""" - memory: dict[int, int] = {} - address_base = 0 - saw_eof = False - - try: - lines = path.read_text(encoding="ascii").splitlines() - except (OSError, UnicodeError) as exc: - raise ProgramError(f"cannot read {path}: {exc}") from exc - - for line_number, text in enumerate(lines, 1): - text = text.strip() - if not text: - continue - if saw_eof: - raise ProgramError(f"{path}:{line_number}: data after EOF record") - if not text.startswith(":"): - raise ProgramError(f"{path}:{line_number}: record does not start with ':'") - try: - record = bytes.fromhex(text[1:]) - except ValueError as exc: - raise ProgramError(f"{path}:{line_number}: invalid hexadecimal record") from exc - - if len(record) < 5 or len(record) != record[0] + 5: - raise ProgramError(f"{path}:{line_number}: invalid record length") - if sum(record) & 0xFF: - raise ProgramError(f"{path}:{line_number}: Intel HEX checksum mismatch") - - count = record[0] - offset = (record[1] << 8) | record[2] - record_type = record[3] - data = record[4 : 4 + count] - - if record_type == 0x00: - start = address_base + offset - if start + count > 0x10000: - raise ProgramError( - f"{path}:{line_number}: address is outside the Z80's 64 KiB space" - ) - for index, value in enumerate(data): - address = start + index - old_value = memory.get(address) - if old_value is not None and old_value != value: - raise ProgramError( - f"{path}:{line_number}: conflicting data at {address:04X}" - ) - memory[address] = value - elif record_type == 0x01: - if count != 0: - raise ProgramError(f"{path}:{line_number}: malformed EOF record") - saw_eof = True - elif record_type == 0x02: - if count != 2: - raise ProgramError( - f"{path}:{line_number}: malformed extended segment address" - ) - address_base = int.from_bytes(data, "big") << 4 - elif record_type == 0x04: - if count != 2: - raise ProgramError( - f"{path}:{line_number}: malformed extended linear address" - ) - address_base = int.from_bytes(data, "big") << 16 - elif record_type in (0x03, 0x05): - # Start-address records do not contain bytes to program. - if count != 4: - raise ProgramError( - f"{path}:{line_number}: malformed start-address record" - ) - continue - else: - raise ProgramError( - f"{path}:{line_number}: unsupported record type {record_type:02X}" - ) - - if not saw_eof: - raise ProgramError(f"{path}: missing Intel HEX EOF record") - if not memory: - raise ProgramError(f"{path}: file contains no data") - return memory - - -def make_blocks(memory: dict[int, int], block_size: int) -> list[tuple[int, bytes]]: - """Combine adjacent addresses without filling gaps from the HEX file.""" - blocks: list[tuple[int, bytes]] = [] - addresses = sorted(memory) - index = 0 - - while index < len(addresses): - start = addresses[index] - data = bytearray([memory[start]]) - index += 1 - while ( - index < len(addresses) - and len(data) < block_size - and addresses[index] == start + len(data) - ): - data.append(memory[addresses[index]]) - index += 1 - blocks.append((start, bytes(data))) - - return blocks - - -class Monitor: - def __init__(self, port: str, baud: int, timeout: float, char_delay: float): - self.char_delay = char_delay - try: - self.serial = serial.Serial( - port=port, - baudrate=baud, - bytesize=serial.EIGHTBITS, - parity=serial.PARITY_NONE, - stopbits=serial.STOPBITS_ONE, - timeout=timeout, - write_timeout=timeout, - ) - except serial.SerialException as exc: - raise ProgramError(f"cannot open serial port {port}: {exc}") from exc - - def close(self) -> None: - self.serial.close() - - def command(self, command: str) -> str: - try: - for value in command.encode("ascii") + b"\r": - self.serial.write(bytes((value,))) - self.serial.flush() - if self.char_delay: - time.sleep(self.char_delay) - response = self.serial.read_until(b"> ") - except serial.SerialException as exc: - raise ProgramError(f"serial communication failed: {exc}") from exc - if not response.endswith(b"> "): - text = response.decode("ascii", errors="replace") - raise ProgramError( - f"timeout waiting for monitor after '{command}'; partial={text!r}" - ) - return response.decode("ascii", errors="replace") - - def synchronize(self) -> None: - try: - self.serial.reset_input_buffer() - # reset_input_buffer() cannot discard bytes which are still queued - # in the computer or USB adapter. Read until the line has stayed - # quiet before generating a fresh, unambiguous prompt. - normal_timeout = self.serial.timeout - self.serial.timeout = min(normal_timeout, 0.2) - while self.serial.read(256): - pass - self.serial.timeout = normal_timeout - except serial.SerialException as exc: - raise ProgramError(f"serial communication failed: {exc}") from exc - response = self.command("") - if not response.endswith("> "): - raise ProgramError("monitor prompt not found") - - -def response_has_ok(response: str) -> bool: - return any(line.strip() == "OK" for line in response.splitlines()) - - -def response_checksum(response: str) -> int | None: - matches = [ - int(line.strip(), 16) - for line in response.splitlines() - if re.fullmatch(r"[0-9A-Fa-f]{4}", line.strip()) - ] - return matches[-1] if matches else None - - -def write_and_verify(monitor: Monitor, start: int, data: bytes) -> tuple[bool, str]: - values = " ".join(f"{value:02X}" for value in data) - response = monitor.command(f"W {start:04X} {values}") - if not response_has_ok(response): - return False, f"monitor did not acknowledge the write; response={response!r}" - - end = start + len(data) - 1 - expected = sum(data) & 0xFFFF - response = monitor.command(f"C {start:04X} {end:04X}") - actual = response_checksum(response) - if actual is None: - return False, f"monitor did not return a checksum; response={response!r}" - if actual != expected: - return False, f"checksum mismatch (expected {expected:04X}, received {actual:04X})" - return True, "" - - -def parse_args() -> argparse.Namespace: - parser = argparse.ArgumentParser( - description="Program an Intel HEX file through the Z80 UART monitor." - ) - parser.add_argument("port", help="serial port, for example /dev/ttyUSB0 or COM3") - parser.add_argument("file", type=Path, help="Intel HEX input file") - parser.add_argument("--baud", type=int, default=2400, help="baud rate (default: 2400)") - parser.add_argument( - "--block-size", - type=int, - default=16, - help=f"bytes per verified block, 1-{MAX_BLOCK_SIZE} (default: 16)", - ) - parser.add_argument( - "--retries", - type=int, - default=3, - help="retries after the first attempt (default: 3)", - ) - parser.add_argument( - "--timeout", - type=float, - default=5.0, - help="serial response timeout in seconds (default: 5)", - ) - parser.add_argument( - "--char-delay", - type=float, - default=0.005, - help="delay after each transmitted character in seconds (default: 0.005)", - ) - args = parser.parse_args() - if not 1 <= args.block_size <= MAX_BLOCK_SIZE: - parser.error(f"--block-size must be between 1 and {MAX_BLOCK_SIZE}") - if args.retries < 0: - parser.error("--retries cannot be negative") - if args.baud <= 0: - parser.error("--baud must be positive") - if args.timeout <= 0: - parser.error("--timeout must be positive") - if args.char_delay < 0: - parser.error("--char-delay cannot be negative") - return args - - -def main() -> int: - args = parse_args() - monitor: Monitor | None = None - - try: - memory = load_ihex(args.file) - blocks = make_blocks(memory, args.block_size) - print( - f"Loaded {len(memory)} bytes in {len(blocks)} blocks " - f"({min(memory):04X}-{max(memory):04X})" - ) - - monitor = Monitor(args.port, args.baud, args.timeout, args.char_delay) - monitor.synchronize() - - for number, (start, data) in enumerate(blocks, 1): - end = start + len(data) - 1 - for attempt in range(args.retries + 1): - try: - if attempt: - monitor.synchronize() - success, reason = write_and_verify(monitor, start, data) - except ProgramError as exc: - success, reason = False, str(exc) - if success: - print( - f"Block {number}/{len(blocks)} " - f"{start:04X}-{end:04X} verified" - ) - break - if attempt == args.retries: - raise ProgramError( - f"block {start:04X}-{end:04X} failed after " - f"{args.retries + 1} attempts: {reason}" - ) - print( - f"Retrying {start:04X}-{end:04X} " - f"({attempt + 1}/{args.retries}): {reason}", - file=sys.stderr, - ) - - print(f"Programmed and verified {len(memory)} bytes") - return 0 - except ProgramError as exc: - print(f"error: {exc}", file=sys.stderr) - return 1 - except KeyboardInterrupt: - print("\nCancelled", file=sys.stderr) - return 130 - finally: - if monitor is not None: - monitor.close() - - -if __name__ == "__main__": - raise SystemExit(main()) diff --git a/rom_layout.mk b/rom_layout.mk deleted file mode 100644 index 97b4dec..0000000 --- a/rom_layout.mk +++ /dev/null @@ -1,16 +0,0 @@ -# Authoritative ROM and resident-memory layout. -# -# Keep assignments in the simple "NAME := value" form: the build generates -# equivalent C and sdasz80 include files from these definitions. - -ROM_SIZE := 32768 - -RESIDENT_RAM_BASE := 0xC000 -RESIDENT_ROM_OFFSET := 0x0080 -RESIDENT_CODE_BASE := 0xC080 -RESIDENT_CODE_SIZE := 0x0F80 -RESIDENT_DATA_BASE := 0xF000 - -TINYBASIC_ROM_ADDRESS := 0x1400 -TAPE_LOADER_ROM_ADDRESS := 0x3000 -NASCOM_BASIC_ROM_ADDRESS := 0x4000 diff --git a/test.wav b/test.wav deleted file mode 100644 index daadff1..0000000 Binary files a/test.wav and /dev/null differ