diff --git a/12-Home computer/LM80C_64K-firmware-r1.18.asm b/12-Home computer/LM80C_64K-firmware-r1.18.asm new file mode 100644 index 0000000..122f1e4 --- /dev/null +++ b/12-Home computer/LM80C_64K-firmware-r1.18.asm @@ -0,0 +1,99 @@ +; ------------------------------------------------------------------------------ +; LM80C 64K - FIRMWARE - R1.18 +; ------------------------------------------------------------------------------ +; The following code is intended to be used with LM80C Z80-based computer +; designed by Leonardo Miliani. More info at +; www DOT leonardomiliani DOT com +; ------------------------------------------------------------------------------ +; Coding/Editing/Compiling: +; Original init code for MC68B05 by Grant Searle +; Original SIO/CTC/PIO init code by Mario Blunk +; NASCOM BASIC originally modified by Gran Searle +; Code modified and adapted for LM80C by Leonardo Miliani +; +; Edited with Visual Studio Code +; +; Compiled with SjASMPlus assembler 1.18.2 +; https://github.com/z00m128/sjasmplus +; ------------------------------------------------------------------------------ +; Copyright notes: +; Parts of the code (c) Grant Searle - free for non commercial use +; Please include this advice and the note to the attribution of the original +; version to Grant Searle if you intend to redistribuite it +; http://searle.hostei.com/grant/index.html +; eMail: home.micros01@btinternet.com +; +; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +; Parts of the code (c) Mario Blunk +; http://www.train­z.de +; +; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +; 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 +; +; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +; The following code is intended to be used with LM80C Z80-based computer +; designed by Leonardo Miliani. Code and computer schematics are released under +; the therms of the GNU GPL License 3.0 and in the form of "as is", without no +; kind of warranty: you can use them at your own risk. +; You are free to use them for any non-commercial use: you are only asked to +; maintain the copyright notices, include this advice and the note to the +; attribution of the original version to Leonardo Miliani, if you intend to +; redistribuite them. +; https://www.leonardomiliani.com +; +; Please support me by visiting the following links: +; Main project page: https://www.leonardomiliani.com +; Schematics and code: https://github.com/leomil72/LM80C +; Videos about the computer: https://www.youtube.com/user/leomil72/videos +; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer +; ------------------------------------------------------------------------------ +; set name for binary output file + OUTPUT "LM80C-64K-firmware-r1.18.bin" + +; set firmware version + DEFINE VERSION "1.18" + +; set DOS version + DEFINE DOS_VER "1.05" + +; ------------------------------------------------------------------------------ +; include the latest version of the bootloader: this sets up the address aliases, +; configure the hardware, checks if warm or cold startup and loads the BASIC interpreter + INCLUDE "../include/bootloader/bootloader-1.07.asm" + +; incude the latest version of the VDP module + INCLUDE "../include/vdp/vdp-1.08.asm" + +; incude the latest version of the PSG module + INCLUDE "../include/psg/psg-1.02.asm" + +; include the latest version of the LM80C 64K BASIC interpreter + INCLUDE "../include/basic/basic-1.13.asm" + +; include utils + INCLUDE "../include/utils/utils-r1.2.asm" + +; include the latest version of the font sets + INCLUDE "../include/vdp/6x8fonts-r16.asm" + INCLUDE "../include/vdp/8x8fonts-r18.asm" + INCLUDE "../include/vdp/logo-fonts.asm" + +; include ROM/RAM switcher + INCLUDE "../include/switcher/switcher-r1.03.asm" + +; include workspace equates + INCLUDE "../include/workspace/workspace-r1.02.asm" + +; include the latest versions of the CF & DOS modules +; do NOT move these files from this position and +; do NOT alter their order! + INCLUDE "../include/dos/dos-1.05.asm" + INCLUDE "../include/dos/bios-1.03.asm" + INCLUDE "../include/dos/buffers-1.01.asm" + +; END OF ASSEMBLY SOURCE +;------------------------------------------------------------------------------- diff --git a/12-Home computer/changelog-64k.txt b/12-Home computer/changelog-64k.txt index 59e98ad..bf94434 100644 --- a/12-Home computer/changelog-64k.txt +++ b/12-Home computer/changelog-64k.txt @@ -9,6 +9,14 @@ for the LM80C 64K Color Computer. More info at www DOT leonardomiliani DOT com P.S.: for the changelog of the LM80C Color Computer see the corresponding changelog file +--------------------------------------------------------------------------------------------- +1.18 - 20210409 + +- New keyboard shortcut: when pressing "C=" (ALT) and "CTRL" keys together, the system resets + the BASIC environment, clears the variables, clears the system stack, set the screen to + graphic mode 1, re-initialize the PSG, close any seq. file still open, reset serial lines, + and returns to the BASIC prompt; the program into memory is NOT deleted. + --------------------------------------------------------------------------------------------- 1.17 - 20210408 @@ -57,10 +65,10 @@ P.S.: for the changelog of the LM80C Color Computer see the corresponding change --------------------------------------------------------------------------------------------- 1.10 - 20210307 +- New LM80C DOS 1.0 introduced, with new BASIC commands DISK, FILES, LOAD, SAVE, ERASE. - New cold reset: by pressing the RUN/STOP key during the boot sequence, the computer restarts again and re-copy the firmware from ROM to RAM, to restore the original code and fix FW modifications made with POKEs w/o the need to power off the computer; -- Added support for LM80C DOS 1.0 and new commands DISK, FILES, LOAD, SAVE, ERASE. --------------------------------------------------------------------------------------------- 1.05 - 20210119 diff --git a/12-Home computer/LM80C_64K-firmware-r1.17.asm b/Legacy/Legacy cores/12-Home computer/LM80C_64K-firmware-r1.17.asm similarity index 100% rename from 12-Home computer/LM80C_64K-firmware-r1.17.asm rename to Legacy/Legacy cores/12-Home computer/LM80C_64K-firmware-r1.17.asm diff --git a/include/basic/basic-1.12.asm b/Legacy/Legacy cores/include/basic/basic-1.12.asm similarity index 100% rename from include/basic/basic-1.12.asm rename to Legacy/Legacy cores/include/basic/basic-1.12.asm diff --git a/include/psg/psg-1.1.asm b/Legacy/Legacy cores/include/psg/psg-1.1.asm similarity index 100% rename from include/psg/psg-1.1.asm rename to Legacy/Legacy cores/include/psg/psg-1.1.asm diff --git a/Rom/LM80C-64K-firmware-r1.18.bin b/Rom/LM80C-64K-firmware-r1.18.bin new file mode 100644 index 0000000..5871630 Binary files /dev/null and b/Rom/LM80C-64K-firmware-r1.18.bin differ diff --git a/Rom/LM80C_64K-firmware-r1.18.lst b/Rom/LM80C_64K-firmware-r1.18.lst new file mode 100644 index 0000000..c5a609a --- /dev/null +++ b/Rom/LM80C_64K-firmware-r1.18.lst @@ -0,0 +1,15006 @@ +# file opened: LM80C_64K-firmware-r1.18.asm + 1 0000 ; ------------------------------------------------------------------------------ + 2 0000 ; LM80C 64K - FIRMWARE - R1.18 + 3 0000 ; ------------------------------------------------------------------------------ + 4 0000 ; The following code is intended to be used with LM80C Z80-based computer + 5 0000 ; designed by Leonardo Miliani. More info at + 6 0000 ; www DOT leonardomiliani DOT com + 7 0000 ; ------------------------------------------------------------------------------ + 8 0000 ; Coding/Editing/Compiling: + 9 0000 ; Original init code for MC68B05 by Grant Searle + 10 0000 ; Original SIO/CTC/PIO init code by Mario Blunk + 11 0000 ; NASCOM BASIC originally modified by Gran Searle + 12 0000 ; Code modified and adapted for LM80C by Leonardo Miliani + 13 0000 ; + 14 0000 ; Edited with Visual Studio Code + 15 0000 ; + 16 0000 ; Compiled with SjASMPlus assembler 1.18.2 + 17 0000 ; https://github.com/z00m128/sjasmplus + 18 0000 ; ------------------------------------------------------------------------------ + 19 0000 ; Copyright notes: + 20 0000 ; Parts of the code (c) Grant Searle - free for non commercial use + 21 0000 ; Please include this advice and the note to the attribution of the original + 22 0000 ; version to Grant Searle if you intend to redistribuite it + 23 0000 ; http://searle.hostei.com/grant/index.html + 24 0000 ; eMail: home.micros01@btinternet.com + 25 0000 ; + 26 0000 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + 27 0000 ; Parts of the code (c) Mario Blunk + 28 0000 ; http://www.train­z.de + 29 0000 ; + 30 0000 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + 31 0000 ; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft + 32 0000 ; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 + 33 0000 ; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) + 34 0000 ; Adapted for the freeware Zilog Macro Assembler 2.10 to produce + 35 0000 ; the original ROM code (checksum A934H). PA + 36 0000 ; + 37 0000 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + 38 0000 ; The following code is intended to be used with LM80C Z80-based computer + 39 0000 ; designed by Leonardo Miliani. Code and computer schematics are released under + 40 0000 ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 41 0000 ; kind of warranty: you can use them at your own risk. + 42 0000 ; You are free to use them for any non-commercial use: you are only asked to + 43 0000 ; maintain the copyright notices, include this advice and the note to the + 44 0000 ; attribution of the original version to Leonardo Miliani, if you intend to + 45 0000 ; redistribuite them. + 46 0000 ; https://www.leonardomiliani.com + 47 0000 ; + 48 0000 ; Please support me by visiting the following links: + 49 0000 ; Main project page: https://www.leonardomiliani.com + 50 0000 ; Schematics and code: https://github.com/leomil72/LM80C + 51 0000 ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 52 0000 ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 53 0000 ; ------------------------------------------------------------------------------ + 54 0000 ; set name for binary output file + 55 0000 OUTPUT "LM80C-64K-firmware-r1.18.bin" + 56 0000 + 57 0000 ; set firmware version + 58 0000 DEFINE VERSION "1.18" + 59 0000 + 60 0000 ; set DOS version + 61 0000 DEFINE DOS_VER "1.05" + 62 0000 + 63 0000 ; ------------------------------------------------------------------------------ + 64 0000 ; include the latest version of the bootloader: this sets up the address aliases, + 65 0000 ; configure the hardware, checks if warm or cold startup and loads the BASIC interpreter + 66 0000 INCLUDE "../include/bootloader/bootloader-1.07.asm" +# file opened: ../include/bootloader/bootloader-1.07.asm + 1+ 0000 ; ------------------------------------------------------------------------------ + 2+ 0000 ; LM80C - BOOTLOADER - 1.07 + 3+ 0000 ; ------------------------------------------------------------------------------ + 4+ 0000 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 0000 ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 0000 ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 0000 ; kind of warranty: you can use them at your own risk. + 8+ 0000 ; You are free to use them for any non-commercial use: you are only asked to + 9+ 0000 ; maintain the copyright notices, include this advice and the note to the + 10+ 0000 ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 0000 ; redistribuite them. + 12+ 0000 ; https://www.leonardomiliani.com + 13+ 0000 ; + 14+ 0000 ; Please support me by visiting the following links: + 15+ 0000 ; Main project page: https://www.leonardomiliani.com + 16+ 0000 ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 0000 ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 0000 ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 0000 ; ------------------------------------------------------------------------------ + 20+ 0000 + 21+ 0000 ; ADDRESS DECODING (bits A6/A5/A4) + 22+ 0000 ; 0000xxxx : PIO + 23+ 0000 ; 0001xxxx : CTC + 24+ 0000 ; 0010xxxx : SIO + 25+ 0000 ; 0011xxxx : VDP + 26+ 0000 ; 0100xxxx : PSG + 27+ 0000 ; 0101xxxx : C.F. + 28+ 0000 + 29+ 0000 + 30+ 0000 ; ------------------------------------------------------------------------------ + 31+ 0000 ; EQUATES + 32+ 0000 ; ------------------------------------------------------------------------------ + 33+ 0000 ; label defining for PIO (Parallel Input/Output) + 34+ 0000 PIO_DA equ %00000000 + 35+ 0000 PIO_DB equ %00000001 + 36+ 0000 PIO_CA equ %00000010 + 37+ 0000 PIO_CB equ %00000011 + 38+ 0000 + 39+ 0000 ; label defining for CTC (Counter Timer Circuit) + 40+ 0000 CTC_CH0 equ %00010000 + 41+ 0000 CTC_CH1 equ %00010001 + 42+ 0000 CTC_CH2 equ %00010010 + 43+ 0000 CTC_CH3 equ %00010011 + 44+ 0000 + 45+ 0000 ;label defining for SIO (Serial Input/Output) + 46+ 0000 SIO_CA equ %00100010 + 47+ 0000 SIO_CB equ %00100011 + 48+ 0000 SIO_DA equ %00100000 + 49+ 0000 SIO_DB equ %00100001 + 50+ 0000 + 51+ 0000 ;label defining for VDP (Video Display Processor) + 52+ 0000 VDP_DAT equ %00110000 + 53+ 0000 VDP_SET equ %00110001 + 54+ 0000 + 55+ 0000 ; label defining for PSG (Programmable Sound Generator) + 56+ 0000 PSG_REG equ %01000000 + 57+ 0000 PSG_DAT equ %01000001 + 58+ 0000 + 59+ 0000 ; Interrupt-driven serial I/O interface lead by the Z80 SIO to run modified + 60+ 0000 ; NASCOM Basic 4.7 - Full input buffering with incoming data hardware handshaking + 61+ 0000 ; Handshake shows full before the buffer is totally filled to allow run-on from the sender + 62+ 0000 SER_BUFSIZE equ $58 + 63+ 0000 SER_FULLSIZE equ $50 + 64+ 0000 SER_EMPTYSIZE equ $05 + 65+ 0000 + 66+ 0000 + 67+ 0000 ;------------------------------------------------------------------------------ + 68+ 0000 ; F I R M W A R E + 69+ 0000 ;------------------------------------------------------------------------------ + 70+ 0000 ; BASE MEMORY - RESET LOCATION ($0000) -> the CPU jumps to $0000 after a reset + 71+ 0000 org $0000 + 72+ 0000 F3 RST00: di ; be sure that INTs are disabled + 73+ 0001 C3 65 53 jp ROM2RAM ; jump to ROM/RAM switcher + 74+ 0004 + 75+ 0004 ;------------------------------------------------------------------------------ + 76+ 0004 ; interrupt vector when SIO ch.B has a char available in its buffer + 77+ 0004 ;$0004 + 78+ 0004 65 01 defw RX_CHB_AVAIL + 79+ 0006 + 80+ 0006 ;------------------------------------------------------------------------------ + 81+ 0006 ; interrupt vector for SIO ch.B special conditions (i.e. buf overrun) + 82+ 0006 ;$0006 + 83+ 0006 68 01 defw SPEC_RXB_CNDT + 84+ 0008 + 85+ 0008 ;------------------------------------------------------------------------------ + 86+ 0008 ; send a character over serial ch. A + 87+ 0008 ;$0008 + 88+ 0008 C3 59 02 RST08: jp TXA + 89+ 000B FF BLOCK 1,$FF ; filler + 90+ 000C + 91+ 000C ;------------------------------------------------------------------------------ + 92+ 000C ; interrupt vector when SIO ch.A has a char available in its buffer + 93+ 000C ;$000C + 94+ 000C 00 01 defw RX_CHA_AVAIL + 95+ 000E + 96+ 000E ;------------------------------------------------------------------------------ + 97+ 000E ; interrupt vector for SIO ch.A special conditions (i.e. buf overrun) + 98+ 000E ;$000E + 99+ 000E 36 01 defw SPEC_RXA_CNDT + 100+ 0010 + 101+ 0010 ;------------------------------------------------------------------------------ + 102+ 0010 ; receive a character over serial ch. A + 103+ 0010 ;$0010 + 104+ 0010 C3 2A 02 RST10: jp RXA + 105+ 0013 FF FF FF... BLOCK 5,$FF ; filler + 106+ 0018 ;------------------------------------------------------------------------------ + 107+ 0018 ; check buffer state + 108+ 0018 + 109+ 0018 ;$0018 + 110+ 0018 C3 78 02 RST18: jp CKINCHAR + 111+ 001B FF FF FF... BLOCK $25,$FF ; filler + 112+ 0040 ;------------------------------------------------------------------------------ + 113+ 0040 ; interrupt vectors for CTC + 114+ 0040 ;$0040 ; for CH0 Timer - used in BASIC by serial 1 for bps + 115+ 0040 82 55 defw CTC0IV + 116+ 0042 ;$0042 ; for CH1 Timer - used in BASIC by serial 2 for bps + 117+ 0042 85 55 defw CTC1IV + 118+ 0044 ;$0044 ; for CH2 timer - unused + 119+ 0044 88 55 defw CTC2IV + 120+ 0046 ;$0046 ; for CH3 Timer - used by FW for 100ths/s counter + 121+ 0046 8B 55 defw CTC3IV + 122+ 0048 FF FF FF... BLOCK $1E,$FF ; filler + 123+ 0066 ;------------------------------------------------------------------------------ + 124+ 0066 ; interrupt routine for NMI + 125+ 0066 ;$0066 + 126+ 0066 C3 FD 53 jp NMIUSR ; jump to execute NMI service routine + 127+ 0069 FF FF FF... BLOCK $27,$FF ; filler + 128+ 0090 ;------------------------------------------------------------------------------ + 129+ 0090 + 130+ 0090 ;$0090 + 131+ 0090 4C 4D 38 30 defb $4C,$4D,$38,$30,$43,$20,$36,$34 + 131+ 0094 43 20 36 34 + 132+ 0098 4B 20 43 4F defb $4B,$20,$43,$4F,$4C,$4F,$52,$00 + 132+ 009C 4C 4F 52 00 + 133+ 00A0 43 4F 4D 50 defb $43,$4F,$4D,$50,$55,$54,$45,$52 + 133+ 00A4 55 54 45 52 + 134+ 00A8 20 28 32 30 defb $20,$28,$32,$30,$32,$31,$29,$00 + 134+ 00AC 32 31 29 00 + 135+ 00B0 44 65 73 69 defb $44,$65,$73,$69,$67,$6E,$65,$64 + 135+ 00B4 67 6E 65 64 + 136+ 00B8 20 62 79 00 defb $20,$62,$79,$00,$00,$00,$00,$00 + 136+ 00BC 00 00 00 00 + 137+ 00C0 4C 65 6F 6E defb $4C,$65,$6F,$6E,$61,$72,$64,$6F + 137+ 00C4 61 72 64 6F + 138+ 00C8 20 4D 69 6C defb $20,$4D,$69,$6C,$69,$61,$6E,$69 + 138+ 00CC 69 61 6E 69 + 139+ 00D0 46 57 20 31 FWVER: defm "FW ","1.18",$20,"2021-04-10",$20,"10:09:56",$00 + 139+ 00D4 2E 31 38 20 + 139+ 00D8 32 30 32 31 + 139+ 00DC 2D 30 34 2D + 139+ 00E0 31 30 20 31 + 139+ 00E4 30 3A 30 39 + 139+ 00E8 3A 35 36 00 + 140+ 00EC FMVEREND: equ $ + 141+ 00EC FF FF FF... BLOCK $100-FMVEREND,$FF ; filler + 142+ 0100 ;------------------------------------------------------------------------------ + 143+ 0100 + 144+ 0100 ;------------------------------------------------------------------------------- + 145+ 0100 ; Z80 SIO CH. A MANAGEMENT + 146+ 0100 ;------------------------------------------------------------------------------- + 147+ 0100 + 148+ 0100 ;------------------------------------------------------------------------------- + 149+ 0100 ; interrupt driven routine to get chars from Z80 SIO ch.A + 150+ 0100 ; this is the only serial channel that can print received chars onto the screen + 151+ 0100 ;$0100 + 152+ 0100 F5 RX_CHA_AVAIL: push AF ; store A + 153+ 0101 E5 push HL ; and HL + 154+ 0102 CD 8F 01 call A_RTS_OFF ; disable RTS line + 155+ 0105 DB 20 in A,(SIO_DA) ; read char from RX buffer into A + 156+ 0107 32 DA 55 ld (TMPKEYBFR),A ; store it into the temp key buffer + 157+ 010A CD FD 01 call CHARINTOBFR ; sub-routine to put the char into the input buffer + 158+ 010D D2 31 01 jp NC,LVRXCHA ; if buffer is full, then leave without doing anything else + 159+ 0110 3A DA 55 ld A,(TMPKEYBFR) ; retrieve char + 160+ 0113 32 9B 55 ld (CHR4VID),A ; write into buffer for video printing + 161+ 0116 FE 0D cp CR ; is it RETURN? + 162+ 0118 CA 20 01 jp Z,CNTRXCHA ; yes, continue + 163+ 011B FE 20 cp $20 ; is it another control char (code < 32)? + 164+ 011D DA 31 01 jp C,LVRXCHA ; yes, leave w/o printing it on video nor sending back to serial + 165+ 0120 F5 CNTRXCHA: push AF ; store char + 166+ 0121 AF xor A + 167+ 0122 32 D8 55 ld (KBDNPT),A ; a char from serial is like a char printed by BASIC + 168+ 0125 3A 9A 55 ld A,(PRNTVIDEO) ; load status of print-on-video + 169+ 0128 FE 01 cp $01 ; is the print on video on? + 170+ 012A CC 61 07 call Z,CHAR2VID ; yes, print on screen + 171+ 012D F1 pop AF ; retrieve char + 172+ 012E CD 59 02 call TXA ; send back to serial + 173+ 0131 E1 LVRXCHA: pop HL ; retrieve HL + 174+ 0132 F1 pop AF ; and A + 175+ 0133 FB ei ; re-enable interrupts + 176+ 0134 ED 4D reti ; and exit + 177+ 0136 + 178+ 0136 ;------------------------------------------------------------------------------- + 179+ 0136 ; special SIO ch.A condition (i.e., buffer overrun) + 180+ 0136 ; if buffer overruns then show an error, empty the RX buffer and send + 181+ 0136 ; a break char + 182+ 0136 F5 SPEC_RXA_CNDT: push AF ; store AF + 183+ 0137 CD 8F 01 call A_RTS_OFF ; disable RTS + 184+ 013A CD CB 01 call SIO_A_DI ; disable RX on ch. A + 185+ 013D 3A E0 55 ld A,(SERIALS_EN) ; load serial status + 186+ 0140 CB 97 res 2,A ; disable RX on port 1 + 187+ 0142 32 E0 55 ld (SERIALS_EN),A ; store new serial status + 188+ 0145 DB 01 in A,(PIO_DB) ; read status LEDs + 189+ 0147 CB E7 set 4,A ; set 5th pin ON + 190+ 0149 D3 01 out (PIO_DB),A ; send new setting + 191+ 014B 3E 30 ld A,%00110000 ; write into WR0: error reset, select WR0 + 192+ 014D D3 22 out (SIO_CA),A ; send command to SIO + 193+ 014F AF EMPTYCHABFR: xor A + 194+ 0150 D3 22 out (SIO_CA),A ; write to WR0, select RR0 + 195+ 0152 DB 22 in A,(SIO_CA) ; read RR0 register + 196+ 0154 E6 01 and $01 ; check if input buffer if empty + 197+ 0156 CA 5D 01 jp Z,CHABFREMPTY ; if yes (bit 0 = 0) then leave + 198+ 0159 DB 20 in A,(SIO_DA) ; read chars + 199+ 015B 18 F2 jr EMPTYCHABFR ; repeat + 200+ 015D F1 CHABFREMPTY: pop AF ; retrieve AF + 201+ 015E 21 9C 3E ld HL,SOERR ; return point set to Serial Buffer Overrun routine + 202+ 0161 E3 ex (SP),HL ; store onto stack + 203+ 0162 FB ei ; re-enable interrupts + 204+ 0163 ED 4D reti ; return from interrupt and execute code at SOERR + 205+ 0165 + 206+ 0165 ;------------------------------------------------------------------------------- + 207+ 0165 ; Z80 SIO CH. A MANAGEMENT + 208+ 0165 ;------------------------------------------------------------------------------- + 209+ 0165 + 210+ 0165 ;------------------------------------------------------------------------------- + 211+ 0165 ; interrupt driven routine to get chars from Z80 SIO ch.B + 212+ 0165 FB RX_CHB_AVAIL: ei + 213+ 0166 ED 4D reti + 214+ 0168 + 215+ 0168 ;------------------------------------------------------------------------------- + 216+ 0168 ; special SIO ch.A condition (i.e., buffer overrun) + 217+ 0168 ; if buffer overruns then show an error, empty the RX buffer and send + 218+ 0168 ; a break char + 219+ 0168 F5 SPEC_RXB_CNDT: push AF ; store A + 220+ 0169 CD 97 01 call B_RTS_OFF ; disable RTS + 221+ 016C CD D3 01 call SIO_B_DI ; disable RX on ch.B + 222+ 016F 3A E0 55 ld A,(SERIALS_EN) ; load serial status + 223+ 0172 CB 9F res 3,A ; disable RX on port 2 + 224+ 0174 32 E0 55 ld (SERIALS_EN),A ; store new serial status + 225+ 0177 DB 01 in A,(PIO_DB) ; read status LEDs + 226+ 0179 CB EF set 5,A ; set 5th pin ON + 227+ 017B D3 01 out (PIO_DB),A ; send new setting + 228+ 017D 3E 30 ld A,%00110000 ; write into WR0: error reset, select WR0 + 229+ 017F D3 23 out (SIO_CB),A ; send command to SIO + 230+ 0181 AF EMPTYCHBBFR: xor A + 231+ 0182 D3 23 out (SIO_CB),A ; write to WR0, select RR0 + 232+ 0184 DB 23 in A,(SIO_CB) ; read RR0 register + 233+ 0186 E6 01 and $01 ; check if input buffer if empty + 234+ 0188 CA 5D 01 jp Z,CHABFREMPTY ; if yes (bit 0 = 0) then jump to run "exit" code + 235+ 018B DB 21 in A,(SIO_DB) ; read chars + 236+ 018D 18 F2 jr EMPTYCHBBFR ; repeat + 237+ 018F + 238+ 018F + 239+ 018F ;------------------------------------------------------------------------------- + 240+ 018F ; Z80 SIO MANAGEMENT + 241+ 018F ;------------------------------------------------------------------------------- + 242+ 018F ; disable RTS: + 243+ 018F ; by resetting RTS bit (set to 0), the RTS line is disabled (HIGH) + 244+ 018F C5 A_RTS_OFF: push BC ; store BC + 245+ 0190 0E 22 ld C,SIO_CA ; select channel A + 246+ 0192 3A E1 55 ld A,(SERABITS) ; load data serial bits for ch.A + 247+ 0195 18 06 jr SIO_RTS_OFF + 248+ 0197 C5 B_RTS_OFF: push BC ; store BC + 249+ 0198 0E 23 ld C,SIO_CB ; select channel B + 250+ 019A 3A E2 55 ld A,(SERBBITS) ; load data serial bits for ch.B + 251+ 019D CB 3F SIO_RTS_OFF: srl A ; position data bits in bits #5&6 + 252+ 019F E6 60 and %01100000 ; get only bits #5&6 + 253+ 01A1 47 ld B,A ; store data bits + 254+ 01A2 3E 05 ld A,%00000101 ; write into WR0: select WR5 + 255+ 01A4 ED 79 out (C),A + 256+ 01A6 3E 88 ld A,%10001000 ; enable DTR (b7) and TX (b4), disable RTS (b1) + 257+ 01A8 B0 or B ; set data bits + 258+ 01A9 ED 79 out (C),A ; send setting + 259+ 01AB C1 pop BC ; retrieve BC + 260+ 01AC C9 ret ; exit + 261+ 01AD + 262+ 01AD ;------------------------------------------------------------------------------- + 263+ 01AD ; enable RTS + 264+ 01AD ; by setting RTS bit (set to 1), the RTS line is enabled (LOW) + 265+ 01AD C5 A_RTS_ON: push BC ; store BC + 266+ 01AE 0E 22 ld C,SIO_CA ; select channel A + 267+ 01B0 3A E1 55 ld A,(SERABITS) ; load data serial bits for ch.A + 268+ 01B3 18 06 jr SIO_RTS_ON + 269+ 01B5 C5 B_RTS_ON: push BC ; store BC + 270+ 01B6 0E 23 ld C,SIO_CB ; select channel B + 271+ 01B8 3A E2 55 ld A,(SERBBITS) ; load data serial bits for ch.B + 272+ 01BB CB 3F SIO_RTS_ON: srl A ; position data bits in bits #5&6 + 273+ 01BD E6 60 and %01100000 ; get only bits #5&6 + 274+ 01BF 47 ld B,A ; store data bits + 275+ 01C0 3E 05 ld A,%00000101 ; write into WR0: select WR5 + 276+ 01C2 ED 79 out (C),A + 277+ 01C4 3E 8A ld A,%10001010 ; enable DTR (b7), TX (b4), and RTS (b1) + 278+ 01C6 B0 or B ; set data bits + 279+ 01C7 ED 79 out (C),A ; send setting + 280+ 01C9 C1 pop BC ; retrieve BC + 281+ 01CA C9 ret ; return + 282+ 01CB + 283+ 01CB ;------------------------------------------------------------------------------- + 284+ 01CB ; disable SIO RX channel + 285+ 01CB C5 SIO_A_DI: push BC ; store BC + 286+ 01CC 0E 22 ld C,SIO_CA ; SIO channel A + 287+ 01CE 3A E1 55 ld A,(SERABITS) ; load data serial bits for ch.A + 288+ 01D1 18 06 jr SIO_RXDI ; jump to disable RX + 289+ 01D3 C5 SIO_B_DI: push BC ; store BC + 290+ 01D4 0E 23 ld C,SIO_CB ; SIO channel B + 291+ 01D6 3A E2 55 ld A,(SERBBITS) ; load data serial bits for ch.B + 292+ 01D9 47 SIO_RXDI: ld B,A ; store data bits + 293+ 01DA 3E 03 ld A,%00000011 ; write into WR0: select WR3 + 294+ 01DC ED 79 out (C),A + 295+ 01DE 78 ld A,B ; retrieve data bits; RX disabled; auto enable is OFF + 296+ 01DF ED 79 out (C),A + 297+ 01E1 C1 pop BC ; retrieve BC + 298+ 01E2 C9 ret ; return + 299+ 01E3 + 300+ 01E3 ;------------------------------------------------------------------------------- + 301+ 01E3 ; enable SIO RX channel + 302+ 01E3 C5 SIO_A_EI: push BC ; store BC + 303+ 01E4 0E 22 ld C,SIO_CA + 304+ 01E6 3A E1 55 ld A,(SERABITS) ; load data serial bits for ch.A + 305+ 01E9 18 06 jr SIO_RXEN + 306+ 01EB C5 SIO_B_EI: push BC ; store BC + 307+ 01EC 0E 23 ld C,SIO_CB + 308+ 01EE 3A E2 55 ld A,(SERBBITS) ; load data serial bits for ch.B + 309+ 01F1 47 SIO_RXEN: ld B,A ; store data bits + 310+ 01F2 3E 03 ld A,%00000011 ; write into WR0: select WR3 + 311+ 01F4 ED 79 out (C),A ; select register + 312+ 01F6 78 ld A,B ; retrieve data bits + 313+ 01F7 CB C7 set 0,A ; set RX enabled; auto enable is OFF + 314+ 01F9 ED 79 out (C),A ; send settings to SIO + 315+ 01FB C1 pop BC ; retrieve BC + 316+ 01FC C9 ret + 317+ 01FD + 318+ 01FD ;------------------------------------------------------------------------------ + 319+ 01FD ; put a char into the input buffer, char is into A + 320+ 01FD ; this sub is called both from the ISR "RX_CHA_AVAIL" and when + 321+ 01FD ; the RETURN key is pressed on the keyboard + 322+ 01FD F5 CHARINTOBFR: push AF ; store it + 323+ 01FE 3A F8 53 ld A,(serBufUsed) ; load buffer size + 324+ 0201 FE 58 cp SER_BUFSIZE ; if buffer is not full + 325+ 0203 DA 08 02 jp C,NOTFULL ; then store the char + 326+ 0206 F1 pop AF ; else drop it + 327+ 0207 C9 ret ; and exit + 328+ 0208 2A F4 53 NOTFULL: ld HL,(serInPtr) ; buffer is not full, can store the char + 329+ 020B 23 inc HL ; load pointer to find first free cell + 330+ 020C 7D ld A,L ; only check low byte because buffer<256 + 331+ 020D FE F4 cp bufWrap ; check if the pointer is at the last cell + 332+ 020F 20 03 jr NZ,NOTWRAP ; if not then continue + 333+ 0211 21 9C 53 ld HL,SERBUF_START ; else load the address of the first cell + 334+ 0214 22 F4 53 NOTWRAP: ld (serInPtr),HL ; store the new pointer + 335+ 0217 F1 pop AF ; then retrieve the char... + 336+ 0218 77 ld (HL),A ; ...and store it in the appropriate cell + 337+ 0219 21 F8 53 ld HL,serBufUsed ; size of the input buffer + 338+ 021C 34 inc (HL) ; increment it + 339+ 021D 3E 50 ld A,SER_FULLSIZE ; input buffer capacity + 340+ 021F BE cp (HL) ; check if input buffer is full + 341+ 0220 D8 ret C ; exit if buffer is not full + 342+ 0221 3A E0 55 ld A,(SERIALS_EN) ; check if serial 1 is open + 343+ 0224 1F rra ; bit 0 into Carry: if Carry is 1 then serial 0 is open and... + 344+ 0225 DC 8F 01 call C,A_RTS_OFF ; ...receiving further chars must be stopped + 345+ 0228 37 scf ; set Carry flag, because we must inform that the char has been added before to disable RTS + 346+ 0229 C9 ret + 347+ 022A + 348+ 022A + 349+ 022A ;------------------------------------------------------------------------------- + 350+ 022A ; retrieve a char from the input buffer + 351+ 022A 3A F8 53 RXA: ld A,(serBufUsed) ; load the buffer size + 352+ 022D A7 and A ; check if it's 0 (empty) + 353+ 022E CA 2A 02 jp Z,RXA ; if it's empty, wait for a char + 354+ 0231 F3 di ; disable interrupts + 355+ 0232 E5 push HL ; store HL + 356+ 0233 2A F6 53 ld HL,(serRdPtr) ; load pointer to first available char + 357+ 0236 23 inc HL ; increment it (go to the next char) + 358+ 0237 7D ld A,L ; check if the end of the buffer has been reached + 359+ 0238 FE F4 cp bufWrap ; (only check low byte because buffer<256) + 360+ 023A 20 03 jr NZ,NOTRDWRAP ; if not, jump straight + 361+ 023C 21 9C 53 ld HL,SERBUF_START ; else reload the starting address of the buffer + 362+ 023F 22 F6 53 NOTRDWRAP: ld (serRdPtr),HL ; store new pointer to the next char to read + 363+ 0242 3A F8 53 ld A,(serBufUsed) ; load buffer size + 364+ 0245 3D dec A ; decrement it + 365+ 0246 32 F8 53 ld (serBufUsed),A ; and store the new size + 366+ 0249 FE 05 cp SER_EMPTYSIZE ; check if input buffer can be considered empty + 367+ 024B 30 08 jr NC,RXA_EXIT ; if not empty yet, then exit + 368+ 024D 3A E0 55 ld A,(SERIALS_EN) ; load serial state + 369+ 0250 EE 05 xor %00000101 ; check if serial 1 is open and RX enabled + 370+ 0252 CC AD 01 call Z,A_RTS_ON ; yes, set RTS on + 371+ 0255 7E RXA_EXIT: ld A,(HL) ; recover the char and return it into A + 372+ 0256 E1 pop HL ; retrieve HL + 373+ 0257 FB ei ; re-enable interrupts + 374+ 0258 C9 ret ; return + 375+ 0259 + 376+ 0259 ;------------------------------------------------------------------------------ + 377+ 0259 ; sends a char over the serial - char is into A + 378+ 0259 F5 TXA: push AF ; store AF + 379+ 025A C5 push BC ; store BC + 380+ 025B 47 ld B,A ; store char + 381+ 025C 3A E0 55 ld A,(SERIALS_EN) ; load serial status + 382+ 025F EE 05 xor %00000101 ; check if serial 1 is open and RX is enabled + 383+ 0261 20 06 jr NZ,TXA_EXIT ; no, jump over + 384+ 0263 78 ld A,B ; retrieve char + 385+ 0264 D3 20 out (SIO_DA),A ; send char to the SIO + 386+ 0266 CD 6C 02 call TX_EMP ; wait for outgoing char to be sent + 387+ 0269 C1 TXA_EXIT: pop BC ; retrieve BC + 388+ 026A F1 pop AF ; retrieve AF + 389+ 026B C9 ret ; return + 390+ 026C + 391+ 026C ;------------------------------------------------------------------------------ + 392+ 026C ; wait until outgoing serial has been sent + 393+ 026C 97 TX_EMP: sub A ; set A to 0 + 394+ 026D 3C inc A ; set A to 1 + 395+ 026E D3 22 out (SIO_CA),A ; write to WR0, select RR1 + 396+ 0270 DB 22 in A,(SIO_CA) ; read RR1 register + 397+ 0272 CB 47 bit 0,A ; check if all chars have been sent + 398+ 0274 CA 6C 02 jp Z,TX_EMP ; if not (bit 0 = 0) then retrieve + 399+ 0277 C9 ret ; else exit + 400+ 0278 + 401+ 0278 + 402+ 0278 ;------------------------------------------------------------------------------ + 403+ 0278 ; check if there is some chars into the buffer + 404+ 0278 3A F8 53 CKINCHAR: ld A,(serBufUsed) ; load buffer size + 405+ 027B A7 and A ; compare to 0 + 406+ 027C C9 ret ; return + 407+ 027D + 408+ 027D ;------------------------------------------------------------------------------ + 409+ 027D ; print a text from memory, and terminate when $00 is found + 410+ 027D 7E RAWPRINT: ld A,(HL) ; load character from memory cell pointed by HL + 411+ 027E B7 or A ; is it $00 (end string)? + 412+ 027F C8 ret Z ; Yes, then return + 413+ 0280 32 9B 55 ld (CHR4VID),A ; store char + 414+ 0283 F3 di + 415+ 0284 CD 61 07 call CHAR2VID ; and send it to screen + 416+ 0287 FB ei + 417+ 0288 23 inc HL ; and select the next one + 418+ 0289 18 F2 jr RAWPRINT ; repeat + 419+ 028B + 420+ 028B ;------------------------------------------------- + 421+ 028B ; Interrupt service routine (ISR) for CH3 timer + 422+ 028B ; this is used to increment the 100ths of a second counter and for cursor flashing + 423+ 028B F5 CH3_TIMER: push AF ; save regs. A, + 424+ 028C C5 push BC ; BC, + 425+ 028D D5 push DE ; DE, + 426+ 028E E5 push HL ; HL + 427+ 028F 21 7E 55 ld HL,TMRCNT ; load starting address of the timer + 428+ 0292 06 04 ld B,$04 ; 4 bytes to check + 429+ 0294 34 INCTMR3: inc (HL) ; increment timer + 430+ 0295 20 03 jr NZ,CHKCRSR ; if not zero then exit (finished increment) + 431+ 0297 23 inc HL ; if yes, there was an overflow, so increment next byte + 432+ 0298 10 FA djnz INCTMR3 ; repeat for 4 bytes + 433+ 029A CD CB 07 CHKCRSR: call FLASHCURSOR ; call the flashing cursor routine + 434+ 029D CD F3 0C call MNGSNDS ; call the tone managemenet + 435+ 02A0 3A 7E 55 ld A,(TMRCNT) ; check for keyboard management + 436+ 02A3 1F rra ; bit 0 = 1 ? + 437+ 02A4 D4 58 0D call NC,KEYBOARD ; no, so read the keyboard inputs + 438+ 02A7 E1 pop HL ; retrieve HL, + 439+ 02A8 D1 pop DE ; DE, + 440+ 02A9 C1 pop BC ; BC, + 441+ 02AA F1 pop AF ; and A + 442+ 02AB FB ei ; re-enable interrupts + 443+ 02AC ED 4D reti ; exit from ISR + 444+ 02AE + 445+ 02AE ;------------------------------------------------------------------------------ + 446+ 02AE ; HARDWARE INITIALISATION + 447+ 02AE ;------------------------------------------------------------------------------ + 448+ 02AE ; first run - setup HW & SW + 449+ 02AE ; (on LN80C 64K runs from RAM) + 450+ 02AE 21 2B 55 INIT_HW: ld HL,TEMPSTACK ; load temp stack pointer + 451+ 02B1 F9 INIT_HW2: ld SP,HL ; set stack to temp stack pointer + 452+ 02B2 21 9C 53 ld HL,SERBUF_START ; set beginning of input buffer + 453+ 02B5 22 F4 53 ld (serInPtr),HL ; for incoming chars to store into buffer + 454+ 02B8 22 F6 53 ld (serRdPtr),HL ; and for chars to be read from buffer + 455+ 02BB AF xor A ; reset A + 456+ 02BC 32 F8 53 ld (serBufUsed),A ; actual buffer size is 0 + 457+ 02BF 32 E0 55 ld (SERIALS_EN),A ; set serial ports status to OFF + 458+ 02C2 CD 40 03 call initCTC ; configure CTC, then... + 459+ 02C5 CD 91 0C call initPSG ; ...configure PSG + 460+ 02C8 CD F2 04 call SHOW_LOGO ; show computer logo + 461+ 02CB 1E 01 ld E,$01 ; E chooses the video mode (graphics 1) + 462+ 02CD CD D1 03 call initVDP ; set video display + 463+ 02D0 AF xor A + 464+ 02D1 ED 47 ld I,A ; set high byte of interrupt vectors to point to page 0 + 465+ 02D3 ED 5E im 2 ; interrupt mode 2 + 466+ 02D5 FB ei ; enable interrupts + 467+ 02D6 ; print system messages + 468+ 02D6 AF xor A ; A=0 so... + 469+ 02D7 32 D8 55 ld (KBDNPT),A ; ...inputs don't come from keyboard + 470+ 02DA 3C inc A ; A=1... + 471+ 02DB 32 9A 55 ld (PRNTVIDEO),A ; ...to activate the print-on-video + 472+ 02DE 21 76 03 ld HL,MSGTXT1 ; sign-on message + 473+ 02E1 CD 7D 02 call RAWPRINT ; print message + 474+ 02E4 3A F9 53 ld A,(basicStarted); check if BASIC is already started + 475+ 02E7 FE 59 cp 'Y' ; to see if this is a power-up + 476+ 02E9 20 19 jr NZ,COLDSTART ; if not, then do a COLD start + 477+ 02EB 21 B4 03 ld HL,MSGTXT2 ; message to choose kind of start + 478+ 02EE CD 7D 02 call RAWPRINT ; print message + 479+ 02F1 CD 2D 09 call CURSOR_ON ; enable cursor + 480+ 02F4 AF xor A + 481+ 02F5 32 9A 55 ld (PRNTVIDEO),A ; disable print-on-video + 482+ 02F8 CD 2A 02 CORW: call RXA ; look for a pressed key + 483+ 02FB E6 DF and %11011111 ; only UPPERCASE char + 484+ 02FD FE 43 cp 'C' ; cold start? + 485+ 02FF 20 0E jr NZ,CHECKWARM ; no, let's check for warm start + 486+ 0301 CD 1C 03 call ECHO_CHAR ; echoes the char + 487+ 0304 3E 59 COLDSTART: ld A,'Y' ; yes, set the "BASIC started" flag + 488+ 0306 32 F9 53 ld (basicStarted),A + 489+ 0309 CD 42 09 call CURSOR_OFF ; disable cursor + 490+ 030C C3 FA 12 jp COLD ; start BASIC COLD + 491+ 030F FE 57 CHECKWARM: cp 'W' + 492+ 0311 20 E5 jr NZ,CORW ; char not recognized, wait again + 493+ 0313 CD 1C 03 call ECHO_CHAR ; echoes the char + 494+ 0316 CD 42 09 call CURSOR_OFF ; disable cursor + 495+ 0319 C3 FD 12 jp WARM ; start BASIC WARM + 496+ 031C + 497+ 031C ;------------------------------------------------------------------------------- + 498+ 031C ; send back char received through ch. A + 499+ 031C 32 9B 55 ECHO_CHAR: ld (CHR4VID),A ; set char for video printing + 500+ 031F AF xor A + 501+ 0320 32 D8 55 ld (KBDNPT),A ; input is not from keyboard + 502+ 0323 F3 di ; disable INTs + 503+ 0324 CD 61 07 call CHAR2VID ; echoes back the pressed key, + 504+ 0327 3E 0D ld A,CR ; then set a CR + 505+ 0329 32 9B 55 ld (CHR4VID),A ; set char for video printing + 506+ 032C CD 61 07 call CHAR2VID ; and send it to screen + 507+ 032F FB ei ; re-enable INTs + 508+ 0330 3E 01 ld A,$01 + 509+ 0332 32 9A 55 ld (PRNTVIDEO),A ; re-enable video printing + 510+ 0335 C9 ret ; return to caller + 511+ 0336 + 512+ 0336 + 513+ 0336 ;------------------------------------------------------------------------------- + 514+ 0336 ; Z80 SIO default settings for serial channels + 515+ 0336 30 SIO_A_SETS: defb %00110000 ; write into WR0: error reset, select WR0 + 516+ 0337 18 defb %00011000 ; write into WR0: channel reset + 517+ 0338 04 defb %00000100 ; write into WR0: select WR4 + 518+ 0339 44 defb %01000100 ; write into WR4: presc. 16x, 1 stop bit, no parity + 519+ 033A 05 defb %00000101 ; write into WR0: select WR5 + 520+ 033B E8 defb %11101000 ; write into WR5: DTR on, TX 8 bits, BREAK off, TX on, RTS off + 521+ 033C 01 SIO_B_SETS: defb %00000001 ; write into WR0: select WR1 + 522+ 033D 04 defb %00000100 ; write into WR1: status affects interrupt vectors + 523+ 033E 02 defb %00000010 ; write into WR0: select WR2 + 524+ 033F 00 defb %00000000 ; write into WR2: set interrupt vector, but bits D3/D2/D1 of this vector + 525+ 0340 ; will be affected by the channel & condition that raised the interrupt + 526+ 0340 ; (see datasheet): in our example, 0x0C for Ch.A receiving A char, 0x0E + 527+ 0340 ; for special conditions + 528+ 0340 ;------------------------------------------------------------------------------ + 529+ 0340 ; Z80 CTC SETTING UP + 530+ 0340 ;------------------------------------------------------------------------------ + 531+ 0340 initCTC: + 532+ 0340 21 6A 03 ld HL,CTCCONF ; CTC configuration + 533+ 0343 11 82 55 ld DE,CTC0IV ; CTC interrupt vector table + 534+ 0346 01 0C 00 ld BC,$000C ; 12 bytes + 535+ 0349 ED B0 ldir ; copy data + 536+ 034B ;CH0, CH1, & CH2 disabled + 537+ 034B 3E 03 ld A,%00000011 ; interrupt off, timer mode, prescaler=16, don't care ext. TRG edge, + 538+ 034D ; start timer on loading constant, no time constant follows, software reset, command word + 539+ 034D D3 10 out (CTC_CH0),A ; set CH0 + 540+ 034F D3 11 out (CTC_CH1),A ; set CH1 + 541+ 0351 D3 12 out (CTC_CH2),A ; set CH2 + 542+ 0353 ;init CH3 + 543+ 0353 ;CH3 divides CPU CLK by 144*256 providing an interrupt signal at 100 Hz (1/100 sec). + 544+ 0353 ;f = CPU_CLK/(144*256) => 3,686,400 / ( 36,864 ) => 100Hz + 545+ 0353 3E A7 ld A,%10100111 ; interrupt on; timer mode; prescaler=256; don't care ext; automatic trigger; + 546+ 0355 ; time constant follows; cont. operation; command word + 547+ 0355 D3 13 out (CTC_CH3),A ; send to CH3 + 548+ 0357 3E 90 ld A,$90 ; time constant - 90$ (144d) + 549+ 0359 D3 13 out (CTC_CH3),A ; send to CH3 + 550+ 035B 3E 40 ld A,%01000000 ; D7..D3 provide the first part of the int vector (in our case, $0100), followed by + 551+ 035D ; D2..D1, provided by the CTC (they point to the channel), D0=interrupt word + 552+ 035D ; so int vector is 01000xx00 + 553+ 035D D3 10 out (CTC_CH0),A ; send to CTC + 554+ 035F ; reset cells of 100ths of a second counter + 555+ 035F AF xor A ; reset A + 556+ 0360 21 7E 55 ld HL,TMRCNT ; load TMR pointer + 557+ 0363 06 04 ld B,$04 ; 4 memory cells + 558+ 0365 77 RESTMR: ld (HL),A ; reset n-cell of TMR + 559+ 0366 23 inc HL ; next cell + 560+ 0367 10 FC djnz RESTMR ; repeat for 4 cells + 561+ 0369 C9 ret + 562+ 036A + 563+ 036A + 564+ 036A ;------------------------------------------------------------------------------ + 565+ 036A ; jump table for CHx interrupts + 566+ 036A FB ED 4D CTCCONF: defb $FB,$ED,$4D ; CTC0 interrupt vector (ei; reti) + 567+ 036D FB ED 4D defb $FB,$ED,$4D ; CTC1 interrupt vector (ei; reti) + 568+ 0370 FB ED 4D defb $FB,$ED,$4D ; CTC2 interrupt vector (ei; reti) + 569+ 0373 C3 8B 02 jp CH3_TIMER ; CTC3 interrupt vector (jump to execute sys-tick timer) + 570+ 0376 + 571+ 0376 + 572+ 0376 ;------------------------------------------------------------------------------ + 573+ 0376 ; welcome messages + 574+ 0376 MSGTXT1: + 575+ 0376 20 20 20 20 defm " LM80C 64K Color Computer",CR + 575+ 037A 4C 4D 38 30 + 575+ 037E 43 20 36 34 + 575+ 0382 4B 20 43 6F + 575+ 0386 6C 6F 72 20 + 575+ 038A 43 6F 6D 70 + 575+ 038E 75 74 65 72 + 575+ 0392 0D + 576+ 0393 20 62 79 20 defm " by Leonardo Miliani * FW R","1.18",CR,0 + 576+ 0397 4C 65 6F 6E + 576+ 039B 61 72 64 6F + 576+ 039F 20 4D 69 6C + 576+ 03A3 69 61 6E 69 + 576+ 03A7 20 2A 20 46 + 576+ 03AB 57 20 52 31 + 576+ 03AF 2E 31 38 0D + 576+ 03B3 00 + 577+ 03B4 0D MSGTXT2: defb CR + 578+ 03B5 20 20 20 3C defm " old or arm start? ",0 + 578+ 03B9 43 3E 6F 6C + 578+ 03BD 64 20 6F 72 + 578+ 03C1 20 3C 57 3E + 578+ 03C5 61 72 6D 20 + 578+ 03C9 73 74 61 72 + 578+ 03CD 74 3F 20 00 + 579+ 03D1 +# file closed: ../include/bootloader/bootloader-1.07.asm + 67 03D1 + 68 03D1 ; incude the latest version of the VDP module + 69 03D1 INCLUDE "../include/vdp/vdp-1.08.asm" +# file opened: ../include/vdp/vdp-1.08.asm + 1+ 03D1 ; ------------------------------------------------------------------------------ + 2+ 03D1 ; LM80C - VDP ROUTINES - 1.08 + 3+ 03D1 ; ------------------------------------------------------------------------------ + 4+ 03D1 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 03D1 ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 03D1 ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 03D1 ; kind of warranty: you can use them at your own risk. + 8+ 03D1 ; You are free to use them for any non-commercial use: you are only asked to + 9+ 03D1 ; maintain the copyright notices, include this advice and the note to the + 10+ 03D1 ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 03D1 ; redistribuite them. + 12+ 03D1 ; https://www.leonardomiliani.com + 13+ 03D1 ; + 14+ 03D1 ; Please support me by visiting the following links: + 15+ 03D1 ; Main project page: https://www.leonardomiliani.com + 16+ 03D1 ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 03D1 ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 03D1 ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 03D1 ; ------------------------------------------------------------------------------ + 20+ 03D1 ; + 21+ 03D1 ;------------------------------------------------------------------------------ + 22+ 03D1 ; VDP INITIALISATION + 23+ 03D1 ; initialize VDP for a specific graphics mode + 24+ 03D1 ; INPUT: E -> contains the graphics mode: + 25+ 03D1 ; 0=text; 1=graphics 1; 2=graphics 2; 3=multicolor; 4=extended graphics 2 + 26+ 03D1 D5 initVDP: push DE ; store E + 27+ 03D2 CD CF 0A call EMPTY_VRAM ; reset VRAM + 28+ 03D5 CD ED 0A call SET_GFX_MODE ; load register settings + 29+ 03D8 CD E2 0A call CLR_RAM_REG ; reset RAM registers + 30+ 03DB D1 pop DE ; restore reg. E + 31+ 03DC AF xor A ; reset A + 32+ 03DD 47 ld B,A ; reset B (will be used later) + 33+ 03DE 7B ld A,E ; move E into A + 34+ 03DF 32 90 55 ld (SCR_MODE),A ; store screen mode + 35+ 03E2 FE 01 cp $01 ; is it graphics 1 (A=1)? + 36+ 03E4 CA 20 04 jp Z,G1MD ; yes, jump over + 37+ 03E7 FE 02 cp $02 ; is it graphics 2 (A=2)? + 38+ 03E9 CA 60 04 jp Z,G2MD ; yes, jump over + 39+ 03EC FE 03 cp $03 ; is it multicolor (A=3)? + 40+ 03EE CA 82 04 jp Z,MCMD ; yes, jump over + 41+ 03F1 FE 04 cp $04 ; is it extended graphics 2 (A=4)? + 42+ 03F3 CA A5 04 jp Z,EXG2MD ; yes, jump over + 43+ 03F6 ; otherwise, it must be $00 so we assume that it's text mode + 44+ 03F6 + 45+ 03F6 ; LOAD VDP SETTINGS FOR SELECTED VIDEO MODE: + 46+ 03F6 + 47+ 03F6 ; TEXT MODE (G0) + 48+ 03F6 ; load charset + 49+ 03F6 60 TXTMD: ld H,B + 50+ 03F7 68 ld L,B ; HL=first pattern cell $0000 + 51+ 03F8 CD 09 0B call LOADCHARSET ; load patterns into VRAM + 52+ 03FB ; set cursor & video overlay + 53+ 03FB AF xor A ; reset A + 54+ 03FC 32 93 55 ld (SCR_CURS_X),A ; set cursor position at X=0 + 55+ 03FF 32 94 55 ld (SCR_CURS_Y),A ; and Y=0 + 56+ 0402 3E 05 ld A,$05 ; light blue + 57+ 0404 32 9D 55 ld (BKGNDCLR),A ; set background/border color + 58+ 0407 3E 28 ld A,$28 + 59+ 0409 32 8E 55 ld (SCR_SIZE_W),A ; screen width = 40 cols + 60+ 040C 3E 18 ld A,$18 + 61+ 040E 32 8F 55 ld (SCR_SIZE_H),A ; screen height = 24 rows + 62+ 0411 3E 1E ld A,$1E + 63+ 0413 32 3F 54 ld (COMMAN),A ; width for commas (4 columns) + 64+ 0416 11 00 08 ld DE,$0800 + 65+ 0419 ED 53 91 55 ld (SCR_NAM_TB),DE ; set name table address + 66+ 041D C3 E7 04 jp ENDVDPSET ; execute the rest of the video setting + 67+ 0420 + 68+ 0420 ; GRAPHICS 1 MODE (G1) + 69+ 0420 ; load pattern table + 70+ 0420 68 G1MD: ld L,B + 71+ 0421 60 ld H,B ; HL=first pattern cell $0000 + 72+ 0422 CD 09 0B call LOADCHARSET ; load patterns into VRAM + 73+ 0425 ; set cursor & video overlay + 74+ 0425 AF xor A ; position cursor + 75+ 0426 32 93 55 ld (SCR_CURS_X),A ; at X=0 + 76+ 0429 32 94 55 ld (SCR_CURS_Y),A ; and Y=0 + 77+ 042C 3E 20 ld A,$20 + 78+ 042E 32 8E 55 ld (SCR_SIZE_W),A ; screen width = 32 cols + 79+ 0431 3E 18 ld A,$18 + 80+ 0433 32 8F 55 ld (SCR_SIZE_H),A ; screen height = 24 rows + 81+ 0436 3E 14 ld A,$14 + 82+ 0438 32 3F 54 ld (COMMAN),A ; width for commas (3 columns) + 83+ 043B 11 00 18 ld DE,$1800 + 84+ 043E ED 53 91 55 ld (SCR_NAM_TB),DE ; set name table address + 85+ 0442 ; load color table + 86+ 0442 21 00 20 ld HL,$2000 ; color table start: $2000 + 87+ 0445 CD 70 06 call SETVDPADRS + 88+ 0448 3E 01 ld A,$01 ; foreground color... + 89+ 044A 32 9C 55 ld (FRGNDCLR),A ; ...set to black + 90+ 044D 3E 0F ld A,$0F ; background color... + 91+ 044F 32 9D 55 ld (BKGNDCLR),A ; ...set to white + 92+ 0452 3E 1F ld A,$1F ; reg.A loaded with colors for chars: bloack pixels on white background + 93+ 0454 06 20 ld B,$20 ; 32 bytes of colors + 94+ 0456 0D dec C ; VDP data mode + 95+ 0457 ED 79 LDCLRTBMD1: out (C),A ; after the first byte, the VDP autoincrements VRAM pointer + 96+ 0459 00 nop + 97+ 045A 00 nop + 98+ 045B 10 FA djnz LDCLRTBMD1 ; repeat for 32 bytes + 99+ 045D C3 E7 04 jp ENDVDPSET ; execute the rest of the video setting + 100+ 0460 + 101+ 0460 ; GRAPHICS 2 MODE (G2) + 102+ 0460 AF G2MD: xor A ; position cursor + 103+ 0461 32 93 55 ld (SCR_CURS_X),A ; at X=0 + 104+ 0464 32 94 55 ld (SCR_CURS_Y),A ; and Y=0 + 105+ 0467 32 8E 55 ld (SCR_SIZE_W),A ; screen width = 256 pixels (0=256) + 106+ 046A 3C inc A ; black on... + 107+ 046B 32 9C 55 ld (FRGNDCLR),A ; ...foreground + 108+ 046E 3E 0F ld A,$0F ; white on... + 109+ 0470 32 9D 55 ld (BKGNDCLR),A ; ...background + 110+ 0473 3E C0 ld A,$C0 + 111+ 0475 32 8F 55 ld (SCR_SIZE_H),A ; screen height = 192 pixels + 112+ 0478 11 00 18 ld DE,$1800 + 113+ 047B ED 53 91 55 ld (SCR_NAM_TB),DE ; set name table address + 114+ 047F C3 E7 04 jp ENDVDPSET ; execute the rest of the video setting + 115+ 0482 + 116+ 0482 ; MULTICOLOR MODE (G3) + 117+ 0482 AF MCMD: xor A ; position cursor + 118+ 0483 32 93 55 ld (SCR_CURS_X),A ; at X=0 + 119+ 0486 32 94 55 ld (SCR_CURS_Y),A ; and Y=0 + 120+ 0489 3E 0F ld A,$0F ; white color for... + 121+ 048B 32 9D 55 ld (BKGNDCLR),A ; ...background and... + 122+ 048E 32 9C 55 ld (FRGNDCLR),A ; ...foreground (even this is not used in MC) + 123+ 0491 3E 40 ld A,$40 + 124+ 0493 32 8E 55 ld (SCR_SIZE_W),A ; screen width = 64 blocks + 125+ 0496 3E 30 ld A,$30 + 126+ 0498 32 8F 55 ld (SCR_SIZE_H),A ; screen height = 48 blocks + 127+ 049B 11 00 08 ld DE,$0800 + 128+ 049E ED 53 91 55 ld (SCR_NAM_TB),DE ; set name table address + 129+ 04A2 C3 E7 04 jp ENDVDPSET ; execute the rest of the video setting + 130+ 04A5 + 131+ 04A5 ; EXTENDED GRAPHICS 2 (G4) + 132+ 04A5 EXG2MD: ; load pattern table + 133+ 04A5 60 ld H,B + 134+ 04A6 68 ld L,B ; HL=first pattern cell $0000 + 135+ 04A7 CD 09 0B call LOADCHARSET ; load patterns into VRAM + 136+ 04AA ; set cursor & video overlay + 137+ 04AA AF xor A ; position cursor + 138+ 04AB 32 93 55 ld (SCR_CURS_X),A ; at X=0 + 139+ 04AE 32 94 55 ld (SCR_CURS_Y),A ; and Y=0 + 140+ 04B1 3E 20 ld A,$20 + 141+ 04B3 32 8E 55 ld (SCR_SIZE_W),A ; screen width = 32 cols + 142+ 04B6 3E 18 ld A,$18 + 143+ 04B8 32 8F 55 ld (SCR_SIZE_H),A ; screen height = 24 rows + 144+ 04BB 3E 14 ld A,$14 + 145+ 04BD 32 3F 54 ld (COMMAN),A ; width for commas (3 columns) + 146+ 04C0 11 00 38 ld DE,$3800 + 147+ 04C3 ED 53 91 55 ld (SCR_NAM_TB),DE ; set name table address + 148+ 04C7 ; load color table + 149+ 04C7 21 00 20 ld HL,$2000 ; color table start: $2000 + 150+ 04CA CD 70 06 call SETVDPADRS + 151+ 04CD 3E 01 ld A,$01 ; foreground color is... + 152+ 04CF 32 9C 55 ld (FRGNDCLR),A ; ...set to black + 153+ 04D2 3E 0F ld A,$0F ; whitefor... + 154+ 04D4 32 9D 55 ld (BKGNDCLR),A ; ...background + 155+ 04D7 3E 1F ld A,$1F ; reg.A loaded with colors for chars: bloack pixels on white background + 156+ 04D9 16 08 ld D,$08 ; 8 pages of + 157+ 04DB 06 00 ld B,$00 ; 256 bytes of colors (total of 2,048 cells) + 158+ 04DD 0D dec C ; VDP data mode + 159+ 04DE ED 79 LDCLRTBEX2: out (C),A ; after first byte, the VDP autoincrements VRAM pointer + 160+ 04E0 00 nop + 161+ 04E1 00 nop + 162+ 04E2 10 FA djnz LDCLRTBEX2 ; repeat for 256 bytes + 163+ 04E4 15 dec D ; did we fill up all the cells? + 164+ 04E5 20 F7 jr NZ,LDCLRTBEX2 ; no, repeat + 165+ 04E7 ; LAST VDP SETTINGS + 166+ 04E7 CD 42 09 ENDVDPSET: call CURSOR_OFF ; disable cursor + 167+ 04EA CD E2 05 call EMPTYVIDBUF ; empty video buffer + 168+ 04ED AF xor A + 169+ 04EE 32 97 55 ld (SCR_ORG_CHR),A ; store byte used tochar used to empty the video buffer + 170+ 04F1 C9 ret ; return to caller + 171+ 04F2 + 172+ 04F2 + 173+ 04F2 ; show initial logo + 174+ 04F2 CD CF 0A SHOW_LOGO: call EMPTY_VRAM ; reset VRAM + 175+ 04F5 ; set VDP for G2 mode + 176+ 04F5 06 07 ld B,$07 ; set only the first 7 registers + 177+ 04F7 11 10 00 ld DE,$0010 ; load settings for G2 mode + 178+ 04FA CD F5 0A call SET_GFX_MODE2 ; load register settings + 179+ 04FD 16 01 ld D,$01 ; backdrop color set to black + 180+ 04FF ED 51 out (C),D ; send data to VDP + 181+ 0501 ED 79 out (C),A ; indicate the register to send data to + 182+ 0503 ; set name table + 183+ 0503 21 00 18 ld HL,$1800 ; name table address + 184+ 0506 CD 5E 06 call SETNAMETABLE ; set name table (load names into table) + 185+ 0509 CD 73 05 call ERASECLRTBL ; erase color table (set foreground & background to black) + 186+ 050C ; set colors for logo + 187+ 050C 21 00 28 ld HL,$2800 ; 2nd page of color table + 188+ 050F CD 70 06 call SETVDPADRS + 189+ 0512 06 05 ld B,$05 ; 5 bands + 190+ 0514 21 BE 05 ld HL,CLRTABLE + 191+ 0517 0D dec C ; set VDP_DAT + 192+ 0518 1E 08 ld E,$08 ; 8 pixels each pattern + 193+ 051A 16 40 RPT101: ld D,$40 ; 64 chars each band + 194+ 051C 7E ld A,(HL) ; load data + 195+ 051D ED 79 RPT102: out (C),A ; send it to VRAM + 196+ 051F 00 nop ; little delay + 197+ 0520 1D dec E ; decrement counter + 198+ 0521 20 FA jr NZ,RPT102 ; repeat until zero + 199+ 0523 1E 08 ld E,$08 ; 8 pixels each pattern + 200+ 0525 15 dec D ; decrement char band counter + 201+ 0526 20 F5 jr NZ,RPT102 ; repeat until zero + 202+ 0528 23 inc HL ; next pattern + 203+ 0529 10 EF djnz RPT101 ; repeat until covered every band + 204+ 052B ; set pattern table + 205+ 052B 21 00 08 ld HL,$0800 ; address of first cell of 2nd area of pattern table + 206+ 052E 11 51 0B ld DE,LM80CLOGO ; pointer to logo pattern + 207+ 0531 45 ld B,L ; 256 bytes, 8 rows + 208+ 0532 CD 9E 05 RPT103: call LOADLOGOCHRS + 209+ 0535 13 inc DE ; next logo pattern + 210+ 0536 10 FA djnz RPT103 + 211+ 0538 06 20 ld B,$20 ; repeat for another 2 rows + 212+ 053A CD 9E 05 RPT104: call LOADLOGOCHRS + 213+ 053D 13 inc DE ; next logo pattern + 214+ 053E 10 FA djnz RPT104 + 215+ 0540 ; show logo/message, play a beep, check for CTRL pressing (to disable DOS), and wait a while + 216+ 0540 06 02 ld B,$02 ; two times + 217+ 0542 AF xor A ; reset A + 218+ 0543 57 ld D,A ; 256 times + 219+ 0544 5F ld E,A ; x 256 times + 220+ 0545 32 9E 55 ld (TMPBFR1),A ; sound flag set to 0 + 221+ 0548 3A F9 53 ld A,(basicStarted) + 222+ 054B FE 59 cp 'Y' + 223+ 054D 28 05 jr Z,DEC_D + 224+ 054F 3E 01 ld A,$01 ; by default, I/O DOS buffer is enabled + 225+ 0551 32 E3 55 ld (DOS_EN),A ; DOS enabled + 226+ 0554 00 DEC_D: nop ; does nothing... + 227+ 0555 00 nop + 228+ 0556 00 nop + 229+ 0557 00 nop + 230+ 0558 00 nop + 231+ 0559 00 nop ; ...until here + 232+ 055A 1D dec E ; decrement E + 233+ 055B 20 F7 jr NZ,DEC_D ; repeat until $00 + 234+ 055D 7A ld A,D + 235+ 055E FE 40 cp $40 ; ...equal to 64 + 236+ 0560 CC 8A 05 call Z,SETBEEP ; if yes, start sound + 237+ 0563 15 dec D + 238+ 0564 20 EE jr NZ,DEC_D ; repeat + 239+ 0566 3A 9E 55 ld A,(TMPBFR1) ; sound state + 240+ 0569 FE 02 cp $02 ; check if sound is to be set off + 241+ 056B C4 96 05 call NZ,BEEPOFF ; yes + 242+ 056E CD C3 05 call CHKSPCK ; check if special key (CTRL) has been pressed on keyboard + 243+ 0571 ; on LM80C 64K, you can disabled the I/O DOS buffer + 244+ 0571 10 E1 djnz DEC_D ; repeat + 245+ 0573 ERASECLRTBL: ; erase color table + 246+ 0573 3E 11 ld A,$11 ; foreground and background set to black + 247+ 0575 16 0A ld D,$0A ; 10 pages + 248+ 0577 06 00 ld B,$00 ; 256 color cells per page + 249+ 0579 21 00 28 ld HL,$2800 ; first cell of 2nd color table + 250+ 057C CD 70 06 call SETVDPADRS ; send address + 251+ 057F 0D dec C ; VDP address for passing data + 252+ 0580 ED 79 RPT100: out (C),A ; send data + 253+ 0582 00 nop + 254+ 0583 00 nop ; little delay + 255+ 0584 10 FA djnz RPT100 ; repeat for entire page + 256+ 0586 15 dec D + 257+ 0587 20 F7 jr NZ,RPT100 ; repeat for all the pages ($0A00 cells) + 258+ 0589 C9 ret ; return to caller + 259+ 058A + 260+ 058A ; play a beep + 261+ 058A 3A 9E 55 SETBEEP: ld A,(TMPBFR1) ; check the already-beeped flag + 262+ 058D B7 or A ; is it 0? + 263+ 058E C0 ret NZ ; no, exit + 264+ 058F 3C inc A ; flag to 1 + 265+ 0590 32 9E 55 ld (TMPBFR1),A ; set sound + 266+ 0593 C3 BF 0C jp WLCMBEEP ; play a beep & return + 267+ 0596 + 268+ 0596 ; beep off + 269+ 0596 3E 02 BEEPOFF: ld A,$02 ; flag for sound off + 270+ 0598 32 9E 55 ld (TMPBFR1),A ; set flag + 271+ 059B C3 C5 0C jp NOBEEP ; stop beep and return + 272+ 059E + 273+ 059E + 274+ 059E ; used to load the chars that will compose the logo of the splash screen + 275+ 059E 1A LOADLOGOCHRS: ld A,(DE) ; load a pattern char of the logo + 276+ 059F 87 add A,A + 277+ 05A0 87 add A,A + 278+ 05A1 87 add A,A ; multiply times 8 to get the offset + 279+ 05A2 C5 push BC + 280+ 05A3 D5 push DE ; store BC and DE + 281+ 05A4 E5 push HL ; store VRAM address to write to + 282+ 05A5 21 90 52 ld HL,LOGOFONT ; start of logo font data + 283+ 05A8 5F ld E,A + 284+ 05A9 16 00 ld D,$00 ; put offset (A) into DE + 285+ 05AB 19 add HL,DE ; get address of pattern data + 286+ 05AC EB ex DE,HL ; move address into DE + 287+ 05AD E1 pop HL ; retrieve VRAM address + 288+ 05AE 06 08 ld B,$08 ; 8 bytes per pattern + 289+ 05B0 CD 70 06 call SETVDPADRS ; set VDP address + 290+ 05B3 0D dec C ; VDP_DAT + 291+ 05B4 1A SNDLOGPT: ld A,(DE) ; load data from RAM + 292+ 05B5 ED 79 out (C),A ; and send to VRAM + 293+ 05B7 13 inc DE ; next byte into RAM + 294+ 05B8 23 inc HL ; next byte into VRAM (used in future iterations) + 295+ 05B9 10 F9 djnz SNDLOGPT ; repeat 8 times + 296+ 05BB D1 pop DE + 297+ 05BC C1 pop BC ; retrieve BC & DE + 298+ 05BD C9 ret ; return to caller + 299+ 05BE CLRTABLE: equ $ + 300+ 05BE 18 1B 13 14 defb $18,$1B,$13,$14,$1D ; colors of background bands of the logo + 300+ 05C2 1D + 301+ 05C3 + 302+ 05C3 + 303+ 05C3 ; while showing the logo, check if special key (CTRL) is being pressed + 304+ 05C3 ; if yes, then disable DOS functions recovering RAM + 305+ 05C3 F5 CHKSPCK: push AF + 306+ 05C4 3E FE ld A,%11111110 ; select CTRL row + 307+ 05C6 CD 43 0D call READKBLN ; read row + 308+ 05C9 CB 5F bit 3,A ; test for RUN/STOP + 309+ 05CB CA DB 05 jp Z,DOCOLDRESET ; yes, do a cold reset + 310+ 05CE CB 57 bit 2,A ; test if CTRL key is pressed + 311+ 05D0 20 07 jr NZ,LVCKSPLK ; no, leave + 312+ 05D2 AF xor A ; yes, so... + 313+ 05D3 32 E3 55 ld (DOS_EN),A ; ...disable DOS + 314+ 05D6 32 F9 53 ld (basicStarted),A; reset BASIC warm start + 315+ 05D9 F1 LVCKSPLK: pop AF + 316+ 05DA C9 ret + 317+ 05DB AF DOCOLDRESET: xor A ; reset A + 318+ 05DC 32 F9 53 ld (basicStarted),A; reset BASIC warm start + 319+ 05DF C3 00 00 jp $0000 ; restart + 320+ 05E2 + 321+ 05E2 + 322+ 05E2 ; empty video buffer + 323+ 05E2 3A 90 55 EMPTYVIDBUF: ld A,(SCR_MODE) ; check screen mode + 324+ 05E5 FE 02 cp $02 ; is it G2 mode? + 325+ 05E7 CA 0A 06 jp Z,EMPTYG2 ; yes, jump over + 326+ 05EA FE 03 cp $03 ; is it MC mode? + 327+ 05EC CA 3A 06 jp Z,EMPTYMC ; yes, jump over + 328+ 05EF 3A 8F 55 ld A,(SCR_SIZE_H) ; load height of screen + 329+ 05F2 47 ld B,A ; move rows into B + 330+ 05F3 AF xor A ; filling char is $00 + 331+ 05F4 2A 91 55 ld HL,(SCR_NAM_TB) ; load the name table address + 332+ 05F7 CD 70 06 call SETVDPADRS ; send address to VDP + 333+ 05FA 0D dec C ; VDP address for passing data + 334+ 05FB 5F LDCOLSTOEMPTY: ld E,A ; store filling char into E + 335+ 05FC 3A 8E 55 ld A,(SCR_SIZE_W) ; load # of cols to empty into A + 336+ 05FF 57 ld D,A ; move A into D + 337+ 0600 7B ld A,E ; recover filling char + 338+ 0601 ED 79 RPTEMPTYBUF: out (C),A ; write empty byte into VRAM + 339+ 0603 00 nop + 340+ 0604 15 dec D ; decr. D + 341+ 0605 20 FA jr NZ,RPTEMPTYBUF ; repeat for the # of cols + 342+ 0607 10 F2 djnz LDCOLSTOEMPTY ; repeat for the # of rows + 343+ 0609 C9 ret ; return to caller + 344+ 060A 2A 91 55 EMPTYG2: ld HL,(SCR_NAM_TB) ; yes, additional setup for G2 - load G2 name table address (usually $1800) + 345+ 060D CD 5E 06 call SETNAMETABLE ; set name table + 346+ 0610 21 00 00 ld HL,$0000 ; set pattern table + 347+ 0613 CD 70 06 call SETVDPADRS ; send address to VDP + 348+ 0616 AF xor A ; empty pattern + 349+ 0617 16 18 ld D,$18 ; 6144 ($1800) cell to clean, 24 pages ($18) + 350+ 0619 47 ld B,A ; 256 bytes for page + 351+ 061A 0D dec C ; VDP data mode + 352+ 061B ED 79 CLRG2PTNTBL: out (C),A ; clear pattern + 353+ 061D 00 nop ; little delay + 354+ 061E 00 nop + 355+ 061F 10 FA djnz CLRG2PTNTBL ; repeat for 1 page + 356+ 0621 15 dec D ; next page + 357+ 0622 20 F7 jr NZ,CLRG2PTNTBL ; repeat + 358+ 0624 21 00 20 ld HL,$2000 ; load the color table address + 359+ 0627 CD 70 06 call SETVDPADRS ; send address to VDP + 360+ 062A 3A 9C 55 ld A,(FRGNDCLR) ; load foreground + 361+ 062D 87 add A,A + 362+ 062E 87 add A,A + 363+ 062F 87 add A,A + 364+ 0630 87 add A,A ; move to high nibble + 365+ 0631 57 ld D,A ; store into D + 366+ 0632 3A 9D 55 ld A,(BKGNDCLR) ; load background color + 367+ 0635 B2 or D ; combine with background color + 368+ 0636 16 18 ld D,$18 ; 6144 ($1800) cells to fill, so 24 pages ($18) + 369+ 0638 18 17 jr STARTEMPTY + 370+ 063A 21 00 08 EMPTYMC: ld HL,$0800 ; MC name table + 371+ 063D CD 5E 06 call SETNAMETABLE ; set name table + 372+ 0640 21 00 00 ld HL,$0000 ; color table address + 373+ 0643 CD 70 06 call SETVDPADRS ; send address to VDP + 374+ 0646 3A 9D 55 ld A,(BKGNDCLR) ; load background + 375+ 0649 57 ld D,A ; store into D + 376+ 064A 87 add A,A + 377+ 064B 87 add A,A + 378+ 064C 87 add A,A + 379+ 064D 87 add A,A ; move to high nibble + 380+ 064E B2 or D ; set background color for high and low nibble + 381+ 064F 16 08 ld D,$08 ; 2048 ($0800) cells to fill, so 8 pages ($08) + 382+ 0651 0D STARTEMPTY: dec C ; VDP address for passing data + 383+ 0652 06 00 ld B,$00 ; 256 bytes each page ($00=256) + 384+ 0654 ED 79 SNDCLRSET: out (C),A ; send color setting + 385+ 0656 00 nop ; wait a while + 386+ 0657 00 nop + 387+ 0658 10 FA djnz SNDCLRSET ; repeat for 1 page + 388+ 065A 15 dec D ; have we filled all the pages? + 389+ 065B 20 F7 jr NZ,SNDCLRSET ; no, repeat + 390+ 065D C9 ret ; return to caller + 391+ 065E + 392+ 065E ; set name table for G2 mode (patterns from $00 to $FF for each of the 3 areas of the screen) + 393+ 065E CD 70 06 SETNAMETABLE: call SETVDPADRS ; send address to VDP + 394+ 0661 0D dec C ; VDP address for passing data + 395+ 0662 16 03 ld D,$03 ; 3 pages to fill into VRAM (768 cells) + 396+ 0664 AF xor A ; starting char name #0 (chars go from 0 to 255) + 397+ 0665 47 ld B,A ; reset B + 398+ 0666 ED 79 RPTFLL1: out (C),A ; send name to VRAM + 399+ 0668 00 nop + 400+ 0669 3C inc A ; increment # of name + 401+ 066A 10 FA djnz RPTFLL1 ; repeat for 256 cells (1 page) + 402+ 066C 15 dec D ; did we fill all the pages? + 403+ 066D 20 F7 jr NZ,RPTFLL1 ; no, continue + 404+ 066F C9 ret ; return to caller + 405+ 0670 + 406+ 0670 ; set an address into VRAM: address is in HL - HL is changed after it + 407+ 0670 0E 31 SETVDPADRS: ld C,VDP_SET ; VDP address mode + 408+ 0672 CB F4 set 6,H ; set bit #6 of address, to write to VRAM + 409+ 0674 ED 69 out (C),L ; send low and... + 410+ 0676 ED 61 out (C),H ; ...high byte of the first cell + 411+ 0678 C9 ret ; return to caller + 412+ 0679 + 413+ 0679 ; clear the video buffer and position the cursor at 0,0 + 414+ 0679 CD E2 05 CLEARVIDBUF: call EMPTYVIDBUF ; clear video buffer + 415+ 067C AF xor A ; reset A + 416+ 067D 32 93 55 ld (SCR_CURS_X),A ; cursor X to 0 + 417+ 0680 32 94 55 ld (SCR_CURS_Y),A ; cursor Y to 0 + 418+ 0683 C3 CC 06 jp POS_CURSOR ; position cursor & return to caller + 419+ 0686 + 420+ 0686 ; HOME: position the cursor at coords. 0,0 + 421+ 0686 AF ATHOME: xor A ; position cursor at 0,0 by storing... + 422+ 0687 32 96 55 ld (SCR_CUR_NY),A ; ...new Y... + 423+ 068A 32 95 55 ld (SCR_CUR_NX),A ; ...and new X + 424+ 068D C3 D6 06 jp MOVCRS ; move cursor to new location & return to caller + 425+ 0690 + 426+ 0690 ; load the char or byte at the VRAM position set by HL + 427+ 0690 ; value is returned into A + 428+ 0690 C5 READ_VIDEO_LOC: push BC ; store BC + 429+ 0691 0E 31 ld C,VDP_SET ; VDP setting mode + 430+ 0693 44 ld B,H + 431+ 0694 CB B8 res 7,B + 432+ 0696 CB B0 res 6,B + 433+ 0698 ED 69 out (C),L ; low byte then... + 434+ 069A ED 41 out (C),B ; high byte + 435+ 069C 0D dec C ; VDP data mode + 436+ 069D 00 nop ; added to compensate shorter instruction + 437+ 069E 00 nop ; wait... + 438+ 069F 00 nop ; ...a while + 439+ 06A0 00 nop + 440+ 06A1 ED 78 in A,(C) ; read byte at current VRAM location + 441+ 06A3 C1 pop BC ; restore BC + 442+ 06A4 C9 ret ; return to caller + 443+ 06A5 + 444+ 06A5 ; write a byte at the VRAM position pointed by HL + 445+ 06A5 ; value is in A + 446+ 06A5 C5 WRITE_VIDEO_LOC:push BC ; store BC + 447+ 06A6 0E 31 ld C,VDP_SET ; VDP setting mode + 448+ 06A8 44 ld B,H ; copy H into B + 449+ 06A9 CB B8 res 7,B + 450+ 06AB CB F0 set 6,B ; write to VRAM + 451+ 06AD ED 69 out (C),L ; low byte then... + 452+ 06AF ED 41 out (C),B ; high byte of VRAM address + 453+ 06B1 0D dec C ; VDP data mode + 454+ 06B2 00 nop ; added to compensate shorter instruction + 455+ 06B3 00 nop ; wait... + 456+ 06B4 00 nop ; ...a while + 457+ 06B5 00 nop + 458+ 06B6 ED 79 out (C),A ; write byte into VRAM + 459+ 06B8 C1 pop BC ; restore BC + 460+ 06B9 C9 ret ; return to caller + 461+ 06BA + 462+ 06BA ; write a value into a specific VDP register + 463+ 06BA ; value is in E, register is in A + 464+ 06BA C5 WRITE_VREG: push BC ; store BC + 465+ 06BB C6 80 add A,$80 ; set VDP to write to registers + 466+ 06BD 0E 31 ld C,VDP_SET ; VDP setting mode + 467+ 06BF ED 59 out (C),E ; send data to VDP + 468+ 06C1 ED 79 out (C),A ; select the destination register + 469+ 06C3 C1 pop BC ; restore BC + 470+ 06C4 C9 ret ; return to caller + 471+ 06C5 + 472+ 06C5 ; read VDP status register and return value into A + 473+ 06C5 C5 READ_VSTAT: push BC ; store BC + 474+ 06C6 0E 31 ld C,VDP_SET ; VDP register access + 475+ 06C8 ED 78 in A,(C) ; read status register + 476+ 06CA C1 pop BC ; restore BC + 477+ 06CB C9 ret ; return to caller + 478+ 06CC + 479+ 06CC ; position the cursor at the current coordinates, preserving underlying char + 480+ 06CC CD 0F 07 POS_CURSOR: call LOAD_CRSR_POS ; load the VRAM address of cursor into HL + 481+ 06CF CD 90 06 call READ_VIDEO_LOC ; load the current char at the cursor position (return in A) + 482+ 06D2 32 97 55 ld (SCR_ORG_CHR),A ; store the current char + 483+ 06D5 C9 ret + 484+ 06D6 + 485+ 06D6 ; move cursor to new X,Y coordinates + 486+ 06D6 CD 06 07 MOVCRS: call RSTCHRCRS ; restore the char in the current cursor position + 487+ 06D9 CD F1 06 call NEWCRSRCOORD ; set new cursor's coordinates + 488+ 06DC CD CC 06 MOVSHOWCRS: call POS_CURSOR ; position cursor into new location + 489+ 06DF 3A 98 55 ld A,(CRSR_STATE) ; load status of cursor + 490+ 06E2 A7 and A ; is cursor off? + 491+ 06E3 C8 ret Z ; yes, return + 492+ 06E4 3A 7E 55 ld A,(TMRCNT) ; no, load the first byte of the 100ths of A second's counter + 493+ 06E7 F6 20 or $20 ; ...set cursor on + 494+ 06E9 32 99 55 ld (LSTCSRSTA),A ; store the last cursor state + 495+ 06EC 3E FF ld A,$FF ; BTW, set cursor visible after moved it + 496+ 06EE C3 A5 06 jp WRITE_VIDEO_LOC ; write into video cell + 497+ 06F1 + 498+ 06F1 + 499+ 06F1 ; set new cursor's coordinates + 500+ 06F1 3A 95 55 NEWCRSRCOORD: ld A,(SCR_CUR_NX) ; load new X + 501+ 06F4 32 93 55 ld (SCR_CURS_X),A ; write new X + 502+ 06F7 3A 96 55 ld A,(SCR_CUR_NY) ; load new Y + 503+ 06FA 32 94 55 ld (SCR_CURS_Y),A ; write new Y + 504+ 06FD 3E FF ld A,$FF ; delete new values + 505+ 06FF 32 95 55 ld (SCR_CUR_NX),A ; of X + 506+ 0702 32 96 55 ld (SCR_CUR_NY),A ; and Y + 507+ 0705 C9 ret + 508+ 0706 + 509+ 0706 ; recover char under the cursor and prints it onto the screen + 510+ 0706 CD 0F 07 RSTCHRCRS: call LOAD_CRSR_POS ; recover old cursor position + 511+ 0709 3A 97 55 ld A,(SCR_ORG_CHR) ; recover old char + 512+ 070C C3 A5 06 jp WRITE_VIDEO_LOC ; write char into VRAM & return + 513+ 070F + 514+ 070F ; retrieve cursor position from either current coordinates or next place + 515+ 070F ; return address position into HL + 516+ 070F 3A 94 55 LOAD_CRSR_POS: ld A,(SCR_CURS_Y) ; load cursor Y + 517+ 0712 6F ld L,A ; move it into reg.L + 518+ 0713 AF xor A ; reset A + 519+ 0714 67 ld H,A ; reset H + 520+ 0715 47 ld B,A ; reset B + 521+ 0716 29 add HL,HL ; create offset (each address is 2-bytes long so we need to double HL) + 522+ 0717 11 9F 0A ld DE,POS_TB_CRS_40; load position table address of cursor for 40 cols + 523+ 071A 3A 8E 55 ld A,(SCR_SIZE_W) ; load screen width + 524+ 071D FE 28 cp $28 ; is it 40 cols? + 525+ 071F 28 03 jr Z,CONT_POS_CURS ; yes, jump over + 526+ 0721 11 6F 0A ld DE,POS_TB_CRS_32; no, load position table address of cursor for 32 cols + 527+ 0724 19 CONT_POS_CURS: add HL,DE ; the correct starting address of the required row is now into HL + 528+ 0725 5E ld E,(HL) ; load starting address of the required row into DE + 529+ 0726 23 inc HL + 530+ 0727 56 ld D,(HL) + 531+ 0728 2A 91 55 ld HL,(SCR_NAM_TB) ; load starting address of name table + 532+ 072B 19 add HL,DE ; starting address of the current row into name table + 533+ 072C 3A 93 55 ld A,(SCR_CURS_X) ; load cursor X + 534+ 072F 4F ld C,A ; transfer A into C + 535+ 0730 09 add HL,BC ; add X offset: now HL contains the address of the current cursor position + 536+ 0731 C9 ret + 537+ 0732 + 538+ 0732 ; find X,Y coordinates of a screen address pointed in VRAM by HL + 539+ 0732 ; return them into L,A for X,Y + 540+ 0732 D5 HL2XY: push DE ; store DE + 541+ 0733 ED 5B 91 55 ld DE,(SCR_NAM_TB) ; load starting address of name table into DE + 542+ 0737 AF xor A ; clear Carry + 543+ 0738 ED 52 sbc HL,DE ; find position relative to screen (from 0,0) + 544+ 073A D1 pop DE + 545+ 073B 3A 8E 55 ld A,(SCR_SIZE_W) ; load screen width + 546+ 073E 4F ld C,A ; move it into C + 547+ 073F CD B5 41 call DIV_16_8 ; divide position by C: return Y into L and X into A + 548+ 0742 C9 ret ; return to caller + 549+ 0743 + 550+ 0743 ;------------------------------------------------------------------------------- + 551+ 0743 ; char table for jumps + 552+ 0743 19 CHRTBL: defb HOME + 553+ 0744 86 06 defw ATHOME ; move the cursor to 0,0 + 554+ 0746 + 555+ 0746 0C defb CS + 556+ 0747 79 06 defw CLEARVIDBUF ; clear video buffer and position cursor at 0,0 + 557+ 0749 + 558+ 0749 0D defb CR + 559+ 074A C2 09 defw CRGRETURN ; go to the beginning of the next line + 560+ 074C + 561+ 074C 08 defb BKSP + 562+ 074D 30 08 defw BACKSPACE ; move cursor left 1 position + 563+ 074F + 564+ 074F 1C defb CRSLFT + 565+ 0750 73 08 defw CURSORLEFT ; move cursor left + 566+ 0752 + 567+ 0752 1E defb CRSUP + 568+ 0753 BF 08 defw CURSORUP ; move cursor up + 569+ 0755 + 570+ 0755 1D defb CRSRGT + 571+ 0756 D8 08 defw CURSORRIGHT ; move cursor right + 572+ 0758 + 573+ 0758 1F defb CRSDN + 574+ 0759 0D 09 defw CURSORDOWN ; move cursor up + 575+ 075B + 576+ 075B 1A defb INSRT + 577+ 075C EE 07 defw INSERTKEY ; insert a space + 578+ 075E + 579+ 075E 0A defb LF + 580+ 075F CA 07 defw PLACEHOLDER ; CURRENTLY WE DON'T PRINT LINE FEED + 581+ 0761 + 582+ 0761 ; send current char to video buffer + 583+ 0761 F5 CHAR2VID: push AF ; store AF + 584+ 0762 C5 push BC ; store BC + 585+ 0763 D5 push DE ; store DE + 586+ 0764 E5 push HL ; store HL + 587+ 0765 3A 98 55 ld A,(CRSR_STATE) ; store cursor state... + 588+ 0768 F5 push AF ; into stack + 589+ 0769 CD 42 09 call CURSOR_OFF ; cursor off + 590+ 076C 3A 9B 55 ld A,(CHR4VID) ; recover char + 591+ 076F 06 0A ld B,$0A ; 10 chars to check + 592+ 0771 21 43 07 ld HL,CHRTBL ; address of key table + 593+ 0774 BE RPTCPCK: cp (HL) ; compare with char + 594+ 0775 23 inc HL ; beginning of sub-routine address + 595+ 0776 20 09 jr NZ,NXTCPCK ; different, go to next char + 596+ 0778 5E ld E,(HL) ; load addres into DE + 597+ 0779 23 inc HL + 598+ 077A 56 ld D,(HL) + 599+ 077B EB ex DE,HL ; move user routine's address into HL + 600+ 077C 11 BD 07 ld DE,EXITCHAR2VID ; set point of return after the user routine + 601+ 077F D5 push DE ; store into stack + 602+ 0780 E9 jp (HL) ; call user routine - then, the CPU will return (jump) to EXITCHAR2VID + 603+ 0781 23 NXTCPCK: inc HL ; jump over 2 cells... + 604+ 0782 23 inc HL ; ...to the next char code + 605+ 0783 10 EF djnz RPTCPCK ; repeat + 606+ 0785 ; it'a not a special char, just print it + 607+ 0785 CD 0F 07 call LOAD_CRSR_POS ; recover position of cursor + 608+ 0788 3A 9B 55 ld A,(CHR4VID) ; recover char to print + 609+ 078B CD A5 06 call WRITE_VIDEO_LOC ; write A into VRAM at (HL) + 610+ 078E 3A 94 55 ld A,(SCR_CURS_Y) ; load cursor Y into A + 611+ 0791 5F ld E,A ; store cursor Y into E + 612+ 0792 3A 93 55 ld A,(SCR_CURS_X) ; load cursor X + 613+ 0795 3C inc A ; move 1 step to right + 614+ 0796 21 8E 55 ld HL,SCR_SIZE_W ; cell that keeps the width of screen + 615+ 0799 BE cp (HL) ; have we reached the most right position? + 616+ 079A 20 0F jr NZ,SETCSRCOORDS ; no, go over + 617+ 079C 1C inc E ; yes, increment cursor Y (go to next line) + 618+ 079D 7B ld A,E ; move cursor Y into A + 619+ 079E 21 8F 55 ld HL,SCR_SIZE_H ; cell that keeps the height of screen + 620+ 07A1 BE cp (HL) ; have we reached the bottom of the screen? + 621+ 07A2 20 06 jr NZ,SETCRSRY ; no, jump over + 622+ 07A4 D5 push DE + 623+ 07A5 CD 49 09 call SCROLLUP ; scroll screen up + 624+ 07A8 D1 pop DE + 625+ 07A9 1D dec E ; decrement 1 row, to set cursor Y on the last line + 626+ 07AA AF SETCRSRY: xor A ; then set cursor X to 0 (go to beginning of line) + 627+ 07AB 32 93 55 SETCSRCOORDS: ld (SCR_CURS_X),A ; store current cursor X + 628+ 07AE 7B ld A,E ; recover Y + 629+ 07AF 32 94 55 ld (SCR_CURS_Y),A ; store current cursor Y + 630+ 07B2 CD CC 06 call POS_CURSOR ; position cursor into new location + 631+ 07B5 3A 7E 55 ld A,(TMRCNT) ; load status of cursor flashing + 632+ 07B8 E6 20 and $20 ; check cursor state + 633+ 07BA 32 99 55 ld (LSTCSRSTA),A ; store the last cursor state + 634+ 07BD AF EXITCHAR2VID: xor A ; reset char + 635+ 07BE 32 9B 55 ld (CHR4VID),A ; to be sent to screen + 636+ 07C1 F1 pop AF ; recover cursor state + 637+ 07C2 A7 and A ; was it off (A=0)? + 638+ 07C3 C4 2D 09 call NZ,CURSOR_ON ; no, set cursor on + 639+ 07C6 E1 pop HL ; restore HL + 640+ 07C7 D1 pop DE ; restore DE + 641+ 07C8 C1 pop BC ; restore BC + 642+ 07C9 F1 pop AF ; restore AF + 643+ 07CA C9 PLACEHOLDER: ret ; return to caller + 644+ 07CB + 645+ 07CB ; flash the cursor at the current position + 646+ 07CB ; (this sub-routine is called by CH3 timer ISR) + 647+ 07CB 3A 98 55 FLASHCURSOR: ld A,(CRSR_STATE) ; now, check the cursor + 648+ 07CE A7 and A ; cursor off (A=0)? + 649+ 07CF C8 ret Z ; yes, return + 650+ 07D0 3A 7E 55 ld A,(TMRCNT) ; no, load the first byte of the 100ths of A second's counter + 651+ 07D3 E6 20 and $20 ; check if it's time to flash the cursor (check bit #6) + 652+ 07D5 21 99 55 ld HL,LSTCSRSTA ; load address of cell that stores the last cursor state + 653+ 07D8 BE cp (HL) ; compare current state with last state + 654+ 07D9 C8 ret Z ; same state, no change required - exit + 655+ 07DA 77 ld (HL),A ; save new state + 656+ 07DB F5 push AF ; store A (keep state for later use) + 657+ 07DC CD 0F 07 call LOAD_CRSR_POS ; load current cursor position into HL + 658+ 07DF F1 pop AF ; recover current state + 659+ 07E0 06 FF ld B,$FF ; cursor char + 660+ 07E2 FE 20 cp $20 ; is the cursor on video (A == $20)? + 661+ 07E4 28 04 jr Z,PUTCRSCHR ; yes, jump over + 662+ 07E6 3A 97 55 ld A,(SCR_ORG_CHR) ; no, load the original char + 663+ 07E9 47 ld B,A ; move char into B + 664+ 07EA 78 PUTCRSCHR: ld A,B ; recover char from B + 665+ 07EB C3 A5 06 jp WRITE_VIDEO_LOC ; print cursor/char at the current position & return + 666+ 07EE + 667+ 07EE + 668+ 07EE ; insert an empty space at the current position of the cursor, moving the following text + 669+ 07EE ; 1 cell straight + 670+ 07EE CD 06 07 INSERTKEY: call RSTCHRCRS ; restore char under the cursor + 671+ 07F1 CD 0F 07 call LOAD_CRSR_POS ; retrieve address of cursor cell + 672+ 07F4 22 9E 55 ld (CUR_POS),HL ; store it + 673+ 07F7 CD 49 0A call ENDOFLN ; find address of first free cell after the end of the text from the current cursor position - address into HL - + 674+ 07FA ; DE is the address of the bottom right cell of the screen + 675+ 07FA 22 A2 55 ld (ENDTXT),HL ; store it + 676+ 07FD ED 4B 9E 55 ld BC,(CUR_POS) ; load starting address + 677+ 0801 AF xor A + 678+ 0802 ED 42 sbc HL,BC ; how many positions to move? + 679+ 0804 CA DC 06 jp Z,MOVSHOWCRS ; none - leave and re-place cursor + 680+ 0807 44 4D ld BC,HL ; number of chars to scroll into BC + 681+ 0809 2A A2 55 ld HL,(ENDTXT) ; load address of the end of text + 682+ 080C 2B CHKHL: dec HL ; decrement to find the address of the char to move + 683+ 080D E5 push HL + 684+ 080E CD 5A 41 call CMP16 ; is it the last cell (bottom right) of screen? + 685+ 0811 E1 pop HL + 686+ 0812 D2 1D 08 jp NC,NXTINST ; yes, so jump over - nothing to do + 687+ 0815 CD 90 06 call READ_VIDEO_LOC ; no, so read current char + 688+ 0818 23 inc HL ; next cell + 689+ 0819 CD A5 06 call WRITE_VIDEO_LOC ; write into new position + 690+ 081C 2B dec HL ; decrement to old position + 691+ 081D 0B NXTINST: dec BC ; decrement number of chars to move + 692+ 081E 79 ld A,C + 693+ 081F B0 or B ; finished? + 694+ 0820 20 EA jr NZ,CHKHL ; no, repeat + 695+ 0822 3E 20 ld A,SPC ; load SPACE character + 696+ 0824 2A 9E 55 ld HL,(CUR_POS) ; get cursor position + 697+ 0827 32 97 55 ld (SCR_ORG_CHR),A ; reset original char under the cursor + 698+ 082A CD A5 06 call WRITE_VIDEO_LOC ; empty current video location + 699+ 082D C3 DC 06 jp MOVSHOWCRS ; re-place cursor + 700+ 0830 + 701+ 0830 ; delete the char at the left of the cursor + 702+ 0830 CD 06 07 BACKSPACE: call RSTCHRCRS ; restore char + 703+ 0833 2A 91 55 ld HL,(SCR_NAM_TB) ; address of origin of screen (location 0,0) + 704+ 0836 44 4D ld BC,HL ; store into BC + 705+ 0838 CD 0F 07 call LOAD_CRSR_POS ; load address of current cursor pos. + 706+ 083B 54 5D ld DE,HL ; copy into DE + 707+ 083D AF xor A ; reset Carry + 708+ 083E ED 42 sbc HL,BC ; check how many chars between + 709+ 0840 CA 6A 08 jp Z,LVBKSP ; none, so we are at the top left corner + 710+ 0843 ED 53 9E 55 ld (CUR_POS),DE ; store current cursor position + 711+ 0847 CD 49 0A call ENDOFLN ; check end of text + 712+ 084A ED 5B 9E 55 ld DE,(CUR_POS) ; retrieve cursor position + 713+ 084E AF xor A ; reset Carry + 714+ 084F ED 52 sbc HL,DE ; check if none follows + 715+ 0851 CA 6A 08 jp Z,LVBKSP ; no chars follow, so simply move the cursor + 716+ 0854 44 4D ld BC,HL ; save numbers of chars to move + 717+ 0856 EB ex DE,HL ; copy starting position into HL + 718+ 0857 CD 90 06 MVBKSP: call READ_VIDEO_LOC ; read char + 719+ 085A 2B dec HL ; 1 position to left + 720+ 085B CD A5 06 call WRITE_VIDEO_LOC ; write char + 721+ 085E 23 inc HL ; goto next char to copy (2 steps to right) + 722+ 085F 23 inc HL + 723+ 0860 0B dec BC ; decrement # of chars + 724+ 0861 79 ld A,C + 725+ 0862 B0 or B ; 0 chars? + 726+ 0863 20 F2 jr NZ,MVBKSP ; not finished, continue + 727+ 0865 2B dec HL + 728+ 0866 AF xor A + 729+ 0867 CD A5 06 call WRITE_VIDEO_LOC ; reset last char + 730+ 086A CD 9C 08 LVBKSP: call MVCRS2LFT ; move cursor to new position + 731+ 086D CD F1 06 call NEWCRSRCOORD ; set new cursor's coordinates + 732+ 0870 C3 DC 06 jp MOVSHOWCRS ; move cursor to the new location and set it ON + 733+ 0873 + 734+ 0873 + 735+ 0873 ; move cursor to left + 736+ 0873 F5 CURSORLEFT: push AF ; store A + 737+ 0874 3A 93 55 ld A,(SCR_CURS_X) ; load cursor X into A + 738+ 0877 A7 and A ; is it at the most left of the screen (X=0)? + 739+ 0878 28 0C jr Z,CHCKYPOS ; yes, check Y position + 740+ 087A 3D dec A ; no, decrement X + 741+ 087B 32 95 55 ld (SCR_CUR_NX),A ; store new X + 742+ 087E 3A 94 55 ld A,(SCR_CURS_Y) ; load current cursor Y + 743+ 0881 32 96 55 ld (SCR_CUR_NY),A ; no move over Y axis + 744+ 0884 18 11 jr CONTCRSLFT ; go on moving cursor + 745+ 0886 3A 94 55 CHCKYPOS: ld A,(SCR_CURS_Y) ; load cursor Y + 746+ 0889 A7 and A ; is it at the most top of the screen (Y=0)? + 747+ 088A 28 0E jr Z,EXITCURSORLEFT; yes, exit doing nothing + 748+ 088C 3D dec A ; no, decrement Y + 749+ 088D 32 96 55 ld (SCR_CUR_NY),A ; store new Y + 750+ 0890 3A 8E 55 ld A,(SCR_SIZE_W) ; load current screen width + 751+ 0893 3D dec A ; cursor to the most right position (width-0) + 752+ 0894 32 95 55 ld (SCR_CUR_NX),A ; set new cursor X + 753+ 0897 CD D6 06 CONTCRSLFT: call MOVCRS ; move cursor into new position + 754+ 089A F1 EXITCURSORLEFT: pop AF ; restore A + 755+ 089B C9 ret ; return to caller + 756+ 089C + 757+ 089C ; move cursor 1 position to the left + 758+ 089C 3A 93 55 MVCRS2LFT: ld A,(SCR_CURS_X) ; load cursor X into A + 759+ 089F A7 and A ; is it at the most left of the screen (X=0)? + 760+ 08A0 28 0B jr Z,CHKYPOS ; yes, check Y position + 761+ 08A2 3D dec A ; no, decrement X + 762+ 08A3 32 95 55 ld (SCR_CUR_NX),A ; store new X + 763+ 08A6 3A 94 55 ld A,(SCR_CURS_Y) ; load current cursor Y + 764+ 08A9 32 96 55 ld (SCR_CUR_NY),A ; no move over Y axis + 765+ 08AC C9 ret ; go on moving cursor + 766+ 08AD 3A 94 55 CHKYPOS: ld A,(SCR_CURS_Y) ; load cursor Y + 767+ 08B0 A7 and A ; is it at the most top of the screen (Y=0)? + 768+ 08B1 28 E7 jr Z,EXITCURSORLEFT; yes, exit doing nothing + 769+ 08B3 3D dec A ; no, decrement Y + 770+ 08B4 32 96 55 ld (SCR_CUR_NY),A ; store new Y + 771+ 08B7 3A 8E 55 ld A,(SCR_SIZE_W) ; load current screen width + 772+ 08BA 3D dec A ; cursor to the most right position (width-1) + 773+ 08BB 32 95 55 ld (SCR_CUR_NX),A ; set new cursor X + 774+ 08BE C9 ret ; return to caller + 775+ 08BF + 776+ 08BF ; move cursor up + 777+ 08BF F5 CURSORUP: push AF ; store A + 778+ 08C0 3A 94 55 ld A,(SCR_CURS_Y) ; load cursor Y into A + 779+ 08C3 A7 and A ; is it at the most top of the screen (Y=0)? + 780+ 08C4 28 10 jr Z,EXITCURSORUP ; yes, exit doing nothing + 781+ 08C6 3D dec A ; no, decrement Y + 782+ 08C7 32 96 55 ld (SCR_CUR_NY),A ; store new Y + 783+ 08CA 3A 93 55 ld A,(SCR_CURS_X) ; load current cursor X + 784+ 08CD 32 95 55 ld (SCR_CUR_NX),A ; set new cursor X + 785+ 08D0 CD 06 07 call RSTCHRCRS ; restore char under the cursor and print it + 786+ 08D3 CD D6 06 call MOVCRS ; move cursor into new position + 787+ 08D6 F1 EXITCURSORUP: pop AF ; restore A + 788+ 08D7 C9 ret ; return to caller + 789+ 08D8 + 790+ 08D8 + 791+ 08D8 ; move cursor to right + 792+ 08D8 F5 CURSORRIGHT: push AF ; store A + 793+ 08D9 C5 push BC ; store B + 794+ 08DA 3A 8E 55 ld A,(SCR_SIZE_W) ; load current screen width (in text modes it's 32 or 40) + 795+ 08DD 3D dec A ; decrement it (most right can only be 31 or 39) + 796+ 08DE 47 ld B,A ; move A into B + 797+ 08DF 3A 93 55 ld A,(SCR_CURS_X) ; load cursor X into A + 798+ 08E2 B8 cp B ; is cursor at the most right position on the screen? + 799+ 08E3 30 0C jr NC,CHCKYPOS2 ; yes, so jump to check Y position + 800+ 08E5 3C inc A ; no, so increment X + 801+ 08E6 32 95 55 ld (SCR_CUR_NX),A ; store new X + 802+ 08E9 3A 94 55 ld A,(SCR_CURS_Y) ; load current cursor Y + 803+ 08EC 32 96 55 ld (SCR_CUR_NY),A ; no move over Y axis + 804+ 08EF 18 13 jr CONTCRSRGT ; go on moving cursor + 805+ 08F1 3A 8F 55 CHCKYPOS2: ld A,(SCR_SIZE_H) ; load screen height + 806+ 08F4 3D dec A ; decrement it (last row can only be 23) + 807+ 08F5 47 ld B,A ; move bottom into B + 808+ 08F6 3A 94 55 ld A,(SCR_CURS_Y) ; load cursor Y into A + 809+ 08F9 B8 cp B ; is the cursor at the bottom of the screen? + 810+ 08FA 30 0E jr NC,EXITCURSORRGHT; yes, exit doing nothing + 811+ 08FC 3C inc A ; no, increment Y + 812+ 08FD 32 96 55 ld (SCR_CUR_NY),A ; store new Y + 813+ 0900 AF xor A ; move cursor to top left + 814+ 0901 32 95 55 ld (SCR_CUR_NX),A ; store new X + 815+ 0904 CD 06 07 CONTCRSRGT: call RSTCHRCRS ; restore char under the cursor and print it + 816+ 0907 CD D6 06 call MOVCRS ; move cursor into new position + 817+ 090A C1 EXITCURSORRGHT: pop BC ; retrieve BC + 818+ 090B F1 pop AF ; restore A + 819+ 090C C9 ret ; return to caller + 820+ 090D + 821+ 090D + 822+ 090D ; move cursor down + 823+ 090D F5 CURSORDOWN: push AF ; store A + 824+ 090E C5 push BC ; store B + 825+ 090F 3A 8F 55 ld A,(SCR_SIZE_H) ; load current screen height (in text modes it's 24) + 826+ 0912 3D dec A ; decrement it (positions can only vary between 0 and 23) + 827+ 0913 47 ld B,A ; move X into B + 828+ 0914 3A 94 55 ld A,(SCR_CURS_Y) ; load cursor Y into A + 829+ 0917 B8 cp B ; is current cursor position < 23? + 830+ 0918 30 10 jr NC,EXITCURSORDOWN; no, exit doing nothing + 831+ 091A 3C inc A ; yes, increment Y + 832+ 091B 32 96 55 ld (SCR_CUR_NY),A ; store new Y + 833+ 091E 3A 93 55 ld A,(SCR_CURS_X) ; load current cursor X + 834+ 0921 32 95 55 ld (SCR_CUR_NX),A ; set new cursor X + 835+ 0924 CD 06 07 call RSTCHRCRS ; restore char under the cursor and print it + 836+ 0927 CD D6 06 call MOVCRS ; move cursor into new position + 837+ 092A C1 EXITCURSORDOWN: pop BC ; retrieve BC + 838+ 092B F1 pop AF ; retrieve A + 839+ 092C C9 ret ; return to caller + 840+ 092D + 841+ 092D + 842+ 092D ; set cursor on (visible on screen) + 843+ 092D F5 CURSOR_ON: push AF ; store AF + 844+ 092E 3A 98 55 ld A,(CRSR_STATE) ; load cursor state + 845+ 0931 B7 or A ; is it on? + 846+ 0932 20 0C jr NZ,EXITCURSOR_ON; yes, so nothing to do + 847+ 0934 3A 8F 55 ld A,(SCR_SIZE_H) ; check the video mode + 848+ 0937 FE 30 cp $30 ; graphics 2 or 3 (if value>=48)? + 849+ 0939 30 05 jr NC,EXITCURSOR_ON; yes, so exit (no cursor in graphics 2 or 3) + 850+ 093B 3E 01 ld A,$01 ; cursor state ON + 851+ 093D 32 98 55 ld (CRSR_STATE),A ; set state + 852+ 0940 F1 EXITCURSOR_ON: pop AF ; restore AF + 853+ 0941 C9 ret ; return to caller + 854+ 0942 + 855+ 0942 ; set cursor off (invisible on screen) + 856+ 0942 F5 CURSOR_OFF: push AF ; store AF + 857+ 0943 AF xor A ; cursor state OFF + 858+ 0944 32 98 55 ld (CRSR_STATE),A ; set state + 859+ 0947 F1 pop AF ; restore AF + 860+ 0948 C9 ret + 861+ 0949 + 862+ 0949 ; scroll the screen 1 row up + 863+ 0949 AF SCROLLUP: xor A ; reset A + 864+ 094A 57 ld D,A ; reset D + 865+ 094B 32 9A 55 ld (PRNTVIDEO),A ; no print on screen while scrolling + 866+ 094E 2A 91 55 ld HL,(SCR_NAM_TB) ; start address of the name table + 867+ 0951 22 CE 55 ld (VIDTMP1),HL ; store address of the destination row (1st row of the screen) + 868+ 0954 3A 8E 55 ld A,(SCR_SIZE_W) ; load the screen width + 869+ 0957 5F ld E,A ; move width into E + 870+ 0958 19 add HL,DE ; HL now contains the address of the source row (2nd row of the screen) + 871+ 0959 22 D0 55 ld (VIDTMP2),HL ; store address of source row + 872+ 095C 3A 8F 55 ld A,(SCR_SIZE_H) ; load the screen height + 873+ 095F 3D dec A ; decrement the # of rows: now, A contains the # of rows to be moved + 874+ 0960 47 ld B,A ; move # of rows into B + 875+ 0961 3A 8E 55 SCROLLNXTRW: ld A,(SCR_SIZE_W) ; (re)load the screen width + 876+ 0964 5F ld E,A ; move width into E + 877+ 0965 2A D0 55 ld HL,(VIDTMP2) ; load source address + 878+ 0968 0E 31 ld C,VDP_SET ; VDP setting mode + 879+ 096A ED 69 out (C),L ; low byte of source + 880+ 096C ED 61 out (C),H ; high byte of source + 881+ 096E 21 A6 55 ld HL,VIDEOBUFF ; load address of the first cell of the video buffer + 882+ 0971 0D dec C ; VDP data mode + 883+ 0972 00 nop ; added to compensate shorter instruction + 884+ 0973 ED 78 LOADNEXTCOL: in A,(C) ; load char + 885+ 0975 77 ld (HL),A ; store char + 886+ 0976 23 inc HL ; next cell of the buffer + 887+ 0977 1D dec E ; count the chars to be read + 888+ 0978 20 F9 jr NZ,LOADNEXTCOL ; repeat until we read the entire row + 889+ 097A 3A 8E 55 ld A,(SCR_SIZE_W) ; reload the screen width + 890+ 097D 5F ld E,A ; move # of rows into E + 891+ 097E 16 00 ld D,$00 ; reset D + 892+ 0980 2A CE 55 ld HL,(VIDTMP1) ; load address of destination row + 893+ 0983 E5 push HL ; store HL + 894+ 0984 2A D0 55 ld HL,(VIDTMP2) ; current source will be.. + 895+ 0987 22 CE 55 ld (VIDTMP1),HL ; ..new destination + 896+ 098A 19 add HL,DE ; address of new + 897+ 098B 22 D0 55 ld (VIDTMP2),HL ; source row + 898+ 098E E1 pop HL ; restore address of current destination row + 899+ 098F CB F4 set 6,H ; writing mode + 900+ 0991 0E 31 ld C,VDP_SET ; VDP setting mode + 901+ 0993 ED 69 out (C),L ; low byte + 902+ 0995 ED 61 out (C),H ; high byte of address + 903+ 0997 21 A6 55 ld HL,VIDEOBUFF ; video buffer address + 904+ 099A 0D dec C ; VDP data mode + 905+ 099B 7E WRITEBUF: ld A,(HL) ; load char + 906+ 099C ED 79 out (C),A ; send char + 907+ 099E 23 inc HL ; increment buffer index + 908+ 099F 1D dec E ; next row + 909+ 09A0 20 F9 jr NZ,WRITEBUF ; repeat until 0 + 910+ 09A2 10 BD djnz SCROLLNXTRW ; repeat for the entire screen + 911+ 09A4 3A 8E 55 ld A,(SCR_SIZE_W) ; reload screen width + 912+ 09A7 47 ld B,A ; cells to empty into B + 913+ 09A8 AF xor A ; null char + 914+ 09A9 0E 31 ld C,VDP_SET ; VDP set mode + 915+ 09AB 2A CE 55 ld HL,(VIDTMP1) ; load address of the last row + 916+ 09AE CB F4 set 6,H ; writing mode + 917+ 09B0 ED 69 out (C),L ; low byte then.. + 918+ 09B2 ED 61 out (C),H ; high byte of address + 919+ 09B4 0D dec C ; VDP data mode + 920+ 09B5 00 nop ; delay + 921+ 09B6 ED 79 RPTEMPTYROW: out (C),A ; empty cell + 922+ 09B8 00 nop ; delay + 923+ 09B9 00 nop + 924+ 09BA 10 FA djnz RPTEMPTYROW ; repeat until the last row has been cleaned + 925+ 09BC 3E 01 ld A,$01 + 926+ 09BE 32 9A 55 ld (PRNTVIDEO),A ; set print-on-video on + 927+ 09C1 C9 ret ; return to caller + 928+ 09C2 + 929+ 09C2 ; carriage return: first, it looks for char $00 at the beginning of the line (look for the first null char), + 930+ 09C2 ; then it starts sendind every char it finds on the screen to the terminal buffer of the BASIC interpreter + 931+ 09C2 ; until another null char is found. Finally, move to the next line and position the cursor at the beginning + 932+ 09C2 ; of the row (equivalent to CR+LF), then gets back control to the screen editor to let it interpret the line + 933+ 09C2 CUR_POS equ TMPBFR1 ; cursor position + 934+ 09C2 SRTTXT equ TMPBFR2 ; start of text line + 935+ 09C2 ENDTXT equ TMPBFR3 ; end of text line + 936+ 09C2 CRGRETURN: ; preliminary: disable cursor if on, and retrieve char under it + 937+ 09C2 3A 98 55 ld A,(CRSR_STATE) ; recover cursor state + 938+ 09C5 32 A4 55 ld (TMPBFR4),A ; store status + 939+ 09C8 A7 and A ; is cursor on? + 940+ 09C9 C4 42 09 call NZ,CURSOR_OFF ; yes, so set cursor off + 941+ 09CC CD 06 07 call RSTCHRCRS ; restore char under it + 942+ 09CF ; first, check if cursor if off, so that we just interpret return as a new line command + 943+ 09CF 3A D8 55 ld A,(KBDNPT) ; check if input from keyboad + 944+ 09D2 A7 and A ; if 0, input is not from keyboard... + 945+ 09D3 CA 28 0A jp Z,PRNTRETURN ; ...so just print a carriage return; otherwise, interpret the return + 946+ 09D6 ; first part: look for the beginning of the text line on screen + 947+ 09D6 CD 0F 07 call LOAD_CRSR_POS ; load cursor position into HL + 948+ 09D9 22 9E 55 ld (CUR_POS),HL ; store it + 949+ 09DC ED 5B 91 55 ld DE,(SCR_NAM_TB) ; load VRAM address of top-left cell of screen ("home") + 950+ 09E0 E5 RPTNLLSRC: push HL + 951+ 09E1 CD 5A 41 call CMP16 ; check if at "home" + 952+ 09E4 E1 pop HL + 953+ 09E5 CA F0 09 jp Z,CNTNULL ; yes, exit because there is nothing before + 954+ 09E8 2B dec HL ; go 1 step back + 955+ 09E9 CD 90 06 call READ_VIDEO_LOC ; read char of current position + 956+ 09EC A7 and A ; is it $00 (null char)? + 957+ 09ED 20 F1 jr NZ,RPTNLLSRC ; no, continue searching + 958+ 09EF 23 inc HL ; move 1 step forward to go back to the last cell with something in + 959+ 09F0 ; second part: look for the ending of the text on screen + 960+ 09F0 22 A0 55 CNTNULL: ld (SRTTXT),HL ; store beginning of text + 961+ 09F3 CD 49 0A call ENDOFLN ; find end of text line looking at the end of chars after the cursor position + 962+ 09F6 22 A2 55 ld (ENDTXT),HL ; store ending of text line + 963+ 09F9 ED 5B A0 55 ld DE,(SRTTXT) ; load beginning of text line + 964+ 09FD A7 and A ; clear Carry + 965+ 09FE ED 52 sbc HL,DE ; how many chars? + 966+ 0A00 28 26 jr Z,PRNTRETURN ; no chars found (HL-DE=0), so just print return & leave + 967+ 0A02 ;--- central part: send the text on the screen to the interpreter + 968+ 0A02 2A A0 55 ld HL,(SRTTXT) ; load beginning of text line + 969+ 0A05 ED 5B A2 55 ld DE,(ENDTXT) ; load ending of text line + 970+ 0A09 CD 90 06 SNDCHRTOBFR: call READ_VIDEO_LOC ; read char + 971+ 0A0C E5 push HL + 972+ 0A0D CD FD 01 call CHARINTOBFR ; send char to buffer + 973+ 0A10 E1 pop HL + 974+ 0A11 23 inc HL ; go to next char + 975+ 0A12 E5 push HL ; store HL + 976+ 0A13 CD 5A 41 call CMP16 ; check if DE=HL (finish chars) + 977+ 0A16 E1 pop HL + 978+ 0A17 20 F0 jr NZ,SNDCHRTOBFR ; no, repeat + 979+ 0A19 3E 0D ld A,CR ; yes, so now send carriage return + 980+ 0A1B CD FD 01 call CHARINTOBFR ; send to buffer + 981+ 0A1E 2A A2 55 ld HL,(ENDTXT) ; recover address of last char of input text + 982+ 0A21 CD 32 07 call HL2XY ; retrieve X,Y from address + 983+ 0A24 7D ld A,L ; move Y into A (we don't need X anymore) + 984+ 0A25 32 94 55 ld (SCR_CURS_Y),A ; store new Y + 985+ 0A28 ;--- final part: go at the beginning of a new line on the screen + 986+ 0A28 AF PRNTRETURN: xor A ; move to col 0 + 987+ 0A29 32 93 55 ld (SCR_CURS_X),A ; store new X + 988+ 0A2C 3A 94 55 ld A,(SCR_CURS_Y) ; load cursor Y into A + 989+ 0A2F 3C inc A ; new row + 990+ 0A30 21 8F 55 ld HL,SCR_SIZE_H ; load address of cell that keeps screen height + 991+ 0A33 BE cp (HL) ; is the cursor over the bottom of the screen? + 992+ 0A34 38 06 jr C,ADDNEWLINE ; no, jump over + 993+ 0A36 3D dec A ; yes, so come back 1 row, then... + 994+ 0A37 F5 push AF ; (store A) + 995+ 0A38 CD 49 09 call SCROLLUP ; ...scroll the screen before to... + 996+ 0A3B F1 pop AF ; (retrieve A) + 997+ 0A3C 32 94 55 ADDNEWLINE: ld (SCR_CURS_Y),A ; ...store new Y + 998+ 0A3F 3A A4 55 ld A,(TMPBFR4) ; retrieve cursor state + 999+ 0A42 A7 and A ; was it off (A=0)? +1000+ 0A43 C4 2D 09 call NZ,CURSOR_ON ; no, set cursor on +1001+ 0A46 C3 CC 06 jp POS_CURSOR ; position cursor to new location & return to caller +1002+ 0A49 +1003+ 0A49 ; find end of text line +1004+ 0A49 ; destroys A, DE, and HL - store address of last char of text line into HL, +1005+ 0A49 ; while DE contains the address of the bottom right cell of the screen +1006+ 0A49 3A 8F 55 ENDOFLN: ld A,(SCR_SIZE_H) +1007+ 0A4C 5F ld E,A ; load screen height into DE +1008+ 0A4D 3A 8E 55 ld A,(SCR_SIZE_W) +1009+ 0A50 6F ld L,A ; load screen width into HL +1010+ 0A51 AF xor A +1011+ 0A52 67 ld H,A +1012+ 0A53 57 ld D,A +1013+ 0A54 CD 65 41 call MUL16 ; multiply HL times DE to get the screen size +1014+ 0A57 ED 5B 91 55 ld DE,(SCR_NAM_TB) ; load screen name table start address into DE +1015+ 0A5B 19 add HL,DE ; get the address... +1016+ 0A5C 2B dec HL ; ...of the "last" video cell +1017+ 0A5D EB ex DE,HL ; store address into DE +1018+ 0A5E 2A 9E 55 ld HL,(CUR_POS) ; retrieve original cursor position +1019+ 0A61 E5 RPTNLLSRC2: push HL +1020+ 0A62 CD 5A 41 call CMP16 ; check if at last position on screen (bottom right corner) +1021+ 0A65 E1 pop HL +1022+ 0A66 C8 ret Z ; if yes, exit because these is nothing after +1023+ 0A67 23 inc HL ; 1 more step forward +1024+ 0A68 CD 90 06 call READ_VIDEO_LOC ; read char of current position +1025+ 0A6B A7 and A ; is it $00 (null char)? +1026+ 0A6C 20 F3 jr NZ,RPTNLLSRC2 ; no, continue searching +1027+ 0A6E C9 ret ; yes: found end of text, return to caller +1028+ 0A6F +1029+ 0A6F +1030+ 0A6F ; ------------------------------------------------------------------------------ +1031+ 0A6F ; this table contains the values of the offsets to be added to +1032+ 0A6F ; the starting address of the name table to find the correct +1033+ 0A6F ; value of the first cell of the corresponding row +1034+ 0A6F ; (by doing so, it's faster than doing a multipication) +1035+ 0A6F ; table for graphics 1 text mode: 32 cols +1036+ 0A6F 00 00 20 00 POS_TB_CRS_32: defw $0000,$0020,$0040,$0060,$0080,$00A0,$00C0,$00E0 +1036+ 0A73 40 00 60 00 +1036+ 0A77 80 00 A0 00 +1036+ 0A7B C0 00 E0 00 +1037+ 0A7F 00 01 20 01 defw $0100,$0120,$0140,$0160,$0180,$01A0,$01C0,$01E0 +1037+ 0A83 40 01 60 01 +1037+ 0A87 80 01 A0 01 +1037+ 0A8B C0 01 E0 01 +1038+ 0A8F 00 02 20 02 defw $0200,$0220,$0240,$0260,$0280,$02A0,$02C0,$02E0 +1038+ 0A93 40 02 60 02 +1038+ 0A97 80 02 A0 02 +1038+ 0A9B C0 02 E0 02 +1039+ 0A9F ; table for pure text mode: 40 cols +1040+ 0A9F 00 00 28 00 POS_TB_CRS_40: defw $0000,$0028,$0050,$0078,$00A0,$00C8,$00F0,$0118 +1040+ 0AA3 50 00 78 00 +1040+ 0AA7 A0 00 C8 00 +1040+ 0AAB F0 00 18 01 +1041+ 0AAF 40 01 68 01 defw $0140,$0168,$0190,$01B8,$01E0,$0208,$0230,$0258 +1041+ 0AB3 90 01 B8 01 +1041+ 0AB7 E0 01 08 02 +1041+ 0ABB 30 02 58 02 +1042+ 0ABF 80 02 A8 02 defw $0280,$02A8,$02D0,$02F8,$0320,$0348,$0370,$0398 +1042+ 0AC3 D0 02 F8 02 +1042+ 0AC7 20 03 48 03 +1042+ 0ACB 70 03 98 03 +1043+ 0ACF +1044+ 0ACF ; ------------------------------------------------------------------------------ +1045+ 0ACF ; reset VRAM +1046+ 0ACF AF EMPTY_VRAM: xor A ; reg.A cleared: we fill up VRAM with $00 +1047+ 0AD0 67 ld H,A +1048+ 0AD1 6F ld L,A ; reset HL +1049+ 0AD2 CD 70 06 call SETVDPADRS ; set address of first VRAM cell to $0000 +1050+ 0AD5 06 40 ld B,$40 ; $40 pages of RAM... +1051+ 0AD7 57 ld D,A ; ...each one with $100 cells (tot. $4000 bytes) +1052+ 0AD8 0D dec C ; VDP data mode +1053+ 0AD9 ED 79 EMPTVRM: out (C),A ; after first byte, the VDP autoincrements VRAM pointer +1054+ 0ADB 14 inc D ; next cell +1055+ 0ADC 00 nop +1056+ 0ADD 20 FA jr NZ,EMPTVRM ; repeat until page is fully cleared +1057+ 0ADF 10 F8 djnz EMPTVRM ; repeat for $40 pages +1058+ 0AE1 C9 ret ; return to caller +1059+ 0AE2 +1060+ 0AE2 ; clear video registers in SRAM +1061+ 0AE2 21 8E 55 CLR_RAM_REG: ld HL,SCR_SIZE_W ; address of first register +1062+ 0AE5 AF xor A ; $00 to clean the registers +1063+ 0AE6 06 44 ld B,CHASNDDTN-SCR_SIZE_W; how many bytes (registers) to clean (dinamically calculated) +1064+ 0AE8 77 RSTVDPRAMREG: ld (HL),A ; reset register +1065+ 0AE9 23 inc HL ; next register +1066+ 0AEA 10 FC djnz RSTVDPRAMREG ; repeat +1067+ 0AEC C9 ret ; return to caller +1068+ 0AED +1069+ 0AED ; ------------------------------------------------------------------------------ +1070+ 0AED ; set a specific graphics mode, passed into reg. E +1071+ 0AED 06 08 SET_GFX_MODE: ld B,$08 ; 8 registers means 8 bytes.. +1072+ 0AEF CB 23 sla E ; multiply E by 8.. +1073+ 0AF1 CB 23 sla E ; so that reg. E can point.. +1074+ 0AF3 CB 23 sla E ; to the correct settings +1075+ 0AF5 16 00 SET_GFX_MODE2: ld D,$00 ; reset D +1076+ 0AF7 21 29 0B ld HL,VDPMODESET ; pointer to register settings | <= here points the SHOW_LOGO sub-routine +1077+ 0AFA 19 add HL,DE ; add offset to get the correct set of values for the required mode +1078+ 0AFB 3E 80 ld A,$80 ; start with REG0 ($80+register number) +1079+ 0AFD 0E 31 ld C,VDP_SET ; VDP set +1080+ 0AFF 56 LDREGVLS: ld D,(HL) ; load register's value +1081+ 0B00 ED 51 out (C),D ; send data to VDP +1082+ 0B02 ED 79 out (C),A ; indicate the register to send data to +1083+ 0B04 3C inc A ; next register +1084+ 0B05 23 inc HL ; next value +1085+ 0B06 10 F7 djnz LDREGVLS ; repeat for 8 registers +1086+ 0B08 C9 ret +1087+ 0B09 +1088+ 0B09 ; ------------------------------------------------------------------------------ +1089+ 0B09 LOADCHARSET: ; reg. A contains the video mode +1090+ 0B09 ; reg. HL contains address of pattern table into VRAM +1091+ 0B09 06 00 ld B,$00 ; 0=256 chars to load (complete charset) +1092+ 0B0B CB F4 set $06,H ; add $4000 to address to indicate that we want to write into VRAM +1093+ 0B0D 0E 31 ld C,VDP_SET ; load VDP address into C +1094+ 0B0F ED 69 out (C),L ; send low byte of address +1095+ 0B11 ED 61 out (C),H ; send high byte +1096+ 0B13 0D dec C ; VDP data mode +1097+ 0B14 21 90 42 ld HL,CHRST68 ; starting address of 6x8 charset into ROM +1098+ 0B17 A7 and A ; is it text mode (A=0)? +1099+ 0B18 28 03 jr Z,NXTCHAR ; yes, so jump to load chars into VRAM +1100+ 0B1A 21 90 4A ld HL,CHRST88 ; no, so we change and load the 8x8 charset +1101+ 0B1D 16 08 NXTCHAR: ld D,$08 ; 8 bytes per pattern char +1102+ 0B1F 7E SENDCHRPTRNS: ld A,(HL) ; load byte to send to VDP +1103+ 0B20 ED 79 out (C),A ; write byte into VRAM +1104+ 0B22 23 inc HL ; inc byte pointer +1105+ 0B23 15 dec D ; 8 bytes sents (0 char)? +1106+ 0B24 20 F9 jr NZ,SENDCHRPTRNS ; no, continue +1107+ 0B26 10 F5 djnz NXTCHAR ; yes, decrement chars counter and continue for all the chars +1108+ 0B28 C9 ret ; return to caller +1109+ 0B29 +1110+ 0B29 ;------------------------------------------------------------------------------ +1111+ 0B29 ; NAME TABLE: buffer video - contains the chars to be shown on video +1112+ 0B29 ; PATTERN TABLE: charset - contains the chars/tiles to be loaded into the name table +1113+ 0B29 ; COLOR TABLE: color settings for chars/tiles +1114+ 0B29 +1115+ 0B29 ; VDP register settings for a text display +1116+ 0B29 00 VDPMODESET: defb %00000000 ; reg.0: external video off +1117+ 0B2A D0 defb %11010000 ; reg.1: 16K VRAM, video on, int. off, text mode (40x24) +1118+ 0B2B 02 defb $02 ; reg.2: name table set to $0800 ($02x$400) +1119+ 0B2C 00 defb $00 ; reg.3: not used in text mode +1120+ 0B2D 00 defb $00 ; reg.4: pattern table set to $0000 +1121+ 0B2E 00 defb $00 ; reg.5: not used in text mode +1122+ 0B2F 00 defb $00 ; reg.6: not used in text mode +1123+ 0B30 F5 defb $f5 ; reg.7: white text on light blue background +1124+ 0B31 +1125+ 0B31 VDPMODESET1: ; VDP register settings for a graphics 1 mode +1126+ 0B31 00 defb %00000000 ; reg.0: ext. video off +1127+ 0B32 C0 defb %11000000 ; reg.1: 16K Vram; video on, int off, graphics mode 1, sprite size 8x8, sprite magn. 0 +1128+ 0B33 06 defb $06 ; reg.2: name table address: $1800 +1129+ 0B34 80 defb $80 ; reg.3: color table address: $2000 +1130+ 0B35 00 defb $00 ; reg.4: pattern table address: $0000 +1131+ 0B36 36 defb $36 ; reg.5: sprite attr. table address: $1B00 +1132+ 0B37 07 defb $07 ; reg.6: sprite pattern table addr.: $3800 +1133+ 0B38 05 defb $05 ; reg.7: backdrop color (light blue) +1134+ 0B39 +1135+ 0B39 VDPMODESET2: ; VDP register settings for a graphics 2 mode +1136+ 0B39 02 defb %00000010 ; reg.0: graphics 2 mode, ext. video dis. +1137+ 0B3A C0 defb %11000000 ; reg.1: 16K VRAM, video on, INT off, sprite size 8x8, sprite magn. 0 +1138+ 0B3B 06 defb $06 ; reg.2: name table addr.: $1800 +1139+ 0B3C FF defb $FF ; reg.3: color table addr.: $2000 +1140+ 0B3D 03 defb $03 ; reg.4: pattern table addr.: $0000 +1141+ 0B3E 36 defb $36 ; reg.5: sprite attr. table addr.: $1B00 +1142+ 0B3F 07 defb $07 ; reg.6: sprite pattern table addr.: $3800 +1143+ 0B40 05 defb $05 ; reg.7: backdrop color: light blue +1144+ 0B41 +1145+ 0B41 VDPMODESETMC: ; VDP register settings for a multicolor mode +1146+ 0B41 00 defb %00000000 ; reg.0: ext. video dis. +1147+ 0B42 CB defb %11001011 ; reg.1: 16K VRAM, video on, INT off, multicolor mode, sprite size 8x8, sprite magn. 0 +1148+ 0B43 02 defb $02 ; reg.2: name table addr.: $0800 +1149+ 0B44 00 defb $00 ; reg.3: don't care +1150+ 0B45 00 defb $00 ; reg.4: pattern table addr.: $0000 +1151+ 0B46 36 defb $36 ; reg.5: sprite attr. table addr.: $1B00 +1152+ 0B47 07 defb $07 ; reg.6: sprite pattern table addr.: $3800 +1153+ 0B48 0F defb $0F ; reg.7: backdrop color (white) +1154+ 0B49 +1155+ 0B49 VDPMODESETEX2: ; VDP register settings for an extended graphics 2 mode +1156+ 0B49 02 defb %00000010 ; reg.0: graphics 2 mode, ext. video dis. +1157+ 0B4A C0 defb %11000000 ; reg.1: 16K VRAM, video on, INT off, sprite size 8x8, sprite magn. 0 +1158+ 0B4B 0E defb $0E ; reg.2: name table addr.: $3800 +1159+ 0B4C 9F defb $9F ; reg.3: color table addr.: $2000 +1160+ 0B4D 00 defb $00 ; reg.4: pattern table addr.: $0000 +1161+ 0B4E 76 defb $76 ; reg.5: sprite attr. table addr.: $3B00 +1162+ 0B4F 03 defb $03 ; reg.6: sprite pattern table addr.: $1800 +1163+ 0B50 05 defb $05 ; reg.7: backdrop color: light blue +1164+ 0B51 +1165+ 0B51 LM80CLOGO: ; patterns to compose the splash screen logo +1166+ 0B51 ; 1st band +1167+ 0B51 00 00 00 00 defb 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +1167+ 0B55 00 00 00 00 +1167+ 0B59 00 00 00 00 +1167+ 0B5D 00 00 00 00 +1167+ 0B61 00 00 00 00 +1167+ 0B65 00 00 00 00 +1167+ 0B69 00 00 00 00 +1167+ 0B6D 00 00 00 00 +1168+ 0B71 00 00 0F 0A defb 0,0,15,10,11,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +1168+ 0B75 0B 10 00 00 +1168+ 0B79 00 00 00 00 +1168+ 0B7D 00 00 00 00 +1168+ 0B81 00 00 00 00 +1168+ 0B85 00 00 00 00 +1168+ 0B89 00 00 00 00 +1168+ 0B8D 00 00 00 00 +1169+ 0B91 ; 2nd band +1170+ 0B91 00 00 0D 17 defb 0,0,13,23,0,12,0,0,0,1,0,0,0,20,0,0,6,5,6,21,22,7,6,21,22,7,6,1,1,7,0,0 +1170+ 0B95 00 0C 00 00 +1170+ 0B99 00 01 00 00 +1170+ 0B9D 00 14 00 00 +1170+ 0BA1 06 05 06 15 +1170+ 0BA5 16 07 06 15 +1170+ 0BA9 16 07 06 01 +1170+ 0BAD 01 07 00 00 +1171+ 0BB1 00 00 0D 00 defb 0,0,13,0,0,12,0,0,0,1,0,0,0,1,20,6,1,5,3,5,3,5,3,5,3,5,3,5,3,5,0,0 +1171+ 0BB5 00 0C 00 00 +1171+ 0BB9 00 01 00 00 +1171+ 0BBD 00 01 14 06 +1171+ 0BC1 01 05 03 05 +1171+ 0BC5 03 05 03 05 +1171+ 0BC9 03 05 03 05 +1171+ 0BCD 03 05 00 00 +1172+ 0BD1 ; 3rd band +1173+ 0BD1 00 00 0D 00 defb 0,0,13,0,0,12,0,0,0,1,0,0,0,1,1,1,1,5,9,20,19,8,3,5,19,5,3,5,0,0,0,0 +1173+ 0BD5 00 0C 00 00 +1173+ 0BD9 00 01 00 00 +1173+ 0BDD 00 01 01 01 +1173+ 0BE1 01 05 09 14 +1173+ 0BE5 13 08 03 05 +1173+ 0BE9 13 05 03 05 +1173+ 0BED 00 00 00 00 +1174+ 0BF1 00 00 0D 00 defb 0,0,13,0,0,12,0,0,0,1,0,0,0,1,0,8,3,5,6,21,22,7,3,1,22,5,3,5,0,0,0,0 +1174+ 0BF5 00 0C 00 00 +1174+ 0BF9 00 01 00 00 +1174+ 0BFD 00 01 00 08 +1174+ 0C01 03 05 06 15 +1174+ 0C05 16 07 03 01 +1174+ 0C09 16 05 03 05 +1174+ 0C0D 00 00 00 00 +1175+ 0C11 ; 4th band +1176+ 0C11 00 00 0D 00 defb 0,0,13,0,0,12,0,0,0,1,0,0,0,1,0,0,3,5,3,5,3,5,3,5,3,5,3,5,3,5,0,0 +1176+ 0C15 00 0C 00 00 +1176+ 0C19 00 01 00 00 +1176+ 0C1D 00 01 00 00 +1176+ 0C21 03 05 03 05 +1176+ 0C25 03 05 03 05 +1176+ 0C29 03 05 03 05 +1176+ 0C2D 03 05 00 00 +1177+ 0C31 00 00 0D 00 defb 0,0,13,0,0,12,0,0,0,1,4,4,0,1,0,0,3,5,9,20,19,8,9,20,19,8,9,1,1,8,0,0 +1177+ 0C35 00 0C 00 00 +1177+ 0C39 00 01 04 04 +1177+ 0C3D 00 01 00 00 +1177+ 0C41 03 05 09 14 +1177+ 0C45 13 08 09 14 +1177+ 0C49 13 08 09 01 +1177+ 0C4D 01 08 00 00 +1178+ 0C51 ; 5th band +1179+ 0C51 00 00 0E 12 defb 0,0,14,18,18,17,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +1179+ 0C55 12 11 00 00 +1179+ 0C59 00 00 00 00 +1179+ 0C5D 00 00 00 00 +1179+ 0C61 00 00 00 00 +1179+ 0C65 00 00 00 00 +1179+ 0C69 00 00 00 00 +1179+ 0C6D 00 00 00 00 +1180+ 0C71 00 00 00 00 defb 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +1180+ 0C75 00 00 00 00 +1180+ 0C79 00 00 00 00 +1180+ 0C7D 00 00 00 00 +1180+ 0C81 00 00 00 00 +1180+ 0C85 00 00 00 00 +1180+ 0C89 00 00 00 00 +1180+ 0C8D 00 00 00 00 +# file closed: ../include/vdp/vdp-1.08.asm + 70 0C91 + 71 0C91 ; incude the latest version of the PSG module + 72 0C91 INCLUDE "../include/psg/psg-1.02.asm" +# file opened: ../include/psg/psg-1.02.asm + 1+ 0C91 ; ------------------------------------------------------------------------------ + 2+ 0C91 ; LM80C - PSG ROUTINES - 1.02 + 3+ 0C91 ; ------------------------------------------------------------------------------ + 4+ 0C91 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 0C91 ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 0C91 ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 0C91 ; kind of warranty: you can use them at your own risk. + 8+ 0C91 ; You are free to use them for any non-commercial use: you are only asked to + 9+ 0C91 ; maintain the copyright notices, include this advice and the note to the + 10+ 0C91 ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 0C91 ; redistribuite them. + 12+ 0C91 ; https://www.leonardomiliani.com + 13+ 0C91 ; + 14+ 0C91 ; Please support me by visiting the following links: + 15+ 0C91 ; Main project page: https://www.leonardomiliani.com + 16+ 0C91 ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 0C91 ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 0C91 ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 0C91 ; ------------------------------------------------------------------------------ + 20+ 0C91 ; + 21+ 0C91 ; ------------------------------------------------------------------------------ + 22+ 0C91 + 23+ 0C91 ;------------------------------------------------------------------------------ + 24+ 0C91 + 25+ 0C91 ; configure the PSG + 26+ 0C91 21 D2 55 initPSG: ld HL,CHASNDDTN ; starting address of sound & keyboard RAM registers + 27+ 0C94 06 0E ld B,SERIALS_EN-CHASNDDTN; # of PSG sound & keyboard registers + 28+ 0C96 AF xor A ; reset A + 29+ 0C97 77 EMPTSNDBFR: ld (HL),A ; reset RAM register + 30+ 0C98 23 inc HL ; next register + 31+ 0C99 10 FC djnz EMPTSNDBFR ; repeat + 32+ 0C9B 06 10 CLRPSGREGS: ld B,$10 ; 16 registers to set + 33+ 0C9D 21 AF 0C ld HL,SNDREGCFG ; starting address of register settings + 34+ 0CA0 16 00 ld D,$00 ; first register + 35+ 0CA2 7A RSTPSG: ld A,D ; register value + 36+ 0CA3 CD E9 0C call SETSNDREG ; select register + 37+ 0CA6 7E ld A,(HL) ; load value + 38+ 0CA7 CD EE 0C call WRTSNDREG ; write to register + 39+ 0CAA 14 inc D ; next register + 40+ 0CAB 23 inc HL ; next value + 41+ 0CAC 10 F4 djnz RSTPSG ; repeat for each register + 42+ 0CAE C9 ret ; return to caller + 43+ 0CAF + 44+ 0CAF 00 00 00 00 SNDREGCFG: defb $00,$00,$00,$00,$00,$00,$00,%10111111 + 44+ 0CB3 00 00 00 BF + 45+ 0CB7 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$ff,$ff + 45+ 0CBB 00 00 FF FF + 46+ 0CBF ; reg. 7: set I/O ch.A to OUTPUT, I/O ch.B to INPUT; set noise to OFF; set audio to OFF + 47+ 0CBF + 48+ 0CBF + 49+ 0CBF ; routine to play a welcome beep on channel C (tone 4010) and to shut it off + 50+ 0CBF 21 D9 0C WLCMBEEP: ld HL,WLCBPDAT ; data address + 51+ 0CC2 C3 C8 0C jp SENDSND + 52+ 0CC5 21 E1 0C NOBEEP: ld HL,NOBPDAT ; data address + 53+ 0CC8 C5 SENDSND: push BC + 54+ 0CC9 06 04 ld B,$04 ; 4 pairs + 55+ 0CCB 7E RPTWLCMBP: ld A,(HL) ; read register # + 56+ 0CCC CD E9 0C call SETSNDREG + 57+ 0CCF 23 inc HL ; next cell + 58+ 0CD0 7E ld A,(HL) ; read value + 59+ 0CD1 CD EE 0C call WRTSNDREG + 60+ 0CD4 23 inc HL + 61+ 0CD5 10 F4 djnz RPTWLCMBP ; repeat + 62+ 0CD7 C1 pop BC + 63+ 0CD8 C9 ret ; return to caller + 64+ 0CD9 + 65+ 0CD9 07 BB 04 56 WLCBPDAT: defb $07,%10111011,$04,$56,$05,$00,$0A,$0F + 65+ 0CDD 05 00 0A 0F + 66+ 0CE1 04 00 05 00 NOBPDAT: defb $04,$00,$05,$00,$0A,$00,$07,%10111111 + 66+ 0CE5 0A 00 07 BF + 67+ 0CE9 + 68+ 0CE9 + 69+ 0CE9 ; select register on PSG + 70+ 0CE9 0E 40 SETSNDREG: ld C,PSG_REG ; PSG register port + 71+ 0CEB ED 79 out (C),A ; set register + 72+ 0CED C9 ret ; return to caller + 73+ 0CEE + 74+ 0CEE ; send data to PSG + 75+ 0CEE 0E 41 WRTSNDREG: ld C,PSG_DAT ; PSG data port + 76+ 0CF0 ED 79 out (C),A ; send data + 77+ 0CF2 C9 ret ; return to caller + 78+ 0CF3 + 79+ 0CF3 ; manage the sounds' duration: each time this subroutine is called, it + 80+ 0CF3 ; decrements the single sound durations (measured in ms) and eventually + 81+ 0CF3 ; shut off the audio channel whose counter has reached 0. + 82+ 0CF3 ; (this sub-routine is called by CH3 timer ISR) + 83+ 0CF3 DD E5 MNGSNDS: push IX ; store IX + 84+ 0CF5 DD 21 D2 55 ld IX,CHASNDDTN ; starting address of tones duration + 85+ 0CF9 06 03 ld B,$03 ; 3 channels to check + 86+ 0CFB 26 01 ld H,$01 ; mixer channels: A=>bit 1, B=>bit 2, C=>bit 3 + 87+ 0CFD DD 5E 00 CHKSNDCH: ld E,(IX+0) ; load LSB into E + 88+ 0D00 DD 56 01 ld D,(IX+1) ; load MSB into D + 89+ 0D03 7B ld A,E ; load E into A + 90+ 0D04 B2 or D ; check that DE=0 + 91+ 0D05 28 31 jr Z,CNTCHKSND ; yes, jump over + 92+ 0D07 1B dec DE ; no, so decrement DE + 93+ 0D08 7B ld A,E ; reload E into A... + 94+ 0D09 DD 73 00 ld (IX+0),E ; store new... + 95+ 0D0C DD 72 01 ld (IX+1),D ; ...duration and... + 96+ 0D0F B2 or D ; ...do another check to see if DE=0 + 97+ 0D10 20 26 jr NZ,CNTCHKSND ; no, so jump over + 98+ 0D12 ; if yes, let's shut down the corresponding channel + 99+ 0D12 ; to shut down a tone we disable it into the mixer + 100+ 0D12 ; then set 0 into its tone registers + 101+ 0D12 16 07 ld D,$07 ; mixer register + 102+ 0D14 0E 40 ld C,PSG_REG ; PSG register selector port + 103+ 0D16 ED 51 out (C),D ; set mixer register + 104+ 0D18 ED 78 in A,(C) ; load current value + 105+ 0D1A B4 or H ; set off the channel into the mixer (remember that 1=OFF) + 106+ 0D1B ED 51 out (C),D ; select mixer register + 107+ 0D1D 0E 41 ld C,PSG_DAT ; PSG data port + 108+ 0D1F ED 79 out (C),A ; send new value for the mixer + 109+ 0D21 3E 03 ld A,$03 ; three channels + 110+ 0D23 90 sub B ; find current channel (0->A, 1->B, 2->C) + 111+ 0D24 87 add A,A ; and find first register (A=>0, B=>2, C=>4) + 112+ 0D25 0E 40 ld C,PSG_REG ; PSG register selector port + 113+ 0D27 ED 79 out (C),A ; select first tone register of channel + 114+ 0D29 2E 00 ld L,$00 ; value 0 into L + 115+ 0D2B 0E 41 ld C,PSG_DAT ; PSG data selector port + 116+ 0D2D ED 69 out (C),L ; write 0 into register + 117+ 0D2F 0E 40 ld C,PSG_REG ; PSG register selector port + 118+ 0D31 3C inc A ; next tone register + 119+ 0D32 ED 79 out (C),A ; select second tone register of channel + 120+ 0D34 0E 41 ld C,PSG_DAT ; PSG data selector port + 121+ 0D36 ED 69 out (C),L ; write 0 into register + 122+ 0D38 DD 23 CNTCHKSND: inc IX ; set for... + 123+ 0D3A DD 23 inc IX ; ...next channel... + 124+ 0D3C CB 24 sla H ; shift left H 1 bit + 125+ 0D3E 10 BD djnz CHKSNDCH ; repeat for 3 channels + 126+ 0D40 DD E1 pop IX ; restore IX + 127+ 0D42 C9 ret ; return to caller + 128+ 0D43 + 129+ 0D43 ; read a specific row of the keyboard matrix, set by A + 130+ 0D43 ; return read into A + 131+ 0D43 C5 READKBLN: push BC ; store BC + 132+ 0D44 06 0F ld B,$0F ; reg #15 + 133+ 0D46 0E 40 ld C,PSG_REG ; PSG register port + 134+ 0D48 ED 41 out (C),B ; select reg #15 + 135+ 0D4A 0E 41 ld C,PSG_DAT ; PSG data port + 136+ 0D4C ED 79 out (C),A ; activate the row + 137+ 0D4E 06 0E ld B,$0E ; register #14 (port B) + 138+ 0D50 0E 40 ld C,PSG_REG ; PSG register port + 139+ 0D52 ED 41 out (C),B ; select reg. 14 (port B) + 140+ 0D54 ED 78 in A,(C) ; read register #14 + 141+ 0D56 C1 pop BC ; retrieve BC + 142+ 0D57 C9 ret + 143+ 0D58 + 144+ 0D58 ; read the keyboard matrix to look for a key pressure + 145+ 0D58 0E 40 KEYBOARD: ld C,PSG_REG ; PSG register port + 146+ 0D5A 06 07 ld B,$07 ; set register #7... + 147+ 0D5C ED 41 out (C),B ; ...to work with + 148+ 0D5E ED 78 in A,(C) ; read register #7 + 149+ 0D60 CB FF set 7,A ; port A set to output + 150+ 0D62 CB B7 res 6,A ; port B set to input + 151+ 0D64 ED 41 out (C),B ; set register #7 + 152+ 0D66 0E 41 ld C,PSG_DAT ; PSG data port + 153+ 0D68 ED 79 out (C),A ; set I/O ports w/o altering the rest of the mixer + 154+ 0D6A ; check for reset combination + 155+ 0D6A 3E FE ld A,%11111110 ; first line of keyboard matrix + 156+ 0D6C CD 43 0D call READKBLN + 157+ 0D6F FE DB cp %11011011 ; are C= and CTRL pressed? + 158+ 0D71 20 29 jr NZ,CHKSPCKS ; no, jump over + 159+ 0D73 3E FE NOMRPRSS: ld A,%11111110 ; wait until the user... + 160+ 0D75 CD 43 0D call READKBLN ; ...releases the key combination... + 161+ 0D78 FE DB cp %11011011 ; ...to avoid multiple... + 162+ 0D7A 28 F7 jr Z,NOMRPRSS ; ...calls of this code + 163+ 0D7C CD 91 0C call initPSG ; reset sounds + 164+ 0D7F 1E 01 ld E,$01 ; flag for soft reset and graphic mode 1 + 165+ 0D81 CD 2E 41 call RESET2 ; reset serials, close seq. files and put disk into standby + 166+ 0D84 CD D1 03 call initVDP ; set video mode + 167+ 0D87 CD 91 19 call RUNFST ; clear BASIC pointers + 168+ 0D8A E1 pop HL ; remove HL from stack (put by RUNFST routine) + 169+ 0D8B CC 2D 09 call Z,CURSOR_ON ; enable cursor + 170+ 0D8E 3E 01 ld A,$01 ; activate the... + 171+ 0D90 32 9A 55 ld (PRNTVIDEO),A ; ...video buffer... + 172+ 0D93 DD 21 A9 18 ld IX,PRNTOK ; set return address + 173+ 0D97 DD E5 push IX ; store into stack + 174+ 0D99 FB ei ; re-enable INTs + 175+ 0D9A ED 4D reti ; return from ISR and go to BASIC prompt + 176+ 0D9C ; check special keys (SHIFT/ALT/CTRL) + 177+ 0D9C 3E FD CHKSPCKS: ld A,%11111101 ; select SHIFT row + 178+ 0D9E CD 43 0D call READKBLN ; read row + 179+ 0DA1 CB 5F bit 3,A ; test if SHIFT key is pressed (4th bit is reset) + 180+ 0DA3 20 05 jr NZ,CHECKALT ; no, so go on + 181+ 0DA5 21 DF 55 ld HL,CONTROLKEYS ; control key flags + 182+ 0DA8 36 01 ld (HL),%00000001 ; set SHIFT flag, reset CTRL & ALT flags (currently multiply control keys are NOT supported) + 183+ 0DAA 3E FE CHECKALT: ld A,%11111110 ; select ALT row + 184+ 0DAC CD 43 0D call READKBLN ; read ALT row + 185+ 0DAF CB 6F bit 5,A ; test if ALT key is pressed (5th bit is reset) + 186+ 0DB1 20 05 jr NZ,CHECKCTRL ; no, so go on + 187+ 0DB3 21 DF 55 ld HL,CONTROLKEYS ; control key flags + 188+ 0DB6 36 04 ld (HL),%00000100 ; set ALT flag, reset SHIFT & CTRL flag (currently multiply control keys are NOT supported) + 189+ 0DB8 3E FE CHECKCTRL: ld A,%11111110 ; select CTRL row + 190+ 0DBA CD 43 0D call READKBLN ; read CTRL row + 191+ 0DBD CB 57 bit 2,A ; test if CTRL key is pressed (3rd bit is reset) + 192+ 0DBF 20 05 jr NZ,CHECKKBD ; no, so make a normal reading + 193+ 0DC1 21 DF 55 ld HL,CONTROLKEYS ; control key flags + 194+ 0DC4 36 02 ld (HL),%00000010 ; set CTRL flag, reset SHIFT & ALT flags (currently multiply control keys are NOT supported) + 195+ 0DC6 06 08 CHECKKBD: ld B,$08 ; 8 lines + 196+ 0DC8 3E 7F ld A,%01111111 ; start from the last line of the matrix + 197+ 0DCA 16 0F RPTKBDRD: ld D,$0F ; register #15 (port B) + 198+ 0DCC 0E 40 ld C,PSG_REG ; PSG register port + 199+ 0DCE ED 51 out (C),D ; select reg. #15 + 200+ 0DD0 0E 41 ld C,PSG_DAT ; PSG data port + 201+ 0DD2 ED 79 out (C),A ; activate 1 line (active line is grounded, i.e. with a LOW signal) + 202+ 0DD4 5F ld E,A ; save current line into E + 203+ 0DD5 16 0E ld D,$0E ; register #14 (port A) + 204+ 0DD7 0E 40 ld C,PSG_REG ; PSG register port + 205+ 0DD9 ED 51 out (C),D ; select reg. 14 (port A) + 206+ 0DDB 00 nop + 207+ 0DDC ED 78 in A,(C) ; read register #14 + 208+ 0DDE FE FF cp $FF ; is there any line set to 0? + 209+ 0DE0 28 2E jr Z,NOKEYPRSD ; no, go to the next row + 210+ 0DE2 ; check control keys + 211+ 0DE2 32 D9 55 ld (KBTMP),A ; yes, check if a control key was pressed. First, store current row + 212+ 0DE5 78 ld A,B ; copy current row (B) into A + 213+ 0DE6 FE 02 cp $02 ; is it the row of the SHIFT? + 214+ 0DE8 20 0F jr NZ,TESTALT ; no, continue checking the other control keys + 215+ 0DEA 3A D9 55 ld A,(KBTMP) ; yes, retrieve current row data + 216+ 0DED CB 5F bit 3,A ; check SHIFT bit line + 217+ 0DEF 20 31 jr NZ,FINDKEY ; no SHIFT, continue checking + 218+ 0DF1 CB DF set 3,A ; yes, it's the SHIFT. So remove SHIFT bit + 219+ 0DF3 FE FF cp $FF ; after deleting the SHIFT bit, is there any other bit selected? + 220+ 0DF5 20 2B jr NZ,FINDKEY ; yes, go to check which one + 221+ 0DF7 18 17 jr NOKEYPRSD ; no, go to next row + 222+ 0DF9 FE 01 TESTALT: cp $01 ; is it the line of ALT & CTRL? + 223+ 0DFB 3A D9 55 ld A,(KBTMP) ; retrieve current row data + 224+ 0DFE 20 22 jr NZ,FINDKEY ; no, continue + 225+ 0E00 CB 6F bit 5,A ; yes, check ALT bit line + 226+ 0E02 20 02 jr NZ,TESTCTRL ; no ALT, continue checking + 227+ 0E04 CB EF set 5,A ; yes, it's the ALT. So remove ALT bit + 228+ 0E06 CB 57 TESTCTRL: bit 2,A ; check CTRL bit line + 229+ 0E08 20 02 jr NZ,ENDCTRLCK ; no CTRL, continue checking + 230+ 0E0A CB D7 set 2,A ; delete CTRL bit flag + 231+ 0E0C FE FF ENDCTRLCK: cp $FF ; after deleting the ALT & CTRL bits, is there any other bit selected? + 232+ 0E0E 20 12 jr NZ,FINDKEY ; yes, go to check which one + 233+ 0E10 7B NOKEYPRSD: ld A,E ; no key pressed, load current output port + 234+ 0E11 0F rrca ; rotate right by 1 + 235+ 0E12 10 B6 djnz RPTKBDRD ; repeat for 8 lines + 236+ 0E14 AF xor A ; if exit from here, no key has been pressed... + 237+ 0E15 32 DB 55 ld (LASTKEYPRSD),A ; ...so reset the last key cell... + 238+ 0E18 32 DF 55 ld (CONTROLKEYS),A ; ...reset contro key flags... + 239+ 0E1B 32 D8 55 ld (KBDNPT),A ; ...no input from keyboard... + 240+ 0E1E 32 DC 55 ld (STATUSKEY),A ; ...no auto-repeat... + 241+ 0E21 C9 ret ; ...and leave + 242+ 0E22 1E FF FINDKEY: ld E,$FF ; counter + 243+ 0E24 1C CHKLN: inc E ; E goes from 0 to 7 + 244+ 0E25 CB 3F srl A ; is the first bit reset? (we're looking for a "0", meaning grounded line) + 245+ 0E27 38 FB jr C,CHKLN ; no, check next bit + 246+ 0E29 3A DF 55 ld A,(CONTROLKEYS) ; load control key flags + 247+ 0E2C 21 45 0F ld HL,KBMAP ; normal keymap + 248+ 0E2F FE 01 cp $01 ; SHIFT flag? + 249+ 0E31 20 05 jr NZ,CHKCTRL ; no, jump over + 250+ 0E33 21 85 0F ld HL,KBMAP_SFT ; SHIFT keymap + 251+ 0E36 18 10 jr LOADMAP ; and load it + 252+ 0E38 FE 02 CHKCTRL: cp $02 ; CTRL flag? + 253+ 0E3A 20 05 jr NZ,CHKALT ; no, jump over + 254+ 0E3C 21 05 10 ld HL,KBMAP_CTRL ; CTRL map + 255+ 0E3F 18 07 jr LOADMAP ; and load it + 256+ 0E41 FE 04 CHKALT: cp $04 ; ALT flag? + 257+ 0E43 20 03 jr NZ,LOADMAP ; no, check over + 258+ 0E45 21 C5 0F ld HL,KBMAP_ALT ; ALT map + 259+ 0E48 05 LOADMAP: dec B ; decrement row # (rows go from 0 to 7) + 260+ 0E49 48 ld C,B ; move B into C and... + 261+ 0E4A CB 21 sla C ; ...multiply it... + 262+ 0E4C CB 21 sla C ; ...by 8 to find... + 263+ 0E4E CB 21 sla C ; ...the current row into the matrix + 264+ 0E50 06 00 ld B,$00 ; reset B + 265+ 0E52 09 add HL,BC ; find the address of the current row + 266+ 0E53 50 ld D,B ; reset D + 267+ 0E54 19 add HL,DE ; find the current column - now (HL) stores the pressed key + 268+ 0E55 3A DB 55 ld A,(LASTKEYPRSD) ; load the last key pressed + 269+ 0E58 BE cp (HL) ; is it the same key? + 270+ 0E59 20 41 jr NZ,NEWKEY ; no, it's a new key + 271+ 0E5B 44 4D ld BC,HL ; store address of current keycode + 272+ 0E5D 2A 7E 55 ld HL,(TMRCNT) ; load current system timer + 273+ 0E60 ED 5B DD 55 ld DE,(KEYTMR) ; load auto-repeat timer + 274+ 0E64 3A DC 55 ld A,(STATUSKEY) ; yes, load current status of auto-repeat + 275+ 0E67 FE 01 cp $01 ; is it initial pressure? + 276+ 0E69 20 1F jr NZ,CHKAUTO ; no, jump over + 277+ 0E6B AF xor A ; clear Carry + 278+ 0E6C ED 52 sbc HL,DE ; startint time - actual time + 279+ 0E6E 16 00 ld D,$00 ; 64 ths/s > 640 ms + 280+ 0E70 3A 4F 54 ld A,(KEYDEL) + 281+ 0E73 5F ld E,A + 282+ 0E74 CD 5A 41 call CMP16 ; time elapsed is >= $40? + 283+ 0E77 DA EC 0E jp C,LVKBRDCHK2 ; no, so leave + 284+ 0E7A 3E 02 SETNEWAUTO: ld A,$02 ; yes set status to... + 285+ 0E7C 32 DC 55 ld (STATUSKEY),A ; ...auto-repeat + 286+ 0E7F 2A 7E 55 ld HL,(TMRCNT) ; load system timer + 287+ 0E82 22 DD 55 ld (KEYTMR),HL ; store starting time + 288+ 0E85 60 69 ld HL,BC ; retrieve address of current keycode + 289+ 0E87 C3 A9 0E jp SENDKEY ; send key + 290+ 0E8A AF CHKAUTO: xor A ; clear Carry + 291+ 0E8B ED 52 sbc HL,DE ; computer interval between initial pressure of key and current time + 292+ 0E8D 16 00 ld D,$00 + 293+ 0E8F 3A 50 54 ld A,(AUTOKE) + 294+ 0E92 5F ld E,A ; auto-repeat delay into DE + 295+ 0E93 CD 5A 41 call CMP16 ; check if interval is greater than delay + 296+ 0E96 DA EC 0E jp C,LVKBRDCHK2 ; no, so leave + 297+ 0E99 C3 7A 0E jp SETNEWAUTO ; set new loop and send key + 298+ 0E9C AF NEWKEY: xor A ; set initial state... + 299+ 0E9D 3C inc A ; ...for auto-repeat... + 300+ 0E9E 32 DC 55 ld (STATUSKEY),A ; ...1=pressure init + 301+ 0EA1 ED 4B 7E 55 ld BC,(TMRCNT) ; load current system timer + 302+ 0EA5 ED 43 DD 55 ld (KEYTMR),BC ; set starting time + 303+ 0EA9 7E SENDKEY: ld A,(HL) ; then, load key... + 304+ 0EAA 32 DB 55 ld (LASTKEYPRSD),A ; ...store it... + 305+ 0EAD 32 DA 55 ld (TMPKEYBFR),A ; ...insert it into the INKEY buffer... + 306+ 0EB0 32 9B 55 ld (CHR4VID),A ; ...and store char for video + 307+ 0EB3 FE 03 cp CTRLC ; is it RUN/STOP? + 308+ 0EB5 20 05 jr NZ,CNTKBCK ; no, jump over + 309+ 0EB7 CD FD 01 call CHARINTOBFR ; yes, send directly to buffer and... + 310+ 0EBA 18 30 jr LVKBRDCHK2 ; ...leave + 311+ 0EBC 01 00 08 CNTKBCK: ld BC,$0800 ; 8 FN keys (B), FN key number (C) + 312+ 0EBF 21 3D 0F ld HL,FNKEYSORD ; FN keys codes + 313+ 0EC2 BE CHKFNK: cp (HL) ; is it an FN key? + 314+ 0EC3 CA F1 0E jp Z,PRNTFNKEY ; yes, jump over + 315+ 0EC6 0C inc C ; next FN key + 316+ 0EC7 23 inc HL ; next FN key code + 317+ 0EC8 10 F8 djnz CHKFNK ; continue for 8 FN keys + 318+ 0ECA 3E 01 SNDKEYTOBFR: ld A,$01 ; normal key - set input flag + 319+ 0ECC 32 D8 55 ld (KBDNPT),A ; to keyboard + 320+ 0ECF 3A 9A 55 ld A,(PRNTVIDEO) ; load status of print-on-video + 321+ 0ED2 B7 or A ; is the print-on-video disabled? + 322+ 0ED3 CA DC 0E jp Z,PUTCHRBUF ; yes, so send char to input buffer + 323+ 0ED6 3A 98 55 ld A,(CRSR_STATE) ; check cursor state + 324+ 0ED9 B7 or A ; is it 0 (cursor OFF)? + 325+ 0EDA 20 0D jr NZ,PNT2VD ; no, print on screen + 326+ 0EDC AF PUTCHRBUF: xor A + 327+ 0EDD 32 D8 55 ld (KBDNPT),A ; if send to input buffer, set RETURN as from BASIC + 328+ 0EE0 3A DA 55 ld A,(TMPKEYBFR) ; retrieve char + 329+ 0EE3 CD FD 01 call CHARINTOBFR ; cursor off, so send char to buffer... + 330+ 0EE6 C3 EC 0E jp LVKBRDCHK2 ; ...and leave + 331+ 0EE9 CD 61 07 PNT2VD: call CHAR2VID ; send char to video + 332+ 0EEC AF LVKBRDCHK2: xor A + 333+ 0EED 32 DF 55 ld (CONTROLKEYS),A ; reset control key flags + 334+ 0EF0 C9 ret ; return to caller: the current key code is into TMPKEYBFR + 335+ 0EF1 ; manage FN keys + 336+ 0EF1 57 PRNTFNKEY: ld D,A ; copy A into D + 337+ 0EF2 2A 4B 54 ld HL,(LINEAT) ; Get current line number + 338+ 0EF5 23 inc HL ; -1 means direct statement + 339+ 0EF6 7C ld A,H + 340+ 0EF7 B5 or L + 341+ 0EF8 7A ld A,D ; retrieve char + 342+ 0EF9 20 CF jr NZ,SNDKEYTOBFR ; indirect mode - just send FN key code to buffer + 343+ 0EFB 79 ld A,C ; direct mode, so print text - first, get FN key number + 344+ 0EFC 87 add A,A + 345+ 0EFD 87 add A,A + 346+ 0EFE 87 add A,A + 347+ 0EFF 87 add A,A ; FN key number * 16 + 348+ 0F00 4F ld C,A ; move it into C + 349+ 0F01 06 00 ld B,$00 ; reset B, to get offset + 350+ 0F03 21 51 54 ld HL,FNKEYS ; load address of FN keys texts + 351+ 0F06 09 add HL,BC ; get correct text address + 352+ 0F07 06 10 ld B,$10 ; 16 chars + 353+ 0F09 7E LDFNKEYCHR: ld A,(HL) ; load char + 354+ 0F0A A7 and A ; null char? + 355+ 0F0B CA EC 0E jp Z,LVKBRDCHK2 ; yes, so leave + 356+ 0F0E 57 ld D,A ; pass char into D + 357+ 0F0F 3A 9A 55 ld A,(PRNTVIDEO) ; load status of print-on-video + 358+ 0F12 B7 or A ; is the print-on-video disabled? + 359+ 0F13 CA 23 0F jp Z,PUTCHRBUF1 ; yes, so send char to input buffer + 360+ 0F16 3A 98 55 ld A,(CRSR_STATE) ; check cursor state + 361+ 0F19 B7 or A ; is it 0 (cursor OFF)? + 362+ 0F1A C4 30 0F call NZ,PRNTFNK ; no, print on screen + 363+ 0F1D 23 CNTFNK: inc HL ; next char + 364+ 0F1E 10 E9 djnz LDFNKEYCHR ; repeat for max. 16 chars + 365+ 0F20 C3 EC 0E jp LVKBRDCHK2 ; leave + 366+ 0F23 AF PUTCHRBUF1: xor A ; if send to input buffer,... + 367+ 0F24 32 D8 55 ld (KBDNPT),A ; ...set input as from BASIC + 368+ 0F27 7A ld A,D ; retrieve char + 369+ 0F28 E5 push HL ; store HL + 370+ 0F29 CD FD 01 call CHARINTOBFR ; cursor off, so send char to buffer... + 371+ 0F2C E1 pop HL ; retrieve HL + 372+ 0F2D C3 1D 0F jp CNTFNK ; repeat + 373+ 0F30 7A PRNTFNK: ld A,D ; recover char + 374+ 0F31 32 9B 55 ld (CHR4VID),A ; store char for printing + 375+ 0F34 3E 01 ld A,$01 ; normal key - set input flag + 376+ 0F36 32 D8 55 ld (KBDNPT),A ; to keyboard + 377+ 0F39 CD 61 07 call CHAR2VID ; print on screen + 378+ 0F3C C9 ret ; return to caller + 379+ 0F3D + 380+ 0F3D + 381+ 0F3D ;----------------------------------------------------------------------- + 382+ 0F3D 01 02 04 05 FNKEYSORD: defb 1,2,4,5,6,22,23,24 ; order of FN Keys + 382+ 0F41 06 16 17 18 + 383+ 0F45 ;----------------------------------------------------------------------- + 384+ 0F45 ; key codes + 385+ 0F45 31 19 0E 03 KBMAP: defb '1',25,14,3,' ',16,'q','2' ; 25=HOME 14=CTRL 3=RUN/STOP 16=C= + 385+ 0F49 20 10 71 32 + 386+ 0F4D 33 77 61 14 defb '3','w','a',20,'z','s','e','4' ; 20=SHIFT + 386+ 0F51 7A 73 65 34 + 387+ 0F55 35 72 64 78 defb '5','r','d','x','c','f','t','6' + 387+ 0F59 63 66 74 36 + 388+ 0F5D 37 79 67 76 defb '7','y','g','v','b','h','u','8' + 388+ 0F61 62 68 75 38 + 389+ 0F65 39 69 6A 6E defb '9','i','j','n','m','k','o','0' + 389+ 0F69 6D 6B 6F 30 + 390+ 0F6D 1F 70 6C 2C defb 31,'p','l',',','.',':','-',30 ; 31=CURSOR DOWN 30=CURSOR UP + 390+ 0F71 2E 3A 2D 1E + 391+ 0F75 1C 2A 3B 2F defb 28,'*',';','/',27,'=','+',29 ; 28=CURSOR LEFT 27=ESCAPE 29=CURSOR RIGHT + 391+ 0F79 1B 3D 2B 1D + 392+ 0F7D 08 0D FC 40 defb 8,13,252,'@',1,2,4,24 ; 8=DEL(backspace) 13=RETURN 252=£ 1=F1 2=F2 4=F3 24=HELP + 392+ 0F81 01 02 04 18 + 393+ 0F85 + 394+ 0F85 ; shifted codes - not all the keys have the shifted version + 395+ 0F85 21 0C 0E 03 KBMAP_SFT: defb '!',12,14,3,' ',16,'Q',34 ; 12=CLEAR 14=CTRL 3=RUN/STOP 16=C= 34=" + 395+ 0F89 20 10 51 22 + 396+ 0F8D 23 57 41 14 defb '#','W','A',20,'Z','S','E','$' ; 20=SHIFT + 396+ 0F91 5A 53 45 24 + 397+ 0F95 25 52 44 58 defb '%','R','D','X','C','F','T','&' + 397+ 0F99 43 46 54 26 + 398+ 0F9D 27 59 47 56 defb 39,'Y','G','V','B','H','U','(' ; 39=' + 398+ 0FA1 42 48 55 28 + 399+ 0FA5 29 49 4A 4E defb ')','I','J','N','M','K','O',94 ; 94=^ + 399+ 0FA9 4D 4B 4F 5E + 400+ 0FAD 1F 50 4C 3C defb 31,'P','L','<','>','[','_',30 ; 31=CURSOR DOWN 30=CURSOR UP + 400+ 0FB1 3E 5B 5F 1E + 401+ 0FB5 1C 2A 5D 3F defb 28,'*',']','?',27,198,'+',29 ; 28=CURSOR LEFT 27=ESCAPE 29=CURSOR RIGHT + 401+ 0FB9 1B C6 2B 1D + 402+ 0FBD 1A 0D D3 40 defb 26,13,211,'@',5,6,22,23 ; 26=INSERT, 211=€ 5=F4 6=F5 22=F6 23=F7 + 402+ 0FC1 05 06 16 17 + 403+ 0FC5 + 404+ 0FC5 ; ALT (C=) codes - not all the keys have the alt-ed version + 405+ 0FC5 31 0C 0E 03 KBMAP_ALT: defb '1',12,14,3,' ',16,222,196 ; 12=CLEAR 14=CTRL 3=RUN/STOP 16=C= 34=" + 405+ 0FC9 20 10 DE C4 + 406+ 0FCD 33 DD 85 14 defb '3',221,133,20,131,130,165,'4' ; 20=SHIFT + 406+ 0FD1 83 82 A5 34 + 407+ 0FD5 35 A2 A6 84 defb '5',162,166,132,157,163,168,'6' + 407+ 0FD9 9D A3 A8 36 + 408+ 0FDD 37 AB A9 A1 defb '7',171,169,161,158,172,213,'8' ; + 408+ 0FE1 9E AC D5 38 + 409+ 0FE5 39 D6 D8 9F defb '9',214,216,159,160,215,135,195 ; + 409+ 0FE9 A0 D7 87 C3 + 410+ 0FED 1F 88 8A C1 defb 31,136,138,193,192,123,144,30 ; 31=CURSOR DOWN 123={ 30=CURSOR UP + 410+ 0FF1 C0 7B 90 1E + 411+ 0FF5 1C 8F 7D FE defb 28,143,125,254,27,209,148,29 ; 28=CURSOR LEFT 125=} 27=ESCAPE 29=CURSOR RIGHT + 411+ 0FF9 1B D1 94 1D + 412+ 0FFD 08 0D E0 89 defb 8,13,224,137,5,6,22,23 ; 8=DEL(backspace) 13=RETURN 252=£ 5=F4 6=F5 22=F6 23=F7 + 412+ 1001 05 06 16 17 + 413+ 1005 + 414+ 1005 ; CTRL codes - not all the keys have the control-ed version + 415+ 1005 31 19 0E 03 KBMAP_CTRL: defb '1',25,14,3,' ',16,154,'2' ; 25=HOME 14=CTRL 3=RUN/STOP 16=C= + 415+ 1009 20 10 9A 32 + 416+ 100D 33 9C 95 14 defb '3',156,149,20,152,150,153,'4' ; 20=SHIFT + 416+ 1011 98 96 99 34 + 417+ 1015 35 9B B0 97 defb '5',155,176,151,177,175,165,'6' + 417+ 1019 B1 AF A5 36 + 418+ 101D 37 A6 A8 B2 defb '7',166,168,178,179,169,167,'8' + 418+ 1021 B3 A9 A7 38 + 419+ 1025 39 B8 AA AC defb '9',184,170,172,171,181,164,'0' + 419+ 1029 AB B5 A4 30 + 420+ 102D 1F A3 AD 2C defb 31,163,173,',','.',':',186,30 ; 31=CURSOR DOWN 30=CURSOR UP + 420+ 1031 2E 3A BA 1E + 421+ 1035 1C E1 3B 2F defb 28,225,';','/',27,212,185,29 ; 28=CURSOR LEFT 27=ESCAPE 212=π 29=CURSOR RIGHT + 421+ 1039 1B D4 B9 1D + 422+ 103D 08 0D BD A2 defb 8,13,189,162,1,2,4,24 ; 8=DEL(backspace) 13=RETURN 252=£ 1=F1 2=F2 4=F3 24=HELP + 422+ 1041 01 02 04 18 +# file closed: ../include/psg/psg-1.02.asm + 73 1045 + 74 1045 ; include the latest version of the LM80C 64K BASIC interpreter + 75 1045 INCLUDE "../include/basic/basic-1.13.asm" +# file opened: ../include/basic/basic-1.13.asm + 1+ 1045 ; ------------------------------------------------------------------------------ + 2+ 1045 ; LM80C BASIC (32K/64K) - R3.25 + 3+ 1045 ; ------------------------------------------------------------------------------ + 4+ 1045 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 1045 ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 1045 ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 1045 ; kind of warranty: you can use them at your own risk. + 8+ 1045 ; You are free to use them for any non-commercial use: you are only asked to + 9+ 1045 ; maintain the copyright notices, include this advice and the note to the + 10+ 1045 ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 1045 ; redistribuite them. + 12+ 1045 ; https://www.leonardomiliani.com + 13+ 1045 ; + 14+ 1045 ; Please support me by visiting the following links: + 15+ 1045 ; Main project page: https://www.leonardomiliani.com + 16+ 1045 ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 1045 ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 1045 ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 1045 ; ------------------------------------------------------------------------------ + 20+ 1045 ; LM80C BASIC 64K - originally based on the following NASCOM BASIC versions: + 21+ 1045 ; 4.7 - original version by NASCOM/MICROSOFT + 22+ 1045 ; 4.7b - modified version by Grant Searle (additional commands & functions) + 23+ 1045 + 24+ 1045 + 25+ 1045 ;------------------------------------------------------------------------------ + 26+ 1045 ; L M 8 0 C B A S I C + 27+ 1045 ;------------------------------------------------------------------------------ + 28+ 1045 + 29+ 1045 ; GENERAL EQUATES + 30+ 1045 + 31+ 1045 NLLCR equ $00 ; null char (used as space/empty char in video prints) + 32+ 1045 CTRLC equ $03 ; Control "C" + 33+ 1045 CTRLG equ $07 ; Control "G" + 34+ 1045 BKSP equ $08 ; Back space + 35+ 1045 LF equ $0A ; Line feed + 36+ 1045 CS equ $0C ; Clear screen + 37+ 1045 CR equ $0D ; Carriage return + 38+ 1045 CTRLO equ $0F ; Control "O" + 39+ 1045 CTRLQ equ $11 ; Control "Q" + 40+ 1045 CTRLR equ $12 ; Control "R" + 41+ 1045 CTRLS equ $13 ; Control "S" + 42+ 1045 CTRLU equ $15 ; Control "U" + 43+ 1045 HOME equ $19 ; Home (cursor at 0,0) + 44+ 1045 ESC equ $1B ; Escape + 45+ 1045 SPC equ $20 ; Space + 46+ 1045 DEL equ $7F ; Delete + 47+ 1045 INSRT equ $1A ; Insert Key + 48+ 1045 ; cursor ASCII codes + 49+ 1045 CRSLFT equ $1C ; cursor left + 50+ 1045 CRSRGT equ $1D ; cursor right + 51+ 1045 CRSUP equ $1E ; cursor up + 52+ 1045 CRSDN equ $1F ; cursor down + 53+ 1045 + 54+ 1045 + 55+ 1045 ;------------------------------------------------------------------------- + 56+ 1045 ; BASIC ERROR MESSAGES + 57+ 1045 ; the interpreter looks for a single-byte code in the following list, + 58+ 1045 ; then loads the corresponding memory pointer in "ERRTBL" table to + 59+ 1045 ; find where to retrieve the message text in "ERRORS" + 60+ 1045 + 61+ 1045 ; BASIC ERROR CODE VALUES + 62+ 1045 ; These values act as an offset to point to the error message into the error table + 63+ 1045 ; must be incremented by 2 because they point to a word address jump + 64+ 1045 NF equ $00 ; NEXT without FOR + 65+ 1045 SN equ $02 ; Syntax error + 66+ 1045 RG equ $04 ; RETURN without GOSUB + 67+ 1045 OD equ $06 ; Out of DATA + 68+ 1045 FC equ $08 ; Function call error + 69+ 1045 OV equ $0A ; Overflow + 70+ 1045 OM equ $0C ; Out of memory + 71+ 1045 UL equ $0E ; Undefined line number + 72+ 1045 BS equ $10 ; Bad subscript + 73+ 1045 DD equ $12 ; Re-Dimensioned array + 74+ 1045 DZ equ $14 ; Division by zero (/0) + 75+ 1045 ID equ $16 ; Illegal direct + 76+ 1045 TM equ $18 ; Type mis-match + 77+ 1045 OS equ $1A ; Out of string space + 78+ 1045 LS equ $1C ; String too long + 79+ 1045 ST equ $1E ; String formula too complex + 80+ 1045 CN equ $20 ; Can't continue + 81+ 1045 UF equ $22 ; Undefined FN function + 82+ 1045 MO equ $24 ; Missing operand + 83+ 1045 HE equ $26 ; HEX error + 84+ 1045 BN equ $28 ; BIN error + 85+ 1045 GM equ $2A ; No Graphics Mode + 86+ 1045 SC equ $2C ; Serial configuration + 87+ 1045 SA equ $2E ; Serial port already open + 88+ 1045 SO equ $30 ; Serial buffer overrun + 89+ 1045 HP equ $32 ; HELP call + 90+ 1045 IM equ $34 ; Illegal indirect + 91+ 1045 NR equ $36 ; Device not ready + 92+ 1045 D0 equ $38 ; File open/close error + 93+ 1045 D1 equ $3A ; Disk/File name error + 94+ 1045 D2 equ $3C ; Disk geometry error + 95+ 1045 D3 equ $3E ; Save error + 96+ 1045 D4 equ $40 ; Load error + 97+ 1045 D5 equ $42 ; Disk full error + 98+ 1045 D6 equ $44 ; Duplicate file name error + 99+ 1045 D7 equ $46 ; DOS version error + 100+ 1045 D8 equ $48 ; File not found error + 101+ 1045 D9 equ $4A ; File already open + 102+ 1045 DA equ $4C ; End of file + 103+ 1045 + 104+ 1045 + 105+ 1045 ; BASIC ERROR POINTER TABLE + 106+ 1045 ERRTBL: equ $ + 107+ 1045 93 10 NFPTR: defw NFMSG + 108+ 1047 A4 10 SNPTR: defw SNMSG + 109+ 1049 AB 10 RGPTR: defw RGMSG + 110+ 104B C0 10 ODPTR: defw ODMSG + 111+ 104D CC 10 FCPTR: defw FCMSG + 112+ 104F E2 10 OVPTR: defw OVMSG + 113+ 1051 EB 10 OMPTR: defw OMMSG + 114+ 1053 F9 10 ULPTR: defw ULMSG + 115+ 1055 08 11 BSPTR: defw BSMSG + 116+ 1057 16 11 DDPTR: defw DDMSG + 117+ 1059 2B 11 DZPTR: defw DZMSG + 118+ 105B 3C 11 IDPTR: defw IDMSG + 119+ 105D 50 11 TMPTR: defw TMMSG + 120+ 105F 5F 11 OSPTR: defw OSMSG + 121+ 1061 73 11 LSPTR: defw LSMSG + 122+ 1063 83 11 STPTR: defw STMSG + 123+ 1065 9E 11 CNPTR: defw CNMSG + 124+ 1067 AD 11 UFPTR: defw UFMSG + 125+ 1069 C3 11 MOPTR: defw MOMSG + 126+ 106B D3 11 HEPTR: defw HEMSG + 127+ 106D DE 11 BNPTR: defw BNMSG + 128+ 106F E9 11 GMPRT: defw GMMSG + 129+ 1071 FA 11 SCPTR: defw SCMSG + 130+ 1073 0F 12 SAPTR: defw SAMSG + 131+ 1075 28 12 SOPTR: defw SOMSG + 132+ 1077 3E 12 HPPTR: defw HPMSG + 133+ 1079 48 12 IMPRT: defw IMMSG + 134+ 107B 5E 12 NRPRT: defw NRMSG + 135+ 107D 6F 12 D0PTR: defw D0MSG + 136+ 107F 7F 12 D1PRT: defw D1MSG + 137+ 1081 8B 12 D2PRT: defw D2MSG + 138+ 1083 99 12 D3PRT: defw D3MSG + 139+ 1085 9E 12 D4PTR: defw D4MSG + 140+ 1087 A3 12 D5PTR: defw D5MSG + 141+ 1089 AD 12 D6PTR: defw D6MSG + 142+ 108B C1 12 D7PRT: defw D7MSG + 143+ 108D CD 12 D8PTR: defw D8MSG + 144+ 108F DC 12 D9PTR: defw D9MSG + 145+ 1091 EE 12 DAPTR: defw DAMSG + 146+ 1093 + 147+ 1093 + 148+ 1093 ; BASIC ERROR MESSAGE LIST + 149+ 1093 ERRORS equ $ + 150+ 1093 4E 45 58 54 NFMSG: defb "NEXT Without FOR",0 + 150+ 1097 20 57 69 74 + 150+ 109B 68 6F 75 74 + 150+ 109F 20 46 4F 52 + 150+ 10A3 00 + 151+ 10A4 53 79 6E 74 SNMSG: defb "Syntax",0 + 151+ 10A8 61 78 00 + 152+ 10AB 52 45 54 55 RGMSG: defb "RETURN without GOSUB",0 + 152+ 10AF 52 4E 20 77 + 152+ 10B3 69 74 68 6F + 152+ 10B7 75 74 20 47 + 152+ 10BB 4F 53 55 42 + 152+ 10BF 00 + 153+ 10C0 4F 75 74 20 ODMSG: defb "Out of DATA",0 + 153+ 10C4 6F 66 20 44 + 153+ 10C8 41 54 41 00 + 154+ 10CC 49 6C 6C 65 FCMSG: defb "Illegal Function Call",0 + 154+ 10D0 67 61 6C 20 + 154+ 10D4 46 75 6E 63 + 154+ 10D8 74 69 6F 6E + 154+ 10DC 20 43 61 6C + 154+ 10E0 6C 00 + 155+ 10E2 4F 76 65 72 OVMSG: defb "Overflow",0 + 155+ 10E6 66 6C 6F 77 + 155+ 10EA 00 + 156+ 10EB 4F 75 74 20 OMMSG: defb "Out of Memory",0 + 156+ 10EF 6F 66 20 4D + 156+ 10F3 65 6D 6F 72 + 156+ 10F7 79 00 + 157+ 10F9 55 6E 64 65 ULMSG: defb "Undefined Line",0 + 157+ 10FD 66 69 6E 65 + 157+ 1101 64 20 4C 69 + 157+ 1105 6E 65 00 + 158+ 1108 42 61 64 20 BSMSG: defb "Bad Subscript",0 + 158+ 110C 53 75 62 73 + 158+ 1110 63 72 69 70 + 158+ 1114 74 00 + 159+ 1116 52 65 2D 44 DDMSG: defb "Re-Dimensioned Array",0 + 159+ 111A 69 6D 65 6E + 159+ 111E 73 69 6F 6E + 159+ 1122 65 64 20 41 + 159+ 1126 72 72 61 79 + 159+ 112A 00 + 160+ 112B 44 69 76 69 DZMSG: defb "Division by Zero",0 + 160+ 112F 73 69 6F 6E + 160+ 1133 20 62 79 20 + 160+ 1137 5A 65 72 6F + 160+ 113B 00 + 161+ 113C 49 6C 6C 65 IDMSG: defb "Illegal Direct Mode",0 + 161+ 1140 67 61 6C 20 + 161+ 1144 44 69 72 65 + 161+ 1148 63 74 20 4D + 161+ 114C 6F 64 65 00 + 162+ 1150 54 79 70 65 TMMSG: defb "Type Mis-match",0 + 162+ 1154 20 4D 69 73 + 162+ 1158 2D 6D 61 74 + 162+ 115C 63 68 00 + 163+ 115F 4F 75 74 20 OSMSG: defb "Out of String Space",0 + 163+ 1163 6F 66 20 53 + 163+ 1167 74 72 69 6E + 163+ 116B 67 20 53 70 + 163+ 116F 61 63 65 00 + 164+ 1173 53 74 72 69 LSMSG: defb "String Too Long",0 + 164+ 1177 6E 67 20 54 + 164+ 117B 6F 6F 20 4C + 164+ 117F 6F 6E 67 00 + 165+ 1183 53 74 72 69 STMSG: defb "String Formula Too Complex",0 + 165+ 1187 6E 67 20 46 + 165+ 118B 6F 72 6D 75 + 165+ 118F 6C 61 20 54 + 165+ 1193 6F 6F 20 43 + 165+ 1197 6F 6D 70 6C + 165+ 119B 65 78 00 + 166+ 119E 43 61 6E 27 CNMSG: defb "Can't Continue",0 + 166+ 11A2 74 20 43 6F + 166+ 11A6 6E 74 69 6E + 166+ 11AA 75 65 00 + 167+ 11AD 55 6E 64 65 UFMSG: defb "Undefined FN Function",0 + 167+ 11B1 66 69 6E 65 + 167+ 11B5 64 20 46 4E + 167+ 11B9 20 46 75 6E + 167+ 11BD 63 74 69 6F + 167+ 11C1 6E 00 + 168+ 11C3 4D 69 73 73 MOMSG: defb "Missing Operand",0 + 168+ 11C7 69 6E 67 20 + 168+ 11CB 4F 70 65 72 + 168+ 11CF 61 6E 64 00 + 169+ 11D3 48 45 58 20 HEMSG: defb "HEX Format",0 + 169+ 11D7 46 6F 72 6D + 169+ 11DB 61 74 00 + 170+ 11DE 42 49 4E 20 BNMSG: defb "BIN Format",0 + 170+ 11E2 46 6F 72 6D + 170+ 11E6 61 74 00 + 171+ 11E9 4E 6F 20 47 GMMSG: defb "No Graphics Mode",0 + 171+ 11ED 72 61 70 68 + 171+ 11F1 69 63 73 20 + 171+ 11F5 4D 6F 64 65 + 171+ 11F9 00 + 172+ 11FA 53 65 72 69 SCMSG: defb "Serial Configuration",0 + 172+ 11FE 61 6C 20 43 + 172+ 1202 6F 6E 66 69 + 172+ 1206 67 75 72 61 + 172+ 120A 74 69 6F 6E + 172+ 120E 00 + 173+ 120F 53 65 72 69 SAMSG: defb "Serial Port Already Open",0 + 173+ 1213 61 6C 20 50 + 173+ 1217 6F 72 74 20 + 173+ 121B 41 6C 72 65 + 173+ 121F 61 64 79 20 + 173+ 1223 4F 70 65 6E + 173+ 1227 00 + 174+ 1228 53 65 72 69 SOMSG: defb "Serial Buffer Overrun",0 + 174+ 122C 61 6C 20 42 + 174+ 1230 75 66 66 65 + 174+ 1234 72 20 4F 76 + 174+ 1238 65 72 72 75 + 174+ 123C 6E 00 + 175+ 123E 48 45 4C 50 HPMSG: defb "HELP Call",0 + 175+ 1242 20 43 61 6C + 175+ 1246 6C 00 + 176+ 1248 49 6C 6C 65 IMMSG: defb "Illegal Indirect Mode",0 + 176+ 124C 67 61 6C 20 + 176+ 1250 49 6E 64 69 + 176+ 1254 72 65 63 74 + 176+ 1258 20 4D 6F 64 + 176+ 125C 65 00 + 177+ 125E 44 65 76 69 NRMSG: defb "Device Not Ready",0 + 177+ 1262 63 65 20 4E + 177+ 1266 6F 74 20 52 + 177+ 126A 65 61 64 79 + 177+ 126E 00 + 178+ 126F 46 69 6C 65 D0MSG: defb "File Open/Close",0 + 178+ 1273 20 4F 70 65 + 178+ 1277 6E 2F 43 6C + 178+ 127B 6F 73 65 00 + 179+ 127F 4E 61 6D 65 D1MSG: defb "Name String",0 + 179+ 1283 20 53 74 72 + 179+ 1287 69 6E 67 00 + 180+ 128B 44 69 73 6B D2MSG: defb "Disk Geometry",0 + 180+ 128F 20 47 65 6F + 180+ 1293 6D 65 74 72 + 180+ 1297 79 00 + 181+ 1299 53 61 76 65 D3MSG: defb "Save",0 + 181+ 129D 00 + 182+ 129E 4C 6F 61 64 D4MSG: defb "Load",0 + 182+ 12A2 00 + 183+ 12A3 44 69 73 6B D5MSG: defb "Disk Full",0 + 183+ 12A7 20 46 75 6C + 183+ 12AB 6C 00 + 184+ 12AD 44 75 70 6C D6MSG: defb "Duplicate File Name",0 + 184+ 12B1 69 63 61 74 + 184+ 12B5 65 20 46 69 + 184+ 12B9 6C 65 20 4E + 184+ 12BD 61 6D 65 00 + 185+ 12C1 44 4F 53 20 D7MSG: defb "DOS Version",0 + 185+ 12C5 56 65 72 73 + 185+ 12C9 69 6F 6E 00 + 186+ 12CD 46 69 6C 65 D8MSG: defb "File Not Found",0 + 186+ 12D1 20 4E 6F 74 + 186+ 12D5 20 46 6F 75 + 186+ 12D9 6E 64 00 + 187+ 12DC 46 69 6C 65 D9MSG: defb "File Already Open",0 + 187+ 12E0 20 41 6C 72 + 187+ 12E4 65 61 64 79 + 187+ 12E8 20 4F 70 65 + 187+ 12EC 6E 00 + 188+ 12EE 45 6E 64 20 DAMSG: defb "End Of File",0 + 188+ 12F2 4F 66 20 46 + 188+ 12F6 69 6C 65 00 + 189+ 12FA + 190+ 12FA + 191+ 12FA ;----------------------------------------------------------------------------- + 192+ 12FA ; STARTING POINTS FOR BASIC BOOT + 193+ 12FA ; COLD: reset every memory pointer, acting as a power-up boot + 194+ 12FA ; WARM: preserve program in memory, keeping every current pointer + 195+ 12FA + 196+ 12FA C3 00 13 COLD: jp STARTB ; Jump for cold start + 197+ 12FD C3 D6 13 WARM: jp WARMST ; Jump for warm start + 198+ 1300 + 199+ 1300 C3 07 13 STARTB: jp CSTART ; Jump to initialise + 200+ 1303 46 1E defw DEINT ; Get integer -32768 to 32767 + 201+ 1305 0B 26 defw ABPASS ; Return integer in AB + 202+ 1307 21 FA 53 CSTART: ld HL,WRKSPC ; Start of workspace RAM + 203+ 130A F9 ld SP,HL ; Set up a temporary stack + 204+ 130B C3 4D 41 jp INITST ; Go to initialise + 205+ 130E + 206+ 130E 21 E2 16 SYSINIT:ld HL,INITAB ; Initialise workspace + 207+ 1311 01 DC 00 ld BC,INITBE-INITAB+3; Bytes to copy + 208+ 1314 11 FA 53 ld DE,WRKSPC ; Into workspace RAM + 209+ 1317 ED B0 ldir ; Copy data + 210+ 1319 EB ex DE,HL ; Copy DE into HL + 211+ 131A F9 ld SP,HL ; Temporary stack + 212+ 131B CD AB 19 call CLREG ; Clear registers and stack + 213+ 131E CD 5D 20 call PRNTCRLF ; Output CRLF + 214+ 1321 32 2D 55 ld (BUFFER+88+1),A ; Mark end of buffer + 215+ 1324 32 07 56 ld (PROGST),A ; Initialise program area + 216+ 1327 18 13 jr MNOASK ; usually, don't ask for memory top (only when there are errors) + 217+ 1329 21 5A 14 MSIZE: ld HL,MEMMSG ; Point to message + 218+ 132C CD 29 27 call PRS ; Output "Memory size" + 219+ 132F CD C8 19 call PROMPT ; Get input with '?' + 220+ 1332 CD 2D 09 call CURSOR_ON ; enable cursor + 221+ 1335 CD 90 1D call GETCHR ; Get next character + 222+ 1338 B7 or A ; Set flags + 223+ 1339 C2 51 13 jp NZ,TSTMEM ; If number - Test if RAM there + 224+ 133C 21 6B 56 MNOASK: ld HL,STLOOK ; Point to start of RAM + 225+ 133F 23 MLOOP: inc HL ; Next byte + 226+ 1340 7C ld A,H ; Above address FFFF ? + 227+ 1341 B5 or L + 228+ 1342 CA 63 13 jp Z,SETTOP ; Yes - 64K RAM + 229+ 1345 7E ld A,(HL) ; Get contents + 230+ 1346 47 ld B,A ; Save it + 231+ 1347 2F cpl ; Flip all bits + 232+ 1348 77 ld (HL),A ; Put it back + 233+ 1349 BE cp (HL) ; RAM there if same + 234+ 134A 70 ld (HL),B ; Restore old contents + 235+ 134B CA 3F 13 jp Z,MLOOP ; If RAM - test next byte + 236+ 134E C3 63 13 jp SETTOP ; Top of RAM found + 237+ 1351 + 238+ 1351 CD 60 1E TSTMEM: call ATOH ; Get high memory into DE + 239+ 1354 B7 or A ; Set flags on last byte + 240+ 1355 C2 49 18 jp NZ,SNERR ; ?SN Error if bad character + 241+ 1358 EB ex DE,HL ; Address into HL + 242+ 1359 2B dec HL ; Back one byte + 243+ 135A 3E D9 ld A,%11011001 ; Test byte + 244+ 135C 46 ld B,(HL) ; Get old contents + 245+ 135D 77 ld (HL),A ; Load test byte + 246+ 135E BE cp (HL) ; RAM there if same + 247+ 135F 70 ld (HL),B ; Restore old contents + 248+ 1360 C2 29 13 jp NZ,MSIZE ; Ask again if no RAM + 249+ 1363 + 250+ 1363 CD 42 09 SETTOP: call CURSOR_OFF ; disable cursor + 251+ 1366 2B dec HL ; Back one byte + 252+ 1367 11 6A 56 ld DE,STLOOK-1 ; See if enough RAM + 253+ 136A CD 41 1B call CPDEHL ; Compare DE with HL + 254+ 136D DA 29 13 jp C,MSIZE ; Ask again if not enough RAM + 255+ 1370 3A E3 55 ld A,(DOS_EN) ; read if the user enabled/disabled DOS while booting + 256+ 1373 1F rra ; is DOS enabled? + 257+ 1374 38 1C jr C,SETDSR ; yes, so jump over + 258+ 1376 DD 21 E3 FF ld IX,DOSJPTB+1 ; point to 1st address of DOS jump table + 259+ 137A + 260+ 137A DEFINE DOSNTRS 10 ; DOS entries <-- CHANGE THIS VALUE TO ALIGN IT WITH THE NUMBER OF ENTRIES + 261+ 137A + 262+ 137A 06 0A ld B,10 ; number of entries + 263+ 137C 11 49 18 ld DE,SNERR ; address of REM routine + 264+ 137F DD 73 00 CPDSTB: ld (IX),E ; copy REM address... + 265+ 1382 DD 23 inc IX ; ...into the... + 266+ 1384 DD 72 00 ld (IX),D ; ...jump entry + 267+ 1387 DD 23 inc IX ; next jump address + 268+ 1389 DD 23 inc IX + 269+ 138B 10 F2 djnz CPDSTB ; repeat + 270+ 138D 11 E2 FF ld DE,0-(10*3); protect jump table (3 byte for each entry) + 271+ 1390 18 03 jr SETNOD + 272+ 1392 11 68 EE SETDSR: ld DE,0-($FFFF-DOSSTART+1) ; no, so reserve RAM occupied by DOS & I/O buffers + 273+ 1395 19 SETNOD: add HL,DE + 274+ 1396 22 32 55 SETTRAM:ld (LSTRAM),HL ; Save last available RAM + 275+ 1399 11 9C FF ld DE,0-100 ; now, reserve 100 bytes for string space + 276+ 139C 19 add HL,DE ; Allocate string space + 277+ 139D 22 49 54 ld (STRSPC),HL ; Save string space + 278+ 13A0 CD 86 19 call CLRPTR ; Clear program area + 279+ 13A3 2A 49 54 ld HL,(STRSPC) ; Get end of memory + 280+ 13A6 11 EF FF ld DE,0-17 ; Offset for free bytes + 281+ 13A9 19 add HL,DE ; Adjust HL + 282+ 13AA 11 07 56 ld DE,PROGST ; Start of program text + 283+ 13AD 7D ld A,L ; Get LSB + 284+ 13AE 93 sub E ; Adjust it + 285+ 13AF 6F ld L,A ; Re-save + 286+ 13B0 7C ld A,H ; Get MSB + 287+ 13B1 9A sbc A,D ; Adjust it + 288+ 13B2 67 ld H,A ; Re-save + 289+ 13B3 E5 push HL ; Save bytes free + 290+ 13B4 21 FC 13 ld HL,SIGNON ; Sign-on message + 291+ 13B7 CD 29 27 call PRS ; Output string + 292+ 13BA 3A E3 55 ld A,(DOS_EN) ; check if DOS is enabled + 293+ 13BD B7 or A + 294+ 13BE 28 06 jr Z,SETTP1 ; no DOS, jump over + 295+ 13C0 21 3D 14 ld HL,DOSMSG ; DOS message + 296+ 13C3 CD 29 27 call PRS + 297+ 13C6 21 E5 13 SETTP1: ld HL,BLNSPC ; Empty space + 298+ 13C9 CD 29 27 call PRS ; Output string + 299+ 13CC E1 pop HL ; Get bytes free back + 300+ 13CD CD C8 31 call PRNTHL ; Output amount of free memory + 301+ 13D0 21 EE 13 ld HL,BFREE ; " Bytes free" message + 302+ 13D3 CD 29 27 call PRS ; Output string + 303+ 13D6 + 304+ 13D6 31 D9 54 WARMST: ld SP,STACK ; Temporary stack + 305+ 13D9 CD AB 19 BRKRET: call CLREG ; Clear registers and stack + 306+ 13DC CD D8 3E call RESFN ; reset FN keys and auto-repeat + 307+ 13DF CD 2D 09 call CURSOR_ON ; enable cursor + 308+ 13E2 C3 A9 18 jp PRNTOK ; Go to get command line + 309+ 13E5 + 310+ 13E5 20 20 20 20 BLNSPC: defb " ",0 ; 8 empty cells to align the "XXXX Bytes free" message + 310+ 13E9 20 20 20 20 + 310+ 13ED 00 + 311+ 13EE 20 42 79 74 BFREE: defb " Bytes free",CR,CR,0 + 311+ 13F2 65 73 20 66 + 311+ 13F6 72 65 65 0D + 311+ 13FA 0D 00 + 312+ 13FC + 313+ 13FC 4C 4D 38 30 SIGNON: defb "LM80C BASIC 3.25 ",251,"2021 L.Miliani" + 313+ 1400 43 20 42 41 + 313+ 1404 53 49 43 20 + 313+ 1408 33 2E 32 35 + 313+ 140C 20 FB 32 30 + 313+ 1410 32 31 20 4C + 313+ 1414 2E 4D 69 6C + 313+ 1418 69 61 6E 69 + 314+ 141C 20 5A 38 30 defb " Z80 BASIC 4.7 ",251,"1978 Microsoft",CR,0 + 314+ 1420 20 42 41 53 + 314+ 1424 49 43 20 34 + 314+ 1428 2E 37 20 20 + 314+ 142C FB 31 39 37 + 314+ 1430 38 20 4D 69 + 314+ 1434 63 72 6F 73 + 314+ 1438 6F 66 74 0D + 314+ 143C 00 + 315+ 143D 20 20 20 20 DOSMSG: defb " LM80C DOS ","1.05"," Loaded",CR,0 + 315+ 1441 20 4C 4D 38 + 315+ 1445 30 43 20 44 + 315+ 1449 4F 53 20 31 + 315+ 144D 2E 30 35 20 + 315+ 1451 20 4C 6F 61 + 315+ 1455 64 65 64 0D + 315+ 1459 00 + 316+ 145A + 317+ 145A 4D 65 6D 6F MEMMSG: defb "Memory top",0 + 317+ 145E 72 79 20 74 + 317+ 1462 6F 70 00 + 318+ 1465 + 319+ 1465 ; The following list reports all the functions supported by the interpreter. + 320+ 1465 ; To add a custom function, the user must first insert the reserved word here, + 321+ 1465 ; then into the list of the reserved words below, and finally must increment the + 322+ 1465 ; ZSGN token value and all the following ones after ZSGN by 1 for every added + 323+ 1465 ; function. + 324+ 1465 + 325+ 1465 ; FUNCTION ADDRESS TABLE (this is a sort of offset table) + 326+ 1465 ; this list must be coherent with the tokens' functions list. This means that every + 327+ 1465 ; entry here must have the corresponding entry in the tokens list. + 328+ 1465 3D 30 FNCTAB: defw SGN + 329+ 1467 D3 25 defw TMR ; added by Leonardo Miliani + 330+ 1469 01 31 defw INT + 331+ 146B 53 30 defw ABS_ ; '_' necessary to avoid assembler warnings + 332+ 146D 00 54 defw USR + 333+ 146F E9 25 defw FRE + 334+ 1471 64 2A defw INP + 335+ 1473 17 26 defw POS + 336+ 1475 C7 32 defw SQR + 337+ 1477 A6 33 defw RND + 338+ 1479 91 2E defw LOG + 339+ 147B 15 33 defw EXP + 340+ 147D 1B 34 defw COS + 341+ 147F 21 34 defw SIN + 342+ 1481 82 34 defw TAN + 343+ 1483 97 34 defw ATN + 344+ 1485 40 2B defw PEEK + 345+ 1487 01 35 defw DEEK + 346+ 1489 47 2B defw VPEEK ; added by Leonardo Miliani + 347+ 148B 16 2D defw VSTAT ; added by Leonardo Miliani + 348+ 148D 21 2D defw SSTAT ; added by Leonardo Miliani + 349+ 148F 35 2D defw INKEY ; added by Leonardo Miliani + 350+ 1491 4D 38 defw POINT ; added by Leonardo Miliani + 351+ 1493 FB 28 defw INSTR ; added by Leonardo Miliani + 352+ 1495 E8 FF defw JPGET ; added by Leonardo Miliani + 353+ 1497 E2 FF defw JPEOF ; added by Leonardo Miliani + 354+ 1499 9B 28 defw LEN + 355+ 149B B3 26 defw STR + 356+ 149D 2B 2A defw VAL + 357+ 149F AA 28 defw ASC + 358+ 14A1 BB 28 defw CHR + 359+ 14A3 36 40 defw HEX ; added by Grant Searle + 360+ 14A5 C7 40 defw BIN ; added by Grant Searle + 361+ 14A7 CB 28 defw LEFT + 362+ 14A9 F1 29 defw RIGHT + 363+ 14AB FB 29 defw MID + 364+ 14AD + 365+ 14AD ; RESERVED WORD LIST + 366+ 14AD ; Here are all the reserved words used by the interpreter + 367+ 14AD ; To add custom functions/commands, the user must insert the keyword + 368+ 14AD ; in this list, following the schematic + 369+ 14AD C5 4E 44 WORDS: defb 'E'+$80,"ND" ; from here the list contains the COMMANDS + 370+ 14B0 C6 4F 52 defb 'F'+$80,"OR" + 371+ 14B3 CE 45 58 54 defb 'N'+$80,"EXT" + 372+ 14B7 C4 41 54 41 defb 'D'+$80,"ATA" + 373+ 14BB C9 4E 50 55 defb 'I'+$80,"NPUT" + 373+ 14BF 54 + 374+ 14C0 C4 49 4D defb 'D'+$80,"IM" + 375+ 14C3 D2 45 41 44 defb 'R'+$80,"EAD" + 376+ 14C7 CC 45 54 defb 'L'+$80,"ET" + 377+ 14CA C7 4F 54 4F defb 'G'+$80,"OTO" + 378+ 14CE D2 55 4E defb 'R'+$80,"UN" + 379+ 14D1 C9 46 defb 'I'+$80,"F" + 380+ 14D3 D2 45 53 54 defb 'R'+$80,"ESTORE" + 380+ 14D7 4F 52 45 + 381+ 14DA C7 4F 53 55 defb 'G'+$80,"OSUB" + 381+ 14DE 42 + 382+ 14DF D2 45 54 55 defb 'R'+$80,"ETURN" + 382+ 14E3 52 4E + 383+ 14E5 D2 45 4D defb 'R'+$80,"EM" ; original REM + 384+ 14E8 D3 54 4F 50 defb 'S'+$80,"TOP" + 385+ 14EC CF 55 54 defb 'O'+$80,"UT" + 386+ 14EF CF 4E defb 'O'+$80,"N" + 387+ 14F1 C6 49 4C 45 defb 'F'+$80,"ILES" ; added by Leonardo Miliani + 387+ 14F5 53 + 388+ 14F6 C5 52 41 53 defb 'E'+$80,"RASE" ; added by Leonardo Miliani + 388+ 14FA 45 + 389+ 14FB C4 49 53 4B defb 'D'+$80,"ISK" ; added by Leonardo Miliani + 390+ 14FF CF 50 45 4E defb 'O'+$80,"PEN" ; added by Leonardo Miliani + 391+ 1503 C3 4C 4F 53 defb 'C'+$80,"LOSE" ; added by Leonardo Miliani + 391+ 1507 45 + 392+ 1508 D0 55 54 defb 'P'+$80,"UT" ; added by Leonardo Miliani + 393+ 150B D7 41 49 54 defb 'W'+$80,"AIT" + 394+ 150F C4 45 46 defb 'D'+$80,"EF" + 395+ 1512 D0 4F 4B 45 defb 'P'+$80,"OKE" + 396+ 1516 C4 4F 4B 45 defb 'D'+$80,"OKE" + 397+ 151A D6 50 4F 4B defb 'V'+$80,"POKE" ; added by Leonardo Miliani + 397+ 151E 45 + 398+ 151F D3 52 45 47 defb 'S'+$80,"REG" ; added by Leonardo Miliani + 399+ 1523 D6 52 45 47 defb 'V'+$80,"REG" ; added by Leonardo Miliani + 400+ 1527 D3 43 52 45 defb 'S'+$80,"CREEN" ; changed by Leonardo Miliani + 400+ 152B 45 4E + 401+ 152D CC 4F 43 41 defb 'L'+$80,"OCATE" ; added by Leonardo Miliani + 401+ 1531 54 45 + 402+ 1533 D3 4F 55 4E defb 'S'+$80,"OUND" ; added by Leonardo Miliani + 402+ 1537 44 + 403+ 1538 D6 4F 4C 55 defb 'V'+$80,"OLUME" ; added by Leonardo Miliani + 403+ 153C 4D 45 + 404+ 153E D0 41 55 53 defb 'P'+$80,"AUSE" ; added by Leonardo Miliani + 404+ 1542 45 + 405+ 1543 C3 4F 4C 4F defb 'C'+$80,"OLOR" ; added by Leonardo Miliani + 405+ 1547 52 + 406+ 1548 D0 4C 4F 54 defb 'P'+$80,"LOT" ; added by Leonardo Miliani + 407+ 154C C4 52 41 57 defb 'D'+$80,"RAW" ; added by Leonardo Miliani + 408+ 1550 C3 49 52 43 defb 'C'+$80,"IRCLE" ; added by Leonardo Miliani + 408+ 1554 4C 45 + 409+ 1556 D0 41 49 4E defb 'P'+$80,"AINT" ; added by Leonardo Miliani + 409+ 155A 54 + 410+ 155B D3 45 52 49 defb 'S'+$80,"ERIAL" ; added by Leonardo Miliani + 410+ 155F 41 4C + 411+ 1561 C8 45 4C 50 defb 'H'+$80,"ELP" ; changed by Leonardo Miliani - was LINES + 412+ 1565 C3 4C 53 defb 'C'+$80,"LS" ; restored command + 413+ 1568 CB 45 59 defb 'K'+$80,"EY" ; added by Leonardo Miliani + 414+ 156B CE 4D 49 defb 'N'+$80,"MI" ; added by Leonardo Miliani + 415+ 156E C7 50 52 49 defb 'G'+$80,"PRINT" ; added by Leonardo Miliani + 415+ 1572 4E 54 + 416+ 1574 D7 49 44 54 defb 'W'+$80,"IDTH" + 416+ 1578 48 + 417+ 1579 D3 59 53 defb 'S'+$80,"YS" ; added by Leonardo Miliani + 418+ 157C D2 45 53 45 defb 'R'+$80,"ESET" ; changed by Leonardo Miliani + 418+ 1580 54 + 419+ 1581 C5 4C 53 45 defb 'E'+$80,"LSE" ; added by Leonardo Miliani + 420+ 1585 D0 52 49 4E defb 'P'+$80,"RINT" + 420+ 1589 54 + 421+ 158A C3 4F 4E 54 defb 'C'+$80,"ONT" + 422+ 158E CC 49 53 54 defb 'L'+$80,"IST" + 423+ 1592 C3 4C 45 41 defb 'C'+$80,"LEAR" + 423+ 1596 52 + 424+ 1597 CC 4F 41 44 defb 'L'+$80,"OAD" + 425+ 159B D3 41 56 45 defb 'S'+$80,"AVE" + 426+ 159F CE 45 57 defb 'N'+$80,"EW" + 427+ 15A2 D4 41 42 28 defb 'T'+$80,"AB(" + 428+ 15A6 D4 4F defb 'T'+$80,"O" + 429+ 15A8 C6 4E defb 'F'+$80,"N" + 430+ 15AA D3 50 43 28 defb 'S'+$80,"PC(" + 431+ 15AE D4 48 45 4E defb 'T'+$80,"HEN" + 432+ 15B2 CE 4F 54 defb 'N'+$80,"OT" + 433+ 15B5 D3 54 45 50 defb 'S'+$80,"TEP" + 434+ 15B9 ; from here: operators + 435+ 15B9 AB defb '+'+$80 + 436+ 15BA AD defb '-'+$80 + 437+ 15BB AA defb '*'+$80 + 438+ 15BC AF defb '/'+$80 + 439+ 15BD A5 defb '%'+$80 + 440+ 15BE A3 defb '#'+$80 + 441+ 15BF DE defb '^'+$80 + 442+ 15C0 C1 4E 44 defb 'A'+$80,"ND" + 443+ 15C3 D8 4F 52 defb 'X'+$80,"OR" + 444+ 15C6 CF 52 defb 'O'+$80,"R" + 445+ 15C8 BE defb '>'+$80 + 446+ 15C9 BD defb '='+$80 + 447+ 15CA BC defb '<'+$80 + 448+ 15CB + 449+ 15CB ; from here there are the tokens' FUNCTIONS list + 450+ 15CB ; this list must be coherent with the functions list above + 451+ 15CB D3 47 4E defb 'S'+$80,"GN" + 452+ 15CE D4 4D 52 defb 'T'+$80,"MR" ; added by Leonardo Miliani + 453+ 15D1 C9 4E 54 defb 'I'+$80,"NT" + 454+ 15D4 C1 42 53 defb 'A'+$80,"BS" + 455+ 15D7 D5 53 52 defb 'U'+$80,"SR" + 456+ 15DA C6 52 45 defb 'F'+$80,"RE" + 457+ 15DD C9 4E 50 defb 'I'+$80,"NP" + 458+ 15E0 D0 4F 53 defb 'P'+$80,"OS" + 459+ 15E3 D3 51 52 defb 'S'+$80,"QR" + 460+ 15E6 D2 4E 44 defb 'R'+$80,"ND" + 461+ 15E9 CC 4F 47 defb 'L'+$80,"OG" + 462+ 15EC C5 58 50 defb 'E'+$80,"XP" + 463+ 15EF C3 4F 53 defb 'C'+$80,"OS" + 464+ 15F2 D3 49 4E defb 'S'+$80,"IN" + 465+ 15F5 D4 41 4E defb 'T'+$80,"AN" + 466+ 15F8 C1 54 4E defb 'A'+$80,"TN" + 467+ 15FB D0 45 45 4B defb 'P'+$80,"EEK" + 468+ 15FF C4 45 45 4B defb 'D'+$80,"EEK" + 469+ 1603 D6 50 45 45 defb 'V'+$80,"PEEK" ; added by Leonardo Miliani + 469+ 1607 4B + 470+ 1608 D6 53 54 41 defb 'V'+$80,"STAT" ; added by Leonardo Miliani + 470+ 160C 54 + 471+ 160D D3 53 54 41 defb 'S'+$80,"STAT" ; added by Leonardo Miliani + 471+ 1611 54 + 472+ 1612 C9 4E 4B 45 defb 'I'+$80,"NKEY" ; added by Leonardo Miliani + 472+ 1616 59 + 473+ 1617 D0 4F 49 4E defb 'P'+$80,"OINT" ; added by Leonardo Miliani + 473+ 161B 54 + 474+ 161C C9 4E 53 54 defb 'I'+$80,"NSTR" ; added by Leonardo Miliani + 474+ 1620 52 + 475+ 1621 C7 45 54 defb 'G'+$80,"ET" ; added by Leonardo Miliani + 476+ 1624 C5 4F 46 defb 'E'+$80,"OF" ; added by Leonardo Miliani + 477+ 1627 CC 45 4E defb 'L'+$80,"EN" + 478+ 162A D3 54 52 24 defb 'S'+$80,"TR$" + 479+ 162E D6 41 4C defb 'V'+$80,"AL" + 480+ 1631 C1 53 43 defb 'A'+$80,"SC" + 481+ 1634 C3 48 52 24 defb 'C'+$80,"HR$" + 482+ 1638 C8 45 58 24 defb 'H'+$80,"EX$" ; added by Grant Searle + 483+ 163C C2 49 4E 24 defb 'B'+$80,"IN$" ; added by Grant Searle + 484+ 1640 CC 45 46 54 defb 'L'+$80,"EFT$" + 484+ 1644 24 + 485+ 1645 D2 49 47 48 defb 'R'+$80,"IGHT$" + 485+ 1649 54 24 + 486+ 164B CD 49 44 24 defb 'M'+$80,"ID$" + 487+ 164F 80 defb $80 ; End-of-list marker + 488+ 1650 + 489+ 1650 ; COMMAND KEYWORD ADDRESS TABLE + 490+ 1650 ; this list must be coherent with the commands' tokens list above + 491+ 1650 DA 1D WORDTB: defw PEND + 492+ 1652 D7 1C defw FOR + 493+ 1654 D6 21 defw NEXT + 494+ 1656 39 1F defw DATA + 495+ 1658 D3 20 defw INPUT + 496+ 165A 2B 24 defw DIM + 497+ 165C 0D 21 defw READ + 498+ 165E 50 1F defw LET + 499+ 1660 F6 1E defw GOTO + 500+ 1662 D1 1E defw RUN + 501+ 1664 C8 1F defw IF + 502+ 1666 A0 1D defw RESTOR + 503+ 1668 E5 1E defw GOSUB + 504+ 166A 14 1F defw RETURN + 505+ 166C 3B 1F defw REM ; original REM + 506+ 166E D8 1D defw STOP + 507+ 1670 70 2A defw POUT + 508+ 1672 AA 1F defw ON + 509+ 1674 FD FF defw JPFILS ; changed by Leonardo Miliani - was NULL + 510+ 1676 F4 FF defw JPERAS ; added by Leonardo Miliani + 511+ 1678 F1 FF defw JPDISK ; added by Leonardo Miliani + 512+ 167A EE FF defw JPOPEN ; added by Leonardo Miliani + 513+ 167C EB FF defw JPCLOSE ; added by Leonardo Miliani + 514+ 167E E5 FF defw JPPUT ; added by Leonardo Miliani + 515+ 1680 76 2A defw WAIT + 516+ 1682 1F 26 defw DEF + 517+ 1684 6A 2B defw POKE + 518+ 1686 0C 35 defw DOKE + 519+ 1688 6F 2B defw VPOKE ; added by Leonardo Miliani + 520+ 168A AC 2B defw SREG ; added by Leonardo Miliani + 521+ 168C FA 2C defw VREG ; added by Leonardo Miliani + 522+ 168E 40 35 defw SCREEN ; new behaviour: now it sets up a graphics mode (Leonardo Miliani) + 523+ 1690 7A 2B defw LOCATE ; added by Leonardo Miliani + 524+ 1692 06 2C defw SOUND ; added by Leonardo Miliani + 525+ 1694 CD 2B defw VOLUME ; added by Leonardo Miliani + 526+ 1696 23 35 defw PAUSE ; added by Leonardo Miliani + 527+ 1698 B9 35 defw COLOR ; added by Leonardo Miliani + 528+ 169A A0 38 defw PLOT ; added by Leonardo Miliani + 529+ 169C 32 39 defw DRAW ; added by Leonardo Miliani + 530+ 169E 67 3A defw CIRCLE ; added by Leonardo Miliani + 531+ 16A0 61 37 defw PAINT ; added by Leonardo Miliani + 532+ 16A2 6E 3C defw SERIAL ; added by Leonardo Miliani + 533+ 16A4 AD 3E defw HELP ; changed by Leonardo Miliani - was LINES + 534+ 16A6 E5 34 defw CLS + 535+ 16A8 CB 3E defw KEY ; added by Leonardo Miliani + 536+ 16AA B8 2A defw NMI ; added by Leonardo Miliani + 537+ 16AC 71 36 defw GPRINT ; added by Leonardo Miliani + 538+ 16AE F9 34 defw WIDTH + 539+ 16B0 12 2B defw SYS ; added by Leonardo Miliani + 540+ 16B2 2C 41 defw RESET ; new behaviour: now it resets the system + 541+ 16B4 3D 1F defw REM+2 ; ELSE: added by Leonardo Miliani + 542+ 16B6 FA 1F defw PRINT + 543+ 16B8 0C 1E defw CONT + 544+ 16BA AE 1B defw LIST + 545+ 16BC 85 1E defw CLEAR + 546+ 16BE F7 FF defw JPLOAD ; re-implemented by Leonardo Miliani (was CLOAD) + 547+ 16C0 FA FF defw JPSAVE ; re-implemented by Leonardo Miliani (was CSAVE) + 548+ 16C2 85 19 defw NEW + 549+ 16C4 + 550+ 16C4 ; RESERVED WORD TOKEN VALUES + 551+ 16C4 ; if you add a function or command you must increment by 1 + 552+ 16C4 ; the values below. Pay attention that you must increment only the + 553+ 16C4 ; values AFTER the position where you entered the function/command word + 554+ 16C4 ; in the "Reserver word list" above. I.E.: VPOKE has been added between + 555+ 16C4 ; DOKE and SCREEN, and since REM is the reserved work listed below + 556+ 16C4 ; that is before the point where VPOKE has been entered, every entry + 557+ 16C4 ; after REM has been incremented. + 558+ 16C4 ; Another example: when TMR has been added, since it's a function, every + 559+ 16C4 ; entry after & included ZSGN must be checked (read below) + 560+ 16C4 + 561+ 16C4 ZEND equ $80 ; END <-- from here, there are the commands + 562+ 16C4 ZFOR equ $81 ; FOR + 563+ 16C4 ZDATA equ $83 ; DATA + 564+ 16C4 ZGOTO equ $88 ; GOTO + 565+ 16C4 ZGOSUB equ $8C ; GOSUB + 566+ 16C4 ZREM equ $8E ; REM + 567+ 16C4 ZELSE equ $B2 ; ELSE + 568+ 16C4 ZPRINT equ $B3 ; PRINT + 569+ 16C4 ZNEW equ $B9 ; NEW + 570+ 16C4 + 571+ 16C4 ZTAB equ $BA ; TAB + 572+ 16C4 ZTO equ $BB ; TO + 573+ 16C4 ZFN equ $BC ; FN + 574+ 16C4 ZSPC equ $BD ; SPC + 575+ 16C4 ZTHEN equ $BE ; THEN + 576+ 16C4 ZNOT equ $BF ; NOT + 577+ 16C4 ZSTEP equ $C0 ; STEP + 578+ 16C4 + 579+ 16C4 ZPLUS equ $C1 ; + <-- from here, there are the math operators + 580+ 16C4 ZMINUS equ $C2 ; - + 581+ 16C4 ZTIMES equ $C3 ; * + 582+ 16C4 ZDIV equ $C4 ; / + 583+ 16C4 ZMOD equ $C5 ; % + 584+ 16C4 ZDINT equ $C6 ; # + 585+ 16C4 ZOR equ $CA ; OR + 586+ 16C4 ZGTR equ $CB ; > + 587+ 16C4 ZEQUAL equ $CC ; M + 588+ 16C4 ZLTH equ $CD ; < + 589+ 16C4 + 590+ 16C4 ZSGN equ $CE ; SGN <-- from here, there are the functions + 591+ 16C4 ZPOINT equ $E4 ; ZPOINT <-- if the user enters a custom function, between + 592+ 16C4 ; SGN and POINT, he/she must increment this pointer by 1 + 593+ 16C4 ZINSTR equ $E5 ; ZINSTR <-- same here + 594+ 16C4 ZLEFT equ $EF ; LEFT$ <-- if the user enters a custom function anywhere, + 595+ 16C4 ; he/she must increment this pointer by 1 + 596+ 16C4 + 597+ 16C4 ; ARITHMETIC PRECEDENCE TABLE + 598+ 16C4 ; in the formulas below, is a number stored into the stack that must be retrieved + 599+ 16C4 ; with POP BC, POP DE; FPREG is a f.p. number store into the RAM register FPREG + 600+ 16C4 79 PRITAB: defb $79 ; Precedence value + 601+ 16C5 AF 31 defw PADD ; FPREG = + FPREG + 602+ 16C7 + 603+ 16C7 79 defb $79 ; Precedence value + 604+ 16C8 92 2D defw PSUB ; FPREG = - FPREG + 605+ 16CA + 606+ 16CA 7C defb $7C ; Precedence value + 607+ 16CB D0 2E defw MULT ; PPREG = * FPREG + 608+ 16CD + 609+ 16CD 7C defb $7C ; Precedence value + 610+ 16CE 82 2F defw DIV ; FPREG = / FPREG + 611+ 16D0 + 612+ 16D0 7C defb $7C ; Precedence value + 613+ 16D1 2D 2F defw MOD ; FPREG = INT()-(INT(FPREG)*INT(/FPREG)) + 614+ 16D3 + 615+ 16D3 7C defb $7C ; precedence value + 616+ 16D4 25 2F defw DINT ; FPREG = INT( / FPREG ) + 617+ 16D6 + 618+ 16D6 7F defb $7F ; Precedence value + 619+ 16D7 D0 32 defw POWER ; FPREG = ^ FPREG + 620+ 16D9 + 621+ 16D9 50 defb $50 ; Precedence value + 622+ 16DA 74 23 defw PAND ; FPREG = AND FPREG + 623+ 16DC + 624+ 16DC 4A defb $4A ; Precedence value + 625+ 16DD 7C 23 defw PXOR ; FPREG = XOR FPREG + 626+ 16DF + 627+ 16DF 46 defb $46 ; Precedence value + 628+ 16E0 77 23 defw POR ; FPREG = OR FPREG + 629+ 16E2 + 630+ 16E2 + 631+ 16E2 ; INITIALISATION TABLE ------------------------------------------------------- + 632+ 16E2 ; these values are copied into RAM at startup + 633+ 16E2 C3 D6 13 INITAB: jp WARMST ; Warm start jump + 634+ 16E5 ED 45 00 defb $ED,$45,$00 ; RETN + NOP for default NMI service routine + 635+ 16E8 C3 5B 1E jp FCERR ; "USR (X)" jump (Set to Error) + 636+ 16EB D3 00 out (0),A ; "out p,n" skeleton + 637+ 16ED C9 ret + 638+ 16EE D6 00 sub $00 ; Division support routine + 639+ 16F0 6F ld L,A + 640+ 16F1 7C ld A,H + 641+ 16F2 DE 00 sbc A,$00 + 642+ 16F4 67 ld H,A + 643+ 16F5 78 ld A,B + 644+ 16F6 DE 00 sbc A,$00 + 645+ 16F8 47 ld B,A + 646+ 16F9 3E 00 ld A,$00 + 647+ 16FB C9 ret + 648+ 16FC 00 00 00 defb $00,$00,$00 ; Random number seed table used by RND + 649+ 16FF 35 4A CA 99 defb $35,$4A,$CA,$99 ;-2.65145E+07 + 650+ 1703 39 1C 76 98 defb $39,$1C,$76,$98 ; 1.61291E+07 + 651+ 1707 22 95 B3 98 defb $22,$95,$B3,$98 ;-1.17691E+07 + 652+ 170B 0A DD 47 98 defb $0A,$DD,$47,$98 ; 1.30983E+07 + 653+ 170F 53 D1 99 99 defb $53,$D1,$99,$99 ;-2-01612E+07 + 654+ 1713 0A 1A 9F 98 defb $0A,$1A,$9F,$98 ;-1.04269E+07 + 655+ 1717 65 BC CD 98 defb $65,$BC,$CD,$98 ;-1.34831E+07 + 656+ 171B D6 77 3E 98 defb $D6,$77,$3E,$98 ; 1.24825E+07 + 657+ 171F 52 C7 4F 80 defb $52,$C7,$4F,$80 ; Last random number + 658+ 1723 DB 00 in A,($00) ; INP (x) skeleton + 659+ 1725 C9 ret + 660+ 1726 FF defb $FF ; Terminal width (255 = no auto CRLF) + 661+ 1727 14 defb $14 ; Width for commas (at reset, 3 columns, for G1 mode) + 662+ 1728 00 defb $00 ; No nulls after input bytes + 663+ 1729 00 defb $00 ; Output enabled (^O off) + 664+ 172A 00 00 defw $00 ; Array load/save check sum + 665+ 172C 00 defb $00 ; Break not by NMI + 666+ 172D 00 defb $00 ; Break flag + 667+ 172E C3 C9 1A jp TTYLIN ; Input reflection (set to TTY) + 668+ 1731 6B 56 defw STLOOK ; Temp string space + 669+ 1733 FE FF defw -2 ; Current line number (cold) + 670+ 1735 FF FF defw -1 ; Current line with errors (no errors) + 671+ 1737 40 AUTORP: defb $40 ; delay for key auto-repeat start + 672+ 1738 08 defb $08 ; auto-repeat delay + 673+ 1739 4C 49 53 54 DEFFNKS:defm "LIST",13,0,0,0,0,0,0,0,0,0,0,0 ; KEY 1 + 673+ 173D 0D 00 00 00 + 673+ 1741 00 00 00 00 + 673+ 1745 00 00 00 00 + 674+ 1749 52 55 4E 0D defm "RUN",13,0,0,0,0,0,0,0,0,0,0,0,0 ; KEY 2 + 674+ 174D 00 00 00 00 + 674+ 1751 00 00 00 00 + 674+ 1755 00 00 00 00 + 675+ 1759 53 43 52 45 defm "SCREEN1",13,0,0,0,0,0,0,0,0 ; KEY 3 + 675+ 175D 45 4E 31 0D + 675+ 1761 00 00 00 00 + 675+ 1765 00 00 00 00 + 676+ 1769 43 4F 4C 4F defm "COLOR1,15,5",13,0,0,0,0 ; KEY 4 + 676+ 176D 52 31 2C 31 + 676+ 1771 35 2C 35 0D + 676+ 1775 00 00 00 00 + 677+ 1779 53 45 52 49 defm "SERIAL1,38400",13,0,0 ; KEY 5 + 677+ 177D 41 4C 31 2C + 677+ 1781 33 38 34 30 + 677+ 1785 30 0D 00 00 + 678+ 1789 53 43 52 45 defm "SCREEN2",13,0,0,0,0,0,0,0,0 ; KEY 6 + 678+ 178D 45 4E 32 0D + 678+ 1791 00 00 00 00 + 678+ 1795 00 00 00 00 + 679+ 1799 43 4F 4E 54 defm "CONT",13,0,0,0,0,0,0,0,0,0,0,0 ; KEY 7 + 679+ 179D 0D 00 00 00 + 679+ 17A1 00 00 00 00 + 679+ 17A5 00 00 00 00 + 680+ 17A9 48 45 4C 50 defm "HELP",13,0,0,0,0,0,0,0,0,0,0,0 ; KEY 8 (HELP KEY) + 680+ 17AD 0D 00 00 00 + 680+ 17B1 00 00 00 00 + 680+ 17B5 00 00 00 00 + 681+ 17B9 08 56 defw PROGST+1 ; Start of program text + 682+ 17BB INITBE: + 683+ 17BB + 684+ 17BB ; END OF INITIALISATION TABLE --------------------------------------------------- + 685+ 17BB + 686+ 17BB 20 45 72 72 ERRMSG: defb " Error",0 + 686+ 17BF 6F 72 00 + 687+ 17C2 20 69 6E 20 INMSG: defb " in ",0 + 687+ 17C6 00 + 688+ 17C7 ZERBYT equ $-1 ; A zero byte + 689+ 17C7 4F 6B 0D 00 OKMSG: defb "Ok",CR,0,0 + 689+ 17CB 00 + 690+ 17CC 42 72 65 61 BRKMSG: defb "Break",0 + 690+ 17D0 6B 00 + 691+ 17D2 + 692+ 17D2 21 04 00 BAKSTK: ld HL,$04 ; Look for "FOR" block with + 693+ 17D5 39 add HL,SP ; same index as specified + 694+ 17D6 7E LOKFOR: ld A,(HL) ; Get block ID + 695+ 17D7 23 inc HL ; Point to index address + 696+ 17D8 FE 81 cp ZFOR ; Is it a "FOR" token + 697+ 17DA C0 ret NZ ; No - exit + 698+ 17DB 4E ld C,(HL) ; BC = Address of "FOR" index + 699+ 17DC 23 inc HL + 700+ 17DD 46 ld B,(HL) + 701+ 17DE 23 inc HL ; Point to sign of STEP + 702+ 17DF E5 push HL ; Save pointer to sign + 703+ 17E0 69 ld L,C ; HL = address of "FOR" index + 704+ 17E1 60 ld H,B + 705+ 17E2 7A ld A,D ; See if an index was specified + 706+ 17E3 B3 or E ; DE = 0 if no index specified + 707+ 17E4 EB ex DE,HL ; Specified index into HL + 708+ 17E5 CA EC 17 jp Z,INDFND ; Skip if no index given + 709+ 17E8 EB ex DE,HL ; Index back into DE + 710+ 17E9 CD 41 1B call CPDEHL ; Compare index with one given + 711+ 17EC 01 0D 00 INDFND: ld BC,16-3 ; Offset to next block + 712+ 17EF E1 pop HL ; Restore pointer to sign + 713+ 17F0 C8 ret Z ; Return if block found + 714+ 17F1 09 add HL,BC ; Point to next block + 715+ 17F2 C3 D6 17 jp LOKFOR ; Keep on looking + 716+ 17F5 + 717+ 17F5 CD 0F 18 MOVUP: call ENFMEM ; See if enough memory + 718+ 17F8 C5 MOVSTR: push BC ; Save end of source + 719+ 17F9 E3 ex (SP),HL ; Swap source and dest" end + 720+ 17FA C1 pop BC ; Get end of destination + 721+ 17FB CD 41 1B MOVLP: call CPDEHL ; See if list moved + 722+ 17FE 7E ld A,(HL) ; Get byte + 723+ 17FF 02 ld (BC),A ; Move it + 724+ 1800 C8 ret Z ; Exit if all done + 725+ 1801 0B dec BC ; Next byte to move to + 726+ 1802 2B dec HL ; Next byte to move + 727+ 1803 C3 FB 17 jp MOVLP ; Loop until all bytes moved + 728+ 1806 + 729+ 1806 E5 CHKSTK: push HL ; Save code string address + 730+ 1807 2A E8 55 ld HL,(ARREND) ; Lowest free memory + 731+ 180A 06 00 ld B,$00 ; BC = Number of levels to test + 732+ 180C 09 add HL,BC ; 2 Bytes for each level + 733+ 180D 09 add HL,BC + 734+ 180E 3E defb $3E ; Skip "push HL" + 735+ 180F E5 ENFMEM: push HL ; Save code string address + 736+ 1810 3E D0 ld A,$D0 ; LOW -48 ; 48 Bytes minimum RAM + 737+ 1812 95 sub L + 738+ 1813 6F ld L,A + 739+ 1814 3E FF ld A,$FF ; HIGH (-48) ; 48 Bytes minimum RAM + 740+ 1816 9C sbc A,H + 741+ 1817 DA 1E 18 jp C,OMERR ; Not enough - ?OM Error + 742+ 181A 67 ld H,A + 743+ 181B 39 add HL,SP ; Test if stack is overflowed + 744+ 181C E1 pop HL ; Restore code string address + 745+ 181D D8 ret C ; Return if enough memory + 746+ 181E 1E 0C OMERR: ld E,OM ; ?OM Error + 747+ 1820 C3 63 18 jp ERROR + 748+ 1823 + 749+ 1823 + 750+ 1823 ; if in graphics mode, return to text (called by "NOLIN" and "ERROR") + 751+ 1823 F5 EXITGM: push AF ; store AF + 752+ 1824 3A 90 55 ld A,(SCR_MODE) ; check screen mode + 753+ 1827 FE 02 cp $02 ; G2? + 754+ 1829 CA 30 18 jp Z,LDG1 ; yes, back to G1 + 755+ 182C FE 03 cp $03 ; G3? + 756+ 182E 20 11 jr NZ,LDG1ND ; no, so return + 757+ 1830 E5 LDG1: push HL ; store HL + 758+ 1831 D5 push DE ; store DE + 759+ 1832 11 01 00 ld DE,$0001 ; sprites set to defaults, G1 mode + 760+ 1835 F3 di ; disable INTs + 761+ 1836 CD D1 03 call initVDP ; initialize VDP with mode pointed by E + 762+ 1839 FB ei ; re-enable INTs + 763+ 183A 3E 01 ld A,$01 ; activate the... + 764+ 183C 32 9A 55 ld (PRNTVIDEO),A ; ...video buffer... + 765+ 183F D1 pop DE ; retrieve DE + 766+ 1840 E1 pop HL ; retrieve HL + 767+ 1841 F1 LDG1ND: pop AF ; retrieve AF + 768+ 1842 C9 ret ; return to caller + 769+ 1843 + 770+ 1843 + 771+ 1843 2A 71 55 DATSNR: ld HL,(DATLIN) ; Get line of current DATA item + 772+ 1846 22 4B 54 ld (LINEAT),HL ; Save as current line + 773+ 1849 1E 02 SNERR: ld E,SN ; ?SN Error + 774+ 184B 01 defb $01 ; Skip "ld E,DZ" + 775+ 184C 1E 14 DZERR: ld E,DZ ; ?/0 Error + 776+ 184E 01 defb $01 ; Skip "ld E,NF" + 777+ 184F 1E 00 NFERR: ld E,NF ; ?NF Error + 778+ 1851 01 defb $01 ; Skip "ld E,DD" + 779+ 1852 1E 12 DDERR: ld E,DD ; ?DD Error + 780+ 1854 01 defb $01 ; Skip "ld E,UF" + 781+ 1855 1E 22 UFERR: ld E,UF ; ?UF Error + 782+ 1857 01 defb $01 ; Skip "ld E,OV + 783+ 1858 1E 0A OVERR: ld E,OV ; ?OV Error + 784+ 185A 01 defb $01 ; Skip "ld E,TM" + 785+ 185B 1E 18 TMERR: ld E,TM ; ?TM Error + 786+ 185D 01 defb $01 ; Skip next statement + 787+ 185E 1E 34 IMERR: ld E,IM ; ?Illegal indirect mode error + 788+ 1860 01 defb $01 ; Skip next statement + 789+ 1861 1E 36 NRERR: ld E,NR ; ?Device not ready error + 790+ 1863 + 791+ 1863 CD AB 19 ERROR: call CLREG ; Clear registers and stack + 792+ 1866 CD 23 18 call EXITGM ; exit from graphic modes + 793+ 1869 32 41 54 ld (CTLOFG),A ; Enable output (A is 0) + 794+ 186C CD 2D 09 call CURSOR_ON ; enable cursor + 795+ 186F CD 4B 20 call STTLIN ; Start new line + 796+ 1872 21 45 10 ld HL,ERRTBL ; Point to error codes + 797+ 1875 57 ld D,A ; D = 0 (A is 0) + 798+ 1876 3E 3F ld A,'?' + 799+ 1878 CD 52 1B call OUTC ; Output '?' + 800+ 187B 19 add HL,DE ; Offset to correct error code + 801+ 187C 5E ld E,(HL) ; load pointer to error message + 802+ 187D 23 inc HL ; by loading LSB, + 803+ 187E 56 ld D,(HL) ; then MSB + 804+ 187F 62 6B ld HL,DE ; load pointer to HL + 805+ 1881 CD 29 27 call PRS ; Output error message + 806+ 1884 21 BB 17 ld HL,ERRMSG ; "Error" message + 807+ 1887 CD 29 27 ERRIN: call PRS ; Output message + 808+ 188A 2A 4B 54 ld HL,(LINEAT) ; Get line of error + 809+ 188D 11 FE FF ld DE,-2 ; Cold start error if -2 + 810+ 1890 CD 41 1B call CPDEHL ; See if cold start error + 811+ 1893 CA 07 13 jp Z,CSTART ; Cold start error - Restart + 812+ 1896 7C ld A,H ; Was it a direct error? + 813+ 1897 A5 and L ; Line = -1 if direct error + 814+ 1898 3C inc A + 815+ 1899 CA A4 18 jp Z,PTLN ; Yes, jump over + 816+ 189C E5 push HL ; indirect mode - store HL + 817+ 189D 2A 4B 54 ld HL,(LINEAT) ; copy current line number + 818+ 18A0 22 4D 54 ld (HLPLN),HL ; save in HELP line register + 819+ 18A3 E1 pop HL ; retrieve HL + 820+ 18A4 C4 C0 31 PTLN: call NZ,LINEIN ; No - output line of error + 821+ 18A7 + 822+ 18A7 3E defb $3E ; Skip "pop BC" + 823+ 18A8 C1 POPNOK: pop BC ; Drop address in input buffer + 824+ 18A9 + 825+ 18A9 ; run into direct mode: print OK and get command + 826+ 18A9 AF PRNTOK: xor A ; Output "Ok" and get command + 827+ 18AA 32 41 54 ld (CTLOFG),A ; Enable output + 828+ 18AD CD 4B 20 call STTLIN ; Start new line + 829+ 18B0 21 C7 17 ld HL,OKMSG ; "Ok" message + 830+ 18B3 CD 29 27 call PRS ; Output "Ok" + 831+ 18B6 CD 2D 09 GETCMD: call CURSOR_ON ; enable cursor + 832+ 18B9 3A E0 55 ld A,(SERIALS_EN) ; load serial state + 833+ 18BC EE 05 xor %00000101 ; check if serial 1 is open and RX enabled + 834+ 18BE CC AD 01 call Z,A_RTS_ON ; yes, set RTS on + 835+ 18C1 21 FF FF ld HL,-1 ; Flag direct mode + 836+ 18C4 22 4B 54 ld (LINEAT),HL ; Save as current line + 837+ 18C7 CD C9 1A call GETLIN ; Get an input line + 838+ 18CA DA B6 18 jp C,GETCMD ; Get line again if break + 839+ 18CD CD 90 1D call GETCHR ; Get first character + 840+ 18D0 17 rla ; 8th bit is copied into carry and original carry is copied into bit 0) + 841+ 18D1 DA 49 18 jp C,SNERR ; if char >=128 (8th bit set) then raise an error + 842+ 18D4 1F rra ; recover original char and Carry + 843+ 18D5 3C inc A ; Test if end of line + 844+ 18D6 3D dec A ; Without affecting Carry + 845+ 18D7 CA B6 18 jp Z,GETCMD ; Nothing entered - Get another + 846+ 18DA F5 push AF ; Save Carry status + 847+ 18DB 3A E0 55 ld A,(SERIALS_EN) ; load serial state + 848+ 18DE EE 05 xor %00000101 ; check if serial 1 is open and RX enabled + 849+ 18E0 CC 8F 01 call Z,A_RTS_OFF ; yes, set RTS on + 850+ 18E3 CD 42 09 call CURSOR_OFF ; cursor disabled + 851+ 18E6 CD 60 1E call ATOH ; Get line number into DE + 852+ 18E9 D5 push DE ; Save line number + 853+ 18EA CD E0 19 call CRUNCH ; Tokenise rest of line + 854+ 18ED 47 ld B,A ; Length of tokenised line + 855+ 18EE D1 pop DE ; Restore line number + 856+ 18EF F1 pop AF ; Restore Carry + 857+ 18F0 D2 70 1D jp NC,EXCUTE ; No line number - Direct mode + 858+ 18F3 D5 push DE ; Save line number + 859+ 18F4 C5 push BC ; Save length of tokenised line + 860+ 18F5 AF xor A + 861+ 18F6 32 74 55 ld (LSTBIN),A ; Clear last byte input + 862+ 18F9 CD 90 1D call GETCHR ; Get next character + 863+ 18FC B7 or A ; Set flags + 864+ 18FD F5 push AF ; And save them + 865+ 18FE CD 65 19 call SRCHLN ; Search for line number in DE + 866+ 1901 DA 0A 19 jp C,LINFND ; Jump if line found + 867+ 1904 F1 pop AF ; Get status + 868+ 1905 F5 push AF ; And re-save + 869+ 1906 CA 0F 1F jp Z,ULERR ; Nothing after number - Error + 870+ 1909 B7 or A ; Clear Carry + 871+ 190A C5 LINFND: push BC ; Save address of line in prog + 872+ 190B D2 21 19 jp NC,INEWLN ; Line not found - Insert new + 873+ 190E EB ex DE,HL ; Next line address in DE + 874+ 190F 2A E4 55 ld HL,(PROGND) ; End of program + 875+ 1912 1A SFTPRG: ld A,(DE) ; Shift rest of program down + 876+ 1913 02 ld (BC),A + 877+ 1914 03 inc BC ; Next destination + 878+ 1915 13 inc DE ; Next source + 879+ 1916 CD 41 1B call CPDEHL ; All done? + 880+ 1919 C2 12 19 jp NZ,SFTPRG ; More to do + 881+ 191C 60 ld H,B ; HL - New end of program + 882+ 191D 69 ld L,C + 883+ 191E 22 E4 55 ld (PROGND),HL ; Update end of program + 884+ 1921 + 885+ 1921 D1 INEWLN: pop DE ; Get address of line, + 886+ 1922 F1 pop AF ; Get status + 887+ 1923 CA 48 19 jp Z,SETPTR ; No text - Set up pointers + 888+ 1926 2A E4 55 ld HL,(PROGND) ; Get end of program + 889+ 1929 E3 ex (SP),HL ; Get length of input line + 890+ 192A C1 pop BC ; End of program to BC + 891+ 192B 09 add HL,BC ; Find new end + 892+ 192C E5 push HL ; Save new end + 893+ 192D CD F5 17 call MOVUP ; Make space for line + 894+ 1930 E1 pop HL ; Restore new end + 895+ 1931 22 E4 55 ld (PROGND),HL ; Update end of program pointer + 896+ 1934 EB ex DE,HL ; Get line to move up in HL + 897+ 1935 74 ld (HL),H ; Save MSB + 898+ 1936 D1 pop DE ; Get new line number + 899+ 1937 23 inc HL ; Skip pointer + 900+ 1938 23 inc HL + 901+ 1939 73 ld (HL),E ; Save LSB of line number + 902+ 193A 23 inc HL + 903+ 193B 72 ld (HL),D ; Save MSB of line number + 904+ 193C 23 inc HL ; To first byte in line + 905+ 193D 11 D4 54 ld DE,BUFFER ; Copy buffer to program + 906+ 1940 1A MOVBUF: ld A,(DE) ; Get source + 907+ 1941 77 ld (HL),A ; Save destinations + 908+ 1942 23 inc HL ; Next source + 909+ 1943 13 inc DE ; Next destination + 910+ 1944 B7 or A ; Done? + 911+ 1945 C2 40 19 jp NZ,MOVBUF ; No - Repeat + 912+ 1948 CD 91 19 SETPTR: call RUNFST ; Set line pointers + 913+ 194B 23 inc HL ; To LSB of pointer + 914+ 194C EB ex DE,HL ; Address to DE + 915+ 194D 62 PTRLP: ld H,D ; Address to HL + 916+ 194E 6B ld L,E + 917+ 194F 7E ld A,(HL) ; Get LSB of pointer + 918+ 1950 23 inc HL ; To MSB of pointer + 919+ 1951 B6 or (HL) ; Compare with MSB pointer + 920+ 1952 CA B6 18 jp Z,GETCMD ; Get command line if end + 921+ 1955 23 inc HL ; To LSB of line number + 922+ 1956 23 inc HL ; Skip line number + 923+ 1957 23 inc HL ; Point to first byte in line + 924+ 1958 AF xor A ; Looking for 00 byte + 925+ 1959 BE FNDEND: cp (HL) ; Found end of line? + 926+ 195A 23 inc HL ; Move to next byte + 927+ 195B C2 59 19 jp NZ,FNDEND ; No - Keep looking + 928+ 195E EB ex DE,HL ; Next line address to HL + 929+ 195F 73 ld (HL),E ; Save LSB of pointer + 930+ 1960 23 inc HL + 931+ 1961 72 ld (HL),D ; Save MSB of pointer + 932+ 1962 C3 4D 19 jp PTRLP ; Do next line + 933+ 1965 + 934+ 1965 2A D1 54 SRCHLN: ld HL,(BASTXT) ; Start of program text + 935+ 1968 44 SRCHLP: ld B,H ; BC = Address to look at + 936+ 1969 4D ld C,L + 937+ 196A 7E ld A,(HL) ; Get address of next line + 938+ 196B 23 inc HL + 939+ 196C B6 or (HL) ; End of program found? + 940+ 196D 2B dec HL + 941+ 196E C8 ret Z ; Yes - Line not found + 942+ 196F 23 inc HL + 943+ 1970 23 inc HL + 944+ 1971 7E ld A,(HL) ; Get LSB of line number + 945+ 1972 23 inc HL + 946+ 1973 66 ld H,(HL) ; Get MSB of line number + 947+ 1974 6F ld L,A + 948+ 1975 CD 41 1B call CPDEHL ; Compare with line in DE + 949+ 1978 60 ld H,B ; HL = Start of this line + 950+ 1979 69 ld L,C + 951+ 197A 7E ld A,(HL) ; Get LSB of next line address + 952+ 197B 23 inc HL + 953+ 197C 66 ld H,(HL) ; Get MSB of next line address + 954+ 197D 6F ld L,A ; Next line to HL + 955+ 197E 3F ccf + 956+ 197F C8 ret Z ; Lines found - Exit + 957+ 1980 3F ccf + 958+ 1981 D0 ret NC ; Line not found,at line after + 959+ 1982 C3 68 19 jp SRCHLP ; Keep looking + 960+ 1985 + 961+ 1985 C0 NEW: ret NZ ; Return if any more on line + 962+ 1986 2A D1 54 CLRPTR: ld HL,(BASTXT) ; Point to start of program + 963+ 1989 AF xor A ; Set program area to empty + 964+ 198A 77 ld (HL),A ; Save LSB = 00 + 965+ 198B 23 inc HL + 966+ 198C 77 ld (HL),A ; Save MSB = 00 + 967+ 198D 23 inc HL + 968+ 198E 22 E4 55 ld (PROGND),HL ; Set program end + 969+ 1991 + 970+ 1991 2A D1 54 RUNFST: ld HL,(BASTXT) ; Clear all variables + 971+ 1994 2B dec HL + 972+ 1995 + 973+ 1995 22 76 55 INTVAR: ld (BRKLIN),HL ; Initialise RUN variables + 974+ 1998 2A 32 55 ld HL,(LSTRAM) ; Get end of RAM + 975+ 199B 22 6B 55 ld (STRBOT),HL ; Clear string space + 976+ 199E AF xor A + 977+ 199F CD A0 1D call RESTOR ; Reset DATA pointers + 978+ 19A2 2A E4 55 ld HL,(PROGND) ; Get end of program + 979+ 19A5 22 E6 55 ld (VAREND),HL ; Clear variables + 980+ 19A8 22 E8 55 ld (ARREND),HL ; Clear arrays + 981+ 19AB + 982+ 19AB C1 CLREG: pop BC ; Save return address + 983+ 19AC 2A 49 54 ld HL,(STRSPC) ; Get end of working RAM + 984+ 19AF F9 ld SP,HL ; Set stack + 985+ 19B0 21 5B 55 ld HL,TMSTPL ; Temporary string pool + 986+ 19B3 22 59 55 ld (TMSTPT),HL ; Reset temporary string ptr + 987+ 19B6 AF xor A ; A = 00 + 988+ 19B7 6F ld L,A ; HL = 0000 + 989+ 19B8 67 ld H,A + 990+ 19B9 22 7C 55 ld (CONTAD),HL ; No CONTinue + 991+ 19BC 32 73 55 ld (FORFLG),A ; Clear FOR flag + 992+ 19BF 22 EC 55 ld (FNRGNM),HL ; Clear FN argument + 993+ 19C2 E5 push HL ; HL = 0000 + 994+ 19C3 C5 push BC ; Put back return + 995+ 19C4 2A 76 55 DOAGN: ld HL,(BRKLIN) ; Get address of code to RUN + 996+ 19C7 C9 ret ; Return to execution driver + 997+ 19C8 + 998+ 19C8 3E 3F PROMPT: ld A,'?' ; '?' + 999+ 19CA CD 52 1B call OUTC ; Output character +1000+ 19CD 3E 00 ld A,NLLCR ; null char +1001+ 19CF CD 52 1B call OUTC ; Output character +1002+ 19D2 CD 2D 09 call CURSOR_ON ; enable cursor +1003+ 19D5 3A E0 55 ld A,(SERIALS_EN) ; load serial state +1004+ 19D8 EE 05 xor %00000101 ; check if serial 1 is open and RX enabled +1005+ 19DA CC AD 01 call Z,A_RTS_ON ; yes, set RTS on +1006+ 19DD C3 46 54 jp RINPUT ; Get input line +1007+ 19E0 +1008+ 19E0 AF CRUNCH: xor A ; Tokenise line @ HL to BUFFER +1009+ 19E1 32 31 55 ld (DATFLG),A ; Reset literal flag +1010+ 19E4 0E 05 ld C,2+3 ; 2 byte number and 3 nulls +1011+ 19E6 11 D4 54 ld DE,BUFFER ; Start of input buffer +1012+ 19E9 7E CRNCLP: ld A,(HL) ; Get byte +1013+ 19EA FE 20 cp SPC ; Is it a space? +1014+ 19EC CA 68 1A jp Z,MOVDIR ; Yes - Copy direct +1015+ 19EF 47 ld B,A ; Save character +1016+ 19F0 FE 22 cp $22 ; '"' ; Is it a quote? +1017+ 19F2 CA 88 1A jp Z,CPYLIT ; Yes - Copy literal string +1018+ 19F5 B7 or A ; Is it end of buffer? +1019+ 19F6 CA 8F 1A jp Z,ENDBUF ; Yes - End buffer +1020+ 19F9 3A 31 55 ld A,(DATFLG) ; Get data type +1021+ 19FC B7 or A ; Literal? +1022+ 19FD 7E ld A,(HL) ; Get byte to copy +1023+ 19FE C2 68 1A jp NZ,MOVDIR ; Literal - Copy direct +1024+ 1A01 FE 3F cp '?' ; Is it '?' short for PRINT +1025+ 1A03 3E B3 ld A,ZPRINT ; "PRINT" token +1026+ 1A05 CA 68 1A jp Z,MOVDIR ; Yes - replace it +1027+ 1A08 7E ld A,(HL) ; Get byte again +1028+ 1A09 FE 30 cp '0' ; Is it less than '0' +1029+ 1A0B DA 13 1A jp C,FNDWRD ; Yes - Look for reserved words +1030+ 1A0E FE 3C cp $3C ;60; ";"+1 ; Is it "0123456789:;" ? +1031+ 1A10 DA 68 1A jp C,MOVDIR ; Yes - copy it direct +1032+ 1A13 D5 FNDWRD: push DE ; Look for reserved words +1033+ 1A14 11 AC 14 ld DE,WORDS-1 ; Point to table +1034+ 1A17 C5 push BC ; Save count +1035+ 1A18 01 64 1A ld BC,RETNAD ; Where to return to +1036+ 1A1B C5 push BC ; Save return address +1037+ 1A1C 06 7F ld B,ZEND-1 ; First token value -1 +1038+ 1A1E 7E ld A,(HL) ; Get byte +1039+ 1A1F FE 61 cp 'a' ; Less than 'a' ? +1040+ 1A21 DA 2C 1A jp C,SEARCH ; Yes - search for words +1041+ 1A24 FE 7B cp 'z'+1 ; Greater than 'z' ? +1042+ 1A26 D2 2C 1A jp NC,SEARCH ; Yes - search for words +1043+ 1A29 E6 5F and %01011111 ; Force upper case +1044+ 1A2B 77 ld (HL),A ; Replace byte +1045+ 1A2C 4E SEARCH: ld C,(HL) ; Search for a word +1046+ 1A2D EB ex DE,HL +1047+ 1A2E 23 GETNXT: inc HL ; Get next reserved word +1048+ 1A2F B6 or (HL) ; Start of word? +1049+ 1A30 F2 2E 1A jp P,GETNXT ; No - move on +1050+ 1A33 04 inc B ; Increment token value +1051+ 1A34 7E ld A,(HL) ; Get byte from table +1052+ 1A35 E6 7F and %01111111 ; Strip bit 7 +1053+ 1A37 C8 ret Z ; Return if end of list +1054+ 1A38 B9 cp C ; Same character as in buffer? +1055+ 1A39 C2 2E 1A jp NZ,GETNXT ; No - get next word +1056+ 1A3C EB ex DE,HL +1057+ 1A3D E5 push HL ; Save start of word +1058+ 1A3E +1059+ 1A3E 13 NXTBYT: inc DE ; Look through rest of word +1060+ 1A3F 1A ld A,(DE) ; Get byte from table +1061+ 1A40 B7 or A ; End of word ? +1062+ 1A41 FA 60 1A jp M,MATCH ; Yes - Match found +1063+ 1A44 4F ld C,A ; Save it +1064+ 1A45 78 ld A,B ; Get token value +1065+ 1A46 FE 88 cp ZGOTO ; Is it "GOTO" token ? +1066+ 1A48 C2 4F 1A jp NZ,NOSPC ; No - Don't allow spaces +1067+ 1A4B CD 90 1D call GETCHR ; Get next character +1068+ 1A4E 2B dec HL ; Cancel increment from GETCHR +1069+ 1A4F 23 NOSPC: inc HL ; Next byte +1070+ 1A50 7E ld A,(HL) ; Get byte +1071+ 1A51 FE 61 cp 'a' ; Less than 'a' ? +1072+ 1A53 DA 58 1A jp C,NOCHNG ; Yes - don't change +1073+ 1A56 E6 5F and %01011111 ; Make upper case +1074+ 1A58 B9 NOCHNG: cp C ; Same as in buffer ? +1075+ 1A59 CA 3E 1A jp Z,NXTBYT ; Yes - keep testing +1076+ 1A5C E1 pop HL ; Get back start of word +1077+ 1A5D C3 2C 1A jp SEARCH ; Look at next word +1078+ 1A60 +1079+ 1A60 48 MATCH: ld C,B ; Word found - Save token value +1080+ 1A61 F1 pop AF ; Throw away return +1081+ 1A62 EB ex DE,HL +1082+ 1A63 C9 ret ; Return to "RETNAD" +1083+ 1A64 EB RETNAD: ex DE,HL ; Get address in string +1084+ 1A65 79 ld A,C ; Get token value +1085+ 1A66 C1 pop BC ; Restore buffer length +1086+ 1A67 D1 pop DE ; Get destination address +1087+ 1A68 23 MOVDIR: inc HL ; Next source in buffer +1088+ 1A69 12 ld (DE),A ; Put byte in buffer +1089+ 1A6A 13 inc DE ; Move up buffer +1090+ 1A6B 0C inc C ; Increment length of buffer +1091+ 1A6C D6 3A sub ':' ; End of statement? +1092+ 1A6E CA 76 1A jp Z,SETLIT ; Jump if multi-statement line +1093+ 1A71 FE 49 cp ZDATA-$3A ; Is it DATA statement ? +1094+ 1A73 C2 79 1A jp NZ,TSTREM ; No - see if REM +1095+ 1A76 32 31 55 SETLIT: ld (DATFLG),A ; Set literal flag +1096+ 1A79 D6 54 TSTREM: sub ZREM-$3A ; Is it REM? +1097+ 1A7B C2 E9 19 jp NZ,CRNCLP ; No - Leave flag +1098+ 1A7E 47 ld B,A ; Copy rest of buffer +1099+ 1A7F 7E NXTCHR: ld A,(HL) ; Get byte +1100+ 1A80 B7 or A ; End of line ? +1101+ 1A81 CA 8F 1A jp Z,ENDBUF ; Yes - Terminate buffer +1102+ 1A84 B8 cp B ; End of statement ? +1103+ 1A85 CA 68 1A jp Z,MOVDIR ; Yes - Get next one +1104+ 1A88 23 CPYLIT: inc HL ; Move up source string +1105+ 1A89 12 ld (DE),A ; Save in destination +1106+ 1A8A 0C inc C ; Increment length +1107+ 1A8B 13 inc DE ; Move up destination +1108+ 1A8C C3 7F 1A jp NXTCHR ; Repeat +1109+ 1A8F +1110+ 1A8F 21 D3 54 ENDBUF: ld HL,BUFFER-1 ; Point to start of buffer +1111+ 1A92 12 ld (DE),A ; Mark end of buffer (A = 00) +1112+ 1A93 13 inc DE +1113+ 1A94 12 ld (DE),A ; A = 00 +1114+ 1A95 13 inc DE +1115+ 1A96 12 ld (DE),A ; A = 00 +1116+ 1A97 C9 ret +1117+ 1A98 +1118+ 1A98 3A 40 54 DODEL: ld A,(NULFLG) ; Get null flag status +1119+ 1A9B B7 or A ; Is it zero? +1120+ 1A9C 3E 00 ld A,$00 ; Zero A - Leave flags +1121+ 1A9E 32 40 54 ld (NULFLG),A ; Zero null flag +1122+ 1AA1 C2 AC 1A jp NZ,ECHDEL ; Set - Echo it +1123+ 1AA4 05 dec B ; Decrement length +1124+ 1AA5 CA C9 1A jp Z,GETLIN ; Get line again if empty +1125+ 1AA8 CD 52 1B call OUTC ; Output null character +1126+ 1AAB 3E defb $3E ; Skip "dec B" +1127+ 1AAC 05 ECHDEL: dec B ; Count bytes in buffer +1128+ 1AAD 2B dec HL ; Back space buffer +1129+ 1AAE CA C0 1A jp Z,OTKLN ; No buffer - Try again +1130+ 1AB1 7E ld A,(HL) ; Get deleted byte +1131+ 1AB2 CD 52 1B call OUTC ; Echo it +1132+ 1AB5 C3 D2 1A jp MORINP ; Get more input +1133+ 1AB8 +1134+ 1AB8 05 DELCHR: dec B ; Count bytes in buffer +1135+ 1AB9 2B dec HL ; Back space buffer +1136+ 1ABA CD 52 1B call OUTC ; Output character in A +1137+ 1ABD C2 D2 1A jp NZ,MORINP ; Not end - Get more +1138+ 1AC0 CD 52 1B OTKLN: call OUTC ; Output character in A +1139+ 1AC3 CD 5D 20 KILIN: call PRNTCRLF ; Output CRLF +1140+ 1AC6 C3 C9 1A jp TTYLIN ; Get line again +1141+ 1AC9 +1142+ 1AC9 GETLIN: +1143+ 1AC9 21 D4 54 TTYLIN: ld HL,BUFFER ; Get a line by character +1144+ 1ACC 06 01 ld B,$01 ; Set buffer as empty +1145+ 1ACE AF xor A +1146+ 1ACF 32 40 54 ld (NULFLG),A ; Clear null flag +1147+ 1AD2 CD 93 1B MORINP: call CLOTST ; Get character and test ^O +1148+ 1AD5 4F ld C,A ; Save character in C +1149+ 1AD6 FE 7F cp DEL ; Delete character? +1150+ 1AD8 CA 98 1A jp Z,DODEL ; Yes - Process it +1151+ 1ADB 3A 40 54 ld A,(NULFLG) ; Get null flag +1152+ 1ADE B7 or A ; Test null flag status +1153+ 1ADF CA E9 1A jp Z,PROCES ; Reset - Process character +1154+ 1AE2 AF xor A ; Clear A +1155+ 1AE3 32 40 54 ld (NULFLG),A ; Reset null flag +1156+ 1AE6 CD 52 1B call OUTC ; Output null +1157+ 1AE9 79 PROCES: ld A,C ; Get character +1158+ 1AEA FE 07 cp CTRLG ; Bell? +1159+ 1AEC CA 29 1B jp Z,PUTCTL ; Yes - Save it +1160+ 1AEF FE 03 cp CTRLC ; Is it control "C"? +1161+ 1AF1 CC 1E 1B call Z,GMNCR ; Yes - exit from graphic mode & Output CRLF +1162+ 1AF4 37 scf ; Flag break +1163+ 1AF5 C8 ret Z ; Return if control "C" +1164+ 1AF6 FE 0D cp CR ; Is it enter? +1165+ 1AF8 CA 53 20 jp Z,ENDINP ; Yes - Terminate input +1166+ 1AFB FE 15 cp CTRLU ; Is it control "U"? +1167+ 1AFD CA C3 1A jp Z,KILIN ; Yes - Get another line +1168+ 1B00 FE 08 cp BKSP ; Is it backspace? +1169+ 1B02 CA B8 1A jp Z,DELCHR ; Yes - Delete character +1170+ 1B05 FE 12 cp CTRLR ; Is it control "R"? +1171+ 1B07 C2 24 1B jp NZ,PUTBUF ; No - Put in buffer +1172+ 1B0A C5 push BC ; Save buffer length +1173+ 1B0B D5 push DE ; Save DE +1174+ 1B0C E5 push HL ; Save buffer address +1175+ 1B0D 36 00 ld (HL),$00 ; Mark end of buffer +1176+ 1B0F CD 54 41 call OUTNCR ; Output and do CRLF +1177+ 1B12 21 D4 54 ld HL,BUFFER ; Point to buffer start +1178+ 1B15 CD 29 27 call PRS ; Output buffer +1179+ 1B18 E1 pop HL ; Restore buffer address +1180+ 1B19 D1 pop DE ; Restore DE +1181+ 1B1A C1 pop BC ; Restore buffer length +1182+ 1B1B C3 D2 1A jp MORINP ; Get another character +1183+ 1B1E CD 23 18 GMNCR: call EXITGM ; exit from graphic mode +1184+ 1B21 C3 5D 20 jp PRNTCRLF ; output CRLF +1185+ 1B24 +1186+ 1B24 FE 20 PUTBUF: cp SPC ; Is it a control code? +1187+ 1B26 DA D2 1A jp C,MORINP ; Yes - Ignore +1188+ 1B29 78 PUTCTL: ld A,B ; Get number of bytes in buffer +1189+ 1B2A FE 59 cp $58+$01 ; Test for line overflow +1190+ 1B2C 3E 08 ld A,BKSP ; Set a bell +1191+ 1B2E D2 3B 1B jp NC,OUTNBS ; Ring bell if buffer full +1192+ 1B31 79 ld A,C ; Get character +1193+ 1B32 71 ld (HL),C ; Save in buffer +1194+ 1B33 32 74 55 ld (LSTBIN),A ; Save last input byte +1195+ 1B36 23 inc HL ; Move up buffer +1196+ 1B37 04 inc B ; Increment length +1197+ 1B38 C3 D2 1A OUTIT: jp MORINP ; Get another character +1198+ 1B3B +1199+ 1B3B CD 52 1B OUTNBS: call OUTC ; Output bell and back over it +1200+ 1B3E C3 38 1B jp OUTIT ; get more chars +1201+ 1B41 +1202+ 1B41 7C CPDEHL: ld A,H ; Get H +1203+ 1B42 92 sub D ; Compare with D +1204+ 1B43 C0 ret NZ ; Different - Exit +1205+ 1B44 7D ld A,L ; Get L +1206+ 1B45 93 sub E ; Compare with E +1207+ 1B46 C9 ret ; Return status +1208+ 1B47 +1209+ 1B47 7E CHKSYN: ld A,(HL) ; Check syntax of character +1210+ 1B48 E3 ex (SP),HL ; Address of test byte +1211+ 1B49 BE cp (HL) ; Same as in code string? +1212+ 1B4A 23 inc HL ; Return address +1213+ 1B4B E3 ex (SP),HL ; Put it back +1214+ 1B4C CA 90 1D jp Z,GETCHR ; Yes - Get next character +1215+ 1B4F C3 49 18 jp SNERR ; Different - ?SN Error +1216+ 1B52 +1217+ 1B52 F5 OUTC: push AF ; Save character +1218+ 1B53 3A 41 54 ld A,(CTLOFG) ; Get control "O" flag +1219+ 1B56 B7 or A ; Is it set? +1220+ 1B57 C2 5E 27 jp NZ,POPAF ; Yes - don't output +1221+ 1B5A F1 pop AF ; Restore character +1222+ 1B5B C5 push BC ; Save buffer length +1223+ 1B5C F5 push AF ; Save character +1224+ 1B5D FE 20 cp SPC ; Is it a control code? +1225+ 1B5F DA 76 1B jp C,DINPOS ; Yes - Don't inc POS(X) +1226+ 1B62 3A 3E 54 ld A,(LWIDTH) ; Get line width +1227+ 1B65 47 ld B,A ; To B +1228+ 1B66 3A 2E 55 ld A,(CURPOS) ; Get cursor position +1229+ 1B69 04 inc B ; Width 255? +1230+ 1B6A CA 72 1B jp Z,INCLEN ; Yes - No width limit +1231+ 1B6D 05 dec B ; Restore width +1232+ 1B6E B8 cp B ; At end of line? +1233+ 1B6F CC 5D 20 call Z,PRNTCRLF ; Yes - output CRLF +1234+ 1B72 3C INCLEN: inc A ; Move on one character +1235+ 1B73 32 2E 55 ld (CURPOS),A ; Save new position +1236+ 1B76 AF DINPOS: xor A +1237+ 1B77 32 D8 55 ld (KBDNPT),A ; set flag for no char from keyboard +1238+ 1B7A F1 pop AF ; Restore character +1239+ 1B7B C1 pop BC ; Restore buffer length +1240+ 1B7C F5 push AF +1241+ 1B7D CD 85 1B call SND2VID ; send char to video +1242+ 1B80 F1 pop AF +1243+ 1B81 CD 29 41 call MONOUT ; send char to serial if enabled +1244+ 1B84 C9 ret +1245+ 1B85 +1246+ 1B85 ; print char to video if cursor is on +1247+ 1B85 32 9B 55 SND2VID:ld (CHR4VID),A ; store A +1248+ 1B88 3A 9A 55 ld A,(PRNTVIDEO) ; check print-on-video +1249+ 1B8B B7 or A ; is it off? +1250+ 1B8C C8 ret Z ; yes, so return +1251+ 1B8D F3 di ; disable INTs +1252+ 1B8E CD 61 07 call CHAR2VID ; cursor is on, so print char on screen +1253+ 1B91 FB ei ; re-enable INTs +1254+ 1B92 C9 ret ; return to caller +1255+ 1B93 +1256+ 1B93 CD E3 34 CLOTST: call GETINP ; Get input character +1257+ 1B96 FE 0F cp CTRLO ; Is it control "O"? +1258+ 1B98 C0 ret NZ ; No don't flip flag +1259+ 1B99 3A 41 54 ld A,(CTLOFG) ; Get flag +1260+ 1B9C 2F cpl ; Flip it +1261+ 1B9D 32 41 54 ld (CTLOFG),A ; Put it back +1262+ 1BA0 A7 and A ; is output enabled? +1263+ 1BA1 CC 2D 09 call Z,CURSOR_ON ; yes, so cursor on +1264+ 1BA4 3A E0 55 ld A,(SERIALS_EN) ; load serial state +1265+ 1BA7 EE 05 xor %00000101 ; check if serial 1 is open and RX enabled +1266+ 1BA9 CC AD 01 call Z,A_RTS_ON ; yes, set RTS on +1267+ 1BAC AF xor A ; Null character +1268+ 1BAD C9 ret +1269+ 1BAE +1270+ 1BAE ; LIST: list the program stored into memory +1271+ 1BAE C1 LIST: pop BC ; rubbish - not needed (legacy from original call of LIST) +1272+ 1BAF 2B dec HL ; dec 'cos GETCHR INCs +1273+ 1BB0 CD 90 1D call GETCHR ; Get next character +1274+ 1BB3 CA 09 1C jp Z,LSTALL ; list all if nothing follows +1275+ 1BB6 FE C2 cp ZMINUS ; is it '-'? +1276+ 1BB8 20 20 jr NZ,LST01 ; no, look for a line number +1277+ 1BBA 11 00 00 ld DE,$0000 ; yes, set search from 0 +1278+ 1BBD CD AA 1C call SRCHLIN ; find address of line number, getting the following if it doesn't exist +1279+ 1BC0 ED 43 9E 55 ld (TMPBFR1),BC ; store address of starting line +1280+ 1BC4 CD 47 1B call CHKSYN ; skip '-' +1281+ 1BC7 C2 defb ZMINUS +1282+ 1BC8 CD 60 1E call ATOH ; now, look for another number (ASCII number to DE) +1283+ 1BCB CD B0 1C call SRCLN ; find a line, getting the previous if it doesn't exist +1284+ 1BCE ED 43 A0 55 ld (TMPBFR2),BC ; store address of ending line +1285+ 1BD2 ED 4B 9E 55 ld BC,(TMPBFR1) ; retrieve address of starting line +1286+ 1BD6 C5 push BC ; store address of line for later use +1287+ 1BD7 C3 41 1C jp LISTLP ; go listing +1288+ 1BDA CD 60 1E LST01: call ATOH ; get a line number (ASCII number to DE) +1289+ 1BDD ED 53 A4 55 LST01H: ld (TMPBFR4),DE ; store ending line address for later use - N.B.: this is a hook for HELP command +1290+ 1BE1 CD AA 1C call SRCHLIN ; find address of line number, getting the following if it doesn't exist +1291+ 1BE4 ED 43 9E 55 ld (TMPBFR1),BC ; store address of starting line +1292+ 1BE8 ED 43 A0 55 ld (TMPBFR2),BC ; same address for ending line (we'll change it later if needed) +1293+ 1BEC 2B dec HL ; dec 'cos GETCHR INCs +1294+ 1BED CD 90 1D call GETCHR ; Get next character +1295+ 1BF0 CA FC 1B jp Z,LSTNOT ; nothing follows, so ending & starting lines are the same +1296+ 1BF3 FE C2 cp ZMINUS ; is it '-'? +1297+ 1BF5 CA 21 1C jp Z,LST03 ; yes, read ending line +1298+ 1BF8 C5 LST06: push BC ; store address for later use +1299+ 1BF9 C3 41 1C jp LISTLP ; jump to list +1300+ 1BFC ED 5B A4 55 LSTNOT: ld DE,(TMPBFR4) +1301+ 1C00 CD AA 1C call SRCHLIN ; find address of line number, getting the following if it doesn't exist +1302+ 1C03 DA F8 1B jp C,LST06 +1303+ 1C06 C3 A9 18 jp PRNTOK +1304+ 1C09 11 F9 FF LSTALL: ld DE,65529 ; set ending line to max. allowed line number +1305+ 1C0C CD AA 1C call SRCHLIN ; get address of last line +1306+ 1C0F ED 43 A0 55 ld (TMPBFR2),BC ; store it +1307+ 1C13 11 00 00 ld DE,$0000 ; set start to first line in memory +1308+ 1C16 CD AA 1C call SRCHLIN ; get address of first line +1309+ 1C19 ED 43 9E 55 ld (TMPBFR1),BC ; store it +1310+ 1C1D C5 push BC ; store address of starting line for later use +1311+ 1C1E C3 41 1C jp LISTLP ; start printing +1312+ 1C21 CD 47 1B LST03: call CHKSYN ; skip '-' +1313+ 1C24 C2 defb ZMINUS +1314+ 1C25 CD 60 1E call ATOH ; look for another number (return into DE) +1315+ 1C28 7A ld A,D +1316+ 1C29 B3 or E ; is line=0? +1317+ 1C2A 20 09 jr NZ,LST05 ; no, jump over +1318+ 1C2C 11 F9 FF ld DE,65529 ; yes set last valid line number +1319+ 1C2F CD AA 1C call SRCHLIN ; get address of last line +1320+ 1C32 C3 38 1C jp LST02 +1321+ 1C35 CD B0 1C LST05: call SRCLN ; find a line, getting the previous if it doesn't exist +1322+ 1C38 ED 43 A0 55 LST02: ld (TMPBFR2),BC ; store address of ending line +1323+ 1C3C ED 4B 9E 55 ld BC,(TMPBFR1) ; retrieve address of starting line +1324+ 1C40 C5 push BC ; store it for later use +1325+ 1C41 E1 LISTLP: pop HL ; Restore address of line +1326+ 1C42 4E ld C,(HL) ; Get LSB of next line +1327+ 1C43 23 inc HL +1328+ 1C44 46 ld B,(HL) ; Get MSB of next line +1329+ 1C45 23 inc HL +1330+ 1C46 78 ld A,B ; BC = 0 (End of program)? +1331+ 1C47 B1 or C +1332+ 1C48 CA A9 18 jp Z,PRNTOK ; Yes - Go to command mode +1333+ 1C4B CD BB 1D call TSTBRK ; Test for break key +1334+ 1C4E CD BE 1C call TSTSPC ; test for space +1335+ 1C51 C5 push BC ; Save address of next line +1336+ 1C52 3A 93 55 ld A,(SCR_CURS_X) ; load current X pos of cursor +1337+ 1C55 A7 and A ; is it at the beginning of a new line? +1338+ 1C56 20 0B jr NZ,LST08 ; No, jump over +1339+ 1C58 3E 0D ld A,CR ; yes, so just send a CR +1340+ 1C5A CD 29 41 call MONOUT ; to serial if it's open +1341+ 1C5D AF xor A ; then, set cursor +1342+ 1C5E 32 2E 55 ld (CURPOS),A ; to position 0 +1343+ 1C61 18 03 jr LST07 ; and continue +1344+ 1C63 CD 5D 20 LST08: call PRNTCRLF ; output CRLF +1345+ 1C66 5E LST07: ld E,(HL) ; Get LSB of line number +1346+ 1C67 23 inc HL +1347+ 1C68 56 ld D,(HL) ; Get MSB of line number +1348+ 1C69 23 inc HL +1349+ 1C6A E5 push HL ; Save address of line start +1350+ 1C6B EB ex DE,HL ; Line number to HL +1351+ 1C6C CD C8 31 call PRNTHL ; Output line number in decimal +1352+ 1C6F 3E 20 ld A,SPC ; Space after line number +1353+ 1C71 E1 pop HL ; Restore start of line address +1354+ 1C72 CD 52 1B LSTLP2: call OUTC ; Output character in A +1355+ 1C75 7E LSTLP3: ld A,(HL) ; Get next byte in line +1356+ 1C76 B7 or A ; End of line? +1357+ 1C77 23 inc HL ; To next byte in line +1358+ 1C78 CA 9C 1C jp Z,NXTLN ; Yes - check next line +1359+ 1C7B F2 72 1C jp P,LSTLP2 ; No token - output it +1360+ 1C7E D6 7F sub ZEND-1 ; Find and output word +1361+ 1C80 4F ld C,A ; Token offset+1 to C +1362+ 1C81 11 AD 14 ld DE,WORDS ; Reserved word list +1363+ 1C84 1A FNDTOK: ld A,(DE) ; Get character in list +1364+ 1C85 13 inc DE ; Move on to next +1365+ 1C86 B7 or A ; Is it start of word? +1366+ 1C87 F2 84 1C jp P,FNDTOK ; No - Keep looking for word +1367+ 1C8A 0D dec C ; Count words +1368+ 1C8B C2 84 1C jp NZ,FNDTOK ; Not there - keep looking +1369+ 1C8E E6 7F OUTWRD: and %01111111 ; Strip bit 7 +1370+ 1C90 CD 52 1B call OUTC ; Output character +1371+ 1C93 1A ld A,(DE) ; Get next character +1372+ 1C94 13 inc DE ; Move on to next +1373+ 1C95 B7 or A ; Is it end of word? +1374+ 1C96 F2 8E 1C jp P,OUTWRD ; No - output the rest +1375+ 1C99 C3 75 1C jp LSTLP3 ; Next byte in line +1376+ 1C9C D1 NXTLN: pop DE ; recover address of current line +1377+ 1C9D 2A A0 55 ld HL,(TMPBFR2) ; address of last line to print +1378+ 1CA0 CD 5A 41 call CMP16 ; check if current line is over last printable line +1379+ 1CA3 DA A9 18 jp C,PRNTOK ; finish - leave & print OK +1380+ 1CA6 D5 push DE ; store address of current line +1381+ 1CA7 C3 41 1C jp LISTLP ; continue listing +1382+ 1CAA ; look for the address of a program line +1383+ 1CAA E5 SRCHLIN:push HL ; store HL (this is needed because HL store the pointer to the input buffer) +1384+ 1CAB CD 65 19 call SRCHLN ; search for line number in DE +1385+ 1CAE E1 pop HL ; retrieve HL +1386+ 1CAF C9 ret ; return to caller +1387+ 1CB0 ; look for the address of a program line - if the line isn't found, +1388+ 1CB0 ; it look backward for the previous line +1389+ 1CB0 E5 SRCLN: push HL ; store HL +1390+ 1CB1 CD 65 19 SRCLN1: call SRCHLN ; search for line in DE +1391+ 1CB4 DA BC 1C jp C,LVSRLN ; found it, leave loop +1392+ 1CB7 1B dec DE ; not found, decrement number to look backward for an existing line +1393+ 1CB8 7B ld A,E +1394+ 1CB9 B2 or D ; is line number zero? +1395+ 1CBA 20 F5 jr NZ,SRCLN1 ; no, continue +1396+ 1CBC E1 LVSRLN: pop HL ; retrieve HL +1397+ 1CBD C9 ret ; return to caller +1398+ 1CBE +1399+ 1CBE ; during LISTing, check if PAUSE is pressed, then pause listing and +1400+ 1CBE ; wait for another pressing of PAUSE to continue or CTRL-C/BREAK to exit +1401+ 1CBE 3A DA 55 TSTSPC: ld A,(TMPKEYBFR) ; Get input character +1402+ 1CC1 FE 20 cp SPC ; Is it SPACE? +1403+ 1CC3 C0 ret NZ ; No, return +1404+ 1CC4 CD E3 34 WTSPC: call GETINP ; Yes, stop listing and wait for another space or BREAK +1405+ 1CC7 FE 20 cp SPC ; is it SPACE? +1406+ 1CC9 20 05 jr NZ,CNTWTSP ; no, continue +1407+ 1CCB AF xor A +1408+ 1CCC 32 DA 55 ld (TMPKEYBFR),A ; reset key +1409+ 1CCF C9 ret ; return to caller +1410+ 1CD0 FE 03 CNTWTSP:cp CTRLC ; is it CTRL-C/BREAK? +1411+ 1CD2 20 F0 jr NZ,WTSPC ; no, loop +1412+ 1CD4 C3 D9 13 jp BRKRET ; exit and output "Ok" +1413+ 1CD7 +1414+ 1CD7 +1415+ 1CD7 3E 64 FOR: ld A,$64 ; Flag "FOR" assignment +1416+ 1CD9 32 73 55 ld (FORFLG),A ; Save "FOR" flag +1417+ 1CDC CD 50 1F call LET ; Set up initial index +1418+ 1CDF C1 pop BC ; Drop RETurn address +1419+ 1CE0 E5 push HL ; Save code string address +1420+ 1CE1 CD 39 1F call DATA ; Get next statement address +1421+ 1CE4 22 6F 55 ld (LOOPST),HL ; Save it for start of loop +1422+ 1CE7 21 02 00 ld HL,$0002 ; Offset for "FOR" block +1423+ 1CEA 39 add HL,SP ; Point to it +1424+ 1CEB CD D6 17 FORSLP: call LOKFOR ; Look for existing "FOR" block +1425+ 1CEE D1 pop DE ; Get code string address +1426+ 1CEF C2 07 1D jp NZ,FORFND ; No nesting found +1427+ 1CF2 09 add HL,BC ; Move into "FOR" block +1428+ 1CF3 D5 push DE ; Save code string address +1429+ 1CF4 2B dec HL +1430+ 1CF5 56 ld D,(HL) ; Get MSB of loop statement +1431+ 1CF6 2B dec HL +1432+ 1CF7 5E ld E,(HL) ; Get LSB of loop statement +1433+ 1CF8 23 inc HL +1434+ 1CF9 23 inc HL +1435+ 1CFA E5 push HL ; Save block address +1436+ 1CFB 2A 6F 55 ld HL,(LOOPST) ; Get address of loop statement +1437+ 1CFE CD 41 1B call CPDEHL ; Compare the FOR loops +1438+ 1D01 E1 pop HL ; Restore block address +1439+ 1D02 C2 EB 1C jp NZ,FORSLP ; Different FORs - Find another +1440+ 1D05 D1 pop DE ; Restore code string address +1441+ 1D06 F9 ld SP,HL ; Remove all nested loops +1442+ 1D07 +1443+ 1D07 EB FORFND: ex DE,HL ; Code string address to HL +1444+ 1D08 0E 08 ld C,$08 +1445+ 1D0A CD 06 18 call CHKSTK ; Check for 8 levels of stack +1446+ 1D0D E5 push HL ; Save code string address +1447+ 1D0E 2A 6F 55 ld HL,(LOOPST) ; Get first statement of loop +1448+ 1D11 E3 ex (SP),HL ; Save and restore code string +1449+ 1D12 E5 push HL ; Re-save code string address +1450+ 1D13 2A 4B 54 ld HL,(LINEAT) ; Get current line number +1451+ 1D16 E3 ex (SP),HL ; Save and restore code string +1452+ 1D17 CD 24 22 call TSTNUM ; Make sure it's a number +1453+ 1D1A CD 47 1B call CHKSYN ; Make sure "TO" is next +1454+ 1D1D BB defb ZTO ; "TO" token +1455+ 1D1E CD 21 22 call GETNUM ; Get "TO" expression value +1456+ 1D21 E5 push HL ; Save code string address +1457+ 1D22 CD 7A 30 call BCDEFP ; Move "TO" value to BCDE +1458+ 1D25 E1 pop HL ; Restore code string address +1459+ 1D26 C5 push BC ; Save "TO" value in block +1460+ 1D27 D5 push DE +1461+ 1D28 01 00 81 ld BC,$8100 ; BCDE - 1 (default STEP) +1462+ 1D2B 51 ld D,C ; C=0 +1463+ 1D2C 5A ld E,D ; D=0 +1464+ 1D2D 7E ld A,(HL) ; Get next byte in code string +1465+ 1D2E FE C0 cp ZSTEP ; See if "STEP" is stated +1466+ 1D30 3E 01 ld A,$01 ; Sign of step = 1 +1467+ 1D32 C2 43 1D jp NZ,SAVSTP ; No STEP given - Default to 1 +1468+ 1D35 CD 90 1D call GETCHR ; Jump over "STEP" token +1469+ 1D38 CD 21 22 call GETNUM ; Get step value +1470+ 1D3B E5 push HL ; Save code string address +1471+ 1D3C CD 7A 30 call BCDEFP ; Move STEP to BCDE +1472+ 1D3F CD 2E 30 call TSTSGN ; Test sign of FPREG +1473+ 1D42 E1 pop HL ; Restore code string address +1474+ 1D43 C5 SAVSTP: push BC ; Save the STEP value in block +1475+ 1D44 D5 push DE +1476+ 1D45 F5 push AF ; Save sign of STEP +1477+ 1D46 33 inc SP ; Don't save flags +1478+ 1D47 E5 push HL ; Save code string address +1479+ 1D48 2A 76 55 ld HL,(BRKLIN) ; Get address of index variable +1480+ 1D4B E3 ex (SP),HL ; Save and restore code string +1481+ 1D4C 06 81 PUTFID: ld B,ZFOR ; "FOR" block marker +1482+ 1D4E C5 push BC ; Save it +1483+ 1D4F 33 inc SP ; Don't save C +1484+ 1D50 +1485+ 1D50 CD BB 1D RUNCNT: call TSTBRK ; Execution driver - Test break +1486+ 1D53 22 76 55 ld (BRKLIN),HL ; Save code address for break +1487+ 1D56 7E ld A,(HL) ; Get next byte in code string +1488+ 1D57 FE 3A cp ':' ; Multi statement line? +1489+ 1D59 CA 70 1D jp Z,EXCUTE ; Yes - Execute it +1490+ 1D5C B7 or A ; End of line? +1491+ 1D5D C2 49 18 jp NZ,SNERR ; No - Syntax error +1492+ 1D60 23 inc HL ; Point to address of next line +1493+ 1D61 7E ld A,(HL) ; Get LSB of line pointer +1494+ 1D62 23 inc HL +1495+ 1D63 B6 or (HL) ; Is it zero (End of prog)? +1496+ 1D64 CA E2 1D jp Z,ENDPRG ; Yes - Terminate execution +1497+ 1D67 23 inc HL ; Point to line number +1498+ 1D68 5E ld E,(HL) ; Get LSB of line number +1499+ 1D69 23 inc HL +1500+ 1D6A 56 ld D,(HL) ; Get MSB of line number +1501+ 1D6B EB ex DE,HL ; Line number to HL +1502+ 1D6C 22 4B 54 ld (LINEAT),HL ; Save as current line number +1503+ 1D6F EB ex DE,HL ; Line number back to DE +1504+ 1D70 CD 90 1D EXCUTE: call GETCHR ; Get key word +1505+ 1D73 11 50 1D ld DE,RUNCNT ; Where to RETurn to +1506+ 1D76 D5 push DE ; Save for RETurn +1507+ 1D77 C8 IFJMP: ret Z ; Go to RUNCNT if end of STMT +1508+ 1D78 +1509+ 1D78 D6 80 ONJMP: sub ZEND ; Is it a token? +1510+ 1D7A DA 50 1F jp C,LET ; No - try to assign it +1511+ 1D7D FE 3A cp ZNEW+1-ZEND ; END to NEW ? +1512+ 1D7F D2 49 18 jp NC,SNERR ; Not a key word - ?SN Error +1513+ 1D82 07 rlca ; Double it +1514+ 1D83 4F ld C,A ; BC = Offset into table +1515+ 1D84 06 00 ld B,0 +1516+ 1D86 EB ex DE,HL ; Save code string address +1517+ 1D87 21 50 16 ld HL,WORDTB ; Keyword address table +1518+ 1D8A 09 add HL,BC ; Point to routine address +1519+ 1D8B 4E ld C,(HL) ; Get LSB of routine address +1520+ 1D8C 23 inc HL +1521+ 1D8D 46 ld B,(HL) ; Get MSB of routine address +1522+ 1D8E C5 push BC ; Save routine address +1523+ 1D8F EB ex DE,HL ; Restore code string address +1524+ 1D90 +1525+ 1D90 ; get a char from input buffer: exit with NC if character found is +1526+ 1D90 ; not a number; exit with Z if nothing found; char is into A +1527+ 1D90 23 GETCHR: inc HL ; Point to next character +1528+ 1D91 7E ld A,(HL) ; Get next code string byte +1529+ 1D92 FE 3A cp ':' ; Z if ':' +1530+ 1D94 D0 ret NC ; NC if > "9" +1531+ 1D95 FE 20 cp SPC +1532+ 1D97 CA 90 1D jp Z,GETCHR ; Skip over spaces +1533+ 1D9A FE 30 cp '0' +1534+ 1D9C 3F ccf ; NC if < '0' +1535+ 1D9D 3C inc A ; Test for zero - Leave carry +1536+ 1D9E 3D dec A ; Z if Null +1537+ 1D9F C9 ret +1538+ 1DA0 +1539+ 1DA0 EB RESTOR: ex DE,HL ; Save code string address +1540+ 1DA1 2A D1 54 ld HL,(BASTXT) ; Point to start of program +1541+ 1DA4 CA B5 1D jp Z,RESTNL ; Just RESTORE - reset pointer +1542+ 1DA7 EB ex DE,HL ; Restore code string address +1543+ 1DA8 CD 60 1E call ATOH ; Get line number to DE +1544+ 1DAB E5 push HL ; Save code string address +1545+ 1DAC CD 65 19 call SRCHLN ; Search for line number in DE +1546+ 1DAF 60 ld H,B ; HL = Address of line +1547+ 1DB0 69 ld L,C +1548+ 1DB1 D1 pop DE ; Restore code string address +1549+ 1DB2 D2 0F 1F jp NC,ULERR ; ?UL Error if not found +1550+ 1DB5 2B RESTNL: dec HL ; Byte before DATA statement +1551+ 1DB6 22 EA 55 UPDATA: ld (NXTDAT),HL ; Update DATA pointer +1552+ 1DB9 EB ex DE,HL ; Restore code string address +1553+ 1DBA C9 ret +1554+ 1DBB +1555+ 1DBB +1556+ 1DBB ; check if CTRL-C is into input buffer +1557+ 1DBB DF TSTBRK: rst $18 ; Check input status +1558+ 1DBC C8 ret Z ; No key, go back +1559+ 1DBD D7 rst $10 ; Get the key into A +1560+ 1DBE FE 1B cp ESC ; Escape key? +1561+ 1DC0 28 11 jr Z,BRK ; Yes, break +1562+ 1DC2 FE 03 cp CTRLC ; +1563+ 1DC4 28 0D jr Z,BRK ; Yes, break +1564+ 1DC6 FE 13 cp CTRLS ; Stop scrolling? +1565+ 1DC8 C0 ret NZ ; Other key, ignore +1566+ 1DC9 +1567+ 1DC9 +1568+ 1DC9 ; wait for a key while listing +1569+ 1DC9 D7 STALL: rst $10 ; Wait for key +1570+ 1DCA FE 11 cp CTRLQ ; Resume scrolling? +1571+ 1DCC C8 ret Z ; Release the chokehold +1572+ 1DCD FE 03 cp CTRLC ; Second break? +1573+ 1DCF 28 07 jr Z,STOP ; Break during hold exits prog +1574+ 1DD1 18 F6 jr STALL ; Loop until or +1575+ 1DD3 +1576+ 1DD3 3E FF BRK: ld A,$FF ; Set BRKFLG +1577+ 1DD5 32 45 54 ld (BRKFLG),A ; Store it +1578+ 1DD8 +1579+ 1DD8 C0 STOP: ret NZ ; Exit if anything else +1580+ 1DD9 F6 defb $F6 ; Flag "STOP" +1581+ 1DDA C0 PEND: ret NZ ; Exit if anything else +1582+ 1DDB 22 76 55 ld (BRKLIN),HL ; Save point of break +1583+ 1DDE 21 defb $21 ; Skip "OR 11111111B" +1584+ 1DDF F6 FF INPBRK: or %11111111 ; Flag "Break" wanted +1585+ 1DE1 C1 pop BC ; Return not needed and more +1586+ 1DE2 2A 4B 54 ENDPRG: ld HL,(LINEAT) ; Get current line number +1587+ 1DE5 F5 push AF ; Save STOP / END status +1588+ 1DE6 7D ld A,L ; Is it direct break? +1589+ 1DE7 A4 and H +1590+ 1DE8 3C inc A ; Line is -1 if direct break +1591+ 1DE9 CA F5 1D jp Z,NOLIN ; Yes - No line number +1592+ 1DEC 22 7A 55 ld (ERRLIN),HL ; Save line of break +1593+ 1DEF 2A 76 55 ld HL,(BRKLIN) ; Get point of break +1594+ 1DF2 22 7C 55 ld (CONTAD),HL ; Save point to CONTinue +1595+ 1DF5 AF NOLIN: xor A +1596+ 1DF6 32 41 54 ld (CTLOFG),A ; Enable output +1597+ 1DF9 CD 4B 20 call STTLIN ; Start a new line +1598+ 1DFC F1 pop AF ; Restore STOP / END status +1599+ 1DFD 21 CC 17 ld HL,BRKMSG ; "Break" message +1600+ 1E00 C2 06 1E jp NZ,ERRINT ; "in line" wanted? +1601+ 1E03 C3 A9 18 jp PRNTOK ; Go to command mode +1602+ 1E06 CD 23 18 ERRINT: call EXITGM ; exit from graphics mode +1603+ 1E09 C3 87 18 jp ERRIN ; print message +1604+ 1E0C +1605+ 1E0C +1606+ 1E0C ; CONTinue after a break/error +1607+ 1E0C 21 FF FF CONT: ld HL,-1 ; reset... +1608+ 1E0F 22 4D 54 ld (HLPLN),HL ; ...HELP line register +1609+ 1E12 2A 7C 55 ld HL,(CONTAD) ; Get CONTinue address +1610+ 1E15 7C ld A,H ; Is it zero? +1611+ 1E16 B5 or L +1612+ 1E17 1E 20 ld E,CN ; ?CN Error +1613+ 1E19 CA 63 18 jp Z,ERROR ; Yes - output "?CN Error" +1614+ 1E1C EB ex DE,HL ; Save code string address +1615+ 1E1D 2A 7A 55 ld HL,(ERRLIN) ; Get line of last break +1616+ 1E20 22 4B 54 ld (LINEAT),HL ; Set up current line number +1617+ 1E23 EB ex DE,HL ; Restore code string address +1618+ 1E24 C9 ret ; CONTinue where left off +1619+ 1E25 +1620+ 1E25 E5 ACCSUM: push HL ; Save address in array +1621+ 1E26 2A 42 54 ld HL,(CHKSUM) ; Get check sum +1622+ 1E29 06 00 ld B,$00 ; BC - Value of byte +1623+ 1E2B 4F ld C,A +1624+ 1E2C 09 add HL,BC ; Add byte to check sum +1625+ 1E2D 22 42 54 ld (CHKSUM),HL ; Re-save check sum +1626+ 1E30 E1 pop HL ; Restore address in array +1627+ 1E31 C9 ret +1628+ 1E32 +1629+ 1E32 7E CHKLTR: ld A,(HL) ; Get byte +1630+ 1E33 FE 41 cp 'A' ; < 'a' ? +1631+ 1E35 D8 ret C ; Carry set if not letter +1632+ 1E36 FE 5B cp 'Z'+1 ; > 'z' ? +1633+ 1E38 3F ccf +1634+ 1E39 C9 ret ; Carry set if not letter +1635+ 1E3A +1636+ 1E3A CD 90 1D FPSINT: call GETCHR ; Get next character +1637+ 1E3D CD 21 22 POSINT: call GETNUM ; Get integer 0 to 32767 +1638+ 1E40 CD 2E 30 DEPINT: call TSTSGN ; Test sign of FPREG +1639+ 1E43 FA 5B 1E jp M,FCERR ; Negative - ?FC Error +1640+ 1E46 3A F5 55 DEINT: ld A,(FPEXP) ; Get integer value to DE +1641+ 1E49 FE 90 cp $80+$10 ; Exponent in range (16 bits)? +1642+ 1E4B DA D6 30 jp C,FPINT ; Yes - convert it +1643+ 1E4E 01 80 90 ld BC,$9080 ; BCDE = -32768 +1644+ 1E51 11 00 00 ld DE,$0000 +1645+ 1E54 E5 push HL ; Save code string address +1646+ 1E55 CD A9 30 call CMPNUM ; Compare FPREG with BCDE +1647+ 1E58 E1 pop HL ; Restore code string address +1648+ 1E59 51 ld D,C ; MSB to D +1649+ 1E5A C8 ret Z ; Return if in range +1650+ 1E5B 1E 08 FCERR: ld E,FC ; ?FC Error +1651+ 1E5D C3 63 18 jp ERROR ; Output error- +1652+ 1E60 +1653+ 1E60 +1654+ 1E60 ; convert a number in ASCII chars into an integer and store it into DE +1655+ 1E60 2B ATOH: dec HL ; ASCII number to DE binary +1656+ 1E61 11 00 00 GETLN: ld DE,$0000 ; Get number to DE +1657+ 1E64 CD 90 1D GTLNLP: call GETCHR ; Get next character +1658+ 1E67 D0 ret NC ; Exit if not a digit +1659+ 1E68 E5 push HL ; Save code string address +1660+ 1E69 F5 push AF ; Save digit +1661+ 1E6A 21 98 19 ld HL,65529/10 ; Largest number 65529 +1662+ 1E6D CD 41 1B call CPDEHL ; Number in range? +1663+ 1E70 DA 49 18 jp C,SNERR ; No - ?SN Error +1664+ 1E73 62 ld H,D ; HL = Number +1665+ 1E74 6B ld L,E +1666+ 1E75 19 add HL,DE ; Times 2 +1667+ 1E76 29 add HL,HL ; Times 4 +1668+ 1E77 19 add HL,DE ; Times 5 +1669+ 1E78 29 add HL,HL ; Times 10 +1670+ 1E79 F1 pop AF ; Restore digit +1671+ 1E7A D6 30 sub '0' ; Make it 0 to 9 +1672+ 1E7C 5F ld E,A ; DE = Value of digit +1673+ 1E7D 16 00 ld D,0 +1674+ 1E7F 19 add HL,DE ; Add to number +1675+ 1E80 EB ex DE,HL ; Number to DE +1676+ 1E81 E1 pop HL ; Restore code string address +1677+ 1E82 C3 64 1E jp GTLNLP ; Go to next character +1678+ 1E85 +1679+ 1E85 CA 95 19 CLEAR: jp Z,INTVAR ; Just "CLEAR" Keep parameters +1680+ 1E88 CD 21 22 call GETNUM ; Evaluate a number +1681+ 1E8B CD 46 1E call DEINT ; Get integer -32768 to 32767 into DE +1682+ 1E8E 2B dec HL ; Cancel increment +1683+ 1E8F CD 90 1D call GETCHR ; Get next character +1684+ 1E92 E5 push HL ; Save code string address +1685+ 1E93 2A 32 55 ld HL,(LSTRAM) ; Get end of RAM +1686+ 1E96 CA AE 1E jp Z,STORED ; No value given - Use stored +1687+ 1E99 E1 pop HL ; Restore code string address +1688+ 1E9A CD 47 1B call CHKSYN ; Check for comma +1689+ 1E9D 2C defb ',' +1690+ 1E9E D5 push DE ; Save number +1691+ 1E9F CD 21 22 call GETNUM ; Evaluate a number +1692+ 1EA2 CD 46 1E call DEINT ; Get integer -32768 to 32767 into DE +1693+ 1EA5 2B dec HL ; Cancel increment +1694+ 1EA6 CD 90 1D call GETCHR ; Get next character +1695+ 1EA9 C2 49 18 jp NZ,SNERR ; ?SN Error if more on line +1696+ 1EAC E3 ex (SP),HL ; Save code string address +1697+ 1EAD EB ex DE,HL ; Number to DE +1698+ 1EAE 7D STORED: ld A,L ; Get LSB of new RAM top +1699+ 1EAF 93 sub E ; Subtract LSB of string space +1700+ 1EB0 5F ld E,A ; Save LSB +1701+ 1EB1 7C ld A,H ; Get MSB of new RAM top +1702+ 1EB2 9A sbc A,D ; Subtract MSB of string space +1703+ 1EB3 57 ld D,A ; Save MSB +1704+ 1EB4 DA 1E 18 jp C,OMERR ; ?OM Error if not enough mem +1705+ 1EB7 E5 push HL ; Save RAM top +1706+ 1EB8 2A E4 55 ld HL,(PROGND) ; Get program end +1707+ 1EBB 01 28 00 ld BC,$28 ; 40 Bytes minimum working RAM +1708+ 1EBE 09 add HL,BC ; Get lowest address +1709+ 1EBF CD 41 1B call CPDEHL ; Enough memory? +1710+ 1EC2 D2 1E 18 jp NC,OMERR ; No - ?OM Error +1711+ 1EC5 EB ex DE,HL ; RAM top to HL +1712+ 1EC6 22 49 54 ld (STRSPC),HL ; Set new string space +1713+ 1EC9 E1 pop HL ; End of memory to use +1714+ 1ECA 22 32 55 ld (LSTRAM),HL ; Set new top of RAM +1715+ 1ECD E1 pop HL ; Restore code string address +1716+ 1ECE C3 95 19 jp INTVAR ; Initialise variables +1717+ 1ED1 +1718+ 1ED1 E5 RUN: push HL ; store HL +1719+ 1ED2 21 FF FF ld HL,-1 ; reset... +1720+ 1ED5 22 4D 54 ld (HLPLN),HL ; ...HELP line register +1721+ 1ED8 E1 pop HL ; retrieve HL +1722+ 1ED9 CA 91 19 jp Z,RUNFST ; RUN from start if just RUN +1723+ 1EDC CD 95 19 call INTVAR ; Initialise variables +1724+ 1EDF 01 50 1D ld BC,RUNCNT ; Execution driver loop +1725+ 1EE2 C3 F5 1E jp RUNLIN ; RUN from line number +1726+ 1EE5 +1727+ 1EE5 0E 03 GOSUB: ld C,$03 ; 3 Levels of stack needed +1728+ 1EE7 CD 06 18 call CHKSTK ; Check for 3 levels of stack +1729+ 1EEA C1 pop BC ; Get return address +1730+ 1EEB E5 push HL ; Save code string for RETURN +1731+ 1EEC E5 push HL ; And for GOSUB routine +1732+ 1EED 2A 4B 54 ld HL,(LINEAT) ; Get current line +1733+ 1EF0 E3 ex (SP),HL ; Into stack - Code string out +1734+ 1EF1 3E 8C ld A,ZGOSUB ; "GOSUB" token +1735+ 1EF3 F5 push AF ; Save token +1736+ 1EF4 33 inc SP ; Don't save flags +1737+ 1EF5 +1738+ 1EF5 C5 RUNLIN: push BC ; Save return address +1739+ 1EF6 CD 60 1E GOTO: call ATOH ; ASCII number to DE binary +1740+ 1EF9 CD 3B 1F call REM ; Get end of line +1741+ 1EFC E5 push HL ; Save end of line +1742+ 1EFD 2A 4B 54 ld HL,(LINEAT) ; Get current line +1743+ 1F00 CD 41 1B call CPDEHL ; Line after current? +1744+ 1F03 E1 pop HL ; Restore end of line +1745+ 1F04 23 inc HL ; Start of next line +1746+ 1F05 DC 68 19 call C,SRCHLP ; Line is after current line +1747+ 1F08 D4 65 19 call NC,SRCHLN ; Line is before current line +1748+ 1F0B 60 ld H,B ; Set up code string address +1749+ 1F0C 69 ld L,C +1750+ 1F0D 2B dec HL ; Incremented after +1751+ 1F0E D8 ret C ; Line found +1752+ 1F0F 1E 0E ULERR: ld E,UL ; ?UL Error +1753+ 1F11 C3 63 18 jp ERROR ; Output error message +1754+ 1F14 +1755+ 1F14 C0 RETURN: ret NZ ; Return if not just RETURN +1756+ 1F15 16 FF ld D,-1 ; Flag "GOSUB" search +1757+ 1F17 CD D2 17 call BAKSTK ; Look "GOSUB" block +1758+ 1F1A F9 ld SP,HL ; Kill all FORs in subroutine +1759+ 1F1B FE 8C cp ZGOSUB ; Test for "GOSUB" token +1760+ 1F1D 1E 04 ld E,RG ; ?RG Error +1761+ 1F1F C2 63 18 jp NZ,ERROR ; Error if no "GOSUB" found +1762+ 1F22 E1 pop HL ; Get RETURN line number +1763+ 1F23 22 4B 54 ld (LINEAT),HL ; Save as current +1764+ 1F26 23 inc HL ; Was it from direct statement? +1765+ 1F27 7C ld A,H +1766+ 1F28 B5 or L ; Return to line +1767+ 1F29 C2 33 1F jp NZ,RETLIN ; No - Return to line +1768+ 1F2C 3A 74 55 ld A,(LSTBIN) ; Any INPUT in subroutine? +1769+ 1F2F B7 or A ; If so buffer is corrupted +1770+ 1F30 C2 A8 18 jp NZ,POPNOK ; Yes - Go to command mode +1771+ 1F33 21 50 1D RETLIN: ld HL,RUNCNT ; Execution driver loop +1772+ 1F36 E3 ex (SP),HL ; Into stack - Code string out +1773+ 1F37 3E defb $3E ; Skip "pop HL" +1774+ 1F38 E1 NXTDTA: pop HL ; Restore code string address +1775+ 1F39 +1776+ 1F39 01 3A DATA: defb $01,$3A ; ':' End of statement (stands for LD BC,$0E3A - NOP) +1777+ 1F3B 0E 00 REM: ld C,$00 ; 00 End of statement +1778+ 1F3D 06 00 ld B,$00 +1779+ 1F3F 79 NXTSTL: ld A,C ; Statement and byte +1780+ 1F40 48 ld C,B +1781+ 1F41 47 ld B,A ; Statement end byte +1782+ 1F42 7E NXTSTT: ld A,(HL) ; Get byte +1783+ 1F43 B7 or A ; End of line? +1784+ 1F44 C8 ret Z ; Yes - Exit +1785+ 1F45 B8 cp B ; End of statement? +1786+ 1F46 C8 ret Z ; Yes - Exit +1787+ 1F47 23 inc HL ; Next byte +1788+ 1F48 FE 22 cp $22 ; '"' ; Literal string? +1789+ 1F4A CA 3F 1F jp Z,NXTSTL ; Yes - Look for another '"' +1790+ 1F4D C3 42 1F jp NXTSTT ; Keep looking +1791+ 1F50 +1792+ 1F50 CD 30 24 LET: call GETVAR ; Get variable name +1793+ 1F53 CD 47 1B call CHKSYN ; Make sure "=" follows +1794+ 1F56 CC defb ZEQUAL ; "=" token +1795+ 1F57 D5 push DE ; Save address of variable +1796+ 1F58 3A 30 55 ld A,(TYPE) ; Get data type +1797+ 1F5B F5 push AF ; Save type +1798+ 1F5C CD 33 22 call EVAL ; Evaluate expression +1799+ 1F5F F1 pop AF ; Restore type +1800+ 1F60 E3 ex (SP),HL ; Save code - Get var addr +1801+ 1F61 22 76 55 ld (BRKLIN),HL ; Save address of variable +1802+ 1F64 1F rra ; Adjust type +1803+ 1F65 CD 26 22 call CHKTYP ; Check types are the same +1804+ 1F68 CA A3 1F jp Z,LETNUM ; Numeric - Move value +1805+ 1F6B E5 LETSTR: push HL ; Save address of string var +1806+ 1F6C 2A F2 55 ld HL,(FPREG) ; Pointer to string entry +1807+ 1F6F E5 push HL ; Save it on stack +1808+ 1F70 23 inc HL ; Skip over length +1809+ 1F71 23 inc HL +1810+ 1F72 5E ld E,(HL) ; LSB of string address +1811+ 1F73 23 inc HL +1812+ 1F74 56 ld D,(HL) ; MSB of string address +1813+ 1F75 2A D1 54 ld HL,(BASTXT) ; Point to start of program +1814+ 1F78 CD 41 1B call CPDEHL ; Is string before program? +1815+ 1F7B D2 92 1F jp NC,CRESTR ; Yes - Create string entry +1816+ 1F7E 2A 49 54 ld HL,(STRSPC) ; Point to string space +1817+ 1F81 CD 41 1B call CPDEHL ; Is string literal in program? +1818+ 1F84 D1 pop DE ; Restore address of string +1819+ 1F85 D2 9A 1F jp NC,MVSTPT ; Yes - Set up pointer +1820+ 1F88 21 67 55 ld HL,TMPSTR ; Temporary string pool +1821+ 1F8B CD 41 1B call CPDEHL ; Is string in temporary pool? +1822+ 1F8E D2 9A 1F jp NC,MVSTPT ; No - Set up pointer +1823+ 1F91 3E defb $3E ; Skip "pop DE" +1824+ 1F92 D1 CRESTR: pop DE ; Restore address of string +1825+ 1F93 CD 8A 28 call BAKTMP ; Back to last tmp-str entry +1826+ 1F96 EB ex DE,HL ; Address of string entry +1827+ 1F97 CD C3 26 call SAVSTR ; Save string in string area +1828+ 1F9A CD 8A 28 MVSTPT: call BAKTMP ; Back to last tmp-str entry +1829+ 1F9D E1 pop HL ; Get string pointer +1830+ 1F9E CD 89 30 call DETHL4 ; Move string pointer to var +1831+ 1FA1 E1 pop HL ; Restore code string address +1832+ 1FA2 C9 ret +1833+ 1FA3 +1834+ 1FA3 E5 LETNUM: push HL ; Save address of variable +1835+ 1FA4 CD 86 30 call FPTHL ; Move value to variable +1836+ 1FA7 D1 pop DE ; Restore address of variable +1837+ 1FA8 E1 pop HL ; Restore code string address +1838+ 1FA9 C9 ret +1839+ 1FAA +1840+ 1FAA CD A7 2A ON: call GETINT ; Get integer 0-255 +1841+ 1FAD 7E ld A,(HL) ; Get "GOTO" or "GOSUB" token +1842+ 1FAE 47 ld B,A ; Save in B +1843+ 1FAF FE 8C cp ZGOSUB ; "GOSUB" token? +1844+ 1FB1 CA B9 1F jp Z,ONGO ; Yes - Find line number +1845+ 1FB4 CD 47 1B call CHKSYN ; Make sure it's "GOTO" +1846+ 1FB7 88 defb ZGOTO ; "GOTO" token +1847+ 1FB8 2B dec HL ; Cancel increment +1848+ 1FB9 4B ONGO: ld C,E ; Integer of branch value +1849+ 1FBA 0D ONGOLP: dec C ; Count branches +1850+ 1FBB 78 ld A,B ; Get "GOTO" or "GOSUB" token +1851+ 1FBC CA 78 1D jp Z,ONJMP ; Go to that line if right one +1852+ 1FBF CD 61 1E call GETLN ; Get line number to DE +1853+ 1FC2 FE 2C cp ',' ; Another line number? +1854+ 1FC4 C0 ret NZ ; No - Drop through +1855+ 1FC5 C3 BA 1F jp ONGOLP ; Yes - loop +1856+ 1FC8 +1857+ 1FC8 CD 33 22 IF: call EVAL ; Evaluate expression +1858+ 1FCB 7E ld A,(HL) ; Get token +1859+ 1FCC FE 88 cp ZGOTO ; "GOTO" token? +1860+ 1FCE CA D6 1F jp Z,IFGO ; Yes - Get line +1861+ 1FD1 CD 47 1B call CHKSYN ; Make sure it's "THEN" +1862+ 1FD4 BE defb ZTHEN ; "THEN" token +1863+ 1FD5 2B dec HL ; Cancel increment +1864+ 1FD6 CD 24 22 IFGO: call TSTNUM ; Make sure it's numeric +1865+ 1FD9 CD 2E 30 call TSTSGN ; Test state of expression +1866+ 1FDC CA E8 1F jp Z,IF1 ; False - Jump over +1867+ 1FDF CD 90 1D IF0: call GETCHR ; Get next character +1868+ 1FE2 DA F6 1E jp C,GOTO ; Number - GOTO that line +1869+ 1FE5 C3 77 1D jp IFJMP ; Otherwise do statement +1870+ 1FE8 0E B2 IF1: ld C,ZELSE +1871+ 1FEA CD 3D 1F call REM+2 ; check statement +1872+ 1FED B7 or A ; end of line? +1873+ 1FEE C8 ret Z ; yes, leave +1874+ 1FEF FE B2 cp ZELSE +1875+ 1FF1 20 F5 jr NZ,IF1 ; ELSE not found, continue check +1876+ 1FF3 C3 DF 1F jp IF0 ; return to IF +1877+ 1FF6 +1878+ 1FF6 +1879+ 1FF6 2B MRPRNT: dec HL ; dec 'cos GETCHR INCs +1880+ 1FF7 CD 90 1D call GETCHR ; Get next character +1881+ 1FFA CA 5D 20 PRINT: jp Z,PRNTCRLF ; CRLF if just PRINT +1882+ 1FFD C8 PRNTLP: ret Z ; End of list - Exit +1883+ 1FFE FE BA cp ZTAB ; "TAB(" token? +1884+ 2000 CA 85 20 jp Z,DOTAB ; Yes - Do TAB routine +1885+ 2003 FE BD cp ZSPC ; "SPC(" token? +1886+ 2005 CA 85 20 jp Z,DOTAB ; Yes - Do SPC routine +1887+ 2008 E5 push HL ; Save code string address +1888+ 2009 FE 2C cp ',' ; Comma? +1889+ 200B CA 6C 20 jp Z,DOCOM ; Yes - Move to next zone +1890+ 200E FE 3B cp ';' ; Semi-colon? +1891+ 2010 CA A9 20 jp Z,NEXITM ; Do semi-colon routine +1892+ 2013 C1 pop BC ; Code string address to BC +1893+ 2014 CD 33 22 call EVAL ; Evaluate expression +1894+ 2017 E5 push HL ; Save code string address +1895+ 2018 3A 30 55 ld A,(TYPE) ; Get variable type +1896+ 201B B7 or A ; Is it a string variable? +1897+ 201C C2 44 20 jp NZ,PRNTST ; Yes - Output string contents +1898+ 201F CD D3 31 call NUMASC ; Convert number to text +1899+ 2022 CD E7 26 call CRTST ; Create temporary string +1900+ 2025 36 00 ld (HL),NLLCR ; Followed by a NULL char (was SPC, space) +1901+ 2027 2A F2 55 ld HL,(FPREG) ; Get length of output +1902+ 202A 34 inc (HL) ; Plus 1 for the space +1903+ 202B 2A F2 55 ld HL,(FPREG) ; < Not needed > +1904+ 202E 3A 3E 54 ld A,(LWIDTH) ; Get width of line +1905+ 2031 47 ld B,A ; To B +1906+ 2032 04 inc B ; Width 255 (No limit)? +1907+ 2033 CA 40 20 jp Z,PRNTNB ; Yes - Output number string +1908+ 2036 04 inc B ; Adjust it +1909+ 2037 3A 2E 55 ld A,(CURPOS) ; Get cursor position +1910+ 203A 86 add A,(HL) ; Add length of string +1911+ 203B 3D dec A ; Adjust it +1912+ 203C B8 cp B ; Will output fit on this line? +1913+ 203D D4 5D 20 call NC,PRNTCRLF ; No - CRLF first +1914+ 2040 CD 2C 27 PRNTNB: call PRS1 ; Output string at (HL) +1915+ 2043 AF xor A ; Skip call by setting 'z' flag +1916+ 2044 C4 2C 27 PRNTST: call NZ,PRS1 ; Output string at (HL) +1917+ 2047 E1 pop HL ; Restore code string address +1918+ 2048 C3 F6 1F jp MRPRNT ; See if more to PRINT +1919+ 204B +1920+ 204B 3A 2E 55 STTLIN: ld A,(CURPOS) ; Make sure on new line +1921+ 204E B7 or A ; Already at start? +1922+ 204F C8 ret Z ; Yes - Do nothing +1923+ 2050 C3 5D 20 jp PRNTCRLF ; Start a new line +1924+ 2053 +1925+ 2053 AF ENDINP: xor A +1926+ 2054 32 D8 55 ld (KBDNPT),A ; char is not from keyboard +1927+ 2057 77 ld (HL),A ; Mark end of buffer +1928+ 2058 21 D3 54 ld HL,BUFFER-1 ; Point to buffer +1929+ 205B 18 0A jr CNTEND +1930+ 205D 3E 0D PRNTCRLF:ld A,CR ; Load a CR +1931+ 205F CD 52 1B call OUTC ; Output character +1932+ 2062 3E 0A ld A,LF ; Load a LF +1933+ 2064 CD 52 1B call OUTC ; Output character +1934+ 2067 AF CNTEND: xor A ; Set to position 0 +1935+ 2068 32 2E 55 ld (CURPOS),A ; Store it +1936+ 206B C9 ret ; return to caller +1937+ 206C +1938+ 206C 3A 3F 54 DOCOM: ld A,(COMMAN) ; Get comma width +1939+ 206F 47 ld B,A ; Save in B +1940+ 2070 3A 93 55 ld A,(SCR_CURS_X) ; Get current position +1941+ 2073 B8 cp B ; Within the limit? +1942+ 2074 D4 5D 20 call NC,PRNTCRLF ; No - output CRLF +1943+ 2077 D2 A9 20 jp NC,NEXITM ; Get next item +1944+ 207A D6 0A ZONELP: sub $0A ; Next zone of 10 characters +1945+ 207C D2 7A 20 jp NC,ZONELP ; Repeat if more zones +1946+ 207F 2F cpl ; Number of null chars to output +1947+ 2080 0E 00 ld C,NLLCR ; null char +1948+ 2082 C3 9F 20 jp ASPCS ; Output them +1949+ 2085 +1950+ 2085 F5 DOTAB: push AF ; Save token +1951+ 2086 CD A4 2A call FNDNUM ; Evaluate expression +1952+ 2089 CD 47 1B call CHKSYN ; Make sure ")" follows +1953+ 208C 29 defb ')' +1954+ 208D 2B dec HL ; Back space on to ")" +1955+ 208E F1 pop AF ; Restore token +1956+ 208F 0E 00 ld C,NLLCR ; for SPC we use NULL char (was SPACE) +1957+ 2091 D6 BD sub ZSPC ; Was it "SPC(" ? +1958+ 2093 E5 push HL ; Save code string address +1959+ 2094 CA 9A 20 jp Z,DOSPC ; Yes - Do 'E' spaces +1960+ 2097 3A 93 55 ld A,(SCR_CURS_X) ; Get current X position +1961+ 209A 2F DOSPC: cpl ; Number of spaces to print to +1962+ 209B 83 add A,E ; Total number to print +1963+ 209C D2 A9 20 jp NC,NEXITM ; TAB < Current POS(X) +1964+ 209F 3C ASPCS: inc A ; Output A spaces +1965+ 20A0 47 ld B,A ; Save number to print +1966+ 20A1 79 SPCLP: ld A,C ; char to print +1967+ 20A2 CD 52 1B call OUTC ; Output character in A +1968+ 20A5 05 dec B ; Count them +1969+ 20A6 C2 A1 20 jp NZ,SPCLP ; Repeat if more +1970+ 20A9 E1 NEXITM: pop HL ; Restore code string address +1971+ 20AA CD 90 1D call GETCHR ; Get next character +1972+ 20AD C3 FD 1F jp PRNTLP ; More to print +1973+ 20B0 +1974+ 20B0 3F 52 65 64 REDO: defb "?Redo from start",CR,0 +1974+ 20B4 6F 20 66 72 +1974+ 20B8 6F 6D 20 73 +1974+ 20BC 74 61 72 74 +1974+ 20C0 0D 00 +1975+ 20C2 +1976+ 20C2 3A 75 55 BADINP: ld A,(READFG) ; READ or INPUT? +1977+ 20C5 B7 or A +1978+ 20C6 C2 43 18 jp NZ,DATSNR ; READ - ?SN Error +1979+ 20C9 C1 pop BC ; Throw away code string addr +1980+ 20CA 21 B0 20 ld HL,REDO ; "Redo from start" message +1981+ 20CD CD 29 27 call PRS ; Output string +1982+ 20D0 C3 C4 19 jp DOAGN ; Do last INPUT again +1983+ 20D3 +1984+ 20D3 CD 94 26 INPUT: call IDTEST ; Test for illegal direct +1985+ 20D6 7E ld A,(HL) ; Get character after "INPUT" +1986+ 20D7 FE 22 cp $22 ; '"' ; Is there a prompt string? +1987+ 20D9 3E 00 ld A,$00 ; Clear A and leave flags +1988+ 20DB 32 41 54 ld (CTLOFG),A ; Enable output +1989+ 20DE C2 ED 20 jp NZ,NOPMPT ; No prompt - get input +1990+ 20E1 CD E8 26 call QTSTR ; Get string terminated by '"' +1991+ 20E4 CD 47 1B call CHKSYN ; Check for ';' after prompt +1992+ 20E7 3B defb ";" +1993+ 20E8 E5 push HL ; Save code string address +1994+ 20E9 CD 2C 27 call PRS1 ; Output prompt string +1995+ 20EC 3E defb $3E ; Skip "push HL" +1996+ 20ED E5 NOPMPT: push HL ; Save code string address +1997+ 20EE CD C8 19 call PROMPT ; Get input with "? " prompt +1998+ 20F1 C1 pop BC ; Restore code string address +1999+ 20F2 DA DF 1D jp C,INPBRK ; Break pressed - Exit +2000+ 20F5 23 inc HL ; Next byte +2001+ 20F6 7E ld A,(HL) ; Get it +2002+ 20F7 B7 or A ; End of line? +2003+ 20F8 2B dec HL ; Back again +2004+ 20F9 C5 push BC ; Re-save code string address +2005+ 20FA 3A E0 55 ld A,(SERIALS_EN) ; load serial state +2006+ 20FD EE 05 xor %00000101 ; check if serial 1 is open and RX enabled +2007+ 20FF CC 8F 01 call Z,A_RTS_OFF ; yes, set RTS on +2008+ 2102 CD 42 09 call CURSOR_OFF ; disable cursor +2009+ 2105 CA 38 1F jp Z,NXTDTA ; Yes - Find next DATA stmt +2010+ 2108 36 2C ld (HL),',' ; Store comma as separator +2011+ 210A C3 12 21 jp NXTITM ; Get next item +2012+ 210D +2013+ 210D E5 READ: push HL ; Save code string address +2014+ 210E 2A EA 55 ld HL,(NXTDAT) ; Next DATA statement +2015+ 2111 F6 defb $F6 ; Flag "READ" +2016+ 2112 AF NXTITM: xor A ; Flag "INPUT" +2017+ 2113 32 75 55 ld (READFG),A ; Save "READ"/"INPUT" flag +2018+ 2116 E3 ex (SP),HL ; Get code str' , Save pointer +2019+ 2117 C3 1E 21 jp GTVLUS ; Get values +2020+ 211A +2021+ 211A CD 47 1B NEDMOR: call CHKSYN ; Check for comma between items +2022+ 211D 2C defb ',' +2023+ 211E CD 30 24 GTVLUS: call GETVAR ; Get variable name +2024+ 2121 E3 ex (SP),HL ; Save code str" , Get pointer +2025+ 2122 D5 push DE ; Save variable address +2026+ 2123 7E ld A,(HL) ; Get next "INPUT"/"DATA" byte +2027+ 2124 FE 2C cp ',' ; Comma? +2028+ 2126 CA 46 21 jp Z,ANTVLU ; Yes - Get another value +2029+ 2129 3A 75 55 ld A,(READFG) ; Is it READ? +2030+ 212C B7 or A +2031+ 212D C2 B2 21 jp NZ,FDTLP ; Yes - Find next DATA stmt +2032+ 2130 3E 3F ld A,'?' ; More INPUT needed +2033+ 2132 CD 52 1B call OUTC ; Output character +2034+ 2135 CD C8 19 call PROMPT ; Get INPUT with prompt +2035+ 2138 D1 pop DE ; Variable address +2036+ 2139 C1 pop BC ; Code string address +2037+ 213A DA DF 1D jp C,INPBRK ; Break pressed +2038+ 213D 23 inc HL ; Point to next DATA byte +2039+ 213E 7E ld A,(HL) ; Get byte +2040+ 213F B7 or A ; Is it zero (No input) ? +2041+ 2140 2B dec HL ; Back space INPUT pointer +2042+ 2141 C5 push BC ; Save code string address +2043+ 2142 CA 38 1F jp Z,NXTDTA ; Find end of buffer +2044+ 2145 D5 push DE ; Save variable address +2045+ 2146 3A 30 55 ANTVLU: ld A,(TYPE) ; Check data type +2046+ 2149 B7 or A ; Is it numeric? +2047+ 214A CA 70 21 jp Z,INPBIN ; Yes - Convert to binary +2048+ 214D CD 90 1D call GETCHR ; Get next character +2049+ 2150 57 ld D,A ; Save input character +2050+ 2151 47 ld B,A ; Again +2051+ 2152 FE 22 cp $22 ; '"' ; Start of literal sting? +2052+ 2154 CA 64 21 jp Z,STRENT ; Yes - Create string entry +2053+ 2157 3A 75 55 ld A,(READFG) ; "READ" or "INPUT" ? +2054+ 215A B7 or A +2055+ 215B 57 ld D,A ; Save 00 if "INPUT" +2056+ 215C CA 61 21 jp Z,ITMSEP ; "INPUT" - End with 00 +2057+ 215F 16 3A ld D,':' ; "DATA" - End with 00 or ':' +2058+ 2161 06 2C ITMSEP: ld B,',' ; Item separator +2059+ 2163 2B dec HL ; Back space for DTSTR +2060+ 2164 CD EB 26 STRENT: call DTSTR ; Get string terminated by D +2061+ 2167 EB ex DE,HL ; String address to DE +2062+ 2168 21 7B 21 ld HL,LTSTND ; Where to go after LETSTR +2063+ 216B E3 ex (SP),HL ; Save HL , get input pointer +2064+ 216C D5 push DE ; Save address of string +2065+ 216D C3 6B 1F jp LETSTR ; Assign string to variable +2066+ 2170 +2067+ 2170 CD 90 1D INPBIN: call GETCHR ; Get next character +2068+ 2173 CD 35 31 call ASCTFP ; Convert ASCII to FP number +2069+ 2176 E3 ex (SP),HL ; Save input ptr, Get var addr +2070+ 2177 CD 86 30 call FPTHL ; Move FPREG to variable +2071+ 217A E1 pop HL ; Restore input pointer +2072+ 217B 2B LTSTND: dec HL ; dec 'cos GETCHR INCs +2073+ 217C CD 90 1D call GETCHR ; Get next character +2074+ 217F CA 87 21 jp Z,MORDT ; End of line - More needed? +2075+ 2182 FE 2C cp ',' ; Another value? +2076+ 2184 C2 C2 20 jp NZ,BADINP ; No - Bad input +2077+ 2187 E3 MORDT: ex (SP),HL ; Get code string address +2078+ 2188 2B dec HL ; dec 'cos GETCHR INCs +2079+ 2189 CD 90 1D call GETCHR ; Get next character +2080+ 218C C2 1A 21 jp NZ,NEDMOR ; More needed - Get it +2081+ 218F D1 pop DE ; Restore DATA pointer +2082+ 2190 3A 75 55 ld A,(READFG) ; "READ" or "INPUT" ? +2083+ 2193 B7 or A +2084+ 2194 EB ex DE,HL ; DATA pointer to HL +2085+ 2195 C2 B6 1D jp NZ,UPDATA ; Update DATA pointer if "READ" +2086+ 2198 D5 push DE ; Save code string address +2087+ 2199 B6 or (HL) ; More input given? +2088+ 219A 21 A2 21 ld HL,EXTIG ; "?Extra ignored" message +2089+ 219D C4 29 27 call NZ,PRS ; Output string if extra given +2090+ 21A0 E1 pop HL ; Restore code string address +2091+ 21A1 C9 ret +2092+ 21A2 +2093+ 21A2 3F 45 78 74 EXTIG: defb "?Extra ignored",CR,0 +2093+ 21A6 72 61 20 69 +2093+ 21AA 67 6E 6F 72 +2093+ 21AE 65 64 0D 00 +2094+ 21B2 +2095+ 21B2 CD 39 1F FDTLP: call DATA ; Get next statement +2096+ 21B5 B7 or A ; End of line? +2097+ 21B6 C2 CB 21 jp NZ,FANDT ; No - See if DATA statement +2098+ 21B9 23 inc HL +2099+ 21BA 7E ld A,(HL) ; End of program? +2100+ 21BB 23 inc HL +2101+ 21BC B6 or (HL) ; 00 00 Ends program +2102+ 21BD 1E 06 ld E,OD ; ?OD Error +2103+ 21BF CA 63 18 jp Z,ERROR ; Yes - Out of DATA +2104+ 21C2 23 inc HL +2105+ 21C3 5E ld E,(HL) ; LSB of line number +2106+ 21C4 23 inc HL +2107+ 21C5 56 ld D,(HL) ; MSB of line number +2108+ 21C6 EB ex DE,HL +2109+ 21C7 22 71 55 ld (DATLIN),HL ; Set line of current DATA item +2110+ 21CA EB ex DE,HL +2111+ 21CB CD 90 1D FANDT: call GETCHR ; Get next character +2112+ 21CE FE 83 cp ZDATA ; "DATA" token +2113+ 21D0 C2 B2 21 jp NZ,FDTLP ; No "DATA" - Keep looking +2114+ 21D3 C3 46 21 jp ANTVLU ; Found - Convert input +2115+ 21D6 +2116+ 21D6 11 00 00 NEXT: ld DE,$0000 ; In case no index given +2117+ 21D9 C4 30 24 NEXT1: call NZ,GETVAR ; Get index address +2118+ 21DC 22 76 55 ld (BRKLIN),HL ; Save code string address +2119+ 21DF CD D2 17 call BAKSTK ; Look for "FOR" block +2120+ 21E2 C2 4F 18 jp NZ,NFERR ; No "FOR" - ?NF Error +2121+ 21E5 F9 ld SP,HL ; Clear nested loops +2122+ 21E6 D5 push DE ; Save index address +2123+ 21E7 7E ld A,(HL) ; Get sign of STEP +2124+ 21E8 23 inc HL +2125+ 21E9 F5 push AF ; Save sign of STEP +2126+ 21EA D5 push DE ; Save index address +2127+ 21EB CD 6C 30 call PHLTFP ; Move index value to FPREG +2128+ 21EE E3 ex (SP),HL ; Save address of TO value +2129+ 21EF E5 push HL ; Save address of index +2130+ 21F0 CD 88 2D call ADDPHL ; Add STEP to index value +2131+ 21F3 E1 pop HL ; Restore address of index +2132+ 21F4 CD 86 30 call FPTHL ; Move value to index variable +2133+ 21F7 E1 pop HL ; Restore address of TO value +2134+ 21F8 CD 7D 30 call LOADFP ; Move TO value to BCDE +2135+ 21FB E5 push HL ; Save address of line of FOR +2136+ 21FC CD A9 30 call CMPNUM ; Compare index with TO value +2137+ 21FF E1 pop HL ; Restore address of line num +2138+ 2200 C1 pop BC ; Address of sign of STEP +2139+ 2201 90 sub B ; Compare with expected sign +2140+ 2202 CD 7D 30 call LOADFP ; BC = Loop stmt,DE = Line num +2141+ 2205 CA 11 22 jp Z,KILFOR ; Loop finished - Terminate it +2142+ 2208 EB ex DE,HL ; Loop statement line number +2143+ 2209 22 4B 54 ld (LINEAT),HL ; Set loop line number +2144+ 220C 69 ld L,C ; Set code string to loop +2145+ 220D 60 ld H,B +2146+ 220E C3 4C 1D jp PUTFID ; Put back "FOR" and continue +2147+ 2211 +2148+ 2211 F9 KILFOR: ld SP,HL ; Remove "FOR" block +2149+ 2212 2A 76 55 ld HL,(BRKLIN) ; Code string after "NEXT" +2150+ 2215 7E ld A,(HL) ; Get next byte in code string +2151+ 2216 FE 2C cp ',' ; More NEXTs ? +2152+ 2218 C2 50 1D jp NZ,RUNCNT ; No - Do next statement +2153+ 221B CD 90 1D call GETCHR ; Position to index name +2154+ 221E CD D9 21 call NEXT1 ; Re-enter NEXT routine +2155+ 2221 ; < will not RETurn to here , Exit to RUNCNT or Loop > +2156+ 2221 +2157+ 2221 CD 33 22 GETNUM: call EVAL ; Get a numeric expression +2158+ 2224 F6 TSTNUM: defb $F6 ; Clear carry (numeric) +2159+ 2225 37 TSTSTR: scf ; Set carry (string) +2160+ 2226 3A 30 55 CHKTYP: ld A,(TYPE) ; Check types match +2161+ 2229 8F adc A,A ; Expected + actual +2162+ 222A B7 or A ; Clear carry , set parity +2163+ 222B E8 ret PE ; Even parity - Types match +2164+ 222C C3 5B 18 jp TMERR ; Different types - Error +2165+ 222F +2166+ 222F CD 47 1B OPNPAR: call CHKSYN ; Make sure "(" follows +2167+ 2232 28 defb '(' +2168+ 2233 2B EVAL: dec HL ; Evaluate expression & save +2169+ 2234 16 00 ld D,$00 ; Precedence value +2170+ 2236 D5 EVAL1: push DE ; Save precedence +2171+ 2237 0E 01 ld C,$01 +2172+ 2239 CD 06 18 call CHKSTK ; Check for 1 level of stack +2173+ 223C CD AA 22 call OPRND ; Get next expression value +2174+ 223F 22 78 55 EVAL2: ld (NXTOPR),HL ; Save address of next operator +2175+ 2242 2A 78 55 EVAL3: ld HL,(NXTOPR) ; Restore address of next opr +2176+ 2245 C1 pop BC ; Precedence value and operator +2177+ 2246 78 ld A,B ; Get precedence value +2178+ 2247 FE 78 cp $78 ; "AND", "OR", or "XOR" ? +2179+ 2249 D4 24 22 call NC,TSTNUM ; No - Make sure it's a number +2180+ 224C 7E ld A,(HL) ; Get next operator / function +2181+ 224D 16 00 ld D,$00 ; Clear Last relation +2182+ 224F D6 CB RLTLP: sub ZGTR ; ">" Token +2183+ 2251 DA 6B 22 jp C,FOPRND ; + - * / ^ AND OR XOR - Test it +2184+ 2254 FE 03 cp ZLTH+1-ZGTR ; < = > +2185+ 2256 D2 6B 22 jp NC,FOPRND ; Function - Call it +2186+ 2259 FE 01 cp ZEQUAL-ZGTR ; "=" +2187+ 225B 17 rla ; <- Test for legal +2188+ 225C AA xor D ; <- combinations of < = > +2189+ 225D BA cp D ; <- by combining last token +2190+ 225E 57 ld D,A ; <- with current one +2191+ 225F DA 49 18 jp C,SNERR ; Error if "<<' '==" or ">>" +2192+ 2262 22 6D 55 ld (CUROPR),HL ; Save address of current token +2193+ 2265 CD 90 1D call GETCHR ; Get next character +2194+ 2268 C3 4F 22 jp RLTLP ; Treat the two as one +2195+ 226B +2196+ 226B 7A FOPRND: ld A,D ; < = > found ? +2197+ 226C B7 or A +2198+ 226D C2 AB 23 jp NZ,TSTRED ; Yes - Test for reduction +2199+ 2270 7E ld A,(HL) ; Get operator token +2200+ 2271 22 6D 55 ld (CUROPR),HL ; Save operator address +2201+ 2274 D6 C1 sub ZPLUS ; Operator or function? +2202+ 2276 D8 ret C ; Neither - Exit +2203+ 2277 FE 0A cp ZOR+1-ZPLUS ; Is it + - * / ^ AND XOR OR ? +2204+ 2279 D0 ret NC ; No - Exit +2205+ 227A 5F ld E,A ; Coded operator +2206+ 227B 3A 30 55 ld A,(TYPE) ; Get data type +2207+ 227E 3D dec A ; FF = numeric , 00 = string +2208+ 227F B3 or E ; Combine with coded operator +2209+ 2280 7B ld A,E ; Get coded operator +2210+ 2281 CA 1F 28 jp Z,CONCAT ; String concatenation +2211+ 2284 07 rlca ; Times 2 +2212+ 2285 83 add A,E ; Times 3 +2213+ 2286 5F ld E,A ; To DE (D is 0) +2214+ 2287 21 C4 16 ld HL,PRITAB ; Precedence table +2215+ 228A 19 add HL,DE ; To the operator concerned +2216+ 228B 78 ld A,B ; Last operator precedence +2217+ 228C 56 ld D,(HL) ; Get evaluation precedence +2218+ 228D BA cp D ; Compare with eval precedence +2219+ 228E D0 ret NC ; Exit if higher precedence +2220+ 228F 23 inc HL ; Point to routine address +2221+ 2290 CD 24 22 call TSTNUM ; Make sure it's a number +2222+ 2293 +2223+ 2293 C5 STKTHS: push BC ; Save last precedence & token +2224+ 2294 01 42 22 ld BC,EVAL3 ; Where to go on prec' break +2225+ 2297 C5 push BC ; Save on stack for return +2226+ 2298 43 ld B,E ; Save operator +2227+ 2299 4A ld C,D ; Save precedence +2228+ 229A CD 5F 30 call STAKFP ; Move value to stack +2229+ 229D 58 ld E,B ; Restore operator +2230+ 229E 51 ld D,C ; Restore precedence +2231+ 229F 4E ld C,(HL) ; Get LSB of routine address +2232+ 22A0 23 inc HL +2233+ 22A1 46 ld B,(HL) ; Get MSB of routine address +2234+ 22A2 23 inc HL +2235+ 22A3 C5 push BC ; Save routine address +2236+ 22A4 2A 6D 55 ld HL,(CUROPR) ; Address of current operator +2237+ 22A7 C3 36 22 jp EVAL1 ; Loop until prec' break +2238+ 22AA +2239+ 22AA AF OPRND: xor A ; Get operand routine +2240+ 22AB 32 30 55 ld (TYPE),A ; Set numeric expected +2241+ 22AE CD 90 1D call GETCHR ; Get next character +2242+ 22B1 1E 24 ld E,MO ; ?MO Error +2243+ 22B3 CA 63 18 jp Z,ERROR ; No operand - Error +2244+ 22B6 DA 35 31 jp C,ASCTFP ; Number - Get value +2245+ 22B9 CD 32 1E call CHKLTR ; See if a letter +2246+ 22BC D2 11 23 jp NC,CONVAR ; Letter - Find variable +2247+ 22BF FE 26 cp '&' ; &H = HEX, &B = BINARY +2248+ 22C1 20 12 jr NZ,NOTAMP +2249+ 22C3 CD 90 1D call GETCHR ; Get next character +2250+ 22C6 FE 48 cp 'H' ; Hex number indicated? [function added] +2251+ 22C8 CA 89 40 jp Z,HEXTFP ; Convert Hex to FPREG +2252+ 22CB FE 42 cp 'B' ; Binary number indicated? [function added] +2253+ 22CD CA F9 40 jp Z,BINTFP ; Convert Bin to FPREG +2254+ 22D0 1E 02 ld E,SN ; If neither then a ?SN Error +2255+ 22D2 CA 63 18 jp Z,ERROR ; +2256+ 22D5 FE C1 NOTAMP: cp ZPLUS ; '+' Token ? +2257+ 22D7 CA AA 22 jp Z,OPRND ; Yes - Look for operand +2258+ 22DA FE 2E cp '.' ; '.' ? +2259+ 22DC CA 35 31 jp Z,ASCTFP ; Yes - Create FP number +2260+ 22DF FE C2 cp ZMINUS ; '-' Token ? +2261+ 22E1 CA 00 23 jp Z,MINUS ; Yes - Do minus +2262+ 22E4 FE 22 cp $22 ; '"' ; Literal string ? +2263+ 22E6 CA E8 26 jp Z,QTSTR ; Get string terminated by '"' +2264+ 22E9 FE BF cp ZNOT ; "NOT" Token ? +2265+ 22EB CA 0B 24 jp Z,EVNOT ; Yes - Eval NOT expression +2266+ 22EE FE BC cp ZFN ; "FN" Token ? +2267+ 22F0 CA 4C 26 jp Z,DOFN ; Yes - Do FN routine +2268+ 22F3 D6 CE sub ZSGN ; Is it a function? +2269+ 22F5 D2 22 23 jp NC,FNOFST ; Yes - Evaluate function +2270+ 22F8 CD 2F 22 EVLPAR: call OPNPAR ; Evaluate expression in "()" +2271+ 22FB CD 47 1B call CHKSYN ; Make sure ")" follows +2272+ 22FE 29 defb ')' +2273+ 22FF C9 ret +2274+ 2300 +2275+ 2300 16 7D MINUS: ld D,$7D ; '-' precedence +2276+ 2302 CD 36 22 call EVAL1 ; Evaluate until prec' break +2277+ 2305 2A 78 55 ld HL,(NXTOPR) ; Get next operator address +2278+ 2308 E5 push HL ; Save next operator address +2279+ 2309 CD 57 30 call INVSGN ; Negate value +2280+ 230C CD 24 22 RETNUM: call TSTNUM ; Make sure it's a number +2281+ 230F E1 pop HL ; Restore next operator address +2282+ 2310 C9 ret +2283+ 2311 +2284+ 2311 CD 30 24 CONVAR: call GETVAR ; Get variable address to DE +2285+ 2314 E5 FRMEVL: push HL ; Save code string address +2286+ 2315 EB ex DE,HL ; Variable address to HL +2287+ 2316 22 F2 55 ld (FPREG),HL ; Save address of variable +2288+ 2319 3A 30 55 ld A,(TYPE) ; Get type +2289+ 231C B7 or A ; Numeric? +2290+ 231D CC 6C 30 call Z,PHLTFP ; Yes - Move contents to FPREG +2291+ 2320 E1 pop HL ; Restore code string address +2292+ 2321 C9 ret +2293+ 2322 +2294+ 2322 06 00 FNOFST: ld B,$00 ; Get address of function +2295+ 2324 07 rlca ; Double function offset +2296+ 2325 4F ld C,A ; BC = Offset in function table +2297+ 2326 C5 push BC ; Save adjusted token value +2298+ 2327 CD 90 1D call GETCHR ; Get next character +2299+ 232A 79 ld A,C ; Get adjusted token value +2300+ 232B FE 2C cp 2*(ZPOINT-ZSGN) ; "POINT" token? +2301+ 232D CA 4D 38 jp Z,POINT ; Yes, do "POINT" +2302+ 2330 FE 2E cp 2*(ZINSTR-ZSGN) ; "INSTR" token? +2303+ 2332 CA FB 28 jp Z,INSTR ; Yes, do "INSTR" +2304+ 2335 FE 41 cp 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? +2305+ 2337 DA 53 23 jp C,FNVAL ; No - Do function +2306+ 233A CD 2F 22 call OPNPAR ; Evaluate expression (X,... +2307+ 233D CD 47 1B call CHKSYN ; Make sure ',' follows +2308+ 2340 2C defb ',' +2309+ 2341 CD 25 22 call TSTSTR ; Make sure it's a string +2310+ 2344 EB ex DE,HL ; Save code string address +2311+ 2345 2A F2 55 ld HL,(FPREG) ; Get address of string +2312+ 2348 E3 ex (SP),HL ; Save address of string +2313+ 2349 E5 push HL ; Save adjusted token value +2314+ 234A EB ex DE,HL ; Restore code string address +2315+ 234B CD A7 2A call GETINT ; Get integer 0-255 +2316+ 234E EB ex DE,HL ; Save code string address +2317+ 234F E3 ex (SP),HL ; Save integer,HL = adj' token +2318+ 2350 C3 5B 23 jp GOFUNC ; Jump to string function +2319+ 2353 +2320+ 2353 CD F8 22 FNVAL: call EVLPAR ; Evaluate expression +2321+ 2356 E3 ex (SP),HL ; HL = Adjusted token value +2322+ 2357 11 0C 23 ld DE,RETNUM ; Return number from function +2323+ 235A D5 push DE ; Save on stack +2324+ 235B 01 65 14 GOFUNC: ld BC,FNCTAB ; Function routine addresses +2325+ 235E 09 add HL,BC ; Point to right address +2326+ 235F 4E ld C,(HL) ; Get LSB of address +2327+ 2360 23 inc HL ; +2328+ 2361 66 ld H,(HL) ; Get MSB of address +2329+ 2362 69 ld L,C ; Address to HL +2330+ 2363 E9 jp (HL) ; Jump to function +2331+ 2364 +2332+ 2364 15 SGNEXP: dec D ; Dee to flag negative exponent +2333+ 2365 FE C2 cp ZMINUS ; '-' token ? +2334+ 2367 C8 ret Z ; Yes - Return +2335+ 2368 FE 2D cp '-' ; '-' ASCII ? +2336+ 236A C8 ret Z ; Yes - Return +2337+ 236B 14 inc D ; Inc to flag positive exponent +2338+ 236C FE 2B cp '+' ; '+' ASCII ? +2339+ 236E C8 ret Z ; Yes - Return +2340+ 236F FE C1 cp ZPLUS ; '+' token ? +2341+ 2371 C8 ret Z ; Yes - Return +2342+ 2372 2B dec HL ; dec 'cos GETCHR INCs +2343+ 2373 C9 ret ; Return "NZ" +2344+ 2374 +2345+ 2374 ; execute OR, AND, and XOR operations +2346+ 2374 AF PAND: xor A ; for AND, Z=1 +2347+ 2375 18 07 jr CNTLGC +2348+ 2377 AF POR: xor A ; for OR, Z=0, S=1 +2349+ 2378 D6 01 sub $01 +2350+ 237A 18 02 jr CNTLGC +2351+ 237C AF PXOR: xor A ; for XOR, Z=0, S=0 +2352+ 237D 3C inc A +2353+ 237E F5 CNTLGC: push AF ; store operand's flags +2354+ 237F CD 24 22 call TSTNUM ; Make sure it's a number +2355+ 2382 CD 46 1E call DEINT ; Get integer -32768 to 32767 +2356+ 2385 F1 pop AF ; retrieve operand's flags +2357+ 2386 EB ex DE,HL ; <- Get last +2358+ 2387 C1 pop BC ; <- value +2359+ 2388 E3 ex (SP),HL ; <- from +2360+ 2389 EB ex DE,HL ; <- stack +2361+ 238A CD 6F 30 call FPBCDE ; Move last value to FPREG +2362+ 238D F5 push AF ; store operand's flags +2363+ 238E CD 46 1E call DEINT ; Get integer -32768 to 32767 +2364+ 2391 F1 pop AF ; retrieve operand's flags +2365+ 2392 C1 pop BC ; Get value +2366+ 2393 79 ld A,C ; Get LSB +2367+ 2394 21 0A 26 ld HL,ACPASS ; Address of save AC as current +2368+ 2397 20 05 jr NZ,POR1 ; if X/OR, jump over +2369+ 2399 A3 PAND1: and E ; "AND" LSBs +2370+ 239A 4F ld C,A ; Save LSB +2371+ 239B 78 ld A,B ; Get MSB +2372+ 239C A2 and D ; "AND" MSBs +2373+ 239D E9 jp (HL) ; Save AC as current (ACPASS) +2374+ 239E F2 A6 23 POR1: jp P,PXOR1 ; if S=0, jump to XOR +2375+ 23A1 B3 or E ; "OR" LSBs +2376+ 23A2 4F ld C,A ; Save LSB +2377+ 23A3 78 ld A,B ; Get MSB +2378+ 23A4 B2 or D ; "OR" MSBs +2379+ 23A5 E9 jp (HL) ; Save AC as current (ACPASS) +2380+ 23A6 AB PXOR1: xor E ; "XOR" LSBs +2381+ 23A7 4F ld C,A ; Save LSB +2382+ 23A8 78 ld A,B ; Get MSB +2383+ 23A9 AA xor D ; "XOR" MSBs +2384+ 23AA E9 jp (HL) ; Save AC as current (ACPASS) +2385+ 23AB +2386+ 23AB 21 BD 23 TSTRED: ld HL,CMPLOG ; Logical compare routine +2387+ 23AE 3A 30 55 ld A,(TYPE) ; Get data type +2388+ 23B1 1F rra ; Carry set = string +2389+ 23B2 7A ld A,D ; Get last precedence value +2390+ 23B3 17 rla ; Times 2 plus carry +2391+ 23B4 5F ld E,A ; To E +2392+ 23B5 16 64 ld D,$64 ; Relational precedence +2393+ 23B7 78 ld A,B ; Get current precedence +2394+ 23B8 BA cp D ; Compare with last +2395+ 23B9 D0 ret NC ; Eval if last was rel' or log' +2396+ 23BA C3 93 22 jp STKTHS ; Stack this one and get next +2397+ 23BD +2398+ 23BD BF 23 CMPLOG: defw CMPLG1 ; Compare two values / strings +2399+ 23BF 79 CMPLG1: ld A,C ; Get data type +2400+ 23C0 B7 or A +2401+ 23C1 1F rra +2402+ 23C2 C1 pop BC ; Get last expression to BCDE +2403+ 23C3 D1 pop DE +2404+ 23C4 F5 push AF ; Save status +2405+ 23C5 CD 26 22 call CHKTYP ; Check that types match +2406+ 23C8 21 01 24 ld HL,CMPRES ; Result to comparison +2407+ 23CB E5 push HL ; Save for RETurn +2408+ 23CC CA A9 30 jp Z,CMPNUM ; Compare values if numeric +2409+ 23CF AF xor A ; Compare two strings +2410+ 23D0 32 30 55 ld (TYPE),A ; Set type to numeric +2411+ 23D3 D5 push DE ; Save string name +2412+ 23D4 CD 6C 28 call GSTRCU ; Get current string +2413+ 23D7 7E ld A,(HL) ; Get length of string +2414+ 23D8 23 inc HL +2415+ 23D9 23 inc HL +2416+ 23DA 4E ld C,(HL) ; Get LSB of address +2417+ 23DB 23 inc HL +2418+ 23DC 46 ld B,(HL) ; Get MSB of address +2419+ 23DD D1 pop DE ; Restore string name +2420+ 23DE C5 push BC ; Save address of string +2421+ 23DF F5 push AF ; Save length of string +2422+ 23E0 CD 70 28 call GSTRDE ; Get second string +2423+ 23E3 CD 7D 30 call LOADFP ; Get address of second string +2424+ 23E6 F1 pop AF ; Restore length of string 1 +2425+ 23E7 57 ld D,A ; Length to D +2426+ 23E8 E1 pop HL ; Restore address of string 1 +2427+ 23E9 7B CMPSTR: ld A,E ; Bytes of string 2 to do +2428+ 23EA B2 or D ; Bytes of string 1 to do +2429+ 23EB C8 ret Z ; Exit if all bytes compared +2430+ 23EC 7A ld A,D ; Get bytes of string 1 to do +2431+ 23ED D6 01 sub $01 +2432+ 23EF D8 ret C ; Exit if end of string 1 +2433+ 23F0 AF xor A +2434+ 23F1 BB cp E ; Bytes of string 2 to do +2435+ 23F2 3C inc A +2436+ 23F3 D0 ret NC ; Exit if end of string 2 +2437+ 23F4 15 dec D ; Count bytes in string 1 +2438+ 23F5 1D dec E ; Count bytes in string 2 +2439+ 23F6 0A ld A,(BC) ; Byte in string 2 +2440+ 23F7 BE cp (HL) ; Compare to byte in string 1 +2441+ 23F8 23 inc HL ; Move up string 1 +2442+ 23F9 03 inc BC ; Move up string 2 +2443+ 23FA CA E9 23 jp Z,CMPSTR ; Same - Try next bytes +2444+ 23FD 3F ccf ; Flag difference (">" or "<") +2445+ 23FE C3 39 30 jp FLGDIF ; "<" gives -1 , ">" gives +1 +2446+ 2401 +2447+ 2401 3C CMPRES: inc A ; Increment current value +2448+ 2402 8F adc A,A ; Double plus carry +2449+ 2403 C1 pop BC ; Get other value +2450+ 2404 A0 and B ; Combine them +2451+ 2405 C6 FF add A,-1 ; Carry set if different +2452+ 2407 9F sbc A,A ; 00 - Equal , FF - Different +2453+ 2408 C3 40 30 jp FLGREL ; Set current value & continue +2454+ 240B +2455+ 240B 16 5A EVNOT: ld D,$5A ; Precedence value for "NOT" +2456+ 240D CD 36 22 call EVAL1 ; Eval until precedence break +2457+ 2410 CD 24 22 call TSTNUM ; Make sure it's a number +2458+ 2413 CD 46 1E call DEINT ; Get integer -32768 - 32767 +2459+ 2416 7B ld A,E ; Get LSB +2460+ 2417 2F cpl ; Invert LSB +2461+ 2418 4F ld C,A ; Save "NOT" of LSB +2462+ 2419 7A ld A,D ; Get MSB +2463+ 241A 2F cpl ; Invert MSB +2464+ 241B CD 0A 26 call ACPASS ; Save AC as current +2465+ 241E C1 pop BC ; Clean up stack +2466+ 241F C3 42 22 jp EVAL3 ; Continue evaluation +2467+ 2422 +2468+ 2422 2B DIMRET: dec HL ; dec 'cos GETCHR INCs +2469+ 2423 CD 90 1D call GETCHR ; Get next character +2470+ 2426 C8 ret Z ; End of DIM statement +2471+ 2427 CD 47 1B call CHKSYN ; Make sure ',' follows +2472+ 242A 2C defb ',' +2473+ 242B 01 22 24 DIM: ld BC,DIMRET ; Return to "DIMRET" +2474+ 242E C5 push BC ; Save on stack +2475+ 242F F6 defb $F6 ; Flag "Create" variable +2476+ 2430 AF GETVAR: xor A ; Find variable address,to DE +2477+ 2431 32 2F 55 ld (LCRFLG),A ; Set locate / create flag +2478+ 2434 46 ld B,(HL) ; Get First byte of name +2479+ 2435 CD 32 1E GTFNAM: call CHKLTR ; See if a letter +2480+ 2438 DA 49 18 jp C,SNERR ; ?SN Error if not a letter +2481+ 243B AF xor A +2482+ 243C 4F ld C,A ; Clear second byte of name +2483+ 243D 32 30 55 ld (TYPE),A ; Set type to numeric +2484+ 2440 CD 90 1D call GETCHR ; Get next character +2485+ 2443 DA 4C 24 jp C,SVNAM2 ; Numeric - Save in name +2486+ 2446 CD 32 1E call CHKLTR ; See if a letter +2487+ 2449 DA 59 24 jp C,CHARTY ; Not a letter - Check type +2488+ 244C 4F SVNAM2: ld C,A ; Save second byte of name +2489+ 244D CD 90 1D ENDNAM: call GETCHR ; Get next character +2490+ 2450 DA 4D 24 jp C,ENDNAM ; Numeric - Get another +2491+ 2453 CD 32 1E call CHKLTR ; See if a letter +2492+ 2456 D2 4D 24 jp NC,ENDNAM ; Letter - Get another +2493+ 2459 D6 24 CHARTY: sub '$' ; String variable? +2494+ 245B C2 68 24 jp NZ,NOTSTR ; No - Numeric variable +2495+ 245E 3C inc A ; A = 1 (string type) +2496+ 245F 32 30 55 ld (TYPE),A ; Set type to string +2497+ 2462 0F rrca ; A = 80H , Flag for string +2498+ 2463 81 add A,C ; 2nd byte of name has bit 7 on +2499+ 2464 4F ld C,A ; Resave second byte on name +2500+ 2465 CD 90 1D call GETCHR ; Get next character +2501+ 2468 3A 73 55 NOTSTR: ld A,(FORFLG) ; Array name needed ? +2502+ 246B 3D dec A +2503+ 246C CA 15 25 jp Z,ARLDSV ; Yes - Get array name +2504+ 246F F2 78 24 jp P,NSCFOR ; No array with "FOR" or "FN" +2505+ 2472 7E ld A,(HL) ; Get byte again +2506+ 2473 D6 28 sub '(' ; Subscripted variable? +2507+ 2475 CA ED 24 jp Z,SBSCPT ; Yes - Sort out subscript +2508+ 2478 +2509+ 2478 AF NSCFOR: xor A ; Simple variable +2510+ 2479 32 73 55 ld (FORFLG),A ; Clear "FOR" flag +2511+ 247C E5 push HL ; Save code string address +2512+ 247D 50 ld D,B ; DE = Variable name to find +2513+ 247E 59 ld E,C +2514+ 247F 2A EC 55 ld HL,(FNRGNM) ; FN argument name +2515+ 2482 CD 41 1B call CPDEHL ; Is it the FN argument? +2516+ 2485 11 EE 55 ld DE,FNARG ; Point to argument value +2517+ 2488 CA 1E 2F jp Z,POPHRT ; Yes - Return FN argument value +2518+ 248B 2A E6 55 ld HL,(VAREND) ; End of variables +2519+ 248E EB ex DE,HL ; Address of end of search +2520+ 248F 2A E4 55 ld HL,(PROGND) ; Start of variables address +2521+ 2492 CD 41 1B FNDVAR: call CPDEHL ; End of variable list table? +2522+ 2495 CA AB 24 jp Z,CFEVAL ; Yes - Called from EVAL? +2523+ 2498 79 ld A,C ; Get second byte of name +2524+ 2499 96 sub (HL) ; Compare with name in list +2525+ 249A 23 inc HL ; Move on to first byte +2526+ 249B C2 A0 24 jp NZ,FNTHR ; Different - Find another +2527+ 249E 78 ld A,B ; Get first byte of name +2528+ 249F 96 sub (HL) ; Compare with name in list +2529+ 24A0 23 FNTHR: inc HL ; Move on to LSB of value +2530+ 24A1 CA DF 24 jp Z,RETADR ; Found - Return address +2531+ 24A4 23 inc HL ; <- Skip +2532+ 24A5 23 inc HL ; <- over +2533+ 24A6 23 inc HL ; <- F.P. +2534+ 24A7 23 inc HL ; <- value +2535+ 24A8 C3 92 24 jp FNDVAR ; Keep looking +2536+ 24AB +2537+ 24AB E1 CFEVAL: pop HL ; Restore code string address +2538+ 24AC E3 ex (SP),HL ; Get return address +2539+ 24AD D5 push DE ; Save address of variable +2540+ 24AE 11 14 23 ld DE,FRMEVL ; Return address in EVAL +2541+ 24B1 CD 41 1B call CPDEHL ; Called from EVAL ? +2542+ 24B4 D1 pop DE ; Restore address of variable +2543+ 24B5 CA E2 24 jp Z,RETNUL ; Yes - Return null variable +2544+ 24B8 E3 ex (SP),HL ; Put back return +2545+ 24B9 E5 push HL ; Save code string address +2546+ 24BA C5 push BC ; Save variable name +2547+ 24BB 01 06 00 ld BC,$0006 ; 2 byte name plus 4 byte data +2548+ 24BE 2A E8 55 ld HL,(ARREND) ; End of arrays +2549+ 24C1 E5 push HL ; Save end of arrays +2550+ 24C2 09 add HL,BC ; Move up 6 bytes +2551+ 24C3 C1 pop BC ; Source address in BC +2552+ 24C4 E5 push HL ; Save new end address +2553+ 24C5 CD F5 17 call MOVUP ; Move arrays up +2554+ 24C8 E1 pop HL ; Restore new end address +2555+ 24C9 22 E8 55 ld (ARREND),HL ; Set new end address +2556+ 24CC 60 ld H,B ; End of variables to HL +2557+ 24CD 69 ld L,C +2558+ 24CE 22 E6 55 ld (VAREND),HL ; Set new end address +2559+ 24D1 +2560+ 24D1 2B ZEROLP: dec HL ; Back through to zero variable +2561+ 24D2 36 00 ld (HL),$00 ; Zero byte in variable +2562+ 24D4 CD 41 1B call CPDEHL ; Done them all? +2563+ 24D7 C2 D1 24 jp NZ,ZEROLP ; No - Keep on going +2564+ 24DA D1 pop DE ; Get variable name +2565+ 24DB 73 ld (HL),E ; Store second character +2566+ 24DC 23 inc HL +2567+ 24DD 72 ld (HL),D ; Store first character +2568+ 24DE 23 inc HL +2569+ 24DF EB RETADR: ex DE,HL ; Address of variable in DE +2570+ 24E0 E1 pop HL ; Restore code string address +2571+ 24E1 C9 ret +2572+ 24E2 +2573+ 24E2 32 F5 55 RETNUL: ld (FPEXP),A ; Set result to zero +2574+ 24E5 21 C6 17 ld HL,ZERBYT ; Also set a null string +2575+ 24E8 22 F2 55 ld (FPREG),HL ; Save for EVAL +2576+ 24EB E1 pop HL ; Restore code string address +2577+ 24EC C9 ret +2578+ 24ED +2579+ 24ED E5 SBSCPT: push HL ; Save code string address +2580+ 24EE 2A 2F 55 ld HL,(LCRFLG) ; Locate/Create and Type +2581+ 24F1 E3 ex (SP),HL ; Save and get code string +2582+ 24F2 57 ld D,A ; Zero number of dimensions +2583+ 24F3 D5 SCPTLP: push DE ; Save number of dimensions +2584+ 24F4 C5 push BC ; Save array name +2585+ 24F5 CD 3A 1E call FPSINT ; Get subscript (0-32767) +2586+ 24F8 C1 pop BC ; Restore array name +2587+ 24F9 F1 pop AF ; Get number of dimensions +2588+ 24FA EB ex DE,HL +2589+ 24FB E3 ex (SP),HL ; Save subscript value +2590+ 24FC E5 push HL ; Save LCRFLG and TYPE +2591+ 24FD EB ex DE,HL +2592+ 24FE 3C inc A ; Count dimensions +2593+ 24FF 57 ld D,A ; Save in D +2594+ 2500 7E ld A,(HL) ; Get next byte in code string +2595+ 2501 FE 2C cp ',' ; Comma (more to come)? +2596+ 2503 CA F3 24 jp Z,SCPTLP ; Yes - More subscripts +2597+ 2506 CD 47 1B call CHKSYN ; Make sure ")" follows +2598+ 2509 29 defb ')' +2599+ 250A 22 78 55 ld (NXTOPR),HL ; Save code string address +2600+ 250D E1 pop HL ; Get LCRFLG and TYPE +2601+ 250E 22 2F 55 ld (LCRFLG),HL ; Restore Locate/create & type +2602+ 2511 1E 00 ld E,$00 ; Flag not CSAVE* or CLOAD* +2603+ 2513 D5 push DE ; Save number of dimensions (D) +2604+ 2514 11 defb $11 ; Skip "push HL" and "push AF' +2605+ 2515 +2606+ 2515 E5 ARLDSV: push HL ; Save code string address +2607+ 2516 F5 push AF ; A = 00 , Flags set = Z,N +2608+ 2517 2A E6 55 ld HL,(VAREND) ; Start of arrays +2609+ 251A 3E defb $3E ; Skip "add HL,DE" +2610+ 251B 19 FNDARY: add HL,DE ; Move to next array start +2611+ 251C EB ex DE,HL +2612+ 251D 2A E8 55 ld HL,(ARREND) ; End of arrays +2613+ 2520 EB ex DE,HL ; Current array pointer +2614+ 2521 CD 41 1B call CPDEHL ; End of arrays found? +2615+ 2524 CA 4D 25 jp Z,CREARY ; Yes - Create array +2616+ 2527 7E ld A,(HL) ; Get second byte of name +2617+ 2528 B9 cp C ; Compare with name given +2618+ 2529 23 inc HL ; Move on +2619+ 252A C2 2F 25 jp NZ,NXTARY ; Different - Find next array +2620+ 252D 7E ld A,(HL) ; Get first byte of name +2621+ 252E B8 cp B ; Compare with name given +2622+ 252F 23 NXTARY: inc HL ; Move on +2623+ 2530 5E ld E,(HL) ; Get LSB of next array address +2624+ 2531 23 inc HL +2625+ 2532 56 ld D,(HL) ; Get MSB of next array address +2626+ 2533 23 inc HL +2627+ 2534 C2 1B 25 jp NZ,FNDARY ; Not found - Keep looking +2628+ 2537 3A 2F 55 ld A,(LCRFLG) ; Found Locate or Create it? +2629+ 253A B7 or A +2630+ 253B C2 52 18 jp NZ,DDERR ; Create - ?DD Error +2631+ 253E F1 pop AF ; Locate - Get number of dim'ns +2632+ 253F 44 ld B,H ; BC Points to array dim'ns +2633+ 2540 4D ld C,L +2634+ 2541 CA 1E 2F jp Z,POPHRT ; Jump if array load/save +2635+ 2544 96 sub (HL) ; Same number of dimensions? +2636+ 2545 CA AB 25 jp Z,FINDEL ; Yes - Find element +2637+ 2548 1E 10 BSERR: ld E,BS ; ?BS Error +2638+ 254A C3 63 18 jp ERROR ; Output error +2639+ 254D +2640+ 254D 11 04 00 CREARY: ld DE,$0004 ; 4 Bytes per entry +2641+ 2550 F1 pop AF ; Array to save or 0 dim'ns? +2642+ 2551 CA 5B 1E jp Z,FCERR ; Yes - ?FC Error +2643+ 2554 71 ld (HL),C ; Save second byte of name +2644+ 2555 23 inc HL +2645+ 2556 70 ld (HL),B ; Save first byte of name +2646+ 2557 23 inc HL +2647+ 2558 4F ld C,A ; Number of dimensions to C +2648+ 2559 CD 06 18 call CHKSTK ; Check if enough memory +2649+ 255C 23 inc HL ; Point to number of dimensions +2650+ 255D 23 inc HL +2651+ 255E 22 6D 55 ld (CUROPR),HL ; Save address of pointer +2652+ 2561 71 ld (HL),C ; Set number of dimensions +2653+ 2562 23 inc HL +2654+ 2563 3A 2F 55 ld A,(LCRFLG) ; Locate of Create? +2655+ 2566 17 rla ; Carry set = Create +2656+ 2567 79 ld A,C ; Get number of dimensions +2657+ 2568 01 0B 00 CRARLP: ld BC,10+1 ; Default dimension size 10 +2658+ 256B D2 70 25 jp NC,DEFSIZ ; Locate - Set default size +2659+ 256E C1 pop BC ; Get specified dimension size +2660+ 256F 03 inc BC ; Include zero element +2661+ 2570 71 DEFSIZ: ld (HL),C ; Save LSB of dimension size +2662+ 2571 23 inc HL +2663+ 2572 70 ld (HL),B ; Save MSB of dimension size +2664+ 2573 23 inc HL +2665+ 2574 F5 push AF ; Save num' of dim'ns an status +2666+ 2575 E5 push HL ; Save address of dim'n size +2667+ 2576 CD 1A 31 call MLDEBC ; Multiply DE by BC to find +2668+ 2579 EB ex DE,HL ; amount of mem needed (to DE) +2669+ 257A E1 pop HL ; Restore address of dimension +2670+ 257B F1 pop AF ; Restore number of dimensions +2671+ 257C 3D dec A ; Count them +2672+ 257D C2 68 25 jp NZ,CRARLP ; Do next dimension if more +2673+ 2580 F5 push AF ; Save locate/create flag +2674+ 2581 42 ld B,D ; MSB of memory needed +2675+ 2582 4B ld C,E ; LSB of memory needed +2676+ 2583 EB ex DE,HL +2677+ 2584 19 add HL,DE ; Add bytes to array start +2678+ 2585 DA 1E 18 jp C,OMERR ; Too big - Error +2679+ 2588 CD 0F 18 call ENFMEM ; See if enough memory +2680+ 258B 22 E8 55 ld (ARREND),HL ; Save new end of array +2681+ 258E +2682+ 258E 2B ZERARY: dec HL ; Back through array data +2683+ 258F 36 00 ld (HL),$00 ; Set array element to zero +2684+ 2591 CD 41 1B call CPDEHL ; All elements zeroed? +2685+ 2594 C2 8E 25 jp NZ,ZERARY ; No - Keep on going +2686+ 2597 03 inc BC ; Number of bytes + 1 +2687+ 2598 57 ld D,A ; A=0 +2688+ 2599 2A 6D 55 ld HL,(CUROPR) ; Get address of array +2689+ 259C 5E ld E,(HL) ; Number of dimensions +2690+ 259D EB ex DE,HL ; To HL +2691+ 259E 29 add HL,HL ; Two bytes per dimension size +2692+ 259F 09 add HL,BC ; Add number of bytes +2693+ 25A0 EB ex DE,HL ; Bytes needed to DE +2694+ 25A1 2B dec HL +2695+ 25A2 2B dec HL +2696+ 25A3 73 ld (HL),E ; Save LSB of bytes needed +2697+ 25A4 23 inc HL +2698+ 25A5 72 ld (HL),D ; Save MSB of bytes needed +2699+ 25A6 23 inc HL +2700+ 25A7 F1 pop AF ; Locate / Create? +2701+ 25A8 DA CF 25 jp C,ENDDIM ; A is 0 , End if create +2702+ 25AB 47 FINDEL: ld B,A ; Find array element +2703+ 25AC 4F ld C,A +2704+ 25AD 7E ld A,(HL) ; Number of dimensions +2705+ 25AE 23 inc HL +2706+ 25AF 16 defb $16 ; Skip "pop HL" +2707+ 25B0 E1 FNDELP: pop HL ; Address of next dim' size +2708+ 25B1 5E ld E,(HL) ; Get LSB of dim'n size +2709+ 25B2 23 inc HL +2710+ 25B3 56 ld D,(HL) ; Get MSB of dim'n size +2711+ 25B4 23 inc HL +2712+ 25B5 E3 ex (SP),HL ; Save address - Get index +2713+ 25B6 F5 push AF ; Save number of dim'ns +2714+ 25B7 CD 41 1B call CPDEHL ; Dimension too large? +2715+ 25BA D2 48 25 jp NC,BSERR ; Yes - ?BS Error +2716+ 25BD E5 push HL ; Save index +2717+ 25BE CD 1A 31 call MLDEBC ; Multiply previous by size +2718+ 25C1 D1 pop DE ; Index supplied to DE +2719+ 25C2 19 add HL,DE ; Add index to pointer +2720+ 25C3 F1 pop AF ; Number of dimensions +2721+ 25C4 3D dec A ; Count them +2722+ 25C5 44 ld B,H ; MSB of pointer +2723+ 25C6 4D ld C,L ; LSB of pointer +2724+ 25C7 C2 B0 25 jp NZ,FNDELP ; More - Keep going +2725+ 25CA 29 add HL,HL ; 4 Bytes per element +2726+ 25CB 29 add HL,HL +2727+ 25CC C1 pop BC ; Start of array +2728+ 25CD 09 add HL,BC ; Point to element +2729+ 25CE EB ex DE,HL ; Address of element to DE +2730+ 25CF 2A 78 55 ENDDIM: ld HL,(NXTOPR) ; Got code string address +2731+ 25D2 C9 ret +2732+ 25D3 +2733+ 25D3 +2734+ 25D3 ; returns the value of the 32-bit system tick counter as +2735+ 25D3 ; two 16-bit words +2736+ 25D3 CD 24 22 TMR: call TSTNUM ; Make sure it's a number +2737+ 25D6 CD 46 1E call DEINT ; Get integer (-32768 to 32767) +2738+ 25D9 2A 7E 55 ld HL,(TMRCNT) ; load the LSBytes of timer +2739+ 25DC 7B ld A,E +2740+ 25DD B2 or D ; is it 0? +2741+ 25DE CA E4 25 jp Z,ENDTMR ; yes, jump over +2742+ 25E1 2A 80 55 ld HL,(TMRCNT+2) ; load the MSBytes of timer +2743+ 25E4 45 ENDTMR: ld B,L ; move bytes... +2744+ 25E5 7C ld A,H ; ...into AB +2745+ 25E6 C3 0B 26 jp ABPASS ; return word into AB +2746+ 25E9 +2747+ 25E9 +2748+ 25E9 ; returns the free space for BASIC or into the string pool +2749+ 25E9 2A E8 55 FRE: ld HL,(ARREND) ; Start of free memory +2750+ 25EC EB ex DE,HL ; To DE +2751+ 25ED 21 00 00 ld HL,$0000 ; End of free memory +2752+ 25F0 39 add HL,SP ; Current stack value +2753+ 25F1 3A 30 55 ld A,(TYPE) ; Dummy argument type +2754+ 25F4 B7 or A +2755+ 25F5 CA 05 26 jp Z,FRENUM ; Numeric - Free variable space +2756+ 25F8 CD 6C 28 call GSTRCU ; Current string to pool +2757+ 25FB CD 6C 27 call GARBGE ; Garbage collection +2758+ 25FE 2A 49 54 ld HL,(STRSPC) ; Bottom of string space in use +2759+ 2601 EB ex DE,HL ; To DE +2760+ 2602 2A 6B 55 ld HL,(STRBOT) ; Bottom of string space +2761+ 2605 7D FRENUM: ld A,L ; Get LSB of end +2762+ 2606 93 sub E ; Subtract LSB of beginning +2763+ 2607 4F ld C,A ; Save difference if C +2764+ 2608 7C ld A,H ; Get MSB of end +2765+ 2609 9A sbc A,D ; Subtract MSB of beginning +2766+ 260A 41 ACPASS: ld B,C ; Return integer AC +2767+ 260B 50 ABPASS: ld D,B ; Return integer AB +2768+ 260C 1E 00 ld E,$00 +2769+ 260E 21 30 55 ld HL,TYPE ; Point to type +2770+ 2611 73 ld (HL),E ; Set type to numeric +2771+ 2612 06 90 ld B,$80+$10 ; 16 bit integer +2772+ 2614 C3 45 30 jp RETINT ; Return the integer +2773+ 2617 +2774+ 2617 ; returns the X position of the cursor during a print +2775+ 2617 3A 2E 55 POS: ld A,(CURPOS) ; Get cursor position +2776+ 261A ; return the value in A as a number +2777+ 261A 47 PASSA: ld B,A ; Put A into AB +2778+ 261B AF xor A ; Zero A +2779+ 261C C3 0B 26 jp ABPASS ; Return integer AB +2780+ 261F +2781+ 261F CD A2 26 DEF: call CHEKFN ; Get "FN" and name +2782+ 2622 CD 94 26 call IDTEST ; Test for illegal direct +2783+ 2625 01 39 1F ld BC,DATA ; To get next statement +2784+ 2628 C5 push BC ; Save address for RETurn +2785+ 2629 D5 push DE ; Save address of function ptr +2786+ 262A CD 47 1B call CHKSYN ; Make sure "(" follows +2787+ 262D 28 defb '(' +2788+ 262E CD 30 24 call GETVAR ; Get argument variable name +2789+ 2631 E5 push HL ; Save code string address +2790+ 2632 EB ex DE,HL ; Argument address to HL +2791+ 2633 2B dec HL +2792+ 2634 56 ld D,(HL) ; Get first byte of arg name +2793+ 2635 2B dec HL +2794+ 2636 5E ld E,(HL) ; Get second byte of arg name +2795+ 2637 E1 pop HL ; Restore code string address +2796+ 2638 CD 24 22 call TSTNUM ; Make sure numeric argument +2797+ 263B CD 47 1B call CHKSYN ; Make sure ")" follows +2798+ 263E 29 defb ')' +2799+ 263F CD 47 1B call CHKSYN ; Make sure "=" follows +2800+ 2642 CC defb ZEQUAL ; "=" token +2801+ 2643 44 ld B,H ; Code string address to BC +2802+ 2644 4D ld C,L +2803+ 2645 E3 ex (SP),HL ; Save code str , Get FN ptr +2804+ 2646 71 ld (HL),C ; Save LSB of FN code string +2805+ 2647 23 inc HL +2806+ 2648 70 ld (HL),B ; Save MSB of FN code string +2807+ 2649 C3 E1 26 jp SVSTAD ; Save address and do function +2808+ 264C +2809+ 264C CD A2 26 DOFN: call CHEKFN ; Make sure FN follows +2810+ 264F D5 push DE ; Save function pointer address +2811+ 2650 CD F8 22 call EVLPAR ; Evaluate expression in "()" +2812+ 2653 CD 24 22 call TSTNUM ; Make sure numeric result +2813+ 2656 E3 ex (SP),HL ; Save code str , Get FN ptr +2814+ 2657 5E ld E,(HL) ; Get LSB of FN code string +2815+ 2658 23 inc HL +2816+ 2659 56 ld D,(HL) ; Get MSB of FN code string +2817+ 265A 23 inc HL +2818+ 265B 7A ld A,D ; And function DEFined? +2819+ 265C B3 or E +2820+ 265D CA 55 18 jp Z,UFERR ; No - ?UF Error +2821+ 2660 7E ld A,(HL) ; Get LSB of argument address +2822+ 2661 23 inc HL +2823+ 2662 66 ld H,(HL) ; Get MSB of argument address +2824+ 2663 6F ld L,A ; HL = Arg variable address +2825+ 2664 E5 push HL ; Save it +2826+ 2665 2A EC 55 ld HL,(FNRGNM) ; Get old argument name +2827+ 2668 E3 ex (SP),HL ; Save old , Get new +2828+ 2669 22 EC 55 ld (FNRGNM),HL ; Set new argument name +2829+ 266C 2A F0 55 ld HL,(FNARG+2) ; Get LSB,NLSB of old arg value +2830+ 266F E5 push HL ; Save it +2831+ 2670 2A EE 55 ld HL,(FNARG) ; Get MSB,EXP of old arg value +2832+ 2673 E5 push HL ; Save it +2833+ 2674 21 EE 55 ld HL,FNARG ; HL = Value of argument +2834+ 2677 D5 push DE ; Save FN code string address +2835+ 2678 CD 86 30 call FPTHL ; Move FPREG to argument +2836+ 267B E1 pop HL ; Get FN code string address +2837+ 267C CD 21 22 call GETNUM ; Get value from function +2838+ 267F 2B dec HL ; dec 'cos GETCHR INCs +2839+ 2680 CD 90 1D call GETCHR ; Get next character +2840+ 2683 C2 49 18 jp NZ,SNERR ; Bad character in FN - Error +2841+ 2686 E1 pop HL ; Get MSB,EXP of old arg +2842+ 2687 22 EE 55 ld (FNARG),HL ; Restore it +2843+ 268A E1 pop HL ; Get LSB,NLSB of old arg +2844+ 268B 22 F0 55 ld (FNARG+2),HL ; Restore it +2845+ 268E E1 pop HL ; Get name of old arg +2846+ 268F 22 EC 55 ld (FNRGNM),HL ; Restore it +2847+ 2692 E1 pop HL ; Restore code string address +2848+ 2693 C9 ret +2849+ 2694 +2850+ 2694 E5 IDTEST: push HL ; Save code string address +2851+ 2695 2A 4B 54 ld HL,(LINEAT) ; Get current line number +2852+ 2698 23 inc HL ; -1 means direct statement +2853+ 2699 7C ld A,H +2854+ 269A B5 or L +2855+ 269B E1 pop HL ; Restore code string address +2856+ 269C C0 ret NZ ; Return if in program +2857+ 269D 1E 16 ld E,ID ; ?ID Error +2858+ 269F C3 63 18 jp ERROR +2859+ 26A2 +2860+ 26A2 CD 47 1B CHEKFN: call CHKSYN ; Make sure FN follows +2861+ 26A5 BC defb ZFN ; "FN" token +2862+ 26A6 3E 80 ld A,$80 +2863+ 26A8 32 73 55 ld (FORFLG),A ; Flag FN name to find +2864+ 26AB B6 or (HL) ; FN name has bit 7 set +2865+ 26AC 47 ld B,A ; in first byte of name +2866+ 26AD CD 35 24 call GTFNAM ; Get FN name +2867+ 26B0 C3 24 22 jp TSTNUM ; Make sure numeric function +2868+ 26B3 +2869+ 26B3 CD 24 22 STR: call TSTNUM ; Make sure it's a number +2870+ 26B6 CD D3 31 call NUMASC ; Turn number into text +2871+ 26B9 CD E7 26 STR1: call CRTST ; Create string entry for it +2872+ 26BC CD 6C 28 call GSTRCU ; Current string to pool +2873+ 26BF 01 C7 28 ld BC,TOPOOL ; Save in string pool +2874+ 26C2 C5 push BC ; Save address on stack +2875+ 26C3 +2876+ 26C3 7E SAVSTR: ld A,(HL) ; Get string length +2877+ 26C4 23 inc HL +2878+ 26C5 23 inc HL +2879+ 26C6 E5 push HL ; Save pointer to string +2880+ 26C7 CD 42 27 call TESTR ; See if enough string space +2881+ 26CA E1 pop HL ; Restore pointer to string +2882+ 26CB 4E ld C,(HL) ; Get LSB of address +2883+ 26CC 23 inc HL +2884+ 26CD 46 ld B,(HL) ; Get MSB of address +2885+ 26CE CD DB 26 call CRTMST ; Create string entry +2886+ 26D1 E5 push HL ; Save pointer to MSB of addr +2887+ 26D2 6F ld L,A ; Length of string +2888+ 26D3 CD 5F 28 call TOSTRA ; Move to string area +2889+ 26D6 D1 pop DE ; Restore pointer to MSB +2890+ 26D7 C9 ret +2891+ 26D8 +2892+ 26D8 CD 42 27 MKTMST: call TESTR ; See if enough string space +2893+ 26DB 21 67 55 CRTMST: ld HL,TMPSTR ; Temporary string +2894+ 26DE E5 push HL ; Save it +2895+ 26DF 77 ld (HL),A ; Save length of string +2896+ 26E0 23 inc HL +2897+ 26E1 23 SVSTAD: inc HL +2898+ 26E2 73 ld (HL),E ; Save LSB of address +2899+ 26E3 23 inc HL +2900+ 26E4 72 ld (HL),D ; Save MSB of address +2901+ 26E5 E1 pop HL ; Restore pointer +2902+ 26E6 C9 ret +2903+ 26E7 +2904+ 26E7 2B CRTST: dec HL ; dec - INCed after +2905+ 26E8 06 22 QTSTR: ld B,$22 ; '"' ; Terminating quote +2906+ 26EA 50 ld D,B ; Quote to D +2907+ 26EB E5 DTSTR: push HL ; Save start +2908+ 26EC 0E FF ld C,-1 ; Set counter to -1 +2909+ 26EE 23 QTSTLP: inc HL ; Move on +2910+ 26EF 7E ld A,(HL) ; Get byte +2911+ 26F0 0C inc C ; Count bytes +2912+ 26F1 B7 or A ; End of line? +2913+ 26F2 CA FD 26 jp Z,CRTSTE ; Yes - Create string entry +2914+ 26F5 BA cp D ; Terminator D found? +2915+ 26F6 CA FD 26 jp Z,CRTSTE ; Yes - Create string entry +2916+ 26F9 B8 cp B ; Terminator B found? +2917+ 26FA C2 EE 26 jp NZ,QTSTLP ; No - Keep looking +2918+ 26FD FE 22 CRTSTE: cp $22 ; '"' ; End with '"'? +2919+ 26FF CC 90 1D call Z,GETCHR ; Yes - Get next character +2920+ 2702 E3 ex (SP),HL ; Starting quote +2921+ 2703 23 inc HL ; First byte of string +2922+ 2704 EB ex DE,HL ; To DE +2923+ 2705 79 ld A,C ; Get length +2924+ 2706 CD DB 26 call CRTMST ; Create string entry +2925+ 2709 11 67 55 TSTOPL: ld DE,TMPSTR ; Temporary string +2926+ 270C 2A 59 55 ld HL,(TMSTPT) ; Temporary string pool pointer +2927+ 270F 22 F2 55 ld (FPREG),HL ; Save address of string ptr +2928+ 2712 3E 01 ld A,$01 +2929+ 2714 32 30 55 ld (TYPE),A ; Set type to string +2930+ 2717 CD 89 30 call DETHL4 ; Move string to pool +2931+ 271A CD 41 1B call CPDEHL ; Out of string pool? +2932+ 271D 22 59 55 ld (TMSTPT),HL ; Save new pointer +2933+ 2720 E1 pop HL ; Restore code string address +2934+ 2721 7E ld A,(HL) ; Get next code byte +2935+ 2722 C0 ret NZ ; Return if pool OK +2936+ 2723 1E 1E ld E,ST ; ?ST Error +2937+ 2725 C3 63 18 jp ERROR ; String pool overflow +2938+ 2728 +2939+ 2728 23 PRNUMS: inc HL ; Skip leading space +2940+ 2729 CD E7 26 PRS: call CRTST ; Create string entry for it +2941+ 272C CD 6C 28 PRS1: call GSTRCU ; Current string to pool +2942+ 272F CD 7D 30 call LOADFP ; Move string block to BCDE +2943+ 2732 1C inc E ; Length + 1 +2944+ 2733 1D PRSLP: dec E ; Count characters +2945+ 2734 C8 ret Z ; End of string +2946+ 2735 0A ld A,(BC) ; Get byte to output +2947+ 2736 CD 52 1B call OUTC ; Output character in A +2948+ 2739 FE 0D cp CR ; Return? +2949+ 273B CC 67 20 call Z,CNTEND ; Yes - Position cursor to 0 +2950+ 273E 03 inc BC ; Next byte in string +2951+ 273F C3 33 27 jp PRSLP ; More characters to output +2952+ 2742 +2953+ 2742 B7 TESTR: or A ; Test if enough room +2954+ 2743 0E defb $0E ; No garbage collection done +2955+ 2744 F1 GRBDON: pop AF ; Garbage collection done +2956+ 2745 F5 push AF ; Save status +2957+ 2746 2A 49 54 ld HL,(STRSPC) ; Bottom of string space in use +2958+ 2749 EB ex DE,HL ; To DE +2959+ 274A 2A 6B 55 ld HL,(STRBOT) ; Bottom of string area +2960+ 274D 2F cpl ; Negate length (Top down) +2961+ 274E 4F ld C,A ; -Length to BC +2962+ 274F 06 FF ld B,-1 ; BC = -ve length of string +2963+ 2751 09 add HL,BC ; Add to bottom of space in use +2964+ 2752 23 inc HL ; Plus one for 2's complement +2965+ 2753 CD 41 1B call CPDEHL ; Below string RAM area? +2966+ 2756 DA 60 27 jp C,TESTOS ; Tidy up if not done else err +2967+ 2759 22 6B 55 ld (STRBOT),HL ; Save new bottom of area +2968+ 275C 23 inc HL ; Point to first byte of string +2969+ 275D EB ex DE,HL ; Address to DE +2970+ 275E F1 POPAF: pop AF ; Throw away status push +2971+ 275F C9 ret +2972+ 2760 +2973+ 2760 F1 TESTOS: pop AF ; Garbage collect been done? +2974+ 2761 1E 1A ld E,OS ; ?OS Error +2975+ 2763 CA 63 18 jp Z,ERROR ; Yes - Not enough string space +2976+ 2766 BF cp A ; Flag garbage collect done +2977+ 2767 F5 push AF ; Save status +2978+ 2768 01 44 27 ld BC,GRBDON ; Garbage collection done +2979+ 276B C5 push BC ; Save for RETurn +2980+ 276C 2A 32 55 GARBGE: ld HL,(LSTRAM) ; Get end of RAM pointer +2981+ 276F 22 6B 55 GARBLP: ld (STRBOT),HL ; Reset string pointer +2982+ 2772 21 00 00 ld HL,$0000 +2983+ 2775 E5 push HL ; Flag no string found +2984+ 2776 2A 49 54 ld HL,(STRSPC) ; Get bottom of string space +2985+ 2779 E5 push HL ; Save bottom of string space +2986+ 277A 21 5B 55 ld HL,TMSTPL ; Temporary string pool +2987+ 277D EB GRBLP: ex DE,HL +2988+ 277E 2A 59 55 ld HL,(TMSTPT) ; Temporary string pool pointer +2989+ 2781 EB ex DE,HL +2990+ 2782 CD 41 1B call CPDEHL ; Temporary string pool done? +2991+ 2785 01 7D 27 ld BC,GRBLP ; Loop until string pool done +2992+ 2788 C2 D1 27 jp NZ,STPOOL ; No - See if in string area +2993+ 278B 2A E4 55 ld HL,(PROGND) ; Start of simple variables +2994+ 278E EB SMPVAR: ex DE,HL +2995+ 278F 2A E6 55 ld HL,(VAREND) ; End of simple variables +2996+ 2792 EB ex DE,HL +2997+ 2793 CD 41 1B call CPDEHL ; All simple strings done? +2998+ 2796 CA A4 27 jp Z,ARRLP ; Yes - Do string arrays +2999+ 2799 7E ld A,(HL) ; Get type of variable +3000+ 279A 23 inc HL +3001+ 279B 23 inc HL +3002+ 279C B7 or A ; "S" flag set if string +3003+ 279D CD D4 27 call STRADD ; See if string in string area +3004+ 27A0 C3 8E 27 jp SMPVAR ; Loop until simple ones done +3005+ 27A3 +3006+ 27A3 C1 GNXARY: pop BC ; Scrap address of this array +3007+ 27A4 EB ARRLP: ex DE,HL +3008+ 27A5 2A E8 55 ld HL,(ARREND) ; End of string arrays +3009+ 27A8 EB ex DE,HL +3010+ 27A9 CD 41 1B call CPDEHL ; All string arrays done? +3011+ 27AC CA FA 27 jp Z,SCNEND ; Yes - Move string if found +3012+ 27AF CD 7D 30 call LOADFP ; Get array name to BCDE +3013+ 27B2 7B ld A,E ; Get type of array +3014+ 27B3 E5 push HL ; Save address of num of dim'ns +3015+ 27B4 09 add HL,BC ; Start of next array +3016+ 27B5 B7 or A ; Test type of array +3017+ 27B6 F2 A3 27 jp P,GNXARY ; Numeric array - Ignore it +3018+ 27B9 22 6D 55 ld (CUROPR),HL ; Save address of next array +3019+ 27BC E1 pop HL ; Get address of num of dim'ns +3020+ 27BD 4E ld C,(HL) ; BC = Number of dimensions +3021+ 27BE 06 00 ld B,$00 +3022+ 27C0 09 add HL,BC ; Two bytes per dimension size +3023+ 27C1 09 add HL,BC +3024+ 27C2 23 inc HL ; Plus one for number of dim'ns +3025+ 27C3 EB GRBARY: ex DE,HL +3026+ 27C4 2A 6D 55 ld HL,(CUROPR) ; Get address of next array +3027+ 27C7 EB ex DE,HL +3028+ 27C8 CD 41 1B call CPDEHL ; Is this array finished? +3029+ 27CB CA A4 27 jp Z,ARRLP ; Yes - Get next one +3030+ 27CE 01 C3 27 ld BC,GRBARY ; Loop until array all done +3031+ 27D1 C5 STPOOL: push BC ; Save return address +3032+ 27D2 F6 80 or $80 ; Flag string type +3033+ 27D4 7E STRADD: ld A,(HL) ; Get string length +3034+ 27D5 23 inc HL +3035+ 27D6 23 inc HL +3036+ 27D7 5E ld E,(HL) ; Get LSB of string address +3037+ 27D8 23 inc HL +3038+ 27D9 56 ld D,(HL) ; Get MSB of string address +3039+ 27DA 23 inc HL +3040+ 27DB F0 ret P ; Not a string - Return +3041+ 27DC B7 or A ; Set flags on string length +3042+ 27DD C8 ret Z ; Null string - Return +3043+ 27DE 44 ld B,H ; Save variable pointer +3044+ 27DF 4D ld C,L +3045+ 27E0 2A 6B 55 ld HL,(STRBOT) ; Bottom of new area +3046+ 27E3 CD 41 1B call CPDEHL ; String been done? +3047+ 27E6 60 ld H,B ; Restore variable pointer +3048+ 27E7 69 ld L,C +3049+ 27E8 D8 ret C ; String done - Ignore +3050+ 27E9 E1 pop HL ; Return address +3051+ 27EA E3 ex (SP),HL ; Lowest available string area +3052+ 27EB CD 41 1B call CPDEHL ; String within string area? +3053+ 27EE E3 ex (SP),HL ; Lowest available string area +3054+ 27EF E5 push HL ; Re-save return address +3055+ 27F0 60 ld H,B ; Restore variable pointer +3056+ 27F1 69 ld L,C +3057+ 27F2 D0 ret NC ; Outside string area - Ignore +3058+ 27F3 C1 pop BC ; Get return , Throw 2 away +3059+ 27F4 F1 pop AF ; +3060+ 27F5 F1 pop AF ; +3061+ 27F6 E5 push HL ; Save variable pointer +3062+ 27F7 D5 push DE ; Save address of current +3063+ 27F8 C5 push BC ; Put back return address +3064+ 27F9 C9 ret ; Go to it +3065+ 27FA +3066+ 27FA D1 SCNEND: pop DE ; Addresses of strings +3067+ 27FB E1 pop HL ; +3068+ 27FC 7D ld A,L ; HL = 0 if no more to do +3069+ 27FD B4 or H +3070+ 27FE C8 ret Z ; No more to do - Return +3071+ 27FF 2B dec HL +3072+ 2800 46 ld B,(HL) ; MSB of address of string +3073+ 2801 2B dec HL +3074+ 2802 4E ld C,(HL) ; LSB of address of string +3075+ 2803 E5 push HL ; Save variable address +3076+ 2804 2B dec HL +3077+ 2805 2B dec HL +3078+ 2806 6E ld L,(HL) ; HL = Length of string +3079+ 2807 26 00 ld H,$00 +3080+ 2809 09 add HL,BC ; Address of end of string+1 +3081+ 280A 50 ld D,B ; String address to DE +3082+ 280B 59 ld E,C +3083+ 280C 2B dec HL ; Last byte in string +3084+ 280D 44 ld B,H ; Address to BC +3085+ 280E 4D ld C,L +3086+ 280F 2A 6B 55 ld HL,(STRBOT) ; Current bottom of string area +3087+ 2812 CD F8 17 call MOVSTR ; Move string to new address +3088+ 2815 E1 pop HL ; Restore variable address +3089+ 2816 71 ld (HL),C ; Save new LSB of address +3090+ 2817 23 inc HL +3091+ 2818 70 ld (HL),B ; Save new MSB of address +3092+ 2819 69 ld L,C ; Next string area+1 to HL +3093+ 281A 60 ld H,B +3094+ 281B 2B dec HL ; Next string area address +3095+ 281C C3 6F 27 jp GARBLP ; Look for more strings +3096+ 281F +3097+ 281F C5 CONCAT: push BC ; Save prec' opr & code string +3098+ 2820 E5 push HL ; +3099+ 2821 2A F2 55 ld HL,(FPREG) ; Get first string +3100+ 2824 E3 ex (SP),HL ; Save first string +3101+ 2825 CD AA 22 call OPRND ; Get second string +3102+ 2828 E3 ex (SP),HL ; Restore first string +3103+ 2829 CD 25 22 call TSTSTR ; Make sure it's a string +3104+ 282C 7E ld A,(HL) ; Get length of second string +3105+ 282D E5 push HL ; Save first string +3106+ 282E 2A F2 55 ld HL,(FPREG) ; Get second string +3107+ 2831 E5 push HL ; Save second string +3108+ 2832 86 add A,(HL) ; Add length of second string +3109+ 2833 1E 1C ld E,LS ; ?LS Error +3110+ 2835 DA 63 18 jp C,ERROR ; String too long - Error +3111+ 2838 CD D8 26 call MKTMST ; Make temporary string +3112+ 283B D1 pop DE ; Get second string to DE +3113+ 283C CD 70 28 call GSTRDE ; Move to string pool if needed +3114+ 283F E3 ex (SP),HL ; Get first string +3115+ 2840 CD 6F 28 call GSTRHL ; Move to string pool if needed +3116+ 2843 E5 push HL ; Save first string +3117+ 2844 2A 69 55 ld HL,(TMPSTR+2) ; Temporary string address +3118+ 2847 EB ex DE,HL ; To DE +3119+ 2848 CD 56 28 call SSTSA ; First string to string area +3120+ 284B CD 56 28 call SSTSA ; Second string to string area +3121+ 284E 21 3F 22 ld HL,EVAL2 ; Return to evaluation loop +3122+ 2851 E3 ex (SP),HL ; Save return,get code string +3123+ 2852 E5 push HL ; Save code string address +3124+ 2853 C3 09 27 jp TSTOPL ; To temporary string to pool +3125+ 2856 +3126+ 2856 E1 SSTSA: pop HL ; Return address +3127+ 2857 E3 ex (SP),HL ; Get string block,save return +3128+ 2858 7E ld A,(HL) ; Get length of string +3129+ 2859 23 inc HL +3130+ 285A 23 inc HL +3131+ 285B 4E ld C,(HL) ; Get LSB of string address +3132+ 285C 23 inc HL +3133+ 285D 46 ld B,(HL) ; Get MSB of string address +3134+ 285E 6F ld L,A ; Length to L +3135+ 285F 2C TOSTRA: inc L ; inc - DECed after +3136+ 2860 2D TSALP: dec L ; Count bytes moved +3137+ 2861 C8 ret Z ; End of string - Return +3138+ 2862 0A ld A,(BC) ; Get source +3139+ 2863 12 ld (DE),A ; Save destination +3140+ 2864 03 inc BC ; Next source +3141+ 2865 13 inc DE ; Next destination +3142+ 2866 C3 60 28 jp TSALP ; Loop until string moved +3143+ 2869 +3144+ 2869 CD 25 22 GETSTR: call TSTSTR ; Make sure it's a string +3145+ 286C 2A F2 55 GSTRCU: ld HL,(FPREG) ; Get current string +3146+ 286F EB GSTRHL: ex DE,HL ; Save DE +3147+ 2870 CD 8A 28 GSTRDE: call BAKTMP ; Was it last tmp-str? +3148+ 2873 EB ex DE,HL ; Restore DE +3149+ 2874 C0 ret NZ ; No - Return +3150+ 2875 D5 push DE ; Save string +3151+ 2876 50 ld D,B ; String block address to DE +3152+ 2877 59 ld E,C +3153+ 2878 1B dec DE ; Point to length +3154+ 2879 4E ld C,(HL) ; Get string length +3155+ 287A 2A 6B 55 ld HL,(STRBOT) ; Current bottom of string area +3156+ 287D CD 41 1B call CPDEHL ; Last one in string area? +3157+ 2880 C2 88 28 jp NZ,POPHL ; No - Return +3158+ 2883 47 ld B,A ; Clear B (A=0) +3159+ 2884 09 add HL,BC ; Remove string from str' area +3160+ 2885 22 6B 55 ld (STRBOT),HL ; Save new bottom of str' area +3161+ 2888 E1 POPHL: pop HL ; Restore string +3162+ 2889 C9 ret +3163+ 288A +3164+ 288A 2A 59 55 BAKTMP: ld HL,(TMSTPT) ; Get temporary string pool top +3165+ 288D 2B dec HL ; Back +3166+ 288E 46 ld B,(HL) ; Get MSB of address +3167+ 288F 2B dec HL ; Back +3168+ 2890 4E ld C,(HL) ; Get LSB of address +3169+ 2891 2B dec HL ; Back +3170+ 2892 2B dec HL ; Back +3171+ 2893 CD 41 1B call CPDEHL ; String last in string pool? +3172+ 2896 C0 ret NZ ; Yes - Leave it +3173+ 2897 22 59 55 ld (TMSTPT),HL ; Save new string pool top +3174+ 289A C9 ret +3175+ 289B +3176+ 289B 01 1A 26 LEN: ld BC,PASSA ; To return integer A +3177+ 289E C5 push BC ; Save address +3178+ 289F CD 69 28 GETLEN: call GETSTR ; Get string and its length +3179+ 28A2 AF xor A +3180+ 28A3 57 ld D,A ; Clear D +3181+ 28A4 32 30 55 ld (TYPE),A ; Set type to numeric +3182+ 28A7 7E ld A,(HL) ; Get length of string +3183+ 28A8 B7 or A ; Set status flags +3184+ 28A9 C9 ret +3185+ 28AA +3186+ 28AA 01 1A 26 ASC: ld BC,PASSA ; To return integer A +3187+ 28AD C5 push BC ; Save address +3188+ 28AE CD 9F 28 GTFLNM: call GETLEN ; Get length of string +3189+ 28B1 CA 5B 1E jp Z,FCERR ; Null string - Error +3190+ 28B4 23 inc HL +3191+ 28B5 23 inc HL +3192+ 28B6 5E ld E,(HL) ; Get LSB of address +3193+ 28B7 23 inc HL +3194+ 28B8 56 ld D,(HL) ; Get MSB of address +3195+ 28B9 1A ld A,(DE) ; Get first byte of string +3196+ 28BA C9 ret +3197+ 28BB +3198+ 28BB 3E 01 CHR: ld A,$01 ; One character string +3199+ 28BD CD D8 26 call MKTMST ; Make a temporary string +3200+ 28C0 CD AA 2A call MAKINT ; Make it integer A +3201+ 28C3 2A 69 55 ld HL,(TMPSTR+2) ; Get address of string +3202+ 28C6 73 ld (HL),E ; Save character +3203+ 28C7 C1 TOPOOL: pop BC ; Clean up stack +3204+ 28C8 C3 09 27 jp TSTOPL ; Temporary string to pool +3205+ 28CB +3206+ 28CB CD 5A 2A LEFT: call LFRGNM ; Get number and ending ")" +3207+ 28CE AF xor A ; Start at first byte in string +3208+ 28CF E3 RIGHT1: ex (SP),HL ; Save code string,Get string +3209+ 28D0 4F ld C,A ; Starting position in string +3210+ 28D1 E5 MID1: push HL ; Save string block address +3211+ 28D2 7E ld A,(HL) ; Get length of string +3212+ 28D3 B8 cp B ; Compare with number given +3213+ 28D4 DA D9 28 jp C,ALLFOL ; All following bytes required +3214+ 28D7 78 ld A,B ; Get new length +3215+ 28D8 11 defb $11 ; Skip "ld C,0" +3216+ 28D9 0E 00 ALLFOL: ld C,$00 ; First byte of string +3217+ 28DB C5 push BC ; Save position in string +3218+ 28DC CD 42 27 call TESTR ; See if enough string space +3219+ 28DF C1 pop BC ; Get position in string +3220+ 28E0 E1 pop HL ; Restore string block address +3221+ 28E1 E5 push HL ; And re-save it +3222+ 28E2 23 inc HL +3223+ 28E3 23 inc HL +3224+ 28E4 46 ld B,(HL) ; Get LSB of address +3225+ 28E5 23 inc HL +3226+ 28E6 66 ld H,(HL) ; Get MSB of address +3227+ 28E7 68 ld L,B ; HL = address of string +3228+ 28E8 06 00 ld B,$00 ; BC = starting address +3229+ 28EA 09 add HL,BC ; Point to that byte +3230+ 28EB 44 ld B,H ; BC = source string +3231+ 28EC 4D ld C,L +3232+ 28ED CD DB 26 call CRTMST ; Create a string entry +3233+ 28F0 6F ld L,A ; Length of new string +3234+ 28F1 CD 5F 28 call TOSTRA ; Move string to string area +3235+ 28F4 D1 pop DE ; Clear stack +3236+ 28F5 CD 70 28 call GSTRDE ; Move to string pool if needed +3237+ 28F8 C3 09 27 jp TSTOPL ; Temporary string to pool +3238+ 28FB +3239+ 28FB +3240+ 28FB ; INSTR statement - look for a string inside another string +3241+ 28FB ; usage: INSTR(A$,B$) -> search for B$ into A$ +3242+ 28FB ; return 0 if B$ is not found into A$, or LEN(A$)=len(S2) +3293+ 2960 DA D5 29 jp C,RZINSTR ; if len(S2)>len(S1) then return 0 +3294+ 2963 AF RPTINST:xor A ; reset... +3295+ 2964 32 AC 55 ld (TP),A ; ...TP... +3296+ 2967 32 AE 55 ld (TF),A ; ...and TF +3297+ 296A ED 4B A6 55 ld BC,(PT) ; pointer to S1 +3298+ 296E 2A A0 55 ld HL,(ADRS1) ; first cell of S1 +3299+ 2971 09 add HL,BC ; get current position into RAM +3300+ 2972 7E ld A,(HL) ; load S1(PT) +3301+ 2973 2A A4 55 ld HL,(ADRS2) ; pointer to first char of S2 +3302+ 2976 BE cp (HL) ; is S1(PT)=S2(0)? +3303+ 2977 20 3A jr NZ,CNT1INS ; no, continue +3304+ 2979 3A A6 55 ld A,(PT) ; load current PT +3305+ 297C 32 AC 55 ld (TP),A ; TP=PT +3306+ 297F 32 A8 55 ld (PT1),A ; P1=PT +3307+ 2982 AF xor A ; set... +3308+ 2983 32 AA 55 ld (PT2),A ; ...PT2=0 +3309+ 2986 3C inc A ; +3310+ 2987 32 AE 55 ld (TF),A ; set TF=1 +3311+ 298A ED 4B A8 55 RP2INST:ld BC,(PT1) ; load pointer PT1 +3312+ 298E 2A A0 55 ld HL,(ADRS1) ; load address of S1 +3313+ 2991 09 add HL,BC ; find char of S1 pointed by PT1 +3314+ 2992 7E ld A,(HL) ; load S1(PT1) +3315+ 2993 ED 4B AA 55 ld BC,(PT2) ; load pointer PT2 +3316+ 2997 2A A4 55 ld HL,(ADRS2) ; load char of S2 pointed by PT2 +3317+ 299A 09 add HL,BC ; find S2(PT2) +3318+ 299B BE cp (HL) ; is S1(PT1)=S2(PT2)? +3319+ 299C 20 4C jr NZ,CNTZIN ; no, exit inner loop +3320+ 299E 21 A8 55 ld HL,PT1 +3321+ 29A1 34 inc (HL) ; increment PT1 +3322+ 29A2 3A AA 55 ld A,(PT2) +3323+ 29A5 3C inc A ; increment PT2 +3324+ 29A6 32 AA 55 ld (PT2),A +3325+ 29A9 CA B3 29 jp Z,CNT1INS ; if PT2>255 then exit +3326+ 29AC 21 A2 55 ld HL,LNS2 ; len(S2) +3327+ 29AF BE cp (HL) ; PT2=len(S2)? +3328+ 29B0 DA 8A 29 jp C,RP2INST ; no (PT2len(S1)-len(S2) +3340+ 29CF DA 63 29 jp C,RPTINST ; repeat if < +3341+ 29D2 CA 63 29 jp Z,RPTINST ; repeat if = +3342+ 29D5 3A AE 55 RZINSTR:ld A,(TF) ; current value of TF +3343+ 29D8 A7 and A ; is it 0? +3344+ 29D9 CA E0 29 jp Z,LVINSTR ; yes, return 0 +3345+ 29DC 3A AC 55 ld A,(TP) ; return TP... +3346+ 29DF 3C inc A ; ...incremented by 1 +3347+ 29E0 E1 LVINSTR:pop HL ; drop original return point +3348+ 29E1 FD E5 push IY ; load current string address from IY into stack +3349+ 29E3 11 0C 23 ld DE,RETNUM ; Address of Return number from function... +3350+ 29E6 D5 push DE ; ...saved on stack +3351+ 29E7 C3 1A 26 jp PASSA ; return TP +3352+ 29EA AF CNTZIN: xor A ; set... +3353+ 29EB 32 AE 55 ld (TF),A ; TF=0 +3354+ 29EE C3 B3 29 jp CNT1INS ; continue +3355+ 29F1 +3356+ 29F1 +3357+ 29F1 ; returns the right portion of a string +3358+ 29F1 CD 5A 2A RIGHT: call LFRGNM ; Get number and ending ")" +3359+ 29F4 D1 pop DE ; Get string length +3360+ 29F5 D5 push DE ; And re-save +3361+ 29F6 1A ld A,(DE) ; Get length +3362+ 29F7 90 sub B ; Move back N bytes +3363+ 29F8 C3 CF 28 jp RIGHT1 ; Go and get sub-string +3364+ 29FB +3365+ 29FB ; returns a piece of a string +3366+ 29FB EB MID: ex DE,HL ; Get code string address +3367+ 29FC 7E ld A,(HL) ; Get next byte ',' or ")" +3368+ 29FD CD 5F 2A call MIDNUM ; Get number supplied +3369+ 2A00 04 inc B ; Is it character zero? +3370+ 2A01 05 dec B +3371+ 2A02 CA 5B 1E jp Z,FCERR ; Yes - Error +3372+ 2A05 C5 push BC ; Save starting position +3373+ 2A06 1E FF ld E,$FF ; All of string +3374+ 2A08 FE 29 cp ')' ; Any length given? +3375+ 2A0A CA 14 2A jp Z,RSTSTR ; No - Rest of string +3376+ 2A0D CD 47 1B call CHKSYN ; Make sure ',' follows +3377+ 2A10 2C defb ',' +3378+ 2A11 CD A7 2A call GETINT ; Get integer 0-255 +3379+ 2A14 CD 47 1B RSTSTR: call CHKSYN ; Make sure ")" follows +3380+ 2A17 29 defb ')' +3381+ 2A18 F1 pop AF ; Restore starting position +3382+ 2A19 E3 ex (SP),HL ; Get string,save code string +3383+ 2A1A 01 D1 28 ld BC,MID1 ; Continuation of MID$ routine +3384+ 2A1D C5 push BC ; Save for return +3385+ 2A1E 3D dec A ; Starting position-1 +3386+ 2A1F BE cp (HL) ; Compare with length +3387+ 2A20 06 00 ld B,$00 ; Zero bytes length +3388+ 2A22 D0 ret NC ; Null string if start past end +3389+ 2A23 4F ld C,A ; Save starting position-1 +3390+ 2A24 7E ld A,(HL) ; Get length of string +3391+ 2A25 91 sub C ; Subtract start +3392+ 2A26 BB cp E ; Enough string for it? +3393+ 2A27 47 ld B,A ; Save maximum length available +3394+ 2A28 D8 ret C ; Truncate string if needed +3395+ 2A29 43 ld B,E ; Set specified length +3396+ 2A2A C9 ret ; Go and create string +3397+ 2A2B +3398+ 2A2B +3399+ 2A2B ; return the value of a numeric string +3400+ 2A2B CD 9F 28 VAL: call GETLEN ; Get length of string +3401+ 2A2E CA FD 2D jp Z,RESZER ; Result zero +3402+ 2A31 5F ld E,A ; Save length +3403+ 2A32 23 inc HL +3404+ 2A33 23 inc HL +3405+ 2A34 7E ld A,(HL) ; Get LSB of address +3406+ 2A35 23 inc HL +3407+ 2A36 66 ld H,(HL) ; Get MSB of address +3408+ 2A37 6F ld L,A ; HL = String address +3409+ 2A38 E5 push HL ; Save string address +3410+ 2A39 19 add HL,DE +3411+ 2A3A 46 ld B,(HL) ; Get end of string+1 byte +3412+ 2A3B 72 ld (HL),D ; Zero it to terminate +3413+ 2A3C E3 ex (SP),HL ; Save string end,get start +3414+ 2A3D C5 push BC ; Save end+1 byte +3415+ 2A3E 7E ld A,(HL) ; Get starting byte +3416+ 2A3F FE 24 cp '$' ; Hex number indicated? [function added] +3417+ 2A41 C2 49 2A jp NZ,VAL1 +3418+ 2A44 CD 89 40 call HEXTFP ; Convert Hex to FPREG +3419+ 2A47 18 0D jr VAL3 +3420+ 2A49 FE 25 VAL1: cp '%' ; Binary number indicated? [function added] +3421+ 2A4B C2 53 2A jp NZ,VAL2 +3422+ 2A4E CD F9 40 call BINTFP ; Convert Bin to FPREG +3423+ 2A51 18 03 jr VAL3 +3424+ 2A53 CD 35 31 VAL2: call ASCTFP ; Convert ASCII string to FP +3425+ 2A56 C1 VAL3: pop BC ; Restore end+1 byte +3426+ 2A57 E1 pop HL ; Restore end+1 address +3427+ 2A58 70 ld (HL),B ; Put back original byte +3428+ 2A59 C9 ret +3429+ 2A5A +3430+ 2A5A EB LFRGNM: ex DE,HL ; Code string address to HL +3431+ 2A5B CD 47 1B call CHKSYN ; Make sure ")" follows +3432+ 2A5E 29 defb ')' +3433+ 2A5F C1 MIDNUM: pop BC ; Get return address +3434+ 2A60 D1 pop DE ; Get number supplied +3435+ 2A61 C5 push BC ; Re-save return address +3436+ 2A62 43 ld B,E ; Number to B +3437+ 2A63 C9 ret +3438+ 2A64 +3439+ 2A64 CD AA 2A INP: call MAKINT ; Make it integer A +3440+ 2A67 32 3C 54 ld (INPORT),A ; Set input port +3441+ 2A6A CD 3B 54 call INPSUB ; Get input from port +3442+ 2A6D C3 1A 26 jp PASSA ; Return integer A +3443+ 2A70 +3444+ 2A70 CD 94 2A POUT: call SETIO ; Set up port number +3445+ 2A73 C3 03 54 jp OUTSUB ; Output data and return +3446+ 2A76 +3447+ 2A76 CD 94 2A WAIT: call SETIO ; Set up port number +3448+ 2A79 F5 push AF ; Save AND mask +3449+ 2A7A 1E 00 ld E,$00 ; Assume zero if none given +3450+ 2A7C 2B dec HL ; dec 'cos GETCHR INCs +3451+ 2A7D CD 90 1D call GETCHR ; Get next character +3452+ 2A80 CA 8A 2A jp Z,NOXOR ; No XOR byte given +3453+ 2A83 CD 47 1B call CHKSYN ; Make sure ',' follows +3454+ 2A86 2C defb ',' +3455+ 2A87 CD A7 2A call GETINT ; Get integer 0-255 to XOR with +3456+ 2A8A C1 NOXOR: pop BC ; Restore AND mask +3457+ 2A8B CD 3B 54 WAITLP: call INPSUB ; Get input +3458+ 2A8E AB xor E ; Flip selected bits +3459+ 2A8F A0 and B ; Result non-zero? +3460+ 2A90 CA 8B 2A jp Z,WAITLP ; No = keep waiting +3461+ 2A93 C9 ret +3462+ 2A94 +3463+ 2A94 CD A7 2A SETIO: call GETINT ; Get integer 0-255 +3464+ 2A97 32 3C 54 ld (INPORT),A ; Set input port +3465+ 2A9A 32 04 54 ld (OTPORT),A ; Set output port +3466+ 2A9D CD 47 1B call CHKSYN ; Make sure ',' follows +3467+ 2AA0 2C defb ',' +3468+ 2AA1 C3 A7 2A jp GETINT ; Get integer 0-255 and return +3469+ 2AA4 +3470+ 2AA4 CD 90 1D FNDNUM: call GETCHR ; Get next character +3471+ 2AA7 CD 21 22 GETINT: call GETNUM ; Get a number from 0 to 255 +3472+ 2AAA CD 40 1E MAKINT: call DEPINT ; Make sure value 0 - 255 +3473+ 2AAD 7A ld A,D ; Get MSB of number +3474+ 2AAE B7 or A ; Zero? +3475+ 2AAF C2 5B 1E jp NZ,FCERR ; No - Error +3476+ 2AB2 2B dec HL ; dec 'cos GETCHR INCs +3477+ 2AB3 CD 90 1D call GETCHR ; Get next character +3478+ 2AB6 7B ld A,E ; Get number to A +3479+ 2AB7 C9 ret +3480+ 2AB8 +3481+ 2AB8 +3482+ 2AB8 ; activate a Non-Maskable Interrupt hooked to VDP interrupt signal +3483+ 2AB8 ; address must point to an ISR routine that terminates with EI/RETN instructions +3484+ 2AB8 CD 21 22 NMI: call GETNUM ; Get memory address +3485+ 2ABB CD 46 1E call DEINT ; get integer -32768 to 32767 +3486+ 2ABE 7B ld A,E ; check if address is 0 +3487+ 2ABF B2 or D +3488+ 2AC0 20 11 jr NZ,NM1 ; no, so jump over +3489+ 2AC2 F3 DISNMI: di ; disable INTs +3490+ 2AC3 CD EF 2A call NMIDINT ; disable VDP INT +3491+ 2AC6 E5 push HL ; store HL +3492+ 2AC7 21 ED 45 ld HL,$45ED ; these are the op-codes for "RETN" +3493+ 2ACA 22 FD 53 ld (NMIUSR),HL ; store RETN +3494+ 2ACD AF xor A +3495+ 2ACE 32 FF 53 ld (NMIUSR+2),A ; "NOP" +3496+ 2AD1 18 11 jr NMI2 ; execute the last part of code +3497+ 2AD3 E5 NM1: push HL ; store current HL +3498+ 2AD4 EB ex DE,HL ; move address argument into HL +3499+ 2AD5 F3 di ; disable INTs +3500+ 2AD6 CD EF 2A call NMIDINT ; disable VDP INT, if enabled +3501+ 2AD9 3E C3 ld A,$C3 ; "jp" instruction +3502+ 2ADB 32 FD 53 ld (NMIUSR),A ; store it +3503+ 2ADE 22 FE 53 ld (NMIUSR+1),HL ; store address +3504+ 2AE1 CD E8 2A call NMIEINT ; re-enable VDP INT +3505+ 2AE4 FB NMI2: ei ; re-enable INTS +3506+ 2AE5 00 nop ; wait for INTs +3507+ 2AE6 E1 pop HL ; retrieve HL +3508+ 2AE7 C9 ret ; return to caller +3509+ 2AE8 ; enable VDP INT +3510+ 2AE8 CD FE 2A NMIEINT:call NMIVR1 ; load default VReg #1 setting +3511+ 2AEB F6 20 or %00100000 ; enable VDP INT +3512+ 2AED 18 03 jr NMIINT ; rest of code is shared +3513+ 2AEF ; disable VDP INT +3514+ 2AEF CD FE 2A NMIDINT:call NMIVR1 ; load default VReg #1 setting +3515+ 2AF2 D5 NMIINT: push DE ; store DE +3516+ 2AF3 5F ld E,A ; move value into E +3517+ 2AF4 3E 01 ld A,$01 ; VREG #1 +3518+ 2AF6 F3 di ; disable INTs +3519+ 2AF7 CD BA 06 call WRITE_VREG ; disable VDP INT +3520+ 2AFA FB ei ; re-enable INTs +3521+ 2AFB 00 nop ; wait for INTs being enabled +3522+ 2AFC D1 pop DE ; retrieve DE +3523+ 2AFD C9 ret ; return to caller +3524+ 2AFE +3525+ 2AFE ; load VREG #1 setting for current screen mode and return it into A +3526+ 2AFE E5 NMIVR1: push HL ; store HL +3527+ 2AFF D5 push DE ; store DE +3528+ 2B00 3A 90 55 ld A,(SCR_MODE) ; check screen mode +3529+ 2B03 87 add A,A ; multiply A by 8... +3530+ 2B04 87 add A,A ; ...so that reg. A can points.. +3531+ 2B05 87 add A,A ; to the correct settings +3532+ 2B06 3C inc A ; need to change VREG 1 +3533+ 2B07 5F ld E,A ; copy A into E +3534+ 2B08 16 00 ld D,$00 ; reset D +3535+ 2B0A 21 29 0B ld HL,VDPMODESET ; pointer to register #1 setting... +3536+ 2B0D 19 add HL,DE ; ...for current screen mode +3537+ 2B0E 7E ld A,(HL) ; load current setting +3538+ 2B0F D1 pop DE ; retrieve DE +3539+ 2B10 E1 pop HL ; retrieve HL +3540+ 2B11 C9 ret ; return to caller +3541+ 2B12 +3542+ 2B12 ; execute a machine language routine, eventually passing a param into A +3543+ 2B12 CD 21 22 SYS: call GETNUM ; Get memory address +3544+ 2B15 CD 46 1E call DEINT ; Get integer -32768 to 32767 +3545+ 2B18 ED 53 A0 55 ld (TMPBFR2),DE ; store user routine's address +3546+ 2B1C AF xor A ; reset A +3547+ 2B1D 32 9E 55 ld (TMPBFR1),A ; store into temp buffer +3548+ 2B20 2B dec HL ; dec 'cos GETCHR INCs +3549+ 2B21 CD 90 1D call GETCHR ; check next character +3550+ 2B24 28 0A jr Z,NOSYSPR ; jump if nothing follows +3551+ 2B26 CD 47 1B call CHKSYN ; Make sure ',' follows +3552+ 2B29 2C defb ',' +3553+ 2B2A CD A7 2A call GETINT ; get byte value (0~255) if something follows +3554+ 2B2D 32 9E 55 ld (TMPBFR1),A ; store into temp buffer +3555+ 2B30 3A 9E 55 NOSYSPR:ld A,(TMPBFR1) ; recover A +3556+ 2B33 ED 5B A0 55 ld DE,(TMPBFR2) ; recover user routine's address +3557+ 2B37 E5 push HL ; save code string address +3558+ 2B38 EB ex DE,HL ; move user routine's address into HL +3559+ 2B39 11 3E 2B ld DE,SYSRET ; set point of return after the user routine +3560+ 2B3C D5 push DE ; store into stack +3561+ 2B3D E9 jp (HL) ; call user routine +3562+ 2B3E E1 SYSRET: pop HL ; retrieve code string address +3563+ 2B3F C9 ret ; return to caller +3564+ 2B40 +3565+ 2B40 +3566+ 2B40 ; read the contents of a RAM location +3567+ 2B40 CD 46 1E PEEK: call DEINT ; Get memory address into DE +3568+ 2B43 1A ld A,(DE) ; Read value of memory cell +3569+ 2B44 C3 1A 26 jp PASSA ; Return into A +3570+ 2B47 +3571+ 2B47 ; read the contents of a VRAM location +3572+ 2B47 CD 46 1E VPEEK: call DEINT ; Get VRAM address into DE +3573+ 2B4A EB ex DE,HL ; Copy param into HL +3574+ 2B4B F3 di ; Disable interrupts +3575+ 2B4C CD 90 06 call READ_VIDEO_LOC ; Read data from VRAM at address HL +3576+ 2B4F FB ei ; Re-enable interrupts +3577+ 2B50 EB ex DE,HL ; Restore HL +3578+ 2B51 C3 1A 26 jp PASSA ; Return value into A +3579+ 2B54 +3580+ 2B54 ; recover params for POKE/VPOKE commands +3581+ 2B54 ; returns address into DE and byte to be written into A +3582+ 2B54 CD 21 22 PKEPRMS:call GETNUM ; Get memory address +3583+ 2B57 CD 46 1E call DEINT ; Get integer -32768 to 32767 +3584+ 2B5A ED 53 9E 55 ld (TMPBFR1),DE ; Store DE into a temp. buffer +3585+ 2B5E CD 47 1B call CHKSYN ; Make sure ',' follows +3586+ 2B61 2C defb ',' +3587+ 2B62 CD A7 2A call GETINT ; Get integer 0-255 +3588+ 2B65 ED 5B 9E 55 ld DE,(TMPBFR1) ; Restore memory address +3589+ 2B69 C9 ret ; Return to caller +3590+ 2B6A +3591+ 2B6A ; write a byte into a RAM location +3592+ 2B6A CD 54 2B POKE: call PKEPRMS ; Get params: address and value, return into DE and A, resp. +3593+ 2B6D 12 ld (DE),A ; Load it into memory +3594+ 2B6E C9 ret +3595+ 2B6F +3596+ 2B6F ; write a byte into a VRAM location +3597+ 2B6F CD 54 2B VPOKE: call PKEPRMS ; Get params: address and value, return into DE and A, resp. +3598+ 2B72 EB ex DE,HL ; Copy address into HL +3599+ 2B73 F3 di ; Disable interrupts +3600+ 2B74 CD A5 06 call WRITE_VIDEO_LOC ; write data into VRAM at address HL +3601+ 2B77 FB ei ; Re-enable interrupts +3602+ 2B78 EB ex DE,HL ; Restore HL +3603+ 2B79 C9 ret ; Return to caller +3604+ 2B7A +3605+ 2B7A ; position the cursor at a specific X,Y location onto screen +3606+ 2B7A CD A7 2A LOCATE: call GETINT ; get the first param into A +3607+ 2B7D E5 push HL ; store HL +3608+ 2B7E 21 8E 55 ld HL,SCR_SIZE_W ; load address of screen width +3609+ 2B81 5E ld E,(HL) ; load screen width into E +3610+ 2B82 E1 pop HL ; restore HL +3611+ 2B83 BB cp E ; compare witdh with param +3612+ 2B84 D2 5B 1E jp NC,FCERR ; value over the width of the screen, exit with Illegal F.C. error +3613+ 2B87 32 9E 55 ld (TMPBFR1),A ; Store X into a temp. buffer +3614+ 2B8A CD 47 1B call CHKSYN ; Make sure ',' follows +3615+ 2B8D 2C defb ',' +3616+ 2B8E CD A7 2A call GETINT ; Get the second param into A +3617+ 2B91 E5 push HL ; store HL +3618+ 2B92 21 8F 55 ld HL,SCR_SIZE_H ; load address of screen width +3619+ 2B95 5E ld E,(HL) ; load screen width into A +3620+ 2B96 E1 pop HL ; restore HL +3621+ 2B97 BB cp E ; compare witdh with param +3622+ 2B98 D2 5B 1E jp NC,FCERR ; value over the height of the screen, exit with Illegal F.C. error +3623+ 2B9B 32 96 55 ld (SCR_CUR_NY),A ; store new Y +3624+ 2B9E 3A 9E 55 ld A,(TMPBFR1) ; recover the new X +3625+ 2BA1 32 95 55 ld (SCR_CUR_NX),A ; store new X +3626+ 2BA4 E5 push HL ; store HL +3627+ 2BA5 F3 di ; disable INTs +3628+ 2BA6 CD D6 06 call MOVCRS ; move cursor to new location +3629+ 2BA9 FB ei ; re-enable INTs +3630+ 2BAA E1 pop HL ; restore HL +3631+ 2BAB C9 ret ; return to caller +3632+ 2BAC +3633+ 2BAC ; write a byte into one of the PSG registers +3634+ 2BAC CD A7 2A SREG: call GETINT ; Get register number back into A +3635+ 2BAF FE 10 cp $10 ; check if value >= 16 (PSG registers go from 0 to 15) +3636+ 2BB1 D2 5B 1E jp NC,FCERR ; If yes, exit and raise an Illegal function call Error +3637+ 2BB4 32 9E 55 ld (TMPBFR1),A ; Store A into a temp. buffer +3638+ 2BB7 CD 47 1B call CHKSYN ; Make sure ',' follows +3639+ 2BBA 2C defb ',' +3640+ 2BBB CD A7 2A call GETINT ; get second value (0-255), returned into A +3641+ 2BBE 5F ld E,A ; store value into E +3642+ 2BBF 3A 9E 55 ld A,(TMPBFR1) ; recover VDP register and store into D +3643+ 2BC2 F3 di ; disable INTs +3644+ 2BC3 0E 40 ld C,PSG_REG ; output port to access PSG registers +3645+ 2BC5 ED 79 out (C),A ; send register # to PSG +3646+ 2BC7 0E 41 ld C,PSG_DAT ; output port to send data to PSG +3647+ 2BC9 ED 59 out (C),E ; send byte to write into selected register +3648+ 2BCB FB ei ; re-enable INTs +3649+ 2BCC C9 ret ; return to caller +3650+ 2BCD +3651+ 2BCD ; VOLUME ch,vol +3652+ 2BCD ; set the volume for the audio channels +3653+ 2BCD ; "ch" is 1~3 for corresponding channel, or 0 for all; "vol" is 0~15 (0=OFF, 15=MAX) +3654+ 2BCD CD A7 2A VOLUME: call GETINT ; get integer 0-255 (recover channel) +3655+ 2BD0 FE 04 cp $04 ; check if it's in the range 0~3 +3656+ 2BD2 D2 5B 1E jp NC,FCERR ; if not, exit with Illegal function call error +3657+ 2BD5 32 9E 55 ld (TMPBFR1),A ; Store A into a temp. buffer +3658+ 2BD8 CD 47 1B call CHKSYN ; Make sure ',' follows +3659+ 2BDB 2C defb ',' +3660+ 2BDC CD A7 2A call GETINT ; get integer 0-255 (recover channel) +3661+ 2BDF FE 10 cp $10 ; check if it's in the range 0~15 +3662+ 2BE1 D2 5B 1E jp NC,FCERR ; if not, exit with Illegal funcion call +3663+ 2BE4 57 ld D,A ; store volume into D +3664+ 2BE5 3A 9E 55 ld A,(TMPBFR1) ; retrieve channel +3665+ 2BE8 A7 and A ; is it 0? (0=every channel) +3666+ 2BE9 20 10 jr NZ,VOLCH ; no, jump over +3667+ 2BEB 06 03 ld B,$03 ; yes, set every channel +3668+ 2BED 1E 08 ld E,$08 ; register volume of first channel +3669+ 2BEF 0E 40 RPVOLCG:ld C,PSG_REG ; PSG register port +3670+ 2BF1 ED 59 out (C),E ; set register # +3671+ 2BF3 0E 41 ld C,PSG_DAT ; PSG data port +3672+ 2BF5 ED 51 out (C),D ; send volume +3673+ 2BF7 1C inc E ; next register +3674+ 2BF8 10 F5 djnz RPVOLCG ; repeat for each channel +3675+ 2BFA C9 ret ; return to caller +3676+ 2BFB 0E 40 VOLCH: ld C,PSG_REG ; PSG register port +3677+ 2BFD C6 07 add $07 ; add 7 to A so that we have the correct register (1->8, 2->9, 3->10) +3678+ 2BFF ED 79 out (C),A ; set register +3679+ 2C01 0E 41 ld C,PSG_DAT ; PSG data port +3680+ 2C03 ED 51 out (C),D ; send volume level +3681+ 2C05 C9 ret ; return to caller +3682+ 2C06 +3683+ 2C06 ; SOUND ch,tone,dur +3684+ 2C06 ; play a tone or noise of "tone" frequency from selected channel "ch" for duration "dur" +3685+ 2C06 ; "ch" is 1~6 (0=means sound OFF,1~3 for tone, 4~6 for noise) / "tone" is 1~4,095 (0=means no tone) / +3686+ 2C06 ; "dur" is 1~16383 h.o.s.,0.001~163s (0=means non-stop tone) +3687+ 2C06 CD A7 2A SOUND: call GETINT ; get integer 0-255 (recover channel) +3688+ 2C09 A7 and A ; is it zero? +3689+ 2C0A 20 08 jr NZ,CTSNDC ; no, continue with checking of params +3690+ 2C0C E5 push HL ; store HL +3691+ 2C0D F3 di ; disable INTs +3692+ 2C0E CD 9B 0C call CLRPSGREGS ; yes, it's zero, so reset PSG registers to shut down every sound +3693+ 2C11 FB ei ; re-enable INTs +3694+ 2C12 E1 pop HL ; retrieve HL +3695+ 2C13 C9 ret ; return to caller +3696+ 2C14 32 9E 55 CTSNDC: ld (TMPBFR1),A ; no, continue by storing A into a temp. buffer +3697+ 2C17 FE 04 cp $04 ; is channel >3? +3698+ 2C19 D2 98 2C jp NC,NOISUP ; Yes - check to see if it's a noise channel +3699+ 2C1C CD 47 1B call CHKSYN ; No, continue checking by making sure ',' follows +3700+ 2C1F 2C defb ',' +3701+ 2C20 CD 21 22 call GETNUM ; Get tone frequency +3702+ 2C23 CD 46 1E call DEINT ; Get integer -32768 to 32767 +3703+ 2C26 ED 53 A0 55 ld (TMPBFR2),DE ; Store frequency +3704+ 2C2A CD 47 1B call CHKSYN ; Make sure ',' follows +3705+ 2C2D 2C defb ',' +3706+ 2C2E CD 21 22 call GETNUM ; Get duration +3707+ 2C31 CD 46 1E call DEINT ; Get integer -32768 to 32767 +3708+ 2C34 ED 53 A2 55 ld (TMPBFR3),DE ; Store duration +3709+ 2C38 ; CHECK CHANNEL +3710+ 2C38 3A 9E 55 ld A,(TMPBFR1) ; recover channel +3711+ 2C3B FE 01 cp $01 ; is channel <1? +3712+ 2C3D DA 5B 1E jp C,FCERR ; Yes - Illegal function call error +3713+ 2C40 ; CHECK FREQUENCY +3714+ 2C40 ED 5B A0 55 ld DE,(TMPBFR2) ; restore frequency from temp buffer +3715+ 2C44 7A ld A,D ; move D into A and check if it is in the range 0~4095... +3716+ 2C45 FE 10 cp $10 ; ...so D must not be greater than $0F (15) +3717+ 2C47 D2 5B 1E jp NC,FCERR ; if not in the range, exit with an Illegal function call error +3718+ 2C4A ; CHECK DURATION +3719+ 2C4A ED 5B A2 55 ld DE,(TMPBFR3) ; restore duration from temp buffer +3720+ 2C4E 7A ld A,D ; check if it is in the range 0~16383... +3721+ 2C4F E6 C0 and $C0 ; ...(15th & 14th bits must not be set) +3722+ 2C51 C2 5B 1E jp NZ,FCERR ; if not in the range, exit with an Illegal function call error +3723+ 2C54 ; +3724+ 2C54 ; SET TONE: +3725+ 2C54 ; let's start by setting up the channel +3726+ 2C54 3A 9E 55 ld A,(TMPBFR1) ; restore channel value +3727+ 2C57 FE 03 cp $03 ; is it 3? +3728+ 2C59 20 02 jr NZ,SND1 ; no, jump over +3729+ 2C5B 3E 04 ld A,%00000100 ; yes, for ch.3, set 3rd bit only (so A=001, B=010, C=100) +3730+ 2C5D 2F SND1: cpl ; complement of A - this is used later to set on the channel into the mixer +3731+ 2C5E CD E5 2C call WRTSND ; enable line into mixer of channel stored in A +3732+ 2C61 ; SET FREQUENCY +3733+ 2C61 ; we simply get frequency and subtract from 4096. The result +3734+ 2C61 ; is put into register pair of the corresponding freq tone channel +3735+ 2C61 ED 5B A0 55 ld DE,(TMPBFR2) ; restore frequency from temp buffer +3736+ 2C65 E5 push HL ; store HL (it will be used by the subroutine) +3737+ 2C66 21 00 10 ld HL,$1000 ; load 4096 into HL +3738+ 2C69 A7 and A ; reset C flag +3739+ 2C6A ED 52 sbc HL,DE ; subtract freq from HL - now the frequency is inverted, so we will send the low as high and vice-versa +3740+ 2C6C 3A 9E 55 ld A,(TMPBFR1) ; restore channel value +3741+ 2C6F 3D dec A ; set A into the range 0~2 +3742+ 2C70 87 add A,A ; double A to find the register pair that correspond to the channel (A->0,1 / B->2,3, C->4,5) +3743+ 2C71 0E 40 ld C,PSG_REG ; PSG register port +3744+ 2C73 ED 79 out (C),A ; select first register of the pair +3745+ 2C75 0E 41 ld C,PSG_DAT ; PSG data port +3746+ 2C77 ED 69 out (C),L ; send high byte +3747+ 2C79 0E 40 ld C,PSG_REG ; PSG register support +3748+ 2C7B 3C inc A ; second register of the pair +3749+ 2C7C ED 79 out (C),A ; select register +3750+ 2C7E 0E 41 ld C,PSG_DAT ; PSG data port +3751+ 2C80 ED 61 out (C),H ; send low byte +3752+ 2C82 ED 5B A2 55 ld DE,(TMPBFR3) ; recover duration +3753+ 2C86 3A 9E 55 ld A,(TMPBFR1) ; recover channel value +3754+ 2C89 3D dec A ; set channel into the range 0~2 +3755+ 2C8A 87 add A,A ; double A to find the correct offset +3756+ 2C8B 21 D2 55 ld HL,CHASNDDTN ; set duration into... +3757+ 2C8E 85 add A,L ; ...the proper... +3758+ 2C8F 30 01 jr NC,SNDOVR ; (is there a rest? no, jump over +3759+ 2C91 24 inc H ; yes, increment H) +3760+ 2C92 6F SNDOVR: ld L,A ; ...register pair... +3761+ 2C93 73 ld (HL),E ; ...and store the value +3762+ 2C94 23 inc HL +3763+ 2C95 72 ld (HL),D +3764+ 2C96 E1 pop HL ; retrieve HL +3765+ 2C97 C9 ret ; Return to caller +3766+ 2C98 FE 07 NOISUP: cp $07 ; is channel in range 4 to 6 (for a noise)? +3767+ 2C9A D2 5B 1E jp NC,FCERR ; no, so ILLEGAL FUNCTION CALL +3768+ 2C9D CD 47 1B call CHKSYN ; yes, continue checking by making sure ',' follows +3769+ 2CA0 2C defb ',' +3770+ 2CA1 CD A7 2A call GETINT ; get integer 0-255 (frequency) +3771+ 2CA4 FE 20 cp $20 ; make sure it's in range 0~31 +3772+ 2CA6 D2 5B 1E jp NC,FCERR ; no, so Illegal function call +3773+ 2CA9 32 A0 55 ld (TMPBFR2),A ; store freq. +3774+ 2CAC 2B dec HL ; dec 'cos GETCHR INCs +3775+ 2CAD CD 90 1D call GETCHR ; check that nothing follows +3776+ 2CB0 C2 49 18 jp NZ,SNERR ; error if no empty line +3777+ 2CB3 3A A0 55 ld A,(TMPBFR2) ; retrieve freq. +3778+ 2CB6 5F ld E,A ; store freq into E +3779+ 2CB7 3A 9E 55 ld A,(TMPBFR1) ; retrieve channel +3780+ 2CBA D6 03 sub $03 ; subtract 3 to get channel in range 1~3 +3781+ 2CBC FE 03 cp $03 ; is it 3? +3782+ 2CBE 20 02 jr NZ,NOS1 ; no, jump over +3783+ 2CC0 3E 04 ld A,%00000100 ; yes, for ch.3, set 3rd bit only (so A=001, B=010, C=100) +3784+ 2CC2 87 NOS1: add A,A +3785+ 2CC3 87 add A,A +3786+ 2CC4 87 add A,A ; let's move A 3 bits to left +3787+ 2CC5 47 ld B,A ; store channel into B +3788+ 2CC6 7B ld A,E ; check if +3789+ 2CC7 A7 and A ; freq is 0 (means that noise reproduction must be halted) +3790+ 2CC8 F3 di ; disable INts +3791+ 2CC9 20 0A jr NZ,NOS2 ; no, so jump over +3792+ 2CCB 3E 07 ld A,$07 ; mixer register +3793+ 2CCD CD E9 0C call SETSNDREG ; set mixer register +3794+ 2CD0 ED 78 in A,(C) ; load current mixer value +3795+ 2CD2 B0 or B ; disable noise +3796+ 2CD3 18 19 jr NOS3 ; continue over +3797+ 2CD5 78 NOS2: ld A,B ; recover channel +3798+ 2CD6 2F cpl ; complement of A - this is used to set on the channel into the mixer +3799+ 2CD7 CD E5 2C call WRTSND ; enable line into mixer of channel stored in A +3800+ 2CDA 3E 06 ld A,$06 ; write into noise register +3801+ 2CDC CD E9 0C call SETSNDREG ; set register into PSG +3802+ 2CDF 7B ld A,E ; load value for noise frequency +3803+ 2CE0 CD EE 0C call WRTSNDREG ; write data into register $06 +3804+ 2CE3 FB ei ; re-enable INTs +3805+ 2CE4 C9 ret +3806+ 2CE5 ; enable line into mixer of channel stored in A +3807+ 2CE5 47 WRTSND: ld B,A ; move channel into B +3808+ 2CE6 3E 07 ld A,$07 ; mixer register +3809+ 2CE8 CD E9 0C call SETSNDREG ; set mixer register +3810+ 2CEB ED 78 in A,(C) ; load current value +3811+ 2CED A0 and B ; set on the channel into the mixer (remember that 0=ON) +3812+ 2CEE ; example: if channel is A (1), complement of 1 is 254 (11111110). So, 255 (in case +3813+ 2CEE ; the register is still unchanged after reset) is 11111111 and +3814+ 2CEE ; 11111111 AND 11111110 is equal to 11111110 +3815+ 2CEE ; 11111001 AND 11111110 is equal to 11111000 (in case channels B & C are ON) +3816+ 2CEE 47 NOS3: ld B,A ; store new mixer value into B +3817+ 2CEF 3E 07 ld A,$07 ; mixer address +3818+ 2CF1 CD E9 0C call SETSNDREG ; set register +3819+ 2CF4 78 ld A,B ; retrieve new mixer value from B +3820+ 2CF5 CD EE 0C call WRTSNDREG ; send new value for the mixer +3821+ 2CF8 FB ei ; re-enable INTs +3822+ 2CF9 C9 ret ; return to caller +3823+ 2CFA +3824+ 2CFA ; write a byte into one of the VDP registers +3825+ 2CFA CD A7 2A VREG: call GETINT ; Get register number back into A +3826+ 2CFD FE 08 cp $08 ; check if value is equal or greater than 8 (VDP registers are only 8, from 0 to 7) +3827+ 2CFF D2 5B 1E jp NC,FCERR ; If yes, exit and raise an Illegal function call Error +3828+ 2D02 32 9E 55 ld (TMPBFR1),A ; Store A into a temp. buffer +3829+ 2D05 CD 47 1B call CHKSYN ; Make sure ',' follows +3830+ 2D08 2C defb ',' +3831+ 2D09 CD A7 2A call GETINT ; get value (0-255) +3832+ 2D0C 5F ld E,A ; store value into E +3833+ 2D0D 3A 9E 55 ld A,(TMPBFR1) ; recover VDP register and store into A +3834+ 2D10 F3 di ; disable INTs +3835+ 2D11 CD BA 06 call WRITE_VREG ; write value into VDP register +3836+ 2D14 FB ei ; re-enable INTs +3837+ 2D15 C9 ret ; return to caller +3838+ 2D16 +3839+ 2D16 ; read the VDP status register and return it into A +3840+ 2D16 CD 46 1E VSTAT: call DEINT ; Get integer -32768 to 32767 (Note: we do NOT use it) +3841+ 2D19 F3 di ; disable INTs +3842+ 2D1A CD C5 06 call READ_VSTAT ; read VDP register status +3843+ 2D1D FB ei ; re-enable INTs +3844+ 2D1E C3 1A 26 jp PASSA ; Return integer A +3845+ 2D21 +3846+ 2D21 ; read from PSG register and return it into A +3847+ 2D21 CD 46 1E SSTAT: call DEINT ; get integer -32768 to 32767 +3848+ 2D24 7B ld A,E ; consider LSB +3849+ 2D25 FE 10 cp $10 ; check if value >= 16 (PSG registers go from 0 to 15) +3850+ 2D27 D2 5B 1E jp NC,FCERR ; If yes, exit and raise an Illegal function call Error +3851+ 2D2A F3 di ; disable INts +3852+ 2D2B 0E 40 ld C,PSG_REG ; output port to set PSG register +3853+ 2D2D ED 79 out (C),A ; send register to read from +3854+ 2D2F ED 78 in A,(C) ; read register's contents and store into A +3855+ 2D31 FB ei ; re-enable INTs +3856+ 2D32 C3 1A 26 jp PASSA ; return A +3857+ 2D35 +3858+ 2D35 ; read the temp key buffer and return the value of the current key being pressed +3859+ 2D35 ; can wait for the number of 100thds of second before to return +3860+ 2D35 CD 94 26 INKEY: call IDTEST ; Test for illegal direct +3861+ 2D38 CD 46 1E call DEINT ; get number param (100thds of second to wait) into DE +3862+ 2D3B C5 push BC ; store BC +3863+ 2D3C 3A 7E 55 ld A,(TMRCNT) ; Load current value of system timer +3864+ 2D3F 47 ld B,A ; move it into B +3865+ 2D40 3A 7E 55 CMP_A: ld A,(TMRCNT) ; make a little delay of 1/100 sec... +3866+ 2D43 B8 cp B ; ...to let the sniffer collect... +3867+ 2D44 20 FA jr NZ,CMP_A ; ...at least 1 char before to continue +3868+ 2D46 7A ld A,D ; check the param +3869+ 2D47 B3 or E ; if DE<>0 then... +3870+ 2D48 20 05 jr NZ,INKEY2 ; ...jump over... +3871+ 2D4A 3A DA 55 ld A,(TMPKEYBFR) ; ...else read the buffer and... +3872+ 2D4D 18 2A jr ENDINK ; ...return it +3873+ 2D4F 7A INKEY2: ld A,D ; check if param>1023 +3874+ 2D50 FE 04 cp $04 ; to do this we check if MSB>3 +3875+ 2D52 D2 5B 1E jp NC,FCERR ; if MSB >=4 then error +3876+ 2D55 E5 push HL ; store HL +3877+ 2D56 21 09 00 ld HL,$0009 ; check if value +3878+ 2D59 CD 5A 41 call CMP16 ; is < 10 +3879+ 2D5C E1 pop HL ; retrieve HL +3880+ 2D5D DA 63 2D jp C,SRTINK ; if value >= 10 then jump over +3881+ 2D60 11 0A 00 ld DE,$000A ; else, use 10 (no intervals shorter than 10/100s) +3882+ 2D63 3A 7E 55 SRTINK: ld A,(TMRCNT) ; Load the first byte of the system timer +3883+ 2D66 47 ld B,A ; move it into B +3884+ 2D67 3A DA 55 CHKINK: ld A,(TMPKEYBFR) ; load char code from buffer +3885+ 2D6A A7 and A ; is it 0? +3886+ 2D6B 20 0C jr NZ,ENDINK ; no, so we can return it +3887+ 2D6D 3A 7E 55 ld A,(TMRCNT) ; load the first byte of the system timer +3888+ 2D70 B8 cp B ; is it the same value? +3889+ 2D71 28 F4 jr Z,CHKINK ; yes, so read again +3890+ 2D73 47 ld B,A ; store new value +3891+ 2D74 1B dec DE ; no, decrement timer +3892+ 2D75 7A ld A,D ; check if zero reached +3893+ 2D76 B3 or E ; by ORing D and E +3894+ 2D77 20 EE jr NZ,CHKINK ; if not 0, repeat +3895+ 2D79 C1 ENDINK: pop BC ; restore BC +3896+ 2D7A F5 push AF ; store A +3897+ 2D7B F3 di ; disable INTs +3898+ 2D7C AF xor A ; clear the... +3899+ 2D7D 32 DA 55 ld (TMPKEYBFR),A ; ...TMP KEY buffer for the next read +3900+ 2D80 FB ei ; re-enable INTs +3901+ 2D81 F1 pop AF ; retrieve A +3902+ 2D82 C3 1A 26 jp PASSA ; return A as ASCII value +3903+ 2D85 +3904+ 2D85 +3905+ 2D85 21 AC 32 ROUND: ld HL,HALF ; Add 0.5 to FPREG +3906+ 2D88 CD 7D 30 ADDPHL: call LOADFP ; Load FP at (HL) to BCDE +3907+ 2D8B C3 97 2D jp FPADD ; Add BCDE to FPREG +3908+ 2D8E +3909+ 2D8E +3910+ 2D8E CD 7D 30 SUBPHL: call LOADFP ; FPREG = -FPREG + number at HL +3911+ 2D91 21 defb $21 ; Skip "pop BC" and "pop DE" +3912+ 2D92 C1 PSUB: pop BC ; Get FP number from stack +3913+ 2D93 D1 pop DE +3914+ 2D94 CD 57 30 SUBCDE: call INVSGN ; Negate FPREG +3915+ 2D97 78 FPADD: ld A,B ; Get FP exponent +3916+ 2D98 B7 or A ; Is number zero? +3917+ 2D99 C8 ret Z ; Yes - Nothing to add +3918+ 2D9A 3A F5 55 ld A,(FPEXP) ; Get FPREG exponent +3919+ 2D9D B7 or A ; Is this number zero? +3920+ 2D9E CA 6F 30 jp Z,FPBCDE ; Yes - Move BCDE to FPREG +3921+ 2DA1 90 sub B ; BCDE number larger? +3922+ 2DA2 D2 B1 2D jp NC,NOSWAP ; No - Don't swap them +3923+ 2DA5 2F cpl ; Two's complement +3924+ 2DA6 3C inc A ; FP exponent +3925+ 2DA7 EB ex DE,HL +3926+ 2DA8 CD 5F 30 call STAKFP ; Put FPREG on stack +3927+ 2DAB EB ex DE,HL +3928+ 2DAC CD 6F 30 call FPBCDE ; Move BCDE to FPREG +3929+ 2DAF C1 pop BC ; Restore number from stack +3930+ 2DB0 D1 pop DE +3931+ 2DB1 FE 19 NOSWAP: cp 24+1 ; Second number insignificant? +3932+ 2DB3 D0 ret NC ; Yes - First number is result +3933+ 2DB4 F5 push AF ; Save number of bits to scale +3934+ 2DB5 CD 94 30 call SIGNS ; Set MSBs & sign of result +3935+ 2DB8 67 ld H,A ; Save sign of result +3936+ 2DB9 F1 pop AF ; Restore scaling factor +3937+ 2DBA CD 5C 2E call SCALE ; Scale BCDE to same exponent +3938+ 2DBD B4 or H ; Result to be positive? +3939+ 2DBE 21 F2 55 ld HL,FPREG ; Point to FPREG +3940+ 2DC1 F2 D7 2D jp P,MINCDE ; No - Subtract FPREG from CDE +3941+ 2DC4 CD 3C 2E call PLUCDE ; Add FPREG to CDE +3942+ 2DC7 D2 1D 2E jp NC,RONDUP ; No overflow - Round it up +3943+ 2DCA 23 inc HL ; Point to exponent +3944+ 2DCB 34 inc (HL) ; Increment it +3945+ 2DCC CA 58 18 jp Z,OVERR ; Number overflowed - Error +3946+ 2DCF 2E 01 ld L,$01 ; 1 bit to shift right +3947+ 2DD1 CD 72 2E call SHRT1 ; Shift result right +3948+ 2DD4 C3 1D 2E jp RONDUP ; Round it up +3949+ 2DD7 +3950+ 2DD7 AF MINCDE: xor A ; Clear A and carry +3951+ 2DD8 90 sub B ; Negate exponent +3952+ 2DD9 47 ld B,A ; Re-save exponent +3953+ 2DDA 7E ld A,(HL) ; Get LSB of FPREG +3954+ 2DDB 9B sbc A, E ; Subtract LSB of BCDE +3955+ 2DDC 5F ld E,A ; Save LSB of BCDE +3956+ 2DDD 23 inc HL +3957+ 2DDE 7E ld A,(HL) ; Get NMSB of FPREG +3958+ 2DDF 9A sbc A,D ; Subtract NMSB of BCDE +3959+ 2DE0 57 ld D,A ; Save NMSB of BCDE +3960+ 2DE1 23 inc HL +3961+ 2DE2 7E ld A,(HL) ; Get MSB of FPREG +3962+ 2DE3 99 sbc A,C ; Subtract MSB of BCDE +3963+ 2DE4 4F ld C,A ; Save MSB of BCDE +3964+ 2DE5 DC 48 2E CONPOS: call C,COMPL ; Overflow - Make it positive +3965+ 2DE8 +3966+ 2DE8 68 BNORM: ld L,B ; L = Exponent +3967+ 2DE9 63 ld H,E ; H = LSB +3968+ 2DEA AF xor A +3969+ 2DEB 47 BNRMLP: ld B,A ; Save bit count +3970+ 2DEC 79 ld A,C ; Get MSB +3971+ 2DED B7 or A ; Is it zero? +3972+ 2DEE C2 0A 2E jp NZ,PNORM ; No - Do it bit at a time +3973+ 2DF1 4A ld C,D ; MSB = NMSB +3974+ 2DF2 54 ld D,H ; NMSB= LSB +3975+ 2DF3 65 ld H,L ; LSB = VLSB +3976+ 2DF4 6F ld L,A ; VLSB= 0 +3977+ 2DF5 78 ld A,B ; Get exponent +3978+ 2DF6 D6 08 sub $08 ; Count 8 bits +3979+ 2DF8 FE E0 cp -24-8 ; Was number zero? +3980+ 2DFA C2 EB 2D jp NZ,BNRMLP ; No - Keep normalising +3981+ 2DFD AF RESZER: xor A ; Result is zero +3982+ 2DFE 32 F5 55 SAVEXP: ld (FPEXP),A ; Save result as zero +3983+ 2E01 C9 ret +3984+ 2E02 +3985+ 2E02 05 NORMAL: dec B ; Count bits +3986+ 2E03 29 add HL,HL ; Shift HL left +3987+ 2E04 7A ld A,D ; Get NMSB +3988+ 2E05 17 rla ; Shift left with last bit +3989+ 2E06 57 ld D,A ; Save NMSB +3990+ 2E07 79 ld A,C ; Get MSB +3991+ 2E08 8F adc A,A ; Shift left with last bit +3992+ 2E09 4F ld C,A ; Save MSB +3993+ 2E0A F2 02 2E PNORM: jp P,NORMAL ; Not done - Keep going +3994+ 2E0D 78 ld A,B ; Number of bits shifted +3995+ 2E0E 5C ld E,H ; Save HL in EB +3996+ 2E0F 45 ld B,L +3997+ 2E10 B7 or A ; Any shifting done? +3998+ 2E11 CA 1D 2E jp Z,RONDUP ; No - Round it up +3999+ 2E14 21 F5 55 ld HL,FPEXP ; Point to exponent +4000+ 2E17 86 add A,(HL) ; Add shifted bits +4001+ 2E18 77 ld (HL),A ; Re-save exponent +4002+ 2E19 D2 FD 2D jp NC,RESZER ; Underflow - Result is zero +4003+ 2E1C C8 ret Z ; Result is zero +4004+ 2E1D 78 RONDUP: ld A,B ; Get VLSB of number +4005+ 2E1E 21 F5 55 RONDB: ld HL,FPEXP ; Point to exponent +4006+ 2E21 B7 or A ; Any rounding? +4007+ 2E22 FC 2F 2E call M,FPROND ; Yes - Round number up +4008+ 2E25 46 ld B,(HL) ; B = Exponent +4009+ 2E26 23 inc HL +4010+ 2E27 7E ld A,(HL) ; Get sign of result +4011+ 2E28 E6 80 and %10000000 ; Only bit 7 needed +4012+ 2E2A A9 xor C ; Set correct sign +4013+ 2E2B 4F ld C,A ; Save correct sign in number +4014+ 2E2C C3 6F 30 jp FPBCDE ; Move BCDE to FPREG +4015+ 2E2F +4016+ 2E2F 1C FPROND: inc E ; Round LSB +4017+ 2E30 C0 ret NZ ; Return if ok +4018+ 2E31 14 inc D ; Round NMSB +4019+ 2E32 C0 ret NZ ; Return if ok +4020+ 2E33 0C inc C ; Round MSB +4021+ 2E34 C0 ret NZ ; Return if ok +4022+ 2E35 0E 80 ld C,$80 ; Set normal value +4023+ 2E37 34 inc (HL) ; Increment exponent +4024+ 2E38 C0 ret NZ ; Return if ok +4025+ 2E39 C3 58 18 jp OVERR ; Overflow error +4026+ 2E3C +4027+ 2E3C 7E PLUCDE: ld A,(HL) ; Get LSB of FPREG +4028+ 2E3D 83 add A,E ; Add LSB of BCDE +4029+ 2E3E 5F ld E,A ; Save LSB of BCDE +4030+ 2E3F 23 inc HL +4031+ 2E40 7E ld A,(HL) ; Get NMSB of FPREG +4032+ 2E41 8A adc A,D ; Add NMSB of BCDE +4033+ 2E42 57 ld D,A ; Save NMSB of BCDE +4034+ 2E43 23 inc HL +4035+ 2E44 7E ld A,(HL) ; Get MSB of FPREG +4036+ 2E45 89 adc A,C ; Add MSB of BCDE +4037+ 2E46 4F ld C,A ; Save MSB of BCDE +4038+ 2E47 C9 ret +4039+ 2E48 +4040+ 2E48 21 F6 55 COMPL: ld HL,SGNRES ; Sign of result +4041+ 2E4B 7E ld A,(HL) ; Get sign of result +4042+ 2E4C 2F cpl ; Negate it +4043+ 2E4D 77 ld (HL),A ; Put it back +4044+ 2E4E AF xor A +4045+ 2E4F 6F ld L,A ; Set L to zero +4046+ 2E50 90 sub B ; Negate exponent,set carry +4047+ 2E51 47 ld B,A ; Re-save exponent +4048+ 2E52 7D ld A,L ; Load zero +4049+ 2E53 9B sbc A,E ; Negate LSB +4050+ 2E54 5F ld E,A ; Re-save LSB +4051+ 2E55 7D ld A,L ; Load zero +4052+ 2E56 9A sbc A,D ; Negate NMSB +4053+ 2E57 57 ld D,A ; Re-save NMSB +4054+ 2E58 7D ld A,L ; Load zero +4055+ 2E59 99 sbc A,C ; Negate MSB +4056+ 2E5A 4F ld C,A ; Re-save MSB +4057+ 2E5B C9 ret +4058+ 2E5C +4059+ 2E5C 06 00 SCALE: ld B,$00 ; Clear underflow +4060+ 2E5E D6 08 SCALLP: sub $08 ; 8 bits (a whole byte)? +4061+ 2E60 DA 6B 2E jp C,SHRITE ; No - Shift right A bits +4062+ 2E63 43 ld B,E ; <- Shift +4063+ 2E64 5A ld E,D ; <- right +4064+ 2E65 51 ld D,C ; <- eight +4065+ 2E66 0E 00 ld C,$00 ; <- bits +4066+ 2E68 C3 5E 2E jp SCALLP ; More bits to shift +4067+ 2E6B +4068+ 2E6B C6 09 SHRITE: add A,8+1 ; Adjust count +4069+ 2E6D 6F ld L,A ; Save bits to shift +4070+ 2E6E AF SHRLP: xor A ; Flag for all done +4071+ 2E6F 2D dec L ; All shifting done? +4072+ 2E70 C8 ret Z ; Yes - Return +4073+ 2E71 79 ld A,C ; Get MSB +4074+ 2E72 1F SHRT1: rra ; Shift it right +4075+ 2E73 4F ld C,A ; Re-save +4076+ 2E74 7A ld A,D ; Get NMSB +4077+ 2E75 1F rra ; Shift right with last bit +4078+ 2E76 57 ld D,A ; Re-save it +4079+ 2E77 7B ld A,E ; Get LSB +4080+ 2E78 1F rra ; Shift right with last bit +4081+ 2E79 5F ld E,A ; Re-save it +4082+ 2E7A 78 ld A,B ; Get underflow +4083+ 2E7B 1F rra ; Shift right with last bit +4084+ 2E7C 47 ld B,A ; Re-save underflow +4085+ 2E7D C3 6E 2E jp SHRLP ; More bits to do +4086+ 2E80 +4087+ 2E80 00 00 00 81 UNITY: defb $00,$00,$00,$81 ; 1.00000 +4088+ 2E84 +4089+ 2E84 03 LOGTAB: defb $03 ; Table used by LOG +4090+ 2E85 AA 56 19 80 defb $AA,$56,$19,$80 ; 0.59898 +4091+ 2E89 F1 22 76 80 defb $F1,$22,$76,$80 ; 0.96147 +4092+ 2E8D 45 AA 38 82 defb $45,$AA,$38,$82 ; 2.88539 +4093+ 2E91 +4094+ 2E91 CD 2E 30 LOG: call TSTSGN ; Test sign of value +4095+ 2E94 B7 or A +4096+ 2E95 EA 5B 1E jp PE,FCERR ; ?FC Error if <= zero +4097+ 2E98 21 F5 55 ld HL,FPEXP ; Point to exponent +4098+ 2E9B 7E ld A,(HL) ; Get exponent +4099+ 2E9C 01 35 80 ld BC,$8035 ; BCDE = SQR(1/2) +4100+ 2E9F 11 F3 04 ld DE,$04F3 +4101+ 2EA2 90 sub B ; Scale value to be < 1 +4102+ 2EA3 F5 push AF ; Save scale factor +4103+ 2EA4 70 ld (HL),B ; Save new exponent +4104+ 2EA5 D5 push DE ; Save SQR(1/2) +4105+ 2EA6 C5 push BC +4106+ 2EA7 CD 97 2D call FPADD ; Add SQR(1/2) to value +4107+ 2EAA C1 pop BC ; Restore SQR(1/2) +4108+ 2EAB D1 pop DE +4109+ 2EAC 04 inc B ; Make it SQR(2) +4110+ 2EAD CD 84 2F call DVBCDE ; Divide by SQR(2) +4111+ 2EB0 21 80 2E ld HL,UNITY ; Point to 1. +4112+ 2EB3 CD 8E 2D call SUBPHL ; Subtract FPREG from 1 +4113+ 2EB6 21 84 2E ld HL,LOGTAB ; Coefficient table +4114+ 2EB9 CD 76 33 call SUMSER ; Evaluate sum of series +4115+ 2EBC 01 80 80 ld BC,$8080 ; BCDE = -0.5 +4116+ 2EBF 11 00 00 ld DE,$0000 +4117+ 2EC2 CD 97 2D call FPADD ; Subtract 0.5 from FPREG +4118+ 2EC5 F1 pop AF ; Restore scale factor +4119+ 2EC6 CD A9 31 call RSCALE ; Re-scale number +4120+ 2EC9 01 31 80 MULLN2: ld BC,$8031 ; BCDE = Ln(2) +4121+ 2ECC 11 18 72 ld DE,$7218 +4122+ 2ECF 21 defb $21 ; Skip "pop BC" and "pop DE" +4123+ 2ED0 +4124+ 2ED0 C1 MULT: pop BC ; Get number from stack +4125+ 2ED1 D1 pop DE +4126+ 2ED2 CD 2E 30 FPMULT: call TSTSGN ; Test sign of FPREG +4127+ 2ED5 C8 ret Z ; Return zero if zero +4128+ 2ED6 2E 00 ld L,$00 ; Flag add exponents +4129+ 2ED8 CD EC 2F call ADDEXP ; Add exponents +4130+ 2EDB 79 ld A,C ; Get MSB of multiplier +4131+ 2EDC 32 04 56 ld (MULVAL),A ; Save MSB of multiplier +4132+ 2EDF EB ex DE,HL +4133+ 2EE0 22 05 56 ld (MULVAL+1),HL ; Save rest of multiplier +4134+ 2EE3 01 00 00 ld BC,$0000 ; Partial product (BCDE) = zero +4135+ 2EE6 50 ld D,B +4136+ 2EE7 58 ld E,B +4137+ 2EE8 21 E8 2D ld HL,BNORM ; Address of normalise +4138+ 2EEB E5 push HL ; Save for return +4139+ 2EEC 21 F4 2E ld HL,MULT8 ; Address of 8 bit multiply +4140+ 2EEF E5 push HL ; Save for NMSB,MSB +4141+ 2EF0 E5 push HL ; +4142+ 2EF1 21 F2 55 ld HL,FPREG ; Point to number +4143+ 2EF4 7E MULT8: ld A,(HL) ; Get LSB of number +4144+ 2EF5 23 inc HL ; Point to NMSB +4145+ 2EF6 B7 or A ; Test LSB +4146+ 2EF7 CA 20 2F jp Z,BYTSFT ; Zero - shift to next byte +4147+ 2EFA E5 push HL ; Save address of number +4148+ 2EFB 2E 08 ld L,$08 ; 8 bits to multiply by +4149+ 2EFD 1F MUL8LP: rra ; Shift LSB right +4150+ 2EFE 67 ld H,A ; Save LSB +4151+ 2EFF 79 ld A,C ; Get MSB +4152+ 2F00 D2 0E 2F jp NC,NOMADD ; Bit was zero - Don't add +4153+ 2F03 E5 push HL ; Save LSB and count +4154+ 2F04 2A 05 56 ld HL,(MULVAL+1) ; Get LSB and NMSB +4155+ 2F07 19 add HL,DE ; Add NMSB and LSB +4156+ 2F08 EB ex DE,HL ; Leave sum in DE +4157+ 2F09 E1 pop HL ; Restore MSB and count +4158+ 2F0A 3A 04 56 ld A,(MULVAL) ; Get MSB of multiplier +4159+ 2F0D 89 adc A,C ; Add MSB +4160+ 2F0E 1F NOMADD: rra ; Shift MSB right +4161+ 2F0F 4F ld C,A ; Re-save MSB +4162+ 2F10 7A ld A,D ; Get NMSB +4163+ 2F11 1F rra ; Shift NMSB right +4164+ 2F12 57 ld D,A ; Re-save NMSB +4165+ 2F13 7B ld A,E ; Get LSB +4166+ 2F14 1F rra ; Shift LSB right +4167+ 2F15 5F ld E,A ; Re-save LSB +4168+ 2F16 78 ld A,B ; Get VLSB +4169+ 2F17 1F rra ; Shift VLSB right +4170+ 2F18 47 ld B,A ; Re-save VLSB +4171+ 2F19 2D dec L ; Count bits multiplied +4172+ 2F1A 7C ld A,H ; Get LSB of multiplier +4173+ 2F1B C2 FD 2E jp NZ,MUL8LP ; More - Do it +4174+ 2F1E E1 POPHRT: pop HL ; Restore address of number +4175+ 2F1F C9 ret +4176+ 2F20 +4177+ 2F20 43 BYTSFT: ld B,E ; Shift partial product left +4178+ 2F21 5A ld E,D +4179+ 2F22 51 ld D,C +4180+ 2F23 4F ld C,A +4181+ 2F24 C9 ret +4182+ 2F25 +4183+ 2F25 +4184+ 2F25 ; WORKING –– +4185+ 2F25 C1 DINT: pop BC ; Get number from stack +4186+ 2F26 D1 pop DE +4187+ 2F27 CD 84 2F call DVBCDE ; get BCDE/FPREG and store result into FPREG +4188+ 2F2A C3 01 31 jp INT ; return INT(FPREG) +4189+ 2F2D +4190+ 2F2D +4191+ 2F2D ; A MODULO B - return remainder of the integer division A/B where: +4192+ 2F2D ; A is in stack; B is in FPREG +4193+ 2F2D ; math is: +4194+ 2F2D ; A=INT(A); B=INT(B); R=A-(B*INT(A/B)) +4195+ 2F2D CD 01 31 MOD: call INT ; B=INT(B) +4196+ 2F30 CD 7A 30 call BCDEFP ; copy B (from FPREG) into BCDE +4197+ 2F33 ED 53 A2 55 ld (TMPBFR3),DE ; store B into... +4198+ 2F37 ED 43 A4 55 ld (TMPBFR4),BC ; ...a temp buffer +4199+ 2F3B C1 pop BC ; recover A... +4200+ 2F3C D1 pop DE ; ...from stack +4201+ 2F3D CD 6F 30 call FPBCDE ; store A into FPREG +4202+ 2F40 CD 01 31 call INT ; get integer part: A=INT(A) +4203+ 2F43 CD 7A 30 call BCDEFP ; copy A (from FPREG) into BCDE +4204+ 2F46 ED 53 9E 55 ld (TMPBFR1),DE ; store A into... +4205+ 2F4A ED 43 A0 55 ld (TMPBFR2),BC ; ...a temp buffer +4206+ 2F4E ; begin calculation +4207+ 2F4E 2A A2 55 ld HL,(TMPBFR3) ; move B... +4208+ 2F51 22 F2 55 ld (FPREG),HL ; ...from... +4209+ 2F54 2A A4 55 ld HL,(TMPBFR4) ; ...temp buffer... +4210+ 2F57 22 F4 55 ld (FPREG+2),HL ; ...into FPREG +4211+ 2F5A CD 84 2F call DVBCDE ; compute A/B and store into FPREG +4212+ 2F5D CD 01 31 call INT ; get integer part of result: now FPREG = INT(A/B) +4213+ 2F60 ED 5B A2 55 ld DE,(TMPBFR3) ; load B... +4214+ 2F64 ED 4B A4 55 ld BC,(TMPBFR4) ; ...into BCDE +4215+ 2F68 CD D2 2E call FPMULT ; get B*INT(A/B) and store into FPREG +4216+ 2F6B ED 5B 9E 55 ld DE,(TMPBFR1) ; retrieve A from... +4217+ 2F6F ED 4B A0 55 ld BC,(TMPBFR2) ; ...temp buffer +4218+ 2F73 C3 94 2D jp SUBCDE ; return result of A-(B*INT(A/B)) +4219+ 2F76 +4220+ 2F76 +4221+ 2F76 CD 5F 30 DIV10: call STAKFP ; Save FPREG on stack +4222+ 2F79 01 20 84 ld BC,$8420 ; BCDE = 10. +4223+ 2F7C 11 00 00 ld DE,$0000 +4224+ 2F7F CD 6F 30 call FPBCDE ; Move 10 to FPREG +4225+ 2F82 +4226+ 2F82 C1 DIV: pop BC ; Get number from stack +4227+ 2F83 D1 pop DE +4228+ 2F84 CD 2E 30 DVBCDE: call TSTSGN ; Test sign of FPREG +4229+ 2F87 CA 4C 18 jp Z,DZERR ; Error if division by zero +4230+ 2F8A 2E FF ld L,-1 ; Flag subtract exponents +4231+ 2F8C CD EC 2F call ADDEXP ; Subtract exponents +4232+ 2F8F 34 inc (HL) ; Add 2 to exponent to adjust +4233+ 2F90 34 inc (HL) +4234+ 2F91 2B dec HL ; Point to MSB +4235+ 2F92 7E ld A,(HL) ; Get MSB of dividend +4236+ 2F93 32 0F 54 ld (DIV3),A ; Save for subtraction +4237+ 2F96 2B dec HL +4238+ 2F97 7E ld A,(HL) ; Get NMSB of dividend +4239+ 2F98 32 0B 54 ld (DIV2),A ; Save for subtraction +4240+ 2F9B 2B dec HL +4241+ 2F9C 7E ld A,(HL) ; Get MSB of dividend +4242+ 2F9D 32 07 54 ld (DIV1),A ; Save for subtraction +4243+ 2FA0 41 ld B,C ; Get MSB +4244+ 2FA1 EB ex DE,HL ; NMSB,LSB to HL +4245+ 2FA2 AF xor A +4246+ 2FA3 4F ld C,A ; Clear MSB of quotient +4247+ 2FA4 57 ld D,A ; Clear NMSB of quotient +4248+ 2FA5 5F ld E,A ; Clear LSB of quotient +4249+ 2FA6 32 12 54 ld (DIV4),A ; Clear overflow count +4250+ 2FA9 E5 DIVLP: push HL ; Save divisor +4251+ 2FAA C5 push BC +4252+ 2FAB 7D ld A,L ; Get LSB of number +4253+ 2FAC CD 06 54 call DIVSUP ; Subt' divisor from dividend +4254+ 2FAF DE 00 sbc A,$00 ; Count for overflows +4255+ 2FB1 3F ccf +4256+ 2FB2 D2 BC 2F jp NC,RESDIV ; Restore divisor if borrow +4257+ 2FB5 32 12 54 ld (DIV4),A ; Re-save overflow count +4258+ 2FB8 F1 pop AF ; Scrap divisor +4259+ 2FB9 F1 pop AF +4260+ 2FBA 37 scf ; Set carry to +4261+ 2FBB D2 defb $D2 ; Skip "pop BC" and "pop HL" +4262+ 2FBC +4263+ 2FBC C1 RESDIV: pop BC ; Restore divisor +4264+ 2FBD E1 pop HL +4265+ 2FBE 79 ld A,C ; Get MSB of quotient +4266+ 2FBF 3C inc A +4267+ 2FC0 3D dec A +4268+ 2FC1 1F rra ; Bit 0 to bit 7 +4269+ 2FC2 FA 1E 2E jp M,RONDB ; Done - Normalise result +4270+ 2FC5 17 rla ; Restore carry +4271+ 2FC6 7B ld A,E ; Get LSB of quotient +4272+ 2FC7 17 rla ; Double it +4273+ 2FC8 5F ld E,A ; Put it back +4274+ 2FC9 7A ld A,D ; Get NMSB of quotient +4275+ 2FCA 17 rla ; Double it +4276+ 2FCB 57 ld D,A ; Put it back +4277+ 2FCC 79 ld A,C ; Get MSB of quotient +4278+ 2FCD 17 rla ; Double it +4279+ 2FCE 4F ld C,A ; Put it back +4280+ 2FCF 29 add HL,HL ; Double NMSB,LSB of divisor +4281+ 2FD0 78 ld A,B ; Get MSB of divisor +4282+ 2FD1 17 rla ; Double it +4283+ 2FD2 47 ld B,A ; Put it back +4284+ 2FD3 3A 12 54 ld A,(DIV4) ; Get VLSB of quotient +4285+ 2FD6 17 rla ; Double it +4286+ 2FD7 32 12 54 ld (DIV4),A ; Put it back +4287+ 2FDA 79 ld A,C ; Get MSB of quotient +4288+ 2FDB B2 or D ; Merge NMSB +4289+ 2FDC B3 or E ; Merge LSB +4290+ 2FDD C2 A9 2F jp NZ,DIVLP ; Not done - Keep dividing +4291+ 2FE0 E5 push HL ; Save divisor +4292+ 2FE1 21 F5 55 ld HL,FPEXP ; Point to exponent +4293+ 2FE4 35 dec (HL) ; Divide by 2 +4294+ 2FE5 E1 pop HL ; Restore divisor +4295+ 2FE6 C2 A9 2F jp NZ,DIVLP ; Ok - Keep going +4296+ 2FE9 C3 58 18 jp OVERR ; Overflow error +4297+ 2FEC +4298+ 2FEC +4299+ 2FEC 78 ADDEXP: ld A,B ; Get exponent of dividend +4300+ 2FED B7 or A ; Test it +4301+ 2FEE CA 10 30 jp Z,OVTST3 ; Zero - Result zero +4302+ 2FF1 7D ld A,L ; Get add/subtract flag +4303+ 2FF2 21 F5 55 ld HL,FPEXP ; Point to exponent +4304+ 2FF5 AE xor (HL) ; Add or subtract it +4305+ 2FF6 80 add A,B ; Add the other exponent +4306+ 2FF7 47 ld B,A ; Save new exponent +4307+ 2FF8 1F rra ; Test exponent for overflow +4308+ 2FF9 A8 xor B +4309+ 2FFA 78 ld A,B ; Get exponent +4310+ 2FFB F2 0F 30 jp P,OVTST2 ; Positive - Test for overflow +4311+ 2FFE C6 80 add A,$80 ; Add excess 128 +4312+ 3000 77 ld (HL),A ; Save new exponent +4313+ 3001 CA 1E 2F jp Z,POPHRT ; Zero - Result zero +4314+ 3004 CD 94 30 call SIGNS ; Set MSBs and sign of result +4315+ 3007 77 ld (HL),A ; Save new exponent +4316+ 3008 2B dec HL ; Point to MSB +4317+ 3009 C9 ret +4318+ 300A +4319+ 300A CD 2E 30 OVTST1: call TSTSGN ; Test sign of FPREG +4320+ 300D 2F cpl ; Invert sign +4321+ 300E E1 pop HL ; Clean up stack +4322+ 300F B7 OVTST2: or A ; Test if new exponent zero +4323+ 3010 E1 OVTST3: pop HL ; Clear off return address +4324+ 3011 F2 FD 2D jp P,RESZER ; Result zero +4325+ 3014 C3 58 18 jp OVERR ; Overflow error +4326+ 3017 +4327+ 3017 CD 7A 30 MLSP10: call BCDEFP ; Move FPREG to BCDE +4328+ 301A 78 ld A,B ; Get exponent +4329+ 301B B7 or A ; Is it zero? +4330+ 301C C8 ret Z ; Yes - Result is zero +4331+ 301D C6 02 add A,$02 ; Multiply by 4 +4332+ 301F DA 58 18 jp C,OVERR ; Overflow - ?OV Error +4333+ 3022 47 ld B,A ; Re-save exponent +4334+ 3023 CD 97 2D call FPADD ; Add BCDE to FPREG (Times 5) +4335+ 3026 21 F5 55 ld HL,FPEXP ; Point to exponent +4336+ 3029 34 inc (HL) ; Double number (Times 10) +4337+ 302A C0 ret NZ ; Ok - Return +4338+ 302B C3 58 18 jp OVERR ; Overflow error +4339+ 302E +4340+ 302E 3A F5 55 TSTSGN: ld A,(FPEXP) ; Get sign of FPREG +4341+ 3031 B7 or A +4342+ 3032 C8 ret Z ; RETurn if number is zero +4343+ 3033 3A F4 55 ld A,(FPREG+2) ; Get MSB of FPREG +4344+ 3036 FE defb 0FEH ; Test sign +4345+ 3037 2F RETREL: cpl ; Invert sign +4346+ 3038 17 rla ; Sign bit to carry +4347+ 3039 9F FLGDIF: sbc A,A ; Carry to all bits of A +4348+ 303A C0 ret NZ ; Return -1 if negative +4349+ 303B 3C inc A ; Bump to +1 +4350+ 303C C9 ret ; Positive - Return +1 +4351+ 303D +4352+ 303D CD 2E 30 SGN: call TSTSGN ; Test sign of FPREG +4353+ 3040 06 88 FLGREL: ld B,$80+8 ; 8 bit integer in exponent +4354+ 3042 11 00 00 ld DE,0 ; Zero NMSB and LSB +4355+ 3045 21 F5 55 RETINT: ld HL,FPEXP ; Point to exponent +4356+ 3048 4F ld C,A ; CDE = MSB,NMSB and LSB +4357+ 3049 70 ld (HL),B ; Save exponent +4358+ 304A 06 00 ld B,0 ; CDE = integer to normalise +4359+ 304C 23 inc HL ; Point to sign of result +4360+ 304D 36 80 ld (HL),$80 ; Set sign of result +4361+ 304F 17 rla ; Carry = sign of integer +4362+ 3050 C3 E5 2D jp CONPOS ; Set sign of result +4363+ 3053 +4364+ 3053 CD 2E 30 ABS_: call TSTSGN ; Test sign of FPREG +4365+ 3056 F0 ret P ; Return if positive +4366+ 3057 21 F4 55 INVSGN: ld HL,FPREG+2 ; Point to MSB +4367+ 305A 7E ld A,(HL) ; Get sign of mantissa +4368+ 305B EE 80 xor $80 ; Invert sign of mantissa +4369+ 305D 77 ld (HL),A ; Re-save sign of mantissa +4370+ 305E C9 ret +4371+ 305F +4372+ 305F EB STAKFP: ex DE,HL ; Save code string address +4373+ 3060 2A F2 55 ld HL,(FPREG) ; LSB,NLSB of FPREG +4374+ 3063 E3 ex (SP),HL ; Stack them,get return +4375+ 3064 E5 push HL ; Re-save return +4376+ 3065 2A F4 55 ld HL,(FPREG+2) ; MSB and exponent of FPREG +4377+ 3068 E3 ex (SP),HL ; Stack them,get return +4378+ 3069 E5 push HL ; Re-save return +4379+ 306A EB ex DE,HL ; Restore code string address +4380+ 306B C9 ret +4381+ 306C +4382+ 306C ; store F.P. number from BCDE into (FPREG) +4383+ 306C CD 7D 30 PHLTFP: call LOADFP ; Number at HL to BCDE +4384+ 306F EB FPBCDE: ex DE,HL ; Save code string address +4385+ 3070 22 F2 55 ld (FPREG),HL ; Save LSB,NLSB of number +4386+ 3073 60 ld H,B ; Exponent of number +4387+ 3074 69 ld L,C ; MSB of number +4388+ 3075 22 F4 55 ld (FPREG+2),HL ; Save MSB and exponent +4389+ 3078 EB ex DE,HL ; Restore code string address +4390+ 3079 C9 ret +4391+ 307A +4392+ 307A ; load F.P. number from (FPREG) into BCDE +4393+ 307A 21 F2 55 BCDEFP: ld HL,FPREG ; Point to FPREG +4394+ 307D 5E LOADFP: ld E,(HL) ; Get LSB of number +4395+ 307E 23 inc HL +4396+ 307F 56 ld D,(HL) ; Get NMSB of number +4397+ 3080 23 inc HL +4398+ 3081 4E ld C,(HL) ; Get MSB of number +4399+ 3082 23 inc HL +4400+ 3083 46 ld B,(HL) ; Get exponent of number +4401+ 3084 23 INCHL: inc HL ; Used for conditional "inc HL" +4402+ 3085 C9 ret +4403+ 3086 +4404+ 3086 ; move floating point from (FPREG) into (HL) +4405+ 3086 11 F2 55 FPTHL: ld DE,FPREG ; Point to FPREG +4406+ 3089 06 04 DETHL4: ld B,$04 ; 4 bytes to move +4407+ 308B 1A DETHLB: ld A,(DE) ; Get source +4408+ 308C 77 ld (HL),A ; Save destination +4409+ 308D 13 inc DE ; Next source +4410+ 308E 23 inc HL ; Next destination +4411+ 308F 05 dec B ; Count bytes +4412+ 3090 C2 8B 30 jp NZ,DETHLB ; Loop if more +4413+ 3093 C9 ret +4414+ 3094 +4415+ 3094 21 F4 55 SIGNS: ld HL,FPREG+2 ; Point to MSB of FPREG +4416+ 3097 7E ld A,(HL) ; Get MSB +4417+ 3098 07 rlca ; Old sign to carry +4418+ 3099 37 scf ; Set MSBit +4419+ 309A 1F rra ; Set MSBit of MSB +4420+ 309B 77 ld (HL),A ; Save new MSB +4421+ 309C 3F ccf ; Complement sign +4422+ 309D 1F rra ; Old sign to carry +4423+ 309E 23 inc HL +4424+ 309F 23 inc HL +4425+ 30A0 77 ld (HL),A ; Set sign of result +4426+ 30A1 79 ld A,C ; Get MSB +4427+ 30A2 07 rlca ; Old sign to carry +4428+ 30A3 37 scf ; Set MSBit +4429+ 30A4 1F rra ; Set MSBit of MSB +4430+ 30A5 4F ld C,A ; Save MSB +4431+ 30A6 1F rra +4432+ 30A7 AE xor (HL) ; New sign of result +4433+ 30A8 C9 ret +4434+ 30A9 +4435+ 30A9 78 CMPNUM: ld A,B ; Get exponent of number +4436+ 30AA B7 or A +4437+ 30AB CA 2E 30 jp Z,TSTSGN ; Zero - Test sign of FPREG +4438+ 30AE 21 37 30 ld HL,RETREL ; Return relation routine +4439+ 30B1 E5 push HL ; Save for return +4440+ 30B2 CD 2E 30 call TSTSGN ; Test sign of FPREG +4441+ 30B5 79 ld A,C ; Get MSB of number +4442+ 30B6 C8 ret Z ; FPREG zero - Number's MSB +4443+ 30B7 21 F4 55 ld HL,FPREG+2 ; MSB of FPREG +4444+ 30BA AE xor (HL) ; Combine signs +4445+ 30BB 79 ld A,C ; Get MSB of number +4446+ 30BC F8 ret M ; Exit if signs different +4447+ 30BD CD C3 30 call CMPFP ; Compare FP numbers +4448+ 30C0 1F rra ; Get carry to sign +4449+ 30C1 A9 xor C ; Combine with MSB of number +4450+ 30C2 C9 ret +4451+ 30C3 +4452+ 30C3 23 CMPFP: inc HL ; Point to exponent +4453+ 30C4 78 ld A,B ; Get exponent +4454+ 30C5 BE cp (HL) ; Compare exponents +4455+ 30C6 C0 ret NZ ; Different +4456+ 30C7 2B dec HL ; Point to MBS +4457+ 30C8 79 ld A,C ; Get MSB +4458+ 30C9 BE cp (HL) ; Compare MSBs +4459+ 30CA C0 ret NZ ; Different +4460+ 30CB 2B dec HL ; Point to NMSB +4461+ 30CC 7A ld A,D ; Get NMSB +4462+ 30CD BE cp (HL) ; Compare NMSBs +4463+ 30CE C0 ret NZ ; Different +4464+ 30CF 2B dec HL ; Point to LSB +4465+ 30D0 7B ld A,E ; Get LSB +4466+ 30D1 96 sub (HL) ; Compare LSBs +4467+ 30D2 C0 ret NZ ; Different +4468+ 30D3 E1 pop HL ; Drop RETurn +4469+ 30D4 E1 pop HL ; Drop another RETurn +4470+ 30D5 C9 ret +4471+ 30D6 +4472+ 30D6 47 FPINT: ld B,A ; <- Move +4473+ 30D7 4F ld C,A ; <- exponent +4474+ 30D8 57 ld D,A ; <- to all +4475+ 30D9 5F ld E,A ; <- bits +4476+ 30DA B7 or A ; Test exponent +4477+ 30DB C8 ret Z ; Zero - Return zero +4478+ 30DC E5 push HL ; Save pointer to number +4479+ 30DD CD 7A 30 call BCDEFP ; Move FPREG to BCDE +4480+ 30E0 CD 94 30 call SIGNS ; Set MSBs & sign of result +4481+ 30E3 AE xor (HL) ; Combine with sign of FPREG +4482+ 30E4 67 ld H,A ; Save combined signs +4483+ 30E5 FC FA 30 call M,DCBCDE ; Negative - Decrement BCDE +4484+ 30E8 3E 98 ld A,$80+24 ; 24 bits +4485+ 30EA 90 sub B ; Bits to shift +4486+ 30EB CD 5C 2E call SCALE ; Shift BCDE +4487+ 30EE 7C ld A,H ; Get combined sign +4488+ 30EF 17 rla ; Sign to carry +4489+ 30F0 DC 2F 2E call C,FPROND ; Negative - Round number up +4490+ 30F3 06 00 ld B,$00 ; Zero exponent +4491+ 30F5 DC 48 2E call C,COMPL ; If negative make positive +4492+ 30F8 E1 pop HL ; Restore pointer to number +4493+ 30F9 C9 ret +4494+ 30FA +4495+ 30FA 1B DCBCDE: dec DE ; Decrement BCDE +4496+ 30FB 7A ld A,D ; Test LSBs +4497+ 30FC A3 and E +4498+ 30FD 3C inc A +4499+ 30FE C0 ret NZ ; Exit if LSBs not FFFF +4500+ 30FF 0B dec BC ; Decrement MSBs +4501+ 3100 C9 ret +4502+ 3101 +4503+ 3101 21 F5 55 INT: ld HL,FPEXP ; Point to exponent +4504+ 3104 7E ld A,(HL) ; Get exponent +4505+ 3105 FE 98 cp $80+24 ; Integer accuracy only? +4506+ 3107 3A F2 55 ld A,(FPREG) ; Get LSB +4507+ 310A D0 ret NC ; Yes - Already integer +4508+ 310B 7E ld A,(HL) ; Get exponent +4509+ 310C CD D6 30 call FPINT ; F.P to integer +4510+ 310F 36 98 ld (HL),$80+24 ; Save 24 bit integer +4511+ 3111 7B ld A,E ; Get LSB of number +4512+ 3112 F5 push AF ; Save LSB +4513+ 3113 79 ld A,C ; Get MSB of number +4514+ 3114 17 rla ; Sign to carry +4515+ 3115 CD E5 2D call CONPOS ; Set sign of result +4516+ 3118 F1 pop AF ; Restore LSB of number +4517+ 3119 C9 ret +4518+ 311A +4519+ 311A 21 00 00 MLDEBC: ld HL,$0000 ; Clear partial product +4520+ 311D 78 ld A,B ; Test multiplier +4521+ 311E B1 or C +4522+ 311F C8 ret Z ; Return zero if zero +4523+ 3120 3E 10 ld A,$10 ; 16 bits +4524+ 3122 29 MLDBLP: add HL,HL ; Shift P.P left +4525+ 3123 DA 48 25 jp C,BSERR ; ?BS Error if overflow +4526+ 3126 EB ex DE,HL +4527+ 3127 29 add HL,HL ; Shift multiplier left +4528+ 3128 EB ex DE,HL +4529+ 3129 D2 30 31 jp NC,NOMLAD ; Bit was zero - No add +4530+ 312C 09 add HL,BC ; Add multiplicand +4531+ 312D DA 48 25 jp C,BSERR ; ?BS Error if overflow +4532+ 3130 3D NOMLAD: dec A ; Count bits +4533+ 3131 C2 22 31 jp NZ,MLDBLP ; More +4534+ 3134 C9 ret +4535+ 3135 +4536+ 3135 FE 2D ASCTFP: cp '-' ; Negative? +4537+ 3137 F5 push AF ; Save it and flags +4538+ 3138 CA 41 31 jp Z,CNVNUM ; Yes - Convert number +4539+ 313B FE 2B cp '+' ; Positive? +4540+ 313D CA 41 31 jp Z,CNVNUM ; Yes - Convert number +4541+ 3140 2B dec HL ; dec 'cos GETCHR INCs +4542+ 3141 CD FD 2D CNVNUM: call RESZER ; Set result to zero +4543+ 3144 47 ld B,A ; Digits after point counter +4544+ 3145 57 ld D,A ; Sign of exponent +4545+ 3146 5F ld E,A ; Exponent of ten +4546+ 3147 2F cpl +4547+ 3148 4F ld C,A ; Before or after point flag +4548+ 3149 CD 90 1D MANLP: call GETCHR ; Get next character +4549+ 314C DA 92 31 jp C,ADDIG ; Digit - Add to number +4550+ 314F FE 2E cp '.' +4551+ 3151 CA 6D 31 jp Z,DPOINT ; '.' - Flag point +4552+ 3154 FE 45 cp 'E' +4553+ 3156 C2 71 31 jp NZ,CONEXP ; Not 'E' - Scale number +4554+ 3159 CD 90 1D call GETCHR ; Get next character +4555+ 315C CD 64 23 call SGNEXP ; Get sign of exponent +4556+ 315F CD 90 1D EXPLP: call GETCHR ; Get next character +4557+ 3162 DA B4 31 jp C,EDIGIT ; Digit - Add to exponent +4558+ 3165 14 inc D ; Is sign negative? +4559+ 3166 C2 71 31 jp NZ,CONEXP ; No - Scale number +4560+ 3169 AF xor A +4561+ 316A 93 sub E ; Negate exponent +4562+ 316B 5F ld E,A ; And re-save it +4563+ 316C 0C inc C ; Flag end of number +4564+ 316D 0C DPOINT: inc C ; Flag point passed +4565+ 316E CA 49 31 jp Z,MANLP ; Zero - Get another digit +4566+ 3171 E5 CONEXP: push HL ; Save code string address +4567+ 3172 7B ld A,E ; Get exponent +4568+ 3173 90 sub B ; Subtract digits after point +4569+ 3174 F4 8A 31 SCALMI: call P,SCALPL ; Positive - Multiply number +4570+ 3177 F2 80 31 jp P,ENDCON ; Positive - All done +4571+ 317A F5 push AF ; Save number of times to /10 +4572+ 317B CD 76 2F call DIV10 ; Divide by 10 +4573+ 317E F1 pop AF ; Restore count +4574+ 317F 3C inc A ; Count divides +4575+ 3180 +4576+ 3180 C2 74 31 ENDCON: jp NZ,SCALMI ; More to do +4577+ 3183 D1 pop DE ; Restore code string address +4578+ 3184 F1 pop AF ; Restore sign of number +4579+ 3185 CC 57 30 call Z,INVSGN ; Negative - Negate number +4580+ 3188 EB ex DE,HL ; Code string address to HL +4581+ 3189 C9 ret +4582+ 318A +4583+ 318A C8 SCALPL: ret Z ; Exit if no scaling needed +4584+ 318B F5 MULTEN: push AF ; Save count +4585+ 318C CD 17 30 call MLSP10 ; Multiply number by 10 +4586+ 318F F1 pop AF ; Restore count +4587+ 3190 3D dec A ; Count multiplies +4588+ 3191 C9 ret +4589+ 3192 +4590+ 3192 D5 ADDIG: push DE ; Save sign of exponent +4591+ 3193 57 ld D,A ; Save digit +4592+ 3194 78 ld A,B ; Get digits after point +4593+ 3195 89 adc A,C ; Add one if after point +4594+ 3196 47 ld B,A ; Re-save counter +4595+ 3197 C5 push BC ; Save point flags +4596+ 3198 E5 push HL ; Save code string address +4597+ 3199 D5 push DE ; Save digit +4598+ 319A CD 17 30 call MLSP10 ; Multiply number by 10 +4599+ 319D F1 pop AF ; Restore digit +4600+ 319E D6 30 sub '0' ; Make it absolute +4601+ 31A0 CD A9 31 call RSCALE ; Re-scale number +4602+ 31A3 E1 pop HL ; Restore code string address +4603+ 31A4 C1 pop BC ; Restore point flags +4604+ 31A5 D1 pop DE ; Restore sign of exponent +4605+ 31A6 C3 49 31 jp MANLP ; Get another digit +4606+ 31A9 +4607+ 31A9 CD 5F 30 RSCALE: call STAKFP ; Put number on stack +4608+ 31AC CD 40 30 call FLGREL ; Digit to add to FPREG +4609+ 31AF C1 PADD: pop BC ; Restore number +4610+ 31B0 D1 pop DE +4611+ 31B1 C3 97 2D jp FPADD ; Add BCDE to FPREG and return +4612+ 31B4 +4613+ 31B4 7B EDIGIT: ld A,E ; Get digit +4614+ 31B5 07 rlca ; Times 2 +4615+ 31B6 07 rlca ; Times 4 +4616+ 31B7 83 add A,E ; Times 5 +4617+ 31B8 07 rlca ; Times 10 +4618+ 31B9 86 add A,(HL) ; Add next digit +4619+ 31BA D6 30 sub '0' ; Make it absolute +4620+ 31BC 5F ld E,A ; Save new digit +4621+ 31BD C3 5F 31 jp EXPLP ; Look for another digit +4622+ 31C0 +4623+ 31C0 E5 LINEIN: push HL ; Save code string address +4624+ 31C1 21 C2 17 ld HL,INMSG ; Output " in " +4625+ 31C4 CD 29 27 call PRS ; Output string at HL +4626+ 31C7 E1 pop HL ; Restore code string address +4627+ 31C8 EB PRNTHL: ex DE,HL ; Code string address to DE +4628+ 31C9 AF xor A +4629+ 31CA 06 98 ld B,$80+24 ; 24 bits +4630+ 31CC CD 45 30 call RETINT ; Return the integer +4631+ 31CF 21 28 27 ld HL,PRNUMS ; Print number string +4632+ 31D2 E5 push HL ; Save for return +4633+ 31D3 ; conmvert FP number into ASCII chars +4634+ 31D3 21 F7 55 NUMASC: ld HL,PBUFF ; Convert number to ASCII +4635+ 31D6 E5 push HL ; Save for return +4636+ 31D7 CD 2E 30 call TSTSGN ; Test sign of FPREG +4637+ 31DA 36 20 ld (HL),SPC ; Space at start +4638+ 31DC F2 E1 31 jp P,SPCFST ; Positive - Space to start +4639+ 31DF 36 2D ld (HL),'-' ; '-' sign at start +4640+ 31E1 23 SPCFST: inc HL ; First byte of number +4641+ 31E2 36 30 ld (HL),'0' ; '0' if zero +4642+ 31E4 CA 97 32 jp Z,JSTZER ; Return '0' if zero +4643+ 31E7 E5 push HL ; Save buffer address +4644+ 31E8 FC 57 30 call M,INVSGN ; Negate FPREG if negative +4645+ 31EB AF xor A ; Zero A +4646+ 31EC F5 push AF ; Save it +4647+ 31ED CD 9D 32 call RNGTST ; Test number is in range +4648+ 31F0 01 43 91 SIXDIG: ld BC,$9143 ; BCDE - 99999.9 +4649+ 31F3 11 F8 4F ld DE,$4FF8 +4650+ 31F6 CD A9 30 call CMPNUM ; Compare numbers +4651+ 31F9 B7 or A +4652+ 31FA E2 0E 32 jp PO,INRNG ; > 99999.9 - Sort it out +4653+ 31FD F1 pop AF ; Restore count +4654+ 31FE CD 8B 31 call MULTEN ; Multiply by ten +4655+ 3201 F5 push AF ; Re-save count +4656+ 3202 C3 F0 31 jp SIXDIG ; Test it again +4657+ 3205 +4658+ 3205 CD 76 2F GTSIXD: call DIV10 ; Divide by 10 +4659+ 3208 F1 pop AF ; Get count +4660+ 3209 3C inc A ; Count divides +4661+ 320A F5 push AF ; Re-save count +4662+ 320B CD 9D 32 call RNGTST ; Test number is in range +4663+ 320E CD 85 2D INRNG: call ROUND ; Add 0.5 to FPREG +4664+ 3211 3C inc A +4665+ 3212 CD D6 30 call FPINT ; F.P to integer +4666+ 3215 CD 6F 30 call FPBCDE ; Move BCDE to FPREG +4667+ 3218 01 06 03 ld BC,$0306 ; 1E+06 to 1E-03 range +4668+ 321B F1 pop AF ; Restore count +4669+ 321C 81 add A,C ; 6 digits before point +4670+ 321D 3C inc A ; Add one +4671+ 321E FA 2A 32 jp M,MAKNUM ; Do it in 'E' form if < 1E-02 +4672+ 3221 FE 08 cp 6+1+1 ; More than 999999 ? +4673+ 3223 D2 2A 32 jp NC,MAKNUM ; Yes - Do it in 'E' form +4674+ 3226 3C inc A ; Adjust for exponent +4675+ 3227 47 ld B,A ; Exponent of number +4676+ 3228 3E 02 ld A,2 ; Make it zero after +4677+ 322A +4678+ 322A 3D MAKNUM: dec A ; Adjust for digits to do +4679+ 322B 3D dec A +4680+ 322C E1 pop HL ; Restore buffer address +4681+ 322D F5 push AF ; Save count +4682+ 322E 11 B0 32 ld DE,POWERS ; Powers of ten +4683+ 3231 05 dec B ; Count digits before point +4684+ 3232 C2 3B 32 jp NZ,DIGTXT ; Not zero - Do number +4685+ 3235 36 2E ld (HL),'.' ; Save point +4686+ 3237 23 inc HL ; Move on +4687+ 3238 36 30 ld (HL),'0' ; Save zero +4688+ 323A 23 inc HL ; Move on +4689+ 323B 05 DIGTXT: dec B ; Count digits before point +4690+ 323C 36 2E ld (HL),'.' ; Save point in case +4691+ 323E CC 84 30 call Z,INCHL ; Last digit - move on +4692+ 3241 C5 push BC ; Save digits before point +4693+ 3242 E5 push HL ; Save buffer address +4694+ 3243 D5 push DE ; Save powers of ten +4695+ 3244 CD 7A 30 call BCDEFP ; Move FPREG to BCDE +4696+ 3247 E1 pop HL ; Powers of ten table +4697+ 3248 06 2F ld B,'0'-1 ; ASCII '0' - 1 +4698+ 324A 04 TRYAGN: inc B ; Count subtractions +4699+ 324B 7B ld A,E ; Get LSB +4700+ 324C 96 sub (HL) ; Subtract LSB +4701+ 324D 5F ld E,A ; Save LSB +4702+ 324E 23 inc HL +4703+ 324F 7A ld A,D ; Get NMSB +4704+ 3250 9E sbc A,(HL) ; Subtract NMSB +4705+ 3251 57 ld D,A ; Save NMSB +4706+ 3252 23 inc HL +4707+ 3253 79 ld A,C ; Get MSB +4708+ 3254 9E sbc A,(HL) ; Subtract MSB +4709+ 3255 4F ld C,A ; Save MSB +4710+ 3256 2B dec HL ; Point back to start +4711+ 3257 2B dec HL +4712+ 3258 D2 4A 32 jp NC,TRYAGN ; No overflow - Try again +4713+ 325B CD 3C 2E call PLUCDE ; Restore number +4714+ 325E 23 inc HL ; Start of next number +4715+ 325F CD 6F 30 call FPBCDE ; Move BCDE to FPREG +4716+ 3262 EB ex DE,HL ; Save point in table +4717+ 3263 E1 pop HL ; Restore buffer address +4718+ 3264 70 ld (HL),B ; Save digit in buffer +4719+ 3265 23 inc HL ; And move on +4720+ 3266 C1 pop BC ; Restore digit count +4721+ 3267 0D dec C ; Count digits +4722+ 3268 C2 3B 32 jp NZ,DIGTXT ; More - Do them +4723+ 326B 05 dec B ; Any decimal part? +4724+ 326C CA 7B 32 jp Z,DOEBIT ; No - Do 'E' bit +4725+ 326F 2B SUPTLZ: dec HL ; Move back through buffer +4726+ 3270 7E ld A,(HL) ; Get character +4727+ 3271 FE 30 cp '0' ; '0' character? +4728+ 3273 CA 6F 32 jp Z,SUPTLZ ; Yes - Look back for more +4729+ 3276 FE 2E cp '.' ; A decimal point? +4730+ 3278 C4 84 30 call NZ,INCHL ; Move back over digit +4731+ 327B +4732+ 327B F1 DOEBIT: pop AF ; Get 'E' flag +4733+ 327C CA 9A 32 jp Z,NOENED ; No 'E' needed - End buffer +4734+ 327F 36 45 ld (HL),'E' ; Put 'E' in buffer +4735+ 3281 23 inc HL ; And move on +4736+ 3282 36 2B ld (HL),'+' ; Put '+' in buffer +4737+ 3284 F2 8B 32 jp P,OUTEXP ; Positive - Output exponent +4738+ 3287 36 2D ld (HL),'-' ; Put '-' in buffer +4739+ 3289 2F cpl ; Negate exponent +4740+ 328A 3C inc A +4741+ 328B 06 2F OUTEXP: ld B,'0'-1 ; ASCII '0' - 1 +4742+ 328D 04 EXPTEN: inc B ; Count subtractions +4743+ 328E D6 0A sub $0A ; Tens digit +4744+ 3290 D2 8D 32 jp NC,EXPTEN ; More to do +4745+ 3293 C6 3A add A,'0'+10 ; Restore and make ASCII +4746+ 3295 23 inc HL ; Move on +4747+ 3296 70 ld (HL),B ; Save MSB of exponent +4748+ 3297 23 JSTZER: inc HL ; +4749+ 3298 77 ld (HL),A ; Save LSB of exponent +4750+ 3299 23 inc HL +4751+ 329A 71 NOENED: ld (HL),C ; Mark end of buffer +4752+ 329B E1 pop HL ; Restore code string address +4753+ 329C C9 ret +4754+ 329D +4755+ 329D 01 74 94 RNGTST: ld BC,$9474 ; BCDE = 999999. +4756+ 32A0 11 F7 23 ld DE,$23F7 +4757+ 32A3 CD A9 30 call CMPNUM ; Compare numbers +4758+ 32A6 B7 or A +4759+ 32A7 E1 pop HL ; Return address to HL +4760+ 32A8 E2 05 32 jp PO,GTSIXD ; Too big - Divide by ten +4761+ 32AB E9 jp (HL) ; Otherwise return to caller +4762+ 32AC +4763+ 32AC 00 00 00 80 HALF: defb $00,$00,$00,$80 ; 0.5 +4764+ 32B0 +4765+ 32B0 A0 86 01 POWERS: defb $A0,$86,$01 ; 100000 +4766+ 32B3 10 27 00 defb $10,$27,$00 ; 10000 +4767+ 32B6 E8 03 00 defb $E8,$03,$00 ; 1000 +4768+ 32B9 64 00 00 defb $64,$00,$00 ; 100 +4769+ 32BC 0A 00 00 defb $0A,$00,$00 ; 10 +4770+ 32BF 01 00 00 defb $01,$00,$00 ; 1 +4771+ 32C2 +4772+ 32C2 21 57 30 NEGAFT: ld HL,INVSGN ; Negate result +4773+ 32C5 E3 ex (SP),HL ; To be done after caller +4774+ 32C6 E9 jp (HL) ; Return to caller +4775+ 32C7 +4776+ 32C7 CD 5F 30 SQR: call STAKFP ; Put value on stack +4777+ 32CA 21 AC 32 ld HL,HALF ; Set power to 1/2 +4778+ 32CD CD 6C 30 call PHLTFP ; Move 1/2 to FPREG +4779+ 32D0 +4780+ 32D0 C1 POWER: pop BC ; Get base +4781+ 32D1 D1 pop DE +4782+ 32D2 CD 2E 30 call TSTSGN ; Test sign of power +4783+ 32D5 78 ld A,B ; Get exponent of base +4784+ 32D6 CA 15 33 jp Z,EXP ; Make result 1 if zero +4785+ 32D9 F2 E0 32 jp P,POWER1 ; Positive base - Ok +4786+ 32DC B7 or A ; Zero to negative power? +4787+ 32DD CA 4C 18 jp Z,DZERR ; Yes - ?/0 Error +4788+ 32E0 B7 POWER1: or A ; Base zero? +4789+ 32E1 CA FE 2D jp Z,SAVEXP ; Yes - Return zero +4790+ 32E4 D5 push DE ; Save base +4791+ 32E5 C5 push BC +4792+ 32E6 79 ld A,C ; Get MSB of base +4793+ 32E7 F6 7F or %01111111 ; Get sign status +4794+ 32E9 CD 7A 30 call BCDEFP ; Move power to BCDE +4795+ 32EC F2 FD 32 jp P,POWER2 ; Positive base - Ok +4796+ 32EF D5 push DE ; Save power +4797+ 32F0 C5 push BC +4798+ 32F1 CD 01 31 call INT ; Get integer of power +4799+ 32F4 C1 pop BC ; Restore power +4800+ 32F5 D1 pop DE +4801+ 32F6 F5 push AF ; MSB of base +4802+ 32F7 CD A9 30 call CMPNUM ; Power an integer? +4803+ 32FA E1 pop HL ; Restore MSB of base +4804+ 32FB 7C ld A,H ; but don't affect flags +4805+ 32FC 1F rra ; Exponent odd or even? +4806+ 32FD E1 POWER2: pop HL ; Restore MSB and exponent +4807+ 32FE 22 F4 55 ld (FPREG+2),HL ; Save base in FPREG +4808+ 3301 E1 pop HL ; LSBs of base +4809+ 3302 22 F2 55 ld (FPREG),HL ; Save in FPREG +4810+ 3305 DC C2 32 call C,NEGAFT ; Odd power - Negate result +4811+ 3308 CC 57 30 call Z,INVSGN ; Negative base - Negate it +4812+ 330B D5 push DE ; Save power +4813+ 330C C5 push BC +4814+ 330D CD 91 2E call LOG ; Get LOG of base +4815+ 3310 C1 pop BC ; Restore power +4816+ 3311 D1 pop DE +4817+ 3312 CD D2 2E call FPMULT ; Multiply LOG by power +4818+ 3315 +4819+ 3315 CD 5F 30 EXP: call STAKFP ; Put value on stack +4820+ 3318 01 38 81 ld BC,$8138 ; BCDE = 1/Ln(2) +4821+ 331B 11 3B AA ld DE,$AA3B +4822+ 331E CD D2 2E call FPMULT ; Multiply value by 1/LN(2) +4823+ 3321 3A F5 55 ld A,(FPEXP) ; Get exponent +4824+ 3324 FE 88 cp $80+8 ; Is it in range? +4825+ 3326 D2 0A 30 jp NC,OVTST1 ; No - Test for overflow +4826+ 3329 CD 01 31 call INT ; Get INT of FPREG +4827+ 332C C6 80 add A,$80 ; For excess 128 +4828+ 332E C6 02 add A,$02 ; Exponent > 126? +4829+ 3330 DA 0A 30 jp C,OVTST1 ; Yes - Test for overflow +4830+ 3333 F5 push AF ; Save scaling factor +4831+ 3334 21 80 2E ld HL,UNITY ; Point to 1. +4832+ 3337 CD 88 2D call ADDPHL ; Add 1 to FPREG +4833+ 333A CD C9 2E call MULLN2 ; Multiply by LN(2) +4834+ 333D F1 pop AF ; Restore scaling factor +4835+ 333E C1 pop BC ; Restore exponent +4836+ 333F D1 pop DE +4837+ 3340 F5 push AF ; Save scaling factor +4838+ 3341 CD 94 2D call SUBCDE ; Subtract exponent from FPREG +4839+ 3344 CD 57 30 call INVSGN ; Negate result +4840+ 3347 21 55 33 ld HL,EXPTAB ; Coefficient table +4841+ 334A CD 85 33 call SMSER1 ; Sum the series +4842+ 334D 11 00 00 ld DE,$0000 ; Zero LSBs +4843+ 3350 C1 pop BC ; Scaling factor +4844+ 3351 4A ld C,D ; Zero MSB +4845+ 3352 C3 D2 2E jp FPMULT ; Scale result to correct value +4846+ 3355 +4847+ 3355 08 EXPTAB: defb $08 ; Table used by EXP +4848+ 3356 40 2E 94 74 defb $40,$2E,$94,$74 ; -1/7! (-1/5040) +4849+ 335A 70 4F 2E 77 defb $70,$4F,$2E,$77 ; 1/6! ( 1/720) +4850+ 335E 6E 02 88 7A defb $6E,$02,$88,$7A ; -1/5! (-1/120) +4851+ 3362 E6 A0 2A 7C defb $E6,$A0,$2A,$7C ; 1/4! ( 1/24) +4852+ 3366 50 AA AA 7E defb $50,$AA,$AA,$7E ; -1/3! (-1/6) +4853+ 336A FF FF 7F 7F defb $FF,$FF,$7F,$7F ; 1/2! ( 1/2) +4854+ 336E 00 00 80 81 defb $00,$00,$80,$81 ; -1/1! (-1/1) +4855+ 3372 00 00 00 81 defb $00,$00,$00,$81 ; 1/0! ( 1/1) +4856+ 3376 +4857+ 3376 CD 5F 30 SUMSER: call STAKFP ; Put FPREG on stack +4858+ 3379 11 D0 2E ld DE,MULT ; Multiply by "X" +4859+ 337C D5 push DE ; To be done after +4860+ 337D E5 push HL ; Save address of table +4861+ 337E CD 7A 30 call BCDEFP ; Move FPREG to BCDE +4862+ 3381 CD D2 2E call FPMULT ; Square the value +4863+ 3384 E1 pop HL ; Restore address of table +4864+ 3385 CD 5F 30 SMSER1: call STAKFP ; Put value on stack +4865+ 3388 7E ld A,(HL) ; Get number of coefficients +4866+ 3389 23 inc HL ; Point to start of table +4867+ 338A CD 6C 30 call PHLTFP ; Move coefficient to FPREG +4868+ 338D 06 defb 06H ; Skip "pop AF" +4869+ 338E F1 SUMLP: pop AF ; Restore count +4870+ 338F C1 pop BC ; Restore number +4871+ 3390 D1 pop DE +4872+ 3391 3D dec A ; Cont coefficients +4873+ 3392 C8 ret Z ; All done +4874+ 3393 D5 push DE ; Save number +4875+ 3394 C5 push BC +4876+ 3395 F5 push AF ; Save count +4877+ 3396 E5 push HL ; Save address in table +4878+ 3397 CD D2 2E call FPMULT ; Multiply FPREG by BCDE +4879+ 339A E1 pop HL ; Restore address in table +4880+ 339B CD 7D 30 call LOADFP ; Number at HL to BCDE +4881+ 339E E5 push HL ; Save address in table +4882+ 339F CD 97 2D call FPADD ; Add coefficient to FPREG +4883+ 33A2 E1 pop HL ; Restore address in table +4884+ 33A3 C3 8E 33 jp SUMLP ; More coefficients +4885+ 33A6 +4886+ 33A6 +4887+ 33A6 ; random number generator +4888+ 33A6 ; a negative argument is used as a seed for the RNG +4889+ 33A6 ; 0 is used to repeat the last random number +4890+ 33A6 ; a positive argument generates a new random number +4891+ 33A6 CD 2E 30 RND: call TSTSGN ; Test sign of FPREG +4892+ 33A9 21 16 54 ld HL,SEED+2 ; Random number seed +4893+ 33AC FA 07 34 jp M,RESEED ; Negative - Re-seed +4894+ 33AF 21 37 54 ld HL,LSTRND ; Last random number +4895+ 33B2 CD 6C 30 call PHLTFP ; Move last RND to FPREG +4896+ 33B5 21 16 54 ld HL,SEED+2 ; Random number seed +4897+ 33B8 C8 ret Z ; Return if RND(0) +4898+ 33B9 86 add A,(HL) ; Add (SEED+2) +4899+ 33BA E6 07 and %00000111 ; 0 to 7 +4900+ 33BC 06 00 ld B,$00 +4901+ 33BE 77 ld (HL),A ; Re-save seed +4902+ 33BF 23 inc HL ; Move to coefficient table +4903+ 33C0 87 add A,A ; 4 bytes +4904+ 33C1 87 add A,A ; per entry +4905+ 33C2 4F ld C,A ; BC = Offset into table +4906+ 33C3 09 add HL,BC ; Point to coefficient +4907+ 33C4 CD 7D 30 call LOADFP ; Coefficient to BCDE +4908+ 33C7 CD D2 2E call FPMULT ; Multiply FPREG by coefficient +4909+ 33CA 3A 15 54 ld A,(SEED+1) ; Get (SEED+1) +4910+ 33CD 3C inc A ; Add 1 +4911+ 33CE E6 03 and %00000011 ; 0 to 3 +4912+ 33D0 06 00 ld B,$00 +4913+ 33D2 FE 01 cp $01 ; Is it zero? +4914+ 33D4 88 adc A,B ; Yes - Make it 1 +4915+ 33D5 32 15 54 ld (SEED+1),A ; Re-save seed +4916+ 33D8 21 0B 34 ld HL,RNDTAB-4 ; Addition table +4917+ 33DB 87 add A,A ; 4 bytes +4918+ 33DC 87 add A,A ; per entry +4919+ 33DD 4F ld C,A ; BC = Offset into table +4920+ 33DE 09 add HL,BC ; Point to value +4921+ 33DF CD 88 2D call ADDPHL ; Add value to FPREG +4922+ 33E2 CD 7A 30 RND1: call BCDEFP ; Move FPREG to BCDE +4923+ 33E5 7B ld A,E ; Get LSB +4924+ 33E6 59 ld E,C ; LSB = MSB +4925+ 33E7 EE 4F xor %01001111 ; Fiddle around +4926+ 33E9 4F ld C,A ; New MSB +4927+ 33EA 36 80 ld (HL),$80 ; Set exponent +4928+ 33EC 2B dec HL ; Point to MSB +4929+ 33ED 46 ld B,(HL) ; Get MSB +4930+ 33EE 36 80 ld (HL),$80 ; Make value -0.5 +4931+ 33F0 21 14 54 ld HL,SEED ; Random number seed +4932+ 33F3 34 inc (HL) ; Count seed +4933+ 33F4 7E ld A,(HL) ; Get seed +4934+ 33F5 D6 AB sub $AB ; Do it modulo 171 +4935+ 33F7 C2 FE 33 jp NZ,RND2 ; Non-zero - Ok +4936+ 33FA 77 ld (HL),A ; Zero seed +4937+ 33FB 0C inc C ; Fillde about +4938+ 33FC 15 dec D ; with the +4939+ 33FD 1C inc E ; number +4940+ 33FE CD E8 2D RND2: call BNORM ; Normalise number +4941+ 3401 21 37 54 ld HL,LSTRND ; Save random number +4942+ 3404 C3 86 30 jp FPTHL ; Move FPREG to last and return +4943+ 3407 +4944+ 3407 77 RESEED: ld (HL),A ; Re-seed random numbers +4945+ 3408 2B dec HL +4946+ 3409 77 ld (HL),A +4947+ 340A 2B dec HL +4948+ 340B 77 ld (HL),A +4949+ 340C C3 E2 33 jp RND1 ; Return RND seed +4950+ 340F +4951+ 340F 68 B1 46 68 RNDTAB: defb $68,$B1,$46,$68 ; Table used by RND +4952+ 3413 99 E9 92 69 defb $99,$E9,$92,$69 +4953+ 3417 10 D1 75 68 defb $10,$D1,$75,$68 +4954+ 341B +4955+ 341B ; COS and SIN functions +4956+ 341B 21 65 34 COS: ld HL,HALFPI ; Point to PI/2 +4957+ 341E CD 88 2D call ADDPHL ; Add it to PPREG +4958+ 3421 CD 5F 30 SIN: call STAKFP ; Put angle on stack +4959+ 3424 01 49 83 ld BC,$8349 ; BCDE = 2 PI +4960+ 3427 11 DB 0F ld DE,$0FDB +4961+ 342A CD 6F 30 call FPBCDE ; Move 2 PI to FPREG +4962+ 342D C1 pop BC ; Restore angle +4963+ 342E D1 pop DE +4964+ 342F CD 84 2F call DVBCDE ; Divide angle by 2 PI +4965+ 3432 CD 5F 30 call STAKFP ; Put it on stack +4966+ 3435 CD 01 31 call INT ; Get INT of result +4967+ 3438 C1 pop BC ; Restore number +4968+ 3439 D1 pop DE +4969+ 343A CD 94 2D call SUBCDE ; Make it 0 <= value < 1 +4970+ 343D 21 69 34 ld HL,QUARTR ; Point to 0.25 +4971+ 3440 CD 8E 2D call SUBPHL ; Subtract value from 0.25 +4972+ 3443 CD 2E 30 call TSTSGN ; Test sign of value +4973+ 3446 37 scf ; Flag positive +4974+ 3447 F2 51 34 jp P,SIN1 ; Positive - Ok +4975+ 344A CD 85 2D call ROUND ; Add 0.5 to value +4976+ 344D CD 2E 30 call TSTSGN ; Test sign of value +4977+ 3450 B7 or A ; Flag negative +4978+ 3451 F5 SIN1: push AF ; Save sign +4979+ 3452 F4 57 30 call P,INVSGN ; Negate value if positive +4980+ 3455 21 69 34 ld HL,QUARTR ; Point to 0.25 +4981+ 3458 CD 88 2D call ADDPHL ; Add 0.25 to value +4982+ 345B F1 pop AF ; Restore sign +4983+ 345C D4 57 30 call NC,INVSGN ; Negative - Make positive +4984+ 345F 21 6D 34 ld HL,SINTAB ; Coefficient table +4985+ 3462 C3 76 33 jp SUMSER ; Evaluate sum of series +4986+ 3465 +4987+ 3465 DB 0F 49 81 HALFPI: defb $DB,$0F,$49,$81 ; 1.5708 (PI/2) +4988+ 3469 +4989+ 3469 00 00 00 7F QUARTR: defb $00,$00,$00,$7F ; 0.25 +4990+ 346D +4991+ 346D 05 SINTAB: defb $05 ; Table used by SIN +4992+ 346E BA D7 1E 86 defb $BA,$D7,$1E,$86 ; 39.711 +4993+ 3472 64 26 99 87 defb $64,$26,$99,$87 ;-76.575 +4994+ 3476 58 34 23 87 defb $58,$34,$23,$87 ; 81.602 +4995+ 347A E0 5D A5 86 defb $E0,$5D,$A5,$86 ;-41.342 +4996+ 347E DA 0F 49 83 defb $DA,$0F,$49,$83 ; 6.2832 +4997+ 3482 +4998+ 3482 CD 5F 30 TAN: call STAKFP ; Put angle on stack +4999+ 3485 CD 21 34 call SIN ; Get SIN of angle +5000+ 3488 C1 pop BC ; Restore angle +5001+ 3489 E1 pop HL +5002+ 348A CD 5F 30 call STAKFP ; Save SIN of angle +5003+ 348D EB ex DE,HL ; BCDE = Angle +5004+ 348E CD 6F 30 call FPBCDE ; Angle to FPREG +5005+ 3491 CD 1B 34 call COS ; Get COS of angle +5006+ 3494 C3 82 2F jp DIV ; TAN = SIN / COS +5007+ 3497 +5008+ 3497 CD 2E 30 ATN: call TSTSGN ; Test sign of value +5009+ 349A FC C2 32 call M,NEGAFT ; Negate result after if -ve +5010+ 349D FC 57 30 call M,INVSGN ; Negate value if -ve +5011+ 34A0 3A F5 55 ld A,(FPEXP) ; Get exponent +5012+ 34A3 FE 81 cp 81H ; Number less than 1? +5013+ 34A5 DA B4 34 jp C,ATN1 ; Yes - Get arc tangnt +5014+ 34A8 01 00 81 ld BC,$8100 ; BCDE = 1 +5015+ 34AB 51 ld D,C +5016+ 34AC 59 ld E,C +5017+ 34AD CD 84 2F call DVBCDE ; Get reciprocal of number +5018+ 34B0 21 8E 2D ld HL,SUBPHL ; Sub angle from PI/2 +5019+ 34B3 E5 push HL ; Save for angle > 1 +5020+ 34B4 21 BE 34 ATN1: ld HL,ATNTAB ; Coefficient table +5021+ 34B7 CD 76 33 call SUMSER ; Evaluate sum of series +5022+ 34BA 21 65 34 ld HL,HALFPI ; PI/2 - angle in case > 1 +5023+ 34BD C9 ret ; Number > 1 - Sub from PI/2 +5024+ 34BE +5025+ 34BE 09 ATNTAB: defb $09 ; Table used by ATN +5026+ 34BF 4A D7 3B 78 defb $4A,$D7,$3B,$78 ; 1/17 +5027+ 34C3 02 6E 84 7B defb $02,$6E,$84,$7B ;-1/15 +5028+ 34C7 FE C1 2F 7C defb $FE,$C1,$2F,$7C ; 1/13 +5029+ 34CB 74 31 9A 7D defb $74,$31,$9A,$7D ;-1/11 +5030+ 34CF 84 3D 5A 7D defb $84,$3D,$5A,$7D ; 1/9 +5031+ 34D3 C8 7F 91 7E defb $C8,$7F,$91,$7E ;-1/7 +5032+ 34D7 E4 BB 4C 7E defb $E4,$BB,$4C,$7E ; 1/5 +5033+ 34DB 6C AA AA 7F defb $6C,$AA,$AA,$7F ;-1/3 +5034+ 34DF 00 00 00 81 defb $00,$00,$00,$81 ; 1/1 +5035+ 34E3 +5036+ 34E3 +5037+ 34E3 D7 GETINP: rst $10 ; input a character +5038+ 34E4 C9 ret +5039+ 34E5 +5040+ 34E5 E5 CLS: push HL +5041+ 34E6 D5 push DE +5042+ 34E7 3A 90 55 ld A,(SCR_MODE) ; check screen mode +5043+ 34EA FE 02 cp $02 ; G2 mode? +5044+ 34EC CC E2 05 call Z,EMPTYVIDBUF ; yes, reset video buffer +5045+ 34EF D1 pop DE +5046+ 34F0 E1 pop HL +5047+ 34F1 3E 0C ld A,CS ; ASCII Clear screen +5048+ 34F3 CD 85 1B call SND2VID ; send to screen +5049+ 34F6 C3 29 41 jp MONOUT ; Output character +5050+ 34F9 +5051+ 34F9 CD A7 2A WIDTH: call GETINT ; Get integer 0-255 +5052+ 34FC 7B ld A,E ; Width to A +5053+ 34FD 32 3E 54 ld (LWIDTH),A ; Set width +5054+ 3500 C9 ret +5055+ 3501 +5056+ 3501 +5057+ 3501 ; read a word (2 bytes) from a couple of RAM locations, in little-endian format +5058+ 3501 ; i.e., the first location is the LSB, while the second one is the MSB +5059+ 3501 CD 46 1E DEEK: call DEINT ; Get integer -32768 to 32767 +5060+ 3504 D5 push DE ; Save number +5061+ 3505 E1 pop HL ; Number to HL +5062+ 3506 46 ld B,(HL) ; Get LSB of contents +5063+ 3507 23 inc HL +5064+ 3508 7E ld A,(HL) ; Get MSB of contents +5065+ 3509 C3 0B 26 jp ABPASS ; Return integer AB +5066+ 350C +5067+ 350C ; write a word (2 bytes) into a couple of RAM locations, in little-endian format +5068+ 350C ; i.e., the LSB will go into the first location, while the MSB into the second one +5069+ 350C CD 21 22 DOKE: call GETNUM ; Get a number +5070+ 350F CD 46 1E call DEINT ; Get integer -32768 to 32767 +5071+ 3512 D5 push DE ; Save address +5072+ 3513 CD 47 1B call CHKSYN ; Make sure ',' follows +5073+ 3516 2C defb ',' +5074+ 3517 CD 21 22 call GETNUM ; Get a number +5075+ 351A CD 46 1E call DEINT ; Get integer -32768 to 32767 +5076+ 351D E3 ex (SP),HL ; Save value,get address +5077+ 351E 73 ld (HL),E ; Save LSB of value +5078+ 351F 23 inc HL +5079+ 3520 72 ld (HL),D ; Save MSB of value +5080+ 3521 E1 pop HL ; Restore code string address +5081+ 3522 C9 ret +5082+ 3523 +5083+ 3523 ; stop the execution of code for a certain bit of time. The pause +5084+ 3523 ; is between $0000 and $FFFF 100ths of a second (0~655.5 secs) +5085+ 3523 CD 21 22 PAUSE: call GETNUM ; Get a number +5086+ 3526 CD 46 1E call DEINT ; Get integer -32768 to 32767 +5087+ 3529 7A ld A,D ; load D into A +5088+ 352A B3 or E ; are D & E equal to $00? +5089+ 352B C8 ret Z ; if yes, then return +5090+ 352C 3A 7E 55 ld A,(TMRCNT) ; Load current value of system timer +5091+ 352F 47 ld B,A ; move it into B +5092+ 3530 CD BB 1D RPTPS: call TSTBRK ; Test for break key +5093+ 3533 3A 7E 55 ld A,(TMRCNT) ; Load current value of system timer +5094+ 3536 B8 cp B ; is it the same value? +5095+ 3537 28 F7 jr Z,RPTPS ; yes, so read again +5096+ 3539 47 ld B,A ; no, so store the new value +5097+ 353A 1B dec DE ; decrement interval +5098+ 353B 7A ld A,D ; load D into A +5099+ 353C B3 or E ; check if DE is equal to 0 (if D & e are $00 then result is 0) +5100+ 353D 20 F1 jr NZ,RPTPS ; no, repeat +5101+ 353F C9 ret +5102+ 3540 +5103+ 3540 ; change the screen mode and set some graphic features. Usage: SCREEN X[,Y][,Z] +5104+ 3540 ; where X is graphic mode: +5105+ 3540 ; 0=text mode (40x24), 1=graphic mode 1 (32x24 chars); 2=graphic mode 2 (256x192 pixels); +5106+ 3540 ; 3=multicolor mode (64x48 pixels); 4=extended graphic mode 2 (32x24 chars mixed between G1 and G2) +5107+ 3540 ; Y is: 0=8x8 sprites, 1=16x16 sprites +5108+ 3540 ; Z is: 0=no sprite magnification; 1=sprite magnification x2 (8x8=>16x16, and 16x16=32x32) +5109+ 3540 ; (the latters are accepted only in graphic modes G1, G2, G3, and G4) +5110+ 3540 AF SCREEN: xor A +5111+ 3541 32 A0 55 ld (TMPBFR2),A ; sprite size & magnif. byte set to 0 +5112+ 3544 CD A7 2A call GETINT ; Get integer 0-255 +5113+ 3547 FE 05 cp $05 ; is it a valid mode (0~4)? +5114+ 3549 D2 5B 1E jp NC,FCERR ; No - Illegal function call Error +5115+ 354C 32 9E 55 ld (TMPBFR1),A ; store graphic mode +5116+ 354F A7 and A ; is it 0 (text mode)? +5117+ 3550 CA 6C 35 jp Z,SCVDP ; yes, ignore other arguments and set mode immediately +5118+ 3553 CD A9 35 call CHKSCAR ; no, check if sprite size follows +5119+ 3556 DA 5E 35 jp C,CKMAGN ; no (set to 0 or missing), so jump over +5120+ 3559 3E 02 ld A,$02 ; no, so set sprite size +5121+ 355B 32 A0 55 ld (TMPBFR2),A ; ...to 16x16 +5122+ 355E CD A9 35 CKMAGN: call CHKSCAR ; check if sprite magnification follows +5123+ 3561 DA 6C 35 jp C,SCVDP ; no (set to 0 or missing), so jump over +5124+ 3564 3A A0 55 ld A,(TMPBFR2) ; yes, so retrieve sprite attributes... +5125+ 3567 F6 01 or $01 ; ...set sprite magnification to 2x... +5126+ 3569 32 A0 55 ld (TMPBFR2),A ; ...and save flags again +5127+ 356C F3 SCVDP: di ; disable INTs +5128+ 356D E5 push HL ; store HL +5129+ 356E 3A 9E 55 ld A,(TMPBFR1) ; recover graphic mode +5130+ 3571 5F ld E,A ; and store it into E +5131+ 3572 3A A0 55 ld A,(TMPBFR2) ; recover sprite flags +5132+ 3575 57 ld D,A ; and store them into D +5133+ 3576 D5 push DE ; store D & E +5134+ 3577 CD D1 03 call initVDP ; initialize VDP with mode pointed by E +5135+ 357A D1 pop DE ; retrieve D & E +5136+ 357B 7B ld A,E ; move graphic mode into A +5137+ 357C 87 add A,A +5138+ 357D 87 add A,A +5139+ 357E 87 add A,A ; multiply A times 8 to get offset of graphic mode +5140+ 357F 5F ld E,A ; and pass it into E +5141+ 3580 D5 push DE ; store sprite flags in E +5142+ 3581 16 00 ld D,$00 ; reset D +5143+ 3583 21 2A 0B ld HL,VDPMODESET+1 ; load address of VDP settings for reg#1 +5144+ 3586 19 add HL,DE ; load correct reg#1 setting +5145+ 3587 D1 pop DE ; retrieve sprite flags from E +5146+ 3588 7E ld A,(HL) ; load reg#1 setting +5147+ 3589 E6 FC and %11111100 ; reset size & magn. bits +5148+ 358B B2 or D ; set size & magn. bits +5149+ 358C 5F ld E,A ; value into E +5150+ 358D 3E 01 ld A,$01 ; reg #1 +5151+ 358F CD BA 06 call WRITE_VREG ; send setting to reg #1 +5152+ 3592 2A 4B 54 ld HL,(LINEAT) ; Get current line number +5153+ 3595 23 inc HL ; -1 means direct statement +5154+ 3596 7C ld A,H +5155+ 3597 B5 or L +5156+ 3598 CC 2D 09 call Z,CURSOR_ON ; enable cursor if not in program mode +5157+ 359B FB ei ; re-enable interrupts +5158+ 359C E1 pop HL ; restore HL +5159+ 359D 3A 8F 55 ld A,(SCR_SIZE_H) ; check the screen mode by looking at the screen height +5160+ 35A0 FE 30 cp $30 ; is it 48 chars or 192 pixels (MC and G2 modes)? +5161+ 35A2 D0 ret NC ; yes, so exit (in graphics 2 and multicolor no print-on-video) +5162+ 35A3 3E 01 ld A,$01 ; no (we are in Text, G1 or ExG2), so activate the... +5163+ 35A5 32 9A 55 ld (PRNTVIDEO),A ; ...video buffer... +5164+ 35A8 C9 ret ; ...and return to caller +5165+ 35A9 +5166+ 35A9 ; check an additional argument for SCREEN - There are 2 ways of working: +5167+ 35A9 ; to check if something follows: Carry is 1 is no argument follows, 0 otherwise +5168+ 35A9 ; to check the value of the following argument: 0 is argument is 1, 1 is argument is <> 1 +5169+ 35A9 2B CHKSCAR:dec HL ; dec 'cos GETCHR INCs +5170+ 35AA CD 90 1D call GETCHR ; Get next character +5171+ 35AD 37 scf ; set carry flag +5172+ 35AE C8 ret Z ; return if nothing follows with Carry=1 +5173+ 35AF CD 47 1B call CHKSYN ; Make sure ',' follows +5174+ 35B2 2C defb ',' +5175+ 35B3 CD A7 2A call GETINT ; get value +5176+ 35B6 1F rra ; Carry=bit #0 +5177+ 35B7 3F ccf ; invert Carry, so Carry=0 if arg. is 1, and Carry=1 otherwise (arg<>1) +5178+ 35B8 C9 ret ; return +5179+ 35B9 +5180+ 35B9 +5181+ 35B9 ; change the colors of the screen - Syntax is COLOR a,b,c where: +5182+ 35B9 ; a=foreground color / b=background color / c=border color +5183+ 35B9 ; a,b,c must be in a range between 1 and 15 (0 is transparent and it's not supported) +5184+ 35B9 ; the number of arguments is based on the current screen mode +5185+ 35B9 CD A7 2A COLOR: call GETINT ; get first value +5186+ 35BC CD 5E 36 call CHKCLR1 ; check if it's in range 1~15 +5187+ 35BF 32 9E 55 ld (TMPBFR1),A ; store it +5188+ 35C2 3A 90 55 ld A,(SCR_MODE) ; check screen mode +5189+ 35C5 FE 03 cp $03 ; is it multicolor mode? +5190+ 35C7 20 0D jr NZ,CNTCKCL ; no, continue +5191+ 35C9 3E 0F ld A,$0F ; white for... +5192+ 35CB 32 9C 55 ld (FRGNDCLR),A ; ...foreground (even it's not used in MC) +5193+ 35CE 3A 9E 55 ld A,(TMPBFR1) ; yes, so we stop here because in MC mode we just support border color +5194+ 35D1 32 A2 55 ld (TMPBFR3),A ; move color into temp buffer 3 +5195+ 35D4 18 30 jr CLRMC ; jump to set color +5196+ 35D6 CD 47 1B CNTCKCL:call CHKSYN ; Make sure ',' follows +5197+ 35D9 2C defb ',' +5198+ 35DA CD A7 2A call GETINT ; get second value +5199+ 35DD CD 5E 36 call CHKCLR1 ; check if it's in range 1~15 +5200+ 35E0 32 A0 55 ld (TMPBFR2),A ; store it +5201+ 35E3 3A 90 55 ld A,(SCR_MODE) ; check screen mode +5202+ 35E6 A7 and A ; is it text mode? +5203+ 35E7 28 1A jr Z,CLRTXT ; yes, stop here because in text mode, background and border colors coincide +5204+ 35E9 CD 47 1B call CHKSYN ; Make sure ',' follows +5205+ 35EC 2C defb ',' +5206+ 35ED CD A7 2A call GETINT ; get third value +5207+ 35F0 CD 5E 36 call CHKCLR1 ; check if it's in range 1~15 +5208+ 35F3 32 A2 55 ld (TMPBFR3),A ; store it +5209+ 35F6 3A 90 55 ld A,(SCR_MODE) ; check screen mode +5210+ 35F9 FE 01 cp $01 ; is it G1 mode? +5211+ 35FB 28 0F jr Z,CLRG1 ; yes, jump over +5212+ 35FD FE 02 cp $02 ; is it G2 mode? +5213+ 35FF 28 14 jr Z,CLRG2 ; yes, jump over +5214+ 3601 18 1B jr CLREX2 ; last case can only be ExG2 +5215+ 3603 CD 51 36 CLRTXT: call MIXCLRS ; mix foreground and background color nibbles in 1 byte +5216+ 3606 32 A2 55 CLRMC: ld (TMPBFR3),A ; store color settings (for MC mode, we only set border color) +5217+ 3609 F3 di ; disable INTs +5218+ 360A 18 2D jr SETBRCL ; set colors and exit +5219+ 360C CD 51 36 CLRG1: call MIXCLRS ; mix foreground and background color nibbles in 1 byte +5220+ 360F 16 01 ld D,$01 ; repeat 1 time +5221+ 3611 06 20 ld B,$20 ; 32 bytes of colors +5222+ 3613 18 10 jr LOADCLR ; load colors +5223+ 3615 CD 51 36 CLRG2: call MIXCLRS ; mix foreground and background color nibbles in 1 byte +5224+ 3618 16 18 ld D,$18 ; 18 pages of... +5225+ 361A 06 00 ld B,$00 ; ...256 bytes each +5226+ 361C 18 07 jr LOADCLR ; load colors +5227+ 361E CD 51 36 CLREX2: call MIXCLRS ; mix foreground and background color nibbles in 1 byte +5228+ 3621 16 08 ld D,$08 ; 8 pages of... +5229+ 3623 06 00 ld B,$00 ; ...256 bytes each +5230+ 3625 E5 LOADCLR:push HL ; store HL +5231+ 3626 21 00 20 ld HL,$2000 ; color table start: $2000 +5232+ 3629 F3 di ; disable INTs +5233+ 362A CD 70 06 call SETVDPADRS +5234+ 362D 0D dec C ; VDP data mode +5235+ 362E ED 79 RPTLDCL:out (C),A ; after first byte, the VDP autoincrements VRAM pointer +5236+ 3630 00 nop +5237+ 3631 00 nop +5238+ 3632 10 FA djnz RPTLDCL ; repeat for 256 bytes (1 page) +5239+ 3634 15 dec D ; did we fill up all the pages? +5240+ 3635 20 F7 jr NZ,RPTLDCL ; no, repeat +5241+ 3637 FB ei +5242+ 3638 E1 pop HL ; retrieve HL +5243+ 3639 3A 9E 55 SETBRCL:ld A,(TMPBFR1) ; retrieve foreground color +5244+ 363C 32 9C 55 ld (FRGNDCLR),A ; store it +5245+ 363F 3A A0 55 ld A,(TMPBFR2) ; retrieve background color +5246+ 3642 32 9D 55 ld (BKGNDCLR),A ; store it +5247+ 3645 3A A2 55 ld A,(TMPBFR3) ; recover border color +5248+ 3648 5F ld E,A ; move it into E +5249+ 3649 3E 07 ld A,$07 ; set VDP register 7 +5250+ 364B F3 di +5251+ 364C CD BA 06 call WRITE_VREG ; send value to VDP: set border color +5252+ 364F FB ei ; re-enable INTs +5253+ 3650 C9 ret ; return to caller +5254+ 3651 +5255+ 3651 +5256+ 3651 ; mix 2 color nibbles in 1 byte +5257+ 3651 3A A0 55 MIXCLRS:ld A,(TMPBFR2) ; retrieve background color +5258+ 3654 47 ld B,A ; move it into B +5259+ 3655 3A 9E 55 ld A,(TMPBFR1) ; retrieve foreground color +5260+ 3658 87 add A,A ; move foreground color into the high nibble of A +5261+ 3659 87 add A,A +5262+ 365A 87 add A,A +5263+ 365B 87 add A,A +5264+ 365C B0 or B ; put background color into the low nibble of A +5265+ 365D C9 ret ; return to caller +5266+ 365E +5267+ 365E +5268+ 365E ; check if the color is not 0 and into the range 1~15 +5269+ 365E A7 CHKCLR1:and A ; is it 0? +5270+ 365F CA 49 18 jp Z,SNERR ; yes, raise a SN error +5271+ 3662 FE 10 CHKCLR0:cp $10 ; is it in range 0~15? +5272+ 3664 D2 49 18 jp NC,SNERR ; no, raise a SN error +5273+ 3667 C9 ret ; param is OK, can return +5274+ 3668 +5275+ 3668 +5276+ 3668 ; check if in graphics 2 mode +5277+ 3668 3A 90 55 CHKG2M: ld A,(SCR_MODE) ; check screen mode +5278+ 366B FE 02 cp $02 ; actually, we can paint only in G2 +5279+ 366D C2 69 3C jp NZ,GMERR ; no G2, print a No Graphics Mode Error +5280+ 3670 C9 ret ; return to caller +5281+ 3671 +5282+ 3671 +5283+ 3671 ; print a text in screen 2 +5284+ 3671 ; GPRINT text,x,y[,fc[,bc]] +5285+ 3671 ; where "text" is an expression that can be converted into a sequence of ASCII chars, +5286+ 3671 ; x & y are the coordinates (0<=x<=31, 0<=y<=23), fc & bc are foreground and background +5287+ 3671 ; colors (1~15), resp. +5288+ 3671 ; (portions of code are from nippur72) +5289+ 3671 GX equ TMPBFR3 +5290+ 3671 GY equ TMPBFR4 +5291+ 3671 TMPCLR equ TMPBFR2 +5292+ 3671 MIXCOL equ TMPBFR1 +5293+ 3671 TMPADR equ VIDEOBUFF +5294+ 3671 CHRPNT equ VIDEOBUFF+$02 +5295+ 3671 NUMCHR equ VIDEOBUFF+$04 +5296+ 3671 TMPHL equ VIDEOBUFF+$06 +5297+ 3671 CD 68 36 GPRINT: call CHKG2M ; check if in graphic mode 2 +5298+ 3674 2B dec HL ; dec 'cos GETCHR INCs +5299+ 3675 CD 90 1D call GETCHR ; check if something follows +5300+ 3678 CA 49 18 jp Z,SNERR ; if nothing else, raise a syntax error +5301+ 367B 22 A6 55 ld (TMPADR),HL ; save current code string pointer +5302+ 367E CD 33 22 call EVAL ; Evaluate expression +5303+ 3681 CD 25 22 call TSTSTR ; Make sure it's a string +5304+ 3684 22 AC 55 ld (TMPHL),HL ; store code string pointer +5305+ 3687 CD 6C 28 call GSTRCU ; Current string to pool +5306+ 368A CD 7D 30 call LOADFP ; Move string block to BCDE (BC=pointer, E=length) +5307+ 368D ED 43 A8 55 ld (CHRPNT),BC ; store string pointer +5308+ 3691 ED 53 AA 55 ld (NUMCHR),DE ; store string lenght +5309+ 3695 2A AC 55 ld HL,(TMPHL) ; restore code string pointer +5310+ 3698 CD 47 1B call CHKSYN ; Make sure ',' follows +5311+ 369B 2C defb ',' +5312+ 369C CD A7 2A call GETINT ; get X coord. +5313+ 369F FE 20 cp $20 ; is it in rage 0~31? +5314+ 36A1 D2 5B 1E jp NC,FCERR ; Illegal function call error +5315+ 36A4 32 A2 55 ld (GX),A ; store into temp. buffer +5316+ 36A7 CD 47 1B call CHKSYN ; Make sure ',' follows +5317+ 36AA 2C defb ',' +5318+ 36AB CD A7 2A call GETINT ; get Y coord. +5319+ 36AE FE 18 cp $18 ; is it in range 0~23? +5320+ 36B0 D2 5B 1E jp NC,FCERR ; Illegal function call error +5321+ 36B3 32 A4 55 ld (GY),A ; store into temp. buffer +5322+ 36B6 11 A0 55 ld DE,TMPCLR +5323+ 36B9 3A 9D 55 ld A,(BKGNDCLR) ; load background color +5324+ 36BC 12 ld (DE),A ; store into temp buff +5325+ 36BD 3A 9C 55 ld A,(FRGNDCLR) ; load foreground color +5326+ 36C0 1B dec DE +5327+ 36C1 1B dec DE +5328+ 36C2 12 ld (DE),A ; store into temp buff +5329+ 36C3 CD 4E 37 call CKCOL ; check color +5330+ 36C6 CA CE 36 jp Z,CNTGPT2 ; if anything follows, jump over +5331+ 36C9 13 inc DE +5332+ 36CA 13 inc DE +5333+ 36CB CD 4E 37 call CKCOL ; check background color +5334+ 36CE CD 51 36 CNTGPT2:call MIXCLRS ; mix foreground & background colors +5335+ 36D1 32 9E 55 ld (MIXCOL),A ; store mixed colors +5336+ 36D4 E5 push HL ; store code string address +5337+ 36D5 ED 4B A8 55 ld BC,(CHRPNT) ; retrieve string pointer +5338+ 36D9 ED 5B AA 55 ld DE,(NUMCHR) ; retrieve string lenght +5339+ 36DD 1C inc E ; Length + 1 +5340+ 36DE CD E3 36 call GPNT ; print on G2 +5341+ 36E1 E1 pop HL ; recover HL +5342+ 36E2 C9 ret ; return to caller +5343+ 36E3 D5 GPNT: push DE ; store string lenght (E) +5344+ 36E4 ; calculate VRAM address of first char +5345+ 36E4 3A A2 55 LD A,(GX) ; load X +5346+ 36E7 6F ld L,A ; +5347+ 36E8 26 00 ld H,0 ; HL = X +5348+ 36EA 29 add HL,HL ; +5349+ 36EB 29 add HL,HL ; +5350+ 36EC 29 add HL,HL ; X=X*8 +5351+ 36ED 3A A4 55 ld A,(GY) ; load Y +5352+ 36F0 57 ld D,A ; move it into D +5353+ 36F1 1E 00 ld E,0 ; DE =Y*256 +5354+ 36F3 19 add HL,DE ; address = X*8 + Y*256 +5355+ 36F4 22 A6 55 ld (TMPADR),HL ; store VRAM address of first VRAM cell +5356+ 36F7 D1 pop DE ; retrieve # of chars to be printed yet (E) +5357+ 36F8 1D RPGPNT: dec E ; Count characters +5358+ 36F9 C8 ret Z ; End of string - return +5359+ 36FA D5 push DE ; store chars counter +5360+ 36FB ; calculate dest address in color vram +5361+ 36FB 2A A6 55 ld HL,(TMPADR) ; recover VRAM address +5362+ 36FE 11 00 20 ld DE,$2000 ; color map address +5363+ 3701 19 add HL,DE ; HL = $2000 + XY address +5364+ 3702 F3 di ; disable INTs +5365+ 3703 ; send color settings +5366+ 3703 CD 70 06 call SETVDPADRS ; set VRAM address for color cell +5367+ 3706 3A 9E 55 ld A,(MIXCOL) ; load color settings +5368+ 3709 06 08 ld B,$08 ; repeat for 8 rows +5369+ 370B 0E 30 ld C,VDP_DAT ; VDP data mode +5370+ 370D ED 79 GPNTCO1:out (C),A ; send data (VRAM pointer auto-increments) +5371+ 370F 00 nop ; wait... +5372+ 3710 00 nop ; ...a... +5373+ 3711 00 nop ; ...while +5374+ 3712 10 F9 djnz GPNTCO1 ; repeat for 8 cells +5375+ 3714 ; calculate source address +5376+ 3714 2A A8 55 ld HL,(CHRPNT) ; load char pointer +5377+ 3717 7E ld A,(HL) ; get char +5378+ 3718 23 inc HL ; increment char pointer +5379+ 3719 22 A8 55 ld (CHRPNT),HL ; store char pointer +5380+ 371C 6F ld L,A ; +5381+ 371D 26 00 ld H,$00 ; char into HL +5382+ 371F 29 add HL,HL ; +5383+ 3720 29 add HL,HL ; +5384+ 3721 29 add HL,HL ; get offset of char into ROM (charcode * 8) +5385+ 3722 11 90 4A ld DE,CHRST88 ; DE = start of 8x8 fonts in ROM +5386+ 3725 19 add HL,DE ; HL = start of characters in ROM +5387+ 3726 EB ex DE,HL ; store address into DE +5388+ 3727 2A A6 55 ld HL,(TMPADR) ; load VRAM address +5389+ 372A CD 70 06 call SETVDPADRS ; send it to VDP +5390+ 372D EB ex DE,HL ; restore address into HL +5391+ 372E 06 08 ld B,$08 ; repeat for 8 rows +5392+ 3730 0D dec C ; VDP data mode +5393+ 3731 ED A3 GPCPCH1:outi ; load a byte from ROM and send to VRAM +5394+ 3733 00 nop ; wait... +5395+ 3734 00 nop ; ...a... +5396+ 3735 00 nop ; ...while +5397+ 3736 20 F9 jr NZ,GPCPCH1 ; repeat for 8 chars +5398+ 3738 FB ei ; re-enable INTs +5399+ 3739 11 08 00 ld DE,$0008 ; 8 bytes to go to the next video cell +5400+ 373C 2A A6 55 ld HL,(TMPADR) ; load VRAM address +5401+ 373F 19 add HL,DE ; get address of next VRAM cell +5402+ 3740 22 A6 55 ld (TMPADR),HL ; store new VRAM address +5403+ 3743 11 00 18 ld DE,$1800 ; forbidden address +5404+ 3746 CD 5A 41 call CMP16 ; check if the printing has gone out of the screen +5405+ 3749 D1 pop DE ; retrieve number of chars to be printed +5406+ 374A D0 ret NC ; if HL>=$1800 then leave +5407+ 374B C3 F8 36 jp RPGPNT ; otherwise, check if more chars to output +5408+ 374E +5409+ 374E ; used by GPRINT to get a color argument (if present) +5410+ 374E 2B CKCOL: dec HL ; dec 'cos GETCHR INCs +5411+ 374F CD 90 1D call GETCHR ; Get next character +5412+ 3752 C8 ret Z ; return if nothing follows +5413+ 3753 CD 47 1B call CHKSYN ; Make sure ',' follows +5414+ 3756 2C defb ',' +5415+ 3757 D5 push DE ; store DE +5416+ 3758 CD A7 2A call GETINT ; get value +5417+ 375B CD 5E 36 call CHKCLR1 ; check if color is in range 1~15 +5418+ 375E D1 pop DE ; retrieve DE +5419+ 375F 12 ld (DE),A ; store color into temp buffer +5420+ 3760 C9 ret ; return to caller +5421+ 3761 +5422+ 3761 +5423+ 3761 ; paint X,Y[,C]: in graphics mode, fills an area starting +5424+ 3761 ; at point X,Y, using default color or, if used, with +5425+ 3761 ; color set by C +5426+ 3761 ; TMPBFR1 X +5427+ 3761 ; TMPBFR2 Y +5428+ 3761 ; TMPBFR3 COLOR +5429+ 3761 PNT equ VIDEOBUFF +5430+ 3761 ORGSP equ VIDEOBUFF+$02 +5431+ 3761 CD 68 36 PAINT: call CHKG2M ; check if in graphic mode 2 +5432+ 3764 CD A7 2A call GETINT ; get X +5433+ 3767 32 9E 55 ld (TMPBFR1),A ; store X +5434+ 376A CD 47 1B call CHKSYN ; Make sure ',' follows +5435+ 376D 2C defb ',' +5436+ 376E CD A7 2A call GETINT ; get Y coords, +5437+ 3771 FE C0 cp $C0 ; check if Y is in range 0~191 +5438+ 3773 D2 5B 1E jp NC,FCERR ; no, raise an FC error +5439+ 3776 32 A0 55 ld (TMPBFR2),A ; store Y +5440+ 3779 CD 50 3C call CLRPRM ; check if color has been passed +5441+ 377C 3A A2 55 ld A,(TMPBFR3) ; load color +5442+ 377F A7 and A ; check if 0 +5443+ 3780 CA 5B 1E jp Z,FCERR ; yes, raise an error +5444+ 3783 E5 push HL ; store HL +5445+ 3784 ; start algorithm +5446+ 3784 CD 95 38 call PNTRTN ; check if pixel is already set +5447+ 3787 C2 3B 38 jp NZ,EXITPA2 ; if yes, then leave PAINT +5448+ 378A ED 73 A8 55 ld (ORGSP),SP ; no, store current Stack Pointer +5449+ 378E 21 01 00 ld HL,$0001 ; HL=1 +5450+ 3791 22 A6 55 ld (PNT),HL ; set PNT +5451+ 3794 3A 9E 55 ld A,(TMPBFR1) ; load starting X... +5452+ 3797 47 ld B,A ; ...into B +5453+ 3798 3A A0 55 ld A,(TMPBFR2) ; load starting Y... +5454+ 379B 4F ld C,A ; ...into C +5455+ 379C C5 push BC ; store starting X,Y into stack +5456+ 379D ; main loop +5457+ 379D 2A A6 55 NXTLOOP:ld HL,(PNT) ; retrieve PNT +5458+ 37A0 7C ld A,H ; check if PNT=0 +5459+ 37A1 B5 or L +5460+ 37A2 CA 37 38 jp Z,EXITPAI ; yes, no more points to process - exit +5461+ 37A5 2B dec HL ; no, so decrement PNT... +5462+ 37A6 22 A6 55 ld (PNT),HL ; ...and store it +5463+ 37A9 C1 pop BC ; retrieve pixel coordinates X,Y into BC +5464+ 37AA CD 3D 38 PAINT0: call CHECKPA ; check if pixel is set/reset +5465+ 37AD 20 09 jr NZ,PAINT11 ; pixel is set, so jump over +5466+ 37AF 78 ld A,B ; pixel is reset, check if X1=0 +5467+ 37B0 A7 and A ; (reached the limit of the screen) +5468+ 37B1 CA B9 37 jp Z,PAINT1 ; yes, jump over +5469+ 37B4 05 dec B ; no, decrement X1... +5470+ 37B5 C3 AA 37 jp PAINT0 ; ...and repeat +5471+ 37B8 04 PAINT11:inc B ; if found a pixel on, the re-increment X1 +5472+ 37B9 AF PAINT1: xor A ; reset A +5473+ 37BA 57 ld D,A ; set SA=0 +5474+ 37BB 5F ld E,A ; set SB=0 +5475+ 37BC CD 3D 38 MNPAINT:call CHECKPA ; check if pixel is set/reset +5476+ 37BF 20 DC jr NZ,NXTLOOP ; it's set, so goto next loop +5477+ 37C1 78 ld A,B ; copy X1 +5478+ 37C2 32 9E 55 ld (TMPBFR1),A ; into buffer +5479+ 37C5 79 ld A,C ; copy Y +5480+ 37C6 32 A0 55 ld (TMPBFR2),A ; into buffer +5481+ 37C9 CD BB 38 call CNTPLOT ; plot pixel X1,Y +5482+ 37CC 7A ld A,D ; load SA into A +5483+ 37CD A7 and A ; SA=0? +5484+ 37CE 20 1C jr NZ,PAINT2 ; no, jump over +5485+ 37D0 79 ld A,C ; load Y +5486+ 37D1 FE 01 cp $01 ; Y>0? +5487+ 37D3 DA EC 37 jp C,PAINT2 ; no, jump over +5488+ 37D6 3D dec A ; yes, Y=Y-1 +5489+ 37D7 CD 3E 38 call CHECKPY ; check pixel X1,Y-1 +5490+ 37DA 20 10 jr NZ,PAINT2 ; it's set, so jump over +5491+ 37DC 0D dec C ; Y=Y-1 +5492+ 37DD C5 push BC ; insert pixel(X1,Y-1) into stack +5493+ 37DE 0C inc C ; retrieve original Y +5494+ 37DF 2A A6 55 ld HL,(PNT) ; load PNT +5495+ 37E2 23 inc HL ; increment PNT +5496+ 37E3 22 A6 55 ld (PNT),HL ; store new PNT +5497+ 37E6 3E 01 ld A,$01 ; set SA=1 and... +5498+ 37E8 57 ld D,A ; ...store SA into memory +5499+ 37E9 C3 FF 37 jp PAINT3 ; jump over +5500+ 37EC 7A PAINT2: ld A,D ; load SA into A +5501+ 37ED 1F rra ; check if SA=1 +5502+ 37EE 30 0F jr NC,PAINT3 ; no, jump over +5503+ 37F0 79 ld A,C ; load Y +5504+ 37F1 FE 01 cp $01 ; Y>0? +5505+ 37F3 DA FF 37 jp C,PAINT3 ; no, jump over +5506+ 37F6 3D dec A ; Y=Y-1 +5507+ 37F7 CD 3E 38 call CHECKPY ; check pixel X1,Y-1 +5508+ 37FA CA FF 37 jp Z,PAINT3 ; if pixel is off, jump over +5509+ 37FD AF xor A ; pixel is on, so... +5510+ 37FE 57 ld D,A ; ...set SA=0 +5511+ 37FF 7B PAINT3: ld A,E ; check if... +5512+ 3800 A7 and A ; SB=0 +5513+ 3801 20 1B jr NZ,PAINT4 ; no, jump over +5514+ 3803 79 ld A,C ; load Y +5515+ 3804 FE BF cp $BF ; Y<191? +5516+ 3806 30 16 jr NC,PAINT4 ; no, jump over +5517+ 3808 3C inc A ; Y=Y+1 +5518+ 3809 CD 3E 38 call CHECKPY ; check pixel X1,Y+1 +5519+ 380C 20 10 jr NZ,PAINT4 ; pixel is on, so jump over +5520+ 380E 0C inc C ; Y=Y+1 +5521+ 380F C5 push BC ; insert pixel(X1,Y+1) into stack +5522+ 3810 0D dec C ; retrieve original Y +5523+ 3811 2A A6 55 ld HL,(PNT) ; PNT +5524+ 3814 23 inc HL ; PNT=PNT+1 +5525+ 3815 22 A6 55 ld (PNT),HL ; store PNT +5526+ 3818 3E 01 ld A,$01 ; SB=1 +5527+ 381A 5F ld E,A ; set SB +5528+ 381B C3 30 38 jp PAINT5 ; jump over +5529+ 381E 7B PAINT4: ld A,E ; load SB +5530+ 381F 1F rra ; check if SB=1 +5531+ 3820 30 0E jr NC,PAINT5 ; no, jump over +5532+ 3822 79 ld A,C ; load Y +5533+ 3823 FE BF cp $BF ; Y<191? +5534+ 3825 30 09 jr NC,PAINT5 ; no, jump over +5535+ 3827 3C inc A ; Y=Y+1 +5536+ 3828 CD 3E 38 call CHECKPY ; check pixel X1,Y+1 +5537+ 382B CA 30 38 jp Z,PAINT5 ; if pixel is off, jump over +5538+ 382E AF xor A ; pixel is on, so... +5539+ 382F 5F ld E,A ; ...set SB=0 +5540+ 3830 04 PAINT5: inc B ; X1=X1+1 +5541+ 3831 CA 9D 37 jp Z,NXTLOOP ; if X1>255 (X1=0) then goto next loop +5542+ 3834 C3 BC 37 jp MNPAINT ; otherwise, repeat for next X +5543+ 3837 ED 7B A8 55 EXITPAI:ld SP,(ORGSP) ; retrieve original SP pointer +5544+ 383B E1 EXITPA2:pop HL ; retrieve HL +5545+ 383C C9 ret ; return to caller +5546+ 383D 79 CHECKPA:ld A,C ; copy Y into A +5547+ 383E 32 A0 55 CHECKPY:ld (TMPBFR2),A ; store Y +5548+ 3841 78 ld A,B ; copy X1 into A +5549+ 3842 32 9E 55 ld (TMPBFR1),A ; store X1 +5550+ 3845 C5 push BC ; save X1,Y +5551+ 3846 D5 push DE +5552+ 3847 CD 95 38 call PNTRTN ; check if pixel is set/reset +5553+ 384A D1 pop DE +5554+ 384B C1 pop BC ; retrieve X1,Y +5555+ 384C C9 ret ; return to caller +5556+ 384D +5557+ 384D +5558+ 384D ; POINT(x,y): return if a pixel is set (returns color) or if it's reset (0) +5559+ 384D CD 68 36 POINT: call CHKG2M ; check if in graphic mode 2 +5560+ 3850 CD 47 1B call CHKSYN ; make sure "(" follows +5561+ 3853 28 defb '(' +5562+ 3854 CD A7 2A call GETINT ; get X coords. +5563+ 3857 32 9E 55 ld (TMPBFR1),A ; store it into a temp buffer +5564+ 385A CD 47 1B call CHKSYN ; Make sure ',' follows +5565+ 385D 2C defb ',' +5566+ 385E CD A7 2A call GETINT ; get Y coords, +5567+ 3861 FE C0 cp $C0 ; check if Y is in range 0~191 +5568+ 3863 D2 5B 1E jp NC,FCERR ; no, raise an FC error +5569+ 3866 32 A0 55 ld (TMPBFR2),A ; store into a temp buffer +5570+ 3869 CD 47 1B call CHKSYN ; make sure ")" follows +5571+ 386C 29 defb ')' +5572+ 386D E5 push HL ; store current string address - the point after the ")" - ... +5573+ 386E FD E1 pop IY ; ...into IY +5574+ 3870 CD 95 38 call PNTRTN ; check if pixel is set or reset +5575+ 3873 20 0C jr NZ,CTPOINT ; it's ON, jump over +5576+ 3875 AF xor A ; no, it's OFF. make sure to reset A... +5577+ 3876 47 ld B,A ; ...and B +5578+ 3877 E1 PNTEND: pop HL ; drop original return point +5579+ 3878 FD E5 push IY ; load current string address from IY into stack +5580+ 387A 11 0C 23 ld DE,RETNUM ; Address of Return number from function... +5581+ 387D D5 push DE ; ...saved on stack +5582+ 387E C3 0B 26 jp ABPASS ; return AB +5583+ 3881 CB EC CTPOINT:set 5,H ; set to read from color VRAM (it's like adding $2000 to HL) +5584+ 3883 F3 di +5585+ 3884 CD 90 06 call READ_VIDEO_LOC ; load original colors of pixel +5586+ 3887 FB ei +5587+ 3888 CB 3F srl A ; shift A... +5588+ 388A CB 3F srl A ; ...4 times... +5589+ 388C CB 3F srl A ; ...to move foreground color... +5590+ 388E CB 3F srl A ; ...into lowest nibble +5591+ 3890 47 ld B,A ; color into B +5592+ 3891 AF xor A ; reset MSB +5593+ 3892 C3 77 38 jp PNTEND ; return AB +5594+ 3895 CD 08 39 PNTRTN: call XY2HL ; find HL address of pixel at X,Y +5595+ 3898 57 ld D,A ; store pixel index +5596+ 3899 F3 di ; disable INTs +5597+ 389A CD 90 06 call READ_VIDEO_LOC ; read contents of VRAM cell addressed by HL +5598+ 389D FB ei ; re-enable INTs +5599+ 389E A2 and D ; is the pixel ON or OFF? (will be checked later) +5600+ 389F C9 ret ; return to caller +5601+ 38A0 +5602+ 38A0 +5603+ 38A0 ; PLOT X,Y[,color] +5604+ 38A0 ; plot a pixel in graphic mode 2 +5605+ 38A0 CD 68 36 PLOT: call CHKG2M ; check if in G2 mode +5606+ 38A3 CD A7 2A call GETINT ; get X coords. +5607+ 38A6 32 9E 55 ld (TMPBFR1),A ; store it into a temp buffer +5608+ 38A9 CD 47 1B call CHKSYN ; Make sure ',' follows +5609+ 38AC 2C defb ',' +5610+ 38AD CD A7 2A call GETINT ; get Y coords, +5611+ 38B0 FE C0 cp $C0 ; check if Y is in range 0~191 +5612+ 38B2 D2 5B 1E jp NC,FCERR ; no, raise an FC error +5613+ 38B5 32 A0 55 ld (TMPBFR2),A ; store into a temp buffer +5614+ 38B8 CD 50 3C call CLRPRM ; check if param "color" has been passed +5615+ 38BB E5 CNTPLOT:push HL ; store HL ** do NOT remove these PUSHs since this +5616+ 38BC C5 push BC ; store BC ** function is called from other routines +5617+ 38BD D5 push DE ; store DE *** +5618+ 38BE CD 08 39 call XY2HL ; find VRAM address of byte containing pixel at X,Y & return into HL +5619+ 38C1 D2 FC 38 jp NC,NOGD ; if carry is reset, there was an error -> so leave +5620+ 38C4 57 ld D,A ; move pixel value into D +5621+ 38C5 3A A2 55 ld A,(TMPBFR3) ; retrieve color +5622+ 38C8 A7 and A ; is it 0? (background, or reset pixel) +5623+ 38C9 20 11 jr NZ,CNTPLT1 ; no, continue +5624+ 38CB F3 di ; yes - so, disable INTs +5625+ 38CC CD 90 06 call READ_VIDEO_LOC ; load original value of VRAM cell pointed by HL +5626+ 38CF FB ei ; re-enable INTs +5627+ 38D0 5F ld E,A ; store value of cell +5628+ 38D1 7A ld A,D ; retrieve pixel +5629+ 38D2 2F cpl ; revert bits +5630+ 38D3 A3 and E ; set video pixel to off +5631+ 38D4 F3 di ; disable INTs +5632+ 38D5 CD A5 06 call WRITE_VIDEO_LOC ; write new value into VRAM cell +5633+ 38D8 FB ei ; re-enable INTs +5634+ 38D9 C3 FC 38 jp NOGD ; leave +5635+ 38DC 87 CNTPLT1:add A,A ; now we move low nibble +5636+ 38DD 87 add A,A ; in the high nibble +5637+ 38DE 87 add A,A ; by adding A to itself +5638+ 38DF 87 add A,A ; 4 times (this is a shift left 4) +5639+ 38E0 5F ld E,A ; move it into E +5640+ 38E1 F3 di ; disable INTs +5641+ 38E2 CD 90 06 call READ_VIDEO_LOC ; load original value of VRAM cell pointed by HL +5642+ 38E5 FB ei +5643+ 38E6 B2 or D ; merge new pixel preserving original pattern +5644+ 38E7 F3 di +5645+ 38E8 CD A5 06 call WRITE_VIDEO_LOC ; write new value into VRAM cell +5646+ 38EB FB ei +5647+ 38EC CB EC set 5,H ; set to read from color VRAM (it's like adding $2000 to HL) +5648+ 38EE F3 di +5649+ 38EF CD 90 06 call READ_VIDEO_LOC ; load original colors of pixel +5650+ 38F2 FB ei +5651+ 38F3 E6 0F and %00001111 ; reset high nibble (the foreground color) +5652+ 38F5 B3 or E ; set new foreground color +5653+ 38F6 F3 di +5654+ 38F7 CD A5 06 call WRITE_VIDEO_LOC ; write new color settings +5655+ 38FA FB ei ; re-enable INTs +5656+ 38FB 00 nop ; wait for INTs to be enabled again +5657+ 38FC D1 NOGD: pop DE ; retrieve DE +5658+ 38FD C1 pop BC ; retrieve BC +5659+ 38FE E1 pop HL ; retrieve HL +5660+ 38FF C9 ret ; return to caller +5661+ 3900 80 40 20 10 PXLSET: defb $80,$40,$20,$10,$08,$04,$02,$01 ; pixel to be set ON +5661+ 3904 08 04 02 01 +5662+ 3908 ; where R(X/8)=> 0=80h, 1=40h, 2=20h, 3=10h, 4=08h, 5=04h, 6=02h, 7=$01 +5663+ 3908 +5664+ 3908 +5665+ 3908 ; compute the VRAM address of the byte containing the pixel +5666+ 3908 ; being pointed by X,Y (TMPBFR1,TMPBFR2) +5667+ 3908 ; byte address is returned into HL +5668+ 3908 ; pixel is returned into A +5669+ 3908 XY2HL: ; formula is: ADDRESS=(INT(X/8))*8 + (INT(Y/8))*256 + R(Y/8) +5670+ 3908 ; where R(Y/8) is the remainder of (Y/8) +5671+ 3908 ; the pixel to be set is given by R(X/8), and data is taken from the array +5672+ 3908 3A A0 55 ld A,(TMPBFR2) ; retrieve Y +5673+ 390B FE C0 cp $C0 ; Y>=192? +5674+ 390D D0 ret NC ; yes, so leave +5675+ 390E 1E 08 ld E,$08 ; load E with divisor +5676+ 3910 57 ld D,A ; and store into D (dividend) +5677+ 3911 CD A5 41 call DIV_8_8 ; get Y/8, D is quotient=INT(Y/8), and A is remainder +5678+ 3914 4F ld C,A ; store remainder into C +5679+ 3915 42 ld B,D ; B=(INT(Y/8))*256 (we simply copy quotient into B) +5680+ 3916 60 69 ld HL,BC ; copy BC into HL: now HL has the VRAM address of the byte being set +5681+ 3918 3A 9E 55 ld A,(TMPBFR1) ; retrieve X +5682+ 391B 57 ld D,A ; and move it into D (dividend) +5683+ 391C CD A5 41 call DIV_8_8 ; get X/8, D is quotient=INT(X/8), and A is remainder +5684+ 391F 4F ld C,A ; store remainder into C +5685+ 3920 7A ld A,D ; move quotient into A +5686+ 3921 87 add A,A ; multiply quotient by 8 +5687+ 3922 87 add A,A +5688+ 3923 87 add A,A +5689+ 3924 5F ld E,A ; store result into E +5690+ 3925 16 00 ld D,$00 ; reset D +5691+ 3927 42 ld B,D ; reset B +5692+ 3928 19 add HL,DE ; add DE to HL, getting the final VRAM address +5693+ 3929 EB ex DE,HL ; move VRAM address into DE +5694+ 392A 21 00 39 ld HL,PXLSET ; starting address of table for pixel to draw +5695+ 392D 09 add HL,BC ; add C (remainder of X/8) to get address of pixel to turn on +5696+ 392E 7E ld A,(HL) ; load pixel data +5697+ 392F EB ex DE,HL ; retrieve VRAM pattern address into HL +5698+ 3930 37 scf ; set Carry for normal exit +5699+ 3931 C9 ret ; return to caller +5700+ 3932 +5701+ 3932 +5702+ 3932 ; DRAW X1,Y1,X2,Y2[,color] +5703+ 3932 ; Draw a line using Bresenham's line algorithm from X1,Y1 to X2,Y2 +5704+ 3932 ; X1,Y1 can be either less than or greater than X2,Y2 (meaning that) +5705+ 3932 ; the drawing will be ever done from X1,Y2 to X2,Y2, regardless of +5706+ 3932 ; the values. If color is not specified, the foreground color set +5707+ 3932 ; with COLOR will be used +5708+ 3932 X1 equ TMPBFR1 +5709+ 3932 Y1 equ TMPBFR2 +5710+ 3932 X2 equ VIDEOBUFF +5711+ 3932 Y2 equ VIDEOBUFF+$02 +5712+ 3932 ER equ VIDEOBUFF+$04 +5713+ 3932 E2 equ VIDEOBUFF+$06 +5714+ 3932 SX equ VIDEOBUFF+$08 +5715+ 3932 SY equ VIDEOBUFF+$0A +5716+ 3932 DX equ VIDEOBUFF+$0C +5717+ 3932 DY equ VIDEOBUFF+$0E +5718+ 3932 CD 68 36 DRAW: call CHKG2M ; check if in G2 mode +5719+ 3935 CD 32 3C call CLRTMBF ; clear TMPBFRx +5720+ 3938 CD 41 3C call CLRVDBF ; clear VIDEOBUFF +5721+ 393B CD A7 2A call GETINT ; get X1 coords. +5722+ 393E 32 9E 55 ld (X1),A ; store it into a temp buffer +5723+ 3941 CD 47 1B call CHKSYN ; Make sure ',' follows +5724+ 3944 2C defb ',' +5725+ 3945 CD A7 2A call GETINT ; get Y1 coords. +5726+ 3948 FE C0 cp $C0 ; check if Y1 is in range 0~191 +5727+ 394A D2 5B 1E jp NC,FCERR ; no, raise an FC error +5728+ 394D 32 A0 55 ld (Y1),A ; store into a temp buffer +5729+ 3950 CD 47 1B call CHKSYN ; Make sure ',' follows +5730+ 3953 2C defb ',' +5731+ 3954 CD A7 2A call GETINT ; get X2 coords. +5732+ 3957 32 A6 55 ld (X2),A ; store it into a temp buffer +5733+ 395A CD 47 1B call CHKSYN ; Make sure ',' follows +5734+ 395D 2C defb ',' +5735+ 395E CD A7 2A call GETINT ; get Y2 coords +5736+ 3961 FE C0 cp $C0 ; check if Y2 is in range 0~191 +5737+ 3963 D2 5B 1E jp NC,FCERR ; no, raise an FC error +5738+ 3966 32 A8 55 ld (Y2),A ; store it into a temp buffer +5739+ 3969 CD 50 3C call CLRPRM ; check for arg. "color" and store it into TMPBFR3 +5740+ 396C E5 push HL ; store register we'll use +5741+ 396D ED 5B 9E 55 ld DE,(X1) ; load X1 and +5742+ 3971 2A A6 55 ld HL,(X2) ; X2 +5743+ 3974 B7 or A ; clear CARRY +5744+ 3975 ED 52 sbc HL,DE ; DX=X2-X1 +5745+ 3977 CD 9B 41 call absHL ; DX=ABS(DX) +5746+ 397A 22 B2 55 ld (DX),HL ; store DX +5747+ 397D 01 FF FF ld BC,$FFFF ; SX=-1 +5748+ 3980 2A 9E 55 ld HL,(X1) +5749+ 3983 ED 5B A6 55 ld DE,(X2) +5750+ 3987 CD 5A 41 call CMP16 ; X1X2 +5753+ 3990 01 01 00 ld BC,$0001 ; yes, so set SX=1 +5754+ 3993 ED 43 AE 55 X1GR: ld (SX),BC ; store SX +5755+ 3997 ED 5B A0 55 ld DE,(Y1) +5756+ 399B 2A A8 55 ld HL,(Y2) +5757+ 399E B7 or A ; clear Carry +5758+ 399F ED 52 sbc HL,DE ; DY=Y2-Y1 +5759+ 39A1 CD 9B 41 call absHL ; DY=ABS(DY) +5760+ 39A4 22 B4 55 ld (DY),HL ; store DY +5761+ 39A7 01 FF FF ld BC,$FFFF ; SY=-1 +5762+ 39AA 2A A0 55 ld HL,(Y1) +5763+ 39AD ED 5B A8 55 ld DE,(Y2) +5764+ 39B1 CD 5A 41 call CMP16 ; is Y1Y2 - jump over +5767+ 39BA 01 01 00 ld BC,$0001 ; yes, so set SY=1 +5768+ 39BD ED 43 B0 55 Y1GR: ld (SY),BC ; store SY +5769+ 39C1 2A B4 55 ld HL,(DY) ; ER=DY +5770+ 39C4 CD 9E 41 call negHL ; ER=-DY +5771+ 39C7 22 AA 55 ld (ER),HL ; store ER +5772+ 39CA 2A B2 55 ld HL,(DX) +5773+ 39CD ED 5B B4 55 ld DE,(DY) +5774+ 39D1 CD 5A 41 call CMP16 ; DX>DY? +5775+ 39D4 CA E0 39 jp Z,ER2 ; no, DX=DY +5776+ 39D7 FA E0 39 jp M,ER2 ; no, DXDY, so ER=DX +5779+ 39E0 2A AA 55 ER2: ld HL,(ER) ; load ER +5780+ 39E3 CB 2C sra H ; right shift (and preserve sign)... +5781+ 39E5 CB 1D rr L ; ...of HL, so ER=INT(ER/2) +5782+ 39E7 CB 7C bit 7,H ; is the number negative? +5783+ 39E9 CA ED 39 jp Z,STRE2 ; no, jump over +5784+ 39EC 23 inc HL ; yes, add 1 'cos INT of a negative number needs to be incremented +5785+ 39ED 22 AA 55 STRE2: ld (ER),HL ; store ER +5786+ 39F0 CD BB 38 RPTDRW: call CNTPLOT ; plot first pixel +5787+ 39F3 2A 9E 55 ld HL,(X1) +5788+ 39F6 ED 5B A6 55 ld DE,(X2) +5789+ 39FA CD 5A 41 call CMP16 ; X1=X2? +5790+ 39FD 20 0D jr NZ,CNTDRW ; no, continue drawing +5791+ 39FF 2A A0 55 ld HL,(Y1) ; yes, so check +5792+ 3A02 ED 5B A8 55 ld DE,(Y2) ; also Y +5793+ 3A06 CD 5A 41 call CMP16 ; Y1=Y2? +5794+ 3A09 CA 65 3A jp Z,ENDDRAW ; yes, finished drawing: exit +5795+ 3A0C ED 5B AA 55 CNTDRW: ld DE,(ER) +5796+ 3A10 ED 53 AC 55 ld (E2),DE ; E2=ER +5797+ 3A14 2A B2 55 ld HL,(DX) +5798+ 3A17 CD 9E 41 call negHL ; DX=-DX +5799+ 3A1A EB ex DE,HL ; invert DE and HL => HL=E2, DE=-DX +5800+ 3A1B CD 5A 41 call CMP16 ; E2>-DX? +5801+ 3A1E CA 3C 3A jp Z,DXGR ; no, E2=-DX: jump +5802+ 3A21 FA 3C 3A jp M,DXGR ; no, E2<-DX: jump +5803+ 3A24 2A AA 55 ld HL,(ER) ; yes +5804+ 3A27 ED 5B B4 55 ld DE,(DY) +5805+ 3A2B B7 or A ; clear CARRY +5806+ 3A2C ED 52 sbc HL,DE ; ER=ER-DY +5807+ 3A2E 22 AA 55 ld (ER),HL +5808+ 3A31 2A 9E 55 ld HL,(X1) +5809+ 3A34 ED 5B AE 55 ld DE,(SX) +5810+ 3A38 19 add HL,DE ; X1=X1+SX (increment X1) +5811+ 3A39 22 9E 55 ld (X1),HL +5812+ 3A3C 2A AC 55 DXGR: ld HL,(E2) +5813+ 3A3F ED 5B B4 55 ld DE,(DY) +5814+ 3A43 CD 5A 41 call CMP16 ; E2DY: jump +5817+ 3A4C 2A AA 55 ld HL,(ER) ; yes +5818+ 3A4F ED 5B B2 55 ld DE,(DX) +5819+ 3A53 19 add HL,DE ; ER=ER+DX +5820+ 3A54 22 AA 55 ld (ER),HL +5821+ 3A57 2A A0 55 ld HL,(Y1) +5822+ 3A5A ED 5B B0 55 ld DE,(SY) +5823+ 3A5E 19 add HL,DE ; Y1=Y1+SY (increment Y1) +5824+ 3A5F 22 A0 55 ld (Y1),HL +5825+ 3A62 C3 F0 39 jp RPTDRW ; repeat +5826+ 3A65 E1 ENDDRAW:pop HL ; retrieve HL +5827+ 3A66 C9 ret ; return to caller +5828+ 3A67 +5829+ 3A67 +5830+ 3A67 ; CIRCLE X,Y,R[,C] +5831+ 3A67 ; Draw a circle using Bresenham's circle algorithm with center in X,Y +5832+ 3A67 ; and radius R, with optional color C. If color is not specified, the +5833+ 3A67 ; foreground color set with COLOR will be used +5834+ 3A67 XC equ VIDEOBUFF +5835+ 3A67 YC equ VIDEOBUFF+$02 +5836+ 3A67 RADIUS equ VIDEOBUFF+$04 +5837+ 3A67 XI equ VIDEOBUFF+$06 +5838+ 3A67 YI equ VIDEOBUFF+$08 +5839+ 3A67 DC equ VIDEOBUFF+$0A +5840+ 3A67 CD 68 36 CIRCLE: call CHKG2M ; check if in G2 mode +5841+ 3A6A CD 41 3C call CLRVDBF ; clear VIDEOBUFF +5842+ 3A6D CD A7 2A call GETINT ; get X coords. +5843+ 3A70 32 A6 55 ld (XC),A ; store it into a temp buffer +5844+ 3A73 CD 47 1B call CHKSYN ; Make sure ',' follows +5845+ 3A76 2C defb ',' +5846+ 3A77 CD A7 2A call GETINT ; get Y coords, +5847+ 3A7A 32 A8 55 ld (YC),A ; store it into a temp buffer +5848+ 3A7D CD 47 1B call CHKSYN ; Make sure ',' follows +5849+ 3A80 2C defb ',' +5850+ 3A81 CD A7 2A call GETINT ; get radius +5851+ 3A84 32 AA 55 ld (RADIUS),A ; store it into a temp buffer +5852+ 3A87 CD 50 3C call CLRPRM ; check if param "color" has been passed +5853+ 3A8A E5 push HL ; store HL +5854+ 3A8B AF xor A ; clear A, +5855+ 3A8C 47 ld B,A ; B, +5856+ 3A8D 4F ld C,A ; C, +5857+ 3A8E 57 ld D,A ; D, +5858+ 3A8F 67 ld H,A ; and H +5859+ 3A90 ED 43 AC 55 ld (XI),BC ; clear XI +5860+ 3A94 3A AA 55 ld A,(RADIUS) ; load RADIUS into A +5861+ 3A97 6F ld L,A ; HL now contains R +5862+ 3A98 22 AE 55 ld (YI),HL ; YI=RADIUS +5863+ 3A9B 29 add HL,HL ; R*2 +5864+ 3A9C EB ex DE,HL ; put HL into DE +5865+ 3A9D 21 03 00 ld HL,$0003 ; HL = 3 +5866+ 3AA0 AF xor A ; clear Carry +5867+ 3AA1 ED 52 sbc HL,DE ; D=3-(2*R) => HL +5868+ 3AA3 22 B0 55 ld (DC),HL ; store D +5869+ 3AA6 CD 03 3B call DRWCRL ; draw initial point +5870+ 3AA9 ED 5B AC 55 RPTCRL: ld DE,(XI) ; load XI +5871+ 3AAD 2A AE 55 ld HL,(YI) ; load YI +5872+ 3AB0 CD 5A 41 call CMP16 ; is YIXI +5875+ 3AB9 C3 01 3B jp ENDCRL ; yes, so we've finished +5876+ 3ABC 21 AC 55 RPTCL1: ld HL,XI +5877+ 3ABF 34 inc (HL) ; XI=XI+1 +5878+ 3AC0 2A B0 55 ld HL,(DC) ; load D +5879+ 3AC3 7C ld A,H +5880+ 3AC4 B5 or L ; is D=0? Yes, jump over +5881+ 3AC5 CA E9 3A jp Z,DLSZ +5882+ 3AC8 CB 7C bit 7,H ; is D<0? +5883+ 3ACA 20 1D jr NZ,DLSZ ; yes, jump over +5884+ 3ACC ED 5B AE 55 ld DE,(YI) ; D>0 +5885+ 3AD0 1B dec DE ; so, YI=YI-1 +5886+ 3AD1 ED 53 AE 55 ld (YI),DE ; store YI +5887+ 3AD5 AF xor A ; clear Carry +5888+ 3AD6 2A AC 55 ld HL,(XI) +5889+ 3AD9 ED 52 sbc HL,DE ; HL=XI-YI +5890+ 3ADB 29 add HL,HL +5891+ 3ADC 29 add HL,HL ; HL=HL*4 +5892+ 3ADD 11 0A 00 ld DE,10 +5893+ 3AE0 19 add HL,DE ; HL=HL+10 +5894+ 3AE1 ED 5B B0 55 ld DE,(DC) ; load D +5895+ 3AE5 EB ex DE,HL ; invert DE and HL, so that HL=4*(XI-YI)+10 and DE=D +5896+ 3AE6 19 add HL,DE ; D=D+4*(XI-YI)+10 +5897+ 3AE7 18 0F jr PLTCRL ; plot next pixel +5898+ 3AE9 2A AC 55 DLSZ: ld HL,(XI) ; load XI +5899+ 3AEC 29 add HL,HL +5900+ 3AED 29 add HL,HL ; XI=XI*4 +5901+ 3AEE 11 06 00 ld DE,$0006 +5902+ 3AF1 19 add HL,DE +5903+ 3AF2 ED 5B B0 55 ld DE,(DC) +5904+ 3AF6 EB ex DE,HL ; HL=D and DE=4*XI+6 +5905+ 3AF7 19 add HL,DE ; D=D+4*XI+6 +5906+ 3AF8 22 B0 55 PLTCRL: ld (DC),HL ; store new D +5907+ 3AFB CD 03 3B call DRWCRL ; plot pixel +5908+ 3AFE C3 A9 3A jp RPTCRL ; repeat +5909+ 3B01 E1 ENDCRL: pop HL +5910+ 3B02 C9 ret ; return to caller +5911+ 3B03 2A A6 55 DRWCRL: ld HL,(XC) +5912+ 3B06 ED 5B AC 55 ld DE,(XI) +5913+ 3B0A 19 add HL,DE ; X=XC+XI +5914+ 3B0B 22 9E 55 ld (X1),HL ; store X +5915+ 3B0E CD 22 3C call VALIDX ; check if X is valid (0~255) +5916+ 3B11 DA 25 3B jp C,CNTCL1 ; if Carry is set, X is not valid +5917+ 3B14 2A A8 55 ld HL,(YC) +5918+ 3B17 ED 5B AE 55 ld DE,(YI) +5919+ 3B1B 19 add HL,DE ; Y=YC+YI +5920+ 3B1C 22 A0 55 ld (Y1),HL ; store Y +5921+ 3B1F CD 27 3C call VALIDY ; check if Y is valid (0~191) +5922+ 3B22 D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +5923+ 3B25 AF CNTCL1: xor A ; clear Carry +5924+ 3B26 2A A6 55 ld HL,(XC) +5925+ 3B29 ED 5B AC 55 ld DE,(XI) +5926+ 3B2D ED 52 sbc HL,DE ; X=XC-XI +5927+ 3B2F 22 9E 55 ld (X1),HL ; store X +5928+ 3B32 CD 22 3C call VALIDX ; check if X is valid (0~255) +5929+ 3B35 DA 49 3B jp C,CNTCL2 ; if Carry is set, X is not valid +5930+ 3B38 2A A8 55 ld HL,(YC) +5931+ 3B3B ED 5B AE 55 ld DE,(YI) +5932+ 3B3F 19 add HL,DE ; Y=YC+YI +5933+ 3B40 22 A0 55 ld (Y1),HL ; store Y +5934+ 3B43 CD 27 3C call VALIDY ; check if Y is valid (0~191) +5935+ 3B46 D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +5936+ 3B49 2A A6 55 CNTCL2: ld HL,(XC) +5937+ 3B4C ED 5B AC 55 ld DE,(XI) +5938+ 3B50 19 add HL,DE ; X=XC+XI +5939+ 3B51 22 9E 55 ld (X1),HL ; store X +5940+ 3B54 CD 22 3C call VALIDX ; check if X is valid (0~255) +5941+ 3B57 DA 6D 3B jp C,CNTCL3 ; if Carry is set, X is not valid +5942+ 3B5A AF xor A ; clear Carry +5943+ 3B5B 2A A8 55 ld HL,(YC) +5944+ 3B5E ED 5B AE 55 ld DE,(YI) +5945+ 3B62 ED 52 sbc HL,DE ; Y=YC-YI +5946+ 3B64 22 A0 55 ld (Y1),HL ; store Y +5947+ 3B67 CD 27 3C call VALIDY ; check if Y is valid (0~191) +5948+ 3B6A D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +5949+ 3B6D AF CNTCL3: xor A ; clear Carry +5950+ 3B6E 2A A6 55 ld HL,(XC) +5951+ 3B71 ED 5B AC 55 ld DE,(XI) +5952+ 3B75 ED 52 sbc HL,DE ; X=XC-XI +5953+ 3B77 22 9E 55 ld (X1),HL ; store X +5954+ 3B7A CD 22 3C call VALIDX ; check if X is valid (0~255) +5955+ 3B7D DA 93 3B jp C,CNTCL4 ; if Carry is set, X is not valid +5956+ 3B80 AF xor A ; clear Carry +5957+ 3B81 2A A8 55 ld HL,(YC) +5958+ 3B84 ED 5B AE 55 ld DE,(YI) +5959+ 3B88 ED 52 sbc HL,DE ; Y=YC-YI +5960+ 3B8A 22 A0 55 ld (Y1),HL ; store Y +5961+ 3B8D CD 27 3C call VALIDY ; check if Y is valid (0~191) +5962+ 3B90 D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +5963+ 3B93 2A A6 55 CNTCL4: ld HL,(XC) +5964+ 3B96 ED 5B AE 55 ld DE,(YI) +5965+ 3B9A 19 add HL,DE ; X=XC+YI +5966+ 3B9B 22 9E 55 ld (X1),HL ; store X +5967+ 3B9E CD 22 3C call VALIDX ; check if X is valid (0~255) +5968+ 3BA1 DA B5 3B jp C,CNTCL5 ; if Carry is set, X is not valid +5969+ 3BA4 2A A8 55 ld HL,(YC) +5970+ 3BA7 ED 5B AC 55 ld DE,(XI) +5971+ 3BAB 19 add HL,DE ; Y=YC+XI +5972+ 3BAC 22 A0 55 ld (Y1),HL ; store Y +5973+ 3BAF CD 27 3C call VALIDY ; check if Y is valid (0~191) +5974+ 3BB2 D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +5975+ 3BB5 AF CNTCL5: xor A ; clear Carry +5976+ 3BB6 2A A6 55 ld HL,(XC) +5977+ 3BB9 ED 5B AE 55 ld DE,(YI) +5978+ 3BBD ED 52 sbc HL,DE ; X=XC-YI +5979+ 3BBF 22 9E 55 ld (X1),HL ; store X +5980+ 3BC2 CD 22 3C call VALIDX ; check if X is valid (0~255) +5981+ 3BC5 DA D9 3B jp C,CNTCL6 ; if Carry is set, X is not valid +5982+ 3BC8 2A A8 55 ld HL,(YC) +5983+ 3BCB ED 5B AC 55 ld DE,(XI) +5984+ 3BCF 19 add HL,DE ; Y=YC+XI +5985+ 3BD0 22 A0 55 ld (Y1),HL ; store Y +5986+ 3BD3 CD 27 3C call VALIDY ; check if Y is valid (0~191) +5987+ 3BD6 D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +5988+ 3BD9 2A A6 55 CNTCL6: ld HL,(XC) +5989+ 3BDC ED 5B AE 55 ld DE,(YI) +5990+ 3BE0 19 add HL,DE ; X=XC+YI +5991+ 3BE1 22 9E 55 ld (X1),HL ; store X +5992+ 3BE4 CD 22 3C call VALIDX ; check if X is valid (0~255) +5993+ 3BE7 DA FD 3B jp C,CNTCL7 ; if Carry is set, X is not valid +5994+ 3BEA AF xor A ; clear Carry +5995+ 3BEB 2A A8 55 ld HL,(YC) +5996+ 3BEE ED 5B AC 55 ld DE,(XI) +5997+ 3BF2 ED 52 sbc HL,DE ; Y=YC-XI +5998+ 3BF4 22 A0 55 ld (Y1),HL ; store Y +5999+ 3BF7 CD 27 3C call VALIDY ; check if Y is valid (0~191) +6000+ 3BFA D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +6001+ 3BFD AF CNTCL7: xor A ; clear Carry +6002+ 3BFE 2A A6 55 ld HL,(XC) +6003+ 3C01 ED 5B AE 55 ld DE,(YI) +6004+ 3C05 ED 52 sbc HL,DE ; X=XC-YI +6005+ 3C07 22 9E 55 ld (X1),HL ; store X +6006+ 3C0A CD 22 3C call VALIDX ; check if X is valid (0~255) +6007+ 3C0D D8 ret C ; if Carry is set, X is not valid +6008+ 3C0E AF xor A ; clear Carry +6009+ 3C0F 2A A8 55 ld HL,(YC) +6010+ 3C12 ED 5B AC 55 ld DE,(XI) +6011+ 3C16 ED 52 sbc HL,DE ; Y=YC-XI +6012+ 3C18 22 A0 55 ld (Y1),HL ; store Y +6013+ 3C1B CD 27 3C call VALIDY ; check if Y is valid (0~191) +6014+ 3C1E D4 BB 38 call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +6015+ 3C21 C9 ret ; return to caller +6016+ 3C22 +6017+ 3C22 ; check if X,Y coordinates are valid: 0<=X<=255 and 0<=Y<=191 +6018+ 3C22 ; input: HL (value to check), can be negative +6019+ 3C22 ; output: CARRY flag: reset => VALID // set => NOT VALID +6020+ 3C22 ; destroys: A +6021+ 3C22 AF VALIDX: xor A ; reset A +6022+ 3C23 B4 or H ; check if H is 0 (this means that X is in range 0~255 and not negative) +6023+ 3C24 C8 ret Z ; yes, we can return (C is clear) +6024+ 3C25 37 scf ; set Carry flag to raise error +6025+ 3C26 C9 ret ; return to caller +6026+ 3C27 +6027+ 3C27 AF VALIDY: xor A ; reset A +6028+ 3C28 B4 or H ; check if H is 0 (this means that Y is in range 0~255 and not negative) +6029+ 3C29 28 02 jr Z,CNTVALY ; yes, continue checking +6030+ 3C2B 37 scf ; no, raise error by setting Carry flag +6031+ 3C2C C9 ret ; return to caller +6032+ 3C2D 7D CNTVALY:ld A,L +6033+ 3C2E FE C0 cp $C0 ; is Y<192? Carry is set if Y<192 +6034+ 3C30 3F ccf ; invert Carry, so Carry=0 means OK, Carry=1 means ERROR +6035+ 3C31 C9 ret ; return to caller +6036+ 3C32 +6037+ 3C32 +6038+ 3C32 +6039+ 3C32 ; cleat TMPBFR1-4 buffers before using them +6040+ 3C32 AF CLRTMBF:xor A ; reset A +6041+ 3C33 E5 push HL ; store HL +6042+ 3C34 C5 push BC ; store BC +6043+ 3C35 21 9E 55 ld HL,TMPBFR1 ; address of 1st location +6044+ 3C38 06 08 ld B,$08 ; 8 locations +6045+ 3C3A 77 RPCLTMB:ld (HL),A ; clear byte +6046+ 3C3B 23 inc HL ; next location +6047+ 3C3C 10 FC djnz RPCLTMB ; repeat +6048+ 3C3E C1 pop BC ; retrieve BC +6049+ 3C3F E1 pop HL ; retrieve HL +6050+ 3C40 C9 ret ; return to caller +6051+ 3C41 +6052+ 3C41 +6053+ 3C41 ; clear VIDEOBUFF before using it as temp buffer +6054+ 3C41 AF CLRVDBF:xor A ; clear A +6055+ 3C42 C5 push BC ; store BC +6056+ 3C43 E5 push HL ; store HL +6057+ 3C44 06 28 ld B,$28 ; 40 cells +6058+ 3C46 21 A6 55 ld HL,VIDEOBUFF ; address of 1st cell +6059+ 3C49 77 RPTCVBF:ld (HL),A ; clear cell +6060+ 3C4A 23 inc HL ; next cell +6061+ 3C4B 10 FC djnz RPTCVBF ; repeat +6062+ 3C4D E1 pop HL ; retrieve HL +6063+ 3C4E C1 pop BC ; retrieve BC +6064+ 3C4F C9 ret ; return to caller +6065+ 3C50 +6066+ 3C50 +6067+ 3C50 ; check if a color is passed as argument with PLOT, DRAW, and CIRCLE +6068+ 3C50 ; commands. If not present, the default foreground color will be used +6069+ 3C50 3A 9C 55 CLRPRM: ld A,(FRGNDCLR) ; load foreground color +6070+ 3C53 32 A2 55 ld (TMPBFR3),A ; store into temp buffer +6071+ 3C56 2B dec HL ; dec 'cos GETCHR INCs +6072+ 3C57 CD 90 1D call GETCHR ; Get next character +6073+ 3C5A C8 ret Z ; return foreground color if nothing follows +6074+ 3C5B CD 47 1B call CHKSYN ; Make sure ',' follows +6075+ 3C5E 2C defb ',' +6076+ 3C5F CD A7 2A call GETINT ; get value +6077+ 3C62 CD 62 36 call CHKCLR0 ; check if color is in range 0~15 +6078+ 3C65 32 A2 55 ld (TMPBFR3),A ; store color into temp buffer +6079+ 3C68 C9 ret ; return to caller +6080+ 3C69 +6081+ 3C69 +6082+ 3C69 ; no graphics mode error: raised when a graphics command is invoked +6083+ 3C69 ; out of graphic 2 mode. +6084+ 3C69 1E 2A GMERR: ld E,GM ; load Graphics Mode Error flag +6085+ 3C6B C3 63 18 jp ERROR ; print error +6086+ 3C6E +6087+ 3C6E +6088+ 3C6E ; set a serial port: params are PORT,BPS,DATA,PARITY,STOP +6089+ 3C6E ; PORT=1/2; BPS=1,200~57,600 (see below), DATA=5/6/7/8 +6090+ 3C6E ; PARITY: 0=no parity; 1=ODD parity; 2=EVEN parity; +6091+ 3C6E ; STOP=0/1/2/3: 0=0 bit; 1=1 bit; 2=1.5 bits; 3=2 bits +6092+ 3C6E ; PORT 1 acts as a char device; PORT 2 acts as a block device +6093+ 3C6E ; DATA,PARITY, and STOP are optional: if nothing follows BPS, +6094+ 3C6E ; they are assumed to be 8,0,1 resp. +6095+ 3C6E PRTNUM equ VIDEOBUFF +6096+ 3C6E BPS equ PRTNUM+$01 +6097+ 3C6E DATABT equ BPS+$02 +6098+ 3C6E PARBT equ DATABT+$01 +6099+ 3C6E STPBT equ PARBT+$01 +6100+ 3C6E SIOBFR equ STPBT+$01 +6101+ 3C6E CD A7 2A SERIAL: call GETINT ; get port # +6102+ 3C71 A7 and A ; is it zero? +6103+ 3C72 CA 5B 1E jp Z,FCERR ; yes, error +6104+ 3C75 FE 03 cp $03 ; is it 1 or 2? +6105+ 3C77 D2 97 3E jp NC,SCERR ; no, error +6106+ 3C7A 32 A6 55 ld (PRTNUM),A ; store port number into a temp buffer +6107+ 3C7D CD 47 1B call CHKSYN ; Make sure ',' follows +6108+ 3C80 2C defb ',' +6109+ 3C81 2B dec HL +6110+ 3C82 CD 90 1D call GETCHR ; check what's following +6111+ 3C85 CA 49 18 jp Z,SNERR ; error if nothing follows +6112+ 3C88 30 05 jr NC,SERVAR ; it's not a number, try a variable +6113+ 3C8A CD 60 1E call ATOH ; get bps (returned into DE) +6114+ 3C8D 18 0F jr CHKZSER ; jump over +6115+ 3C8F CD 21 22 SERVAR: call GETNUM ; get number +6116+ 3C92 CD 2E 30 call TSTSGN ; check value +6117+ 3C95 FA 5B 1E jp M,FCERR ; negative - illegal function call +6118+ 3C98 3A F5 55 ld A,(FPEXP) ; Get integer value to DE +6119+ 3C9B CD D6 30 call FPINT ; get integer number into BCDE - drop BC 'cause isn't necessary +6120+ 3C9E 7A CHKZSER:ld A,D ; bps is into DE - move MSB into A +6121+ 3C9F B3 or E ; check if bps=0 +6122+ 3CA0 20 3A jr NZ,CNTSER ; no, continue checking +6123+ 3CA2 ; if baud rate is 0, then close the serial comm. +6124+ 3CA2 3A A6 55 RSTSERS:ld A,(PRTNUM) ; yes, so reset the channel. First, load port number +6125+ 3CA5 3D dec A ; subtract 1, so that serial channel is 0=>A and 1=>B +6126+ 3CA6 C6 22 add SIO_CA ; find correct channel +6127+ 3CA8 4F ld C,A ; store serial channel +6128+ 3CA9 F3 di ; disable INTs +6129+ 3CAA AF xor A ; reset A +6130+ 3CAB 16 01 ld D,$01 ; start from WR1 +6131+ 3CAD 06 05 ld B,$05 ; 5 registers +6132+ 3CAF ED 51 RPTRSSR:out (C),D ; select register +6133+ 3CB1 ED 79 out (C),A ; reset register +6134+ 3CB3 14 inc D ; next register +6135+ 3CB4 10 F9 djnz RPTRSSR ; repeat +6136+ 3CB6 3E 30 ld A,%00110000 ; write into WR0: error reset, select WR0 +6137+ 3CB8 ED 79 out (C),A ; send command to serial channel +6138+ 3CBA 3E 18 ld A,%00011000 ; write into WR0: channel reset +6139+ 3CBC ED 79 out (C),A ; send command to serial channel +6140+ 3CBE FB ei ; re-enable INTs +6141+ 3CBF E5 push HL ; store HL +6142+ 3CC0 21 E0 55 ld HL,SERIALS_EN ; serials enabled status byte +6143+ 3CC3 DB 01 in A,(PIO_DB) ; read status LEDs +6144+ 3CC5 CB 41 bit 0,C ; check serial port +6145+ 3CC7 20 09 jr NZ,SRPT2 ; if bit is set, jump to port 2 +6146+ 3CC9 CB B7 res 6,A ; it's port 1 +6147+ 3CCB CB A7 res 4,A ; remove possible error LED +6148+ 3CCD CB 86 res 0,(HL) ; disable port 1 +6149+ 3CCF C3 D8 3C jp SERLED ; jump over +6150+ 3CD2 CB BF SRPT2: res 7,A ; it's port 2 +6151+ 3CD4 CB AF res 5,A ; remove possible error LED +6152+ 3CD6 CB 8E res 1,(HL) ; disable port 2 +6153+ 3CD8 D3 01 SERLED: out (PIO_DB),A ; send new configuration +6154+ 3CDA E1 pop HL ; retrieve HL +6155+ 3CDB C9 ret ; return to caller +6156+ 3CDC ; check if bps=1, meaning reactivate RX on serial +6157+ 3CDC 7A CNTSER: ld A,D +6158+ 3CDD B2 or D ; check if bps<>1 by first checking D=0 +6159+ 3CDE 20 36 jr NZ,CNTSER2 ; if not, jump over +6160+ 3CE0 7B ld A,E ; then by checking that +6161+ 3CE1 FE 01 cp $01 ; E=1 +6162+ 3CE3 20 31 jr NZ,CNTSER2 ; if not, jump over +6163+ 3CE5 3A A6 55 ld A,(PRTNUM) ; load port number +6164+ 3CE8 57 ld D,A ; store port on D +6165+ 3CE9 3A E0 55 ld A,(SERIALS_EN) ; load address of serial status cell +6166+ 3CEC A2 and D ; check status +6167+ 3CED CA 97 3E jp Z,SCERR ; port not open, raise error +6168+ 3CF0 F3 di ; disable INTs +6169+ 3CF1 7A ld A,D ; move port # into A +6170+ 3CF2 5F ld E,A ; and also into E +6171+ 3CF3 87 add A +6172+ 3CF4 87 add A ; move A to left times 2 +6173+ 3CF5 57 ld D,A ; move value into D +6174+ 3CF6 3A E0 55 ld A,(SERIALS_EN) ; load serial status byte +6175+ 3CF9 B2 or D ; re-enable RX +6176+ 3CFA 32 E0 55 ld (SERIALS_EN),A ; store new serial status +6177+ 3CFD 7B ld A,E ; recover port # +6178+ 3CFE 3D dec A ; check port +6179+ 3CFF 20 0A jr NZ,CNTRX2 ; port is #2 +6180+ 3D01 CD E3 01 call SIO_A_EI ; re-enable RX on port 1 +6181+ 3D04 DB 01 in A,(PIO_DB) ; load status LEDs +6182+ 3D06 CB A7 res 4,A ; remove error LED +6183+ 3D08 C3 12 3D jp RXEND ; terminate setting +6184+ 3D0B CD EB 01 CNTRX2: call SIO_B_EI ; re-enable RX on port 2 +6185+ 3D0E DB 01 in A,(PIO_DB) ; load status LEDs +6186+ 3D10 CB AF res 5,A ; remove error LED +6187+ 3D12 D3 01 RXEND: out (PIO_DB),A ; set new status for LEDs +6188+ 3D14 FB ei ; re-enable INTs +6189+ 3D15 C9 ret ; return to caller +6190+ 3D16 ; set serial port comm. +6191+ 3D16 D5 CNTSER2:push DE ; store BPS +6192+ 3D17 3A A6 55 ld A,(PRTNUM) ; load port number +6193+ 3D1A 57 ld D,A ; move port # into D +6194+ 3D1B 3A E0 55 ld A,(SERIALS_EN) ; check if serial port is already open +6195+ 3D1E A2 and D ; by ANDing A with D +6196+ 3D1F D1 pop DE ; retrieve BPS +6197+ 3D20 CA 28 3D jp Z,CNTSER3 ; not open, continue +6198+ 3D23 1E 2E ld E,SA ; already open, so raise a "Serial Port Already Error" +6199+ 3D25 C3 63 18 jp ERROR ; and leave +6200+ 3D28 E5 CNTSER3:push HL ; store HL +6201+ 3D29 21 00 E1 ld HL,$E100 ; check bps. start with HL=57,600 +6202+ 3D2C CD 5A 41 call CMP16 ; is bps<=57,600? +6203+ 3D2F E1 pop HL ; but first, recover HL +6204+ 3D30 DA 97 3E jp C,SCERR ; no (bps>57,600) then error +6205+ 3D33 ED 53 A7 55 ld (BPS),DE ; store bps +6206+ 3D37 2B dec HL ; dec 'cos GETCHR INCs +6207+ 3D38 CD 90 1D call GETCHR ; Get next character +6208+ 3D3B CA 73 3D jp Z,DEFSER ; defaults if nothing follows +6209+ 3D3E CD 47 1B call CHKSYN ; Make sure ',' follows +6210+ 3D41 2C defb ',' +6211+ 3D42 CD A7 2A call GETINT ; get data bits +6212+ 3D45 FE 05 cp $05 ; is it <5? +6213+ 3D47 DA 97 3E jp C,SCERR ; yes, error +6214+ 3D4A FE 09 cp $09 ; is it >=9? +6215+ 3D4C D2 5B 1E jp NC,FCERR ; yes, error +6216+ 3D4F 32 A9 55 ld (DATABT),A ; store data bits +6217+ 3D52 CD 47 1B call CHKSYN ; Make sure ',' follows +6218+ 3D55 2C defb ',' +6219+ 3D56 CD A7 2A call GETINT ; get parity bits +6220+ 3D59 BF FE 03 cp A,$03 ; check if parity is in range 0~2 +6221+ 3D5C D2 97 3E jp NC,SCERR ; no, error +6222+ 3D5F 32 AA 55 ld (PARBT),A ; store parity +6223+ 3D62 CD 47 1B call CHKSYN ; Make sure ',' follows +6224+ 3D65 2C defb ',' +6225+ 3D66 CD A7 2A call GETINT ; get stop bits +6226+ 3D69 FE 03 cp $03 ; is it >=3? +6227+ 3D6B D2 97 3E jp NC,SCERR ; yes, error +6228+ 3D6E 32 AB 55 ld (STPBT),A ; store stop bits +6229+ 3D71 18 0D jr SETSER ; jump to set serial +6230+ 3D73 3E 08 DEFSER: ld A,$08 ; 8 bits for data +6231+ 3D75 32 A9 55 ld (DATABT),A +6232+ 3D78 AF xor A ; no parity bit +6233+ 3D79 32 AA 55 ld (PARBT),A +6234+ 3D7C 3C inc A ; 1 bit for stop +6235+ 3D7D 32 AB 55 ld (STPBT),A +6236+ 3D80 ; check if bps are legal +6237+ 3D80 E5 SETSER: push HL ; store HL +6238+ 3D81 D5 push DE ; store DE +6239+ 3D82 DD E5 push IX ; store IX +6240+ 3D84 DD 21 72 3E ld IX,SUP_BPS ; allowed BPSs +6241+ 3D88 06 0B ld B,$0B ; 11 items +6242+ 3D8A 0E 00 ld C,$00 ; reset pointer +6243+ 3D8C 2A A7 55 CKBPS: ld HL,(BPS) ; load BPS +6244+ 3D8F DD 5E 00 ld E,(IX+0) ; load LSB of item +6245+ 3D92 DD 56 01 ld D,(IX+1) ; load MSB of item +6246+ 3D95 CD 5A 41 call CMP16 ; is it equal? +6247+ 3D98 CA A5 3D jp Z,SET_PT ; yes, found a correspondance +6248+ 3D9B DD 23 inc IX +6249+ 3D9D DD 23 inc IX ; no, go to next entry +6250+ 3D9F 0C inc C ; increment pointer +6251+ 3DA0 10 EA djnz CKBPS ; repeat for 10 entries +6252+ 3DA2 C3 93 3E jp SCERR1 ; if nothing found, raise an error +6253+ 3DA5 SET_PT: ;init CTC CH0: CH0 provides RX/TX clock to SIO port A +6254+ 3DA5 ; TO0 output frequency=INPUT CLK/time constant. Time constant is set to get 16 times +6255+ 3DA5 ; the requested baud rate. I.e., if bps is 19,200 then time constast is set to 6 because +6256+ 3DA5 ; 1,843,200/6 = 307,200 Hz (that is 19,200 x 16) +6257+ 3DA5 F3 di ; disable INTs +6258+ 3DA6 06 00 ld B,$00 ; reset B +6259+ 3DA8 21 88 3E ld HL,CTC_CFG ; address of first CTC divider +6260+ 3DAB 09 add HL,BC ; adjust for correct CTC divider +6261+ 3DAC 0E 10 ld C,CTC_CH0 ; CTC channel 0 +6262+ 3DAE 3A A6 55 ld A,(PRTNUM) ; load port number +6263+ 3DB1 1F rra ; is it 1 (Carry=1) or 2 (Carry=0) +6264+ 3DB2 DA B6 3D jp C,SET_CTC ; port 1 => ch. 0, so continue +6265+ 3DB5 0C inc C ; port 2 => ch. 1, increment address port into C +6266+ 3DB6 3E 47 SET_CTC:ld A,%01000111 ; interrupt off, counter mode, prsc=16 (doesn't matter), ext. start, +6267+ 3DB8 ; start upon loading time constant, time constant follows, sw reset, command word +6268+ 3DB8 ED 79 out (C),A ; configure CTC channel +6269+ 3DBA 7E ld A,(HL) ; load CTC divider +6270+ 3DBB ED 79 out (C),A ; send divider +6271+ 3DBD ; configure SIO +6272+ 3DBD 21 36 03 ld HL,SIO_A_SETS ; load default settings for SIO +6273+ 3DC0 11 AC 55 ld DE,SIOBFR ; into a temp buffer +6274+ 3DC3 01 0A 00 ld BC,$000A ; 10 items to copy +6275+ 3DC6 ED B0 ldir ; copy SIO settings into TEMP buffer +6276+ 3DC8 3A B1 55 ld A,(SIOBFR+5) ; load WR5 setting +6277+ 3DCB 47 ld B,A ; move it into B +6278+ 3DCC 3A A9 55 ld A,(DATABT) ; load DATA bits +6279+ 3DCF FE 05 cp $05 ; is it 5 bits? +6280+ 3DD1 20 06 jr NZ,BITS6 ; no, jump over +6281+ 3DD3 CB B0 res 6,B +6282+ 3DD5 CB A8 res 5,B ; set D6 & D5 to 0 +6283+ 3DD7 18 19 jr SETPAR ; jump to set parity +6284+ 3DD9 FE 06 BITS6: cp $06 ; is it 6 bits? +6285+ 3DDB 20 06 jr NZ,BITS7 ; no, jump over +6286+ 3DDD CB F0 set 6,B +6287+ 3DDF CB A8 res 5,B ; set D6 & D5 to 1,0 +6288+ 3DE1 18 0F jr SETPAR ; jump to set parity +6289+ 3DE3 FE 07 BITS7: cp $07 ; is it 7 bits? +6290+ 3DE5 20 07 jr NZ,BITS8 ; no, jump over +6291+ 3DE7 CB B0 res 6,B +6292+ 3DE9 CB E8 set 5,B ; set D6 & D5 to 0,1 +6293+ 3DEB C3 F2 3D jp SETPAR ; jump to set parity +6294+ 3DEE CB F0 BITS8: set 6,B +6295+ 3DF0 CB E8 set 5,B ; set D6 & D5 to 1,1 +6296+ 3DF2 21 E1 55 SETPAR: ld HL,SERABITS ; load address for storing data bits +6297+ 3DF5 3A A6 55 ld A,(PRTNUM) ; check serial port number +6298+ 3DF8 3D dec A ; is it port #1? +6299+ 3DF9 CA FD 3D jp Z,SETPAR2 ; yes, jump over +6300+ 3DFC 23 inc HL ; port #2, use SERBBITS instead +6301+ 3DFD 78 SETPAR2:ld A,B ; retrieve DATA bits +6302+ 3DFE 32 B1 55 ld (SIOBFR+5),A ; save DATA bits +6303+ 3E01 E6 60 and %01100000 ; filter only D5&D6 bits +6304+ 3E03 87 add A,A ; shift left times 1 +6305+ 3E04 77 ld (HL),A ; store for SIO_EI & SIO_DI functions +6306+ 3E05 3A AB 55 ld A,(STPBT) ; load STOP bits +6307+ 3E08 87 add A,A +6308+ 3E09 87 add A,A ; 2 left shifts +6309+ 3E0A 47 ld B,A ; move forming byte into B +6310+ 3E0B 3A AA 55 ld A,(PARBT) ; load PARITY setting +6311+ 3E0E A7 and A ; is it 0? +6312+ 3E0F CA 1A 3E jp Z,STRPAR ; yes, jump over +6313+ 3E12 CB C0 set 0,B ; set PARITY on +6314+ 3E14 3D dec A ; is parity ODD? +6315+ 3E15 CA 1A 3E jp Z,STRPAR ; yes, so jump over +6316+ 3E18 CB C8 set 1,B ; no, it's EVEN so set the corresponding bit +6317+ 3E1A 3A AF 55 STRPAR: ld A,(SIOBFR+3) ; load WR4 setting +6318+ 3E1D E6 F0 and %11110000 ; reset STOP & PARITY bits +6319+ 3E1F B0 or B ; set new STOP & PARITY bits +6320+ 3E20 32 AF 55 ld (SIOBFR+3),A ; store new value +6321+ 3E23 ;set up TX and RX: +6322+ 3E23 ; the followings are settings for channel A +6323+ 3E23 21 AC 55 ld HL,SIOBFR ; settings for SIO ch. A +6324+ 3E26 06 06 ld B,$06 ; 6 bytes to send +6325+ 3E28 0E 22 ld C,SIO_CA ; I/O address of SIO ch.A +6326+ 3E2A 3A A6 55 ld A,(PRTNUM) ; load port number +6327+ 3E2D 1F rra ; is it 1 (Carry=1) or 2 (Carry=0) +6328+ 3E2E DA 32 3E jp C,SRLCNT ; port 1, continue +6329+ 3E31 0C inc C ; port 2, increment address port into C +6330+ 3E32 ED B3 SRLCNT: otir ; send bytes to SIO +6331+ 3E34 ; the following are settings for channel B (don't need to load HL since settings are contigous) +6332+ 3E34 06 04 ld B,$04 ; other 4 bytes to send +6333+ 3E36 51 ld D,C ; store port address into D +6334+ 3E37 0E 23 ld C,SIO_CB ; I/O address of SIO ch.B +6335+ 3E39 ED B3 otir ; send bytes to SIO +6336+ 3E3B ; the following are settings for selected channel +6337+ 3E3B 3E 01 ld A,$01 ; write into WR0: select WR1 +6338+ 3E3D 4A ld C,D ; retrieve port address +6339+ 3E3E ED 79 out (C),A +6340+ 3E40 3E 18 ld A,%00011000 ; interrupts on every RX char; parity is no special condition; +6341+ 3E42 ; buffer overrun is special condition +6342+ 3E42 ED 79 out (C),A +6343+ 3E44 21 E0 55 ld HL,SERIALS_EN +6344+ 3E47 3A A6 55 ld A,(PRTNUM) ; retrieve serial channel +6345+ 3E4A 3D dec A ; channel A? +6346+ 3E4B 20 10 jr NZ,ENCHB ; no, jump over +6347+ 3E4D CD E3 01 call SIO_A_EI ; enable RX on SIO channel A +6348+ 3E50 CB C6 set 0,(HL) ; set serial port 1 status ON +6349+ 3E52 CB D6 set 2,(HL) ; set serial port 1 RX ON +6350+ 3E54 ; back to normal running +6351+ 3E54 FB ei ; re-enable INTs +6352+ 3E55 DB 01 in A,(PIO_DB) ; load status LEDs +6353+ 3E57 CB F7 set 6,A ; set status LED on +6354+ 3E59 CB A7 res 4,A ; set error LED off +6355+ 3E5B 18 0E jr EXNRM ; leave +6356+ 3E5D CD EB 01 ENCHB: call SIO_B_EI ; enable RX on SIO channel B +6357+ 3E60 CB CE set 1,(HL) ; set serial port 2 status ON +6358+ 3E62 CB DE set 3,(HL) ; set serial port 2 RX ON +6359+ 3E64 ; back to normal running +6360+ 3E64 FB ei ; re-enable INTs +6361+ 3E65 DB 01 in A,(PIO_DB) ; load status LEDs +6362+ 3E67 CB FF set 7,A ; set status LED on +6363+ 3E69 CB AF res 5,A ; set error LED off +6364+ 3E6B D3 01 EXNRM: out (PIO_DB),A ; send new configuration +6365+ 3E6D DD E1 pop IX ; retrieve IX +6366+ 3E6F D1 pop DE ; retrieve DE +6367+ 3E70 E1 pop HL ; retrieve HL +6368+ 3E71 C9 ret ; return to caller +6369+ 3E72 +6370+ 3E72 ; allowed bps (Bauds per second) +6371+ 3E72 00 E1 00 96 SUP_BPS:defw 57600,38400,28800,19200,14400,9600,4800,3600,2400,1200,600 +6371+ 3E76 80 70 00 4B +6371+ 3E7A 40 38 80 25 +6371+ 3E7E C0 12 10 0E +6371+ 3E82 60 09 B0 04 +6371+ 3E86 58 02 +6372+ 3E88 ; corresponding CTC divider +6373+ 3E88 02 03 04 06 CTC_CFG:defb 2,3,4,6,8,12,24,32,48,96,192 +6373+ 3E8C 08 0C 18 20 +6373+ 3E90 30 60 C0 +6374+ 3E93 +6375+ 3E93 +6376+ 3E93 ; serial configuration error +6377+ 3E93 DD E1 SCERR1: pop IX ; retrieve IX +6378+ 3E95 D1 pop DE ; retrieve DE +6379+ 3E96 E1 pop HL ; retrieve HL +6380+ 3E97 1E 2C SCERR: ld E,SC ; Serial Configuration Error +6381+ 3E99 C3 63 18 jp ERROR ; print error +6382+ 3E9C +6383+ 3E9C +6384+ 3E9C ; serial buffer overrun +6385+ 3E9C CD 5D 20 SOERR: call PRNTCRLF +6386+ 3E9F 1E 30 ld E,SO ; Serial Buffer Overrun +6387+ 3EA1 C3 63 18 jp ERROR +6388+ 3EA4 +6389+ 3EA4 +6390+ 3EA4 ; check for direct mode: +6391+ 3EA4 ; Z is set if in direct mode, reset otherwise +6392+ 3EA4 E5 DIRMOD: push HL ; Save code string address +6393+ 3EA5 2A 4B 54 ld HL,(LINEAT) ; Get current line number +6394+ 3EA8 23 inc HL ; -1 means direct statement +6395+ 3EA9 7C ld A,H +6396+ 3EAA B5 or L +6397+ 3EAB E1 pop HL ; Restore code string address +6398+ 3EAC C9 ret +6399+ 3EAD +6400+ 3EAD +6401+ 3EAD ; HELP lists the line program where an error occured +6402+ 3EAD CD A4 3E HELP: call DIRMOD ; check if in direct mode +6403+ 3EB0 C2 C6 3E jp NZ,HLPERR ; raise error if in indirect mode +6404+ 3EB3 E5 push HL ; store HL +6405+ 3EB4 2A 4D 54 ld HL,(HLPLN) ; load HELP line +6406+ 3EB7 23 inc HL ; increment HL +6407+ 3EB8 7C ld A,H +6408+ 3EB9 B5 or L ; check if there is a line into the HELP reg. +6409+ 3EBA E1 pop HL +6410+ 3EBB CA C6 3E jp Z,HLPERR ; no line found, raise error +6411+ 3EBE ED 5B 4D 54 ld DE,(HLPLN) ; recover line +6412+ 3EC2 C1 pop BC ; remove BC from stack since it's not needed anymore for LIST +6413+ 3EC3 C3 DD 1B jp LST01H ; jump to list line +6414+ 3EC6 1E 32 HLPERR: ld E,HP ; HELP call error +6415+ 3EC8 C3 63 18 jp ERROR ; raise error +6416+ 3ECB +6417+ 3ECB +6418+ 3ECB ; KEY command to list/modify function keys and auto-repeat +6419+ 3ECB 2B KEY: dec HL ; dec 'cos GETCHR INCs +6420+ 3ECC CD 90 1D call GETCHR ; Get next character +6421+ 3ECF CA 4D 3F jp Z,LSTKEYS ; jump if nothing follows +6422+ 3ED2 ; change FN keys +6423+ 3ED2 CD A7 2A call GETINT ; get a number +6424+ 3ED5 A7 and A ; is it 0? +6425+ 3ED6 20 0E jr NZ,KEYCH ; no, jump over +6426+ 3ED8 E5 RESFN: push HL ; yes - reset FN keys to defaults +6427+ 3ED9 21 37 17 ld HL,AUTORP ; pointer to default auto-repeat delays and FN keys texts +6428+ 3EDC 11 4F 54 ld DE,KEYDEL ; pointer to destination +6429+ 3EDF 01 82 00 ld BC,$0082 ; 130 chars to be copied (2xauto-delay, 128xFN keys) +6430+ 3EE2 ED B0 ldir ; restore default texts +6431+ 3EE4 E1 pop HL ; retrieve HL +6432+ 3EE5 C9 ret ; return to caller +6433+ 3EE6 FE 09 KEYCH: cp $09 ; is it >= 9? +6434+ 3EE8 D2 00 40 jp NC,SETREP ; yes - jump over +6435+ 3EEB 3D dec A ; FN key in range 0~7 +6436+ 3EEC 87 add A,A ; multiply A... +6437+ 3EED 87 add A,A ; ... times 4... +6438+ 3EEE 87 add A,A ; ... to get the correct... +6439+ 3EEF 87 add A,A ; ... offset fo FN key text +6440+ 3EF0 32 9E 55 ld (TMPBFR1),A ; store FN key offset... +6441+ 3EF3 AF xor A ; ...in a... +6442+ 3EF4 32 9F 55 ld (TMPBFR1+1),A ; ...16-bit register +6443+ 3EF7 CD 47 1B call CHKSYN ; Make sure ',' follows +6444+ 3EFA 2C defb ',' +6445+ 3EFB 44 4D ld BC,HL ; copy address into BC +6446+ 3EFD CD 33 22 call EVAL ; Evaluate expression (in E there is the length) +6447+ 3F00 E5 push HL ; store string pointer +6448+ 3F01 3A 30 55 ld A,(TYPE) ; Get variable type +6449+ 3F04 B7 or A ; Is it a string variable? +6450+ 3F05 CA 49 18 jp Z,SNERR ; no - syntax error +6451+ 3F08 CD 6C 28 call GSTRCU ; Current string to pool +6452+ 3F0B CD 7D 30 call LOADFP ; Move string block data to (BC=pointer, DE=length) +6453+ 3F0E 7B ld A,E ; copy length into A +6454+ 3F0F FE 11 cp $11 ; is length > 16? +6455+ 3F11 DA 16 3F jp C,DECLN1 ; no, jump over +6456+ 3F14 1E 10 ld E,$10 ; yes, so set length to 16 +6457+ 3F16 3E 10 DECLN1: ld A,$10 ; calculate how many... +6458+ 3F18 93 sub E ; ...null chars needed to fill up... +6459+ 3F19 57 ld D,A ; ...the FN key text +6460+ 3F1A C5 push BC ; store address of string +6461+ 3F1B ED 4B 9E 55 ld BC,(TMPBFR1) ; load FN key offset +6462+ 3F1F 21 51 54 ld HL,FNKEYS ; load address of FN keys texts +6463+ 3F22 09 add HL,BC ; get corrected address +6464+ 3F23 C1 pop BC ; retrieve address of string chars +6465+ 3F24 0A CPKEY: ld A,(BC) ; load char from string +6466+ 3F25 FE 0D cp CR ; return? +6467+ 3F27 CA 34 3F jp Z,CPKEY2 ; yes, store char +6468+ 3F2A FE 7B cp $7B ; if char > "z" ? +6469+ 3F2C D2 49 18 jp NC,SNERR ; yes - syntax error +6470+ 3F2F FE 20 cp $20 ; is char < space? +6471+ 3F31 DA 49 18 jp C,SNERR ; yes - syntax error +6472+ 3F34 FE 61 CPKEY2: cp $61 ; is it >= 'a'? +6473+ 3F36 DA 3B 3F jp C,CPKEY3 ; no, continue +6474+ 3F39 E6 5F and %01011111 ; set letters to uppercase +6475+ 3F3B 77 CPKEY3: ld (HL),A ; store char +6476+ 3F3C 23 inc HL ; next string char +6477+ 3F3D 03 inc BC ; next free cell +6478+ 3F3E 1D dec E ; decrement E +6479+ 3F3F 20 E3 jr NZ,CPKEY ; repeat until 0 +6480+ 3F41 AF xor A ; null char +6481+ 3F42 14 inc D ; +1 to decrement below +6482+ 3F43 15 CPKEY1: dec D ; how many null chars to insert? +6483+ 3F44 CA 4B 3F jp Z,CPKYEND ; no more nulls, so exit +6484+ 3F47 77 ld (HL),A ; store it +6485+ 3F48 23 inc HL ; next cell +6486+ 3F49 18 F8 jr CPKEY1 ; repeat +6487+ 3F4B E1 CPKYEND:pop HL ; retrieve pointer to string +6488+ 3F4C C9 ret ; return to caller +6489+ 3F4D ; list FN keys +6490+ 3F4D E5 LSTKEYS:push HL ; Save code string address +6491+ 3F4E 2A 4B 54 ld HL,(LINEAT) ; Get current line number +6492+ 3F51 23 inc HL ; -1 means direct statement +6493+ 3F52 7C ld A,H +6494+ 3F53 B5 or L +6495+ 3F54 E1 pop HL ; Restore code string address +6496+ 3F55 C2 49 18 jp NZ,SNERR ; raise error if in indirect mode +6497+ 3F58 E5 push HL ; store HL +6498+ 3F59 D5 push DE ; store DE +6499+ 3F5A 21 51 54 ld HL,FNKEYS ; load starting address of FN keys text +6500+ 3F5D 0E 01 ld C,$01 ; 8 function keys +6501+ 3F5F 06 10 PRTK4: ld B,$10 ; 16 chars each +6502+ 3F61 11 22 40 ld DE,CHKEY1 ; message "KEY " +6503+ 3F64 CD F1 3F call PRTCKEY ; print it +6504+ 3F67 79 ld A,C ; load FN key +6505+ 3F68 C6 30 add $30 ; get number in ASCI code +6506+ 3F6A CD 52 1B call OUTC ; print it +6507+ 3F6D 11 27 40 ld DE,CHKEY2 ; message ": "" +6508+ 3F70 CD F1 3F call PRTCKEY ; print it +6509+ 3F73 3E 01 ld A,$01 ; " opened +6510+ 3F75 32 9E 55 ld (TMPBFR1),A +6511+ 3F78 7E LDKEY: ld A,(HL) ; retrieve char +6512+ 3F79 A7 and A ; is it zero? +6513+ 3F7A CA 8D 3F jp Z,CNTLTK ; yes, go next char +6514+ 3F7D CD D9 3F call OPNQT ; check if quotes are opened +6515+ 3F80 FE 22 cp $22 ; check if char is "? +6516+ 3F82 CA A2 3F jp Z,PRTCHR ; yes, print "chr$(" +6517+ 3F85 FE 0D cp CR ; is it a CR? +6518+ 3F87 CA A2 3F jp Z,PRTCHR ; yes, print "chr$(" +6519+ 3F8A CD 52 1B PRTK3: call OUTC ; no, just print it +6520+ 3F8D 23 CNTLTK: inc HL ; next char +6521+ 3F8E 10 E8 djnz LDKEY ; continue until finished +6522+ 3F90 CD C7 3F call CLSQT ; check if quotes are still open +6523+ 3F93 3E 0D ld A,CR ; go next line +6524+ 3F95 CD 52 1B call OUTC ; print it +6525+ 3F98 0C inc C ; next FN key +6526+ 3F99 79 ld A,C ; check if... +6527+ 3F9A FE 09 cp $09 ; finished keys? +6528+ 3F9C DA 5F 3F jp C,PRTK4 ; no, repeat 1 more time +6529+ 3F9F D1 pop DE ; retrieve DE +6530+ 3FA0 E1 pop HL ; retrieve HL +6531+ 3FA1 C9 ret ; return to caller +6532+ 3FA2 E5 PRTCHR: push HL ; store HL +6533+ 3FA3 CD C7 3F call CLSQT ; check if quotes are closed +6534+ 3FA6 3E 2B ld A,'+' ; '+' char +6535+ 3FA8 CD 52 1B call OUTC ; print it +6536+ 3FAB 11 2A 40 ld DE,CHKEY3 ; address of "CHR$(" +6537+ 3FAE CD F1 3F call PRTCKEY ; print it +6538+ 3FB1 E1 pop HL ; recover HL +6539+ 3FB2 23 inc HL ; next char +6540+ 3FB3 05 dec B ; increment char counter +6541+ 3FB4 11 30 40 ld DE,CHKEY4 ; load address of RETURN +6542+ 3FB7 7E ld A,(HL) ; load char +6543+ 3FB8 FE 0D cp CR ; is it a RETURN? +6544+ 3FBA 20 03 jr NZ,PTCHR1 ; no, jump over +6545+ 3FBC 11 33 40 ld DE,CHKEY5 ; yes, load address of " +6546+ 3FBF CD F1 3F PTCHR1: call PRTCKEY ; print it +6547+ 3FC2 3E 29 ld A,')' ; char ) +6548+ 3FC4 C3 8A 3F jp PRTK3 ; continue +6549+ 3FC7 F5 CLSQT: push AF ; store A +6550+ 3FC8 3A 9E 55 ld A,(TMPBFR1) ; quote status +6551+ 3FCB A7 and A ; are they closed? +6552+ 3FCC 28 09 jr Z,CLSQT1 ; if yes, return +6553+ 3FCE 3E 22 ld A,$22 ; no, so close them +6554+ 3FD0 CD 52 1B call OUTC ; print " +6555+ 3FD3 AF xor A ; set quotes +6556+ 3FD4 32 9E 55 ld (TMPBFR1),A ; as closed +6557+ 3FD7 F1 CLSQT1: pop AF ; retrieve A +6558+ 3FD8 C9 ret ; return to caller +6559+ 3FD9 F5 OPNQT: push AF ; store A +6560+ 3FDA 3A 9E 55 ld A,(TMPBFR1) ; quote status +6561+ 3FDD A7 and A ; are they open? +6562+ 3FDE 20 0F jr NZ,OPNQT1 ; if yes, return +6563+ 3FE0 3E 2B ld A,'+' ; no, so add '+ +6564+ 3FE2 CD 52 1B call OUTC ; print it +6565+ 3FE5 3E 22 ld A,$22 ; and then open quotes +6566+ 3FE7 CD 52 1B call OUTC ; print them +6567+ 3FEA 3E 01 ld A,$01 ; set quotes +6568+ 3FEC 32 9E 55 ld (TMPBFR1),A ; as opened +6569+ 3FEF F1 OPNQT1: pop AF ; retrieve A +6570+ 3FF0 C9 ret ; return to caller +6571+ 3FF1 F5 PRTCKEY:push AF ; store original char +6572+ 3FF2 1A PRTK1: ld A,(DE) ; load char +6573+ 3FF3 A7 and A ; is it 0? +6574+ 3FF4 CA FE 3F jp Z,PRTEND ; yes, finished printing +6575+ 3FF7 CD 52 1B call OUTC ; no, print char +6576+ 3FFA 13 inc DE ; next char +6577+ 3FFB C3 F2 3F jp PRTK1 ; repeat +6578+ 3FFE F1 PRTEND: pop AF ; retrieve AF +6579+ 3FFF C9 ret ; return to caller +6580+ 4000 FE 09 SETREP: cp $09 ; is it special key 9? (stands for auto-repeat) +6581+ 4002 C2 49 18 jp NZ,SNERR ; no, raise an error +6582+ 4005 CD 47 1B call CHKSYN ; Check for comma +6583+ 4008 2C defb ',' +6584+ 4009 CD A7 2A call GETINT ; get a number +6585+ 400C 32 9E 55 ld (TMPBFR1),A ; store it +6586+ 400F CD 47 1B call CHKSYN ; Check for comma +6587+ 4012 2C defb ',' +6588+ 4013 CD A7 2A call GETINT ; get another number +6589+ 4016 E5 push HL ; store HL +6590+ 4017 21 50 54 ld HL,AUTOKE ; address of second cell for key auto-repeat +6591+ 401A 77 ld (HL),A ; store auto-repeat delay +6592+ 401B 2B dec HL ; previous cell +6593+ 401C 3A 9E 55 ld A,(TMPBFR1) ; retrieve value +6594+ 401F 77 ld (HL),A ; store delay for auto-repeat +6595+ 4020 E1 pop HL ; retrieve HL +6596+ 4021 C9 ret +6597+ 4022 4B 45 59 20 CHKEY1: defb "KEY ",0 +6597+ 4026 00 +6598+ 4027 3A 22 00 CHKEY2: defb ":",34,0 +6599+ 402A 63 68 72 24 CHKEY3: defb "chr$(",0 +6599+ 402E 28 00 +6600+ 4030 31 33 00 CHKEY4: defb "13",0 +6601+ 4033 33 34 00 CHKEY5: defb "34",0 +6602+ 4036 +6603+ 4036 +6604+ 4036 ; HEX$(nn) Convert 16 bit number to Hexadecimal string +6605+ 4036 CD 24 22 HEX: call TSTNUM ; Verify it's a number +6606+ 4039 CD 46 1E call DEINT ; Get integer -32768 to 32767 +6607+ 403C C5 push BC ; Save contents of BC +6608+ 403D 21 F7 55 ld HL,PBUFF ; load address of PBUFF into HL +6609+ 4040 7A ld A,D ; Get MSB into A +6610+ 4041 B7 or A ; OR with LSB to see if param=0 +6611+ 4042 28 0C jr Z,HEX2 ; Skip output if both high digits are zero +6612+ 4044 CD 6C 40 call BYT2ASC ; Convert D to ASCII +6613+ 4047 78 ld A,B ; cechk if B +6614+ 4048 FE 30 cp '0' ; is 0 +6615+ 404A 28 02 jr Z,HEX1 ; Don't store high digit if zero +6616+ 404C 70 ld (HL),B ; Store it to PBUFF +6617+ 404D 23 inc HL ; Next location +6618+ 404E 71 HEX1: ld (HL),C ; Store C to PBUFF+1 +6619+ 404F 23 inc HL ; Next location +6620+ 4050 7B HEX2: ld A,E ; Get lower byte +6621+ 4051 CD 6C 40 call BYT2ASC ; Convert E to ASCII +6622+ 4054 7A ld A,D +6623+ 4055 B7 or A +6624+ 4056 20 05 jr NZ,HEX3 ; If upper byte was not zero then always print lower byte +6625+ 4058 78 ld A,B +6626+ 4059 FE 30 cp '0' ; If high digit of lower byte is zero then don't print +6627+ 405B 28 02 jr Z,HEX4 +6628+ 405D 70 HEX3: ld (HL),B ; to PBUFF+2 +6629+ 405E 23 inc HL ; Next location +6630+ 405F 71 HEX4: ld (HL),C ; to PBUFF+3 +6631+ 4060 23 inc HL ; PBUFF+4 to zero +6632+ 4061 AF xor A ; Terminating character +6633+ 4062 77 ld (HL),A ; Store zero to terminate +6634+ 4063 23 inc HL ; Make sure PBUFF is terminated +6635+ 4064 77 ld (HL),A ; Store the double zero there +6636+ 4065 C1 pop BC ; Get BC back +6637+ 4066 21 F7 55 ld HL,PBUFF ; Reset to start of PBUFF +6638+ 4069 C3 B9 26 jp STR1 ; Convert the PBUFF to a string and return it +6639+ 406C 47 BYT2ASC:ld B,A ; Save original value +6640+ 406D E6 0F and $0F ; Strip off upper nybble +6641+ 406F FE 0A cp $0A ; 0-9? +6642+ 4071 38 02 jr C,ADD30 ; If A-F, add 7 more +6643+ 4073 C6 07 add A,$07 ; Bring value up to ASCII A-F +6644+ 4075 C6 30 ADD30: add A,$30 ; And make ASCII +6645+ 4077 4F ld C,A ; Save converted char to C +6646+ 4078 78 ld A,B ; Retrieve original value +6647+ 4079 0F rrca ; and Rotate it right +6648+ 407A 0F rrca +6649+ 407B 0F rrca +6650+ 407C 0F rrca +6651+ 407D E6 0F and $0F ; Mask off upper nybble +6652+ 407F FE 0A cp $0A ; 0-9? < A hex? +6653+ 4081 38 02 jr C,ADD301 ; Skip Add 7 +6654+ 4083 C6 07 add A,$07 ; Bring it up to ASCII A-F +6655+ 4085 C6 30 ADD301: add A,$30 ; And make it full ASCII +6656+ 4087 47 ld B,A ; Store high order byte +6657+ 4088 C9 ret +6658+ 4089 +6659+ 4089 ; Convert "&Hnnnn" to FPREG +6660+ 4089 ; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" +6661+ 4089 ; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 +6662+ 4089 EB HEXTFP: ex DE,HL ; Move code string pointer to DE +6663+ 408A 21 00 00 ld HL,$0000 ; Zero out the value +6664+ 408D CD A2 40 call GETHEX ; Check the number for valid hex +6665+ 4090 DA C2 40 jp C,HXERR ; First value wasn't hex, HEX error +6666+ 4093 18 05 jr HEXLP1 ; Convert first character +6667+ 4095 CD A2 40 HEXLP: call GETHEX ; Get second and addtional characters +6668+ 4098 38 1F jr C,HEXIT ; Exit if not a hex character +6669+ 409A 29 HEXLP1: add HL,HL ; Rotate 4 bits to the left +6670+ 409B 29 add HL,HL +6671+ 409C 29 add HL,HL +6672+ 409D 29 add HL,HL +6673+ 409E B5 or L ; Add in D0-D3 into L +6674+ 409F 6F ld L,A ; Save new value +6675+ 40A0 18 F3 jr HEXLP ; And continue until all hex characters are in +6676+ 40A2 +6677+ 40A2 13 GETHEX: inc DE ; Next location +6678+ 40A3 1A ld A,(DE) ; Load character at pointer +6679+ 40A4 FE 20 cp SPC +6680+ 40A6 CA A2 40 jp Z,GETHEX ; Skip spaces +6681+ 40A9 D6 30 sub $30 ; Get absolute value +6682+ 40AB D8 ret C ; < "0", error +6683+ 40AC FE 0A cp $0A +6684+ 40AE 38 05 jr C,NOSUB7 ; Is already in the range 0-9 +6685+ 40B0 D6 07 sub $07 ; Reduce to A-F +6686+ 40B2 FE 0A cp $0A ; Value should be $0A-$0F at this point +6687+ 40B4 D8 ret C ; CY set if was : ; < = > ? @ +6688+ 40B5 FE 10 NOSUB7: cp $10 ; > Greater than "F"? +6689+ 40B7 3F ccf +6690+ 40B8 C9 ret ; CY set if it wasn't valid hex +6691+ 40B9 +6692+ 40B9 EB HEXIT: ex DE,HL ; Value into DE, Code string into HL +6693+ 40BA 7A ld A,D ; Load DE into AC +6694+ 40BB 4B ld C,E ; For prep to +6695+ 40BC E5 push HL +6696+ 40BD CD 0A 26 call ACPASS ; ACPASS to set AC as integer into FPREG +6697+ 40C0 E1 pop HL +6698+ 40C1 C9 ret +6699+ 40C2 +6700+ 40C2 1E 26 HXERR: ld E,HE ; ?HEX Error +6701+ 40C4 C3 63 18 jp ERROR +6702+ 40C7 +6703+ 40C7 ; BIN$(NN) Convert integer to a 1-16 char binary string +6704+ 40C7 CD 24 22 BIN: call TSTNUM ; Verify it's a number +6705+ 40CA CD 46 1E call DEINT ; Get integer -32768 to 32767 +6706+ 40CD C5 push BC ; Save contents of BC +6707+ 40CE 21 F7 55 ld HL,PBUFF +6708+ 40D1 06 11 ld B,$11 ; One higher than max char count (16+1) +6709+ 40D3 ; Suppress leading zeros +6710+ 40D3 05 ZEROSUP:dec B ; Max 16 chars +6711+ 40D4 78 ld A,B +6712+ 40D5 FE 01 cp $01 +6713+ 40D7 28 08 jr Z,BITOUT ; Always output at least one character +6714+ 40D9 CB 13 rl E +6715+ 40DB CB 12 rl D +6716+ 40DD 30 F4 jr NC,ZEROSUP +6717+ 40DF 18 04 jr BITOUT2 +6718+ 40E1 CB 13 BITOUT: rl E +6719+ 40E3 CB 12 rl D ; Top bit now in carry +6720+ 40E5 3E 30 BITOUT2:ld A,'0' ; Char for '0' +6721+ 40E7 CE 00 adc A,$00 ; If carry set then '0' --> '1' +6722+ 40E9 77 ld (HL),A +6723+ 40EA 23 inc HL +6724+ 40EB 05 dec B +6725+ 40EC 20 F3 jr NZ,BITOUT +6726+ 40EE AF xor A ; Terminating character +6727+ 40EF 77 ld (HL),A ; Store zero to terminate +6728+ 40F0 23 inc HL ; Make sure PBUFF is terminated +6729+ 40F1 77 ld (HL),A ; Store the double zero there +6730+ 40F2 C1 pop BC +6731+ 40F3 21 F7 55 ld HL,PBUFF +6732+ 40F6 C3 B9 26 jp STR1 +6733+ 40F9 +6734+ 40F9 ; Convert "&Bnnnn" to FPREG +6735+ 40F9 ; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" +6736+ 40F9 EB BINTFP: ex DE,HL ; Move code string pointer to DE +6737+ 40FA 21 00 00 ld HL,$0000 ; Zero out the value +6738+ 40FD CD 16 41 call CHKBIN ; Check the number for valid bin +6739+ 4100 DA 24 41 jp C,BINERR ; First value wasn't bin, BIN error +6740+ 4103 D6 30 BINIT: sub '0' +6741+ 4105 29 add HL,HL ; Rotate HL left +6742+ 4106 B5 or L +6743+ 4107 6F ld L,A +6744+ 4108 CD 16 41 call CHKBIN ; Get second and addtional characters +6745+ 410B 30 F6 jr NC,BINIT ; Process if a bin character +6746+ 410D EB ex DE,HL ; Value into DE, Code string into HL +6747+ 410E 7A ld A,D ; Load DE into AC +6748+ 410F 4B ld C,E ; For prep to +6749+ 4110 E5 push HL +6750+ 4111 CD 0A 26 call ACPASS ; ACPASS to set AC as integer into FPREG +6751+ 4114 E1 pop HL +6752+ 4115 C9 ret +6753+ 4116 +6754+ 4116 ; Char is in A, NC if char is 0 or 1 +6755+ 4116 13 CHKBIN: inc DE +6756+ 4117 1A ld A,(DE) +6757+ 4118 FE 20 cp SPC +6758+ 411A CA 16 41 jp Z,CHKBIN ; Skip spaces +6759+ 411D FE 30 cp '0' ; Set C if < '0' +6760+ 411F D8 ret C +6761+ 4120 FE 32 cp '2' +6762+ 4122 3F ccf ; Set C if > '1' +6763+ 4123 C9 ret +6764+ 4124 +6765+ 4124 1E 28 BINERR: ld E,BN ; ?BIN Error +6766+ 4126 C3 63 18 jp ERROR +6767+ 4129 +6768+ 4129 +6769+ 4129 C3 08 00 MONOUT: jp $0008 ; output a char +6770+ 412C +6771+ 412C +6772+ 412C 1E 00 RESET: ld E,$00 ; full RESET +6773+ 412E CD C2 2A RESET2: call DISNMI ; disable NMI vector +6774+ 4131 3A E0 55 ld A,(SERIALS_EN) ; load status of serial lines +6775+ 4134 E6 11 and $11 ; are serial ports open? +6776+ 4136 C4 A2 3C call NZ,RSTSERS ; yes, reset serials +6777+ 4139 3A E3 55 ld A,(DOS_EN) ; check DOS status +6778+ 413C A7 and A ; DOS enabled? +6779+ 413D 28 0A jr Z,RESETE ; no, jump over +6780+ 413F CD 44 FD call CF_STANDBY ; yes, put CF into standby mode +6781+ 4142 AF xor A +6782+ 4143 32 D6 FF ld (SEQFL),A ; close any seq. file opened +6783+ 4146 7B ld A,E +6784+ 4147 B7 or A +6785+ 4148 C0 ret NZ ; return if called from soft reset (C= + CTRL) +6786+ 4149 F3 RESETE: di ; disable INTs +6787+ 414A C3 65 53 jp ROM2RAM ; Restart +6788+ 414D +6789+ 414D +6790+ 414D AF INITST: xor A ; Clear break flag +6791+ 414E 32 45 54 ld (BRKFLG),A +6792+ 4151 C3 0E 13 jp SYSINIT +6793+ 4154 +6794+ 4154 +6795+ 4154 CD 52 1B OUTNCR: call OUTC ; Output character in A +6796+ 4157 C3 5D 20 jp PRNTCRLF ; Output CRLF +6797+ 415A +# file closed: ../include/basic/basic-1.13.asm + 76 415A + 77 415A ; include utils + 78 415A INCLUDE "../include/utils/utils-r1.2.asm" +# file opened: ../include/utils/utils-r1.2.asm + 1+ 415A ; ------------------------------------------------------------------------------ + 2+ 415A ; LM80C - UTILITY ROUTINES - R1.2 + 3+ 415A ; ------------------------------------------------------------------------------ + 4+ 415A ; The following code is intended to be used with LM80C Z80-based computer + 5+ 415A ; designed by Leonardo Miliani. More info at + 6+ 415A ; www DOT leonardomiliani DOT com + 7+ 415A ; + 8+ 415A ; *ALS are routines from "Z80 Assembly Language Subroutines" by Lance + 9+ 415A ; A. Leventhal and Winthrop Saville - Ed. Osborne/McGraw-Hill (1983) + 10+ 415A ; + 11+ 415A ; * WKT are routines from WikiTI: + 12+ 415A ; http://wikiti.brandonw.net/index.php?title=WikiTI_Home + 13+ 415A ; + 14+ 415A ; * LAC are routines from Learn@Cemetch + 15+ 415A ; https://learn.cemetech.net/index.php/Main_Page + 16+ 415A ; + 17+ 415A ; ------------------------------------------------------------------------------ + 18+ 415A ; Code Revision: + 19+ 415A ; R1.0 - 20200110 - First release: 16-bit comparision/multiplication/negation + 20+ 415A ; R1.1 - 20200413 - Second release: added ABS(HL) + 21+ 415A ; R1.2 - 20200131 - Added 32/16 bit multiplication/division and converter to + 22+ 415A ; transform a 32-bit value into ASCII representation + 23+ 415A ; + 24+ 415A ; ------------------------------------------------------------------------------ + 25+ 415A + 26+ 415A ; compare two 16-bit registers, HL (minuend) and DE (subtrahend) + 27+ 415A ; values can be both signed or unsigned words + 28+ 415A ; inputs: HL, DE + 29+ 415A ; destroys: A,F,HL + 30+ 415A ; + 31+ 415A ; returns: Z=1 if HL = DE + 32+ 415A ; for UNSIGNED: C=1 if HLDE + 33+ 415A ; for SIGNED: S=1 (M) if HLDE + 34+ 415A ; if HL=DE: Z,P,NC - Z=1, S=0; C=0 + 35+ 415A ; if HL>DE: NZ,P,NC - Z=0, S=0; C=0 + 36+ 415A ; if HL + 90+ 4484 10 20 40 00 + 91+ 4488 70 88 08 10 defb $70,$88,$08,$10,$20,$00,$20,$00 ; char 63: ? + 91+ 448C 20 00 20 00 + 92+ 4490 70 88 08 68 defb $70,$88,$08,$68,$a8,$a8,$70,$00 ; char 64: @ + 92+ 4494 A8 A8 70 00 + 93+ 4498 70 88 88 88 defb $70,$88,$88,$88,$f8,$88,$88,$00 ; char 65: A + 93+ 449C F8 88 88 00 + 94+ 44A0 F0 88 88 F0 defb $f0,$88,$88,$f0,$88,$88,$f0,$00 ; char 66: B + 94+ 44A4 88 88 F0 00 + 95+ 44A8 70 88 80 80 defb $70,$88,$80,$80,$80,$88,$70,$00 ; char 67: C + 95+ 44AC 80 88 70 00 + 96+ 44B0 E0 90 88 88 defb $e0,$90,$88,$88,$88,$90,$e0,$00 ; char 68: D + 96+ 44B4 88 90 E0 00 + 97+ 44B8 F8 80 80 F0 defb $f8,$80,$80,$f0,$80,$80,$f8,$00 ; char 69: E + 97+ 44BC 80 80 F8 00 + 98+ 44C0 F8 80 80 F0 defb $f8,$80,$80,$f0,$80,$80,$80,$00 ; char 70: F + 98+ 44C4 80 80 80 00 + 99+ 44C8 70 88 80 B8 defb $70,$88,$80,$b8,$88,$88,$78,$00 ; char 71: G + 99+ 44CC 88 88 78 00 + 100+ 44D0 88 88 88 F8 defb $88,$88,$88,$f8,$88,$88,$88,$00 ; char 72: H + 100+ 44D4 88 88 88 00 + 101+ 44D8 70 20 20 20 defb $70,$20,$20,$20,$20,$20,$70,$00 ; char 73: I + 101+ 44DC 20 20 70 00 + 102+ 44E0 38 10 10 10 defb $38,$10,$10,$10,$10,$90,$60,$00 ; char 74: J + 102+ 44E4 10 90 60 00 + 103+ 44E8 88 90 A0 C0 defb $88,$90,$a0,$c0,$a0,$90,$88,$00 ; char 75: K + 103+ 44EC A0 90 88 00 + 104+ 44F0 80 80 80 80 defb $80,$80,$80,$80,$80,$80,$f8,$00 ; char 76: L + 104+ 44F4 80 80 F8 00 + 105+ 44F8 88 D8 A8 A8 defb $88,$d8,$a8,$a8,$88,$88,$88,$00 ; char 77: M + 105+ 44FC 88 88 88 00 + 106+ 4500 88 C8 A8 98 defb $88,$c8,$a8,$98,$88,$88,$88,$00 ; char 78: N + 106+ 4504 88 88 88 00 + 107+ 4508 70 88 88 88 defb $70,$88,$88,$88,$88,$88,$70,$00 ; char 79: O + 107+ 450C 88 88 70 00 + 108+ 4510 F0 88 88 F0 defb $f0,$88,$88,$f0,$80,$80,$80,$00 ; char 80: P + 108+ 4514 80 80 80 00 + 109+ 4518 70 88 88 88 defb $70,$88,$88,$88,$a8,$90,$68,$00 ; char 81: Q + 109+ 451C A8 90 68 00 + 110+ 4520 F0 88 88 F0 defb $f0,$88,$88,$f0,$a0,$90,$88,$00 ; char 82: R + 110+ 4524 A0 90 88 00 + 111+ 4528 78 80 80 70 defb $78,$80,$80,$70,$08,$08,$f0,$00 ; char 83: S + 111+ 452C 08 08 F0 00 + 112+ 4530 F8 20 20 20 defb $f8,$20,$20,$20,$20,$20,$20,$00 ; char 84: T + 112+ 4534 20 20 20 00 + 113+ 4538 88 88 88 88 defb $88,$88,$88,$88,$88,$88,$70,$00 ; char 85: U + 113+ 453C 88 88 70 00 + 114+ 4540 88 88 88 88 defb $88,$88,$88,$88,$88,$50,$20,$00 ; char 86: V + 114+ 4544 88 50 20 00 + 115+ 4548 88 88 88 88 defb $88,$88,$88,$88,$a8,$a8,$50,$00 ; char 87: W + 115+ 454C A8 A8 50 00 + 116+ 4550 88 88 50 20 defb $88,$88,$50,$20,$50,$88,$88,$00 ; char 88: X + 116+ 4554 50 88 88 00 + 117+ 4558 88 88 88 50 defb $88,$88,$88,$50,$20,$20,$20,$00 ; char 89: Y + 117+ 455C 20 20 20 00 + 118+ 4560 F8 08 10 20 defb $f8,$08,$10,$20,$40,$80,$f8,$00 ; char 90: Z + 118+ 4564 40 80 F8 00 + 119+ 4568 70 40 40 40 defb $70,$40,$40,$40,$40,$40,$70,$00 ; char 91: [ + 119+ 456C 40 40 70 00 + 120+ 4570 00 80 40 20 defb $00,$80,$40,$20,$10,$08,$00,$00 ; char 92: \ + 120+ 4574 10 08 00 00 + 121+ 4578 70 10 10 10 defb $70,$10,$10,$10,$10,$10,$70,$00 ; char 93: ] + 121+ 457C 10 10 70 00 + 122+ 4580 20 50 88 00 defb $20,$50,$88,$00,$00,$00,$00,$00 ; char 94: ^ + 122+ 4584 00 00 00 00 + 123+ 4588 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$FC ; char 95: _ (underscore) + 123+ 458C 00 00 00 FC + 124+ 4590 40 20 10 00 defb $40,$20,$10,$00,$00,$00,$00,$00 ; char 96: ` + 124+ 4594 00 00 00 00 + 125+ 4598 00 00 70 08 defb $00,$00,$70,$08,$78,$88,$78,$00 ; char 97: a + 125+ 459C 78 88 78 00 + 126+ 45A0 80 80 80 B0 defb $80,$80,$80,$b0,$c8,$88,$f0,$00 ; char 98: b + 126+ 45A4 C8 88 F0 00 + 127+ 45A8 00 00 70 80 defb $00,$00,$70,$80,$80,$88,$70,$00 ; char 99: c + 127+ 45AC 80 88 70 00 + 128+ 45B0 08 08 08 68 defb $08,$08,$08,$68,$98,$88,$78,$00 ; char 100: d + 128+ 45B4 98 88 78 00 + 129+ 45B8 00 00 70 88 defb $00,$00,$70,$88,$f8,$80,$70,$00 ; char 101: e + 129+ 45BC F8 80 70 00 + 130+ 45C0 30 48 40 E0 defb $30,$48,$40,$e0,$40,$40,$40,$00 ; char 102: f + 130+ 45C4 40 40 40 00 + 131+ 45C8 00 00 78 88 defb $00,$00,$78,$88,$78,$08,$70,$00 ; char 103: g + 131+ 45CC 78 08 70 00 + 132+ 45D0 80 80 B0 C8 defb $80,$80,$b0,$c8,$88,$88,$88,$00 ; char 104: h + 132+ 45D4 88 88 88 00 + 133+ 45D8 20 00 20 20 defb $20,$00,$20,$20,$20,$20,$20,$00 ; char 105: i + 133+ 45DC 20 20 20 00 + 134+ 45E0 08 00 18 08 defb $08,$00,$18,$08,$08,$88,$70,$00 ; char 106: j + 134+ 45E4 08 88 70 00 + 135+ 45E8 80 80 90 A0 defb $80,$80,$90,$a0,$c0,$a0,$90,$00 ; char 107: k + 135+ 45EC C0 A0 90 00 + 136+ 45F0 60 20 20 20 defb $60,$20,$20,$20,$20,$20,$70,$00 ; char 108: l + 136+ 45F4 20 20 70 00 + 137+ 45F8 00 00 D0 A8 defb $00,$00,$d0,$a8,$a8,$88,$88,$00 ; char 109: m + 137+ 45FC A8 88 88 00 + 138+ 4600 00 00 B0 C8 defb $00,$00,$b0,$c8,$88,$88,$88,$00 ; char 110: n + 138+ 4604 88 88 88 00 + 139+ 4608 00 00 70 88 defb $00,$00,$70,$88,$88,$88,$70,$00 ; char 111: o + 139+ 460C 88 88 70 00 + 140+ 4610 00 00 F0 88 defb $00,$00,$f0,$88,$f0,$80,$80,$00 ; char 112: p + 140+ 4614 F0 80 80 00 + 141+ 4618 00 00 78 88 defb $00,$00,$78,$88,$78,$08,$08,$00 ; char 113: q + 141+ 461C 78 08 08 00 + 142+ 4620 00 00 B0 C8 defb $00,$00,$b0,$c8,$80,$80,$80,$00 ; char 114: r + 142+ 4624 80 80 80 00 + 143+ 4628 00 00 70 80 defb $00,$00,$70,$80,$70,$08,$f0,$00 ; char 115: s + 143+ 462C 70 08 F0 00 + 144+ 4630 40 40 E0 40 defb $40,$40,$e0,$40,$40,$48,$30,$00 ; char 116: t + 144+ 4634 40 48 30 00 + 145+ 4638 00 00 88 88 defb $00,$00,$88,$88,$88,$98,$68,$00 ; char 117: u + 145+ 463C 88 98 68 00 + 146+ 4640 00 00 88 88 defb $00,$00,$88,$88,$88,$50,$20,$00 ; char 118: v + 146+ 4644 88 50 20 00 + 147+ 4648 00 00 88 88 defb $00,$00,$88,$88,$a8,$a8,$50,$00 ; char 119: w + 147+ 464C A8 A8 50 00 + 148+ 4650 00 00 88 50 defb $00,$00,$88,$50,$20,$50,$88,$00 ; char 120: x + 148+ 4654 20 50 88 00 + 149+ 4658 00 00 88 98 defb $00,$00,$88,$98,$68,$08,$70,$00 ; char 121: y + 149+ 465C 68 08 70 00 + 150+ 4660 00 00 F8 10 defb $00,$00,$f8,$10,$20,$40,$f8,$00 ; char 122: z + 150+ 4664 20 40 F8 00 + 151+ 4668 10 20 20 40 defb $10,$20,$20,$40,$20,$20,$10,$00 ; char 123: { + 151+ 466C 20 20 10 00 + 152+ 4670 20 20 20 20 defb $20,$20,$20,$20,$20,$20,$20,$00 ; char 124: | + 152+ 4674 20 20 20 00 + 153+ 4678 20 10 10 08 defb $20,$10,$10,$08,$10,$10,$20,$00 ; char 125: } + 153+ 467C 10 10 20 00 + 154+ 4680 00 28 50 00 defb $00,$28,$50,$00,$00,$00,$00,$00 ; char 126: ~ + 154+ 4684 00 00 00 00 + 155+ 4688 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 127: (delete) - here end the standard ASCII (0-127) + 155+ 468C 00 00 00 00 + 156+ 4690 78 84 CC 84 defb %01111000,%10000100,%11001100,%10000100,%10110100,%10000100,%01111000,%00000000 ; char 128 (open face) + 156+ 4694 B4 84 78 00 + 157+ 4698 78 FC B4 FC defb %01111000,%11111100,%10110100,%11111100,%10110100,%11001100,%01111000,%00000000 ; char 129 (full face) + 157+ 469C B4 CC 78 00 + 158+ 46A0 48 FC FC FC defb %01001000,%11111100,%11111100,%11111100,%11111100,%01111000,%00110000,%00000000 ; char 130 (hearts) + 158+ 46A4 FC 78 30 00 + 159+ 46A8 00 20 70 F8 defb %00000000,%00100000,%01110000,%11111000,%11111000,%01110000,%00100000,%00000000 ; char 131 (diamonds) + 159+ 46AC F8 70 20 00 + 160+ 46B0 70 20 A8 F8 defb %01110000,%00100000,%10101000,%11111000,%10101000,%00100000,%01110000,%00000000 ; char 132 (clubs) + 160+ 46B4 A8 20 70 00 + 161+ 46B8 20 70 F8 F8 defb %00100000,%01110000,%11111000,%11111000,%10101000,%00100000,%01110000,%00000000 ; char 133 (spades) + 161+ 46BC A8 20 70 00 + 162+ 46C0 30 30 30 FC defb %00110000,%00110000,%00110000,%11111100,%11111100,%00110000,%00110000,%00110000 ; char 134 + 162+ 46C4 FC 30 30 30 + 163+ 46C8 00 00 00 3C defb %00000000,%00000000,%00000000,%00111100,%00111100,%00110000,%00110000,%00110000 ; char 135 + 163+ 46CC 3C 30 30 30 + 164+ 46D0 00 00 00 F0 defb %00000000,%00000000,%00000000,%11110000,%11110000,%00110000,%00110000,%00110000 ; char 136 + 164+ 46D4 F0 30 30 30 + 165+ 46D8 30 30 30 F0 defb %00110000,%00110000,%00110000,%11110000,%11110000,%00000000,%00000000,%00000000 ; char 137 + 165+ 46DC F0 00 00 00 + 166+ 46E0 30 30 30 3C defb %00110000,%00110000,%00110000,%00111100,%00111100,%00000000,%00000000,%00000000 ; char 138 + 166+ 46E4 3C 00 00 00 + 167+ 46E8 30 30 30 FC defb %00110000,%00110000,%00110000,%11111100,%11111100,%00000000,%00000000,%00000000 ; char 139 + 167+ 46EC FC 00 00 00 + 168+ 46F0 30 30 30 3C defb %00110000,%00110000,%00110000,%00111100,%00111100,%00110000,%00110000,%00110000 ; char 140 + 168+ 46F4 3C 30 30 30 + 169+ 46F8 00 00 00 FC defb %00000000,%00000000,%00000000,%11111100,%11111100,%00110000,%00110000,%00110000 ; char 141 + 169+ 46FC FC 30 30 30 + 170+ 4700 30 30 30 F0 defb %00110000,%00110000,%00110000,%11110000,%11110000,%00110000,%00110000,%00110000 ; char 142 + 170+ 4704 F0 30 30 30 + 171+ 4708 00 00 00 FC defb %00000000,%00000000,%00000000,%11111100,%11111100,%00000000,%00000000,%00000000 ; char 143 + 171+ 470C FC 00 00 00 + 172+ 4710 30 30 30 30 defb %00110000,%00110000,%00110000,%00110000,%00110000,%00110000,%00110000,%00110000 ; char 144 + 172+ 4714 30 30 30 30 + 173+ 4718 0C 1C 18 38 defb %00001100,%00011100,%00011000,%00111000,%01110000,%01100000,%11100000,%11000000 ; char 145 + 173+ 471C 70 60 E0 C0 + 174+ 4720 C0 E0 60 70 defb %11000000,%11100000,%01100000,%01110000,%00111000,%00011000,%00011100,%00001100 ; char 146 + 174+ 4724 38 18 1C 0C + 175+ 4728 CC CC 78 30 defb %11001100,%11001100,%01111000,%00110000,%00110000,%01111000,%11001100,%11001100 ; char 147 + 175+ 472C 30 78 CC CC + 176+ 4730 20 20 20 FC defb %00100000,%00100000,%00100000,%11111100,%00100000,%00100000,%00100000,%00100000 ; char 148 + 176+ 4734 20 20 20 20 + 177+ 4738 00 00 00 3C defb %00000000,%00000000,%00000000,%00111100,%00100000,%00100000,%00100000,%00100000 ; char 149 + 177+ 473C 20 20 20 20 + 178+ 4740 00 00 00 E0 defb %00000000,%00000000,%00000000,%11100000,%00100000,%00100000,%00100000,%00100000 ; char 150 + 178+ 4744 20 20 20 20 + 179+ 4748 20 20 20 E0 defb %00100000,%00100000,%00100000,%11100000,%00000000,%00000000,%00000000,%00000000 ; char 151 + 179+ 474C 00 00 00 00 + 180+ 4750 20 20 20 3C defb %00100000,%00100000,%00100000,%00111100,%00000000,%00000000,%00000000,%00000000 ; char 152 + 180+ 4754 00 00 00 00 + 181+ 4758 20 20 20 FC defb %00100000,%00100000,%00100000,%11111100,%00000000,%00000000,%00000000,%00000000 ; char 153 + 181+ 475C 00 00 00 00 + 182+ 4760 20 20 20 3C defb %00100000,%00100000,%00100000,%00111100,%00100000,%00100000,%00100000,%00100000 ; char 154 + 182+ 4764 20 20 20 20 + 183+ 4768 00 00 00 FC defb %00000000,%00000000,%00000000,%11111100,%00100000,%00100000,%00100000,%00100000 ; char 155 + 183+ 476C 20 20 20 20 + 184+ 4770 20 20 20 E0 defb %00100000,%00100000,%00100000,%11100000,%00100000,%00100000,%00100000,%00100000 ; char 156 + 184+ 4774 20 20 20 20 + 185+ 4778 00 00 00 FC defb %00000000,%00000000,%00000000,%11111100,%00000000,%00000000,%00000000,%00000000 ; char 157 + 185+ 477C 00 00 00 00 + 186+ 4780 20 20 20 20 defb %00100000,%00100000,%00100000,%00100000,%00100000,%00100000,%00100000,%00100000 ; char 158 + 186+ 4784 20 20 20 20 + 187+ 4788 04 08 08 10 defb %00000100,%00001000,%00001000,%00010000,%00100000,%01000000,%01000000,%10000000 ; char 159 + 187+ 478C 20 40 40 80 + 188+ 4790 80 40 40 20 defb %10000000,%01000000,%01000000,%00100000,%00010000,%00001000,%00001000,%00000100 ; char 160 + 188+ 4794 10 08 08 04 + 189+ 4798 84 48 48 30 defb %10000100,%01001000,%01001000,%00110000,%00110000,%01001000,%01001000,%10000100 ; char 161 + 189+ 479C 30 48 48 84 + 190+ 47A0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%11111100,%11111100 ; char 162 + 190+ 47A4 00 00 FC FC + 191+ 47A8 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11111100,%11111100,%11111100,%11111100 ; char 163 + 191+ 47AC FC FC FC FC + 192+ 47B0 00 00 FC FC defb %00000000,%00000000,%11111100,%11111100,%11111100,%11111100,%11111100,%11111100 ; char 164 + 192+ 47B4 FC FC FC FC + 193+ 47B8 FC FC 00 00 defb %11111100,%11111100,%00000000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 165 + 193+ 47BC 00 00 00 00 + 194+ 47C0 FC FC FC FC defb %11111100,%11111100,%11111100,%11111100,%00000000,%00000000,%00000000,%00000000 ; char 166 + 194+ 47C4 00 00 00 00 + 195+ 47C8 FC FC FC FC defb %11111100,%11111100,%11111100,%11111100,%11111100,%11111100,%00000000,%00000000 ; char 167 + 195+ 47CC FC FC 00 00 + 196+ 47D0 80 80 80 80 defb %10000000,%10000000,%10000000,%10000000,%10000000,%10000000,%10000000,%10000000 ; char 168 + 196+ 47D4 80 80 80 80 + 197+ 47D8 E0 E0 E0 E0 defb %11100000,%11100000,%11100000,%11100000,%11100000,%11100000,%11100000,%11100000 ; char 169 + 197+ 47DC E0 E0 E0 E0 + 198+ 47E0 F8 F8 F8 F8 defb %11111000,%11111000,%11111000,%11111000,%11111000,%11111000,%11111000,%11111000 ; char 170 + 198+ 47E4 F8 F8 F8 F8 + 199+ 47E8 04 04 04 04 defb %00000100,%00000100,%00000100,%00000100,%00000100,%00000100,%00000100,%00000100 ; char 171 + 199+ 47EC 04 04 04 04 + 200+ 47F0 1C 1C 1C 1C defb %00011100,%00011100,%00011100,%00011100,%00011100,%00011100,%00011100,%00011100 ; char 172 + 200+ 47F4 1C 1C 1C 1C + 201+ 47F8 7C 7C 7C 7C defb %01111100,%01111100,%01111100,%01111100,%01111100,%01111100,%01111100,%01111100 ; char 173 + 201+ 47FC 7C 7C 7C 7C + 202+ 4800 FC 84 84 84 defb %11111100,%10000100,%10000100,%10000100,%10000100,%10000100,%10000100,%11111100 ; char 174 + 202+ 4804 84 84 84 FC + 203+ 4808 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11100000,%11100000,%11100000,%11100000 ; char 175 + 203+ 480C E0 E0 E0 E0 + 204+ 4810 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00011100,%00011100,%00011100,%00011100 ; char 176 + 204+ 4814 1C 1C 1C 1C + 205+ 4818 1C 1C 1C 1C defb %00011100,%00011100,%00011100,%00011100,%00000000,%00000000,%00000000,%00000000 ; char 177 + 205+ 481C 00 00 00 00 + 206+ 4820 E0 E0 E0 E0 defb %11100000,%11100000,%11100000,%11100000,%00000000,%00000000,%00000000,%00000000 ; char 178 + 206+ 4824 00 00 00 00 + 207+ 4828 E0 E0 E0 E0 defb %11100000,%11100000,%11100000,%11100000,%00011100,%00011100,%00011100,%00011100 ; char 179 + 207+ 482C 1C 1C 1C 1C + 208+ 4830 1C 1C 1C 1C defb %00011100,%00011100,%00011100,%00011100,%11100000,%11100000,%11100000,%11100000 ; char 180 + 208+ 4834 E0 E0 E0 E0 + 209+ 4838 78 78 78 78 defb %01111000,%01111000,%01111000,%01111000,%01111000,%01111000,%01111000,%01111000 ; char 181 + 209+ 483C 78 78 78 78 + 210+ 4840 CC CC CC CC defb %11001100,%11001100,%11001100,%11001100,%11001100,%11001100,%11001100,%11001100 ; char 182 + 210+ 4844 CC CC CC CC + 211+ 4848 FC FC 00 00 defb %11111100,%11111100,%00000000,%00000000,%00000000,%00000000,%11111100,%11111100 ; char 183 + 211+ 484C 00 00 FC FC + 212+ 4850 00 00 FC FC defb %00000000,%00000000,%11111100,%11111100,%11111100,%11111100,%00000000,%00000000 ; char 184 + 212+ 4854 FC FC 00 00 + 213+ 4858 30 30 CC CC defb %00110000,%00110000,%11001100,%11001100,%00110000,%00110000,%11001100,%11001100 ; char 185 + 213+ 485C 30 30 CC CC + 214+ 4860 54 A8 54 A8 defb %01010100,%10101000,%01010100,%10101000,%01010100,%10101000,%01010100,%10101000 ; char 186 + 214+ 4864 54 A8 54 A8 + 215+ 4868 64 30 98 CC defb %01100100,%00110000,%10011000,%11001100,%01100100,%00110000,%10011000,%11001100 ; char 187 + 215+ 486C 64 30 98 CC + 216+ 4870 CC 64 30 98 defb %11001100,%01100100,%00110000,%10011000,%11001100,%01100100,%00110000,%10011000 ; char 188 + 216+ 4874 CC 64 30 98 + 217+ 4878 30 98 CC 64 defb %00110000,%10011000,%11001100,%01100100,%00110000,%10011000,%11001100,%01100100 ; char 189 + 217+ 487C 30 98 CC 64 + 218+ 4880 64 CC 98 30 defb %01100100,%11001100,%10011000,%00110000,%01100100,%11001100,%10011000,%00110000 ; char 190 + 218+ 4884 64 CC 98 30 + 219+ 4888 20 20 F8 20 defb %00100000,%00100000,%11111000,%00100000,%00100000,%00000000,%11111000,%00000000 ; char 191 (±) + 219+ 488C 20 00 F8 00 + 220+ 4890 C0 30 08 30 defb %11000000,%00110000,%00001000,%00110000,%11000000,%00000000,%11111000,%00000000 ; char 192 (≥) + 220+ 4894 C0 00 F8 00 + 221+ 4898 18 60 80 60 defb %00011000,%01100000,%10000000,%01100000,%00011000,%00000000,%11111000,%00000000 ; char 193 (≤) + 221+ 489C 18 00 F8 00 + 222+ 48A0 3C 20 20 20 defb %00111100,%00100000,%00100000,%00100000,%10100000,%01100000,%00100000,%00000000 ; char 194 (square root) + 222+ 48A4 A0 60 20 00 + 223+ 48A8 30 48 48 30 defb %00110000,%01001000,%01001000,%00110000,%00000000,%00000000,%00000000,%00000000 ; char 195 (°) + 223+ 48AC 00 00 00 00 + 224+ 48B0 60 10 30 40 defb %01100000,%00010000,%00110000,%01000000,%01110000,%00000000,%00000000,%00000000 ; char 196 (²) + 224+ 48B4 70 00 00 00 + 225+ 48B8 00 00 54 A8 defb %00000000,%00000000,%01010100,%10101000,%00000000,%11111100,%00000000,%00000000 ; char 197 + 225+ 48BC 00 FC 00 00 + 226+ 48C0 00 54 A8 00 defb %00000000,%01010100,%10101000,%00000000,%01010100,%10101000,%00000000,%00000000 ; char 198 (≈) + 226+ 48C4 54 A8 00 00 + 227+ 48C8 00 80 C0 E0 defb %00000000,%10000000,%11000000,%11100000,%11100000,%11000000,%10000000,%00000000 ; char 199 + 227+ 48CC E0 C0 80 00 + 228+ 48D0 FC 78 30 00 defb %11111100,%01111000,%00110000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 200 + 228+ 48D4 00 00 00 00 + 229+ 48D8 00 04 0C 1C defb %00000000,%00000100,%00001100,%00011100,%00011100,%00001100,%00000100,%00000000 ; char 201 + 229+ 48DC 1C 0C 04 00 + 230+ 48E0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00110000,%01111000,%11111100 ; char 202 + 230+ 48E4 00 30 78 FC + 231+ 48E8 20 70 F8 20 defb %00100000,%01110000,%11111000,%00100000,%00100000,%00100000,%00100000,%00000000 ; char 203 (up arrow) + 231+ 48EC 20 20 20 00 + 232+ 48F0 3C 1C 1C 24 defb %00111100,%00011100,%00011100,%00100100,%01000000,%10000000,%00000000,%00000000 ; char 204 (up right arrow) + 232+ 48F4 40 80 00 00 + 233+ 48F8 00 10 18 FC defb %00000000,%00010000,%00011000,%11111100,%00011000,%00010000,%00000000,%00000000 ; char 205 (right arrow) + 233+ 48FC 18 10 00 00 + 234+ 4900 00 00 80 40 defb %00000000,%00000000,%10000000,%01000000,%00100100,%00011100,%00011100,%00111100 ; char 206 (down right arrow) + 234+ 4904 24 1C 1C 3C + 235+ 4908 00 20 20 20 defb %00000000,%00100000,%00100000,%00100000,%00100000,%11111000,%01110000,%00100000 ; char 207 (down arrow) + 235+ 490C 20 F8 70 20 + 236+ 4910 00 00 04 08 defb %00000000,%00000000,%00000100,%00001000,%10010000,%11100000,%11100000,%11110000 ; char 208 (down left arrow) + 236+ 4914 90 E0 E0 F0 + 237+ 4918 00 20 60 FC defb %00000000,%00100000,%01100000,%11111100,%01100000,%00100000,%00000000,%00000000 ; char 209 (left arrow) + 237+ 491C 60 20 00 00 + 238+ 4920 F0 E0 E0 90 defb %11110000,%11100000,%11100000,%10010000,%00001000,%00000100,%00000000,%00000000 ; char 210 (up left arrow) + 238+ 4924 08 04 00 00 + 239+ 4928 38 44 F0 40 defb %00111000,%01000100,%11110000,%01000000,%11110000,%01000100,%00111000,%00000000 ; char 211 (euro) + 239+ 492C F0 44 38 00 + 240+ 4930 00 04 78 A8 defb %00000000,%00000100,%01111000,%10101000,%00101000,%00101000,%00101000,%00000000 ; char 212 (greek pi) + 240+ 4934 28 28 28 00 + 241+ 4938 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00011100,%00100000,%00100000,%00100000 ; char 213 + 241+ 493C 1C 20 20 20 + 242+ 4940 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11100000,%00010000,%00010000,%00010000 ; char 214 + 242+ 4944 E0 10 10 10 + 243+ 4948 10 10 10 E0 defb %00010000,%00010000,%00010000,%11100000,%00000000,%00000000,%00000000,%00000000 ; char 215 + 243+ 494C 00 00 00 00 + 244+ 4950 20 20 20 1C defb %00100000,%00100000,%00100000,%00011100,%00000000,%00000000,%00000000,%00000000 ; char 216 + 244+ 4954 00 00 00 00 + 245+ 4958 00 00 00 1C defb %00000000,%00000000,%00000000,%00011100,%00111100,%00110000,%00110000,%00110000 ; char 217 + 245+ 495C 3C 30 30 30 + 246+ 4960 00 00 00 E0 defb %00000000,%00000000,%00000000,%11100000,%11110000,%00110000,%00110000,%00110000 ; char 218 + 246+ 4964 F0 30 30 30 + 247+ 4968 30 30 30 F0 defb %00110000,%00110000,%00110000,%11110000,%11100000,%00000000,%00000000,%00000000 ; char 219 + 247+ 496C E0 00 00 00 + 248+ 4970 30 30 30 3C defb %00110000,%00110000,%00110000,%00111100,%00011100,%00000000,%00000000,%00000000 ; char 220 + 248+ 4974 1C 00 00 00 + 249+ 4978 00 30 48 48 defb %00000000,%00110000,%01001000,%01001000,%01001000,%00110000,%00000000,%00000000 ; char 221 + 249+ 497C 48 30 00 00 + 250+ 4980 00 30 78 78 defb %00000000,%00110000,%01111000,%01111000,%01111000,%00110000,%00000000,%00000000 ; char 222 + 250+ 4984 78 30 00 00 + 251+ 4988 00 30 78 FC defb %00000000,%00110000,%01111000,%11111100,%11111100,%01111000,%00110000,%00000000 ; char 223 + 251+ 498C FC 78 30 00 + 252+ 4990 FC F8 F0 E0 defb %11111100,%11111000,%11110000,%11100000,%11100000,%11000000,%10000000,%10000000 ; char 224 + 252+ 4994 E0 C0 80 80 + 253+ 4998 FC 7C 3C 1C defb %11111100,%01111100,%00111100,%00011100,%00011100,%00001100,%00000100,%00000100 ; char 225 + 253+ 499C 1C 0C 04 04 + 254+ 49A0 04 04 0C 1C defb %00000100,%00000100,%00001100,%00011100,%00011100,%00111100,%01111100,%11111100 ; char 226 + 254+ 49A4 1C 3C 7C FC + 255+ 49A8 80 80 C0 E0 defb %10000000,%10000000,%11000000,%11100000,%11100000,%11110000,%11111000,%11111100 ; char 227 + 255+ 49AC E0 F0 F8 FC + 256+ 49B0 00 04 0C D8 defb %00000000,%00000100,%00001100,%11011000,%11110000,%11100000,%11000000,%00000000 ; char 228 (checkmark) + 256+ 49B4 F0 E0 C0 00 + 257+ 49B8 00 CC 78 30 defb %00000000,%11001100,%01111000,%00110000,%01111000,%11001100,%00000000,%00000000 ; char 229 (x) + 257+ 49BC 78 CC 00 00 + 258+ 49C0 70 88 88 88 defb %01110000,%10001000,%10001000,%10001000,%01110000,%00100000,%01110000,%00100000 ; char 230 (female) + 258+ 49C4 70 20 70 20 + 259+ 49C8 00 1C 0C 74 defb %00000000,%00011100,%00001100,%01110100,%10010000,%10010000,%01100000,%00000000 ; char 231 (male) + 259+ 49CC 90 90 60 00 + 260+ 49D0 F8 84 84 84 defb %11111000,%10000100,%10000100,%10000100,%10000100,%10000100,%10000100,%11111100 ; char 232 (new doc) + 260+ 49D4 84 84 84 FC + 261+ 49D8 00 F0 FC 84 defb %00000000,%11110000,%11111100,%10000100,%10000100,%10000100,%10000100,%11111100 ; char 233 (folder) + 261+ 49DC 84 84 84 FC + 262+ 49E0 30 78 FC 48 defb %00110000,%01111000,%11111100,%01001000,%01001000,%01001000,%01001000,%01111000 ; char 234 (trash bin) + 262+ 49E4 48 48 48 78 + 263+ 49E8 FC 84 84 84 defb %11111100,%10000100,%10000100,%10000100,%11111100,%10110100,%10110100,%11111100 ; char 235 (floppy disk) + 263+ 49EC FC B4 B4 FC + 264+ 49F0 00 00 D4 D8 defb %00000000,%00000000,%11010100,%11011000,%11010100,%11010100,%00000000,%00000000 ; char 236 (OK) + 264+ 49F4 D4 D4 00 00 + 265+ 49F8 30 78 FC 78 defb %00110000,%01111000,%11111100,%01111000,%01111000,%01001000,%01001000,%01001000 ; char 237 (home) + 265+ 49FC 78 48 48 48 + 266+ 4A00 78 84 A4 A4 defb %01111000,%10000100,%10100100,%10100100,%10110100,%10000100,%01111000,%00000000 ; char 238 (clock) + 266+ 4A04 B4 84 78 00 + 267+ 4A08 00 00 08 F4 defb %00000000,%00000000,%00001000,%11110100,%10101000,%10000000,%00000000,%00000000 ; char 239 (key) + 267+ 4A0C A8 80 00 00 + 268+ 4A10 20 30 78 B0 defb %00100000,%00110000,%01111000,%10110000,%10100000,%10001000,%01110000,%00000000 ; char 240 (undo) + 268+ 4A14 A0 88 70 00 + 269+ 4A18 00 FC CC B4 defb %00000000,%11111100,%11001100,%10110100,%10000100,%10000100,%11111100,%00000000 ; char 241 (letter) + 269+ 4A1C 84 84 FC 00 + 270+ 4A20 60 90 90 F0 defb %01100000,%10010000,%10010000,%11110000,%11110000,%11110000,%11110000,%00000000 ; char 242 (lock) + 270+ 4A24 F0 F0 F0 00 + 271+ 4A28 08 14 14 F0 defb %00001000,%00010100,%00010100,%11110000,%11110000,%11110000,%11110000,%00000000 ; char 243 (unlock) + 271+ 4A2C F0 F0 F0 00 + 272+ 4A30 FC FC 84 B4 defb %11111100,%11111100,%10000100,%10110100,%10010100,%10010100,%10000100,%11111100 ; char 244 (calendar) + 272+ 4A34 94 94 84 FC + 273+ 4A38 00 04 38 58 defb %00000000,%00000100,%00111000,%01011000,%01101000,%01110000,%10000000,%00000000 ; char 245 (diameter) + 273+ 4A3C 68 70 80 00 + 274+ 4A40 78 84 84 84 defb %01111000,%10000100,%10000100,%10000100,%01101100,%00011000,%00001000,%00000000 ; char 246 (baloon) + 274+ 4A44 6C 18 08 00 + 275+ 4A48 30 28 28 28 defb %00110000,%00101000,%00101000,%00101000,%00100000,%01100000,%11100000,%01000000 ; char 247 (note) + 275+ 4A4C 20 60 E0 40 + 276+ 4A50 20 68 E4 E4 defb %00100000,%01101000,%11100100,%11100100,%11100100,%01101000,%00100000,%00000000 ; char 248 (audio on) + 276+ 4A54 E4 68 20 00 + 277+ 4A58 20 60 E0 E0 defb %00100000,%01100000,%11100000,%11100000,%11100000,%01100000,%00100000,%00000000 ; char 249 (audio off) + 277+ 4A5C E0 60 20 00 + 278+ 4A60 80 C0 E0 F0 defb %10000000,%11000000,%11100000,%11110000,%11111000,%11111100,%11110000,%10010000 ; char 250 (pointer) + 278+ 4A64 F8 FC F0 90 + 279+ 4A68 78 84 B4 A4 defb %01111000,%10000100,%10110100,%10100100,%10110100,%10000100,%01111000,%00000000 ; char 251 (©) + 279+ 4A6C B4 84 78 00 + 280+ 4A70 30 48 40 E0 defb %00110000,%01001000,%01000000,%11100000,%01000000,%01001000,%10110000,%00000000 ; char 252 (£) + 280+ 4A74 40 48 B0 00 + 281+ 4A78 78 84 F0 48 defb %01111000,%10000100,%11110000,%01001000,%01001000,%00111100,%10000100,%01111000 ; char 253 (§) + 281+ 4A7C 48 3C 84 78 + 282+ 4A80 00 00 20 00 defb %00000000,%00000000,%00100000,%00000000,%11111000,%00000000,%00100000,%00000000 ; char 254 (÷) + 282+ 4A84 F8 00 20 00 + 283+ 4A88 FC FC FC FC defb %11111100,%11111100,%11111100,%11111100,%11111100,%11111100,%11111100,%11111100 ; char 255 (cursor) + 283+ 4A8C FC FC FC FC + 284+ 4A90 ; here ends the ASCII table + 285+ 4A90 +# file closed: ../include/vdp/6x8fonts-r16.asm + 82 4A90 INCLUDE "../include/vdp/8x8fonts-r18.asm" +# file opened: ../include/vdp/8x8fonts-r18.asm + 1+ 4A90 ; ------------------------------------------------------------------------------ + 2+ 4A90 ; LM80C - 8x8 CHARSET - R1.8 + 3+ 4A90 ; ------------------------------------------------------------------------------ + 4+ 4A90 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 4A90 ; designed by Leonardo Miliani. More info at + 6+ 4A90 ; www DOT leonardomiliani DOT com + 7+ 4A90 ; ------------------------------------------------------------------------------ + 8+ 4A90 ; Code Revision: + 9+ 4A90 ; R1.0 - 20190615 - First revision: ASCII chars (from 0 to 255) - actually, they are 6x8 pixels + 10+ 4A90 ; R1.1 - 20190616 - Converted to 8x8 pixels + 11+ 4A90 ; R1.2 - 20191013 - Added new graphic chars and reorganized previous ones + 12+ 4A90 ; R1.3 - 20191015 - More graphic chars + 13+ 4A90 ; R1.4 - 20191202 - Fixed char 11/12, added new special chars + 14+ 4A90 ; R1.5 - 20191210 - Changed several graphic chars + 15+ 4A90 ; R1.6 - 20200125 - Removed double chars, changed with new ones + 16+ 4A90 ; R1.7 - 20200228 - adopted more usual hexadecimal & binary prefixes + 17+ 4A90 ; R1.8 - 20200524 - New style for char #252 + 18+ 4A90 ; ------------------------------------------------------------------------------ + 19+ 4A90 ; + 20+ 4A90 ;------------------------------------------------------------------------------- + 21+ 4A90 ; + 22+ 4A90 ; 8 x 8 C H A R S E T + 23+ 4A90 ; + 24+ 4A90 ;------------------------------------------------------------------------------- + 25+ 4A90 ; + 26+ 4A90 ; 8X8 CHARS, DESIGNED FOR GRAPHICS 1 MODE + 27+ 4A90 + 28+ 4A90 CHRST88 equ $ + 29+ 4A90 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 0 (null char) + 29+ 4A94 00 00 00 00 + 30+ 4A98 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 1 F1 + 30+ 4A9C 00 00 00 00 + 31+ 4AA0 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 2 F2 + 31+ 4AA4 00 00 00 00 + 32+ 4AA8 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 3 CTRL-C + 32+ 4AAC 00 00 00 00 + 33+ 4AB0 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 4 F3 + 33+ 4AB4 00 00 00 00 + 34+ 4AB8 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 5 F4 + 34+ 4ABC 00 00 00 00 + 35+ 4AC0 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 6 F5 + 35+ 4AC4 00 00 00 00 + 36+ 4AC8 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 7 (bell) + 36+ 4ACC 00 00 00 00 + 37+ 4AD0 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 8 DEL key (backspace) + 37+ 4AD4 00 00 00 00 + 38+ 4AD8 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 9 (H. tab) + 38+ 4ADC 00 00 00 00 + 39+ 4AE0 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 10 (line feed) + 39+ 4AE4 00 00 00 00 + 40+ 4AE8 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 11 (unused) + 40+ 4AEC 00 00 00 00 + 41+ 4AF0 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 12 Form feed (clear screen) + 41+ 4AF4 00 00 00 00 + 42+ 4AF8 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 13 RETURN key (carriage return) + 42+ 4AFC 00 00 00 00 + 43+ 4B00 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 14 CTRL key + 43+ 4B04 00 00 00 00 + 44+ 4B08 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 15 CTRL-O + 44+ 4B0C 00 00 00 00 + 45+ 4B10 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 16 C=/Graphic key + 45+ 4B14 00 00 00 00 + 46+ 4B18 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 17 CTRL-Q + 46+ 4B1C 00 00 00 00 + 47+ 4B20 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 18 CTRL-R + 47+ 4B24 00 00 00 00 + 48+ 4B28 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 19 CTRL-S + 48+ 4B2C 00 00 00 00 + 49+ 4B30 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 20 SHIFT key + 49+ 4B34 00 00 00 00 + 50+ 4B38 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 21 CTRL-U + 50+ 4B3C 00 00 00 00 + 51+ 4B40 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 22 F6 key + 51+ 4B44 00 00 00 00 + 52+ 4B48 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 23 F7 key + 52+ 4B4C 00 00 00 00 + 53+ 4B50 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 24 HELP key + 53+ 4B54 00 00 00 00 + 54+ 4B58 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 25 HOME key + 54+ 4B5C 00 00 00 00 + 55+ 4B60 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 26 INSERT key + 55+ 4B64 00 00 00 00 + 56+ 4B68 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 27 ESCAPE key + 56+ 4B6C 00 00 00 00 + 57+ 4B70 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 28 CRSR LEFT key (cursor left) + 57+ 4B74 00 00 00 00 + 58+ 4B78 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 29 CRSR RIGHT key (cursor right) + 58+ 4B7C 00 00 00 00 + 59+ 4B80 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 30 CRSR UP key (cursor up) + 59+ 4B84 00 00 00 00 + 60+ 4B88 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 31 CRSR DOWN key (cursor down) + 60+ 4B8C 00 00 00 00 + 61+ 4B90 00 00 00 00 defb $00,$00,$00,$00,$00,$00,$00,$00 ; char 32 SPACE key + 61+ 4B94 00 00 00 00 + 62+ 4B98 10 10 10 10 defb %00010000,%00010000,%00010000,%00010000,%00010000,%00000000,%00010000,%00000000 ; char 33 - ! + 62+ 4B9C 10 00 10 00 + 63+ 4BA0 28 28 28 00 defb %00101000,%00101000,%00101000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 34 - " + 63+ 4BA4 00 00 00 00 + 64+ 4BA8 28 28 FE 28 defb %00101000,%00101000,%11111110,%00101000,%11111110,%00101000,%00101000,%00000000 ; char 35 - # + 64+ 4BAC FE 28 28 00 + 65+ 4BB0 10 3C 50 38 defb %00010000,%00111100,%01010000,%00111000,%00010100,%01111000,%00010000,%00000000 ; char 36 - $ + 65+ 4BB4 14 78 10 00 + 66+ 4BB8 00 62 64 08 defb %00000000,%01100010,%01100100,%00001000,%00010000,%00100110,%01000110,%00000000 ; char 37 - % + 66+ 4BBC 10 26 46 00 + 67+ 4BC0 00 30 48 30 defb %00000000,%00110000,%01001000,%00110000,%01001010,%01000100,%00111010,%00000000 ; char 38 - & + 67+ 4BC4 4A 44 3A 00 + 68+ 4BC8 08 10 20 00 defb %00001000,%00010000,%00100000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 39 - ' + 68+ 4BCC 00 00 00 00 + 69+ 4BD0 08 10 20 20 defb %00001000,%00010000,%00100000,%00100000,%00100000,%00010000,%00001000,%00000000 ; char 40 - ( + 69+ 4BD4 20 10 08 00 + 70+ 4BD8 20 10 08 08 defb %00100000,%00010000,%00001000,%00001000,%00001000,%00010000,%00100000,%00000000 ; char 41 - ) + 70+ 4BDC 08 10 20 00 + 71+ 4BE0 00 10 54 38 defb %00000000,%00010000,%01010100,%00111000,%00111000,%01010100,%00010000,%00000000 ; char 42 - * + 71+ 4BE4 38 54 10 00 + 72+ 4BE8 00 10 10 7C defb %00000000,%00010000,%00010000,%01111100,%00010000,%00010000,%00000000,%00000000 ; char 43 - + + 72+ 4BEC 10 10 00 00 + 73+ 4BF0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00011000,%00001000,%00010000 ; char 44 - , + 73+ 4BF4 00 18 08 10 + 74+ 4BF8 00 00 00 7C defb %00000000,%00000000,%00000000,%01111100,%00000000,%00000000,%00000000,%00000000 ; char 45 - - + 74+ 4BFC 00 00 00 00 + 75+ 4C00 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00011000,%00011000,%00000000 ; char 46 - . + 75+ 4C04 00 18 18 00 + 76+ 4C08 00 02 04 08 defb %00000000,%00000010,%00000100,%00001000,%00010000,%00100000,%01000000,%00000000 ; char 47 - / + 76+ 4C0C 10 20 40 00 + 77+ 4C10 38 44 4C 54 defb %00111000,%01000100,%01001100,%01010100,%01100100,%01000100,%00111000,%00000000 ; char 48 - 0 + 77+ 4C14 64 44 38 00 + 78+ 4C18 10 30 50 10 defb %00010000,%00110000,%01010000,%00010000,%00010000,%00010000,%01111100,%00000000 ; char 49 - 1 + 78+ 4C1C 10 10 7C 00 + 79+ 4C20 38 44 04 08 defb %00111000,%01000100,%00000100,%00001000,%00010000,%00100000,%01111100,%00000000 ; char 50 - 2 + 79+ 4C24 10 20 7C 00 + 80+ 4C28 7C 08 10 08 defb %01111100,%00001000,%00010000,%00001000,%00000100,%01000100,%00111000,%00000000 ; char 51 - 3 + 80+ 4C2C 04 44 38 00 + 81+ 4C30 08 18 28 48 defb %00001000,%00011000,%00101000,%01001000,%01111100,%00001000,%00001000,%00000000 ; char 52 - 4 + 81+ 4C34 7C 08 08 00 + 82+ 4C38 7C 40 78 04 defb %01111100,%01000000,%01111000,%00000100,%00000100,%01000100,%00111000,%00000000 ; char 53 - 5 + 82+ 4C3C 04 44 38 00 + 83+ 4C40 38 44 40 78 defb %00111000,%01000100,%01000000,%01111000,%01000100,%01000100,%00111000,%00000000 ; char 54 - 6 + 83+ 4C44 44 44 38 00 + 84+ 4C48 7C 04 08 10 defb %01111100,%00000100,%00001000,%00010000,%00100000,%00100000,%00100000,%00000000 ; char 55 - 7 + 84+ 4C4C 20 20 20 00 + 85+ 4C50 38 44 44 38 defb %00111000,%01000100,%01000100,%00111000,%01000100,%01000100,%00111000,%00000000 ; char 56 - 8 + 85+ 4C54 44 44 38 00 + 86+ 4C58 38 44 44 3C defb %00111000,%01000100,%01000100,%00111100,%00000100,%01000100,%00111000,%00000000 ; char 57 - 9 + 86+ 4C5C 04 44 38 00 + 87+ 4C60 00 18 18 00 defb %00000000,%00011000,%00011000,%00000000,%00011000,%00011000,%00000000,%00000000 ; char 58 - : + 87+ 4C64 18 18 00 00 + 88+ 4C68 00 18 18 00 defb %00000000,%00011000,%00011000,%00000000,%00011000,%00001000,%00010000,%00000000 ; char 59 - ; + 88+ 4C6C 18 08 10 00 + 89+ 4C70 04 08 10 20 defb %00000100,%00001000,%00010000,%00100000,%00010000,%00001000,%00000100,%00000000 ; char 60 - < + 89+ 4C74 10 08 04 00 + 90+ 4C78 00 00 7E 00 defb %00000000,%00000000,%01111110,%00000000,%01111110,%00000000,%00000000,%00000000 ; char 61 - = + 90+ 4C7C 7E 00 00 00 + 91+ 4C80 20 10 08 04 defb %00100000,%00010000,%00001000,%00000100,%00001000,%00010000,%00100000,%00000000 ; char 62 - > + 91+ 4C84 08 10 20 00 + 92+ 4C88 38 44 04 08 defb %00111000,%01000100,%00000100,%00001000,%00010000,%00000000,%00010000,%00000000 ; char 63 - ? + 92+ 4C8C 10 00 10 00 + 93+ 4C90 78 84 BC AC defb %01111000,%10000100,%10111100,%10101100,%10111000,%10000000,%10000100,%01111000 ; char 64 - @ + 93+ 4C94 B8 80 84 78 + 94+ 4C98 38 44 44 44 defb %00111000,%01000100,%01000100,%01000100,%01111100,%01000100,%01000100,%00000000 ; char 65 - A + 94+ 4C9C 7C 44 44 00 + 95+ 4CA0 78 44 44 78 defb %01111000,%01000100,%01000100,%01111000,%01000100,%01000100,%01111000,%00000000 ; char 66 - B + 95+ 4CA4 44 44 78 00 + 96+ 4CA8 38 44 40 40 defb %00111000,%01000100,%01000000,%01000000,%01000000,%01000100,%00111000,%00000000 ; char 67 - C + 96+ 4CAC 40 44 38 00 + 97+ 4CB0 78 44 44 44 defb %01111000,%01000100,%01000100,%01000100,%01000100,%01000100,%01111000,%00000000 ; char 68 - D + 97+ 4CB4 44 44 78 00 + 98+ 4CB8 7C 40 40 70 defb %01111100,%01000000,%01000000,%01110000,%01000000,%01000000,%01111100,%00000000 ; char 69 - E + 98+ 4CBC 40 40 7C 00 + 99+ 4CC0 7C 40 40 70 defb %01111100,%01000000,%01000000,%01110000,%01000000,%01000000,%01000000,%00000000 ; char 70 - F + 99+ 4CC4 40 40 40 00 + 100+ 4CC8 38 44 40 40 defb %00111000,%01000100,%01000000,%01000000,%01011100,%01000100,%00111000,%00000000 ; char 71 - G + 100+ 4CCC 5C 44 38 00 + 101+ 4CD0 44 44 44 7C defb %01000100,%01000100,%01000100,%01111100,%01000100,%01000100,%01000100,%00000000 ; char 72 - H + 101+ 4CD4 44 44 44 00 + 102+ 4CD8 38 10 10 10 defb %00111000,%00010000,%00010000,%00010000,%00010000,%00010000,%00111000,%00000000 ; char 73 - I + 102+ 4CDC 10 10 38 00 + 103+ 4CE0 3C 04 04 04 defb %00111100,%00000100,%00000100,%00000100,%00000100,%01000100,%00111000,%00000000 ; char 74 - J + 103+ 4CE4 04 44 38 00 + 104+ 4CE8 44 44 48 70 defb %01000100,%01000100,%01001000,%01110000,%01001000,%01000100,%01000100,%00000000 ; char 75 - K + 104+ 4CEC 48 44 44 00 + 105+ 4CF0 40 40 40 40 defb %01000000,%01000000,%01000000,%01000000,%01000000,%01000000,%01111100,%00000000 ; char 76 - L + 105+ 4CF4 40 40 7C 00 + 106+ 4CF8 42 66 5A 42 defb %01000010,%01100110,%01011010,%01000010,%01000010,%01000010,%01000010,%00000000 ; char 77 - M + 106+ 4CFC 42 42 42 00 + 107+ 4D00 44 64 54 4C defb %01000100,%01100100,%01010100,%01001100,%01000100,%01000100,%01000100,%00000000 ; char 78 - N + 107+ 4D04 44 44 44 00 + 108+ 4D08 38 44 44 44 defb %00111000,%01000100,%01000100,%01000100,%01000100,%01000100,%00111000,%00000000 ; char 79 - O + 108+ 4D0C 44 44 38 00 + 109+ 4D10 78 44 44 44 defb %01111000,%01000100,%01000100,%01000100,%01111000,%01000000,%01000000,%00000000 ; char 80 - P + 109+ 4D14 78 40 40 00 + 110+ 4D18 38 44 44 44 defb %00111000,%01000100,%01000100,%01000100,%01010100,%01001000,%00110100,%00000000 ; char 81 - Q + 110+ 4D1C 54 48 34 00 + 111+ 4D20 78 44 44 44 defb %01111000,%01000100,%01000100,%01000100,%01111000,%01001000,%01000100,%00000000 ; char 82 - R + 111+ 4D24 78 48 44 00 + 112+ 4D28 3C 40 40 38 defb %00111100,%01000000,%01000000,%00111000,%00000100,%00000100,%01111000,%00000000 ; char 83 - S + 112+ 4D2C 04 04 78 00 + 113+ 4D30 7C 10 10 10 defb %01111100,%00010000,%00010000,%00010000,%00010000,%00010000,%00010000,%00000000 ; char 84 - T + 113+ 4D34 10 10 10 00 + 114+ 4D38 44 44 44 44 defb %01000100,%01000100,%01000100,%01000100,%01000100,%01000100,%00111000,%00000000 ; char 85 - U + 114+ 4D3C 44 44 38 00 + 115+ 4D40 44 44 44 44 defb %01000100,%01000100,%01000100,%01000100,%01000100,%00101000,%00010000,%00000000 ; char 86 - V + 115+ 4D44 44 28 10 00 + 116+ 4D48 42 42 42 42 defb %01000010,%01000010,%01000010,%01000010,%01011010,%01011010,%00100100,%00000000 ; char 87 - W + 116+ 4D4C 5A 5A 24 00 + 117+ 4D50 44 44 28 10 defb %01000100,%01000100,%00101000,%00010000,%00101000,%01000100,%01000100,%00000000 ; char 88 - X + 117+ 4D54 28 44 44 00 + 118+ 4D58 44 44 44 28 defb %01000100,%01000100,%01000100,%00101000,%00010000,%00010000,%00010000,%00000000 ; char 89 - Y + 118+ 4D5C 10 10 10 00 + 119+ 4D60 7C 04 08 10 defb %01111100,%00000100,%00001000,%00010000,%00100000,%01000000,%01111100,%00000000 ; char 90 - Z + 119+ 4D64 20 40 7C 00 + 120+ 4D68 38 20 20 20 defb %00111000,%00100000,%00100000,%00100000,%00100000,%00100000,%00111000,%00000000 ; char 91 - [ + 120+ 4D6C 20 20 38 00 + 121+ 4D70 00 40 20 10 defb %00000000,%01000000,%00100000,%00010000,%00001000,%00000100,%00000010,%00000000 ; char 92 - \ + 121+ 4D74 08 04 02 00 + 122+ 4D78 38 08 08 08 defb %00111000,%00001000,%00001000,%00001000,%00001000,%00001000,%00111000,%00000000 ; char 93 - ] + 122+ 4D7C 08 08 38 00 + 123+ 4D80 10 28 44 00 defb %00010000,%00101000,%01000100,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 94 - ^ + 123+ 4D84 00 00 00 00 + 124+ 4D88 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%01111110,%00000000 ; char 95 _ (underscore) + 124+ 4D8C 00 00 7E 00 + 125+ 4D90 20 10 08 00 defb %00100000,%00010000,%00001000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 96 - ` + 125+ 4D94 00 00 00 00 + 126+ 4D98 00 00 38 04 defb %00000000,%00000000,%00111000,%00000100,%00111100,%01000100,%00111100,%00000000 ; char 97 - a + 126+ 4D9C 3C 44 3C 00 + 127+ 4DA0 40 40 40 78 defb %01000000,%01000000,%01000000,%01111000,%01000100,%01000100,%01111000,%00000000 ; char 98 - b + 127+ 4DA4 44 44 78 00 + 128+ 4DA8 00 00 38 40 defb %00000000,%00000000,%00111000,%01000000,%01000000,%01000100,%00111000,%00000000 ; char 99 - c + 128+ 4DAC 40 44 38 00 + 129+ 4DB0 04 04 04 3C defb %00000100,%00000100,%00000100,%00111100,%01000100,%01000100,%00111100,%00000000 ; char 100 - d + 129+ 4DB4 44 44 3C 00 + 130+ 4DB8 00 00 38 44 defb %00000000,%00000000,%00111000,%01000100,%01111100,%01000000,%00111000,%00000000 ; char 101 - e + 130+ 4DBC 7C 40 38 00 + 131+ 4DC0 18 24 20 70 defb %00011000,%00100100,%00100000,%01110000,%00100000,%00100000,%00100000,%00000000 ; char 102 - f + 131+ 4DC4 20 20 20 00 + 132+ 4DC8 00 00 3C 44 defb %00000000,%00000000,%00111100,%01000100,%01000100,%00111100,%00000100,%00111000 ; char 103 - g + 132+ 4DCC 44 3C 04 38 + 133+ 4DD0 40 40 58 64 defb %01000000,%01000000,%01011000,%01100100,%01000100,%01000100,%01000100,%00000000 ; char 104 - h + 133+ 4DD4 44 44 44 00 + 134+ 4DD8 00 10 00 10 defb %00000000,%00010000,%00000000,%00010000,%00010000,%00010000,%00010000,%00000000 ; char 105 - i + 134+ 4DDC 10 10 10 00 + 135+ 4DE0 08 00 18 08 defb %00001000,%00000000,%00011000,%00001000,%00001000,%00001000,%01001000,%00110000 ; char 106 - j + 135+ 4DE4 08 08 48 30 + 136+ 4DE8 40 40 48 50 defb %01000000,%01000000,%01001000,%01010000,%01100000,%01010000,%01001000,%00000000 ; char 107 - k + 136+ 4DEC 60 50 48 00 + 137+ 4DF0 30 10 10 10 defb %00110000,%00010000,%00010000,%00010000,%00010000,%00010000,%00111000,%00000000 ; char 108 - l + 137+ 4DF4 10 10 38 00 + 138+ 4DF8 00 00 54 6A defb %00000000,%00000000,%01010100,%01101010,%01001010,%01000010,%01000010,%00000000 ; char 109 - m + 138+ 4DFC 4A 42 42 00 + 139+ 4E00 00 00 58 64 defb %00000000,%00000000,%01011000,%01100100,%01000100,%01000100,%01000100,%00000000 ; char 110 - n + 139+ 4E04 44 44 44 00 + 140+ 4E08 00 00 38 44 defb %00000000,%00000000,%00111000,%01000100,%01000100,%01000100,%00111000,%00000000 ; char 111: o + 140+ 4E0C 44 44 38 00 + 141+ 4E10 00 00 78 44 defb %00000000,%00000000,%01111000,%01000100,%01000100,%01111000,%01000000,%01000000 ; char 112: p + 141+ 4E14 44 78 40 40 + 142+ 4E18 00 00 3C 44 defb %00000000,%00000000,%00111100,%01000100,%01000100,%00111100,%00000100,%00000100 ; char 113: q + 142+ 4E1C 44 3C 04 04 + 143+ 4E20 00 00 58 64 defb %00000000,%00000000,%01011000,%01100100,%01000000,%01000000,%01000000,%00000000 ; char 114: r + 143+ 4E24 40 40 40 00 + 144+ 4E28 00 00 38 40 defb %00000000,%00000000,%00111000,%01000000,%00111000,%00000100,%01111000,%00000000 ; char 115: s + 144+ 4E2C 38 04 78 00 + 145+ 4E30 20 20 70 20 defb %00100000,%00100000,%01110000,%00100000,%00100000,%00100100,%00011000,%00000000 ; char 116: t + 145+ 4E34 20 24 18 00 + 146+ 4E38 00 00 44 44 defb %00000000,%00000000,%01000100,%01000100,%01000100,%01001100,%00110100,%00000000 ; char 117: u + 146+ 4E3C 44 4C 34 00 + 147+ 4E40 00 00 44 44 defb %00000000,%00000000,%01000100,%01000100,%01000100,%00101000,%00010000,%00000000 ; char 118: v + 147+ 4E44 44 28 10 00 + 148+ 4E48 00 00 44 44 defb %00000000,%00000000,%01000100,%01000100,%01010100,%01010100,%00101000,%00000000 ; char 119: w + 148+ 4E4C 54 54 28 00 + 149+ 4E50 00 00 44 28 defb %00000000,%00000000,%01000100,%00101000,%00010000,%00101000,%01000100,%00000000 ; char 120: x + 149+ 4E54 10 28 44 00 + 150+ 4E58 00 00 44 44 defb %00000000,%00000000,%01000100,%01000100,%01001100,%00110100,%00000100,%00111000 ; char 121: y + 150+ 4E5C 4C 34 04 38 + 151+ 4E60 00 00 7C 08 defb %00000000,%00000000,%01111100,%00001000,%00010000,%00100000,%01111100,%00000000 ; char 122: z + 151+ 4E64 10 20 7C 00 + 152+ 4E68 18 20 20 40 defb %00011000,%00100000,%00100000,%01000000,%00100000,%00100000,%00011000,%00000000 ; char 123: { + 152+ 4E6C 20 20 18 00 + 153+ 4E70 10 10 10 10 defb %00010000,%00010000,%00010000,%00010000,%00010000,%00010000,%00010000,%00000000 ; char 124: | + 153+ 4E74 10 10 10 00 + 154+ 4E78 30 08 08 04 defb %00110000,%00001000,%00001000,%00000100,%00001000,%00001000,%00110000,%00000000 ; char 125: } + 154+ 4E7C 08 08 30 00 + 155+ 4E80 20 54 08 00 defb %00100000,%01010100,%00001000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 126: ~ + 155+ 4E84 00 00 00 00 + 156+ 4E88 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 127 (delete) - end the standard ASCII (0-127) + 156+ 4E8C 00 00 00 00 + 157+ 4E90 3C 42 A5 81 defb %00111100,%01000010,%10100101,%10000001,%10100101,%10011001,%01000010,%00111100 ; char 128 (open face) + 157+ 4E94 A5 99 42 3C + 158+ 4E98 3C 7E DB FF defb %00111100,%01111110,%11011011,%11111111,%11011011,%11100111,%01111110,%00111100 ; char 129 (full face) + 158+ 4E9C DB E7 7E 3C + 159+ 4EA0 6C FE FE FE defb %01101100,%11111110,%11111110,%11111110,%01111100,%00111000,%00010000,%00000000 ; char 130 (hearts) + 159+ 4EA4 7C 38 10 00 + 160+ 4EA8 10 38 7C FE defb %00010000,%00111000,%01111100,%11111110,%01111100,%00111000,%00010000,%00000000 ; char 131 (diamonds) + 160+ 4EAC 7C 38 10 00 + 161+ 4EB0 10 38 54 FE defb %00010000,%00111000,%01010100,%11111110,%01010100,%00010000,%01111100,%00000000 ; char 132 (clus) + 161+ 4EB4 54 10 7C 00 + 162+ 4EB8 10 38 7C FE defb %00010000,%00111000,%01111100,%11111110,%11010110,%00010000,%01111100,%00000000 ; char 133 (spades) + 162+ 4EBC D6 10 7C 00 + 163+ 4EC0 18 18 18 FF defb %00011000,%00011000,%00011000,%11111111,%11111111,%00011000,%00011000,%00011000 ; char 134 + 163+ 4EC4 FF 18 18 18 + 164+ 4EC8 00 00 00 1F defb %00000000,%00000000,%00000000,%00011111,%00011111,%00011000,%00011000,%00011000 ; char 135 + 164+ 4ECC 1F 18 18 18 + 165+ 4ED0 00 00 00 F8 defb %00000000,%00000000,%00000000,%11111000,%11111000,%00011000,%00011000,%00011000 ; char 136 + 165+ 4ED4 F8 18 18 18 + 166+ 4ED8 18 18 18 F8 defb %00011000,%00011000,%00011000,%11111000,%11111000,%00000000,%00000000,%00000000 ; char 137 + 166+ 4EDC F8 00 00 00 + 167+ 4EE0 18 18 18 1F defb %00011000,%00011000,%00011000,%00011111,%00011111,%00000000,%00000000,%00000000 ; char 138 + 167+ 4EE4 1F 00 00 00 + 168+ 4EE8 18 18 18 FF defb %00011000,%00011000,%00011000,%11111111,%11111111,%00000000,%00000000,%00000000 ; char 139 + 168+ 4EEC FF 00 00 00 + 169+ 4EF0 18 18 18 1F defb %00011000,%00011000,%00011000,%00011111,%00011111,%00011000,%00011000,%00011000 ; char 140 + 169+ 4EF4 1F 18 18 18 + 170+ 4EF8 00 00 00 FF defb %00000000,%00000000,%00000000,%11111111,%11111111,%00011000,%00011000,%00011000 ; char 141 + 170+ 4EFC FF 18 18 18 + 171+ 4F00 18 18 18 F8 defb %00011000,%00011000,%00011000,%11111000,%11111000,%00011000,%00011000,%00011000 ; char 142 + 171+ 4F04 F8 18 18 18 + 172+ 4F08 00 00 00 FF defb %00000000,%00000000,%00000000,%11111111,%11111111,%00000000,%00000000,%00000000 ; char 143 + 172+ 4F0C FF 00 00 00 + 173+ 4F10 18 18 18 18 defb %00011000,%00011000,%00011000,%00011000,%00011000,%00011000,%00011000,%00011000 ; char 144 + 173+ 4F14 18 18 18 18 + 174+ 4F18 03 07 0E 1C defb %00000011,%00000111,%00001110,%00011100,%00111000,%01110000,%11100000,%11000000 ; char 145 + 174+ 4F1C 38 70 E0 C0 + 175+ 4F20 C0 E0 70 38 defb %11000000,%11100000,%01110000,%00111000,%00011100,%00001110,%00000111,%00000011 ; char 146 + 175+ 4F24 1C 0E 07 03 + 176+ 4F28 C3 E7 7E 3C defb %11000011,%11100111,%01111110,%00111100,%00111100,%01111110,%11100111,%11000011 ; char 147 + 176+ 4F2C 3C 7E E7 C3 + 177+ 4F30 10 10 10 FF defb %00010000,%00010000,%00010000,%11111111,%00010000,%00010000,%00010000,%00010000 ; char 148 + 177+ 4F34 10 10 10 10 + 178+ 4F38 00 00 00 1F defb %00000000,%00000000,%00000000,%00011111,%00010000,%00010000,%00010000,%00010000 ; char 149 + 178+ 4F3C 10 10 10 10 + 179+ 4F40 00 00 00 F0 defb %00000000,%00000000,%00000000,%11110000,%00010000,%00010000,%00010000,%00010000 ; char 150 + 179+ 4F44 10 10 10 10 + 180+ 4F48 10 10 10 F0 defb %00010000,%00010000,%00010000,%11110000,%00000000,%00000000,%00000000,%00000000 ; char 151 + 180+ 4F4C 00 00 00 00 + 181+ 4F50 10 10 10 1F defb %00010000,%00010000,%00010000,%00011111,%00000000,%00000000,%00000000,%00000000 ; char 152 + 181+ 4F54 00 00 00 00 + 182+ 4F58 10 10 10 FF defb %00010000,%00010000,%00010000,%11111111,%00000000,%00000000,%00000000,%00000000 ; char 153 + 182+ 4F5C 00 00 00 00 + 183+ 4F60 10 10 10 1F defb %00010000,%00010000,%00010000,%00011111,%00010000,%00010000,%00010000,%00010000 ; char 154 + 183+ 4F64 10 10 10 10 + 184+ 4F68 00 00 00 FF defb %00000000,%00000000,%00000000,%11111111,%00010000,%00010000,%00010000,%00010000 ; char 155 + 184+ 4F6C 10 10 10 10 + 185+ 4F70 10 10 10 F0 defb %00010000,%00010000,%00010000,%11110000,%00010000,%00010000,%00010000,%00010000 ; char 156 + 185+ 4F74 10 10 10 10 + 186+ 4F78 00 00 00 FF defb %00000000,%00000000,%00000000,%11111111,%00000000,%00000000,%00000000,%00000000 ; char 157 + 186+ 4F7C 00 00 00 00 + 187+ 4F80 10 10 10 10 defb %00010000,%00010000,%00010000,%00010000,%00010000,%00010000,%00010000,%00010000 ; char 158 + 187+ 4F84 10 10 10 10 + 188+ 4F88 01 02 04 08 defb %00000001,%00000010,%00000100,%00001000,%00010000,%00100000,%01000000,%10000000 ; char 159 + 188+ 4F8C 10 20 40 80 + 189+ 4F90 80 40 20 10 defb %10000000,%01000000,%00100000,%00010000,%00001000,%00000100,%00000010,%00000001 ; char 160 + 189+ 4F94 08 04 02 01 + 190+ 4F98 81 42 24 18 defb %10000001,%01000010,%00100100,%00011000,%00011000,%00100100,%01000010,%10000001 ; char 161 + 190+ 4F9C 18 24 42 81 + 191+ 4FA0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%11111111,%11111111 ; char 162 + 191+ 4FA4 00 00 FF FF + 192+ 4FA8 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11111111,%11111111,%11111111,%11111111 ; char 163 + 192+ 4FAC FF FF FF FF + 193+ 4FB0 00 00 FF FF defb %00000000,%00000000,%11111111,%11111111,%11111111,%11111111,%11111111,%11111111 ; char 164 + 193+ 4FB4 FF FF FF FF + 194+ 4FB8 FF FF 00 00 defb %11111111,%11111111,%00000000,%00000000,%00000000,%00000000,%00000000,%00000000 ; char 165 + 194+ 4FBC 00 00 00 00 + 195+ 4FC0 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%00000000,%00000000,%00000000,%00000000 ; char 166 + 195+ 4FC4 00 00 00 00 + 196+ 4FC8 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%11111111,%11111111,%00000000,%00000000 ; char 167 + 196+ 4FCC FF FF 00 00 + 197+ 4FD0 C0 C0 C0 C0 defb %11000000,%11000000,%11000000,%11000000,%11000000,%11000000,%11000000,%11000000 ; char 168 + 197+ 4FD4 C0 C0 C0 C0 + 198+ 4FD8 F0 F0 F0 F0 defb %11110000,%11110000,%11110000,%11110000,%11110000,%11110000,%11110000,%11110000 ; char 169 + 198+ 4FDC F0 F0 F0 F0 + 199+ 4FE0 FC FC FC FC defb %11111100,%11111100,%11111100,%11111100,%11111100,%11111100,%11111100,%11111100 ; char 170 + 199+ 4FE4 FC FC FC FC + 200+ 4FE8 03 03 03 03 defb %00000011,%00000011,%00000011,%00000011,%00000011,%00000011,%00000011,%00000011 ; char 171 + 200+ 4FEC 03 03 03 03 + 201+ 4FF0 0F 0F 0F 0F defb %00001111,%00001111,%00001111,%00001111,%00001111,%00001111,%00001111,%00001111 ; char 172 + 201+ 4FF4 0F 0F 0F 0F + 202+ 4FF8 3F 3F 3F 3F defb %00111111,%00111111,%00111111,%00111111,%00111111,%00111111,%00111111,%00111111 ; char 173 + 202+ 4FFC 3F 3F 3F 3F + 203+ 5000 FF 81 81 81 defb %11111111,%10000001,%10000001,%10000001,%10000001,%10000001,%10000001,%11111111 ; char 174 + 203+ 5004 81 81 81 FF + 204+ 5008 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11110000,%11110000,%11110000,%11110000 ; char 175 + 204+ 500C F0 F0 F0 F0 + 205+ 5010 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00001111,%00001111,%00001111,%00001111 ; char 176 + 205+ 5014 0F 0F 0F 0F + 206+ 5018 0F 0F 0F 0F defb %00001111,%00001111,%00001111,%00001111,%00000000,%00000000,%00000000,%00000000 ; char 177 + 206+ 501C 00 00 00 00 + 207+ 5020 F0 F0 F0 F0 defb %11110000,%11110000,%11110000,%11110000,%00000000,%00000000,%00000000,%00000000 ; char 178 + 207+ 5024 00 00 00 00 + 208+ 5028 F0 F0 F0 F0 defb %11110000,%11110000,%11110000,%11110000,%00001111,%00001111,%00001111,%00001111 ; char 179 + 208+ 502C 0F 0F 0F 0F + 209+ 5030 0F 0F 0F 0F defb %00001111,%00001111,%00001111,%00001111,%11110000,%11110000,%11110000,%11110000 ; char 180 + 209+ 5034 F0 F0 F0 F0 + 210+ 5038 3C 3C 3C 3C defb %00111100,%00111100,%00111100,%00111100,%00111100,%00111100,%00111100,%00111100 ; char 181 + 210+ 503C 3C 3C 3C 3C + 211+ 5040 C3 C3 C3 C3 defb %11000011,%11000011,%11000011,%11000011,%11000011,%11000011,%11000011,%11000011 ; char 182 + 211+ 5044 C3 C3 C3 C3 + 212+ 5048 FF FF 00 00 defb %11111111,%11111111,%00000000,%00000000,%00000000,%00000000,%11111111,%11111111 ; char 183 + 212+ 504C 00 00 FF FF + 213+ 5050 00 00 FF FF defb %00000000,%00000000,%11111111,%11111111,%11111111,%11111111,%00000000,%00000000 ; char 184 + 213+ 5054 FF FF 00 00 + 214+ 5058 33 33 CC CC defb %00110011,%00110011,%11001100,%11001100,%00110011,%00110011,%11001100,%11001100 ; char 185 + 214+ 505C 33 33 CC CC + 215+ 5060 55 AA 55 AA defb %01010101,%10101010,%01010101,%10101010,%01010101,%10101010,%01010101,%10101010 ; char 186 + 215+ 5064 55 AA 55 AA + 216+ 5068 66 33 99 CC defb %01100110,%00110011,%10011001,%11001100,%01100110,%00110011,%10011001,%11001100 ; char 187 + 216+ 506C 66 33 99 CC + 217+ 5070 CC 99 33 66 defb %11001100,%10011001,%00110011,%01100110,%11001100,%10011001,%00110011,%01100110 ; char 188 + 217+ 5074 CC 99 33 66 + 218+ 5078 33 99 CC 66 defb %00110011,%10011001,%11001100,%01100110,%00110011,%10011001,%11001100,%01100110 ; char 189 + 218+ 507C 33 99 CC 66 + 219+ 5080 66 CC 99 33 defb %01100110,%11001100,%10011001,%00110011,%01100110,%11001100,%10011001,%00110011 ; char 190 + 219+ 5084 66 CC 99 33 + 220+ 5088 10 10 7C 10 defb %00010000,%00010000,%01111100,%00010000,%00010000,%00000000,%01111100,%00000000 ; char 191 (±) + 220+ 508C 10 00 7C 00 + 221+ 5090 60 18 06 18 defb %01100000,%00011000,%00000110,%00011000,%01100000,%00000000,%01111110,%00000000 ; char 192 (≥) + 221+ 5094 60 00 7E 00 + 222+ 5098 06 18 60 18 defb %00000110,%00011000,%01100000,%00011000,%00000110,%00000000,%01111110,%00000000 ; char 193 (≤) + 222+ 509C 06 00 7E 00 + 223+ 50A0 3E 20 20 20 defb %00111110,%00100000,%00100000,%00100000,%10100000,%01100000,%00100000,%00000000 ; char 194 (square root) + 223+ 50A4 A0 60 20 00 + 224+ 50A8 30 48 48 30 defb %00110000,%01001000,%01001000,%00110000,%00000000,%00000000,%00000000,%00000000 ; char 195 (°) + 224+ 50AC 00 00 00 00 + 225+ 50B0 60 10 30 40 defb %01100000,%00010000,%00110000,%01000000,%01110000,%00000000,%00000000,%00000000 ; char 196 (²) + 225+ 50B4 70 00 00 00 + 226+ 50B8 00 00 2A 54 defb %00000000,%00000000,%00101010,%01010100,%00000000,%01111110,%00000000,%00000000 ; char 197 + 226+ 50BC 00 7E 00 00 + 227+ 50C0 00 54 A8 00 defb %00000000,%01010100,%10101000,%00000000,%01010100,%10101000,%00000000,%00000000 ; char 198 (≈) + 227+ 50C4 54 A8 00 00 + 228+ 50C8 80 C0 E0 F0 defb %10000000,%11000000,%11100000,%11110000,%11100000,%11000000,%10000000,%00000000 ; char 199 + 228+ 50CC E0 C0 80 00 + 229+ 50D0 FE 7C 38 10 defb %11111110,%01111100,%00111000,%00010000,%00000000,%00000000,%00000000,%00000000 ; char 200 + 229+ 50D4 00 00 00 00 + 230+ 50D8 01 03 07 0F defb %00000001,%00000011,%00000111,%00001111,%00000111,%00000011,%00000001,%00000000 ; char 201 + 230+ 50DC 07 03 01 00 + 231+ 50E0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00010000,%00111000,%01111100,%11111110 ; char 202 + 231+ 50E4 10 38 7C FE + 232+ 50E8 10 38 7C 10 defb %00010000,%00111000,%01111100,%00010000,%00010000,%00010000,%00010000,%00000000 ; char 203 (up arrow) + 232+ 50EC 10 10 10 00 + 233+ 50F0 1E 0E 0E 12 defb %00011110,%00001110,%00001110,%00010010,%00100000,%01000000,%00000000,%00000000 ; char 204 (up right arrow) + 233+ 50F4 20 40 00 00 + 234+ 50F8 00 08 0C FE defb %00000000,%00001000,%00001100,%11111110,%00001100,%00001000,%00000000,%00000000 ; char 205 (right arrow) + 234+ 50FC 0C 08 00 00 + 235+ 5100 00 40 20 12 defb %00000000,%01000000,%00100000,%00010010,%00001110,%00001110,%00011110,%00000000 ; char 206 (down right arrow) + 235+ 5104 0E 0E 1E 00 + 236+ 5108 10 10 10 10 defb %00010000,%00010000,%00010000,%00010000,%01111100,%00111000,%00010000,%00000000 ; char 207 (down arrow) + 236+ 510C 7C 38 10 00 + 237+ 5110 00 04 08 90 defb %00000000,%00000100,%00001000,%10010000,%11100000,%11100000,%11110000,%00000000 ; char 208 (down left arrow) + 237+ 5114 E0 E0 F0 00 + 238+ 5118 00 20 60 FE defb %00000000,%00100000,%01100000,%11111110,%01100000,%00100000,%00000000,%00000000 ; char 209 (left arrow) + 238+ 511C 60 20 00 00 + 239+ 5120 F0 E0 E0 90 defb %11110000,%11100000,%11100000,%10010000,%00001000,%00000100,%00000000,%00000000 ; char 210 (up left arrow) + 239+ 5124 08 04 00 00 + 240+ 5128 38 44 F0 40 defb %00111000,%01000100,%11110000,%01000000,%11110000,%01000100,%00111000,%00000000 ; char 211 (euro) + 240+ 512C F0 44 38 00 + 241+ 5130 00 02 7C A8 defb %00000000,%00000010,%01111100,%10101000,%00101000,%00101000,%00101000,%00000000 ; char 212 (greek pi) + 241+ 5134 28 28 28 00 + 242+ 5138 00 00 00 07 defb %00000000,%00000000,%00000000,%00000111,%00001000,%00010000,%00010000,%00010000 ; char 213 + 242+ 513C 08 10 10 10 + 243+ 5140 00 00 00 C0 defb %00000000,%00000000,%00000000,%11000000,%00100000,%00010000,%00010000,%00010000 ; char 214 + 243+ 5144 20 10 10 10 + 244+ 5148 10 10 20 C0 defb %00010000,%00010000,%00100000,%11000000,%00000000,%00000000,%00000000,%00000000 ; char 215 + 244+ 514C 00 00 00 00 + 245+ 5150 10 10 08 07 defb %00010000,%00010000,%00001000,%00000111,%00000000,%00000000,%00000000,%00000000 ; char 216 + 245+ 5154 00 00 00 00 + 246+ 5158 00 00 00 07 defb %00000000,%00000000,%00000000,%00000111,%00001111,%00011100,%00011000,%00011000 ; char 217 + 246+ 515C 0F 1C 18 18 + 247+ 5160 00 00 00 E0 defb %00000000,%00000000,%00000000,%11100000,%11110000,%00111000,%00011000,%00011000 ; char 218 + 247+ 5164 F0 38 18 18 + 248+ 5168 18 18 38 F0 defb %00011000,%00011000,%00111000,%11110000,%11100000,%00000000,%00000000,%00000000 ; char 219 + 248+ 516C E0 00 00 00 + 249+ 5170 18 18 1C 0F defb %00011000,%00011000,%00011100,%00001111,%00000111,%00000000,%00000000,%00000000 ; char 220 + 249+ 5174 07 00 00 00 + 250+ 5178 00 3C 42 42 defb %00000000,%00111100,%01000010,%01000010,%01000010,%01000010,%00111100,%00000000 ; char 221 + 250+ 517C 42 42 3C 00 + 251+ 5180 00 3C 7E 7E defb %00000000,%00111100,%01111110,%01111110,%01111110,%01111110,%00111100,%00000000 ; char 222 + 251+ 5184 7E 7E 3C 00 + 252+ 5188 00 18 3C 7E defb %00000000,%00011000,%00111100,%01111110,%01111110,%00111100,%00011000,%00000000 ; char 223 + 252+ 518C 7E 3C 18 00 + 253+ 5190 FF FE FC F8 defb %11111111,%11111110,%11111100,%11111000,%11110000,%11100000,%11000000,%10000000 ; char 224 + 253+ 5194 F0 E0 C0 80 + 254+ 5198 FF 7F 3F 1F defb %11111111,%01111111,%00111111,%00011111,%00001111,%00000111,%00000011,%00000001 ; char 225 + 254+ 519C 0F 07 03 01 + 255+ 51A0 01 03 07 0F defb %00000001,%00000011,%00000111,%00001111,%00011111,%00111111,%01111111,%11111111 ; char 226 + 255+ 51A4 1F 3F 7F FF + 256+ 51A8 80 C0 E0 F0 defb %10000000,%11000000,%11100000,%11110000,%11111000,%11111100,%11111110,%11111111 ; char 227 + 256+ 51AC F8 FC FE FF + 257+ 51B0 00 02 06 6C defb %00000000,%00000010,%00000110,%01101100,%01111000,%01110000,%01100000,%00000000 ; char 228 (checkmark) + 257+ 51B4 78 70 60 00 + 258+ 51B8 00 66 3C 18 defb %00000000,%01100110,%00111100,%00011000,%00111100,%01100110,%00000000,%00000000 ; char 229 (x) + 258+ 51BC 3C 66 00 00 + 259+ 51C0 38 44 44 44 defb %00111000,%01000100,%01000100,%01000100,%00111000,%00010000,%00111000,%00010000 ; char 230 (female) + 259+ 51C4 38 10 38 10 + 260+ 51C8 07 03 3D 44 defb %00000111,%00000011,%00111101,%01000100,%01000100,%01000100,%00111000,%00000000 ; char 231 (male) + 260+ 51CC 44 44 38 00 + 261+ 51D0 78 44 42 42 defb %01111000,%01000100,%01000010,%01000010,%01000010,%01000010,%01000010,%01111110 ; char 232 (new doc) + 261+ 51D4 42 42 42 7E + 262+ 51D8 00 F8 FF 81 defb %00000000,%11111000,%11111111,%10000001,%10000001,%10000001,%10000001,%11111111 ; char 233 (folder) + 262+ 51DC 81 81 81 FF + 263+ 51E0 10 7C FE 54 defb %00010000,%01111100,%11111110,%01010100,%01010100,%01010100,%01010100,%01111100 ; char 234 (trash bin) + 263+ 51E4 54 54 54 7C + 264+ 51E8 FF 81 81 81 defb %11111111,%10000001,%10000001,%10000001,%10111101,%10101101,%10101101,%11111111 ; char 235 (floppy disk) + 264+ 51EC BD AD AD FF + 265+ 51F0 00 EA AA AC defb %00000000,%11101010,%10101010,%10101100,%10101100,%10101010,%11101010,%00000000 ; char 236 (OK) + 265+ 51F4 AC AA EA 00 + 266+ 51F8 18 7E FF 7E defb %00011000,%01111110,%11111111,%01111110,%01111110,%01100110,%01100110,%01100110 ; char 237 (home) + 266+ 51FC 7E 66 66 66 + 267+ 5200 3C 42 91 91 defb %00111100,%01000010,%10010001,%10010001,%10011101,%10000001,%01000010,%00111100 ; char 238 (clock) + 267+ 5204 9D 81 42 3C + 268+ 5208 00 02 05 FD defb %00000000,%00000010,%00000101,%11111101,%10100101,%10100010,%00000000,%00000000 ; char 239 (key) + 268+ 520C A5 A2 00 00 + 269+ 5210 08 0C 3E 4C defb %00001000,%00001100,%00111110,%01001100,%01001000,%01000010,%01000010,%00111100 ; char 240 (undo) + 269+ 5214 48 42 42 3C + 270+ 5218 00 FF C3 A5 defb %00000000,%11111111,%11000011,%10100101,%10011001,%10000001,%11111111,%00000000 ; char 241 (letter) + 270+ 521C 99 81 FF 00 + 271+ 5220 38 44 44 7C defb %00111000,%01000100,%01000100,%01111100,%01111100,%01111100,%01111100,%00000000 ; char 242 (lock) + 271+ 5224 7C 7C 7C 00 + 272+ 5228 06 09 09 F8 defb %00000110,%00001001,%00001001,%11111000,%11111000,%11111000,%11111000,%00000000 ; char 243 (unlock) + 272+ 522C F8 F8 F8 00 + 273+ 5230 FF FF 81 AD defb %11111111,%11111111,%10000001,%10101101,%10100101,%10100101,%10000001,%11111111 ; char 244 (calendar) + 273+ 5234 A5 A5 81 FF + 274+ 5238 01 1A 24 4A defb %00000001,%00011010,%00100100,%01001010,%01010010,%00100100,%01011000,%10000000 ; char 245 (diameter) + 274+ 523C 52 24 58 80 + 275+ 5240 7E 81 81 81 defb %01111110,%10000001,%10000001,%10000001,%10000001,%01110110,%00001100,%00000100 ; char 246 (baloon) + 275+ 5244 81 76 0C 04 + 276+ 5248 0C 0A 0A 0A defb %00001100,%00001010,%00001010,%00001010,%00001000,%00011000,%00111000,%00010000 ; char 247 (note) + 276+ 524C 08 18 38 10 + 277+ 5250 12 31 F5 F5 defb %00010010,%00110001,%11110101,%11110101,%11110101,%11110101,%00110001,%00010010 ; char 248 (audio on) + 277+ 5254 F5 F5 31 12 + 278+ 5258 10 30 F0 F0 defb %00010000,%00110000,%11110000,%11110000,%11110000,%11110000,%00110000,%00010000 ; char 249 (audio off) + 278+ 525C F0 F0 30 10 + 279+ 5260 40 60 70 78 defb %01000000,%01100000,%01110000,%01111000,%01111100,%01111110,%01111000,%01001000 ; char 250 (pointer) + 279+ 5264 7C 7E 78 48 + 280+ 5268 3C 42 99 A1 defb %00111100,%01000010,%10011001,%10100001,%10100001,%10011001,%01000010,%00111100 ; char 251 (©) + 280+ 526C A1 99 42 3C + 281+ 5270 18 24 20 78 defb %00011000,%00100100,%00100000,%01111000,%00100000,%00100010,%01011100,%00000000 ; char 252 (£) + 281+ 5274 20 22 5C 00 + 282+ 5278 3C 42 78 24 defb %00111100,%01000010,%01111000,%00100100,%00100100,%00011110,%01000010,%00111100 ; char 253 (§) + 282+ 527C 24 1E 42 3C + 283+ 5280 00 00 10 00 defb %00000000,%00000000,%00010000,%00000000,%01111100,%00000000,%00010000,%00000000 ; char 254 (÷) + 283+ 5284 7C 00 10 00 + 284+ 5288 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%11111111,%11111111,%11111111,%11111111 ; char 255 (cursor) + 284+ 528C FF FF FF FF + 285+ 5290 +# file closed: ../include/vdp/8x8fonts-r18.asm + 83 5290 INCLUDE "../include/vdp/logo-fonts.asm" +# file opened: ../include/vdp/logo-fonts.asm + 1+ 5290 ; ------------------------------------------------------------------------------ + 2+ 5290 ; LM80C - LOGO CHARSET - R1.1 + 3+ 5290 ; ------------------------------------------------------------------------------ + 4+ 5290 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 5290 ; designed by Leonardo Miliani. More info at + 6+ 5290 ; www DOT leonardomiliani DOT com + 7+ 5290 ; ------------------------------------------------------------------------------ + 8+ 5290 ; Code Revision: + 9+ 5290 ; R1.0 - 20200124 - First revision: logo chars + 10+ 5290 ; R1.1 - 20200229 - Adopted usual hexadecimal & binary prefixes + 11+ 5290 ; ------------------------------------------------------------------------------ + 12+ 5290 + 13+ 5290 LOGOFONT: equ $ + 14+ 5290 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%00000000,%00000000 ; 0 + 14+ 5294 00 00 00 00 + 15+ 5298 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%11111111,%11111111,%11111111,%11111111 ; 1 + 15+ 529C FF FF FF FF + 16+ 52A0 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%00000000,%00000000,%00000000,%00000000 ; 2 + 16+ 52A4 00 00 00 00 + 17+ 52A8 0F 0F 0F 0F defb %00001111,%00001111,%00001111,%00001111,%00001111,%00001111,%00001111,%00001111 ; 3 + 17+ 52AC 0F 0F 0F 0F + 18+ 52B0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11111111,%11111111,%11111111,%11111111 ; 4 + 18+ 52B4 FF FF FF FF + 19+ 52B8 F0 F0 F0 F0 defb %11110000,%11110000,%11110000,%11110000,%11110000,%11110000,%11110000,%11110000 ; 5 + 19+ 52BC F0 F0 F0 F0 + 20+ 52C0 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%00001111,%00001111,%00001111,%00001111 ; 6 + 20+ 52C4 0F 0F 0F 0F + 21+ 52C8 00 00 00 00 defb %00000000,%00000000,%00000000,%00000000,%11110000,%11110000,%11110000,%11110000 ; 7 + 21+ 52CC F0 F0 F0 F0 + 22+ 52D0 F0 F0 F0 F0 defb %11110000,%11110000,%11110000,%11110000,%00000000,%00000000,%00000000,%00000000 ; 8 + 22+ 52D4 00 00 00 00 + 23+ 52D8 0F 0F 0F 0F defb %00001111,%00001111,%00001111,%00001111,%00000000,%00000000,%00000000,%00000000 ; 9 + 23+ 52DC 00 00 00 00 + 24+ 52E0 00 00 00 FC defb %00000000,%00000000,%00000000,%11111100,%11111111,%00000111,%00000011,%00000000 ; 10 + 24+ 52E4 FF 07 03 00 + 25+ 52E8 00 00 00 3F defb %00000000,%00000000,%00000000,%00111111,%11111111,%11100000,%11000000,%00000000 ; 11 + 25+ 52EC FF E0 C0 00 + 26+ 52F0 18 18 1F 19 defb %00011000,%00011000,%00011111,%00011001,%00011001,%00011111,%00011000,%00011000 ; 12 + 26+ 52F4 19 1F 18 18 + 27+ 52F8 18 18 F8 98 defb %00011000,%00011000,%11111000,%10011000,%10011000,%11111000,%00011000,%00011000 ; 13 + 27+ 52FC 98 F8 18 18 + 28+ 5300 18 18 1C 1F defb %00011000,%00011000,%00011100,%00011111,%00001111,%00000000,%00000000,%00000000 ; 14 + 28+ 5304 0F 00 00 00 + 29+ 5308 00 00 00 0F defb %00000000,%00000000,%00000000,%00001111,%00011111,%00011100,%00011000,%00011000 ; 15 + 29+ 530C 1F 1C 18 18 + 30+ 5310 00 00 00 F0 defb %00000000,%00000000,%00000000,%11110000,%11111000,%00111000,%00011000,%00011000 ; 16 + 30+ 5314 F8 38 18 18 + 31+ 5318 18 18 38 F8 defb %00011000,%00011000,%00111000,%11111000,%11110000,%00000000,%00000000,%00000000 ; 17 + 31+ 531C F0 00 00 00 + 32+ 5320 00 00 00 FF defb %00000000,%00000000,%00000000,%11111111,%11111111,%00000000,%00000000,%00000000 ; 18 + 32+ 5324 FF 00 00 00 + 33+ 5328 0F 0F 0F 0F defb %00001111,%00001111,%00001111,%00001111,%11111111,%11111111,%11111111,%11111111 ; 19 + 33+ 532C FF FF FF FF + 34+ 5330 F0 F0 F0 F0 defb %11110000,%11110000,%11110000,%11110000,%11111111,%11111111,%11111111,%11111111 ; 20 + 34+ 5334 FF FF FF FF + 35+ 5338 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%11110000,%11110000,%11110000,%11110000 ; 21 + 35+ 533C F0 F0 F0 F0 + 36+ 5340 FF FF FF FF defb %11111111,%11111111,%11111111,%11111111,%00001111,%00001111,%00001111,%00001111 ; 22 + 36+ 5344 0F 0F 0F 0F + 37+ 5348 00 30 78 78 defb %00000000,%00110000,%01111000,%01111000,%00110000,%00000000,%00000000,%00000000 ; 23 + 37+ 534C 30 00 00 00 + 38+ 5350 +# file closed: ../include/vdp/logo-fonts.asm + 84 5350 + 85 5350 ; include ROM/RAM switcher + 86 5350 INCLUDE "../include/switcher/switcher-r1.03.asm" +# file opened: ../include/switcher/switcher-r1.03.asm + 1+ 5350 ; ------------------------------------------------------------------------------ + 2+ 5350 ; LM80C - ROM/RAM SWITCHER - R1.03 + 3+ 5350 ; ------------------------------------------------------------------------------ + 4+ 5350 ; The following code is intended to be used with LM80C Z80-based computer + 5+ 5350 ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 5350 ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 5350 ; kind of warranty: you can use them at your own risk. + 8+ 5350 ; You are free to use them for any non-commercial use: you are only asked to + 9+ 5350 ; maintain the copyright notices, include this advice and the note to the + 10+ 5350 ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 5350 ; redistribuite them. + 12+ 5350 ; https://www.leonardomiliani.com + 13+ 5350 ; + 14+ 5350 ; Please support me by visiting the following links: + 15+ 5350 ; Main project page: https://www.leonardomiliani.com + 16+ 5350 ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 5350 ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 5350 ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 5350 ; ------------------------------------------------------------------------------ + 20+ 5350 ; Code Revision: + 21+ 5350 ; R1.0 - 20200718 - First version + 22+ 5350 ; R1.1 - 20200827 - PIO settings now are part of the file + 23+ 5350 ; R1.02 - 20210319 - support for LM80C DOS and its repositioning into high-RAM + 24+ 5350 ; R1.03 - 20210408 - code revision + 25+ 5350 ;------------------------------------------------------------------------------- + 26+ 5350 + 27+ 5350 TMP_FW_LOC: equ $8000 ; address from where to make a temporary copy of the FW + 28+ 5350 ;------------------------------------------------------------------------------- + 29+ 5350 ; THIS CODE WILL BE EXECUTED FROM RAM + 30+ 5350 3E FC RAMRUN: ld A,%11111100 ; set ROM off and RAM on.. + 31+ 5352 D3 01 out (PIO_DB),A ; ...by setting bit #0 to 0 (and leave VRAM bank #0) + 32+ 5354 01 9C 53 ld BC,END_OF_FW ; let's copy back FW into low RAM - bytes to copy + 33+ 5357 21 00 80 ld HL,TMP_FW_LOC ; source address + 34+ 535A 11 00 00 ld DE,$0000 ; dest. address + 35+ 535D ED B0 ldir ; copy! + 36+ 535F AF xor A + 37+ 5360 D3 01 out (PIO_DB),A ; all LEDs off - finished copying + 38+ 5362 C3 AE 02 jp INIT_HW ; return control to old init (now into RAM) + 39+ 5365 + 40+ 5365 ;------------------------------------------------------------------------------- + 41+ 5365 ; copy the whole contents of ROM into RAM then disable the first memory + 42+ 5365 3A F9 53 ROM2RAM: ld A,(basicStarted); check if BASIC is already started + 43+ 5368 FE 59 cp 'Y' ; to see if this is a power-up + 44+ 536A 20 0C jr NZ,CNTCP2RAM ; no, continue copy to RAM + 45+ 536C ; WARNING: Do **NOT** change the following "out()" sequence, ABSOLUTELY! + 46+ 536C 3E CF ld A,%11001111 ; set mode 3 ("control mode") + 47+ 536E D3 03 out (PIO_CB),A ; for PIO port B + 48+ 5370 AF xor A ; set LEDs off, RAM on, VRAM on bank #0 + 49+ 5371 D3 01 out (PIO_DB),A ; send settings to PIO register + 50+ 5373 D3 03 out (PIO_CB),A ; set pins following register's status + 51+ 5375 C3 AE 02 jp INIT_HW ; jump to re-init HW + 52+ 5378 + 53+ 5378 ; WARNING: Do **NOT** change the following "out()" sequence, ABSOLUTELY! + 54+ 5378 3E CF CNTCP2RAM: ld A,%11001111 ; set mode 3 (mode control) + 55+ 537A D3 03 out (PIO_CB),A ; for PIO port B + 56+ 537C 3E FD ld A,%11111101 ; set pin #0 as HIGH to enable ROM + 57+ 537E D3 01 out (PIO_DB),A ; store the value into the internal register + 58+ 5380 AF xor A ; set pins to OUTPUT + 59+ 5381 D3 03 out (PIO_CB),A ; for port B, activating the RAM + 60+ 5383 ; copy DOS + 61+ 5383 01 98 11 ld BC,$FFFF-DOSSTART+1 ; bytes to copy + 62+ 5386 21 9C 53 ld HL,END_OF_FW ; load DOS from its original location and... + 63+ 5389 11 68 EE ld DE,DOSSTART ; ...store it into its portion of memory + 64+ 538C ED B0 ldir ; copy! + 65+ 538E ; copy BASIC + 66+ 538E 01 9C 53 ld BC,END_OF_FW ; copy FW from ROM to high RAM + 67+ 5391 21 00 00 ld HL,$0000 ; source address + 68+ 5394 11 00 80 ld DE,TMP_FW_LOC ; dest. address + 69+ 5397 ED B0 ldir ; copy! + 70+ 5399 C3 50 D3 jp RAMRUN+TMP_FW_LOC; jump to execute code into RAM + 71+ 539C + 72+ 539C ;------------------------------------------------------------------------------- + 73+ 539C END_OF_FW: equ $ ; this is the last cell of the firmware +# file closed: ../include/switcher/switcher-r1.03.asm + 87 539C + 88 539C ; include workspace equates + 89 539C INCLUDE "../include/workspace/workspace-r1.02.asm" +# file opened: ../include/workspace/workspace-r1.02.asm + 1+ 539C ; ------------------------------------------------------------------------------ + 2+ 539C ; LM80C 64K - WORKSPACE EQUATES - R1.02 + 3+ 539C ; ------------------------------------------------------------------------------ + 4+ 539C ; The following code is intended to be used with LM80C Z80-based computer + 5+ 539C ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 539C ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 539C ; kind of warranty: you can use them at your own risk. + 8+ 539C ; You are free to use them for any non-commercial use: you are only asked to + 9+ 539C ; maintain the copyright notices, include this advice and the note to the + 10+ 539C ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 539C ; redistribuite them. + 12+ 539C ; https://www.leonardomiliani.com + 13+ 539C ; + 14+ 539C ; Please support me by visiting the following links: + 15+ 539C ; Main project page: https://www.leonardomiliani.com + 16+ 539C ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 539C ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 539C ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 539C ; ------------------------------------------------------------------------------ + 20+ 539C + 21+ 539C ; set starting of RAM based on computer model + 22+ 539C SERBUF_START equ END_OF_FW ; RAM starts here + 23+ 539C + 24+ 539C ;------------------------------------------------------------------------------- + 25+ 539C serInPtr equ SERBUF_START + SER_BUFSIZE + 26+ 539C serRdPtr equ serInPtr+2 + 27+ 539C serBufUsed equ serRdPtr+2 + 28+ 539C basicStarted equ serBufUsed+1 + 29+ 539C bufWrap equ (SERBUF_START + SER_BUFSIZE) & $FF + 30+ 539C TEMPSTACK equ CURPOS - 3 ; top of BASIC line input buffer so is "free ram" when BASIC resets + 31+ 539C + 32+ 539C ; BASIC WORK SPACE LOCATIONS + 33+ 539C ; THE INTERPRETER ALLOCATES THE FOLLOWING RAM CELLS + 34+ 539C ; TO STORE IMPORTANT VALUES USED FOR SOME SPECIFIC FUNCTIONS: + 35+ 539C ; THEY CAN BE VECTOR (ADDRESSES) FUNCTIONS, SYSTEM DATAS (I.E. VARIABLES) + 36+ 539C ; AND SO ON. THE FIRST CELLS ARE FILLED WITH VALUES STORED INTO ROM AT $(INITAB) ADDRESS + 37+ 539C WRKSPC equ basicStarted+$01; (3) BASIC Work space + 38+ 539C NMIUSR equ WRKSPC+$03 ; (3) NMI exit point routine + 39+ 539C USR equ NMIUSR+$03 ; (3) "USR (x)" jump <-- in (USR+$01)/(USR+$02) the user can store the address of a specific machine language routine + 40+ 539C OUTSUB equ USR+$03 ; (1) "out p,n" + 41+ 539C OTPORT equ OUTSUB+$01 ; (2) Port (p) + 42+ 539C DIVSUP equ OTPORT+$02 ; (1) Division support routine + 43+ 539C DIV1 equ DIVSUP+$01 ; (4) <- Values + 44+ 539C DIV2 equ DIV1+$04 ; (4) <- to + 45+ 539C DIV3 equ DIV2+$04 ; (3) <- be + 46+ 539C DIV4 equ DIV3+$03 ; (2) <-inserted + 47+ 539C SEED equ DIV4+$02 ; (35) Random number seed <-- starting address of a seed table + 48+ 539C LSTRND equ SEED+$23 ; (4) Last random number + 49+ 539C INPSUB equ LSTRND+$04 ; (1) INP A,(x) Routine + 50+ 539C INPORT equ INPSUB+$01 ; (2) PORT (x) + 51+ 539C LWIDTH equ INPORT+$02 ; (1) Terminal width + 52+ 539C COMMAN equ LWIDTH+$01 ; (1) Width for commas + 53+ 539C NULFLG equ COMMAN+$01 ; (1) Null after input byte flag + 54+ 539C CTLOFG equ NULFLG+$01 ; (1) Control "O" flag + 55+ 539C CHKSUM equ CTLOFG+$01 ; (2) Array load/save check sum + 56+ 539C NMIFLG equ CHKSUM+$02 ; (1) Flag for NMI break routine + 57+ 539C BRKFLG equ NMIFLG+$01 ; (1) Break flag + 58+ 539C RINPUT equ BRKFLG+$01 ; (3) Input reflection + 59+ 539C STRSPC equ RINPUT+$03 ; (2) Pointer to bottom (start) of string space - default is 100 bytes below the top of memory + 60+ 539C LINEAT equ STRSPC+$02 ; (2) Current line number. -1 means "direct mode", while -2 means cold start. + 61+ 539C HLPLN equ LINEAT+$02 ; (2) Current line with errors + 62+ 539C KEYDEL equ HLPLN+$02 ; (1) delay before key auto-repeat starts + 63+ 539C AUTOKE equ KEYDEL+$01 ; (1) delay for key auto-repeat + 64+ 539C FNKEYS equ AUTOKE+$01 ; (128) default text of FN keys + 65+ 539C BASTXT equ FNKEYS+$80 ; (3) Pointer to start of BASIC program in memory + 66+ 539C ; - - - - - - - - - - - - - - - - - - - the above are locations pre-filled by the firmware at startup + 67+ 539C BUFFER equ BASTXT+$03 ; (5) Input buffer + 68+ 539C STACK equ BUFFER+$05 ; (85) Initial stack + 69+ 539C CURPOS equ STACK+$55 ; (1) Character position on line + 70+ 539C LCRFLG equ CURPOS+$01 ; (1) Locate/Create flag for DIM statement + 71+ 539C TYPE equ LCRFLG+$01 ; (1) Data type flag: 0=numeric, non-zero=string + 72+ 539C DATFLG equ TYPE+$01 ; (1) Literal statement flag + 73+ 539C LSTRAM equ DATFLG+$01 ; (2) Last available RAM location for BASIC + 74+ 539C DOSER equ LSTRAM+$02 ; (1) Error from DOS + 75+ 539C TMPDBF equ DOSER+$01 ; (36) Secondary buffer for DOS + 76+ 539C TMSTPT equ TMPDBF+$24 ; (2) Temporary string pointer + 77+ 539C TMSTPL equ TMSTPT+$02 ; (12) Temporary string pool + 78+ 539C TMPSTR equ TMSTPL+$0C ; (4) Temporary string + 79+ 539C STRBOT equ TMPSTR+$04 ; (2) Bottom of string space + 80+ 539C CUROPR equ STRBOT+$02 ; (2) Current operator in EVAL + 81+ 539C LOOPST equ CUROPR+$02 ; (2) First statement of loop + 82+ 539C DATLIN equ LOOPST+$02 ; (2) Line of current DATA item + 83+ 539C FORFLG equ DATLIN+$02 ; (1) "FOR" loop flag + 84+ 539C LSTBIN equ FORFLG+$01 ; (1) Last byte entered + 85+ 539C READFG equ LSTBIN+$01 ; (1) Read/Input flag + 86+ 539C BRKLIN equ READFG+$01 ; (2) Line of break + 87+ 539C NXTOPR equ BRKLIN+$02 ; (2) Next operator in EVAL + 88+ 539C ERRLIN equ NXTOPR+$02 ; (2) Line of error + 89+ 539C CONTAD equ ERRLIN+$02 ; (2) Where to CONTinue + 90+ 539C TMRCNT equ CONTAD+$02 ; (4) TMR counter for 1/100 seconds + 91+ 539C CTC0IV equ TMRCNT+$04 ; (3) CTC0 interrupt vector + 92+ 539C CTC1IV equ CTC0IV+$03 ; (3) CTC1 interrupt vector + 93+ 539C CTC2IV equ CTC1IV+$03 ; (3) CTC2 interrupt vector + 94+ 539C CTC3IV equ CTC2IV+$03 ; (3) CTC3 interrupt vector + 95+ 539C ; - - - - - - - - - - - - - - - - - - - VIDEO REGISTERS - FROM HERE... + 96+ 539C SCR_SIZE_W equ CTC3IV+$03 ; (1) screen width (it can be either 40 chars or 32 chars/bytes) + 97+ 539C SCR_SIZE_H equ SCR_SIZE_W+$01 ; (1) screen height (it can be 24/48/192: 24 for text, 48 for MC, 192 for graphics) + 98+ 539C SCR_MODE equ SCR_SIZE_H+$01 ; (1) screen mode (0=text, 1=G1, 2=G2, 3=MC, 4=ExG2) + 99+ 539C SCR_NAM_TB equ SCR_MODE+$01 ; (2) video name table address + 100+ 539C SCR_CURS_X equ SCR_NAM_TB+$02 ; (1) cursor X + 101+ 539C SCR_CURS_Y equ SCR_CURS_X+$01 ; (1) cursor Y + 102+ 539C SCR_CUR_NX equ SCR_CURS_Y+$01 ; (1) new cursor X position + 103+ 539C SCR_CUR_NY equ SCR_CUR_NX+$01 ; (1) new cursor Y position + 104+ 539C SCR_ORG_CHR equ SCR_CUR_NY+$01 ; (1) original char positioned under the cursor + 105+ 539C CRSR_STATE equ SCR_ORG_CHR+$01 ; (1) state of cursor (1=on, 0=off) + 106+ 539C LSTCSRSTA equ CRSR_STATE+$01 ; (1) last cursor state + 107+ 539C PRNTVIDEO equ LSTCSRSTA+$01 ; (1) print on video buffer (1=on / 0=off) set to off on graphic only modes + 108+ 539C CHR4VID equ PRNTVIDEO+$01 ; (1) char for video buffer + 109+ 539C FRGNDCLR equ CHR4VID+$01 ; (1) foreground color as set by SCREEN or COLOR commands + 110+ 539C BKGNDCLR equ FRGNDCLR+$01 ; (1) background color as set by SCREEN or COLOR commands + 111+ 539C TMPBFR1 equ BKGNDCLR+$01 ; (2) word for general purposes use (temp. buffer for 1 or 2 bytes) + 112+ 539C TMPBFR2 equ TMPBFR1+$02 ; (2) word for general purposes use (temp. buffer for 1 or 2 bytes) + 113+ 539C TMPBFR3 equ TMPBFR2+$02 ; (2) word for general purposes use (temp. buffer for 1 or 2 bytes) + 114+ 539C TMPBFR4 equ TMPBFR3+$02 ; (2) word for general purposes use (temp. buffer for 1 or 2 bytes) + 115+ 539C VIDEOBUFF equ TMPBFR4+$02 ; (40) buffer used for video scrolling and other purposes + 116+ 539C VIDTMP1 equ VIDEOBUFF+$28 ; (2) temporary video word + 117+ 539C VIDTMP2 equ VIDTMP1+$02 ; (2) temporary video word + 118+ 539C ; - - - - - - - - - - - - - - - - - - - ...TO HERE. DO NOT ADD ANYTHING RELATED TO VPD OUT OF THIS RANGE, + 119+ 539C ; OTHERWISE YOU WILL HAVE TO CHECK THE POINTER IN "CLR_RAM_REG" FUNCTION + 120+ 539C ; - - - - - - - - - - - - - - - - - - - SOUND & KEYBOARD REGISTERS - FROM HERE... + 121+ 539C CHASNDDTN equ VIDTMP2+$02 ; (2) sound Ch.A duration (in 1/100s) + 122+ 539C CHBSNDDTN equ CHASNDDTN+$02 ; (2) sound Ch.B duration (in 1/100s) + 123+ 539C CHCSNDDTN equ CHBSNDDTN+$02 ; (2) sound Ch.C duration (in 1/100s) + 124+ 539C KBDNPT equ CHCSNDDTN+$02 ; (1) temp cell used to flag if input comes from keyboard + 125+ 539C KBTMP equ KBDNPT+$01 ; (1) temp cell used by keyboard scanner + 126+ 539C TMPKEYBFR equ KBTMP+$01 ; (1) temp buffer for last key pressed + 127+ 539C LASTKEYPRSD equ TMPKEYBFR+$01 ; (1) last key code pressed + 128+ 539C STATUSKEY equ LASTKEYPRSD+$01 ; (1) status key, used for auto-repeat + 129+ 539C KEYTMR equ STATUSKEY+$01 ; (2) timer used for auto-repeat key + 130+ 539C CONTROLKEYS equ KEYTMR+$02 ; (1) flags for control keys (bit#0=SHIFT; bit#1=CTRL; bit#2=C=) + 131+ 539C ; - - - - - - - - - - - - - - - - - - - ...TO HERE. DO NOT ADD ANYTHING RELATED TO PSG OUT OF THIS RANGE, + 132+ 539C ; OTHERWISE YOU WILL HAVE TO CHANGE THE POINTER IN "initPSG" FUNCTION + 133+ 539C SERIALS_EN equ CONTROLKEYS+$01 ; (1) serial ports status: bit 0 for Port1 (A), bit 1 for Port2 (B): 0=OFF, 1=ON + 134+ 539C SERABITS equ SERIALS_EN+$01 ; (1) serial port A data bits + 135+ 539C SERBBITS equ SERABITS+$01 ; (1) serial port B data bits + 136+ 539C DOS_EN equ SERBBITS+$01 ; (1) DOS enable/disable (1/0) + 137+ 539C ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + 138+ 539C ; from here there are the RAM locations that + 139+ 539C ; are saved during SAVE + 140+ 539C PROGND equ DOS_EN+$01 ; (2) End of program + 141+ 539C VAREND equ PROGND+$02 ; (2) End of variables + 142+ 539C ARREND equ VAREND+$02 ; (2) End of arrays + 143+ 539C NXTDAT equ ARREND+$02 ; (2) Next data item + 144+ 539C FNRGNM equ NXTDAT+$02 ; (2) Name of FN argument + 145+ 539C FNARG equ FNRGNM+$02 ; (4) FN argument value + 146+ 539C FPREG equ FNARG+$04 ; (3) Floating point register + 147+ 539C FPEXP equ FPREG+$03 ; (1) Floating point exponent + 148+ 539C SGNRES equ FPEXP+$01 ; (1) Sign of result + 149+ 539C PBUFF equ SGNRES+$01 ; (13) Number print buffer + 150+ 539C MULVAL equ PBUFF+$0D ; (3) Multiplier + 151+ 539C PROGST equ MULVAL+$03 ; (100) Start of program text area + 152+ 539C STLOOK equ PROGST+$64 ; Start of memory test + 153+ 539C +# file closed: ../include/workspace/workspace-r1.02.asm + 90 539C + 91 539C ; include the latest versions of the CF & DOS modules + 92 539C ; do NOT move these files from this position and + 93 539C ; do NOT alter their order! + 94 539C INCLUDE "../include/dos/dos-1.05.asm" +# file opened: ../include/dos/dos-1.05.asm + 1+ 539C ; ------------------------------------------------------------------------------ + 2+ 539C ; LM80C 64K - DOS ROUTINES - R1.05 + 3+ 539C ; ------------------------------------------------------------------------------ + 4+ 539C ; The following code is intended to be used with LM80C Z80-based computer + 5+ 539C ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ 539C ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ 539C ; kind of warranty: you can use them at your own risk. + 8+ 539C ; You are free to use them for any non-commercial use: you are only asked to + 9+ 539C ; maintain the copyright notices, include this advice and the note to the + 10+ 539C ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ 539C ; redistribuite them. + 12+ 539C ; https://www.leonardomiliani.com + 13+ 539C ; + 14+ 539C ; Please support me by visiting the following links: + 15+ 539C ; Main project page: https://www.leonardomiliani.com + 16+ 539C ; Schematics and code: https://github.com/leomil72/LM80C + 17+ 539C ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ 539C ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ 539C ; ------------------------------------------------------------------------------ + 20+ 539C ; + 21+ 539C ; ------------------------------------------------------------------------------ + 22+ 539C ; Code Revision: + 23+ 539C ; R1.0 - 20210306 - first release + 24+ 539C ; R1.01 - 20210309 - code cleaning & optimization - new behaviour for ERASE (full erase everything) + 25+ 539C ; R1.02 - 20210310 - code optimization - new UNDELETE feature for DISK statement + 26+ 539C ; R1.03 - 20210316 - code size enhancements + 27+ 539C ; R1.04 - 20210319 - code re-organization and new positioning into RAM + 28+ 539C ; R1.05 - 20210327 - added support for sequential files + 29+ 539C ; + 30+ 539C ;------------------------------------------------------------------------------ + 31+ 539C + 32+ 539C + 33+ 539C org $EE68 + 34+ EE68 + 35+ EE68 DOSSTART: equ $ + 36+ EE68 4C 4D 38 30 DSKHDR defb "LM80C DOS",$00,"1.05",$00 ; disk header + 36+ EE6C 43 20 44 4F + 36+ EE70 53 00 31 2E + 36+ EE74 30 35 00 + 37+ EE77 00 01 DSKDIRADR: defb $00,$01 ; 1st sector of directory ($0001) + 38+ EE79 + 39+ EE79 DIR_STRT: equ TMPDBF ; (2) start of directory + 40+ EE79 DAT_STRT: equ DIR_STRT+$02 ; (2) start of DATA area + 41+ EE79 DIR_SCT: equ DAT_STRT+$02 ; (2) sector of first free entry in the directory + 42+ EE79 NTR_NBR: equ DIR_SCT+$02 ; (2) number of free entry + 43+ EE79 BYT_SIZ: equ NTR_NBR+$02 ; (2) file size in bytes + 44+ EE79 SCT_SIZ: equ BYT_SIZ+$02 ; (1) file size in sectors + 45+ EE79 MSW_SCT: equ SCT_SIZ+$01 ; (2) MSW sector of file + 46+ EE79 LSW_SCT: equ MSW_SCT+$02 ; (2) LSW sector of file + 47+ EE79 RAM_PTR: equ LSW_SCT+$02 ; (2) pointer to RAM + 48+ EE79 TPBF1: equ RAM_PTR+$02 ; (2) temp. word + 49+ EE79 TPBF2: equ TPBF1+$02 ; (2) temp. word + 50+ EE79 TPBF3: equ TPBF2+$02 ; (2) temp. word + 51+ EE79 TPBF4: equ TPBF3+$02 ; (2) temp. word + 52+ EE79 SRTMEM: equ TPBF4+$02 ; (2) temp. word + 53+ EE79 ENDMEM: equ SRTMEM+$02 ; (2) temp. word + 54+ EE79 + 55+ EE79 + 56+ EE79 ; ************************************************************************************** + 57+ EE79 ; B A S I C I N T E R F A C E + 58+ EE79 ;*************************************************************************************** + 59+ EE79 + 60+ EE79 ; OPEN a sequential file + 61+ EE79 ; OPEN "filename",flnm,mod = open file "filename" with #flnm for READ (mod=0) or WRITE (mod=1) + 62+ EE79 CD EA F1 OPEN: call CHKFLNM ; check if a string follows + 63+ EE7C CD 47 1B call CHKSYN ; Make sure ',' follows + 64+ EE7F 2C defb ',' + 65+ EE80 CD A7 2A call GETINT ; get file number + 66+ EE83 32 35 55 ld (TMPDBF),A ; store it into a temp buffer + 67+ EE86 CD 47 1B call CHKSYN ; Make sure ',' follows + 68+ EE89 2C defb ',' + 69+ EE8A CD A7 2A call GETINT ; get mode + 70+ EE8D FE 02 cp $02 ; 0 or 1? + 71+ EE8F D2 5B 1E jp NC,FCERR ; no, illegal function call + 72+ EE92 32 36 55 ld (TMPDBF+1),A ; store it into a temp buffer + 73+ EE95 2B dec HL ; dec 'cos GETCHR INCs + 74+ EE96 CD 90 1D call GETCHR ; check if something follows + 75+ EE99 C2 49 18 jp NZ,SNERR ; if something more, raise a syntax error + 76+ EE9C E5 push HL ; store code string pointer + 77+ EE9D CD EA F3 call OPNFIL ; call open file + 78+ EEA0 E1 pop HL ; retrieve code string pointer + 79+ EEA1 DA 30 F0 jp C,DOS_ERR ; any error? + 80+ EEA4 C9 ret ; return to caller + 81+ EEA5 + 82+ EEA5 + 83+ EEA5 ; CLOSE a file + 84+ EEA5 CD A7 2A CLOSE: call GETINT ; look for a number + 85+ EEA8 32 35 55 ld (TMPDBF),A ; store file number + 86+ EEAB E5 push HL ; store code string pointer + 87+ EEAC CD F4 F4 call CLOSFIL ; close an open file + 88+ EEAF E1 pop HL ; retrieve code string pointer + 89+ EEB0 DA 30 F0 jp C,DOS_ERR + 90+ EEB3 C9 ret ; return to caller + 91+ EEB4 + 92+ EEB4 + 93+ EEB4 ; LOAD "filename"[,1] <- load a BASIC program from disk + 94+ EEB4 ; LOAD x,y,w,z <- load a sector from disc, LBA address equals to ((((z*256)+w)*256)+y)*256)+x + 95+ EEB4 CD 07 EF LOAD: call LDSVPT ; check what's following + 96+ EEB7 CA D5 EE jp Z,LOADST ; number - load a single sector + 97+ EEBA CD A4 3E call DIRMOD ; a file can be loaded ONLY in direct mode + 98+ EEBD C2 5E 18 jp NZ,IMERR ; raise error if in indirect mode + 99+ EEC0 CD F4 F1 call CHKFN1 ; string - evaluate file name + 100+ EEC3 CD 37 F0 call CHK1AR ; check for ",1" argument + 101+ EEC6 22 9E 55 ld (TMPBFR1),HL ; store HL + 102+ EEC9 21 F6 EE ld HL,TXTLDG ; loading message + 103+ EECC CD 29 27 call PRS ; print + 104+ EECF CD 73 F9 call LODFILE ; load file into memory + 105+ EED2 C3 EA EE jp LDEND ; retrieve registers and leave + 106+ EED5 2A 9E 55 LOADST: ld HL,(TMPBFR1) ; retrieve HL + 107+ EED8 CD 19 EF call GET4AR ; get 4 arguments + 108+ EEDB 22 9E 55 ld (TMPBFR1),HL ; store HL + 109+ EEDE CD 0E FD call CF_SETSTR ; set sector + 110+ EEE1 CD 50 FD call CF_RD_SEC ; read sector + 111+ EEE4 38 0B jr C,LDERR ; load error? + 112+ EEE6 CD 44 FD call CF_STANDBY ; put CF in standby mode + 113+ EEE9 AF xor A ; clear Carry + 114+ EEEA 2A 9E 55 LDEND: ld HL,(TMPBFR1) ; retrieve HL + 115+ EEED DA 30 F0 jp C,DOS_ERR ; jump if DOS error + 116+ EEF0 C9 ret ; return to caller + 117+ EEF1 1E 40 LDERR: ld E,D4 ; load error + 118+ EEF3 C3 63 18 jp ERROR + 119+ EEF6 4C 6F 61 64 TXTLDG: defb "Loading file... ",0 + 119+ EEFA 69 6E 67 20 + 119+ EEFE 66 69 6C 65 + 119+ EF02 2E 2E 2E 20 + 119+ EF06 00 + 120+ EF07 + 121+ EF07 + 122+ EF07 ; common code for LOAD/SAVE to check the type of operation required + 123+ EF07 ; (load/save a file or a single sector) + 124+ EF07 ; returns Z if argument is a number, NZ if it's a string + 125+ EF07 2B LDSVPT: dec HL ; dec 'cos GETCHR INCs + 126+ EF08 CD 90 1D call GETCHR ; check if something follows + 127+ EF0B CA 49 18 jp Z,SNERR ; if anything else, raise a syntax error + 128+ EF0E 22 9E 55 ld (TMPBFR1),HL ; save current code string pointer + 129+ EF11 CD 33 22 call EVAL ; Evaluate expression + 130+ EF14 3A 30 55 ld A,(TYPE) ; Get variable type + 131+ EF17 B7 or A ; Is it a string variable? + 132+ EF18 C9 ret ; return to caller + 133+ EF19 + 134+ EF19 + 135+ EF19 ; shared code between LOAD and SAVE + 136+ EF19 ; get 4 arguments after the command LOAD or SAVE + 137+ EF19 ; and load them into appropriate registers + 138+ EF19 2A 9E 55 GET4AR: ld HL,(TMPBFR1) ; retrieve string code pointer + 139+ EF1C CD A7 2A call GETINT ; get 1st pointer + 140+ EF1F 32 35 55 ld (TMPDBF),A ; store it into a temp buffer + 141+ EF22 CD 47 1B call CHKSYN ; Make sure ',' follows + 142+ EF25 2C defb ',' + 143+ EF26 CD A7 2A call GETINT ; get 2nd pointer + 144+ EF29 32 36 55 ld (TMPDBF+1),A ; store it into a temp buffer + 145+ EF2C CD 47 1B call CHKSYN ; Make sure ',' follows + 146+ EF2F 2C defb ',' + 147+ EF30 CD A7 2A call GETINT ; get 3rd pointer + 148+ EF33 32 37 55 ld (TMPDBF+2),A ; store it into a temp buffer + 149+ EF36 CD 47 1B call CHKSYN ; Make sure ',' follows + 150+ EF39 2C defb ',' + 151+ EF3A CD A7 2A call GETINT ; get 4th pointer + 152+ EF3D 57 ld D,A ; store it + 153+ EF3E 3A 35 55 ld A,(TMPDBF) ; retrieve 1st pointer + 154+ EF41 4F ld C,A + 155+ EF42 3A 36 55 ld A,(TMPDBF+1) ; retrieve 2nd pointer + 156+ EF45 47 ld B,A + 157+ EF46 3A 37 55 ld A,(TMPDBF+2) ; retrieve 3rd pointer + 158+ EF49 5F ld E,A + 159+ EF4A CD CC FC call CF_INIT ; init CF card + 160+ EF4D DA 61 18 jp C,NRERR ; error if device not available/ready + 161+ EF50 C9 ret ; return to caller + 162+ EF51 + 163+ EF51 + 164+ EF51 ; save a file onto the disk + 165+ EF51 ; syntax: save "filename" to save a BASIC program + 166+ EF51 ; save x,y,z to save IO buffer into x-y-z sector + 167+ EF51 ; save "filename",start,end to save a portion of memory + 168+ EF51 2B SAVE: dec HL ; dec 'cos GETCHR INCs + 169+ EF52 CD 90 1D call GETCHR ; check if something follows + 170+ EF55 CA 49 18 jp Z,SNERR ; if nothing else, raise a syntax error + 171+ EF58 22 9E 55 ld (TMPBFR1),HL ; save current code string pointer + 172+ EF5B CD 33 22 call EVAL ; Evaluate expression + 173+ EF5E 3A 30 55 ld A,(TYPE) ; Get variable type + 174+ EF61 B7 or A ; Is it a string variable? + 175+ EF62 CA C0 EF jp Z,SAVESCT ; no - save a single sector + 176+ EF65 CD F4 F1 call CHKFN1 ; yes, load string name + 177+ EF68 ED 53 A4 55 ld (TMPBFR4),DE ; store lenght into another buffer + 178+ EF6C ED 43 4E 55 ld (TPBF4+2),BC ; store address into another buffer + 179+ EF70 3E 80 ld A,$80 ; set BAS as file type + 180+ EF72 32 4C 55 ld (TPBF4),A + 181+ EF75 2B dec HL ; dec 'cos GETCHR INCs + 182+ EF76 CD 90 1D call GETCHR ; check if something follows + 183+ EF79 28 30 jr Z,SAVE1 ; no, jump over + 184+ EF7B CD 47 1B call CHKSYN ; yes - Make sure ',' follows + 185+ EF7E 2C defb ',' + 186+ EF7F 22 35 55 ld (TMPDBF),HL ; store code string pointer + 187+ EF82 CD 33 22 call EVAL ; check expression + 188+ EF85 2A 35 55 ld HL,(TMPDBF) ; point back to the beginning of epression + 189+ EF88 3A 30 55 ld A,(TYPE) ; check result type + 190+ EF8B B7 or A ; is it another string? + 191+ EF8C 20 4B jr NZ,RENFIL ; yes, jump to rename file + 192+ EF8E CD 21 22 call GETNUM ; no, this is the memory address for a BIN file + 193+ EF91 CD 46 1E call DEINT ; Get integer -32768 to 32767 + 194+ EF94 ED 53 4E 55 ld (SRTMEM),DE ; Store DE into a temp. buffer + 195+ EF98 CD 47 1B call CHKSYN ; Make sure ',' follows + 196+ EF9B 2C defb ',' + 197+ EF9C CD 21 22 call GETNUM ; Get memory address + 198+ EF9F CD 46 1E call DEINT ; Get integer -32768 to 32767 + 199+ EFA2 ED 53 50 55 ld (ENDMEM),DE ; Store DE into a temp. buffer + 200+ EFA6 3E 81 ld A,$81 ; set BIN for file type + 201+ EFA8 32 4C 55 ld (TPBF4),A + 202+ EFAB CD A4 3E SAVE1: call DIRMOD ; can be executed ONLY in direct mode + 203+ EFAE C2 5E 18 jp NZ,IMERR ; raise error if in indirect mode + 204+ EFB1 22 9E 55 ld (TMPBFR1),HL ; store code string pointer + 205+ EFB4 21 0C F0 ld HL,TXTSVG ; loading message + 206+ EFB7 CD 29 27 call PRS ; print + 207+ EFBA CD A9 F7 call SAVFILE ; load file into memory + 208+ EFBD C3 D2 EF jp SVEND ; retrieve registers and leave + 209+ EFC0 ;save a single sector + 210+ EFC0 2A 35 55 SAVESCT:ld HL,(TMPDBF) ; retrieve string code pointer + 211+ EFC3 CD 19 EF call GET4AR ; get 4 arguments + 212+ EFC6 22 9E 55 ld (TMPBFR1),HL ; store code string pointer + 213+ EFC9 CD 77 FD call CF_WR_SEC ; read sector + 214+ EFCC 38 39 jr C,SVERR + 215+ EFCE CD 44 FD call CF_STANDBY ; put CF in standby mode + 216+ EFD1 AF xor A ; clear Carry + 217+ EFD2 2A 9E 55 SVEND: ld HL,(TMPBFR1) ; retrieve code string pointer + 218+ EFD5 DA 30 F0 jp C,DOS_ERR ; jump if DOS error + 219+ EFD8 C9 ret ; return to caller + 220+ EFD9 CD 6C 28 RENFIL: call GSTRCU ; check that a string follows + 221+ EFDC CD 7D 30 call LOADFP ; Move string block to BCDE (BC=pointer, E=length) + 222+ EFDF ED 53 3D 55 ld (BYT_SIZ),DE ; store values into + 223+ EFE3 ED 43 44 55 ld (RAM_PTR),BC ; temp buffers + 224+ EFE7 E5 push HL ; store code string pointer + 225+ EFE8 21 F6 EF ld HL,TXTRNM ; point to "renaming file" + 226+ EFEB CD 29 27 call PRS ; print string + 227+ EFEE CD DF F8 call CHNGNAM ; rename file + 228+ EFF1 E1 pop HL ; retrieve code string pointer + 229+ EFF2 DA 30 F0 jp C,DOS_ERR ; any error? + 230+ EFF5 C9 ret ; return to caller + 231+ EFF6 52 65 6E 61 TXTRNM: defb "Renaming file...",0 + 231+ EFFA 6D 69 6E 67 + 231+ EFFE 20 66 69 6C + 231+ F002 65 2E 2E 2E + 231+ F006 00 + 232+ F007 1E 3E SVERR: ld E,D3 ; save error + 233+ F009 C3 63 18 jp ERROR + 234+ F00C 53 61 76 69 TXTSVG: defb "Saving file... ",0 + 234+ F010 6E 67 20 66 + 234+ F014 69 6C 65 2E + 234+ F018 2E 2E 20 00 + 235+ F01C + 236+ F01C + 237+ F01C ; FILES + 238+ F01C ; list files on disk + 239+ F01C CD 9F FC FILES: call CLRIOBF ; clear I/O buffer + 240+ F01F CD CC FC call CF_INIT ; init CF card + 241+ F022 DA 30 F0 jp C,DOS_ERR ; error if device not available/ready + 242+ F025 E5 push HL ; store code string pointer + 243+ F026 16 01 ld D,$01 ; print disk details and file list + 244+ F028 CD 6C F6 call LST_FILES ; list files + 245+ F02B E1 pop HL ; retrieve code string pointer + 246+ F02C DA 30 F0 jp C,DOS_ERR ; any error? + 247+ F02F C9 ret ; return to caller + 248+ F030 + 249+ F030 + 250+ F030 ; raise a DOS error + 251+ F030 3A 34 55 DOS_ERR:ld A,(DOSER) ; load error code + 252+ F033 5F ld E,A ; copy into E + 253+ F034 C3 63 18 jp ERROR ; goto error routine + 254+ F037 + 255+ F037 + 256+ F037 ; check for ",1" argument + 257+ F037 ; check if 1 is passed as argument after LOAD and ERASE + 258+ F037 AF CHK1AR: xor A ; reset A + 259+ F038 32 4C 55 ld (TPBF4),A ; default setting + 260+ F03B ; (load=store file in RAM using current BASIC pointers + 261+ F03B ; (erase=quick delete) + 262+ F03B 2B dec HL ; dec 'cause GETCHR increments + 263+ F03C CD 90 1D call GETCHR ; check if something follows + 264+ F03F C8 ret Z ; if nothing follows, return + 265+ F040 CD 47 1B call CHKSYN ; Make sure ',' follows + 266+ F043 2C defb ',' + 267+ F044 CD A7 2A call GETINT ; get a value + 268+ F047 3D dec A ; decrement it + 269+ F048 C2 49 18 jp NZ,SNERR ; not '1' - raise an error + 270+ F04B 3C inc A ; A=1 + 271+ F04C 32 4C 55 ld (TPBF4),A ; load=store file in RAM using address in file + 272+ F04F ; erase=full delete + 273+ F04F C9 ret ; return to caller + 274+ F050 + 275+ F050 + 276+ F050 ; ERASE "filename" + 277+ F050 ; erase a file from disk + 278+ F050 CD EA F1 ERASE: call CHKFLNM ; check for a disk name + 279+ F053 CD 37 F0 call CHK1AR ; check for ",1" argument + 280+ F056 E5 push HL ; store code string pointer + 281+ F057 21 7A F0 ld HL,ERSTX ; Point to message + 282+ F05A CD 29 27 call PRS ; print message for init confirmation + 283+ F05D E1 pop HL ; retrieve HL + 284+ F05E CD C5 F1 call CNFREQ ; ask for confirmation + 285+ F061 38 33 jr C,ABRTDS ; if Carry set then abort + 286+ F063 CD CC FC call CF_INIT ; init CF card + 287+ F066 DA 30 F0 jp C,DOS_ERR ; error if device not available/ready + 288+ F069 E5 push HL ; store code string pointer + 289+ F06A CD 23 FA call FIL_ERASE ; deleted file + 290+ F06D E1 pop HL ; retrieve code string pointer + 291+ F06E DA 30 F0 jp C,DOS_ERR ; leave if error + 292+ F071 E5 push HL ; store HL + 293+ F072 21 88 F0 ld HL,ERASED ; point to message of file deleted + 294+ F075 CD 29 27 call PRS ; print it + 295+ F078 E1 pop HL ; retrieve HL + 296+ F079 C9 ret ; return to caller + 297+ F07A 44 65 6C 65 ERSTX: defb "Delete file? ",0 + 297+ F07E 74 65 20 66 + 297+ F082 69 6C 65 3F + 297+ F086 20 00 + 298+ F088 46 69 6C 65 ERASED: defb "File deleted",CR,0 + 298+ F08C 20 64 65 6C + 298+ F090 65 74 65 64 + 298+ F094 0D 00 + 299+ F096 + 300+ F096 + 301+ F096 ; disk operation aborted + 302+ F096 3E 01 ABRTDS: ld A,$01 ; re-enable... + 303+ F098 32 9A 55 ld (PRNTVIDEO),A ; ...print-on-video + 304+ F09B E5 push HL ; store code string pointer + 305+ F09C 21 A4 F0 ld HL,ABRTXT ; Point to message + 306+ F09F CD 29 27 call PRS ; print message for leaving init procedure + 307+ F0A2 E1 pop HL ; retrieve code string pointer + 308+ F0A3 C9 ret ; return to caller + 309+ F0A4 0D 41 62 6F ABRTXT: defb CR,"Aborted",0 + 309+ F0A8 72 74 65 64 + 309+ F0AC 00 + 310+ F0AD + 311+ F0AD + 312+ F0AD ; ************************************************************************************** + 313+ F0AD ; D O S R O U T I N E S + 314+ F0AD ;*************************************************************************************** + 315+ F0AD + 316+ F0AD ; DISK command ------- + 317+ F0AD ; execute several operations on a disk: + 318+ F0AD ; "F": format/rewrite Master Sector + 319+ F0AD ; "R": rename disk + 320+ F0AD ; "W": rewrite Master Sector + 321+ F0AD ; "U": undelete deleted files + 322+ F0AD ; syntax: DISK "arg1"[,"arg2"] + 323+ F0AD TPHL: equ TMPDBF ; temp. buffer for code string pointer + 324+ F0AD CD A4 3E DISK: call DIRMOD ; can be executed ONLY in direct mode + 325+ F0B0 C2 5E 18 jp NZ,IMERR ; raise error if in indirect mode + 326+ F0B3 ; check first argument + 327+ F0B3 2B dec HL ; dec 'cause GETCHR increments + 328+ F0B4 CD 90 1D call GETCHR ; check if something follows + 329+ F0B7 CA 49 18 jp Z,SNERR ; if nothing else, raise a syntax error + 330+ F0BA CD 33 22 call EVAL ; Evaluate expression + 331+ F0BD CD 25 22 call TSTSTR ; Make sure it's a string + 332+ F0C0 22 35 55 ld (TPHL),HL ; store code string pointer into a temp buffer + 333+ F0C3 CD 6C 28 call GSTRCU ; check that a string follows + 334+ F0C6 CD 7D 30 call LOADFP ; Move string block to BCDE (BC=pointer, E=length) + 335+ F0C9 7B ld A,E + 336+ F0CA 3D dec A ; lenght must be = 1 + 337+ F0CB 2A 35 55 ld HL,(TPHL) ; retrieve code string pointer + 338+ F0CE C2 49 18 jp NZ,SNERR + 339+ F0D1 AF xor A + 340+ F0D2 32 4C 55 ld (TPBF4),A ; set default to full format + 341+ F0D5 0A ld A,(BC) ; load command + 342+ F0D6 E6 5F and %01011111 ; Force upper case + 343+ F0D8 FE 46 cp 'F' ; format command? + 344+ F0DA CA F4 F0 jp Z,DSKFRM ; yes + 345+ F0DD FE 57 cp 'W' ; rewrite master sector? + 346+ F0DF CA EF F0 jp Z,RWMSSC ; yes + 347+ F0E2 FE 52 cp 'R' ; rename command? + 348+ F0E4 CA 93 F1 jp Z,DSKRNM ; yes + 349+ F0E7 FE 55 cp 'U' ; undelete command? + 350+ F0E9 CA 83 F1 jp Z,DSKUND ; yes + 351+ F0EC C3 49 18 jp SNERR ; nothing more - raise a syntax error + 352+ F0EF + 353+ F0EF + 354+ F0EF ; Format disk or rewrite Master sector + 355+ F0EF ; syntax: DISK "F/W","disk name" + 356+ F0EF ; "F" -> format disk, "W" -> rewrite master sector + 357+ F0EF ; "disk name" is the name -> max 16 chars, allowed chars: "A" to "Z", "0" to "9","-", SPACE + 358+ F0EF ; Format: set up a fresh new file system, creating the Master Sector and + 359+ F0EF ; initializing the directory + 360+ F0EF ; Master Sector rewriting: re-initialize the Master Sector, writing a new disk name and + 361+ F0EF ; re-calculating disk geometry + 362+ F0EF DKNMPT: equ TMPBFR2 ; store the pointer to the disk name string + 363+ F0EF DKLNPT: equ TMPBFR3 ; store the pointer to the lenght of disk name string + 364+ F0EF 3E 01 RWMSSC ld A,$01 ; set rewriting of master sector + 365+ F0F1 32 4C 55 ld (TPBF4),A + 366+ F0F4 CD 47 1B DSKFRM: call CHKSYN ; Make sure ',' follows + 367+ F0F7 2C defb ',' + 368+ F0F8 CD EA F1 call CHKFLNM ; check for file name + 369+ F0FB 11 3E F1 ld DE,MSTTXT ; format message + 370+ F0FE 3A 4C 55 ld A,(TPBF4) ; check for type of operation + 371+ F101 B7 or A ; A=0 (full format)? + 372+ F102 20 03 jr NZ,CFINIT ; no, jump over + 373+ F104 11 56 F1 ld DE,FRMTXT ; rewrite Master Sector + 374+ F107 E5 CFINIT: push HL ; store code string pointer + 375+ F108 62 ld H,D ; Point to message + 376+ F109 6B ld L,E + 377+ F10A CD 29 27 call PRS ; print message for confirmation + 378+ F10D E1 pop HL ; retrieve HL + 379+ F10E CD C5 F1 call CNFREQ ; ask for confirmation + 380+ F111 DA 96 F0 jp C,ABRTDS ; if Carry set then abort + 381+ F114 CD CC FC call CF_INIT ; init CF card + 382+ F117 DA 30 F0 jp C,DOS_ERR ; error if device not available/ready + 383+ F11A E5 push HL ; store code string pointer + 384+ F11B CD 11 F2 call DSK_INIT ; init disk + 385+ F11E E1 pop HL ; retrieve code string pointer + 386+ F11F DA 30 F0 jp C,DOS_ERR ; if Carry set, raise error + 387+ F122 E5 push HL ; store code string pointer + 388+ F123 3A 9E 55 ld A,(TMPBFR1) + 389+ F126 B7 or A ; full formatting? + 390+ F127 20 0D jr NZ,MSPTOK ; no + 391+ F129 21 6E F1 ld HL,OPRCMP ; yes, Point to message + 392+ F12C CD 29 27 call PRS ; print message for init confirmation + 393+ F12F 16 00 ld D,$00 ; print only disk details, no file list + 394+ F131 CD 6C F6 call LST_FILES ; print details of disk and list files + 395+ F134 E1 pop HL ; retrieve code string pointer + 396+ F135 C9 ret ; return to caller + 397+ F136 21 6E F1 MSPTOK: ld HL,OPRCMP ; format OK message + 398+ F139 CD 29 27 call PRS ; print message for init confirmation + 399+ F13C E1 pop HL ; retrieve code string pointer + 400+ F13D C9 ret ; return to caller + 401+ F13E 52 65 77 72 MSTTXT: defb "Rewrite Master Sector? ",0 + 401+ F142 69 74 65 20 + 401+ F146 4D 61 73 74 + 401+ F14A 65 72 20 53 + 401+ F14E 65 63 74 6F + 401+ F152 72 3F 20 00 + 402+ F156 57 41 52 4E FRMTXT: defb "WARNING!! Format disk? ",0 + 402+ F15A 49 4E 47 21 + 402+ F15E 21 20 46 6F + 402+ F162 72 6D 61 74 + 402+ F166 20 64 69 73 + 402+ F16A 6B 3F 20 00 + 403+ F16E 4F 70 65 72 OPRCMP: defb "Operation completed",CR,0 + 403+ F172 61 74 69 6F + 403+ F176 6E 20 63 6F + 403+ F17A 6D 70 6C 65 + 403+ F17E 74 65 64 0D + 403+ F182 00 + 404+ F183 + 405+ F183 + 406+ F183 ; undelete files + 407+ F183 ; look for files marked as "deleted" and undelete them + 408+ F183 2B DSKUND: dec HL ; dec 'cause GETCHR increments + 409+ F184 CD 90 1D call GETCHR ; check if something follows + 410+ F187 C2 49 18 jp NZ,SNERR ; if something else, raise a syntax error + 411+ F18A E5 push HL ; store code string pointer + 412+ F18B CD E5 FA call DSKUNDFL ; undelete files + 413+ F18E E1 pop HL ; retrieve code string pointer + 414+ F18F DA 30 F0 jp C,DOS_ERR ; DOS error + 415+ F192 C9 ret ; return to caller + 416+ F193 + 417+ F193 + 418+ F193 ; disk rename + 419+ F193 ; change the name of the disk w/o altering anything else + 420+ F193 CD 47 1B DSKRNM: call CHKSYN ; Make sure ',' follows + 421+ F196 2C defb ',' + 422+ F197 CD EA F1 call CHKFLNM ; check for file name + 423+ F19A E5 push HL ; store code string pointer + 424+ F19B 21 B7 F1 ld HL,RNDKTX ; Point to message + 425+ F19E CD 29 27 call PRS ; print message for confirmation + 426+ F1A1 E1 pop HL ; retrieve HL + 427+ F1A2 CD C5 F1 call CNFREQ ; ask for confirmation + 428+ F1A5 DA 96 F0 jp C,ABRTDS ; if Carry set then abort + 429+ F1A8 CD CC FC call CF_INIT ; init CF card + 430+ F1AB DA 30 F0 jp C,DOS_ERR ; error if device not available/ready + 431+ F1AE E5 push HL ; store code string pointer + 432+ F1AF CD 49 F3 call DSK_RNM ; init disk + 433+ F1B2 E1 pop HL ; retrieve code string pointer + 434+ F1B3 DA 30 F0 jp C,DOS_ERR ; DOS error + 435+ F1B6 C9 ret + 436+ F1B7 52 65 6E 61 RNDKTX: defb "Rename disk? ",0 + 436+ F1BB 6D 65 20 64 + 436+ F1BF 69 73 6B 3F + 436+ F1C3 20 00 + 437+ F1C5 + 438+ F1C5 + 439+ F1C5 ; confirmation required by the user ('y' or 'Y' DO confirm, otherwise DON'T) + 440+ F1C5 CD 2D 09 CNFREQ: call CURSOR_ON ; enable cursor + 441+ F1C8 AF xor A + 442+ F1C9 32 9A 55 ld (PRNTVIDEO),A ; disable print-on-video + 443+ F1CC CD 2A 02 call RXA ; look for a pressed key + 444+ F1CF FE 03 cp CTRLC ; is it RUN STOP? + 445+ F1D1 28 15 jr Z,CNFRQN ; yes, abort operation + 446+ F1D3 E6 DF and %11011111 ; only UPPERCASE char + 447+ F1D5 FE 59 cp 'Y' ; 'Y'? + 448+ F1D7 20 0F jr NZ,CNFRQN ; no, abort operation + 449+ F1D9 08 ex AF,AF' ; store char into A' + 450+ F1DA 3E 01 ld A,$01 ; re-enable... + 451+ F1DC 32 9A 55 ld (PRNTVIDEO),A ; ...print-on-video + 452+ F1DF 08 ex AF,AF' ; retrieve char from A' + 453+ F1E0 CD 1C 03 call ECHO_CHAR ; yes, echoes the char + 454+ F1E3 CD 42 09 call CURSOR_OFF ; disable cursor + 455+ F1E6 AF xor A ; reset Carry flag + 456+ F1E7 C9 ret ; return to caller + 457+ F1E8 37 CNFRQN: scf ; set Carry flag + 458+ F1E9 C9 ret ; return to caller + 459+ F1EA + 460+ F1EA + 461+ F1EA ; check that a disk/file name follows + 462+ F1EA 2B CHKFLNM:dec HL ; dec 'cause GETCHR increments + 463+ F1EB CD 90 1D call GETCHR ; check if something follows + 464+ F1EE CA 49 18 jp Z,SNERR ; if nothing else, raise a syntax error + 465+ F1F1 CD 33 22 call EVAL ; Evaluate expression + 466+ F1F4 CD 25 22 CHKFN1: call TSTSTR ; Make sure it's a string + 467+ F1F7 22 37 55 ld (TMPDBF+2),HL ; store code string pointer into a temp buffer + 468+ F1FA CD 6C 28 call GSTRCU ; get current string into pool + 469+ F1FD CD 7D 30 call LOADFP ; Move string block to BCDE (BC=pointer, E=length) + 470+ F200 7B ld A,E ; check if lenght = 0 + 471+ F201 A7 and A ; null string? + 472+ F202 CA 49 18 jp Z,SNERR ; yes, syntax error + 473+ F205 ED 53 A2 55 ld (DKLNPT),DE ; no, store lenght + 474+ F209 ED 43 A0 55 ld (DKNMPT),BC ; store address of temp string + 475+ F20D 2A 37 55 ld HL,(TMPDBF+2) ; retrieve code string pointer + 476+ F210 C9 ret ; return to caller + 477+ F211 + 478+ F211 + 479+ F211 ; ***************************************************************************** + 480+ F211 ; D I S K I N I T + 481+ F211 ; Functions: format a disk creating a fresh new file system on disk or + 482+ F211 ; rewrite only the Master Sector + 483+ F211 ; ***************************************************************************** + 484+ F211 CD 6A FB DSK_INIT: call CHKSQFL ; check if a seq. file is open + 485+ F214 C2 18 F6 jp NZ,FILOPCLER ; jump if open + 486+ F217 3A 4C 55 ld A,(TPBF4) ; load type of formatting + 487+ F21A 32 9E 55 ld (TMPBFR1),A ; save onto another location for later use + 488+ F21D CD 9F FC call CLRIOBF ; clear I/O buffer + 489+ F220 CD B4 FC call CLRDOSBF ; clear DOS buffer + 490+ F223 3E E0 ld A,$E0 ; select CF as master, driver 0, LBA mode (bits #5-7=111) + 491+ F225 D3 56 out (CF_LBA3),A ; send configuration + 492+ F227 3E EC ld A,$EC ; select "drive ID" command + 493+ F229 D3 57 out (CF_CMD),A ; send command + 494+ F22B CD 01 FD call CF_DAT_RDY ; wait until data is ready to be read + 495+ F22E CD 63 FD call CF_RD_CMD ; read data and store into I/O buffer + 496+ F231 11 A0 FD ld DE,DOSBFR ; address of default conf. buffer + 497+ F234 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer + 498+ F237 01 0E 00 ld BC,$000E ; position of current disk size in sectors + 499+ F23A 09 add HL,BC ; set into HL + 500+ F23B 0E 04 ld C,$04 ; 4 bytes to copy + 501+ F23D ED B0 ldir ; copy (DE is auto-incremented) + 502+ F23F 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer + 503+ F242 01 02 00 ld BC,$0002 ; 2 bytes to copy and also address of number of cylinders + 504+ F245 09 add HL,BC ; get position of data + 505+ F246 ED B0 ldir ; copy (DE is auto-incremented) + 506+ F248 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer + 507+ F24B 01 0C 00 ld BC,$000C ; address of number of sectors per cylinder + 508+ F24E 09 add HL,BC ; get position of data + 509+ F24F 0E 02 ld C,$02 ; 2 bytes to copy + 510+ F251 ED B0 ldir ; copy (DE is auto-incremented) + 511+ F253 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer + 512+ F256 01 06 00 ld BC,$0006 ; address of number of heads + 513+ F259 09 add HL,BC ; get position of data + 514+ F25A 0E 02 ld C,$02 ; 2 bytes to copy + 515+ F25C ED B0 ldir ; copy (DE is auto-incremented) + 516+ F25E ; now we calculate the # of files allowed (1 file = 1 block = 64K) + 517+ F25E ED 53 4C 55 ld (TPBF4),DE ; store current pointer to temp. default conf. buffer + 518+ F262 21 A0 FD ld HL,DOSBFR ; load number of sectors + 519+ F265 4E ld C,(HL) ; MSW into AC + 520+ F266 23 inc HL + 521+ F267 7E ld A,(HL) + 522+ F268 23 inc HL + 523+ F269 5E ld E,(HL) ; LSW into DE + 524+ F26A 23 inc HL + 525+ F26B 56 ld D,(HL) + 526+ F26C D5 push DE ; move DE into IX + 527+ F26D DD E1 pop IX + 528+ F26F 11 80 00 ld DE,$0080 ; 128 sectors per block + 529+ F272 CD D9 41 call DIV_32_16 ; execute ACIX/DE; result is into ACIX, remainder into HL + 530+ F275 47 ld B,A ; now result is into BCIX + 531+ F276 B1 or C ; BC=$0000? + 532+ F277 28 05 jr Z,DOS_FTC ; yes, but..... + 533+ F279 11 FF FF ld DE,$FFFF ; ... no more than $FFFF files, so set limit + 534+ F27C 18 0E jr DOS_FT1 ; jump over + 535+ F27E DD E5 DOS_FTC: push IX ; move IX into DE + 536+ F280 D1 pop DE ; now result is into BCDE + 537+ F281 7C ld A,H ; remainder = zero? + 538+ F282 B5 or L + 539+ F283 CA 8C F2 jp Z,DOS_FT1 ; yes, jump over + 540+ F286 13 inc DE ; no, increment DE + 541+ F287 7A ld A,D ; check if DE is zero + 542+ F288 B3 or E + 543+ F289 20 01 jr NZ,DOS_FT1 ; no, jump over + 544+ F28B 1B dec DE ; yes, so set files to limit of $FFFF + 545+ F28C 2A 4C 55 DOS_FT1: ld HL,(TPBF4) ; retrieve current pointer to temp. def. conf. buffer + 546+ F28F CD 63 FC call DE2HL ; store # of entries + 547+ F292 D5 push DE ; store entries + 548+ F293 EB ex DE,HL ; copy current pointer into DE + 549+ F294 21 77 EE ld HL,DSKDIRADR ; address of directory start + 550+ F297 01 02 00 ld BC,$0002 ; 2 bytes to copy + 551+ F29A ED B0 ldir ; copy into buffer + 552+ F29C ; now we calculate the starting sector of data area + 553+ F29C E1 pop HL ; entries into HL + 554+ F29D 0E 10 ld C,$10 ; 16 entries per sector + 555+ F29F CD B5 41 call DIV_16_8 ; calculare how many sectors for dir (HL/C) + 556+ F2A2 B7 or A ; remainder = 0? + 557+ F2A3 28 01 jr Z,DOS_FT2 ; yes, jump over + 558+ F2A5 23 inc HL ; increment sectors + 559+ F2A6 E5 DOS_FT2: push HL ; store size of directory + 560+ F2A7 FD E1 pop IY ; into IY + 561+ F2A9 23 inc HL ; data area is 1 sector bigger than directory's size + 562+ F2AA EB ex DE,HL ; restore pointer into HL, and move sectors into DE + 563+ F2AB 73 ld (HL),E ; store starting of + 564+ F2AC 23 inc HL ; data area + 565+ F2AD 72 ld (HL),D ; into buffer + 566+ F2AE ; now clean again the I/O buffer and copy the configuration into I/O buffer + 567+ F2AE CD 9F FC call CLRIOBF ; clear I/O buffer + 568+ F2B1 21 68 EE ld HL,DSKHDR ; address of disk header string + 569+ F2B4 11 C0 FD ld DE,IOBUFF ; address of I/O buffer + 570+ F2B7 01 0F 00 ld BC,$000F ; 15 chars + 571+ F2BA ED B0 ldir ; copy header into buffer + 572+ F2BC 21 A0 FD ld HL,DOSBFR ; first part of configuration + 573+ F2BF 01 10 00 ld BC,$0010 ; composed by 16 chars + 574+ F2C2 ED B0 ldir ; copy (DE is auto-incremented) + 575+ F2C4 AF xor A ; A=$0 + 576+ F2C5 12 ld (DE),A ; marker at $1F + 577+ F2C6 13 inc DE + 578+ F2C7 CD 3B FC call CHKNMVAL ; copy disk name into buffer + 579+ F2CA DA 27 F6 jp C,NAMERR ; disk name error + 580+ F2CD CD C3 FB call RND_ID ; generate a semi-random disk ID + 581+ F2D0 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer + 582+ F2D3 54 ld D,H ; copy into DE... + 583+ F2D4 5D ld E,L ; ...for later use + 584+ F2D5 01 FE 01 ld BC,$01FE ; get address of last 2 bytes... + 585+ F2D8 09 add HL,BC ; ...of the I/O buffer + 586+ F2D9 3E 38 ld A,'8' ; write marker "80" + 587+ F2DB 77 ld (HL),A ; ... + 588+ F2DC 23 inc HL ; ... + 589+ F2DD 3E 30 ld A,'0' ; ... + 590+ F2DF 77 ld (HL),A ; ...into last 2 locations + 591+ F2E0 EB ex DE,HL ; copy beginning of I/O buffer from DE into HL + 592+ F2E1 AF xor A ; reset A - set sector # to $00000000 + 593+ F2E2 47 ld B,A ; LBA0=0 + 594+ F2E3 4F ld C,A ; LBA1=0 + 595+ F2E4 57 ld D,A ; LBA2=0 + 596+ F2E5 5F ld E,A ; LBA3=0 + 597+ F2E6 CD 77 FD call CF_WR_SEC ; write sector to CF + 598+ F2E9 DA 1E F6 jp C,D2ERR + 599+ F2EC ; check if only re-writing of Master Sector was need + 600+ F2EC 3A 9E 55 ld A,(TMPBFR1) ; retrieve type of formatting + 601+ F2EF 3D dec A ; A=1? + 602+ F2F0 C8 ret Z ; yes, finished job + 603+ F2F1 ; erase directory ----------------------------- + 604+ F2F1 ; create a progress bar + 605+ F2F1 3E 0D ld A,CR ; no, full format - go to new line + 606+ F2F3 CD 52 1B call OUTC + 607+ F2F6 FD E5 push IY ; copy directory's size... + 608+ F2F8 E1 pop HL ; ...into HL + 609+ F2F9 01 18 00 ld BC,$0018 ; 24 steps + 610+ F2FC CD B5 41 call DIV_16_8 ; calculate HL/24 (remainder is ignored, here) + 611+ F2FF E5 push HL ; store result... + 612+ F300 DD E1 pop IX ; ...into IX... + 613+ F302 EB ex DE,HL ; ...and into DE + 614+ F303 3E 2D ld A,'-' ; print a progress bar + 615+ F305 CD 41 F3 call DOS_FT7 ; print it + 616+ F308 3E 1C ld A,CRSLFT ; CURSOR left + 617+ F30A CD 41 F3 call DOS_FT7 ; come back to beginning of line + 618+ F30D FD E5 push IY ; copy directory's size + 619+ F30F E1 pop HL ; into HL + 620+ F310 01 01 00 ld BC,$0001 ; first sector of directory + 621+ F313 CD 9F FC call CLRIOBF ; clear I/O buffer + 622+ F316 D5 DOS_FTA: push DE ; store counter + 623+ F317 11 00 00 ld DE,$0000 ; reset MSW of sector pointer + 624+ F31A CD 77 FD call CF_WR_SEC ; write sector to CF + 625+ F31D DA 3D F3 jp C,DOS_FT10 ; error occured + 626+ F320 03 inc BC ; next sector + 627+ F321 2B dec HL ; decrement HL + 628+ F322 D1 pop DE ; retrieve counter + 629+ F323 1B dec DE ; decrement counter + 630+ F324 7B ld A,E + 631+ F325 B2 or D ; check if counter is zero + 632+ F326 20 08 jr NZ,DOS_FT9 ; no, jump over + 633+ F328 3E 2A ld A,'*' ; yes, print char + 634+ F32A CD 52 1B call OUTC + 635+ F32D DD E5 push IX ; re-set counter + 636+ F32F D1 pop DE + 637+ F330 7C DOS_FT9: ld A,H ; check if... + 638+ F331 B5 or L ; ...HL = 0 + 639+ F332 20 E2 jr NZ,DOS_FTA ; if not, repeat + 640+ F334 3E 0D ld A,CR ; return + 641+ F336 CD 52 1B call OUTC ; next line + 642+ F339 CD 44 FD call CF_STANDBY ; set CF into stand-by mode + 643+ F33C C9 ret + 644+ F33D D1 DOS_FT10: pop DE + 645+ F33E C3 1E F6 jp D2ERR ; disk geometry error + 646+ F341 + 647+ F341 ; print a char 24 times + 648+ F341 06 18 DOS_FT7: ld B,$18 ; 24 times + 649+ F343 CD 52 1B DOS_FT8: call OUTC ; print char + 650+ F346 10 FB djnz DOS_FT8 ; repeat + 651+ F348 C9 ret ; return to caller + 652+ F349 + 653+ F349 + 654+ F349 ; ***************************************************************************** + 655+ F349 ; D I S K R E N A M E + 656+ F349 ;****************************************************************************** + 657+ F349 CD 03 FC DSK_RNM: call CHKDSKVAL ; check DOS version & load disk details + 658+ F34C DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error + 659+ F34F CD 9F FC call CLRIOBF ; clear I/O buffer + 660+ F352 CD B4 FC call CLRDOSBF ; clear DOS buff. + 661+ F355 CD B7 FB call LDMSCT ; load Master Sector + 662+ F358 21 C0 FD ld HL,IOBUFF ; point to start of I/O buffer + 663+ F35B 01 20 00 ld BC,$0020 ; offset for disk name + 664+ F35E 09 add HL,BC ; get pointer + 665+ F35F EB ex DE,HL ; copy pointer into DE + 666+ F360 CD 3B FC call CHKNMVAL ; copy disk name into buffer + 667+ F363 DA 27 F6 jp C,NAMERR ; disk name error + 668+ F366 11 00 00 ld DE,$0000 ; reset MSW sector + 669+ F369 42 ld B,D ; reset LSW sector + 670+ F36A 4A ld C,D + 671+ F36B CD 77 FD call CF_WR_SEC ; write sector + 672+ F36E DA 9B FA jp C,WRT_ERR ; error? + 673+ F371 C9 ret ; no, return to caller + 674+ F372 + 675+ F372 + 676+ F372 ; ***************************************************************************** + 677+ F372 ; PUT A CHAR INTO A SEQUENTIAL FILE + 678+ F372 ; when the buffer is full, it writes it on the disk, + 679+ F372 ; then move to another sector + 680+ F372 ; ***************************************************************************** + 681+ F372 CD 6A FB PUTFIL: call CHKSQFL ; is there a seq. file open? + 682+ F375 CA 18 F6 jp Z,FILOPCLER ; no, raise an error + 683+ F378 47 ld B,A ; copy file number into B + 684+ F379 3A 35 55 ld A,(TMPDBF) ; load argument + 685+ F37C B8 cp B ; are they equal? + 686+ F37D C2 2A F6 jp NZ,FLNTFND ; file not found + 687+ F380 3A D7 FF ld A,(SEQFLS) ; check access mode + 688+ F383 B7 or A ; only reading? + 689+ F384 3E 3E ld A,D3 ; prepare a save error + 690+ F386 CA 32 F6 jp Z,RET_ERR ; yes, error + 691+ F389 ; store byte + 692+ F389 ED 5B DD FF ld DE,(SEQBYSZ) ; load size in bytes + 693+ F38D 13 inc DE ; increment file size + 694+ F38E 7B ld A,E ; check if... + 695+ F38F B2 or D ; ...rolled back to $0000 + 696+ F390 CA 21 F6 jp Z,DSKFULL ; yes, block is full + 697+ F393 ED 53 DD FF ld (SEQBYSZ),DE ; no, store new size + 698+ F397 2A DF FF ld HL,(SEQPNT) ; pointer to byte + 699+ F39A 11 C0 FD ld DE,IOBUFF ; load starting address of I/O buffer + 700+ F39D 44 ld B,H ; copy byte pointer... + 701+ F39E 4D ld C,L ; ...to BC + 702+ F39F 19 add HL,DE ; point to new location + 703+ F3A0 3A 36 55 ld A,(TMPDBF+1) ; retrieve byte + 704+ F3A3 77 ld (HL),A ; store it + 705+ F3A4 03 inc BC ; increment byte pointer + 706+ F3A5 ED 43 DF FF ld (SEQPNT),BC ; store it + 707+ F3A9 CD AE F3 call PUTNXSC ; check if I/O buffer is full + 708+ F3AC AF xor A ; clear Carry + 709+ F3AD C9 ret ; return to caller + 710+ F3AE ; check if I/O buffer is full + 711+ F3AE ; if yes, store buffer and goto a new sector + 712+ F3AE 11 00 02 PUTNXSC: ld DE,$0200 ; max buffer size + 713+ F3B1 2A DF FF ld HL,(SEQPNT) ; pointer to byte + 714+ F3B4 CD 5A 41 call CMP16 ; check if pointer < $200 + 715+ F3B7 D8 ret C ; yes, return + 716+ F3B8 ED 4B DA FF ld BC,(SEQSCTL) ; load LSW of sector address + 717+ F3BC ED 5B D8 FF ld DE,(SEQSCTM) ; load MSW of sector address + 718+ F3C0 CD 77 FD call CF_WR_SEC ; write buffer into sector + 719+ F3C3 3A DC FF ld A,(SEQSCSZ) ; load size in sectors + 720+ F3C6 3C inc A ; we need another sector + 721+ F3C7 67 ld H,A ; store A into H + 722+ F3C8 FE 81 cp $81 ; A>128? + 723+ F3CA 3E 42 ld A,D5 ; prepare a disk full error + 724+ F3CC D2 10 F6 jp NC,GETER ; yes, raise an error + 725+ F3CF 7C ld A,H ; no, retrieve sector counter + 726+ F3D0 32 DC FF ld (SEQSCSZ),A ; store new size in sectors + 727+ F3D3 21 00 00 ld HL,$0000 ; reset pointer + 728+ F3D6 22 DF FF ld (SEQPNT),HL + 729+ F3D9 03 inc BC ; next sector + 730+ F3DA 79 ld A,C ; check if BC is rolled back to zero (overflow) + 731+ F3DB B0 or B + 732+ F3DC 20 05 jr NZ,PUTFIL2 ; no, jump over + 733+ F3DE 13 inc DE ; yes, increment MSW of sector address + 734+ F3DF ED 53 D8 FF ld (SEQSCTM),DE ; save new MSW of sector address + 735+ F3E3 ED 43 DA FF PUTFIL2: ld (SEQSCTL),BC ; save new LSW of sector address + 736+ F3E7 C3 90 F4 jp OPNFRD1 ; load sector and return + 737+ F3EA + 738+ F3EA + 739+ F3EA ; ***************************************************************************** + 740+ F3EA ; OPEN A SEQUENTIAL FILE + 741+ F3EA ; open a sequential file for read/write operations + 742+ F3EA ; if file already exists, it appends new data at the end of the file + 743+ F3EA ;****************************************************************************** + 744+ F3EA CD 03 FC OPNFIL: call CHKDSKVAL ; check DOS version & load disk details + 745+ F3ED DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error + 746+ F3F0 CD 6A FB call CHKSQFL ; check if there is a file already opened + 747+ F3F3 C2 1B F6 jp NZ,FILALROP ; yes, jump over + 748+ F3F6 CD C0 FC call CLRSEQBF ; clear seq. file buffer + 749+ F3F9 3A 35 55 ld A,(TMPDBF) ; recover file number and... + 750+ F3FC 32 D6 FF ld (SEQFL),A ; ...store it + 751+ F3FF 3A 36 55 ld A,(TMPDBF+1) ; load access mode + 752+ F402 32 D7 FF ld (SEQFLS),A ; store access mode + 753+ F405 ; open file + 754+ F405 CD 9F FC call CLRIOBF ; clear I/O + 755+ F408 CD 41 F9 call CHKFLEXT ; check if file already exists + 756+ F40B 1E 00 ld E,$00 ; reset E + 757+ F40D CB 13 rl E ; store Carry into E (0=file not exists, 1=file exists) + 758+ F40F 3A D7 FF ld A,(SEQFLS) ; load access mode (0=read, 1=create/append) + 759+ F412 B3 or E ; if read mode and file not exist... + 760+ F413 CA 2A F6 jp Z,FLNTFND ; ...raise a file not found error + 761+ F416 3A D7 FF ld A,(SEQFLS) ; reload access mode (0=read, 1=create/append) + 762+ F419 B7 or A ; read mode? + 763+ F41A 28 7F jr Z,OPFLRS ; yes, open file for read + 764+ F41C ; open file for writing + 765+ F41C 7B ld A,E ; no, open file for save + 766+ F41D B7 or A ; check if file exists + 767+ F41E 20 46 jr NZ,OPNFRD ; file exists, open for append + 768+ F420 ; open file for creating (new file) + 769+ F420 CD 9F FC call CLRIOBF ; clear I/O buffer + 770+ F423 CD 32 FB call FNDFRENTR ; file doesn't exist, find a free entry in the directory + 771+ F426 DA 21 F6 jp C,DSKFULL ; no entry, disk full error + 772+ F429 3E 82 ld A,$82 ; set seq. file type + 773+ F42B 32 4C 55 ld (TPBF4),A + 774+ F42E 3E 01 ld A,$01 ; set initial size to 1 sector + 775+ F430 32 DC FF ld (SEQSCSZ),A ; store it for seq. file manager + 776+ F433 32 3F 55 ld (SCT_SIZ),A ; store it for DOS, too + 777+ F436 21 00 00 ld HL,$0000 ; set initial file size to 0 bytes + 778+ F439 22 3D 55 ld (BYT_SIZ),HL ; store it for DOS + 779+ F43C 22 4E 55 ld (SRTMEM),HL ; RAM starting address set to 0 (seq. file is not saved/loaded from/into RAM) + 780+ F43F CD 5E F8 call SVENTRY ; save entry into directory + 781+ F442 ED 5B 40 55 ld DE,(MSW_SCT) ; store MSW of sector address for DOS + 782+ F446 ED 53 D8 FF ld (SEQSCTM),DE ; also for seq. file manager + 783+ F44A ED 4B 42 55 ld BC,(LSW_SCT) ; store LSW of sector address for DOS + 784+ F44E ED 43 DA FF ld (SEQSCTL),BC ; also for seq. file manager + 785+ F452 CD E8 F4 call SVSQFLNM ; store name + 786+ F455 CD 9F FC call CLRIOBF ; clear I/O buffer + 787+ F458 ED 5B 40 55 ld DE,(MSW_SCT) ; load MSW of sector + 788+ F45C ED 4B 42 55 ld BC,(LSW_SCT) ; load LSW of sector + 789+ F460 CD 77 FD call CF_WR_SEC ; write sector + 790+ F463 C3 AC F4 jp OPNFILPT ; go setting pointer + 791+ F466 ; open file for append (add data after the end) + 792+ F466 CD B4 F4 OPNFRD: call OPNRDDET ; load file details - size in bytes in DE - size in sectors in A + 793+ F469 21 00 02 ld HL,$0200 ; sector wide + 794+ F46C EB ex DE,HL ; move file size into HL and sector size into DE + 795+ F46D 3D OPNFRD3: dec A ; decrement sector counter + 796+ F46E 28 05 jr Z,OPNFRD2 ; reached 0? jump over + 797+ F470 B7 or A ; reset Carry + 798+ F471 ED 52 sbc HL,DE ; decrement sector size + 799+ F473 18 F8 jr OPNFRD3 ; repeat + 800+ F475 22 DF FF OPNFRD2: ld (SEQPNT),HL ; save pointer + 801+ F478 3A DC FF ld A,(SEQSCSZ) ; load size in sectors + 802+ F47B 3D dec A ; decrement by 1 + 803+ F47C 4F ld C,A ; store into... + 804+ F47D 06 00 ld B,$00 ; ...HL + 805+ F47F 2A DA FF ld HL,(SEQSCTL) ; load LSW of sector address + 806+ F482 ED 5B D8 FF ld DE,(SEQSCTM) ; load MSW of sector address + 807+ F486 09 add HL,BC ; point to latest sector + 808+ F487 4D ld C,L ; copy HL into BC + 809+ F488 44 ld B,H + 810+ F489 30 05 jr NC,OPNFRD1 ; if LSW didn't overflow, jump over + 811+ F48B 13 inc DE ; overflow, so increment MSW + 812+ F48C ED 53 D8 FF ld (SEQSCTM),DE ; store new MSW of sector address + 813+ F490 ED 43 DA FF OPNFRD1: ld (SEQSCTL),BC ; store new LSW of sector address + 814+ F494 CD 0E FD call CF_SETSTR ; set sector to load + 815+ F497 CD 50 FD call CF_RD_SEC ; read sector + 816+ F49A C9 ret ; return to caller + 817+ F49B ; open file for read & point to beginning of it + 818+ F49B CD B4 F4 OPFLRS: call OPNRDDET ; load file details + 819+ F49E ED 5B D8 FF ld DE,(SEQSCTM) ; load MSW of sector address + 820+ F4A2 ED 4B DA FF ld BC,(SEQSCTL) ; load LSW of sector addres + 821+ F4A6 CD 0E FD call CF_SETSTR ; point to 1st sector + 822+ F4A9 CD 50 FD call CF_RD_SEC ; load sector + 823+ F4AC AF OPNFILPT: xor A ; A=0 + 824+ F4AD 32 DF FF ld (SEQPNT),A ; file pointer... + 825+ F4B0 32 E0 FF ld (SEQPNT+1),A ; ...set to 0 + 826+ F4B3 C9 ret ; return to caller + 827+ F4B4 + 828+ F4B4 + 829+ F4B4 ; open an existing file and load details + 830+ F4B4 DD 5E 14 OPNRDDET: ld E,(IX+$14) ; load MSW into DE + 831+ F4B7 DD 56 15 ld D,(IX+$15) + 832+ F4BA DD 4E 16 ld C,(IX+$16) ; load LSW into BC + 833+ F4BD DD 46 17 ld B,(IX+$17) + 834+ F4C0 ED 53 40 55 ld (MSW_SCT),DE ; store DE for DOS + 835+ F4C4 ED 53 D8 FF ld (SEQSCTM),DE ; also for seq. file manager + 836+ F4C8 ED 43 42 55 ld (LSW_SCT),BC ; store BC dor DOS + 837+ F4CC ED 43 DA FF ld (SEQSCTL),BC ; also for seq. file manager + 838+ F4D0 DD 5E 18 ld E,(IX+$18) ; load size in bytes + 839+ F4D3 DD 56 19 ld D,(IX+$19) + 840+ F4D6 ED 53 3D 55 ld (BYT_SIZ),DE ; store it for DOS + 841+ F4DA ED 53 DD FF ld (SEQBYSZ),DE ; store it for seq. file manager + 842+ F4DE DD 7E 1A ld A,(IX+$1A) ; load size in sectors + 843+ F4E1 32 3F 55 ld (SCT_SIZ),A ; store it for DOS + 844+ F4E4 32 DC FF ld (SEQSCSZ),A ; and also for seq. file manager + 845+ F4E7 C9 ret ; return to caller + 846+ F4E8 + 847+ F4E8 + 848+ F4E8 ; save file name into seq. buffer + 849+ F4E8 11 C6 FF SVSQFLNM: ld DE,TMPNAM ; temp. buff. + 850+ F4EB 01 10 00 ld BC,$0010 ; 10 chars + 851+ F4EE 21 A0 FD ld HL,DOSBFR ; pointer to file name + 852+ F4F1 ED B0 ldir ; store filename + 853+ F4F3 C9 ret ; return to caller + 854+ F4F4 + 855+ F4F4 ; ***************************************************************************** + 856+ F4F4 ; CLOSE A SEQUENTIAL FILE + 857+ F4F4 ; ***************************************************************************** + 858+ F4F4 CD 6A FB CLOSFIL: call CHKSQFL ; is there a seq. file open? + 859+ F4F7 CA 18 F6 jp Z,FILOPCLER ; no, raise an error + 860+ F4FA 47 ld B,A ; copy file number into B + 861+ F4FB 3A 35 55 ld A,(TMPDBF) ; load argument + 862+ F4FE B8 cp B ; are they equal? + 863+ F4FF C2 2A F6 jp NZ,FLNTFND ; file not found + 864+ F502 3A D7 FF ld A,(SEQFLS) ; check access mode + 865+ F505 B7 or A ; only reading? + 866+ F506 28 09 jr Z,CLOSFIL1 ; yes, just mark file closed + 867+ F508 CD 16 F5 call SVCRNTSE ; save current buffer + 868+ F50B CD 22 F5 call UPCRNENT ; update entry into dir + 869+ F50E DA 2A F6 jp C,FLNTFND ; file not found? + 870+ F511 CLOSFIL1: ;call CLRSEQBF ; clear seq. buffer + 871+ F511 AF xor A ; mark file as closed + 872+ F512 32 D6 FF ld (SEQFL),A + 873+ F515 C9 ret ; return to caller + 874+ F516 + 875+ F516 + 876+ F516 ; save current buffer into a sequential file + 877+ F516 ED 5B D8 FF SVCRNTSE: ld DE,(SEQSCTM) ; MSW of sector address + 878+ F51A ED 4B DA FF ld BC,(SEQSCTL) ; LSW of sector address + 879+ F51E CD 77 FD call CF_WR_SEC ; save current open sector + 880+ F521 C9 ret + 881+ F522 + 882+ F522 + 883+ F522 ; update current entry (for a seq. file) + 884+ F522 11 10 00 UPCRNENT: ld DE,$0010 + 885+ F525 ED 53 A2 55 ld (DKLNPT),DE ; lenght of name + 886+ F529 11 C6 FF ld DE,TMPNAM + 887+ F52C ED 53 A0 55 ld (DKNMPT),DE ; pointer to name + 888+ F530 CD 41 F9 call CHKFLEXT ; check file existance + 889+ F533 D2 51 F5 jp NC,UPCRNENT1 ; file not found + 890+ F536 2A DD FF ld HL,(SEQBYSZ) + 891+ F539 DD 75 18 ld (IX+$18),L ; point to file size + 892+ F53C DD 74 19 ld (IX+$19),H + 893+ F53F 3A DC FF ld A,(SEQSCSZ) ; load size in sectors + 894+ F542 DD 77 1A ld (IX+$1A),A + 895+ F545 ED 5B 48 55 ld DE,(TPBF2) ; retrieve MSW of current directory sector + 896+ F549 ED 4B 4A 55 ld BC,(TPBF3) ; retrieve LSW of current directory secto + 897+ F54D CD 77 FD call CF_WR_SEC ; store entry + 898+ F550 37 scf ; set Carry + 899+ F551 3F UPCRNENT1: ccf ; invert Carry + 900+ F552 C9 ret + 901+ F553 + 902+ F553 + 903+ F553 ; ***************************************************************************** + 904+ F553 ; E O F + 905+ F553 ; check EOF/size + 906+ F553 ; input: 0 => return size of current file + 907+ F553 ; input: file number => 1 if EOF, 0 otherwise + 908+ F553 ; ***************************************************************************** + 909+ F553 CD 6A FB EOF: call CHKSQFL ; is there a seq. file open? + 910+ F556 1E 38 ld E,D0 ; prepare a file open error + 911+ F558 CA 63 18 jp Z,ERROR ; no, raise an error + 912+ F55B CD 46 1E call DEINT ; get any number + 913+ F55E 7B ld A,E ; is it 0? + 914+ F55F B7 or A + 915+ F560 28 07 jr Z,EOF1 ; ok, jump over + 916+ F562 3A D6 FF ld A,(SEQFL) ; get current file number + 917+ F565 BB cp E ; same? + 918+ F566 C2 5B 1E jp NZ,FCERR ; no, error + 919+ F569 D5 EOF1: push DE ; store value + 920+ F56A E5 push HL ; store code string pointer + 921+ F56B CD 5A FB call CHKEOF ; check EOF/size + 922+ F56E E1 pop HL ; retrieve code string pointer + 923+ F56F C1 pop BC ; retrieve argument + 924+ F570 3E 00 ld A,$00 ; reset A (w/o altering Carry) + 925+ F572 17 rla ; copy Carry into bit #0 + 926+ F573 47 ld B,A ; copy A into B + 927+ F574 79 ld A,C ; retrieve argument + 928+ F575 B7 or A ; is it zero? + 929+ F576 20 05 jr NZ,RETEOF ; return EOF + 930+ F578 7A ld A,D ; copy size into AB + 931+ F579 43 ld B,E + 932+ F57A C3 0B 26 jp ABPASS ; return size into AB + 933+ F57D 78 RETEOF: ld A,B ; retrieve EOF + 934+ F57E C3 1A 26 jp PASSA ; return value + 935+ F581 + 936+ F581 + 937+ F581 ; ***************************************************************************** + 938+ F581 ; P U T + 939+ F581 ; ***************************************************************************** + 940+ F581 CD A7 2A PUT: call GETINT ; get file number + 941+ F584 32 35 55 ld (TMPDBF),A ; store it + 942+ F587 CD 47 1B call CHKSYN ; Make sure ',' follows + 943+ F58A 2C defb ',' + 944+ F58B CD A7 2A call GETINT ; get mode + 945+ F58E 32 36 55 ld (TMPDBF+1),A ; store it + 946+ F591 E5 push HL ; store code string pointer + 947+ F592 CD 72 F3 call PUTFIL ; insert data into file + 948+ F595 DA 30 F0 jp C,DOS_ERR ; any error? + 949+ F598 E1 pop HL ; retrieve code string pointer + 950+ F599 C9 ret ; return to caller + 951+ F59A + 952+ F59A + 953+ F59A ; ***************************************************************************** + 954+ F59A ; G E T + 955+ F59A ; return a byte read from a sequential file + 956+ F59A ; ***************************************************************************** + 957+ F59A CD 46 1E GET: call DEINT ; get file number + 958+ F59D 7B ld A,E ; check if... + 959+ F59E B7 or A ; ...it's zero + 960+ F59F CA 5B 1E jp Z,FCERR ; yes, illegal function call + 961+ F5A2 CD 6A FB call CHKSQFL ; is there a seq. file opened? + 962+ F5A5 3E 38 ld A,D0 ; prepare a file open error + 963+ F5A7 28 67 jr Z,GETER ; no, exit with error + 964+ F5A9 3A D7 FF ld A,(SEQFLS) ; check mode + 965+ F5AC B7 or A ; is it write? + 966+ F5AD C2 5B 1E jp NZ,FCERR ; yes, raise error + 967+ F5B0 3A D6 FF ld A,(SEQFL) ; file number + 968+ F5B3 BB cp E ; same? + 969+ F5B4 C2 5B 1E jp NZ,FCERR ; no, error + 970+ F5B7 ; load byte pointed by seq. file pointer + 971+ F5B7 E5 push HL ; store code string pointer + 972+ F5B8 CD 5A FB call CHKEOF ; check if EOF + 973+ F5BB 1E 4C ld E,DA + 974+ F5BD DA 63 18 jp C,ERROR ; return EOF error + 975+ F5C0 2A DF FF ld HL,(SEQPNT) ; reload pointer in bytes + 976+ F5C3 7C ld A,H ; copy into AC + 977+ F5C4 4D ld C,L + 978+ F5C5 11 00 02 ld DE,$0200 ; size of buffer + 979+ F5C8 CD C4 41 call DIV_16_16 ; calculate (pointer MOD $200) => HL=current pointer into buffer + 980+ F5CB 11 C0 FD ld DE,IOBUFF ; address of I/O buffer + 981+ F5CE 19 add HL,DE ; find position of byte to load + 982+ F5CF 7E ld A,(HL) ; load byte + 983+ F5D0 32 9E 55 ld (TMPBFR1),A ; store + 984+ F5D3 2A DF FF ld HL,(SEQPNT) ; load pointer + 985+ F5D6 23 inc HL ; increment pointer + 986+ F5D7 22 DF FF ld (SEQPNT),HL + 987+ F5DA 11 00 02 ld DE,$0200 ; sector size + 988+ F5DD 7C ld A,H ; copy HL into AC + 989+ F5DE 4D ld C,L + 990+ F5DF CD C4 41 call DIV_16_16 ; calculate + 991+ F5E2 7D ld A,L + 992+ F5E3 BC cp H ; check if remainder is 0 meaning that we read all the buffer ($200 chars) + 993+ F5E4 20 23 jr NZ,GET1 ; no, jump over + 994+ F5E6 ED 4B DA FF ld BC,(SEQSCTL) ; load LSW of sector address + 995+ F5EA 03 inc BC ; next sector + 996+ F5EB 79 ld A,C ; check if BC is rolled back to zero (overflow) + 997+ F5EC B0 or B + 998+ F5ED 20 09 jr NZ,GET2 ; no, jump over + 999+ F5EF ED 5B D8 FF ld DE,(SEQSCTM) ; load MSW of sector address +1000+ F5F3 13 inc DE ; yes, increment MSW of sector address +1001+ F5F4 ED 53 D8 FF ld (SEQSCTM),DE ; save MSW of sector address +1002+ F5F8 ED 43 DA FF GET2: ld (SEQSCTL),BC ; save LSW of sector address +1003+ F5FC ED 5B D8 FF ld DE,(SEQSCTM) ; load MSW of sector address +1004+ F600 CD 0E FD call CF_SETSTR ; set sector to read +1005+ F603 CD 50 FD call CF_RD_SEC ; read next sector +1006+ F606 CD 44 FD call CF_STANDBY ; set CF to standby +1007+ F609 E1 GET1: pop HL ; retrieve code string pointer +1008+ F60A 3A 9E 55 ld A,(TMPBFR1) +1009+ F60D C3 1A 26 jp PASSA ; return A and then return to caller +1010+ F610 E1 GETER: pop HL ; retrieve code string pointer +1011+ F611 5F ld E,A ; load error code +1012+ F612 CD 44 FD call CF_STANDBY ; set CF into stand-by +1013+ F615 C3 63 18 jp ERROR ; raise error +1014+ F618 +1015+ F618 +1016+ F618 ; ***************************************************************************** +1017+ F618 ; DOS ERRORS +1018+ F618 ; ***************************************************************************** +1019+ F618 3E 38 FILOPCLER: ld A,D0 ; file open/close error +1020+ F61A 01 defb $01 ; Skip next statement +1021+ F61B 3E 4A FILALROP: ld A,D9 ; file already open +1022+ F61D 01 defb $01 ; Skip next statement +1023+ F61E 3E 3C D2ERR: ld A,D2 ; disk geometry error +1024+ F620 01 defb $01 ; Skip next statement +1025+ F621 3E 42 DSKFULL: ld A,D5 ; disk full error +1026+ F623 01 defb $01 ; Skip next statement +1027+ F624 3E 44 DUPLERR: ld A,D6 ; duplicate file name +1028+ F626 01 defb $01 ; Skip next statement +1029+ F627 3E 3A NAMERR: ld A,D1 ; file name error +1030+ F629 01 defb $01 ; Skip next statement +1031+ F62A 3E 48 FLNTFND: ld A,D8 ; file not found +1032+ F62C 01 defb $01 ; Skip next statement +1033+ F62D 3E 40 LODERR: ld A,D4 ; generic load error +1034+ F62F 01 defb $01 ; Skip next statement +1035+ F630 3E 46 DOSVERSERR: ld A,D7 ; DOS version error +1036+ F632 32 34 55 RET_ERR: ld (DOSER),A ; store DOS error +1037+ F635 CD 44 FD call CF_STANDBY ; set CF into stand-by +1038+ F638 37 scf ; set Carry for error +1039+ F639 C9 ret ; return to caller +1040+ F63A +1041+ F63A +1042+ F63A ; ***************************************************************************** +1043+ F63A ; L I S T F I L E S +1044+ F63A ; Function: print details of disk and list files +1045+ F63A ; Input: D: $00=only disk details; $01=file list, too +1046+ F63A ; ***************************************************************************** +1047+ F63A 44 69 73 6B DSKNMTX: defb "Disk name: ",0 +1047+ F63E 20 6E 61 6D +1047+ F642 65 3A 20 00 +1048+ F646 0D 53 65 63 TLSCTTX: defb CR,"Sectors: ",0 +1048+ F64A 74 6F 72 73 +1048+ F64E 3A 20 00 +1049+ F651 0D 41 6C 6C ALFLSTXT: defb CR,"Allowed files: ",0 +1049+ F655 6F 77 65 64 +1049+ F659 20 66 69 6C +1049+ F65D 65 73 3A 20 +1049+ F661 00 +1050+ F662 20 66 69 6C TLFLSTX: defb " file(s)",CR,0 +1050+ F666 65 28 73 29 +1050+ F66A 0D 00 +1051+ F66C CD 6A FB LST_FILES: call CHKSQFL ; check if a seq. file is open +1052+ F66F C2 18 F6 jp NZ,FILOPCLER ; jump if open +1053+ F672 CD 03 FC call CHKDSKVAL ; check DOS version & load disk details +1054+ F675 DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error +1055+ F678 D5 push DE ; store D +1056+ F679 CD B7 FB call LDMSCT ; load Master Sector +1057+ F67C 21 3A F6 ld HL,DSKNMTX ; pointer to "Disk name" message +1058+ F67F CD 29 27 call PRS ; print it +1059+ F682 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer +1060+ F685 11 20 00 ld DE,$0020 ; position of disk name +1061+ F688 19 add HL,DE ; get address +1062+ F689 06 10 ld B,$10 ; 16 chars +1063+ F68B 7E INPR1: ld A,(HL) ; load char +1064+ F68C CD 52 1B call OUTC ; print it +1065+ F68F 23 inc HL +1066+ F690 10 F9 djnz INPR1 ; repeat +1067+ F692 3E 0D ld A,CR +1068+ F694 CD 52 1B call OUTC ; carriage return +1069+ F697 DD 21 00 00 ld IX,$0000 ; reset file counter (for use in formatting) +1070+ F69B D1 pop DE ; retrieve D +1071+ F69C 7A ld A,D +1072+ F69D B7 or A ; is D=0? +1073+ F69E CA 51 F7 jp Z,PNTSTATS ; yes, jump over +1074+ F6A1 ; print list of files +1075+ F6A1 21 C0 FD ld HL,IOBUFF ; start of I/O buffer +1076+ F6A4 11 0F 00 ld DE,$000F ; point to details of disk +1077+ F6A7 19 add HL,DE ; find address +1078+ F6A8 11 A0 FD ld DE,DOSBFR ; store into DOS buffer +1079+ F6AB 01 20 00 ld BC,$0020 ; 32 bytes +1080+ F6AE ED B0 ldir ; copy +1081+ F6B0 CD A8 FB call LDENTRIES ; load entries +1082+ F6B3 FD 2A 3B 55 ld IY,(NTR_NBR) ; load max entries +1083+ F6B7 D9 exx +1084+ F6B8 01 00 00 ld BC,$0000 ; reset file counter +1085+ F6BB D9 exx +1086+ F6BC CD 6F FB call SETPTEN ; point to 1st sector of dir +1087+ F6BF CD 77 FB LSTFILES1: call PT2FSEN ; point to 1st entry of a dir's sect +1088+ F6C2 CD 82 FB LSTFILES2: call CKCREN ; check current entry +1089+ F6C5 28 64 jr Z,LSTFILES6 ; if empty or deleted, ignore it +1090+ F6C7 C5 push BC ; this is a valid entry - so, store BC (LSW of sect) +1091+ F6C8 FD E5 push IY ; store IY (entries counter) +1092+ F6CA E5 push HL ; store HL (sect entry counter) +1093+ F6CB D5 push DE ; store DE (MSW of sector) +1094+ F6CC DD E5 push IX ; store IX (pointer to first byte of entry) +1095+ F6CE 06 10 ld B,$10 ; 16 chars to read and print +1096+ F6D0 DD 7E 00 LSTFILES3: ld A,(IX) ; load char from name +1097+ F6D3 CD 52 1B call OUTC ; print char +1098+ F6D6 DD 23 inc IX ; next char +1099+ F6D8 10 F6 djnz LSTFILES3 ; repeat +1100+ F6DA 3E 20 ld A,SPC +1101+ F6DC CD 52 1B call OUTC ; print space +1102+ F6DF DD 7E 00 ld A,(IX) ; file type +1103+ F6E2 D6 80 sub $80 ; types start from $80 +1104+ F6E4 B7 or A ; BAS type ($00)? +1105+ F6E5 20 05 jr NZ,LSTFILES20 ; no, jump over +1106+ F6E7 21 95 F7 ld HL,FILETP ; print "BAS" +1107+ F6EA 18 13 jr LSTFILESPR +1108+ F6EC 3D LSTFILES20: dec A ; BIN type ($01)? +1109+ F6ED 20 05 jr NZ,LSTFILES21 ; no, jump over +1110+ F6EF 21 9A F7 ld HL,FILETP+5 ; print "BIN" +1111+ F6F2 18 0B jr LSTFILESPR +1112+ F6F4 3D LSTFILES21: dec A +1113+ F6F5 20 05 jr NZ,LSTFILES22 +1114+ F6F7 21 9F F7 ld HL,FILETP+10 ; print "SEQ" +1115+ F6FA 18 03 jr LSTFILESPR +1116+ F6FC 21 9F F7 LSTFILES22: ld HL,FILETP+10 ; print "???" +1117+ F6FF CD 29 27 LSTFILESPR: call PRS +1118+ F702 01 08 00 ld BC,$0008 +1119+ F705 DD 09 add IX,BC ; point to file size in bytes +1120+ F707 DD 4E 00 ld C,(IX) ; load size in BC, first LSW +1121+ F70A DD 23 inc IX +1122+ F70C DD 46 00 ld B,(IX) ; then MSW +1123+ F70F C5 push BC ; copy... +1124+ F710 DD E1 pop IX ; ...into IX +1125+ F712 11 00 00 ld DE,$0000 ; reset DE +1126+ F715 FD E5 push IY +1127+ F717 CD 76 FC call PRN16ASCIX ; print size in bytes (DEIX) +1128+ F71A FD E1 pop IY +1129+ F71C 3E 0D ld A,CR +1130+ F71E CD 52 1B call OUTC ; print carriage return +1131+ F721 D9 exx ; set shadow registers +1132+ F722 03 inc BC ; increment file counter +1133+ F723 D9 exx ; restore main registers +1134+ F724 DD E1 pop IX ; retrieve IX +1135+ F726 D1 pop DE ; retrieve DE +1136+ F727 E1 pop HL ; retrieve HL +1137+ F728 FD E1 pop IY ; retrieve IY +1138+ F72A C1 pop BC ; retrieve BC +1139+ F72B CD BB 1D LSTFILES6: call TSTBRK ; Test for break key +1140+ F72E CD BE 1C call TSTSPC ; test for space +1141+ F731 CD 8A FB call GTNXTEN ; other entries in this sector? +1142+ F734 20 8C jr NZ,LSTFILES2 ; yes, continue check +1143+ F736 CD 96 FB call CKLSTEN ; go to next sector +1144+ F739 D2 BF F6 jp NC,LSTFILES1 ; more entries? repeat +1145+ F73C D9 exx ; set shadow registers +1146+ F73D C5 push BC ; store file counter +1147+ F73E D9 exx ; restore main registers +1148+ F73F DD E1 pop IX ; retrieve file counter +1149+ F741 DD E5 push IX ; store it again +1150+ F743 11 00 00 ld DE,$0000 ; reset DE +1151+ F746 CD 76 FC call PRN16ASCIX ; print number of files from DEIX +1152+ F749 21 62 F6 ld HL,TLFLSTX +1153+ F74C CD 29 27 call PRS ; print "file(s)" +1154+ F74F DD E1 pop IX +1155+ F751 21 46 F6 PNTSTATS: ld HL,TLSCTTX ; Point to message "Tot. sectors" +1156+ F754 CD 29 27 call PRS ; print message +1157+ F757 21 A0 FD ld HL,DOSBFR ; reload address of I/O buffer and point to disk size +1158+ F75A DD E5 push IX +1159+ F75C CD 6D FC call PRN32ASCII ; print size +1160+ F75F 3E 2F ld A,'/' +1161+ F761 CD 52 1B call OUTC ; print a "/"" +1162+ F764 D1 pop DE ; copy number of entries into DE +1163+ F765 01 80 00 ld BC,$0080 ; 128 sectors per entry block +1164+ F768 CD 7F 41 call MUL_U32 ; multiply BC times DE: returns DEHL +1165+ F76B ED 53 46 55 ld (TPBF1),DE ; store results +1166+ F76F 22 48 55 ld (TPBF2),HL +1167+ F772 21 46 55 ld HL,TPBF1 ; print results +1168+ F775 CD 6D FC call PRN32ASCII +1169+ F778 21 51 F6 ld HL,ALFLSTXT ; Point to message "Allowed files" +1170+ F77B CD 29 27 call PRS ; print message +1171+ F77E 21 A0 FD ld HL,DOSBFR ; reload address of I/O buffer +1172+ F781 01 0A 00 ld BC,$000A ; address of allowed files +1173+ F784 09 add HL,BC ; find pointer +1174+ F785 11 00 00 ld DE,$0000 ; MSW set to $0000 +1175+ F788 CD 70 FC call PRN16ASCII ; print max files +1176+ F78B 3E 0D ld A,CR +1177+ F78D CD 52 1B call OUTC ; print a carriage return +1178+ F790 CD 44 FD call CF_STANDBY ; put CF into standby +1179+ F793 AF xor A ; clear Carry flag +1180+ F794 C9 ret ; return to caller +1181+ F795 42 41 53 20 FILETP: defb "BAS ",0 ; BASIC type +1181+ F799 00 +1182+ F79A 42 49 4E 20 defb "BIN ",0 ; BINARY type +1182+ F79E 00 +1183+ F79F 53 45 51 20 defb "SEQ ",0 ; SEQUENTIAL type +1183+ F7A3 00 +1184+ F7A4 3F 3F 3F 20 defb "??? ",0 ; unkown +1184+ F7A8 00 +1185+ F7A9 +1186+ F7A9 +1187+ F7A9 ; ***************************************************************************** +1188+ F7A9 ; S A V E F I L E +1189+ F7A9 ; save current BASIC program onto a file +1190+ F7A9 ; ***************************************************************************** +1191+ F7A9 CD 6A FB SAVFILE: call CHKSQFL ; check if a seq. file is open +1192+ F7AC C2 18 F6 jp NZ,FILOPCLER ; jump if open +1193+ F7AF CD 41 F9 call CHKFLEXT ; file already exists? +1194+ F7B2 DA 24 F6 jp C,DUPLERR ; name is present - error +1195+ F7B5 CD 32 FB call FNDFRENTR ; find a free entry in the directory +1196+ F7B8 DA 21 F6 jp C,DSKFULL ; no entry, disk full error +1197+ F7BB 3A 4C 55 ld A,(TPBF4) ; check what to save +1198+ F7BE FE 80 cp $80 ; BASIC program? +1199+ F7C0 C2 CF F7 jp NZ,SAVFL3 ; no, jump over +1200+ F7C3 ; BASIC area to save starts at PROGND and ends at (PROGND) +1201+ F7C3 2A E4 55 ld HL,(PROGND) ; load end of BASIC program <- WARNING: pay attention to (PROGND) and PROGND +1202+ F7C6 11 E4 55 ld DE,PROGND ; start of RAM to be saved <- WARNING: pay attention to (PROGND) and PROGND +1203+ F7C9 ED 53 4E 55 ld (SRTMEM),DE ; copy DE +1204+ F7CD 18 08 jr SAVFL1 +1205+ F7CF 2A 50 55 SAVFL3: ld HL,(ENDMEM) ; save a portion of memory: HL <= end of portion +1206+ F7D2 23 inc HL ; we always need 1 more byte to store the portion of memory +1207+ F7D3 ED 5B 4E 55 ld DE,(SRTMEM) ; DE <= start of portion +1208+ F7D7 ; compute how many sectors/blocks are needed to save file +1209+ F7D7 AF SAVFL1: xor A ; reset Carry +1210+ F7D8 ED 52 sbc HL,DE ; get how many bytes to save +1211+ F7DA 22 3D 55 ld (BYT_SIZ),HL ; store into memory +1212+ F7DD 11 00 02 ld DE,$0200 ; 512 bytes per sector +1213+ F7E0 7C ld A,H ; move lenght... +1214+ F7E1 4D ld C,L ; ...into AC +1215+ F7E2 CD C4 41 call DIV_16_16 ; lenght/512 = nbr. of sectors: quotient in AC but A will be discarded +1216+ F7E5 7C ld A,H ; check if... +1217+ F7E6 B5 or L ; ...remainder (HL) is 0 +1218+ F7E7 28 01 jr Z,SAVFL6 ; yes, jump over +1219+ F7E9 03 inc BC ; no, so we need another sector +1220+ F7EA 79 SAVFL6: ld A,C +1221+ F7EB 32 3F 55 ld (SCT_SIZ),A ; store into memory +1222+ F7EE CD 5E F8 call SVENTRY ; save new entry into dir +1223+ F7F1 CD 9F FC call CLRIOBF ; clear I/O buffer +1224+ F7F4 ; start saving RAM +1225+ F7F4 ED 5B 4E 55 ld DE,(SRTMEM) ; load start of RAM +1226+ F7F8 ED 53 44 55 ld (RAM_PTR),DE ; store +1227+ F7FC CD 9F FC SAVFL10: call CLRIOBF ; clear I/O buffer +1228+ F7FF 2A 3D 55 ld HL,(BYT_SIZ) ; load bytes left to be copied +1229+ F802 11 00 02 ld DE,$0200 ; are they < 512? +1230+ F805 CD 5A 41 call CMP16 +1231+ F808 30 04 jr NC,SAVFL4 ; no, jump over +1232+ F80A ED 5B 3D 55 ld DE,(BYT_SIZ) ; yes, so load remaining bytes +1233+ F80E 4B SAVFL4: ld C,E ; bytes to copy +1234+ F80F 42 ld B,D ; into BC +1235+ F810 2A 44 55 ld HL,(RAM_PTR) ; load pointer to RAM to be saved +1236+ F813 11 C0 FD ld DE,IOBUFF ; load start of I/O buffer +1237+ F816 ED B0 ldir ; copy data +1238+ F818 ED 5B 40 55 ld DE,(MSW_SCT) ; load MSW of sector +1239+ F81C ED 4B 42 55 ld BC,(LSW_SCT) ; load LSW of sector +1240+ F820 CD 77 FD call CF_WR_SEC ; write sector +1241+ F823 DA 9B FA jp C,WRT_ERR ; error? +1242+ F826 21 3F 55 ld HL,SCT_SIZ ; sector counter +1243+ F829 35 dec (HL) ; copied all the sectors? +1244+ F82A CA 59 F8 jp Z,SAVFLEXT ; yes, exit +1245+ F82D 2A 44 55 ld HL,(RAM_PTR) ; pointer to RAM +1246+ F830 11 00 02 ld DE,$0200 ; block of 512 bytes copied +1247+ F833 19 add HL,DE ; calculate next starting address +1248+ F834 22 44 55 ld (RAM_PTR),HL ; store next block +1249+ F837 AF xor A ; reset Carry +1250+ F838 2A 3D 55 ld HL,(BYT_SIZ) ; load left bytes +1251+ F83B ED 52 sbc HL,DE ; subtract copied bytes +1252+ F83D 22 3D 55 ld (BYT_SIZ),HL ; store left bytes +1253+ F840 ED 4B 42 55 ld BC,(LSW_SCT) ; load LSW of sector +1254+ F844 03 inc BC ; next sector +1255+ F845 78 ld A,B ; BC=$0000? +1256+ F846 B1 or C +1257+ F847 20 09 jr NZ,SAVFL12 ; no, jump over +1258+ F849 ED 5B 40 55 ld DE,(MSW_SCT) ; load MSW of sector +1259+ F84D 13 inc DE ; increment DE +1260+ F84E ED 53 40 55 ld (MSW_SCT),DE ; store new MSW of sector +1261+ F852 ED 43 42 55 SAVFL12: ld (LSW_SCT),BC ; store new LSW of sector +1262+ F856 C3 FC F7 jp SAVFL10 ; repeat +1263+ F859 CD 44 FD SAVFLEXT: call CF_STANDBY ; set CF into stand-by mode +1264+ F85C AF xor A ; clear Carry flag +1265+ F85D C9 ret ; return to caller +1266+ F85E +1267+ F85E +1268+ F85E ; save entry on disk +1269+ F85E 11 00 00 SVENTRY: ld DE,$0000 ; directory is always from sector 0000-0001 +1270+ F861 ED 4B 39 55 ld BC,(DIR_SCT) ; load sector of dir where to save file entry +1271+ F865 CD 0E FD call CF_SETSTR ; set sector to read +1272+ F868 CD 50 FD call CF_RD_SEC ; read sector +1273+ F86B 3A 3B 55 ld A,(NTR_NBR) ; load entry number (ignoring MSB) +1274+ F86E E6 0F and %00001111 ; be sure to get only low nibble +1275+ F870 87 add A,A ; multiply... +1276+ F871 87 add A,A ; ...times 16 by... +1277+ F872 87 add A,A ; ...adding... +1278+ F873 87 add A,A ; ...4 times +1279+ F874 CB 27 sla A ; left shift to multiply times 32 - Carry is set if results is > 255 +1280+ F876 5F ld E,A ; copy into C +1281+ F877 CB 12 rl D ; if Carry, then increment D (D was 0, see above) +1282+ F879 ; set name +1283+ F879 21 C0 FD ld HL,IOBUFF ; get starting address of I/O buffer +1284+ F87C 19 add HL,DE ; add offset to get address of entry +1285+ F87D 11 A0 FD ld DE,DOSBFR ; pointer to file name +1286+ F880 01 10 00 ld BC,$0010 ; 16 chars +1287+ F883 EB ex DE,HL ; move source into HL and destination into DE +1288+ F884 ED B0 ldir ; copy file name +1289+ F886 EB ex DE,HL ; move current buffer pointer into HL +1290+ F887 3A 4C 55 ld A,(TPBF4) ; load the type of file +1291+ F88A 77 ld (HL),A ; store it +1292+ F88B 23 inc HL +1293+ F88C AF xor A ; file attributes - AT THE MOMENT, NO ATTRIBUTES +1294+ F88D 77 ld (HL),A +1295+ F88E 23 inc HL +1296+ F88F ED 5B 3B 55 ld DE,(NTR_NBR) ; reload entry number +1297+ F893 CD 63 FC call DE2HL ; store entry into buffer +1298+ F896 E5 push HL ; store pointer +1299+ F897 01 80 00 ld BC,$0080 ; 128 sectors per entry block +1300+ F89A CD 7F 41 call MUL_U32 ; multiply BC times DE: returns DEHL +1301+ F89D ED 4B 37 55 ld BC,(DAT_STRT) ; load start of data +1302+ F8A1 09 add HL,BC ; add sector of data area +1303+ F8A2 30 01 jr NC,SAVFL9 ; overflow? +1304+ F8A4 13 inc DE ; yes, increment DE +1305+ F8A5 ED 53 40 55 SAVFL9: ld (MSW_SCT),DE ; store MSW of sector +1306+ F8A9 22 42 55 ld (LSW_SCT),HL ; store LSW of sector +1307+ F8AC E1 pop HL ; retrieve pointer +1308+ F8AD CD 63 FC call DE2HL ; also copy MSW of sector into entry +1309+ F8B0 ED 5B 42 55 ld DE,(LSW_SCT) ; retrieve LSW +1310+ F8B4 CD 63 FC call DE2HL ; also copy LSW of sector into entry +1311+ F8B7 ED 5B 3D 55 ld DE,(BYT_SIZ) ; retrieve file size in bytes +1312+ F8BB CD 63 FC call DE2HL ; copy file size into buffer +1313+ F8BE 3A 3F 55 ld A,(SCT_SIZ) ; retrieve file size in sectors +1314+ F8C1 77 ld (HL),A ; copy into buffer +1315+ F8C2 23 inc HL ; next location +1316+ F8C3 ED 5B 4E 55 ld DE,(SRTMEM) ; start of address of file in RAM +1317+ F8C7 CD 63 FC call DE2HL ; copy into buffer +1318+ F8CA 06 03 ld B,$03 ; remaining chars... +1319+ F8CC AF xor A ; ...set to $00 +1320+ F8CD 77 SAVFL2: ld (HL),A ; reset byte +1321+ F8CE 23 inc HL ; next cell +1322+ F8CF 10 FC djnz SAVFL2 ; repeat +1323+ F8D1 ; save entry into directory +1324+ F8D1 11 00 00 ld DE,$0000 ; block 0 +1325+ F8D4 ED 4B 39 55 ld BC,(DIR_SCT) ; load sector of dir where to save file entry +1326+ F8D8 CD 77 FD call CF_WR_SEC ; write new entry into directory +1327+ F8DB DA 1E F6 jp C,D2ERR ; error occured +1328+ F8DE C9 ret +1329+ F8DF +1330+ F8DF +1331+ F8DF ; ***************************************************************************** +1332+ F8DF ; C H A N G E F I L E N A M E +1333+ F8DF ; change name to a file +1334+ F8DF ; ***************************************************************************** +1335+ F8DF ED 5B 3D 55 CHNGNAM: ld DE,(BYT_SIZ) ; load lenght +1336+ F8E3 ED 53 A2 55 ld (DKLNPT),DE ; store it +1337+ F8E7 ED 5B 44 55 ld DE,(RAM_PTR) ; load address +1338+ F8EB ED 53 A0 55 ld (DKNMPT),DE ; store it +1339+ F8EF CD 41 F9 call CHKFLEXT ; destination file already exists? +1340+ F8F2 DA 24 F6 jp C,DUPLERR ; file name already exists +1341+ F8F5 CD 9F FC call CLRIOBF ; clear I/O buffer +1342+ F8F8 ED 5B A4 55 ld DE,(TMPBFR4) ; load lenght +1343+ F8FC ED 53 A2 55 ld (DKLNPT),DE ; store it +1344+ F900 ED 5B 4E 55 ld DE,(TPBF4+2) ; load address +1345+ F904 ED 53 A0 55 ld (DKNMPT),DE ; store it +1346+ F908 CD 5E F9 call LK4FILE ; look for file +1347+ F90B D2 2A F6 jp NC,FLNTFND ; file not found error +1348+ F90E ED 5B 3D 55 ld DE,(BYT_SIZ) ; load lenght +1349+ F912 ED 53 A2 55 ld (DKLNPT),DE ; store it +1350+ F916 ED 5B 44 55 ld DE,(RAM_PTR) ; load address +1351+ F91A ED 53 A0 55 ld (DKNMPT),DE ; store it +1352+ F91E CD B4 FC call CLRDOSBF ; clear DOS buffer +1353+ F921 11 A0 FD ld DE,DOSBFR ; DE set to beginning of DOS buffer +1354+ F924 CD 3B FC call CHKNMVAL ; check and copy file name +1355+ F927 21 A0 FD ld HL,DOSBFR ; retrieve new name pointer +1356+ F92A DD E5 push IX ; copy dest. address... +1357+ F92C D1 pop DE ; ...into DE +1358+ F92D 01 10 00 ld BC,$0010 ; 16 chars to copy +1359+ F930 ED B0 ldir ; copy +1360+ F932 ED 5B 48 55 ld DE,(TPBF2) ; retrieve MSW of dir. sector +1361+ F936 ED 4B 4A 55 ld BC,(TPBF3) ; retrieve LSW of dir. sector +1362+ F93A CD 77 FD call CF_WR_SEC ; write sector +1363+ F93D CD 44 FD call CF_STANDBY ; put CF in standby +1364+ F940 C9 ret ; return to caller +1365+ F941 +1366+ F941 +1367+ F941 ; ***************************************************************************** +1368+ F941 ; C H E C K F I L E E X I S T A N C E +1369+ F941 ; check if a file with the given name exists into dir +1370+ F941 ; Carry set if exist +1371+ F941 ; ***************************************************************************** +1372+ F941 CD 9F FC CHKFLEXT: call CLRIOBF ; clear I/O +1373+ F944 CD 03 FC call CHKDSKVAL ; check DOS version & load disk details +1374+ F947 DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error +1375+ F94A CD A8 FB call LDENTRIES ; load entries into RAM register NTR_NBR +1376+ F94D CD 68 FC call HL2DE ; get start of directory into DE +1377+ F950 ED 53 35 55 ld (DIR_STRT),DE ; store +1378+ F954 CD 68 FC call HL2DE ; get start of data area into DE +1379+ F957 ED 53 37 55 ld (DAT_STRT),DE ; store +1380+ F95B C3 61 F9 jp LK4FILE1 ; check for name already present in dir and return to caller +1381+ F95E +1382+ F95E +1383+ F95E ; ***************************************************************************** +1384+ F95E ; L O O K F O R A F I L E +1385+ F95E ; look for the given file into the dir +1386+ F95E ; Carry is reset if not found, set otherwise +1387+ F95E ; ***************************************************************************** +1388+ F95E CD A8 FB LK4FILE: call LDENTRIES ; load entries into RAM register NTR_NBR +1389+ F961 CD 9F FC LK4FILE1: call CLRIOBF ; clear IO buffer +1390+ F964 CD B4 FC call CLRDOSBF ; clear DOS buffer +1391+ F967 11 A0 FD ld DE,DOSBFR ; DE set to beginning of DOS buffer +1392+ F96A CD 3B FC call CHKNMVAL ; check and copy file name +1393+ F96D DA 27 F6 jp C,NAMERR ; if Carry, file name error +1394+ F970 C3 A0 FA jp FILE_EXIST ; check if file exists and return to caller +1395+ F973 +1396+ F973 +1397+ F973 ; ***************************************************************************** +1398+ F973 ; F I L E L O A D +1399+ F973 ; load a file from the disk into the memory +1400+ F973 ; ***************************************************************************** +1401+ F973 CD 6A FB LODFILE: call CHKSQFL ; check if a seq. file is open +1402+ F976 C2 18 F6 jp NZ,FILOPCLER ; jump if open +1403+ F979 CD 9F FC call CLRIOBF ; clear I/O +1404+ F97C CD 03 FC call CHKDSKVAL ; check DOS version & load disk details +1405+ F97F DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error +1406+ F982 CD 5E F9 call LK4FILE ; look for given file +1407+ F985 D2 2A F6 jp NC,FLNTFND ; file not found - error +1408+ F988 DD E5 push IX ; copy pointer to file... +1409+ F98A E1 pop HL ; ...into HL +1410+ F98B 01 10 00 ld BC,$0010 ; skip file name (16 chars)... +1411+ F98E 09 add HL,BC ; ...by getting pointer to file details +1412+ F98F 7E ld A,(HL) ; load file type +1413+ F990 FE 80 cp $80 ; 'BAS' type? +1414+ F992 28 0C jr Z,LDFL4 ; yes, jump over +1415+ F994 FE 81 cp $81 ; 'BIN' type? +1416+ F996 C2 2D F6 jp NZ,LODERR ; no, raise error +1417+ F999 3A 4C 55 ld A,(TPBF4) ; if BIN file, file must be loaded into its original position +1418+ F99C B7 or A ; did the user set this? +1419+ F99D CA 2D F6 jp Z,LODERR ; no, raise an error +1420+ F9A0 0E 04 LDFL4: ld C,$04 ; 4 steps forward and also 4 bytes to copy +1421+ F9A2 09 add HL,BC ; point to starting sector +1422+ F9A3 11 40 55 ld DE,MSW_SCT ; point to store sector address of file +1423+ F9A6 ED B0 ldir ; copy MSW/LSW from entry into buffer +1424+ F9A8 11 3D 55 ld DE,BYT_SIZ ; point to store size of file +1425+ F9AB 01 03 00 ld BC,$0003 ; 3 bytes to copy +1426+ F9AE ED B0 ldir ; copy size in bytes and sectors from entry into buffer +1427+ F9B0 11 E4 55 ld DE,PROGND ; load start of BASIC RAM +1428+ F9B3 3A 4C 55 ld A,(TPBF4) ; check where to save the data from +1429+ F9B6 B7 or A ; is it 0? (meaning from the current BASIC pointers) +1430+ F9B7 28 03 jr Z,LDFL1 ; yes, don't re-load the file from the address stored into the file +1431+ F9B9 CD 68 FC call HL2DE ; no, load RAM address from disk +1432+ F9BC ED 53 44 55 LDFL1: ld (RAM_PTR),DE ; store starting pointer +1433+ F9C0 ; start loading from disk +1434+ F9C0 CD 9F FC LDFL2: call CLRIOBF ; clear I/O buffer +1435+ F9C3 ED 5B 40 55 ld DE,(MSW_SCT) ; load MSW of sector +1436+ F9C7 ED 4B 42 55 ld BC,(LSW_SCT) ; load LSW of sector +1437+ F9CB CD 0E FD call CF_SETSTR ; set sector +1438+ F9CE CD 50 FD call CF_RD_SEC ; read sector +1439+ F9D1 2A 3D 55 ld HL,(BYT_SIZ) ; load bytes left to be copied +1440+ F9D4 11 00 02 ld DE,$0200 ; are they < 512? +1441+ F9D7 CD 5A 41 call CMP16 +1442+ F9DA 30 04 jr NC,LDFL3 ; no, jump over +1443+ F9DC ED 5B 3D 55 ld DE,(BYT_SIZ) ; yes, so load only remaining bytes +1444+ F9E0 4B LDFL3: ld C,E ; move bytes to copy... +1445+ F9E1 42 ld B,D ; ...into BC +1446+ F9E2 21 C0 FD ld HL,IOBUFF ; point to I/O buffer +1447+ F9E5 ED 5B 44 55 ld DE,(RAM_PTR) ; point to RAM where to save +1448+ F9E9 ED B0 ldir ; copy data +1449+ F9EB 21 3F 55 ld HL,SCT_SIZ ; sector counter +1450+ F9EE 35 dec (HL) ; copied all the sectors? +1451+ F9EF CA 1E FA jp Z,LDFLEX ; yes, exit +1452+ F9F2 2A 44 55 ld HL,(RAM_PTR) ; pointer to RAM +1453+ F9F5 11 00 02 ld DE,$0200 ; block of 512 bytes copied +1454+ F9F8 19 add HL,DE ; calculate next starting address +1455+ F9F9 22 44 55 ld (RAM_PTR),HL ; store next block +1456+ F9FC AF xor A ; reset Carry +1457+ F9FD 2A 3D 55 ld HL,(BYT_SIZ) ; load left bytes +1458+ FA00 ED 52 sbc HL,DE ; subtract copied bytes +1459+ FA02 22 3D 55 ld (BYT_SIZ),HL ; store left bytes +1460+ FA05 ED 4B 42 55 ld BC,(LSW_SCT) ; load LSW of sector +1461+ FA09 03 inc BC ; next sector +1462+ FA0A 78 ld A,B ; BC=$0000? +1463+ FA0B B1 or C +1464+ FA0C 20 09 jr NZ,LDFL5 ; no, jump over +1465+ FA0E ED 5B 40 55 ld DE,(MSW_SCT) ; load MSW of sector +1466+ FA12 13 inc DE ; increment DE +1467+ FA13 ED 53 40 55 ld (MSW_SCT),DE ; store new MSW of sector +1468+ FA17 ED 43 42 55 LDFL5: ld (LSW_SCT),BC ; store new LSW of sector +1469+ FA1B C3 C0 F9 jp LDFL2 ; repeat +1470+ FA1E CD 44 FD LDFLEX: call CF_STANDBY ; set CF into stand-by mode +1471+ FA21 AF xor A ; clear Carry flag +1472+ FA22 C9 ret ; return to caller +1473+ FA23 +1474+ FA23 +1475+ FA23 ; ***************************************************************************** +1476+ FA23 ; F I L E E R A S E +1477+ FA23 ; erase a file from disk, freeing its block +1478+ FA23 ; ***************************************************************************** +1479+ FA23 CD 6A FB FIL_ERASE: call CHKSQFL ; check if a seq. file is open +1480+ FA26 C2 18 F6 jp NZ,FILOPCLER ; jump if open +1481+ FA29 CD 9F FC call CLRIOBF ; clear I/O +1482+ FA2C CD 03 FC call CHKDSKVAL ; check DOS version & load disk details +1483+ FA2F DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error +1484+ FA32 CD 5E F9 call LK4FILE ; look for given file +1485+ FA35 D2 2A F6 jp NC,FLNTFND ; file not found - error +1486+ FA38 DD 5E 14 ld E,(IX+$14) ; load MSW into DE +1487+ FA3B DD 56 15 ld D,(IX+$15) +1488+ FA3E DD 4E 16 ld C,(IX+$16) ; load LSW into BC +1489+ FA41 DD 46 17 ld B,(IX+$17) +1490+ FA44 ED 53 40 55 ld (MSW_SCT),DE ; store DE +1491+ FA48 ED 43 42 55 ld (LSW_SCT),BC ; store BC +1492+ FA4C DD 7E 1A ld A,(IX+$1A) ; load size in sectors +1493+ FA4F 32 3F 55 ld (SCT_SIZ),A ; store it +1494+ FA52 3E 7F ld A,$7F ; marker for file deleted +1495+ FA54 DD 77 00 ld (IX),A ; set file as deleted (quick erase) +1496+ FA57 3A 4C 55 ld A,(TPBF4) ; check for quick or full delete +1497+ FA5A B7 or A ; A=0 quick erase +1498+ FA5B 28 0A jr Z,FIL_ERA5 ; jump if quick erase +1499+ FA5D AF xor A ; clear A +1500+ FA5E 06 20 ld B,$20 ; full erase - clean entry (32 cells) +1501+ FA60 DD 77 00 FIL_ERA6: ld (IX),A ; reset cell +1502+ FA63 DD 23 inc IX ; next cell +1503+ FA65 10 F9 djnz FIL_ERA6 ; repeat +1504+ FA67 ED 5B 48 55 FIL_ERA5: ld DE,(TPBF2) ; retrieve MSW of current directory sector +1505+ FA6B ED 4B 4A 55 ld BC,(TPBF3) ; retrieve LSW of current directory sector +1506+ FA6F CD 77 FD call CF_WR_SEC ; write sector +1507+ FA72 38 27 jr C,WRT_ERR ; error? +1508+ FA74 3A 4C 55 ld A,(TPBF4) ; check for quick or full delete +1509+ FA77 B7 or A ; if A=0 then quick erase +1510+ FA78 28 1C jr Z,FIL_ERA3 ; yes, leave +1511+ FA7A CD 9F FC call CLRIOBF ; no, full delete - clear I/O buffer +1512+ FA7D ED 5B 40 55 ld DE,(MSW_SCT) ; load MSW of 1st sector of file block +1513+ FA81 ED 4B 42 55 ld BC,(LSW_SCT) ; load LSW of 1st sector of file block +1514+ FA85 21 3F 55 ld HL,SCT_SIZ ; pointer to size in sectors +1515+ FA88 CD 77 FD FIL_ERA1: call CF_WR_SEC ; erase sector +1516+ FA8B 38 0E jr C,WRT_ERR ; error? +1517+ FA8D 03 inc BC ; next sector +1518+ FA8E 78 ld A,B ; is LSW rolled back to 0? +1519+ FA8F B1 or C +1520+ FA90 20 01 jr NZ,FIL_ERA2 ; no, jump over +1521+ FA92 13 inc DE ; yes, increment MSW +1522+ FA93 35 FIL_ERA2: dec (HL) ; decrement sector counter +1523+ FA94 20 F2 jr NZ,FIL_ERA1 ; repeat if other sectors +1524+ FA96 CD 44 FD FIL_ERA3: call CF_STANDBY ; set CF into stand-by mode +1525+ FA99 AF xor A ; clear Carry +1526+ FA9A C9 ret +1527+ FA9B CD 44 FD WRT_ERR: call CF_STANDBY ; put CF into stand-by +1528+ FA9E 37 scf ; set error +1529+ FA9F C9 ret ; return to caller +1530+ FAA0 +1531+ FAA0 +1532+ FAA0 ; ***************************************************************************** +1533+ FAA0 ; F I L E C H E C K +1534+ FAA0 ; check if file name already exists in directory +1535+ FAA0 ; file name must be stored from DOSBFR for 16 chars +1536+ FAA0 ; ***************************************************************************** +1537+ FAA0 FD 2A 3B 55 FILE_EXIST: ld IY,(NTR_NBR) ; load max entries +1538+ FAA4 CD 6F FB call SETPTEN ; point to 1st sector of dir +1539+ FAA7 CD 77 FB CHKSTNM1: call PT2FSEN ; point to 1st entry of a dir's sect +1540+ FAAA CD 82 FB CHKSTNM2: call CKCREN ; check current entry +1541+ FAAD 28 28 jr Z,CHKSTNM10 ; if empty or deleted, jump over +1542+ FAAF 22 46 55 ld (TPBF1),HL ; store HL +1543+ FAB2 ED 53 48 55 ld (TPBF2),DE ; store DE +1544+ FAB6 ED 43 4A 55 ld (TPBF3),BC ; store BC +1545+ FABA DD E5 push IX ; copy IX... +1546+ FABC E1 pop HL ; ...into HL +1547+ FABD 11 A0 FD ld DE,DOSBFR ; beginning of name file +1548+ FAC0 06 10 ld B,$10 ; 16 chars to check +1549+ FAC2 1A CHKSTNM3: ld A,(DE) ; load a char from name on disk +1550+ FAC3 ED A1 cpi ; compare with name from user +1551+ FAC5 20 05 jr NZ,CHKSTNM6 ; chars are different, leave +1552+ FAC7 13 inc DE ; inc DE (HL is incremented by "cpi") +1553+ FAC8 10 F8 djnz CHKSTNM3 ; repeat for 16 chars +1554+ FACA 18 17 jr FLEXST ; file exists in dir +1555+ FACC 2A 46 55 CHKSTNM6: ld HL,(TPBF1) ; retrieve HL +1556+ FACF ED 5B 48 55 ld DE,(TPBF2) ; retrieve DE +1557+ FAD3 ED 4B 4A 55 ld BC,(TPBF3) ; retrieve sector counter +1558+ FAD7 CD 8A FB CHKSTNM10: call GTNXTEN ; other entries in this sector? +1559+ FADA 20 CE jr NZ,CHKSTNM2 ; yes, continue check +1560+ FADC CD 96 FB call CKLSTEN ; go to next sector +1561+ FADF 30 C6 jr NC,CHKSTNM1 ; more entries? repeat +1562+ FAE1 AF xor A ; file not found, reset Carry +1563+ FAE2 C9 ret ; return +1564+ FAE3 37 FLEXST: scf ; file is present - set Carry flag for error +1565+ FAE4 C9 ret +1566+ FAE5 +1567+ FAE5 +1568+ FAE5 ; ***************************************************************************** +1569+ FAE5 ; UNDELETE DELETED FILES +1570+ FAE5 ; look for deleted files and undelete them +1571+ FAE5 ; ***************************************************************************** +1572+ FAE5 CD 9F FC DSKUNDFL: call CLRIOBF ; clear I/O +1573+ FAE8 CD 03 FC call CHKDSKVAL ; check DOS version & load disk details +1574+ FAEB DA 30 F6 jp C,DOSVERSERR ; if Carry is set, raise DOS version error +1575+ FAEE CD 32 FB call FNDFRENTR ; find a free entry +1576+ FAF1 D8 DSKUNDFL1: ret C ; return if entries are finished +1577+ FAF2 DD 7E 00 ld A,(IX) ; reload first char of entry +1578+ FAF5 FE 7F cp $7F ; is it a deleted entry? +1579+ FAF7 20 29 jr NZ,DSKUNDFL2 ; no, jump over +1580+ FAF9 CD DA FB call RND8 ; get a random char +1581+ FAFC CD F8 FB call CHATOZ ; transform it into a letter +1582+ FAFF DD 77 00 ld (IX),A ; store it as the first letter of filename +1583+ FB02 CD 77 FD call CF_WR_SEC ; write sector (address is into DEBC) +1584+ FB05 E5 push HL ; store HL +1585+ FB06 C5 push BC ; store BC +1586+ FB07 D5 push DE ; store DE +1587+ FB08 DD E5 push IX ; copy IX... +1588+ FB0A E1 pop HL ; ...into HL +1589+ FB0B 06 10 ld B,$10 ; 16 chars +1590+ FB0D 7E DSKUNDPR: ld A,(HL) ; retrieve char from filename +1591+ FB0E CD 52 1B call OUTC ; print char +1592+ FB11 23 inc HL ; next char +1593+ FB12 10 F9 djnz DSKUNDPR ; repeat +1594+ FB14 3E 20 ld A,SPC ; print a space +1595+ FB16 CD 52 1B call OUTC +1596+ FB19 21 27 FB ld HL,DSKUNDTXT ; print undeleted message +1597+ FB1C CD 29 27 call PRS +1598+ FB1F D1 pop DE ; retrieve DE +1599+ FB20 C1 pop BC ; retrieve BC +1600+ FB21 E1 pop HL ; retrieve HL +1601+ FB22 CD 46 FB DSKUNDFL2: call FNDFRENTR4 ; goto next entry +1602+ FB25 18 CA jr DSKUNDFL1 ; repeat +1603+ FB27 75 6E 64 65 DSKUNDTXT: defb "undeleted",CR,0 +1603+ FB2B 6C 65 74 65 +1603+ FB2F 64 0D 00 +1604+ FB32 +1605+ FB32 +1606+ FB32 ; ***************************************************************************** +1607+ FB32 ; FIND A FREE ENTRY +1608+ FB32 ; find a free entry in the directory to store a new file +1609+ FB32 ; ***************************************************************************** +1610+ FB32 CD B7 FB FNDFRENTR: call LDMSCT ; read Master Sector +1611+ FB35 CD A8 FB call LDENTRIES ; load entries into RAM register NTR_NBR and DE +1612+ FB38 D5 push DE ; copy number of entries... +1613+ FB39 FD E1 pop IY ; ...into IY +1614+ FB3B CD 6F FB call SETPTEN ; point to first entry +1615+ FB3E CD 77 FB FNDFRENTR1: call PT2FSEN ; point to 1st entry of sector +1616+ FB41 CD 82 FB FNDFRENTR2: call CKCREN ; check current entry +1617+ FB44 28 0B jr Z,FNDFRENTR3 ; found a free entry +1618+ FB46 CD 8A FB FNDFRENTR4: call GTNXTEN ; other entries in this sector? +1619+ FB49 20 F6 jr NZ,FNDFRENTR2 ; yes, continue check +1620+ FB4B CD 96 FB call CKLSTEN ; go to next sector +1621+ FB4E 30 EE jr NC,FNDFRENTR1 ; more entries? repeat +1622+ FB50 C9 ret ; entries finished - leave +1623+ FB51 ED 43 39 55 FNDFRENTR3: ld (DIR_SCT),BC ; store sector of dir +1624+ FB55 22 3B 55 ld (NTR_NBR),HL ; store entry number +1625+ FB58 AF xor A ; reset Carry +1626+ FB59 C9 ret +1627+ FB5A +1628+ FB5A +1629+ FB5A ; ***************************************************************************** +1630+ FB5A ; U T I L I T I E S +1631+ FB5A ; ***************************************************************************** +1632+ FB5A +1633+ FB5A +1634+ FB5A ; check if EOF for seq. file +1635+ FB5A ; C is set if EOF, NC otherwise +1636+ FB5A ; destroys DE & HL +1637+ FB5A ; return: DE=size of seq. file; C=1 if EOF, C=0 otherwise +1638+ FB5A ED 5B DD FF CHKEOF: ld DE,(SEQBYSZ) ; size of seq. file +1639+ FB5E 7B ld A,E ; check if file size... +1640+ FB5F B2 or D ; ...is 0 +1641+ FB60 28 06 jr Z,CHKEOFC ; yes, EOF +1642+ FB62 2A DF FF ld HL,(SEQPNT) ; pointer to last byte of seq. file +1643+ FB65 CD 5A 41 call CMP16 ; over the EOF? +1644+ FB68 3F CHKEOFC: ccf ; invert Carry +1645+ FB69 C9 ret +1646+ FB6A +1647+ FB6A +1648+ FB6A ; check if a sequential file is open +1649+ FB6A 3A D6 FF CHKSQFL: ld A,(SEQFL) ; seq. file status +1650+ FB6D B7 or A ; if A<>0 then a file is open +1651+ FB6E C9 ret ; return to caller +1652+ FB6F +1653+ FB6F +1654+ FB6F ; set up registers to point to first sector of directory +1655+ FB6F 01 01 00 SETPTEN: ld BC,$0001 ; BC=$0001 (starting sector of dir) (LSW) +1656+ FB72 50 ld D,B ; DE=$0000 (starting sector of dir) (MSW) +1657+ FB73 58 ld E,B +1658+ FB74 60 ld H,B ; HL=$0000 (entry counter) +1659+ FB75 68 ld L,B +1660+ FB76 C9 ret ; return to caller +1661+ FB77 +1662+ FB77 +1663+ FB77 ; load a sector and point to first entry +1664+ FB77 CD 0E FD PT2FSEN: call CF_SETSTR ; set sector to read (BC-DE) +1665+ FB7A CD 50 FD call CF_RD_SEC ; read sector +1666+ FB7D DD 21 C0 FD ld IX,IOBUFF ; beginning of I/O buffer +1667+ FB81 C9 ret +1668+ FB82 +1669+ FB82 +1670+ FB82 ; check current entry +1671+ FB82 DD 7E 00 CKCREN: ld A,(IX) ; load 1st char of entry name +1672+ FB85 ;dec IY ; decrement number of entries +1673+ FB85 B7 or A ; is it $00 (empty entry)? +1674+ FB86 C8 ret Z ; yes, found an entry +1675+ FB87 FE 7F cp $7F ; is it $7F (deleted entry)? +1676+ FB89 C9 ret +1677+ FB8A +1678+ FB8A +1679+ FB8A ; goto next entry +1680+ FB8A C5 GTNXTEN: push BC ; store BC +1681+ FB8B 01 20 00 ld BC,$0020 ; load BC with directory entry size (32 bytes) +1682+ FB8E DD 09 add IX,BC ; next entry in current sector +1683+ FB90 C1 pop BC ; retrieve sector pointer +1684+ FB91 23 inc HL ; increment entry counter +1685+ FB92 7D ld A,L +1686+ FB93 E6 0F and %00001111 ; just done 16 entries? +1687+ FB95 C9 ret +1688+ FB96 +1689+ FB96 +1690+ FB96 ; check if reached last entry +1691+ FB96 ; Carry is set if entries finished +1692+ FB96 03 CKLSTEN: inc BC ; entries in this sector finished .. goto next sector +1693+ FB97 78 ld A,B ; check if... +1694+ FB98 B1 or C ; ...BC=$000 +1695+ FB99 20 01 jr NZ,CKLSTEN1 ; no, jump over +1696+ FB9B 13 inc DE ; yes, increment DE (MSW) +1697+ FB9C E5 CKLSTEN1: push HL ; preserve current entry +1698+ FB9D D5 push DE +1699+ FB9E FD E5 push IY ; copy max allowed files... +1700+ FBA0 D1 pop DE ; ...into HL +1701+ FBA1 CD 5A 41 call CMP16 ; check if reached max allowed entries +1702+ FBA4 D1 pop DE +1703+ FBA5 E1 pop HL ; (retrieve current entry) +1704+ FBA6 3F ccf +1705+ FBA7 C9 ret ; return +1706+ FBA8 +1707+ FBA8 +1708+ FBA8 ; load entries intro RAM register +1709+ FBA8 21 C0 FD LDENTRIES: ld HL,IOBUFF ; start of I/O buffer +1710+ FBAB 01 19 00 ld BC,$0019 ; point to max. allowed entries +1711+ FBAE 09 add HL,BC ; get address +1712+ FBAF CD 68 FC call HL2DE ; get entries into DE +1713+ FBB2 ED 53 3B 55 ld (NTR_NBR),DE ; store +1714+ FBB6 C9 ret ; return to caller +1715+ FBB7 +1716+ FBB7 +1717+ FBB7 ; load Master Sector (sector #0) +1718+ FBB7 01 00 00 LDMSCT: ld BC,$0000 ; LSW of sector +1719+ FBBA 50 ld D,B ; MSW of sector +1720+ FBBB 58 ld E,B +1721+ FBBC CD 0E FD call CF_SETSTR ; set sector +1722+ FBBF CD 50 FD call CF_RD_SEC ; read sector +1723+ FBC2 C9 ret +1724+ FBC3 +1725+ FBC3 +1726+ FBC3 ; generate random disk ID +1727+ FBC3 C5 RND_ID: push BC +1728+ FBC4 06 02 ld B,$02 ; repeat 2 times +1729+ FBC6 CD DA FB RND_ID1: call RND8 ; get a random value +1730+ FBC9 CD F8 FB call CHATOZ ; transform it into a letter +1731+ FBCC 12 ld (DE),A ; store it +1732+ FBCD 13 inc DE ; inc pointer +1733+ FBCE CD DA FB call RND8 ; get a random value +1734+ FBD1 CD ED FB call CH0TO9 ; transform it into a number from 0 to 9 +1735+ FBD4 12 ld (DE),A ; store it +1736+ FBD5 13 inc DE ; inc pointer +1737+ FBD6 10 EE djnz RND_ID1 ; repeat +1738+ FBD8 C1 pop BC +1739+ FBD9 C9 ret ; return to caller +1740+ FBDA +1741+ FBDA +1742+ FBDA ; generate a pseudo-random number using TMR and R registers +1743+ FBDA C5 RND8: push BC ; store B +1744+ FBDB 3A 7E 55 ld A,(TMRCNT) ; load LSW of sys-timer +1745+ FBDE 47 ld B,A ; copy into B +1746+ FBDF ED 5F ld A,R ; load refresh register +1747+ FBE1 A8 xor B ; A xor B +1748+ FBE2 47 ld B,A ; copy into B +1749+ FBE3 0F rrca ; multiply by 32 +1750+ FBE4 0F rrca +1751+ FBE5 0F rrca +1752+ FBE6 EE 1F xor $1F ; a XOR to mix bits +1753+ FBE8 80 add A,B ; add B +1754+ FBE9 DE FF sbc A,255 ; carry +1755+ FBEB C1 pop BC ; retrieve B +1756+ FBEC C9 ret ; return to caller +1757+ FBED +1758+ FBED +1759+ FBED ; char ported into 0-9 interval +1760+ FBED E6 0F CH0TO9: and %00001111 ; get only low nibble +1761+ FBEF FE 0A cp $0A ; is it < 10? +1762+ FBF1 38 02 jr C,CH0TO9E ; yes, jump over +1763+ FBF3 D6 0A sub $0A ; subract 10 +1764+ FBF5 C6 30 CH0TO9E: add $30 ; get a number from 0 to 9 +1765+ FBF7 C9 ret +1766+ FBF8 +1767+ FBF8 +1768+ FBF8 ; char ported into A-Z interval +1769+ FBF8 E6 1F CHATOZ: and %00011111 ; get only first 5 bits +1770+ FBFA FE 1A cp $1A ; is it < 26? +1771+ FBFC 38 02 jr C,CHATOZE ; yes, jump over +1772+ FBFE D6 1A sub $1A ; no, subtract 26 +1773+ FC00 C6 41 CHATOZE: add $41 ; get a letter from 'A' to 'Z' +1774+ FC02 C9 ret ; return to caller +1775+ FC03 +1776+ FC03 +1777+ FC03 ; first check DOS validity then load disk details +1778+ FC03 CD CC FC CHKDSKVAL: call CF_INIT ; open CF card comm. +1779+ FC06 D8 ret C ; if errors, leave +1780+ FC07 C5 push BC ; store BC +1781+ FC08 D5 push DE ; store DE +1782+ FC09 E5 push HL ; store HL +1783+ FC0A 01 00 00 ld BC,$0000 ; reset LSW of sector +1784+ FC0D 50 ld D,B ; reset MSW of sector +1785+ FC0E 58 ld E,B +1786+ FC0F CD 0E FD call CF_SETSTR ; set sector #0 +1787+ FC12 CD 50 FD call CF_RD_SEC ; read sector +1788+ FC15 21 C0 FD ld HL,IOBUFF ; address of default conf. buffer +1789+ FC18 11 0A 00 ld DE,$000A ; point to disk DOS version +1790+ FC1B 19 add HL,DE +1791+ FC1C 11 72 EE ld DE,DSKHDR+10 ; get starting address of I/O buffer +1792+ FC1F 06 04 ld B,$04 ; 4 chars +1793+ FC21 1A CHKDSKVAL1: ld A,(DE) ; load char from DOS version into memory +1794+ FC22 BE cp (HL) ; compare with disk DOS version +1795+ FC23 20 11 jr NZ,CHKDSKVALE ; no match - so error +1796+ FC25 13 inc DE ; next source +1797+ FC26 23 inc HL ; next comparison +1798+ FC27 10 F8 djnz CHKDSKVAL1 ; repeat +1799+ FC29 21 A0 FD ld HL,DOSBFR ; address of default conf. buffer +1800+ FC2C 11 1D 00 ld DE,$001D ; point to address of data area +1801+ FC2F 19 add HL,DE ; set pointer to beginning of identifies +1802+ FC30 CD 68 FC call HL2DE ; first sector of data area into DE +1803+ FC33 AF xor A ; no error - clear Carry flag +1804+ FC34 18 01 jr CHKDSKVAL2 ; jump over +1805+ FC36 37 CHKDSKVALE: scf ; error - set carry flag +1806+ FC37 E1 CHKDSKVAL2: pop HL +1807+ FC38 D1 pop DE +1808+ FC39 C1 pop BC +1809+ FC3A C9 ret ; return to caller +1810+ FC3B +1811+ FC3B +1812+ FC3B ; check name validity (only allowed chars) and copy it from string pool into a temp buff +1813+ FC3B ; Inputs: DE: pointer to dest. buffer +1814+ FC3B ; operation: copy (HL)->(DE) and pads to get a 16-chars name +1815+ FC3B ; destroys: A, BC, DE, HL +1816+ FC3B ED 4B A2 55 CHKNMVAL: ld BC,(DKLNPT) ; load lenght of name +1817+ FC3F 79 ld A,C ; lenght is max. 16 char, so we only check C +1818+ FC40 FE 11 cp $11 ; is it <=16? +1819+ FC42 38 02 jr C,CHKNMVAL1 ; yes, so jump over +1820+ FC44 0E 10 ld C,$10 ; no, get only 16 chars +1821+ FC46 41 CHKNMVAL1: ld B,C ; copy lenght into B +1822+ FC47 0E 10 ld C,$10 ; char counter +1823+ FC49 2A A0 55 ld HL,(DKNMPT) ; pointer to name +1824+ FC4C 7E CHKNMVAL2: ld A,(HL) ; get a char from string name +1825+ FC4D CD 89 FC call CHK_NAM ; check if valid +1826+ FC50 D8 ret C ; no, name error +1827+ FC51 12 ld (DE),A ; yes, store char +1828+ FC52 13 inc DE ; next I/O location +1829+ FC53 23 inc HL ; next name char +1830+ FC54 0D dec C ; decrement number of chars copied +1831+ FC55 10 F5 djnz CHKNMVAL2 ; repeat until name ends +1832+ FC57 79 ld A,C ; check if there are no empty chars in file +1833+ FC58 B7 or A +1834+ FC59 C8 ret Z ; yes, job finished - return +1835+ FC5A 3E 20 ld A,SPC ; no, padding required +1836+ FC5C 12 CHKNMVAL3: ld (DE),A ; store char +1837+ FC5D 13 inc DE ; next location +1838+ FC5E 0D dec C ; check if padding is over +1839+ FC5F 20 FB jr NZ,CHKNMVAL3 ; no, continue +1840+ FC61 AF xor A ; clear Carry flag +1841+ FC62 C9 ret ; return to caller +1842+ FC63 +1843+ FC63 +1844+ FC63 ; store DE into (HL) and (HL+1) +1845+ FC63 73 DE2HL: ld (HL),E ; LSW of size +1846+ FC64 23 inc HL +1847+ FC65 72 ld (HL),D ; MSW of size +1848+ FC66 23 inc HL +1849+ FC67 C9 ret ; return to caller +1850+ FC68 +1851+ FC68 +1852+ FC68 ; get DE from (HL) and (HL+1) +1853+ FC68 5E HL2DE: ld E,(HL) ; get LSW into E +1854+ FC69 23 inc HL ; next location +1855+ FC6A 56 ld D,(HL) ; get MSW into D +1856+ FC6B 23 inc HL ; next location +1857+ FC6C C9 ret ; return to caller +1858+ FC6D +1859+ FC6D +1860+ FC6D ; convert a 16/32-bit number into an ASCII string and print it +1861+ FC6D ; inputs: HL pointer to 32-bit number +1862+ FC6D CD 68 FC PRN32ASCII: call HL2DE ; load MSW into DE <-- entry for 32-bit +1863+ FC70 4E PRN16ASCII: ld C,(HL) ; load LSW into BC <-- entry for 16-bit (set DE to $0000 before to call) +1864+ FC71 23 inc HL +1865+ FC72 46 ld B,(HL) +1866+ FC73 C5 push BC ; copy BC... +1867+ FC74 DD E1 pop IX ; ...into IX +1868+ FC76 FD 21 46 55 PRN16ASCIX: ld IY,TPBF1 ; number is into DEIX - now, load pointer to destination buffer +1869+ FC7A CD 23 42 call CLCN32 ; convert number in DEIX into ASCII number +1870+ FC7D 21 46 55 ld HL,TPBF1 ; address of ASCII number +1871+ FC80 7E PRNTSIZ: ld A,(HL) ; get a char +1872+ FC81 B7 or A ; is it $00 (end of string)? +1873+ FC82 C8 ret Z ; yes, leave +1874+ FC83 CD 52 1B call OUTC ; no, print char +1875+ FC86 23 inc HL ; next char +1876+ FC87 18 F7 jr PRNTSIZ ; repeat +1877+ FC89 +1878+ FC89 +1879+ FC89 ; check for non-allowed chars in disk/file names - allowed chars: '0'-'9', 'A'-'Z', '-', SPACE +1880+ FC89 ; input: A -> char to check +1881+ FC89 ; return: C is set if ERROR, reset otherwise +1882+ FC89 FE 20 CHK_NAM: cp SPC ; is it a space? +1883+ FC8B C8 ret Z ; return if equal (C is reset) +1884+ FC8C FE 2D cp '-' ; is it a minus? +1885+ FC8E C8 ret Z ; return if equal +1886+ FC8F FE 30 cp '0' ; char < '0' ? +1887+ FC91 D8 ret C ; yes, disk name error +1888+ FC92 FE 3A cp ':' ; is char <= '9' ? +1889+ FC94 38 07 jr C,CHK_C_CF ; yes, leave +1890+ FC96 E6 5F and %01011111 ; for letters, only UPPER CASE +1891+ FC98 FE 41 cp 'A' ; is char >= 'A' ? +1892+ FC9A D8 ret C ; no, error +1893+ FC9B FE 5B cp '[' ; is char <= 'Z' ? (if yes, C=1, then C=0; otherwise, C=0 then C=1) +1894+ FC9D 3F CHK_C_CF: ccf ; Carry complement (invert Carry) +1895+ FC9E C9 ret ; return to caller +1896+ FC9F +1897+ FC9F +1898+ FC9F ; clear I/O buffer +1899+ FC9F F5 CLRIOBF: push AF ; store AF +1900+ FCA0 C5 push BC ; store BC +1901+ FCA1 E5 push HL ; store HL +1902+ FCA2 21 C0 FD ld HL,IOBUFF ; load address of I/O buffer +1903+ FCA5 01 02 00 ld BC,$0002 ; B=256 iterations ($00); C=repeat 2 times +1904+ FCA8 AF CLRBUFF: xor A ; reset A ----- common part ----- +1905+ FCA9 77 RSTIOBF: ld (HL),A ; reset cell +1906+ FCAA 23 inc HL ; next cell +1907+ FCAB 10 FC djnz RSTIOBF ; repeat for 256 times +1908+ FCAD 0D dec C ; decrement C +1909+ FCAE 20 F9 jr NZ,RSTIOBF ; repeat if not zero +1910+ FCB0 E1 pop HL ; retrieve HL +1911+ FCB1 C1 pop BC ; retrieve BC +1912+ FCB2 F1 pop AF ; retrieve AF +1913+ FCB3 C9 ret ; return to caller +1914+ FCB4 +1915+ FCB4 +1916+ FCB4 ; clear DOS buffer +1917+ FCB4 F5 CLRDOSBF: push AF ; store AF +1918+ FCB5 C5 push BC ; store BC +1919+ FCB6 E5 push HL ; store HL +1920+ FCB7 21 A0 FD ld HL,DOSBFR ; load address of DOS buffer +1921+ FCBA 01 01 20 ld BC,$2001 ; B=32 iterations; C=repeat 1 time +1922+ FCBD C3 A8 FC jp CLRBUFF ; continue to common part +1923+ FCC0 +1924+ FCC0 +1925+ FCC0 ; clear seq. file buffer +1926+ FCC0 F5 CLRSEQBF: push AF ; store AF +1927+ FCC1 C5 push BC ; store BC +1928+ FCC2 E5 push HL ; store HL +1929+ FCC3 21 D6 FF ld HL,SEQFL ; load address of DOS buffer +1930+ FCC6 01 01 0B ld BC,$0B01 ; B=11 iterations; C=repeat 1 time +1931+ FCC9 C3 A8 FC jp CLRBUFF ; continue to common part +1932+ FCCC +# file closed: ../include/dos/dos-1.05.asm + 95 FCCC INCLUDE "../include/dos/bios-1.03.asm" +# file opened: ../include/dos/bios-1.03.asm + 1+ FCCC ; ------------------------------------------------------------------------------ + 2+ FCCC ; LM80C 64K - BIOS ROUTINES - R1.03 + 3+ FCCC ; ------------------------------------------------------------------------------ + 4+ FCCC ; The following code is intended to be used with LM80C Z80-based computer + 5+ FCCC ; designed by Leonardo Miliani. Code and computer schematics are released under + 6+ FCCC ; the therms of the GNU GPL License 3.0 and in the form of "as is", without no + 7+ FCCC ; kind of warranty: you can use them at your own risk. + 8+ FCCC ; You are free to use them for any non-commercial use: you are only asked to + 9+ FCCC ; maintain the copyright notices, include this advice and the note to the + 10+ FCCC ; attribution of the original version to Leonardo Miliani, if you intend to + 11+ FCCC ; redistribuite them. + 12+ FCCC ; https://www.leonardomiliani.com + 13+ FCCC ; + 14+ FCCC ; Please support me by visiting the following links: + 15+ FCCC ; Main project page: https://www.leonardomiliani.com + 16+ FCCC ; Schematics and code: https://github.com/leomil72/LM80C + 17+ FCCC ; Videos about the computer: https://www.youtube.com/user/leomil72/videos + 18+ FCCC ; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer + 19+ FCCC ; ------------------------------------------------------------------------------ + 20+ FCCC ; + 21+ FCCC ; ------------------------------------------------------------------------------ + 22+ FCCC ; Code Revision: + 23+ FCCC ; R1.0 - 20210307 - first release + 24+ FCCC ; R1.01 - 20210310 - Code optimizing & better error handling + 25+ FCCC ; R1.02 - 20210316 - disk speed improvements with INIR and OTIR + 26+ FCCC ; R1.03 - 20210319 - code re-organization and new positioning into RAM + 27+ FCCC ; + 28+ FCCC ;------------------------------------------------------------------------------ + 29+ FCCC + 30+ FCCC ; equates for CF at port $50 + 31+ FCCC CF_DATA: equ %01010000 ; ($50) Data register (R/W) + 32+ FCCC CF_ERR: equ %01010001 ; ($51) Error (R) + 33+ FCCC CF_FTR: equ %01010001 ; ($51) Features (W) + 34+ FCCC CF_SECCNT: equ %01010010 ; ($52) Sector count register (R/W) + 35+ FCCC CF_LBA0: equ %01010011 ; ($53) LBA register 0 (bits 0-7) (R/W) + 36+ FCCC CF_LBA1: equ %01010100 ; ($54) LBA register 1 (bits 8-15) (R/W) + 37+ FCCC CF_LBA2: equ %01010101 ; ($55) LBA register 2 (bits 16-23) (R/W) + 38+ FCCC CF_LBA3: equ %01010110 ; ($56) LBA register 3 (bits 24-27) (R/W) - bits 28-31 must be set to 111 in LBA mode + 39+ FCCC CF_STAT: equ %01010111 ; ($57) Status (R) + 40+ FCCC CF_CMD: equ %01010111 ; ($57) Command register (W) + 41+ FCCC + 42+ FCCC + 43+ FCCC ;------------------------------------------------------------------------------ + 44+ FCCC ; R O U T I N E S + 45+ FCCC ;------------------------------------------------------------------------------ + 46+ FCCC + 47+ FCCC BIOSSTART: equ $ + 48+ FCCC ; initilialize CF to work with, wakeing it up from standby and setting it to work in 8-bit mode + 49+ FCCC CD E2 FC CF_INIT: call CF_NOP ; execute a NOP to wake up the CF + 50+ FCCF CD 30 FD call CR_DEV_RDY ; wait for CF available and ready + 51+ FCD2 D8 ret C ; no card or I/O error, leave + 52+ FCD3 3E 01 ld A,$01 ; 8-bit mode + 53+ FCD5 D3 51 out (CF_FTR),A ; set mode + 54+ FCD7 CD EB FC call CF_BUSY ; wait for CF being ready + 55+ FCDA 3E EF ld A,$EF ; command to set mode + 56+ FCDC D3 57 out (CF_CMD),A ; execute command + 57+ FCDE CD EB FC call CF_BUSY ; wait for CF being ready + 58+ FCE1 C9 ret ; return to caller + 59+ FCE2 + 60+ FCE2 + 61+ FCE2 ; a NOP command, just used to wake up the CF card + 62+ FCE2 3E 69 CF_NOP: ld A,$69 ; NOP command + 63+ FCE4 D3 51 out (CF_FTR),A ; send it + 64+ FCE6 3E EF ld A,$EF ; set mode command + 65+ FCE8 D3 57 out (CF_CMD),A ; execute NOP + 66+ FCEA C9 ret ; return to caller + 67+ FCEB + 68+ FCEB + 69+ FCEB ; wait until BUSY bit is 0 (means CF has executed the requested job) + 70+ FCEB DB 57 CF_BUSY: in A,(CF_STAT) ; read status register + 71+ FCED 07 rlca ; copy bit #7 into the Carry + 72+ FCEE DA EB FC jp C,CF_BUSY ; loop while bit #7 is 1 + 73+ FCF1 C9 ret ; bit #7 cleared - return to caller + 74+ FCF2 + 75+ FCF2 + 76+ FCF2 ; check that CF is ready to get commands + 77+ FCF2 DB 57 CF_CMDRDY: in A,(CF_STAT) ; read status register + 78+ FCF4 CB 47 bit 0,A ; any error? + 79+ FCF6 20 07 jr NZ,RETERR ; yes, return error + 80+ FCF8 E6 C0 and %11000000 ; check only bits #6 & #7 + 81+ FCFA EE 40 xor %01000000 ; bit #7 (BUSY) must be 0 and bit #6 (DRVRDY) must be 1 + 82+ FCFC 20 F4 jr NZ,CF_CMDRDY ; wait + 83+ FCFE C9 ret ; return to caller + 84+ FCFF 37 RETERR: scf ; set carry flag + 85+ FD00 C9 ret ; return + 86+ FD01 + 87+ FD01 + 88+ FD01 ; wait until data is ready to be read + 89+ FD01 DB 57 CF_DAT_RDY: in A,(CF_STAT) ; read status register + 90+ FD03 CB 47 bit 0,A ; any error? + 91+ FD05 20 F8 jr NZ,RETERR ; yes, return error + 92+ FD07 E6 88 and %10001000 ; check only bits #7 & #3 + 93+ FD09 EE 08 xor %00001000 ; bit #7 (BUSY) must be 0 and bit #3 (DRQ) must be 1 + 94+ FD0B 20 F4 jr NZ,CF_DAT_RDY ; wait until data is ready + 95+ FD0D C9 ret ; return to caller + 96+ FD0E + 97+ FD0E + 98+ FD0E ; set sector to read from/write to - sector number is into DEBC (C=LSB, D=MSB) + 99+ FD0E CD F2 FC CF_SETSTR: call CF_CMDRDY ; Make sure drive is ready for command + 100+ FD11 3E 01 ld A,$01 ; 1 sector at a time + 101+ FD13 D3 52 out (CF_SECCNT),A ; set number of sectors + 102+ FD15 CD F2 FC call CF_CMDRDY ; Make sure drive is ready for command + 103+ FD18 79 ld A,C ; load LBA0 byte + 104+ FD19 D3 53 out (CF_LBA0),A ; send it + 105+ FD1B CD F2 FC call CF_CMDRDY ; Make sure drive is ready for command + 106+ FD1E 78 ld A,B ; load LBA1 byte + 107+ FD1F D3 54 out (CF_LBA1),A ; send it + 108+ FD21 CD F2 FC call CF_CMDRDY ; Make sure drive is ready for command + 109+ FD24 7B ld A,E ; load LBA2 byte + 110+ FD25 D3 55 out (CF_LBA2),A ; send it + 111+ FD27 CD F2 FC call CF_CMDRDY ; Make sure drive is ready for command + 112+ FD2A 3E E0 ld A,$E0 ; load LBA3 byte+master+LBA addressing + 113+ FD2C B2 or D ; add LBA sector + 114+ FD2D D3 56 out (CF_LBA3),A ; send it + 115+ FD2F C9 ret ; return to caller + 116+ FD30 + 117+ FD30 + 118+ FD30 ; check if device is available & ready - try a bit of times, then exit with + 119+ FD30 ; error if no response, otherwise wait until device is ready + 120+ FD30 ; return Carry = 0 if device is available and ready, Carry = 1 if errors + 121+ FD30 C5 CR_DEV_RDY: push BC ; store HL + 122+ FD31 06 00 ld B,$00 ; 256 tries + 123+ FD33 0E 57 ld C,CF_STAT ; address of status register + 124+ FD35 ED 78 CR_DV_RD_1: in A,(C) ; load status register (curiously, with no CF attached, in(CF_STAT) returns %01111000) + 125+ FD37 FE 40 cp %01000000 ; busy=0, rdy=1 + 126+ FD39 28 07 jr Z,CR_DV_RD_E ; got a response, so leave + 127+ FD3B FE 50 cp %01010000 ; busy=0, rdy=1, dsc=1 + 128+ FD3D 28 03 jr Z,CR_DV_RD_E ; got a response, so leave + 129+ FD3F 10 F4 djnz CR_DV_RD_1 ; repeat until timeout (Carry=1 while HL1=seq. file number + 45+ FFD7 00 SEQFLS: defb $00 ; (1) seq. file mode: 0 read / 1 write + 46+ FFD8 00 00 SEQSCTM: defb $00,$00 ; (2) MSW of sector address + 47+ FFDA 00 00 SEQSCTL: defb $00,$00 ; (2) LSW of sector address + 48+ FFDC 00 SEQSCSZ: defb $00 ; (1) size in sectors + 49+ FFDD 00 00 SEQBYSZ: defb $00,$00 ; (2) size in bytes + 50+ FFDF 00 00 SEQPNT: defb $00,$00 ; (2) pointer to byte + 51+ FFE1 + 52+ FFE1 FF defb $FF + 53+ FFE2 ; DOS jump table + 54+ FFE2 DOSJPTB equ $ ; address of 1st entry + 55+ FFE2 C3 53 F5 JPEOF: jp EOF ; jump to EOF statement + 56+ FFE5 C3 81 F5 JPPUT: jp PUT ; jump to PUT statement + 57+ FFE8 C3 9A F5 JPGET: jp GET ; jump to GET statement + 58+ FFEB C3 A5 EE JPCLOSE: jp CLOSE ; jump to CLOSE statement + 59+ FFEE C3 79 EE JPOPEN: jp OPEN ; jump to OPEN statement + 60+ FFF1 C3 AD F0 JPDISK: jp DISK ; jump to DISK statement + 61+ FFF4 C3 50 F0 JPERAS: jp ERASE ; jump to ERASE statement + 62+ FFF7 C3 B4 EE JPLOAD: jp LOAD ; jump to LOAD statement + 63+ FFFA C3 51 EF JPSAVE: jp SAVE ; jump to SAVE statement + 64+ FFFD C3 1C F0 JPFILS: jp FILES ; jump to FILES statement + 65+ 0000 +# file closed: ../include/dos/buffers-1.01.asm + 97 0000 + 98 0000 ; END OF ASSEMBLY SOURCE + 99 0000 ;------------------------------------------------------------------------------- + 100 0000 +# file closed: LM80C_64K-firmware-r1.18.asm + +Value Label +------ - ----------------------------------------------------------- +0xFDA0 X SRTBFS +0xFD9B BIOSEND +0xFD98 CF_WR_EXIT +0xFD74 CF_RD_EXIT +0xFD42 CR_DV_RD_E +0xFCFF RETERR +0xFCF2 CF_CMDRDY +0xFD30 CR_DEV_RDY +0xFCE2 CF_NOP +0xFCCC X BIOSSTART +0x0057 CF_STAT +0x0055 CF_LBA2 +0x0054 CF_LBA1 +0x0053 CF_LBA0 +0x0052 CF_SECCNT +0x0051 CF_FTR +0x0051 X CF_ERR +0x0050 CF_DATA +0xFCA9 RSTIOBF +0xFCA8 CLRBUFF +0xFC9D CHK_C_CF +0xFC80 PRNTSIZ +0xFC5C CHKNMVAL3 +0xFC89 CHK_NAM +0xFC4C CHKNMVAL2 +0xFC37 CHKDSKVAL2 +0xFC36 CHKDSKVALE +0xFC21 CHKDSKVAL1 +0xFC00 CHATOZE +0xFBF5 CH0TO9E +0xFBED CH0TO9 +0xFBC6 RND_ID1 +0xFB9C CKLSTEN1 +0xFB68 CHKEOFC +0xFB51 FNDFRENTR3 +0xFB41 FNDFRENTR2 +0xFB3E FNDFRENTR1 +0xFB46 FNDFRENTR4 +0xFB27 DSKUNDTXT +0xFB0D DSKUNDPR +0xFBF8 CHATOZ +0xFBDA RND8 +0xFB22 DSKUNDFL2 +0xFAF1 DSKUNDFL1 +0xFAE3 FLEXST +0xFACC CHKSTNM6 +0xFAC2 CHKSTNM3 +0xFAD7 CHKSTNM10 +0xFAAA CHKSTNM2 +0xFAA7 CHKSTNM1 +0xFA93 FIL_ERA2 +0xFA88 FIL_ERA1 +0xFA96 FIL_ERA3 +0xFA60 FIL_ERA6 +0xFA67 FIL_ERA5 +0xFA17 LDFL5 +0xFA1E LDFLEX +0xF9E0 LDFL3 +0xF9C0 LDFL2 +0xF9BC LDFL1 +0xF9A0 LDFL4 +0xFAA0 FILE_EXIST +0xF961 LK4FILE1 +0xFC68 HL2DE +0xF95E LK4FILE +0xF8CD SAVFL2 +0xF8A5 SAVFL9 +0xF852 SAVFL12 +0xF859 SAVFLEXT +0xF80E SAVFL4 +0xF7FC SAVFL10 +0xF7EA SAVFL6 +0xF7D7 SAVFL1 +0xF7CF SAVFL3 +0xFC70 PRN16ASCII +0xFC6D PRN32ASCII +0xFB96 CKLSTEN +0xFB8A GTNXTEN +0xFC76 PRN16ASCIX +0xF6FC LSTFILES22 +0xF6F4 LSTFILES21 +0xF6FF LSTFILESPR +0xF795 FILETP +0xF6EC LSTFILES20 +0xF6D0 LSTFILES3 +0xFB82 CKCREN +0xF6C2 LSTFILES2 +0xFB77 PT2FSEN +0xF6BF LSTFILES1 +0xFB6F SETPTEN +0xFBA8 LDENTRIES +0xF751 PNTSTATS +0xF68B INPR1 +0xF662 TLFLSTX +0xF651 ALFLSTXT +0xF646 TLSCTTX +0xF63A DSKNMTX +0xF62D LODERR +0xF624 DUPLERR +0xF5F8 GET2 +0xF609 GET1 +0xF59A GET +0xF581 PUT +0xF57D RETEOF +0xFB5A CHKEOF +0xF569 EOF1 +0xF553 EOF +0xF551 UPCRNENT1 +0xF522 UPCRNENT +0xF516 SVCRNTSE +0xF511 CLOSFIL1 +0xFFC6 TMPNAM +0xF475 OPNFRD2 +0xF46D OPNFRD3 +0xF4B4 OPNRDDET +0xF4AC OPNFILPT +0xF4E8 SVSQFLNM +0xF85E SVENTRY +0xFB32 FNDFRENTR +0xF466 OPNFRD +0xF49B OPFLRS +0xF941 CHKFLEXT +0xFCC0 CLRSEQBF +0xF61B FILALROP +0xF490 OPNFRD1 +0xF3E3 PUTFIL2 +0xF610 GETER +0xFFDC SEQSCSZ +0xFFD8 SEQSCTM +0xFFDA SEQSCTL +0xF3AE PUTNXSC +0xFFDF SEQPNT +0xF621 DSKFULL +0xFFDD SEQBYSZ +0xF632 RET_ERR +0xF62A FLNTFND +0xF372 PUTFIL +0xFA9B WRT_ERR +0xFBB7 LDMSCT +0xF630 DOSVERSERR +0xFC03 CHKDSKVAL +0xF343 DOS_FT8 +0xF330 DOS_FT9 +0xF33D DOS_FT10 +0xF316 DOS_FTA +0xF341 DOS_FT7 +0xF61E D2ERR +0xFBC3 RND_ID +0xF627 NAMERR +0xFC3B CHKNMVAL +0xF2A6 DOS_FT2 +0xFC63 DE2HL +0xF28C DOS_FT1 +0xF27E DOS_FTC +0xFDA0 DOSBFR +0xFD63 CF_RD_CMD +0xFD01 CF_DAT_RDY +0x0057 CF_CMD +0x0056 CF_LBA3 +0xFCB4 CLRDOSBF +0xF618 FILOPCLER +0xFB6A CHKSQFL +0xF1E8 CNFRQN +0xF349 DSK_RNM +0xF1B7 RNDKTX +0xF16E OPRCMP +0xF136 MSPTOK +0xF211 DSK_INIT +0xF156 FRMTXT +0xF107 CFINIT +0xF13E MSTTXT +0x55A2 DKLNPT +0x55A0 DKNMPT +0xF183 DSKUND +0xF193 DSKRNM +0xF0EF RWMSSC +0xF0F4 DSKFRM +0xF0AD DISK +0x5535 TPHL +0xF0A4 ABRTXT +0xF088 ERASED +0xFA23 FIL_ERASE +0xF096 ABRTDS +0xF1C5 CNFREQ +0xF07A ERSTX +0xF050 ERASE +0xF66C LST_FILES +0xFC9F CLRIOBF +0xF01C FILES +0xEFF6 TXTRNM +0xF007 SVERR +0xFD77 CF_WR_SEC +0xEFD2 SVEND +0xF7A9 SAVFILE +0xF00C TXTSVG +0xEFD9 RENFIL +0xEFAB SAVE1 +0xEFC0 SAVESCT +0xEF51 SAVE +0xFCCC CF_INIT +0xEEF1 LDERR +0xFD50 CF_RD_SEC +0xF72B LSTFILES6 +0xFD0E CF_SETSTR +0xEF19 GET4AR +0xEEEA LDEND +0xF973 LODFILE +0xEEF6 TXTLDG +0xF037 CHK1AR +0xF1F4 CHKFN1 +0xEED5 LOADST +0xEF07 LDSVPT +0xEEB4 LOAD +0xF4F4 CLOSFIL +0xEEA5 CLOSE +0xF030 DOS_ERR +0xF3EA OPNFIL +0xF1EA CHKFLNM +0xEE79 OPEN +0x5550 ENDMEM +0x554E SRTMEM +0x554C TPBF4 +0x5548 TPBF2 +0x5546 TPBF1 +0x5544 RAM_PTR +0x5542 LSW_SCT +0x5540 MSW_SCT +0x553F SCT_SIZ +0x553D BYT_SIZ +0x553B NTR_NBR +0x5539 DIR_SCT +0xFD35 CR_DV_RD_1 +0x5537 DAT_STRT +0x5535 DIR_STRT +0xEE77 DSKDIRADR +0xEE68 DSKHDR +0x55D6 CHCSNDDTN +0x55D4 CHBSNDDTN +0x5535 TMPDBF +0x5534 DOSER +0x5444 NMIFLG +0x5378 CNTCP2RAM +0x539C END_OF_FW +0x5350 RAMRUN +0x8000 TMP_FW_LOC +0x4281 CLCN323 +0x4258 CLCN325 +0x4236 CLCN322 +0x4233 CLCN321 +0x4223 CLCN32 +0x421F CLCN32Z +0x41F7 CLCN32T +0x41F2 DIV_32_16SB +0x41EF DIV_32_16OF +0x41DE DIV_32_16LP +0x41D9 DIV_32_16 +0x41C9 DV16_16_LP +0x41C4 DIV_16_16 +0x41B8 DIV_16_8LP +0x41A9 DIV_8_8LOOP +0x4197 MU32_2 +0x418C MUL_32L +0x417F MUL_U32 +0x417D EXMUL16 +0x4174 MLP1 +0x416D MLP +0xFD44 CF_STANDBY +0x4149 RESETE +0x4103 BINIT +0x4116 CHKBIN +0x40E5 BITOUT2 +0x40E1 BITOUT +0x40D3 ZEROSUP +0x40B5 NOSUB7 +0x40B9 HEXIT +0x4095 HEXLP +0x409A HEXLP1 +0x40C2 HXERR +0x40A2 GETHEX +0x4085 ADD301 +0x4075 ADD30 +0x405F HEX4 +0x405D HEX3 +0x404E HEX1 +0x4050 HEX2 +0x3FFE PRTEND +0x3FF2 PRTK1 +0x3FEF OPNQT1 +0x3FD7 CLSQT1 +0x4033 CHKEY5 +0x3FBF PTCHR1 +0x4030 CHKEY4 +0x3FC7 CLSQT +0x3F8A PRTK3 +0x3FA2 PRTCHR +0x3FD9 OPNQT +0x3F8D CNTLTK +0x3F78 LDKEY +0x4027 CHKEY2 +0x3FF1 PRTCKEY +0x4022 CHKEY1 +0x3F5F PRTK4 +0x3F4B CPKYEND +0x3F43 CPKEY1 +0x3F3B CPKEY3 +0x3F34 CPKEY2 +0x3F24 CPKEY +0x3F16 DECLN1 +0x4000 SETREP +0x3EE6 KEYCH +0x3F4D LSTKEYS +0x3EC6 HLPERR +0x3EA4 DIRMOD +0x3E6B EXNRM +0x3E5D ENCHB +0x3E32 SRLCNT +0x3E1A STRPAR +0x3DFD SETPAR2 +0x3DEE BITS8 +0x3DE3 BITS7 +0x3DF2 SETPAR +0x3DD9 BITS6 +0x3DB6 SET_CTC +0x3E88 CTC_CFG +0x3E93 SCERR1 +0x3DA5 SET_PT +0x3D8C CKBPS +0x3E72 SUP_BPS +0x3D80 SETSER +0x3D73 DEFSER +0x3D28 CNTSER3 +0x3D0B CNTRX2 +0x3D16 CNTSER2 +0x3CD8 SERLED +0x3CD2 SRPT2 +0x3CAF RPTRSSR +0x3CA2 RSTSERS +0x3CDC CNTSER +0x3C9E CHKZSER +0x3C8F SERVAR +0x3E97 SCERR +0x55AC SIOBFR +0x55AB STPBT +0x55AA PARBT +0x55A9 DATABT +0x55A7 BPS +0x55A6 PRTNUM +0x3C49 RPTCVBF +0x3C3A RPCLTMB +0x3C2D CNTVALY +0x3BFD CNTCL7 +0x3BD9 CNTCL6 +0x3BB5 CNTCL5 +0x3B93 CNTCL4 +0x3B6D CNTCL3 +0x3B49 CNTCL2 +0x3C27 VALIDY +0x3B25 CNTCL1 +0x3C22 VALIDX +0x3AF8 PLTCRL +0x3AE9 DLSZ +0x3B01 ENDCRL +0x3ABC RPTCL1 +0x3AA9 RPTCRL +0x3B03 DRWCRL +0x55B0 DC +0x55AE YI +0x55AC XI +0x554A TPBF3 +0x55AA RADIUS +0x55A8 YC +0x55A6 XC +0x3A3C DXGR +0x3A65 ENDDRAW +0x3A0C CNTDRW +0x39F0 RPTDRW +0x39ED STRE2 +0x39E0 ER2 +0x419E negHL +0x39BD Y1GR +0x3993 X1GR +0x419B absHL +0x3C41 CLRVDBF +0x3C32 CLRTMBF +0x55B2 DX +0x55B0 SY +0x55AE SX +0x55AC E2 +0x55AA ER +0x55A8 Y2 +0x55A6 X2 +0x55A0 Y1 +0x559E X1 +0x41A5 DIV_8_8 +0x3900 PXLSET +0x38DC CNTPLT1 +0x38FC NOGD +0x3908 XY2HL +0x3877 PNTEND +0x3881 CTPOINT +0x3830 PAINT5 +0x37FF PAINT3 +0x383E CHECKPY +0x37EC PAINT2 +0x38BB CNTPLOT +0x37BC MNPAINT +0x37B9 PAINT1 +0x37B8 PAINT11 +0x383D CHECKPA +0x37AA PAINT0 +0x3837 EXITPAI +0x379D NXTLOOP +0x383B EXITPA2 +0x3895 PNTRTN +0x3C50 CLRPRM +0x55A8 ORGSP +0x55A6 PNT +0x3731 GPCPCH1 +0x370D GPNTCO1 +0x36F8 RPGPNT +0x36E3 GPNT +0x36CE CNTGPT2 +0x374E CKCOL +0x55AC TMPHL +0x55AA NUMCHR +0x55A8 CHRPNT +0x55A6 TMPADR +0x559E MIXCOL +0x55A0 TMPCLR +0x55A4 GY +0x55A2 GX +0x3C69 GMERR +0x3668 CHKG2M +0x3662 CHKCLR0 +0x362E RPTLDCL +0x3625 LOADCLR +0x3639 SETBRCL +0x3651 MIXCLRS +0x361E CLREX2 +0x3615 CLRG2 +0x360C CLRG1 +0x3603 CLRTXT +0x3606 CLRMC +0x365E CHKCLR1 +0x355E CKMAGN +0x35A9 CHKSCAR +0x356C SCVDP +0x3530 RPTPS +0x34BE ATNTAB +0x34B4 ATN1 +0x346D SINTAB +0x3451 SIN1 +0x3469 QUARTR +0x3465 HALFPI +0x33FE RND2 +0x33E2 RND1 +0x340F RNDTAB +0x5437 LSTRND +0x3407 RESEED +0x5414 SEED +0x338E SUMLP +0x3385 SMSER1 +0x3355 EXPTAB +0x32FD POWER2 +0x32E0 POWER1 +0x32C2 NEGAFT +0x328D EXPTEN +0xFDC0 IOBUFF +0x328B OUTEXP +0x329A NOENED +0x326F SUPTLZ +0x327B DOEBIT +0x324A TRYAGN +0x323B DIGTXT +0x32B0 POWERS +0x322A MAKNUM +0x3205 GTSIXD +0x320E INRNG +0x31F0 SIXDIG +0x329D RNGTST +0x3297 JSTZER +0x31E1 SPCFST +0x55F7 PBUFF +0x318B MULTEN +0x3180 ENDCON +0x318A SCALPL +0x3174 SCALMI +0x31B4 EDIGIT +0x315F EXPLP +0x3171 CONEXP +0x316D DPOINT +0x3192 ADDIG +0x3149 MANLP +0x3141 CNVNUM +0x3122 MLDBLP +0x30FA DCBCDE +0x30C3 CMPFP +0x308B DETHLB +0x3084 INCHL +0x3037 RETREL +0x3017 MLSP10 +0x300A OVTST1 +0x300F OVTST2 +0x3010 OVTST3 +0x2FBC RESDIV +0x5406 DIVSUP +0x2FA9 DIVLP +0x5412 DIV4 +0x5407 DIV1 +0x540B DIV2 +0x540F DIV3 +0x2F76 DIV10 +0x2F0E NOMADD +0x2EFD MUL8LP +0x2F20 BYTSFT +0x2EF4 MULT8 +0x5604 MULVAL +0x2FEC ADDEXP +0x2ED2 FPMULT +0x2EC9 MULLN2 +0x31A9 RSCALE +0x3376 SUMSER +0x2F84 DVBCDE +0x2E84 LOGTAB +0x2E80 UNITY +0x2E6E SHRLP +0x2E6B SHRITE +0x2E5E SCALLP +0x55F6 SGNRES +0x2E2F FPROND +0x2E1E RONDB +0x2E02 NORMAL +0x2DFE SAVEXP +0x2E0A PNORM +0x2DE5 CONPOS +0x2E72 SHRT1 +0x2E1D RONDUP +0x2E3C PLUCDE +0x2DD7 MINCDE +0x2E5C SCALE +0x3094 SIGNS +0x2DB1 NOSWAP +0x2D94 SUBCDE +0x2D8E SUBPHL +0x2D97 FPADD +0x32AC HALF +0x2D85 ROUND +0x2D67 CHKINK +0x2D63 SRTINK +0x2D79 ENDINK +0x2D4F INKEY2 +0x2D40 CMP_A +0x2CEE NOS3 +0x2CD5 NOS2 +0x2CC2 NOS1 +0x2C92 SNDOVR +0x2CE5 WRTSND +0x2C5D SND1 +0x2BEF RPVOLCG +0x2BFB VOLCH +0x2B54 PKEPRMS +0x2B3E SYSRET +0x2B30 NOSYSPR +0x2AF2 NMIINT +0x2AFE NMIVR1 +0x2AE8 NMIEINT +0x2AE4 NMI2 +0x2AEF NMIDINT +0x2AC2 DISNMI +0x2AD3 NM1 +0x5404 OTPORT +0x2A8B WAITLP +0x2A8A NOXOR +0x5403 OUTSUB +0x2A94 SETIO +0x543B INPSUB +0x543C INPORT +0x2A53 VAL2 +0x2A56 VAL3 +0xFAE5 DSKUNDFL +0x2A49 VAL1 +0x2DFD RESZER +0x2A14 RSTSTR +0x2A5F MIDNUM +0x29E0 LVINSTR +0x29EA CNTZIN +0x298A RP2INST +0x29B3 CNT1INS +0x2963 RPTINST +0x29D5 RZINSTR +0x55B4 DY +0x2952 EMPTINS +0x55AE TF +0x55AC TP +0x55AA PT2 +0x55A6 PT +0x55A4 ADRS2 +0x55A2 LNS2 +0x55A0 ADRS1 +0x559E LNS1 +0x28D9 ALLFOL +0x28D1 MID1 +0x4124 BINERR +0x28CF RIGHT1 +0x2A5A LFRGNM +0x2AAA MAKINT +0x28AE X GTFLNM +0x289F GETLEN +0x2888 POPHL +0x2869 GETSTR +0x2860 TSALP +0x2856 SSTSA +0x286F GSTRHL +0x27C3 GRBARY +0x27FA SCNEND +0x27A3 GNXARY +0x27D4 STRADD +0x27A4 ARRLP +0x278E SMPVAR +0x27D1 STPOOL +0x277D GRBLP +0x276F GARBLP +0x2760 TESTOS +0x2744 GRBDON +0x2733 PRSLP +0x2728 PRNUMS +0x2709 TSTOPL +0x26FD CRTSTE +0x26EE QTSTLP +0x26D8 MKTMST +0x26DB CRTMST +0x2742 TESTR +0x28C7 TOPOOL +0x26B9 STR1 +0x26E1 SVSTAD +0x26A2 CHEKFN +0x261A PASSA +0x3045 RETINT +0x276C GARBGE +0x2605 FRENUM +0x25E4 ENDTMR +0x25B0 FNDELP +0x25CF ENDDIM +0x258E ZERARY +0x311A MLDEBC +0x2570 DEFSIZ +0x2568 CRARLP +0x2548 BSERR +0x25AB FINDEL +0x252F NXTARY +0x254D CREARY +0x251B FNDARY +0x24F3 SCPTLP +0x24D1 ZEROLP +0x24E2 RETNUL +0x24DF RETADR +0x24A0 FNTHR +0x24AB CFEVAL +0x2492 FNDVAR +0x2F1E POPHRT +0x55EE FNARG +0x24ED SBSCPT +0x2478 NSCFOR +0x2515 ARLDSV +0x2468 NOTSTR +0x244D ENDNAM +0x2459 CHARTY +0x244C SVNAM2 +0x2435 GTFNAM +0x552F LCRFLG +0x2422 DIMRET +0x3040 FLGREL +0x3039 FLGDIF +0x23E9 CMPSTR +0x2870 GSTRDE +0x286C GSTRCU +0x2401 CMPRES +0x23BF CMPLG1 +0x23BD CMPLOG +0x23A6 PXOR1 +0x2399 X PAND1 +0x239E POR1 +0x260A ACPASS +0x306F FPBCDE +0x237E CNTLGC +0x2364 SGNEXP +0x235B GOFUNC +0x2353 FNVAL +0x2314 FRMEVL +0x230C RETNUM +0x3057 INVSGN +0x22F8 EVLPAR +0x2322 FNOFST +0x264C DOFN +0x240B EVNOT +0x2300 MINUS +0x40F9 BINTFP +0x4089 HEXTFP +0x22D5 NOTAMP +0x2311 CONVAR +0x305F STAKFP +0x2293 STKTHS +0x281F CONCAT +0x23AB TSTRED +0x556D CUROPR +0x226B FOPRND +0x224F RLTLP +0x2242 EVAL3 +0x5578 NXTOPR +0x223F EVAL2 +0x22AA OPRND +0x2236 EVAL1 +0x222F OPNPAR +0x2225 TSTSTR +0x2211 KILFOR +0x307D LOADFP +0x2D88 ADDPHL +0x306C PHLTFP +0x21D9 NEXT1 +0x21CB FANDT +0x21A2 EXTIG +0x2187 MORDT +0x3135 ASCTFP +0x217B LTSTND +0x26EB DTSTR +0x2161 ITMSEP +0x2164 STRENT +0x2170 INPBIN +0x21B2 FDTLP +0x2146 ANTVLU +0x211A NEDMOR +0x211E GTVLUS +0x2112 NXTITM +0x20ED NOPMPT +0x2694 IDTEST +0x5575 READFG +0x20C2 BADINP +0x20B0 REDO +0x20A1 SPCLP +0x209A DOSPC +0x2AA4 FNDNUM +0x207A ZONELP +0x2067 CNTEND +0x272C PRS1 +0x26E7 CRTST +0x31D3 NUMASC +0x2044 PRNTST +0x20A9 NEXITM +0x206C DOCOM +0x2085 DOTAB +0x1FFD PRNTLP +0x1FF6 MRPRNT +0x1FDF IF0 +0x1FE8 IF1 +0x1FD6 IFGO +0x1FBA ONGOLP +0x1FB9 ONGO +0x2AA7 GETINT +0x3086 FPTHL +0x3089 DETHL4 +0x26C3 SAVSTR +0x288A BAKTMP +0x5567 TMPSTR +0x1F9A MVSTPT +0x1F92 CRESTR +0x55F2 FPREG +0x1F6B LETSTR +0x1FA3 LETNUM +0x2226 CHKTYP +0x2233 EVAL +0x5530 TYPE +0x2430 GETVAR +0x1F42 NXTSTT +0x1F3F NXTSTL +0x1F38 NXTDTA +0x1F33 RETLIN +0x1EF5 RUNLIN +0x1EAE STORED +0x1E64 GTLNLP +0x1E61 GETLN +0x30A9 CMPNUM +0x30D6 FPINT +0x55F5 FPEXP +0x1E40 DEPINT +0x1E3D X POSINT +0x2C98 NOISUP +0x1E3A FPSINT +0x1E32 CHKLTR +0x5442 CHKSUM +0x1E25 X ACCSUM +0x1E06 ERRINT +0x557A ERRLIN +0x1DF5 NOLIN +0x1DDF INPBRK +0x5445 BRKFLG +0x1DC9 STALL +0x1DD3 BRK +0x55EA NXTDAT +0x1DB6 UPDATA +0x1DB5 RESTNL +0x1D78 ONJMP +0x1D77 IFJMP +0x1DE2 ENDPRG +0x1D50 RUNCNT +0x1D4C PUTFID +0x302E TSTSGN +0x1D43 SAVSTP +0x307A BCDEFP +0x2221 GETNUM +0x2224 TSTNUM +0x1D07 FORFND +0x1CEB FORSLP +0x556F LOOPST +0x1CD0 CNTWTSP +0x1CC4 WTSPC +0x1CBC LVSRLN +0x1CB1 SRCLN1 +0x1C8E OUTWRD +0x1C9C NXTLN +0x1C75 LSTLP3 +0x1C72 LSTLP2 +0x1C66 LST07 +0x1C63 LST08 +0x1CBE TSTSPC +0x1DBB TSTBRK +0x381E PAINT4 +0x1C38 LST02 +0x1BF8 LST06 +0x1C21 LST03 +0x1BFC LSTNOT +0x1BDD LST01H +0x1C41 LISTLP +0x1CB0 SRCLN +0x1CAA SRCHLIN +0x1BDA LST01 +0x1C09 LSTALL +0x34E3 GETINP +0x4129 MONOUT +0x1B85 SND2VID +0x1B72 INCLEN +0x552E CURPOS +0x543E LWIDTH +0x1B76 DINPOS +0x275E POPAF +0x1B47 CHKSYN +0x1B38 OUTIT +0x1B3B OUTNBS +0x4154 OUTNCR +0x1B24 PUTBUF +0x2053 ENDINP +0x1B1E GMNCR +0x1B29 PUTCTL +0xFFD7 SEQFLS +0x1AE9 PROCES +0x1B93 CLOTST +0x1AC3 KILIN +0x1AB8 DELCHR +0x1AD2 MORINP +0x1AC0 OTKLN +0x1AAC ECHDEL +0x5440 NULFLG +0x1A98 DODEL +0x1A7F NXTCHR +0x1A79 TSTREM +0x1A76 SETLIT +0x1A58 NOCHNG +0x1A4F NOSPC +0x1A60 MATCH +0x1A3E NXTBYT +0x1A2E GETNXT +0x1A2C SEARCH +0x1A64 RETNAD +0x1A13 FNDWRD +0x1A8F ENDBUF +0x1A88 CPYLIT +0x1A68 MOVDIR +0x19E9 CRNCLP +0x5531 DATFLG +0x5446 RINPUT +0x19C4 DOAGN +0x55EC FNRGNM +0x5573 FORFLG +0x557C CONTAD +0x5559 TMSTPT +0x555B TMSTPL +0x55E6 VAREND +0x556B STRBOT +0x5576 BRKLIN +0x1995 INTVAR +0x1968 SRCHLP +0x54D1 BASTXT +0x1959 FNDEND +0x194D PTRLP +0x1940 MOVBUF +0x1948 SETPTR +0x1912 SFTPRG +0x55E4 PROGND +0x1921 INEWLN +0x1F0F ULERR +0x190A LINFND +0x1965 SRCHLN +0x5574 LSTBIN +0x1D70 EXCUTE +0x19E0 CRUNCH +0x1AC9 GETLIN +0x18B6 GETCMD +0x18A8 POPNOK +0x31C0 LINEIN +0x544D HLPLN +0x18A4 PTLN +0x1887 ERRIN +0x1B52 OUTC +0x204B STTLIN +0x5441 CTLOFG +0x1861 NRERR +0x185E IMERR +0x185B TMERR +0x1858 OVERR +0x1855 UFERR +0x1852 DDERR +0x184F NFERR +0x184C DZERR +0x5571 DATLIN +0x1843 DATSNR +0x1841 LDG1ND +0x1830 LDG1 +0x1823 EXITGM +0x1863 ERROR +0x181E OMERR +0x55E8 ARREND +0x1806 CHKSTK +0x17FB MOVLP +0x17F8 MOVSTR +0x180F ENFMEM +0x17F5 MOVUP +0x17EC INDFND +0x17D6 LOKFOR +0x17D2 BAKSTK +0x17CC BRKMSG +0x17C7 OKMSG +0x17C6 ZERBYT +0x17C2 INMSG +0x17BB ERRMSG +0x1739 X DEFFNKS +0x1737 AUTORP +0x1AC9 TTYLIN +0x1E5B FCERR +0x2377 POR +0x237C PXOR +0x2374 PAND +0x2DE8 BNORM +0x32D0 POWER +0x2F25 DINT +0x2F2D MOD +0x2F82 DIV +0x2ED0 MULT +0x2D92 PSUB +0x31AF PADD +0x16C4 PRITAB +0x00EF ZLEFT +0x00E5 ZINSTR +0x00E4 ZPOINT +0x00CE ZSGN +0x00CD ZLTH +0x00CC ZEQUAL +0x00CB ZGTR +0x00CA ZOR +0x00C6 X ZDINT +0x00C5 X ZMOD +0x00C4 X ZDIV +0x00C3 X ZTIMES +0x00C2 ZMINUS +0x00C1 ZPLUS +0x00C0 ZSTEP +0x00BF ZNOT +0x00BE ZTHEN +0x00BD ZSPC +0x00BC ZFN +0x00BB ZTO +0x00BA ZTAB +0x00B9 ZNEW +0x00B3 ZPRINT +0x00B2 ZELSE +0x008E ZREM +0x008C ZGOSUB +0x0088 ZGOTO +0x0083 ZDATA +0x0081 ZFOR +0x0080 ZEND +0x1985 NEW +0xFFFA JPSAVE +0xFFF7 JPLOAD +0x1E85 CLEAR +0x1BAE LIST +0x1E0C CONT +0x1FFA PRINT +0x412C RESET +0x2B12 SYS +0x34F9 WIDTH +0x3671 GPRINT +0x2AB8 NMI +0x3ECB KEY +0x34E5 CLS +0x3EAD HELP +0x3C6E SERIAL +0x3761 PAINT +0x3A67 CIRCLE +0xF8DF CHNGNAM +0x3932 DRAW +0x38A0 PLOT +0x35B9 COLOR +0x3523 PAUSE +0x2BCD VOLUME +0x2C06 SOUND +0x2B7A LOCATE +0x2CFA VREG +0x2BAC SREG +0x2B6F VPOKE +0x350C DOKE +0x2B6A POKE +0x261F DEF +0x2A76 WAIT +0xFFE5 JPPUT +0xFFEB JPCLOSE +0xFFEE JPOPEN +0xFFF1 JPDISK +0xFFF4 JPERAS +0xFFFD JPFILS +0x1FAA ON +0x2A70 POUT +0x1DD8 STOP +0x1F3B REM +0x1F14 RETURN +0x1EE5 GOSUB +0x1DA0 RESTOR +0x1FC8 IF +0x1ED1 RUN +0x1EF6 GOTO +0x1F50 LET +0x210D READ +0x242B DIM +0x20D3 INPUT +0x1F39 DATA +0x21D6 NEXT +0x1CD7 FOR +0x1DDA PEND +0x1650 WORDTB +0x14AD WORDS +0x29FB MID +0x29F1 RIGHT +0x28CB LEFT +0x40C7 BIN +0x4036 HEX +0x28BB CHR +0x28AA ASC +0x2A2B VAL +0x26B3 STR +0x3D12 RXEND +0x289B LEN +0xFFE2 JPEOF +0x1C35 LST05 +0xFFE8 JPGET +0x28FB INSTR +0x384D POINT +0x2D35 INKEY +0x2D21 SSTAT +0x2D16 VSTAT +0x2B47 VPEEK +0x3501 DEEK +0x2B40 PEEK +0x3497 ATN +0x3482 TAN +0x3540 SCREEN +0x3421 SIN +0x341B COS +0x3315 EXP +0x2E91 LOG +0x33A6 RND +0x32C7 SQR +0x2617 POS +0x2A64 INP +0x25E9 FRE +0x55A8 PT1 +0x5400 USR +0x3053 ABS_ +0x3101 INT +0x25D3 TMR +0x303D SGN +0x1465 FNCTAB +0x3ED8 RESFN +0x13D9 BRKRET +0x54D9 STACK +0x13EE BFREE +0x31C8 PRNTHL +0x13E5 BLNSPC +0x143D DOSMSG +0x13C6 SETTP1 +0x13FC SIGNON +0x1986 CLRPTR +0x5449 STRSPC +0x5532 LSTRAM +0x1396 X SETTRAM +0xEE68 DOSSTART +0x1395 SETNOD +0x137F CPDSTB +0xFFE2 DOSJPTB +0x1392 SETDSR +0x1B41 CPDEHL +0x1849 SNERR +0x1E60 ATOH +0x1363 SETTOP +0x133F MLOOP +0x566B STLOOK +0x1351 TSTMEM +0x1D90 GETCHR +0x19C8 PROMPT +0x2729 PRS +0x145A MEMMSG +0x1329 MSIZE +0x133C MNOASK +0x2C14 CTSNDC +0x5607 PROGST +0xFC46 CHKNMVAL1 +0x54D4 BUFFER +0x205D PRNTCRLF +0x19AB CLREG +0x1C84 FNDTOK +0x17BB INITBE +0x16E2 INITAB +0x130E SYSINIT +0x53FA WRKSPC +0x260B ABPASS +0x2040 PRNTNB +0x1E46 DEINT +0x1307 CSTART +0x13D6 WARMST +0x1300 STARTB +0x1093 X ERRORS +0x12EE DAMSG +0x1091 X DAPTR +0x285F TOSTRA +0x12DC D9MSG +0x108F X D9PTR +0x12CD D8MSG +0x108D X D8PTR +0x12C1 D7MSG +0x108B X D7PRT +0x12AD D6MSG +0x1089 X D6PTR +0x12A3 D5MSG +0x1087 X D5PTR +0x129E D4MSG +0x1085 X D4PTR +0x1299 D3MSG +0x3130 NOMLAD +0x1083 X D3PRT +0x128B D2MSG +0x1081 X D2PRT +0x127F D1MSG +0x107F X D1PRT +0x126F D0MSG +0x107D X D0PTR +0x125E NRMSG +0x107B X NRPRT +0x1248 IMMSG +0x1079 X IMPRT +0x123E HPMSG +0x1077 X HPPTR +0x1228 SOMSG +0x120F SAMSG +0x1073 X SAPTR +0x11FA SCMSG +0x1071 X SCPTR +0x106F X GMPRT +0x11DE BNMSG +0x106D X BNPTR +0x11D3 HEMSG +0x106B X HEPTR +0x11C3 MOMSG +0x1069 X MOPTR +0x406C BYT2ASC +0x11AD UFMSG +0x1067 X UFPTR +0x119E CNMSG +0x1065 X CNPTR +0x1183 STMSG +0x1063 X STPTR +0x1075 X SOPTR +0x1173 LSMSG +0x1061 X LSPTR +0x115F OSMSG +0x418A MU32_1 +0x105F X OSPTR +0x1150 TMMSG +0x105D X TMPTR +0x113C IDMSG +0x105B X IDPTR +0x112B DZMSG +0x1059 X DZPTR +0x1116 DDMSG +0x1057 X DDPTR +0x1108 BSMSG +0x1055 X BSPTR +0x10F9 ULMSG +0x402A CHKEY3 +0x1053 X ULPTR +0x10EB OMMSG +0x1051 X OMPTR +0x10E2 OVMSG +0x104F X OVPTR +0x10CC FCMSG +0x104D X FCPTR +0x10C0 ODMSG +0x104B X ODPTR +0x10AB RGMSG +0x1049 X RGPTR +0x10A4 SNMSG +0x1047 X SNPTR +0x1093 NFMSG +0x1045 X NFPTR +0x1045 ERRTBL +0x004C DA +0x004A D9 +0x0048 D8 +0x0046 D7 +0x0044 D6 +0x0042 D5 +0x0040 D4 +0x003E D3 +0x003C D2 +0x003A D1 +0x0038 D0 +0x0036 NR +0x0034 IM +0x0032 HP +0x0030 SO +0x002E SA +0x002C SC +0x002A GM +0x0028 BN +0x0026 HE +0x0024 MO +0x0022 UF +0x0020 CN +0x001E ST +0x209F ASPCS +0x001C LS +0x001A OS +0x0018 TM +0x0016 ID +0x0014 DZ +0x0012 DD +0x0010 BS +0x000E UL +0x000C OM +0x000A OV +0x0008 FC +0x0006 OD +0x0004 RG +0x0002 SN +0x0000 NF +0x007F DEL +0x001B ESC +0x0015 CTRLU +0x0013 CTRLS +0x0012 CTRLR +0x0011 CTRLQ +0x000F CTRLO +0x0007 CTRLG +0x0F1D CNTFNK +0x0F30 PRNTFNK +0x0F23 PUTCHRBUF1 +0x0F09 LDFNKEYCHR +0x5451 FNKEYS +0x544B LINEAT +0x0EE9 PNT2VD +0x0EDC PUTCHRBUF +0x0ECA SNDKEYTOBFR +0x0EF1 PRNTFNKEY +0x0EC2 CHKFNK +0x0F3D FNKEYSORD +0x0EBC CNTKBCK +0x0003 CTRLC +0x5450 AUTOKE +0x2DEB BNRMLP +0x0EA9 SENDKEY +0x0E7A SETNEWAUTO +0x0EEC LVKBRDCHK2 +0x544F KEYDEL +0x0E8A CHKAUTO +0x55DD KEYTMR +0x0E9C NEWKEY +0x0FC5 KBMAP_ALT +0x1005 KBMAP_CTRL +0x0E41 CHKALT +0x0E48 LOADMAP +0x0F85 KBMAP_SFT +0x0E38 CHKCTRL +0x0F45 KBMAP +0x0E24 CHKLN +0x55DC STATUSKEY +0x55DB LASTKEYPRSD +0x0E0C ENDCTRLCK +0x0E06 TESTCTRL +0x0E22 FINDKEY +0x0DF9 TESTALT +0x55D9 KBTMP +0x0E10 NOKEYPRSD +0x0DCA RPTKBDRD +0x0DC6 CHECKKBD +0x0DB8 CHECKCTRL +0x55DF CONTROLKEYS +0x0DAA CHECKALT +0x18A9 PRNTOK +0x1991 RUNFST +0x412E RESET2 +0x0D73 NOMRPRSS +0x0D9C CHKSPCKS +0x0D38 CNTCHKSND +0x0CFD CHKSNDCH +0x0CCB RPTWLCMBP +0x0CE1 NOBPDAT +0x0CC8 SENDSND +0x0CD9 WLCBPDAT +0x0CEE WRTSNDREG +0x0CE9 SETSNDREG +0x0CAF SNDREGCFG +0x0C9B CLRPSGREGS +0x0C97 EMPTSNDBFR +0x0B49 X VDPMODESETEX2 +0x0B41 X VDPMODESETMC +0x0B39 X VDPMODESET2 +0x26E8 QTSTR +0x0B31 X VDPMODESET1 +0x0B1F SENDCHRPTRNS +0x4A90 CHRST88 +0x0B1D NXTCHAR +0x4290 CHRST68 +0x0AFF LDREGVLS +0x0B29 VDPMODESET +0x0AE8 RSTVDPRAMREG +0x55D2 CHASNDDTN +0x0AD9 EMPTVRM +0x0A61 RPTNLLSRC2 +0x4165 MUL16 +0x0A3C ADDNEWLINE +0x0A09 SNDCHRTOBFR +0x09F0 CNTNULL +0x09E0 RPTNLLSRC +0x0A28 PRNTRETURN +0x55A4 TMPBFR4 +0x55A2 TMPBFR3 +0x55A0 SRTTXT +0x55A0 TMPBFR2 +0x09B6 RPTEMPTYROW +0x099B WRITEBUF +0xFFD6 SEQFL +0x0973 LOADNEXTCOL +0x55A6 VIDEOBUFF +0x0961 SCROLLNXTRW +0x55D0 VIDTMP2 +0x55CE VIDTMP1 +0x0940 EXITCURSOR_ON +0x092A EXITCURSORDOWN +0x090A EXITCURSORRGHT +0x0904 CONTCRSRGT +0x08F1 CHCKYPOS2 +0x08D6 EXITCURSORUP +0x08AD CHKYPOS +0x089A EXITCURSORLEFT +0x0897 CONTCRSLFT +0x0886 CHCKYPOS +0x089C MVCRS2LFT +0x0857 MVBKSP +0x086A LVBKSP +0x0020 SPC +0x081D NXTINST +0x415A CMP16 +0x080C CHKHL +0x55A2 ENDTXT +0x0A49 ENDOFLN +0x559E CUR_POS +0x07EA PUTCRSCHR +0x0949 SCROLLUP +0x07AA SETCRSRY +0xFCEB CF_BUSY +0x07AB SETCSRCOORDS +0x07BD EXITCHAR2VID +0x0781 NXTCPCK +0x0774 RPTCPCK +0x07CA PLACEHOLDER +0x000A LF +0x07EE INSERTKEY +0x001A INSRT +0x090D CURSORDOWN +0x001F CRSDN +0x08D8 CURSORRIGHT +0x001D CRSRGT +0x08BF CURSORUP +0x001E CRSUP +0x0873 CURSORLEFT +0x001C CRSLFT +0x0830 BACKSPACE +0x35D6 CNTCKCL +0x0008 BKSP +0x09C2 CRGRETURN +0x000C CS +0x0019 HOME +0x0743 CHRTBL +0x41B5 DIV_16_8 +0x0732 HL2XY +0x0A6F POS_TB_CRS_32 +0x0724 CONT_POS_CURS +0x0A9F POS_TB_CRS_40 +0x5599 LSTCSRSTA +0x5598 CRSR_STATE +0x06DC MOVSHOWCRS +0x06F1 NEWCRSRCOORD +0x0706 RSTCHRCRS +0x070F LOAD_CRSR_POS +0x06C5 READ_VSTAT +0x06BA WRITE_VREG +0x06A5 WRITE_VIDEO_LOC +0x0690 READ_VIDEO_LOC +0x06D6 MOVCRS +0x5595 SCR_CUR_NX +0x0000 NLLCR +0x5596 SCR_CUR_NY +0x0686 ATHOME +0x06CC POS_CURSOR +0x0679 CLEARVIDBUF +0x0666 RPTFLL1 +0x0654 SNDCLRSET +0x0651 STARTEMPTY +0x061B CLRG2PTNTBL +0x0601 RPTEMPTYBUF +0x05FB LDCOLSTOEMPTY +0x063A EMPTYMC +0x060A EMPTYG2 +0x05D9 LVCKSPLK +0x05DB DOCOLDRESET +0x0D43 READKBLN +0x05B4 SNDLOGPT +0x2E48 COMPL +0x5290 LOGOFONT +0x0CC5 NOBEEP +0x0CBF WLCMBEEP +0x0580 RPT100 +0x05C3 CHKSPCK +0x0596 BEEPOFF +0x058A SETBEEP +0x55E3 DOS_EN +0x0554 DEC_D +0x559E TMPBFR1 +0x053A RPT104 +0x059E LOADLOGOCHRS +0x0532 RPT103 +0x0B51 LM80CLOGO +0x051D RPT102 +0x0CA2 RSTPSG +0x051A RPT101 +0x05BE CLRTABLE +0x0573 ERASECLRTBL +0x065E SETNAMETABLE +0x0AF5 SET_GFX_MODE2 +0x5597 SCR_ORG_CHR +0x05E2 EMPTYVIDBUF +0x0457 LDCLRTBMD1 +0x559C FRGNDCLR +0x0670 SETVDPADRS +0x04E7 ENDVDPSET +0x5591 SCR_NAM_TB +0x543F COMMAN +0x558F SCR_SIZE_H +0x558E SCR_SIZE_W +0x559D BKGNDCLR +0x5594 SCR_CURS_Y +0x04DE LDCLRTBEX2 +0x5593 SCR_CURS_X +0x0B09 LOADCHARSET +0x03F6 X TXTMD +0x04A5 EXG2MD +0x0482 MCMD +0x0460 G2MD +0x0420 G1MD +0x5590 SCR_MODE +0x0AE2 CLR_RAM_REG +0x0AED SET_GFX_MODE +0x0ACF EMPTY_VRAM +0x0365 RESTMR +0x036A CTCCONF +0x033C X SIO_B_SETS +0x0336 SIO_A_SETS +0x12FD WARM +0x12FA COLD +0x0942 CURSOR_OFF +0x031C ECHO_CHAR +0x030F CHECKWARM +0x02F8 CORW +0x092D CURSOR_ON +0x03B4 MSGTXT2 +0x0304 COLDSTART +0x53F9 basicStarted +0x0376 MSGTXT1 +0x414D INITST +0x03D1 initVDP +0x04F2 SHOW_LOGO +0x0C91 initPSG +0x0340 initCTC +0x02B1 X INIT_HW2 +0x552B TEMPSTACK +0x02AE INIT_HW +0x0D58 KEYBOARD +0x0CF3 MNGSNDS +0x07CB FLASHCURSOR +0x029A CHKCRSR +0x0294 INCTMR3 +0x557E TMRCNT +0x028B CH3_TIMER +0x027D RAWPRINT +0x026C TX_EMP +0x0269 TXA_EXIT +0x0255 RXA_EXIT +0x023F NOTRDWRAP +0x53F6 serRdPtr +0x539C SERBUF_START +0x0214 NOTWRAP +0x00F4 bufWrap +0x53F4 serInPtr +0x0208 NOTFULL +0x53F8 serBufUsed +0x01EB SIO_B_EI +0x01F1 SIO_RXEN +0x01E3 SIO_A_EI +0x01D9 SIO_RXDI +0x01B5 X B_RTS_ON +0x01BB SIO_RTS_ON +0x01AD A_RTS_ON +0x55E2 SERBBITS +0x019D SIO_RTS_OFF +0x55E1 SERABITS +0x0181 EMPTYCHBBFR +0x01D3 SIO_B_DI +0x0197 B_RTS_OFF +0x3E9C SOERR +0x015D CHABFREMPTY +0x014F EMPTYCHABFR +0x55E0 SERIALS_EN +0x01CB SIO_A_DI +0x11E9 GMMSG +0x0761 CHAR2VID +0x559A PRNTVIDEO +0x55D8 KBDNPT +0x0120 CNTRXCHA +0x000D CR +0x559B CHR4VID +0x0131 LVRXCHA +0x01FD CHARINTOBFR +0x55DA TMPKEYBFR +0x018F A_RTS_OFF +0x00EC FMVEREND +0x00D0 X FWVER +0x53FD NMIUSR +0x558B CTC3IV +0x5588 CTC2IV +0x5585 CTC1IV +0x5582 CTC0IV +0x0278 CKINCHAR +0x0018 X RST18 +0x022A RXA +0x0010 X RST10 +0x0136 SPEC_RXA_CNDT +0x0100 RX_CHA_AVAIL +0x0259 TXA +0x0008 X RST08 +0x0168 SPEC_RXB_CNDT +0x0165 RX_CHB_AVAIL +0x5365 ROM2RAM +0x0000 X RST00 +0x0005 SER_EMPTYSIZE +0x0050 SER_FULLSIZE +0x0058 SER_BUFSIZE +0x0041 PSG_DAT +0x0040 PSG_REG +0x0031 VDP_SET +0x0030 VDP_DAT +0x0021 SIO_DB +0x0020 SIO_DA +0x0023 SIO_CB +0x0022 SIO_CA +0x0013 CTC_CH3 +0x0012 CTC_CH2 +0x0011 CTC_CH1 +0x0010 CTC_CH0 +0x0003 PIO_CB +0x0002 X PIO_CA +0x0001 PIO_DB +0x0000 X PIO_DA diff --git a/Rom/LM80C-64K-firmware-r1.17.bin b/Rom/Legacy/LM80C-64K-firmware-r1.17.bin similarity index 100% rename from Rom/LM80C-64K-firmware-r1.17.bin rename to Rom/Legacy/LM80C-64K-firmware-r1.17.bin diff --git a/Rom/LM80C_64K-firmware-r1.17.lst b/Rom/Legacy/LM80C_64K-firmware-r1.17.lst similarity index 100% rename from Rom/LM80C_64K-firmware-r1.17.lst rename to Rom/Legacy/LM80C_64K-firmware-r1.17.lst diff --git a/include/basic/basic-1.13.asm b/include/basic/basic-1.13.asm new file mode 100644 index 0000000..0e546c4 --- /dev/null +++ b/include/basic/basic-1.13.asm @@ -0,0 +1,6796 @@ +; ------------------------------------------------------------------------------ +; LM80C BASIC (32K/64K) - R3.25 +; ------------------------------------------------------------------------------ +; The following code is intended to be used with LM80C Z80-based computer +; designed by Leonardo Miliani. Code and computer schematics are released under +; the therms of the GNU GPL License 3.0 and in the form of "as is", without no +; kind of warranty: you can use them at your own risk. +; You are free to use them for any non-commercial use: you are only asked to +; maintain the copyright notices, include this advice and the note to the +; attribution of the original version to Leonardo Miliani, if you intend to +; redistribuite them. +; https://www.leonardomiliani.com +; +; Please support me by visiting the following links: +; Main project page: https://www.leonardomiliani.com +; Schematics and code: https://github.com/leomil72/LM80C +; Videos about the computer: https://www.youtube.com/user/leomil72/videos +; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer +; ------------------------------------------------------------------------------ +; LM80C BASIC 64K - originally based on the following NASCOM BASIC versions: +; 4.7 - original version by NASCOM/MICROSOFT +; 4.7b - modified version by Grant Searle (additional commands & functions) + + +;------------------------------------------------------------------------------ +; L M 8 0 C B A S I C +;------------------------------------------------------------------------------ + +; GENERAL EQUATES + +NLLCR equ $00 ; null char (used as space/empty char in video prints) +CTRLC equ $03 ; Control "C" +CTRLG equ $07 ; Control "G" +BKSP equ $08 ; Back space +LF equ $0A ; Line feed +CS equ $0C ; Clear screen +CR equ $0D ; Carriage return +CTRLO equ $0F ; Control "O" +CTRLQ equ $11 ; Control "Q" +CTRLR equ $12 ; Control "R" +CTRLS equ $13 ; Control "S" +CTRLU equ $15 ; Control "U" +HOME equ $19 ; Home (cursor at 0,0) +ESC equ $1B ; Escape +SPC equ $20 ; Space +DEL equ $7F ; Delete +INSRT equ $1A ; Insert Key +; cursor ASCII codes +CRSLFT equ $1C ; cursor left +CRSRGT equ $1D ; cursor right +CRSUP equ $1E ; cursor up +CRSDN equ $1F ; cursor down + + +;------------------------------------------------------------------------- +; BASIC ERROR MESSAGES +; the interpreter looks for a single-byte code in the following list, +; then loads the corresponding memory pointer in "ERRTBL" table to +; find where to retrieve the message text in "ERRORS" + +; BASIC ERROR CODE VALUES +; These values act as an offset to point to the error message into the error table +; must be incremented by 2 because they point to a word address jump +NF equ $00 ; NEXT without FOR +SN equ $02 ; Syntax error +RG equ $04 ; RETURN without GOSUB +OD equ $06 ; Out of DATA +FC equ $08 ; Function call error +OV equ $0A ; Overflow +OM equ $0C ; Out of memory +UL equ $0E ; Undefined line number +BS equ $10 ; Bad subscript +DD equ $12 ; Re-Dimensioned array +DZ equ $14 ; Division by zero (/0) +ID equ $16 ; Illegal direct +TM equ $18 ; Type mis-match +OS equ $1A ; Out of string space +LS equ $1C ; String too long +ST equ $1E ; String formula too complex +CN equ $20 ; Can't continue +UF equ $22 ; Undefined FN function +MO equ $24 ; Missing operand +HE equ $26 ; HEX error +BN equ $28 ; BIN error +GM equ $2A ; No Graphics Mode +SC equ $2C ; Serial configuration +SA equ $2E ; Serial port already open +SO equ $30 ; Serial buffer overrun +HP equ $32 ; HELP call +IM equ $34 ; Illegal indirect +NR equ $36 ; Device not ready +D0 equ $38 ; File open/close error +D1 equ $3A ; Disk/File name error +D2 equ $3C ; Disk geometry error +D3 equ $3E ; Save error +D4 equ $40 ; Load error +D5 equ $42 ; Disk full error +D6 equ $44 ; Duplicate file name error +D7 equ $46 ; DOS version error +D8 equ $48 ; File not found error +D9 equ $4A ; File already open +DA equ $4C ; End of file + + +; BASIC ERROR POINTER TABLE +ERRTBL: equ $ +NFPTR: defw NFMSG +SNPTR: defw SNMSG +RGPTR: defw RGMSG +ODPTR: defw ODMSG +FCPTR: defw FCMSG +OVPTR: defw OVMSG +OMPTR: defw OMMSG +ULPTR: defw ULMSG +BSPTR: defw BSMSG +DDPTR: defw DDMSG +DZPTR: defw DZMSG +IDPTR: defw IDMSG +TMPTR: defw TMMSG +OSPTR: defw OSMSG +LSPTR: defw LSMSG +STPTR: defw STMSG +CNPTR: defw CNMSG +UFPTR: defw UFMSG +MOPTR: defw MOMSG +HEPTR: defw HEMSG +BNPTR: defw BNMSG +GMPRT: defw GMMSG +SCPTR: defw SCMSG +SAPTR: defw SAMSG +SOPTR: defw SOMSG +HPPTR: defw HPMSG +IMPRT: defw IMMSG +NRPRT: defw NRMSG +D0PTR: defw D0MSG +D1PRT: defw D1MSG +D2PRT: defw D2MSG +D3PRT: defw D3MSG +D4PTR: defw D4MSG +D5PTR: defw D5MSG +D6PTR: defw D6MSG +D7PRT: defw D7MSG +D8PTR: defw D8MSG +D9PTR: defw D9MSG +DAPTR: defw DAMSG + + +; BASIC ERROR MESSAGE LIST +ERRORS equ $ +NFMSG: defb "NEXT Without FOR",0 +SNMSG: defb "Syntax",0 +RGMSG: defb "RETURN without GOSUB",0 +ODMSG: defb "Out of DATA",0 +FCMSG: defb "Illegal Function Call",0 +OVMSG: defb "Overflow",0 +OMMSG: defb "Out of Memory",0 +ULMSG: defb "Undefined Line",0 +BSMSG: defb "Bad Subscript",0 +DDMSG: defb "Re-Dimensioned Array",0 +DZMSG: defb "Division by Zero",0 +IDMSG: defb "Illegal Direct Mode",0 +TMMSG: defb "Type Mis-match",0 +OSMSG: defb "Out of String Space",0 +LSMSG: defb "String Too Long",0 +STMSG: defb "String Formula Too Complex",0 +CNMSG: defb "Can't Continue",0 +UFMSG: defb "Undefined FN Function",0 +MOMSG: defb "Missing Operand",0 +HEMSG: defb "HEX Format",0 +BNMSG: defb "BIN Format",0 +GMMSG: defb "No Graphics Mode",0 +SCMSG: defb "Serial Configuration",0 +SAMSG: defb "Serial Port Already Open",0 +SOMSG: defb "Serial Buffer Overrun",0 +HPMSG: defb "HELP Call",0 +IMMSG: defb "Illegal Indirect Mode",0 +NRMSG: defb "Device Not Ready",0 +D0MSG: defb "File Open/Close",0 +D1MSG: defb "Name String",0 +D2MSG: defb "Disk Geometry",0 +D3MSG: defb "Save",0 +D4MSG: defb "Load",0 +D5MSG: defb "Disk Full",0 +D6MSG: defb "Duplicate File Name",0 +D7MSG: defb "DOS Version",0 +D8MSG: defb "File Not Found",0 +D9MSG: defb "File Already Open",0 +DAMSG: defb "End Of File",0 + + +;----------------------------------------------------------------------------- +; STARTING POINTS FOR BASIC BOOT +; COLD: reset every memory pointer, acting as a power-up boot +; WARM: preserve program in memory, keeping every current pointer + +COLD: jp STARTB ; Jump for cold start +WARM: jp WARMST ; Jump for warm start + +STARTB: jp CSTART ; Jump to initialise + defw DEINT ; Get integer -32768 to 32767 + defw 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 + +SYSINIT:ld HL,INITAB ; Initialise workspace + ld BC,INITBE-INITAB+3; Bytes to copy + ld DE,WRKSPC ; Into workspace RAM + ldir ; Copy data + ex DE,HL ; Copy DE into HL + ld SP,HL ; Temporary stack + call CLREG ; Clear registers and stack + call PRNTCRLF ; Output CRLF + ld (BUFFER+88+1),A ; Mark end of buffer + ld (PROGST),A ; Initialise program area + jr MNOASK ; usually, don't ask for memory top (only when there are errors) +MSIZE: ld HL,MEMMSG ; Point to message + call PRS ; Output "Memory size" + call PROMPT ; Get input with '?' + call CURSOR_ON ; enable cursor + call GETCHR ; Get next character + or A ; Set flags + jp NZ,TSTMEM ; If number - Test if RAM there +MNOASK: 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,%11011001 ; 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: call CURSOR_OFF ; disable cursor + 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 A,(DOS_EN) ; read if the user enabled/disabled DOS while booting + rra ; is DOS enabled? + jr C,SETDSR ; yes, so jump over + ld IX,DOSJPTB+1 ; point to 1st address of DOS jump table + + DEFINE DOSNTRS 10 ; DOS entries <-- CHANGE THIS VALUE TO ALIGN IT WITH THE NUMBER OF ENTRIES + + ld B,DOSNTRS ; number of entries + ld DE,SNERR ; address of REM routine +CPDSTB: ld (IX),E ; copy REM address... + inc IX ; ...into the... + ld (IX),D ; ...jump entry + inc IX ; next jump address + inc IX + djnz CPDSTB ; repeat + ld DE,0-(DOSNTRS*3); protect jump table (3 byte for each entry) + jr SETNOD +SETDSR: ld DE,0-($FFFF-DOSSTART+1) ; no, so reserve RAM occupied by DOS & I/O buffers +SETNOD: add HL,DE +SETTRAM:ld (LSTRAM),HL ; Save last available RAM + ld DE,0-100 ; now, reserve 100 bytes for string space + 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 + ld A,(DOS_EN) ; check if DOS is enabled + or A + jr Z,SETTP1 ; no DOS, jump over + ld HL,DOSMSG ; DOS message + call PRS +SETTP1: ld HL,BLNSPC ; Empty space + 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 + call RESFN ; reset FN keys and auto-repeat + call CURSOR_ON ; enable cursor + jp PRNTOK ; Go to get command line + +BLNSPC: defb " ",0 ; 8 empty cells to align the "XXXX Bytes free" message +BFREE: defb " Bytes free",CR,CR,0 + +SIGNON: defb "LM80C BASIC 3.25 ",251,"2021 L.Miliani" + defb " Z80 BASIC 4.7 ",251,"1978 Microsoft",CR,0 +DOSMSG: defb " LM80C DOS ",DOS_VER," Loaded",CR,0 + +MEMMSG: defb "Memory top",0 + +; The following list reports all the functions supported by the interpreter. +; To add a custom function, the user must first insert the reserved word here, +; then into the list of the reserved words below, and finally must increment the +; ZSGN token value and all the following ones after ZSGN by 1 for every added +; function. + +; FUNCTION ADDRESS TABLE (this is a sort of offset table) +; this list must be coherent with the tokens' functions list. This means that every +; entry here must have the corresponding entry in the tokens list. +FNCTAB: defw SGN + defw TMR ; added by Leonardo Miliani + defw INT + defw ABS_ ; '_' necessary to avoid assembler warnings + defw USR + defw FRE + defw INP + defw POS + defw SQR + defw RND + defw LOG + defw EXP + defw COS + defw SIN + defw TAN + defw ATN + defw PEEK + defw DEEK + defw VPEEK ; added by Leonardo Miliani + defw VSTAT ; added by Leonardo Miliani + defw SSTAT ; added by Leonardo Miliani + defw INKEY ; added by Leonardo Miliani + defw POINT ; added by Leonardo Miliani + defw INSTR ; added by Leonardo Miliani + defw JPGET ; added by Leonardo Miliani + defw JPEOF ; added by Leonardo Miliani + defw LEN + defw STR + defw VAL + defw ASC + defw CHR + defw HEX ; added by Grant Searle + defw BIN ; added by Grant Searle + defw LEFT + defw RIGHT + defw MID + +; RESERVED WORD LIST +; Here are all the reserved words used by the interpreter +; To add custom functions/commands, the user must insert the keyword +; in this list, following the schematic +WORDS: defb 'E'+$80,"ND" ; from here the list contains the COMMANDS + defb 'F'+$80,"OR" + defb 'N'+$80,"EXT" + defb 'D'+$80,"ATA" + defb 'I'+$80,"NPUT" + defb 'D'+$80,"IM" + defb 'R'+$80,"EAD" + defb 'L'+$80,"ET" + defb 'G'+$80,"OTO" + defb 'R'+$80,"UN" + defb 'I'+$80,"F" + defb 'R'+$80,"ESTORE" + defb 'G'+$80,"OSUB" + defb 'R'+$80,"ETURN" + defb 'R'+$80,"EM" ; original REM + defb 'S'+$80,"TOP" + defb 'O'+$80,"UT" + defb 'O'+$80,"N" + defb 'F'+$80,"ILES" ; added by Leonardo Miliani + defb 'E'+$80,"RASE" ; added by Leonardo Miliani + defb 'D'+$80,"ISK" ; added by Leonardo Miliani + defb 'O'+$80,"PEN" ; added by Leonardo Miliani + defb 'C'+$80,"LOSE" ; added by Leonardo Miliani + defb 'P'+$80,"UT" ; added by Leonardo Miliani + defb 'W'+$80,"AIT" + defb 'D'+$80,"EF" + defb 'P'+$80,"OKE" + defb 'D'+$80,"OKE" + defb 'V'+$80,"POKE" ; added by Leonardo Miliani + defb 'S'+$80,"REG" ; added by Leonardo Miliani + defb 'V'+$80,"REG" ; added by Leonardo Miliani + defb 'S'+$80,"CREEN" ; changed by Leonardo Miliani + defb 'L'+$80,"OCATE" ; added by Leonardo Miliani + defb 'S'+$80,"OUND" ; added by Leonardo Miliani + defb 'V'+$80,"OLUME" ; added by Leonardo Miliani + defb 'P'+$80,"AUSE" ; added by Leonardo Miliani + defb 'C'+$80,"OLOR" ; added by Leonardo Miliani + defb 'P'+$80,"LOT" ; added by Leonardo Miliani + defb 'D'+$80,"RAW" ; added by Leonardo Miliani + defb 'C'+$80,"IRCLE" ; added by Leonardo Miliani + defb 'P'+$80,"AINT" ; added by Leonardo Miliani + defb 'S'+$80,"ERIAL" ; added by Leonardo Miliani + defb 'H'+$80,"ELP" ; changed by Leonardo Miliani - was LINES + defb 'C'+$80,"LS" ; restored command + defb 'K'+$80,"EY" ; added by Leonardo Miliani + defb 'N'+$80,"MI" ; added by Leonardo Miliani + defb 'G'+$80,"PRINT" ; added by Leonardo Miliani + defb 'W'+$80,"IDTH" + defb 'S'+$80,"YS" ; added by Leonardo Miliani + defb 'R'+$80,"ESET" ; changed by Leonardo Miliani + defb 'E'+$80,"LSE" ; added by Leonardo Miliani + defb 'P'+$80,"RINT" + defb 'C'+$80,"ONT" + defb 'L'+$80,"IST" + defb 'C'+$80,"LEAR" + defb 'L'+$80,"OAD" + defb 'S'+$80,"AVE" + defb 'N'+$80,"EW" + defb 'T'+$80,"AB(" + defb 'T'+$80,"O" + defb 'F'+$80,"N" + defb 'S'+$80,"PC(" + defb 'T'+$80,"HEN" + defb 'N'+$80,"OT" + defb 'S'+$80,"TEP" + ; from here: operators + defb '+'+$80 + defb '-'+$80 + defb '*'+$80 + defb '/'+$80 + defb '%'+$80 + defb '#'+$80 + defb '^'+$80 + defb 'A'+$80,"ND" + defb 'X'+$80,"OR" + defb 'O'+$80,"R" + defb '>'+$80 + defb '='+$80 + defb '<'+$80 + + ; from here there are the tokens' FUNCTIONS list + ; this list must be coherent with the functions list above + defb 'S'+$80,"GN" + defb 'T'+$80,"MR" ; added by Leonardo Miliani + defb 'I'+$80,"NT" + defb 'A'+$80,"BS" + defb 'U'+$80,"SR" + defb 'F'+$80,"RE" + defb 'I'+$80,"NP" + defb 'P'+$80,"OS" + defb 'S'+$80,"QR" + defb 'R'+$80,"ND" + defb 'L'+$80,"OG" + defb 'E'+$80,"XP" + defb 'C'+$80,"OS" + defb 'S'+$80,"IN" + defb 'T'+$80,"AN" + defb 'A'+$80,"TN" + defb 'P'+$80,"EEK" + defb 'D'+$80,"EEK" + defb 'V'+$80,"PEEK" ; added by Leonardo Miliani + defb 'V'+$80,"STAT" ; added by Leonardo Miliani + defb 'S'+$80,"STAT" ; added by Leonardo Miliani + defb 'I'+$80,"NKEY" ; added by Leonardo Miliani + defb 'P'+$80,"OINT" ; added by Leonardo Miliani + defb 'I'+$80,"NSTR" ; added by Leonardo Miliani + defb 'G'+$80,"ET" ; added by Leonardo Miliani + defb 'E'+$80,"OF" ; added by Leonardo Miliani + defb 'L'+$80,"EN" + defb 'S'+$80,"TR$" + defb 'V'+$80,"AL" + defb 'A'+$80,"SC" + defb 'C'+$80,"HR$" + defb 'H'+$80,"EX$" ; added by Grant Searle + defb 'B'+$80,"IN$" ; added by Grant Searle + defb 'L'+$80,"EFT$" + defb 'R'+$80,"IGHT$" + defb 'M'+$80,"ID$" + defb $80 ; End-of-list marker + +; COMMAND KEYWORD ADDRESS TABLE +; this list must be coherent with the commands' tokens list above +WORDTB: defw PEND + defw FOR + defw NEXT + defw DATA + defw INPUT + defw DIM + defw READ + defw LET + defw GOTO + defw RUN + defw IF + defw RESTOR + defw GOSUB + defw RETURN + defw REM ; original REM + defw STOP + defw POUT + defw ON + defw JPFILS ; changed by Leonardo Miliani - was NULL + defw JPERAS ; added by Leonardo Miliani + defw JPDISK ; added by Leonardo Miliani + defw JPOPEN ; added by Leonardo Miliani + defw JPCLOSE ; added by Leonardo Miliani + defw JPPUT ; added by Leonardo Miliani + defw WAIT + defw DEF + defw POKE + defw DOKE + defw VPOKE ; added by Leonardo Miliani + defw SREG ; added by Leonardo Miliani + defw VREG ; added by Leonardo Miliani + defw SCREEN ; new behaviour: now it sets up a graphics mode (Leonardo Miliani) + defw LOCATE ; added by Leonardo Miliani + defw SOUND ; added by Leonardo Miliani + defw VOLUME ; added by Leonardo Miliani + defw PAUSE ; added by Leonardo Miliani + defw COLOR ; added by Leonardo Miliani + defw PLOT ; added by Leonardo Miliani + defw DRAW ; added by Leonardo Miliani + defw CIRCLE ; added by Leonardo Miliani + defw PAINT ; added by Leonardo Miliani + defw SERIAL ; added by Leonardo Miliani + defw HELP ; changed by Leonardo Miliani - was LINES + defw CLS + defw KEY ; added by Leonardo Miliani + defw NMI ; added by Leonardo Miliani + defw GPRINT ; added by Leonardo Miliani + defw WIDTH + defw SYS ; added by Leonardo Miliani + defw RESET ; new behaviour: now it resets the system + defw REM+2 ; ELSE: added by Leonardo Miliani + defw PRINT + defw CONT + defw LIST + defw CLEAR + defw JPLOAD ; re-implemented by Leonardo Miliani (was CLOAD) + defw JPSAVE ; re-implemented by Leonardo Miliani (was CSAVE) + defw NEW + +; RESERVED WORD TOKEN VALUES +; if you add a function or command you must increment by 1 +; the values below. Pay attention that you must increment only the +; values AFTER the position where you entered the function/command word +; in the "Reserver word list" above. I.E.: VPOKE has been added between +; DOKE and SCREEN, and since REM is the reserved work listed below +; that is before the point where VPOKE has been entered, every entry +; after REM has been incremented. +; Another example: when TMR has been added, since it's a function, every +; entry after & included ZSGN must be checked (read below) + +ZEND equ $80 ; END <-- from here, there are the commands +ZFOR equ $81 ; FOR +ZDATA equ $83 ; DATA +ZGOTO equ $88 ; GOTO +ZGOSUB equ $8C ; GOSUB +ZREM equ $8E ; REM +ZELSE equ $B2 ; ELSE +ZPRINT equ $B3 ; PRINT +ZNEW equ $B9 ; NEW + +ZTAB equ $BA ; TAB +ZTO equ $BB ; TO +ZFN equ $BC ; FN +ZSPC equ $BD ; SPC +ZTHEN equ $BE ; THEN +ZNOT equ $BF ; NOT +ZSTEP equ $C0 ; STEP + +ZPLUS equ $C1 ; + <-- from here, there are the math operators +ZMINUS equ $C2 ; - +ZTIMES equ $C3 ; * +ZDIV equ $C4 ; / +ZMOD equ $C5 ; % +ZDINT equ $C6 ; # +ZOR equ $CA ; OR +ZGTR equ $CB ; > +ZEQUAL equ $CC ; M +ZLTH equ $CD ; < + +ZSGN equ $CE ; SGN <-- from here, there are the functions +ZPOINT equ $E4 ; ZPOINT <-- if the user enters a custom function, between + ; SGN and POINT, he/she must increment this pointer by 1 +ZINSTR equ $E5 ; ZINSTR <-- same here +ZLEFT equ $EF ; LEFT$ <-- if the user enters a custom function anywhere, + ; he/she must increment this pointer by 1 + +; ARITHMETIC PRECEDENCE TABLE +; in the formulas below, is a number stored into the stack that must be retrieved +; with POP BC, POP DE; FPREG is a f.p. number store into the RAM register FPREG +PRITAB: defb $79 ; Precedence value + defw PADD ; FPREG = + FPREG + + defb $79 ; Precedence value + defw PSUB ; FPREG = - FPREG + + defb $7C ; Precedence value + defw MULT ; PPREG = * FPREG + + defb $7C ; Precedence value + defw DIV ; FPREG = / FPREG + + defb $7C ; Precedence value + defw MOD ; FPREG = INT()-(INT(FPREG)*INT(/FPREG)) + + defb $7C ; precedence value + defw DINT ; FPREG = INT( / FPREG ) + + defb $7F ; Precedence value + defw POWER ; FPREG = ^ FPREG + + defb $50 ; Precedence value + defw PAND ; FPREG = AND FPREG + + defb $4A ; Precedence value + defw PXOR ; FPREG = XOR FPREG + + defb $46 ; Precedence value + defw POR ; FPREG = OR FPREG + + +; INITIALISATION TABLE ------------------------------------------------------- +; these values are copied into RAM at startup +INITAB: jp WARMST ; Warm start jump + defb $ED,$45,$00 ; RETN + NOP for default NMI service routine + jp FCERR ; "USR (X)" jump (Set to Error) + out (0),A ; "out p,n" skeleton + ret + sub $00 ; Division support routine + ld L,A + ld A,H + sbc A,$00 + ld H,A + ld A,B + sbc A,$00 + ld B,A + ld A,$00 + ret + defb $00,$00,$00 ; Random number seed table used by RND + defb $35,$4A,$CA,$99 ;-2.65145E+07 + defb $39,$1C,$76,$98 ; 1.61291E+07 + defb $22,$95,$B3,$98 ;-1.17691E+07 + defb $0A,$DD,$47,$98 ; 1.30983E+07 + defb $53,$D1,$99,$99 ;-2-01612E+07 + defb $0A,$1A,$9F,$98 ;-1.04269E+07 + defb $65,$BC,$CD,$98 ;-1.34831E+07 + defb $D6,$77,$3E,$98 ; 1.24825E+07 + defb $52,$C7,$4F,$80 ; Last random number + in A,($00) ; INP (x) skeleton + ret + defb $FF ; Terminal width (255 = no auto CRLF) + defb $14 ; Width for commas (at reset, 3 columns, for G1 mode) + defb $00 ; No nulls after input bytes + defb $00 ; Output enabled (^O off) + defw $00 ; Array load/save check sum + defb $00 ; Break not by NMI + defb $00 ; Break flag + jp TTYLIN ; Input reflection (set to TTY) + defw STLOOK ; Temp string space + defw -2 ; Current line number (cold) + defw -1 ; Current line with errors (no errors) +AUTORP: defb $40 ; delay for key auto-repeat start + defb $08 ; auto-repeat delay +DEFFNKS:defm "LIST",13,0,0,0,0,0,0,0,0,0,0,0 ; KEY 1 + defm "RUN",13,0,0,0,0,0,0,0,0,0,0,0,0 ; KEY 2 + defm "SCREEN1",13,0,0,0,0,0,0,0,0 ; KEY 3 + defm "COLOR1,15,5",13,0,0,0,0 ; KEY 4 + defm "SERIAL1,38400",13,0,0 ; KEY 5 + defm "SCREEN2",13,0,0,0,0,0,0,0,0 ; KEY 6 + defm "CONT",13,0,0,0,0,0,0,0,0,0,0,0 ; KEY 7 + defm "HELP",13,0,0,0,0,0,0,0,0,0,0,0 ; KEY 8 (HELP KEY) + defw PROGST+1 ; Start of program text +INITBE: + +; END OF INITIALISATION TABLE --------------------------------------------------- + +ERRMSG: defb " Error",0 +INMSG: defb " in ",0 +ZERBYT equ $-1 ; A zero byte +OKMSG: defb "Ok",CR,0,0 +BRKMSG: defb "Break",0 + +BAKSTK: ld HL,$04 ; 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,$00 ; BC = Number of levels to test + add HL,BC ; 2 Bytes for each level + add HL,BC + defb $3E ; Skip "push HL" +ENFMEM: push HL ; Save code string address + ld A,$D0 ; LOW -48 ; 48 Bytes minimum RAM + sub L + ld L,A + ld A,$FF ; 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 memory +OMERR: ld E,OM ; ?OM Error + jp ERROR + + +; if in graphics mode, return to text (called by "NOLIN" and "ERROR") +EXITGM: push AF ; store AF + ld A,(SCR_MODE) ; check screen mode + cp $02 ; G2? + jp Z,LDG1 ; yes, back to G1 + cp $03 ; G3? + jr NZ,LDG1ND ; no, so return +LDG1: push HL ; store HL + push DE ; store DE + ld DE,$0001 ; sprites set to defaults, G1 mode + di ; disable INTs + call initVDP ; initialize VDP with mode pointed by E + ei ; re-enable INTs + ld A,$01 ; activate the... + ld (PRNTVIDEO),A ; ...video buffer... + pop DE ; retrieve DE + pop HL ; retrieve HL +LDG1ND: pop AF ; retrieve AF + ret ; return to caller + + +DATSNR: ld HL,(DATLIN) ; Get line of current DATA item + ld (LINEAT),HL ; Save as current line +SNERR: ld E,SN ; ?SN Error + defb $01 ; Skip "ld E,DZ" +DZERR: ld E,DZ ; ?/0 Error + defb $01 ; Skip "ld E,NF" +NFERR: ld E,NF ; ?NF Error + defb $01 ; Skip "ld E,DD" +DDERR: ld E,DD ; ?DD Error + defb $01 ; Skip "ld E,UF" +UFERR: ld E,UF ; ?UF Error + defb $01 ; Skip "ld E,OV +OVERR: ld E,OV ; ?OV Error + defb $01 ; Skip "ld E,TM" +TMERR: ld E,TM ; ?TM Error + defb $01 ; Skip next statement +IMERR: ld E,IM ; ?Illegal indirect mode error + defb $01 ; Skip next statement +NRERR: ld E,NR ; ?Device not ready error + +ERROR: call CLREG ; Clear registers and stack + call EXITGM ; exit from graphic modes + ld (CTLOFG),A ; Enable output (A is 0) + call CURSOR_ON ; enable cursor + call STTLIN ; Start new line + ld HL,ERRTBL ; 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 E,(HL) ; load pointer to error message + inc HL ; by loading LSB, + ld D,(HL) ; then MSB + ld HL,DE ; load pointer to HL + call PRS ; Output error message + 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 + jp Z,PTLN ; Yes, jump over + push HL ; indirect mode - store HL + ld HL,(LINEAT) ; copy current line number + ld (HLPLN),HL ; save in HELP line register + pop HL ; retrieve HL +PTLN: call NZ,LINEIN ; No - output line of error + + defb $3E ; Skip "pop BC" +POPNOK: pop BC ; Drop address in input buffer + +; run into direct mode: print OK and get command +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: call CURSOR_ON ; enable cursor + ld A,(SERIALS_EN) ; load serial state + xor %00000101 ; check if serial 1 is open and RX enabled + call Z,A_RTS_ON ; yes, set RTS on + 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 + rla ; 8th bit is copied into carry and original carry is copied into bit 0) + jp C,SNERR ; if char >=128 (8th bit set) then raise an error + rra ; recover original char and Carry + inc A ; Test if end of line + dec A ; Without affecting Carry + jp Z,GETCMD ; Nothing entered - Get another + push AF ; Save Carry status + ld A,(SERIALS_EN) ; load serial state + xor %00000101 ; check if serial 1 is open and RX enabled + call Z,A_RTS_OFF ; yes, set RTS on + call CURSOR_OFF ; cursor disabled + 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 RAM + 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,NLLCR ; null char + call OUTC ; Output character + call CURSOR_ON ; enable cursor + ld A,(SERIALS_EN) ; load serial state + xor %00000101 ; check if serial 1 is open and RX enabled + call Z,A_RTS_ON ; yes, set RTS on + 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 SPC ; Is it a space? + jp Z,MOVDIR ; Yes - Copy direct + ld B,A ; Save character + cp $22 ; '"' ; 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 $3C ;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 %01011111 ; 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 %01111111 ; 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 %01011111 ; 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-$3A ; Is it DATA statement ? + jp NZ,TSTREM ; No - see if REM +SETLIT: ld (DATFLG),A ; Set literal flag +TSTREM: sub ZREM-$3A ; 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,$00 ; 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 + defb $3E ; 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,$01 ; 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 + xor A ; Clear A + ld (NULFLG),A ; Reset null flag + call OUTC ; Output null +PROCES: ld A,C ; Get character + cp CTRLG ; Bell? + jp Z,PUTCTL ; Yes - Save it + cp CTRLC ; Is it control "C"? + call Z,GMNCR ; Yes - exit from graphic mode & 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 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),$00 ; 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 +GMNCR: call EXITGM ; exit from graphic mode + jp PRNTCRLF ; output CRLF + +PUTBUF: cp SPC ; Is it a control code? + jp C,MORINP ; Yes - Ignore +PUTCTL: ld A,B ; Get number of bytes in buffer + cp $58+$01 ; Test for line overflow + ld A,BKSP ; 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: jp MORINP ; Get another character + +OUTNBS: call OUTC ; Output bell and back over it + jp OUTIT ; get more chars + +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 SPC ; 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: xor A + ld (KBDNPT),A ; set flag for no char from keyboard + pop AF ; Restore character + pop BC ; Restore buffer length + push AF + call SND2VID ; send char to video + pop AF + call MONOUT ; send char to serial if enabled + ret + +; print char to video if cursor is on +SND2VID:ld (CHR4VID),A ; store A + ld A,(PRNTVIDEO) ; check print-on-video + or A ; is it off? + ret Z ; yes, so return + di ; disable INTs + call CHAR2VID ; cursor is on, so print char on screen + ei ; re-enable INTs + ret ; return to caller + +CLOTST: call GETINP ; Get input character + 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 + and A ; is output enabled? + call Z,CURSOR_ON ; yes, so cursor on + ld A,(SERIALS_EN) ; load serial state + xor %00000101 ; check if serial 1 is open and RX enabled + call Z,A_RTS_ON ; yes, set RTS on + xor A ; Null character + ret + +; LIST: list the program stored into memory +LIST: pop BC ; rubbish - not needed (legacy from original call of LIST) + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + jp Z,LSTALL ; list all if nothing follows + cp ZMINUS ; is it '-'? + jr NZ,LST01 ; no, look for a line number + ld DE,$0000 ; yes, set search from 0 + call SRCHLIN ; find address of line number, getting the following if it doesn't exist + ld (TMPBFR1),BC ; store address of starting line + call CHKSYN ; skip '-' + defb ZMINUS + call ATOH ; now, look for another number (ASCII number to DE) + call SRCLN ; find a line, getting the previous if it doesn't exist + ld (TMPBFR2),BC ; store address of ending line + ld BC,(TMPBFR1) ; retrieve address of starting line + push BC ; store address of line for later use + jp LISTLP ; go listing +LST01: call ATOH ; get a line number (ASCII number to DE) +LST01H: ld (TMPBFR4),DE ; store ending line address for later use - N.B.: this is a hook for HELP command + call SRCHLIN ; find address of line number, getting the following if it doesn't exist + ld (TMPBFR1),BC ; store address of starting line + ld (TMPBFR2),BC ; same address for ending line (we'll change it later if needed) + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + jp Z,LSTNOT ; nothing follows, so ending & starting lines are the same + cp ZMINUS ; is it '-'? + jp Z,LST03 ; yes, read ending line +LST06: push BC ; store address for later use + jp LISTLP ; jump to list +LSTNOT: ld DE,(TMPBFR4) + call SRCHLIN ; find address of line number, getting the following if it doesn't exist + jp C,LST06 + jp PRNTOK +LSTALL: ld DE,65529 ; set ending line to max. allowed line number + call SRCHLIN ; get address of last line + ld (TMPBFR2),BC ; store it + ld DE,$0000 ; set start to first line in memory + call SRCHLIN ; get address of first line + ld (TMPBFR1),BC ; store it + push BC ; store address of starting line for later use + jp LISTLP ; start printing +LST03: call CHKSYN ; skip '-' + defb ZMINUS + call ATOH ; look for another number (return into DE) + ld A,D + or E ; is line=0? + jr NZ,LST05 ; no, jump over + ld DE,65529 ; yes set last valid line number + call SRCHLIN ; get address of last line + jp LST02 +LST05: call SRCLN ; find a line, getting the previous if it doesn't exist +LST02: ld (TMPBFR2),BC ; store address of ending line + ld BC,(TMPBFR1) ; retrieve address of starting line + push BC ; store it for later use +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 TSTBRK ; Test for break key + call TSTSPC ; test for space + push BC ; Save address of next line + ld A,(SCR_CURS_X) ; load current X pos of cursor + and A ; is it at the beginning of a new line? + jr NZ,LST08 ; No, jump over + ld A,CR ; yes, so just send a CR + call MONOUT ; to serial if it's open + xor A ; then, set cursor + ld (CURPOS),A ; to position 0 + jr LST07 ; and continue +LST08: call PRNTCRLF ; output CRLF +LST07: 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,SPC ; 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,NXTLN ; Yes - check 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 %01111111 ; Strip bit 7 + call OUTC ; Output 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 +NXTLN: pop DE ; recover address of current line + ld HL,(TMPBFR2) ; address of last line to print + call CMP16 ; check if current line is over last printable line + jp C,PRNTOK ; finish - leave & print OK + push DE ; store address of current line + jp LISTLP ; continue listing +; look for the address of a program line +SRCHLIN:push HL ; store HL (this is needed because HL store the pointer to the input buffer) + call SRCHLN ; search for line number in DE + pop HL ; retrieve HL + ret ; return to caller +; look for the address of a program line - if the line isn't found, +; it look backward for the previous line +SRCLN: push HL ; store HL +SRCLN1: call SRCHLN ; search for line in DE + jp C,LVSRLN ; found it, leave loop + dec DE ; not found, decrement number to look backward for an existing line + ld A,E + or D ; is line number zero? + jr NZ,SRCLN1 ; no, continue +LVSRLN: pop HL ; retrieve HL + ret ; return to caller + +; during LISTing, check if PAUSE is pressed, then pause listing and +; wait for another pressing of PAUSE to continue or CTRL-C/BREAK to exit +TSTSPC: ld A,(TMPKEYBFR) ; Get input character + cp SPC ; Is it SPACE? + ret NZ ; No, return +WTSPC: call GETINP ; Yes, stop listing and wait for another space or BREAK + cp SPC ; is it SPACE? + jr NZ,CNTWTSP ; no, continue + xor A + ld (TMPKEYBFR),A ; reset key + ret ; return to caller +CNTWTSP:cp CTRLC ; is it CTRL-C/BREAK? + jr NZ,WTSPC ; no, loop + jp BRKRET ; exit and output "Ok" + + +FOR: ld A,$64 ; 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,$0002 ; 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,$08 + 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 + defb 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,$8100 ; 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,$01 ; 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 + +; get a char from input buffer: exit with NC if character found is +; not a number; exit with Z if nothing found; char is into A +GETCHR: inc HL ; Point to next character + ld A,(HL) ; Get next code string byte + cp ':' ; Z if ':' + ret NC ; NC if > "9" + cp SPC + 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 + + +; check if CTRL-C is into input buffer +TSTBRK: rst $18 ; Check input status + ret Z ; No key, go back + rst $10 ; 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 + + +; wait for a key while listing +STALL: rst $10 ; 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 + defb $F6 ; Flag "STOP" +PEND: ret NZ ; Exit if anything else + ld (BRKLIN),HL ; Save point of break + defb $21 ; Skip "OR 11111111B" +INPBRK: or %11111111 ; 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,ERRINT ; "in line" wanted? + jp PRNTOK ; Go to command mode +ERRINT: call EXITGM ; exit from graphics mode + jp ERRIN ; print message + + +; CONTinue after a break/error +CONT: ld HL,-1 ; reset... + ld (HLPLN),HL ; ...HELP line register + 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 + +ACCSUM: push HL ; Save address in array + ld HL,(CHKSUM) ; Get check sum + ld B,$00 ; 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 $80+$10 ; Exponent in range (16 bits)? + jp C,FPINT ; Yes - convert it + ld BC,$9080 ; 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- + + +; convert a number in ASCII chars into an integer and store it into DE +ATOH: dec HL ; ASCII number to DE binary +GETLN: ld DE,$0000 ; 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 GETNUM ; Evaluate a number + call DEINT ; Get integer -32768 to 32767 into 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 + defb ',' + push DE ; Save number + call GETNUM ; Evaluate a number + call DEINT ; Get integer -32768 to 32767 into DE + 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,$28 ; 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: push HL ; store HL + ld HL,-1 ; reset... + ld (HLPLN),HL ; ...HELP line register + pop HL ; retrieve HL + 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,$03 ; 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 + defb $3E ; Skip "pop HL" +NXTDTA: pop HL ; Restore code string address + +DATA: defb $01,$3A ; ':' End of statement (stands for LD BC,$0E3A - NOP) +REM: ld C,$00 ; 00 End of statement + ld B,$00 +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 $22 ; '"' ; Literal string? + jp Z,NXTSTL ; Yes - Look for another '"' + jp NXTSTT ; Keep looking + +LET: call GETVAR ; Get variable name + call CHKSYN ; Make sure "=" follows + defb 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 + defb $3E ; 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" + defb 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" + defb ZTHEN ; "THEN" token + dec HL ; Cancel increment +IFGO: call TSTNUM ; Make sure it's numeric + call TSTSGN ; Test state of expression + jp Z,IF1 ; False - Jump over +IF0: call GETCHR ; Get next character + jp C,GOTO ; Number - GOTO that line + jp IFJMP ; Otherwise do statement +IF1: ld C,ZELSE + call REM+2 ; check statement + or A ; end of line? + ret Z ; yes, leave + cp ZELSE + jr NZ,IF1 ; ELSE not found, continue check + jp IF0 ; return to IF + + +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 ';' ; 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),NLLCR ; Followed by a NULL char (was SPC, 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: xor A + ld (KBDNPT),A ; char is not from keyboard + ld (HL),A ; Mark end of buffer + ld HL,BUFFER-1 ; Point to buffer + jr CNTEND +PRNTCRLF:ld A,CR ; Load a CR + call OUTC ; Output character + ld A,LF ; Load a LF + call OUTC ; Output character +CNTEND: xor A ; Set to position 0 + ld (CURPOS),A ; Store it + ret ; return to caller + +DOCOM: ld A,(COMMAN) ; Get comma width + ld B,A ; Save in B + ld A,(SCR_CURS_X) ; Get current position + cp B ; Within the limit? + call NC,PRNTCRLF ; No - output CRLF + jp NC,NEXITM ; Get next item +ZONELP: sub $0A ; Next zone of 10 characters + jp NC,ZONELP ; Repeat if more zones + cpl ; Number of null chars to output + ld C,NLLCR ; null char + jp ASPCS ; Output them + +DOTAB: push AF ; Save token + call FNDNUM ; Evaluate expression + call CHKSYN ; Make sure ")" follows + defb ')' + dec HL ; Back space on to ")" + pop AF ; Restore token + ld C,NLLCR ; for SPC we use NULL char (was SPACE) + sub ZSPC ; Was it "SPC(" ? + push HL ; Save code string address + jp Z,DOSPC ; Yes - Do 'E' spaces + ld A,(SCR_CURS_X) ; Get current X 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 +SPCLP: ld A,C ; char to print + 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: defb "?Redo from start",CR,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 $22 ; '"' ; Is there a prompt string? + ld A,$00 ; 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 + defb ";" + push HL ; Save code string address + call PRS1 ; Output prompt string + defb $3E ; 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 + ld A,(SERIALS_EN) ; load serial state + xor %00000101 ; check if serial 1 is open and RX enabled + call Z,A_RTS_OFF ; yes, set RTS on + call CURSOR_OFF ; disable cursor + 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 + defb $F6 ; 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 + defb ',' +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 $22 ; '"' ; 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: defb "?Extra ignored",CR,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,$0000 ; 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: defb $F6 ; 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 + defb '(' +EVAL: dec HL ; Evaluate expression & save + ld D,$00 ; Precedence value +EVAL1: push DE ; Save precedence + ld C,$01 + 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 $78 ; "AND", "OR", or "XOR" ? + call NC,TSTNUM ; No - Make sure it's a number + ld A,(HL) ; Get next operator / function + ld D,$00 ; Clear Last relation +RLTLP: sub ZGTR ; ">" Token + jp C,FOPRND ; + - * / ^ AND OR XOR - 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 XOR 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 $22 ; '"' ; 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 + defb ')' + ret + +MINUS: ld D,$7D ; '-' 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,$00 ; 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) ; "POINT" token? + jp Z,POINT ; Yes, do "POINT" + cp 2*(ZINSTR-ZSGN) ; "INSTR" token? + jp Z,INSTR ; Yes, do "INSTR" + 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 + defb ',' + 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" + +; execute OR, AND, and XOR operations +PAND: xor A ; for AND, Z=1 + jr CNTLGC +POR: xor A ; for OR, Z=0, S=1 + sub $01 + jr CNTLGC +PXOR: xor A ; for XOR, Z=0, S=0 + inc A +CNTLGC: push AF ; store operand's flags + call TSTNUM ; Make sure it's a number + call DEINT ; Get integer -32768 to 32767 + pop AF ; retrieve operand's flags + 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 ; store operand's flags + call DEINT ; Get integer -32768 to 32767 + pop AF ; retrieve operand's flags + pop BC ; Get value + ld A,C ; Get LSB + ld HL,ACPASS ; Address of save AC as current + jr NZ,POR1 ; if X/OR, jump over +PAND1: and E ; "AND" LSBs + ld C,A ; Save LSB + ld A,B ; Get MSB + and D ; "AND" MSBs + jp (HL) ; Save AC as current (ACPASS) +POR1: jp P,PXOR1 ; if S=0, jump to XOR + 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) +PXOR1: xor E ; "XOR" LSBs + ld C,A ; Save LSB + ld A,B ; Get MSB + xor D ; "XOR" 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,$64 ; 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: defw 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 $01 + 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,$5A ; 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 + defb ',' +DIM: ld BC,DIMRET ; Return to "DIMRET" + push BC ; Save on stack + defb $F6 ; 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,$0006 ; 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),$00 ; 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 + defb ')' + ld (NXTOPR),HL ; Save code string address + pop HL ; Get LCRFLG and TYPE + ld (LCRFLG),HL ; Restore Locate/create & type + ld E,$00 ; Flag not CSAVE* or CLOAD* + push DE ; Save number of dimensions (D) + defb $11 ; 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 + defb $3E ; 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,$0004 ; 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),$00 ; 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 + defb $16 ; 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 + + +; returns the value of the 32-bit system tick counter as +; two 16-bit words +TMR: call TSTNUM ; Make sure it's a number + call DEINT ; Get integer (-32768 to 32767) + ld HL,(TMRCNT) ; load the LSBytes of timer + ld A,E + or D ; is it 0? + jp Z,ENDTMR ; yes, jump over + ld HL,(TMRCNT+2) ; load the MSBytes of timer +ENDTMR: ld B,L ; move bytes... + ld A,H ; ...into AB + jp ABPASS ; return word into AB + + +; returns the free space for BASIC or into the string pool +FRE: ld HL,(ARREND) ; Start of free memory + ex DE,HL ; To DE + ld HL,$0000 ; 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,$00 + ld HL,TYPE ; Point to type + ld (HL),E ; Set type to numeric + ld B,$80+$10 ; 16 bit integer + jp RETINT ; Return the integer + +; returns the X position of the cursor during a print +POS: ld A,(CURPOS) ; Get cursor position +; return the value in A as a number +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 + defb '(' + 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 + defb ')' + call CHKSYN ; Make sure "=" follows + defb 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 + defb ZFN ; "FN" token + ld A,$80 + 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,$22 ; '"' ; 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 $22 ; '"' ; 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,$01 + 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,CNTEND ; Yes - Position cursor to 0 + inc BC ; Next byte in string + jp PRSLP ; More characters to output + +TESTR: or A ; Test if enough room + defb $0E ; 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 space + 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,$0000 + 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,$00 + 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 $80 ; 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,$00 + 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,$01 ; 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 + defb $11 ; Skip "ld C,0" +ALLFOL: ld C,$00 ; 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,$00 ; 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 + + +; INSTR statement - look for a string inside another string +; usage: INSTR(A$,B$) -> search for B$ into A$ +; return 0 if B$ is not found into A$, or LEN(A$)=len(S2) + jp C,RZINSTR ; if len(S2)>len(S1) then return 0 +RPTINST:xor A ; reset... + ld (TP),A ; ...TP... + ld (TF),A ; ...and TF + ld BC,(PT) ; pointer to S1 + ld HL,(ADRS1) ; first cell of S1 + add HL,BC ; get current position into RAM + ld A,(HL) ; load S1(PT) + ld HL,(ADRS2) ; pointer to first char of S2 + cp (HL) ; is S1(PT)=S2(0)? + jr NZ,CNT1INS ; no, continue + ld A,(PT) ; load current PT + ld (TP),A ; TP=PT + ld (PT1),A ; P1=PT + xor A ; set... + ld (PT2),A ; ...PT2=0 + inc A ; + ld (TF),A ; set TF=1 +RP2INST:ld BC,(PT1) ; load pointer PT1 + ld HL,(ADRS1) ; load address of S1 + add HL,BC ; find char of S1 pointed by PT1 + ld A,(HL) ; load S1(PT1) + ld BC,(PT2) ; load pointer PT2 + ld HL,(ADRS2) ; load char of S2 pointed by PT2 + add HL,BC ; find S2(PT2) + cp (HL) ; is S1(PT1)=S2(PT2)? + jr NZ,CNTZIN ; no, exit inner loop + ld HL,PT1 + inc (HL) ; increment PT1 + ld A,(PT2) + inc A ; increment PT2 + ld (PT2),A + jp Z,CNT1INS ; if PT2>255 then exit + ld HL,LNS2 ; len(S2) + cp (HL) ; PT2=len(S2)? + jp C,RP2INST ; no (PT2len(S1)-len(S2) + jp C,RPTINST ; repeat if < + jp Z,RPTINST ; repeat if = +RZINSTR:ld A,(TF) ; current value of TF + and A ; is it 0? + jp Z,LVINSTR ; yes, return 0 + ld A,(TP) ; return TP... + inc A ; ...incremented by 1 +LVINSTR:pop HL ; drop original return point + push IY ; load current string address from IY into stack + ld DE,RETNUM ; Address of Return number from function... + push DE ; ...saved on stack + jp PASSA ; return TP +CNTZIN: xor A ; set... + ld (TF),A ; TF=0 + jp CNT1INS ; continue + + +; returns the right portion of a string +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 + +; returns a piece of a 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,$FF ; All of string + cp ')' ; Any length given? + jp Z,RSTSTR ; No - Rest of string + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; Get integer 0-255 +RSTSTR: call CHKSYN ; Make sure ")" follows + defb ')' + pop AF ; Restore starting position + ex (SP),HL ; Get string,save 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,$00 ; 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 + + +; return the value of a numeric 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 + defb ')' +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,$00 ; 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 + defb ',' + 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 + defb ',' + 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 + + +; activate a Non-Maskable Interrupt hooked to VDP interrupt signal +; address must point to an ISR routine that terminates with EI/RETN instructions +NMI: call GETNUM ; Get memory address + call DEINT ; get integer -32768 to 32767 + ld A,E ; check if address is 0 + or D + jr NZ,NM1 ; no, so jump over +DISNMI: di ; disable INTs + call NMIDINT ; disable VDP INT + push HL ; store HL + ld HL,$45ED ; these are the op-codes for "RETN" + ld (NMIUSR),HL ; store RETN + xor A + ld (NMIUSR+2),A ; "NOP" + jr NMI2 ; execute the last part of code +NM1: push HL ; store current HL + ex DE,HL ; move address argument into HL + di ; disable INTs + call NMIDINT ; disable VDP INT, if enabled + ld A,$C3 ; "jp" instruction + ld (NMIUSR),A ; store it + ld (NMIUSR+1),HL ; store address + call NMIEINT ; re-enable VDP INT +NMI2: ei ; re-enable INTS + nop ; wait for INTs + pop HL ; retrieve HL + ret ; return to caller +; enable VDP INT +NMIEINT:call NMIVR1 ; load default VReg #1 setting + or %00100000 ; enable VDP INT + jr NMIINT ; rest of code is shared +; disable VDP INT +NMIDINT:call NMIVR1 ; load default VReg #1 setting +NMIINT: push DE ; store DE + ld E,A ; move value into E + ld A,$01 ; VREG #1 + di ; disable INTs + call WRITE_VREG ; disable VDP INT + ei ; re-enable INTs + nop ; wait for INTs being enabled + pop DE ; retrieve DE + ret ; return to caller + +; load VREG #1 setting for current screen mode and return it into A +NMIVR1: push HL ; store HL + push DE ; store DE + ld A,(SCR_MODE) ; check screen mode + add A,A ; multiply A by 8... + add A,A ; ...so that reg. A can points.. + add A,A ; to the correct settings + inc A ; need to change VREG 1 + ld E,A ; copy A into E + ld D,$00 ; reset D + ld HL,VDPMODESET ; pointer to register #1 setting... + add HL,DE ; ...for current screen mode + ld A,(HL) ; load current setting + pop DE ; retrieve DE + pop HL ; retrieve HL + ret ; return to caller + +; execute a machine language routine, eventually passing a param into A +SYS: call GETNUM ; Get memory address + call DEINT ; Get integer -32768 to 32767 + ld (TMPBFR2),DE ; store user routine's address + xor A ; reset A + ld (TMPBFR1),A ; store into temp buffer + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; check next character + jr Z,NOSYSPR ; jump if nothing follows + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get byte value (0~255) if something follows + ld (TMPBFR1),A ; store into temp buffer +NOSYSPR:ld A,(TMPBFR1) ; recover A + ld DE,(TMPBFR2) ; recover user routine's address + push HL ; save code string address + ex DE,HL ; move user routine's address into HL + ld DE,SYSRET ; set point of return after the user routine + push DE ; store into stack + jp (HL) ; call user routine +SYSRET: pop HL ; retrieve code string address + ret ; return to caller + + +; read the contents of a RAM location +PEEK: call DEINT ; Get memory address into DE + ld A,(DE) ; Read value of memory cell + jp PASSA ; Return into A + +; read the contents of a VRAM location +VPEEK: call DEINT ; Get VRAM address into DE + ex DE,HL ; Copy param into HL + di ; Disable interrupts + call READ_VIDEO_LOC ; Read data from VRAM at address HL + ei ; Re-enable interrupts + ex DE,HL ; Restore HL + jp PASSA ; Return value into A + +; recover params for POKE/VPOKE commands +; returns address into DE and byte to be written into A +PKEPRMS:call GETNUM ; Get memory address + call DEINT ; Get integer -32768 to 32767 + ld (TMPBFR1),DE ; Store DE into a temp. buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; Get integer 0-255 + ld DE,(TMPBFR1) ; Restore memory address + ret ; Return to caller + +; write a byte into a RAM location +POKE: call PKEPRMS ; Get params: address and value, return into DE and A, resp. + ld (DE),A ; Load it into memory + ret + +; write a byte into a VRAM location +VPOKE: call PKEPRMS ; Get params: address and value, return into DE and A, resp. + ex DE,HL ; Copy address into HL + di ; Disable interrupts + call WRITE_VIDEO_LOC ; write data into VRAM at address HL + ei ; Re-enable interrupts + ex DE,HL ; Restore HL + ret ; Return to caller + +; position the cursor at a specific X,Y location onto screen +LOCATE: call GETINT ; get the first param into A + push HL ; store HL + ld HL,SCR_SIZE_W ; load address of screen width + ld E,(HL) ; load screen width into E + pop HL ; restore HL + cp E ; compare witdh with param + jp NC,FCERR ; value over the width of the screen, exit with Illegal F.C. error + ld (TMPBFR1),A ; Store X into a temp. buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; Get the second param into A + push HL ; store HL + ld HL,SCR_SIZE_H ; load address of screen width + ld E,(HL) ; load screen width into A + pop HL ; restore HL + cp E ; compare witdh with param + jp NC,FCERR ; value over the height of the screen, exit with Illegal F.C. error + ld (SCR_CUR_NY),A ; store new Y + ld A,(TMPBFR1) ; recover the new X + ld (SCR_CUR_NX),A ; store new X + push HL ; store HL + di ; disable INTs + call MOVCRS ; move cursor to new location + ei ; re-enable INTs + pop HL ; restore HL + ret ; return to caller + +; write a byte into one of the PSG registers +SREG: call GETINT ; Get register number back into A + cp $10 ; check if value >= 16 (PSG registers go from 0 to 15) + jp NC,FCERR ; If yes, exit and raise an Illegal function call Error + ld (TMPBFR1),A ; Store A into a temp. buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get second value (0-255), returned into A + ld E,A ; store value into E + ld A,(TMPBFR1) ; recover VDP register and store into D + di ; disable INTs + ld C,PSG_REG ; output port to access PSG registers + out (C),A ; send register # to PSG + ld C,PSG_DAT ; output port to send data to PSG + out (C),E ; send byte to write into selected register + ei ; re-enable INTs + ret ; return to caller + +; VOLUME ch,vol +; set the volume for the audio channels +; "ch" is 1~3 for corresponding channel, or 0 for all; "vol" is 0~15 (0=OFF, 15=MAX) +VOLUME: call GETINT ; get integer 0-255 (recover channel) + cp $04 ; check if it's in the range 0~3 + jp NC,FCERR ; if not, exit with Illegal function call error + ld (TMPBFR1),A ; Store A into a temp. buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get integer 0-255 (recover channel) + cp $10 ; check if it's in the range 0~15 + jp NC,FCERR ; if not, exit with Illegal funcion call + ld D,A ; store volume into D + ld A,(TMPBFR1) ; retrieve channel + and A ; is it 0? (0=every channel) + jr NZ,VOLCH ; no, jump over + ld B,$03 ; yes, set every channel + ld E,$08 ; register volume of first channel +RPVOLCG:ld C,PSG_REG ; PSG register port + out (C),E ; set register # + ld C,PSG_DAT ; PSG data port + out (C),D ; send volume + inc E ; next register + djnz RPVOLCG ; repeat for each channel + ret ; return to caller +VOLCH: ld C,PSG_REG ; PSG register port + add $07 ; add 7 to A so that we have the correct register (1->8, 2->9, 3->10) + out (C),A ; set register + ld C,PSG_DAT ; PSG data port + out (C),D ; send volume level + ret ; return to caller + +; SOUND ch,tone,dur +; play a tone or noise of "tone" frequency from selected channel "ch" for duration "dur" +; "ch" is 1~6 (0=means sound OFF,1~3 for tone, 4~6 for noise) / "tone" is 1~4,095 (0=means no tone) / +; "dur" is 1~16383 h.o.s.,0.001~163s (0=means non-stop tone) +SOUND: call GETINT ; get integer 0-255 (recover channel) + and A ; is it zero? + jr NZ,CTSNDC ; no, continue with checking of params + push HL ; store HL + di ; disable INTs + call CLRPSGREGS ; yes, it's zero, so reset PSG registers to shut down every sound + ei ; re-enable INTs + pop HL ; retrieve HL + ret ; return to caller +CTSNDC: ld (TMPBFR1),A ; no, continue by storing A into a temp. buffer + cp $04 ; is channel >3? + jp NC,NOISUP ; Yes - check to see if it's a noise channel + call CHKSYN ; No, continue checking by making sure ',' follows + defb ',' + call GETNUM ; Get tone frequency + call DEINT ; Get integer -32768 to 32767 + ld (TMPBFR2),DE ; Store frequency + call CHKSYN ; Make sure ',' follows + defb ',' + call GETNUM ; Get duration + call DEINT ; Get integer -32768 to 32767 + ld (TMPBFR3),DE ; Store duration + ; CHECK CHANNEL + ld A,(TMPBFR1) ; recover channel + cp $01 ; is channel <1? + jp C,FCERR ; Yes - Illegal function call error + ; CHECK FREQUENCY + ld DE,(TMPBFR2) ; restore frequency from temp buffer + ld A,D ; move D into A and check if it is in the range 0~4095... + cp $10 ; ...so D must not be greater than $0F (15) + jp NC,FCERR ; if not in the range, exit with an Illegal function call error + ; CHECK DURATION + ld DE,(TMPBFR3) ; restore duration from temp buffer + ld A,D ; check if it is in the range 0~16383... + and $C0 ; ...(15th & 14th bits must not be set) + jp NZ,FCERR ; if not in the range, exit with an Illegal function call error + ; + ; SET TONE: + ; let's start by setting up the channel + ld A,(TMPBFR1) ; restore channel value + cp $03 ; is it 3? + jr NZ,SND1 ; no, jump over + ld A,%00000100 ; yes, for ch.3, set 3rd bit only (so A=001, B=010, C=100) +SND1: cpl ; complement of A - this is used later to set on the channel into the mixer + call WRTSND ; enable line into mixer of channel stored in A + ; SET FREQUENCY + ; we simply get frequency and subtract from 4096. The result + ; is put into register pair of the corresponding freq tone channel + ld DE,(TMPBFR2) ; restore frequency from temp buffer + push HL ; store HL (it will be used by the subroutine) + ld HL,$1000 ; load 4096 into HL + and A ; reset C flag + sbc HL,DE ; subtract freq from HL - now the frequency is inverted, so we will send the low as high and vice-versa + ld A,(TMPBFR1) ; restore channel value + dec A ; set A into the range 0~2 + add A,A ; double A to find the register pair that correspond to the channel (A->0,1 / B->2,3, C->4,5) + ld C,PSG_REG ; PSG register port + out (C),A ; select first register of the pair + ld C,PSG_DAT ; PSG data port + out (C),L ; send high byte + ld C,PSG_REG ; PSG register support + inc A ; second register of the pair + out (C),A ; select register + ld C,PSG_DAT ; PSG data port + out (C),H ; send low byte + ld DE,(TMPBFR3) ; recover duration + ld A,(TMPBFR1) ; recover channel value + dec A ; set channel into the range 0~2 + add A,A ; double A to find the correct offset + ld HL,CHASNDDTN ; set duration into... + add A,L ; ...the proper... + jr NC,SNDOVR ; (is there a rest? no, jump over + inc H ; yes, increment H) +SNDOVR: ld L,A ; ...register pair... + ld (HL),E ; ...and store the value + inc HL + ld (HL),D + pop HL ; retrieve HL + ret ; Return to caller +NOISUP: cp $07 ; is channel in range 4 to 6 (for a noise)? + jp NC,FCERR ; no, so ILLEGAL FUNCTION CALL + call CHKSYN ; yes, continue checking by making sure ',' follows + defb ',' + call GETINT ; get integer 0-255 (frequency) + cp $20 ; make sure it's in range 0~31 + jp NC,FCERR ; no, so Illegal function call + ld (TMPBFR2),A ; store freq. + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; check that nothing follows + jp NZ,SNERR ; error if no empty line + ld A,(TMPBFR2) ; retrieve freq. + ld E,A ; store freq into E + ld A,(TMPBFR1) ; retrieve channel + sub $03 ; subtract 3 to get channel in range 1~3 + cp $03 ; is it 3? + jr NZ,NOS1 ; no, jump over + ld A,%00000100 ; yes, for ch.3, set 3rd bit only (so A=001, B=010, C=100) +NOS1: add A,A + add A,A + add A,A ; let's move A 3 bits to left + ld B,A ; store channel into B + ld A,E ; check if + and A ; freq is 0 (means that noise reproduction must be halted) + di ; disable INts + jr NZ,NOS2 ; no, so jump over + ld A,$07 ; mixer register + call SETSNDREG ; set mixer register + in A,(C) ; load current mixer value + or B ; disable noise + jr NOS3 ; continue over +NOS2: ld A,B ; recover channel + cpl ; complement of A - this is used to set on the channel into the mixer + call WRTSND ; enable line into mixer of channel stored in A + ld A,$06 ; write into noise register + call SETSNDREG ; set register into PSG + ld A,E ; load value for noise frequency + call WRTSNDREG ; write data into register $06 + ei ; re-enable INTs + ret + ; enable line into mixer of channel stored in A +WRTSND: ld B,A ; move channel into B + ld A,$07 ; mixer register + call SETSNDREG ; set mixer register + in A,(C) ; load current value + and B ; set on the channel into the mixer (remember that 0=ON) + ; example: if channel is A (1), complement of 1 is 254 (11111110). So, 255 (in case + ; the register is still unchanged after reset) is 11111111 and + ; 11111111 AND 11111110 is equal to 11111110 + ; 11111001 AND 11111110 is equal to 11111000 (in case channels B & C are ON) +NOS3: ld B,A ; store new mixer value into B + ld A,$07 ; mixer address + call SETSNDREG ; set register + ld A,B ; retrieve new mixer value from B + call WRTSNDREG ; send new value for the mixer + ei ; re-enable INTs + ret ; return to caller + +; write a byte into one of the VDP registers +VREG: call GETINT ; Get register number back into A + cp $08 ; check if value is equal or greater than 8 (VDP registers are only 8, from 0 to 7) + jp NC,FCERR ; If yes, exit and raise an Illegal function call Error + ld (TMPBFR1),A ; Store A into a temp. buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get value (0-255) + ld E,A ; store value into E + ld A,(TMPBFR1) ; recover VDP register and store into A + di ; disable INTs + call WRITE_VREG ; write value into VDP register + ei ; re-enable INTs + ret ; return to caller + +; read the VDP status register and return it into A +VSTAT: call DEINT ; Get integer -32768 to 32767 (Note: we do NOT use it) + di ; disable INTs + call READ_VSTAT ; read VDP register status + ei ; re-enable INTs + jp PASSA ; Return integer A + +; read from PSG register and return it into A +SSTAT: call DEINT ; get integer -32768 to 32767 + ld A,E ; consider LSB + cp $10 ; check if value >= 16 (PSG registers go from 0 to 15) + jp NC,FCERR ; If yes, exit and raise an Illegal function call Error + di ; disable INts + ld C,PSG_REG ; output port to set PSG register + out (C),A ; send register to read from + in A,(C) ; read register's contents and store into A + ei ; re-enable INTs + jp PASSA ; return A + +; read the temp key buffer and return the value of the current key being pressed +; can wait for the number of 100thds of second before to return +INKEY: call IDTEST ; Test for illegal direct + call DEINT ; get number param (100thds of second to wait) into DE + push BC ; store BC + ld A,(TMRCNT) ; Load current value of system timer + ld B,A ; move it into B +CMP_A: ld A,(TMRCNT) ; make a little delay of 1/100 sec... + cp B ; ...to let the sniffer collect... + jr NZ,CMP_A ; ...at least 1 char before to continue + ld A,D ; check the param + or E ; if DE<>0 then... + jr NZ,INKEY2 ; ...jump over... + ld A,(TMPKEYBFR) ; ...else read the buffer and... + jr ENDINK ; ...return it +INKEY2: ld A,D ; check if param>1023 + cp $04 ; to do this we check if MSB>3 + jp NC,FCERR ; if MSB >=4 then error + push HL ; store HL + ld HL,$0009 ; check if value + call CMP16 ; is < 10 + pop HL ; retrieve HL + jp C,SRTINK ; if value >= 10 then jump over + ld DE,$000A ; else, use 10 (no intervals shorter than 10/100s) +SRTINK: ld A,(TMRCNT) ; Load the first byte of the system timer + ld B,A ; move it into B +CHKINK: ld A,(TMPKEYBFR) ; load char code from buffer + and A ; is it 0? + jr NZ,ENDINK ; no, so we can return it + ld A,(TMRCNT) ; load the first byte of the system timer + cp B ; is it the same value? + jr Z,CHKINK ; yes, so read again + ld B,A ; store new value + dec DE ; no, decrement timer + ld A,D ; check if zero reached + or E ; by ORing D and E + jr NZ,CHKINK ; if not 0, repeat +ENDINK: pop BC ; restore BC + push AF ; store A + di ; disable INTs + xor A ; clear the... + ld (TMPKEYBFR),A ; ...TMP KEY buffer for the next read + ei ; re-enable INTs + pop AF ; retrieve A + jp PASSA ; return A as ASCII value + + +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 + defb $21 ; 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,$01 ; 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 $08 ; 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 %10000000 ; 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,$80 ; 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,$00 ; Clear underflow +SCALLP: sub $08 ; 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,$00 ; <- 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: defb $00,$00,$00,$81 ; 1.00000 + +LOGTAB: defb $03 ; Table used by LOG + defb $AA,$56,$19,$80 ; 0.59898 + defb $F1,$22,$76,$80 ; 0.96147 + defb $45,$AA,$38,$82 ; 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,$8035 ; BCDE = SQR(1/2) + ld DE,$04F3 + 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,$8080 ; BCDE = -0.5 + ld DE,$0000 + call FPADD ; Subtract 0.5 from FPREG + pop AF ; Restore scale factor + call RSCALE ; Re-scale number +MULLN2: ld BC,$8031 ; BCDE = Ln(2) + ld DE,$7218 + defb $21 ; 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,$00 ; 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,$0000 ; 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,$08 ; 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 + + +; WORKING –– +DINT: pop BC ; Get number from stack + pop DE + call DVBCDE ; get BCDE/FPREG and store result into FPREG + jp INT ; return INT(FPREG) + + +; A MODULO B - return remainder of the integer division A/B where: +; A is in stack; B is in FPREG +; math is: +; A=INT(A); B=INT(B); R=A-(B*INT(A/B)) +MOD: call INT ; B=INT(B) + call BCDEFP ; copy B (from FPREG) into BCDE + ld (TMPBFR3),DE ; store B into... + ld (TMPBFR4),BC ; ...a temp buffer + pop BC ; recover A... + pop DE ; ...from stack + call FPBCDE ; store A into FPREG + call INT ; get integer part: A=INT(A) + call BCDEFP ; copy A (from FPREG) into BCDE + ld (TMPBFR1),DE ; store A into... + ld (TMPBFR2),BC ; ...a temp buffer + ; begin calculation + ld HL,(TMPBFR3) ; move B... + ld (FPREG),HL ; ...from... + ld HL,(TMPBFR4) ; ...temp buffer... + ld (FPREG+2),HL ; ...into FPREG + call DVBCDE ; compute A/B and store into FPREG + call INT ; get integer part of result: now FPREG = INT(A/B) + ld DE,(TMPBFR3) ; load B... + ld BC,(TMPBFR4) ; ...into BCDE + call FPMULT ; get B*INT(A/B) and store into FPREG + ld DE,(TMPBFR1) ; retrieve A from... + ld BC,(TMPBFR2) ; ...temp buffer + jp SUBCDE ; return result of A-(B*INT(A/B)) + + +DIV10: call STAKFP ; Save FPREG on stack + ld BC,$8420 ; BCDE = 10. + ld DE,$0000 + 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,$00 ; 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 + defb $D2 ; 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,$80 ; 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,$02 ; 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 + defb 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,$80+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),$80 ; 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 $80 ; 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 + +; store F.P. number from BCDE into (FPREG) +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 + +; load F.P. number from (FPREG) into BCDE +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 + +; move floating point from (FPREG) into (HL) +FPTHL: ld DE,FPREG ; Point to FPREG +DETHL4: ld B,$04 ; 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,$80+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,$00 ; 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 $80+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),$80+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,$0000 ; Clear partial product + ld A,B ; Test multiplier + or C + ret Z ; Return zero if zero + ld A,$10 ; 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,$80+24 ; 24 bits + call RETINT ; Return the integer + ld HL,PRNUMS ; Print number string + push HL ; Save for return +; conmvert FP number into ASCII chars +NUMASC: ld HL,PBUFF ; Convert number to ASCII + push HL ; Save for return + call TSTSGN ; Test sign of FPREG + ld (HL),SPC ; 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,$9143 ; BCDE - 99999.9 + ld DE,$4FF8 + 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,$0306 ; 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 $0A ; 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,$9474 ; BCDE = 999999. + ld DE,$23F7 + 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: defb $00,$00,$00,$80 ; 0.5 + +POWERS: defb $A0,$86,$01 ; 100000 + defb $10,$27,$00 ; 10000 + defb $E8,$03,$00 ; 1000 + defb $64,$00,$00 ; 100 + defb $0A,$00,$00 ; 10 + defb $01,$00,$00 ; 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 %01111111 ; 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,$8138 ; BCDE = 1/Ln(2) + ld DE,$AA3B + call FPMULT ; Multiply value by 1/LN(2) + ld A,(FPEXP) ; Get exponent + cp $80+8 ; Is it in range? + jp NC,OVTST1 ; No - Test for overflow + call INT ; Get INT of FPREG + add A,$80 ; For excess 128 + add A,$02 ; 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,$0000 ; Zero LSBs + pop BC ; Scaling factor + ld C,D ; Zero MSB + jp FPMULT ; Scale result to correct value + +EXPTAB: defb $08 ; Table used by EXP + defb $40,$2E,$94,$74 ; -1/7! (-1/5040) + defb $70,$4F,$2E,$77 ; 1/6! ( 1/720) + defb $6E,$02,$88,$7A ; -1/5! (-1/120) + defb $E6,$A0,$2A,$7C ; 1/4! ( 1/24) + defb $50,$AA,$AA,$7E ; -1/3! (-1/6) + defb $FF,$FF,$7F,$7F ; 1/2! ( 1/2) + defb $00,$00,$80,$81 ; -1/1! (-1/1) + defb $00,$00,$00,$81 ; 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 + defb 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 + + +; random number generator +; a negative argument is used as a seed for the RNG +; 0 is used to repeat the last random number +; a positive argument generates a new random number +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 %00000111 ; 0 to 7 + ld B,$00 + 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 %00000011 ; 0 to 3 + ld B,$00 + cp $01 ; 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 %01001111 ; Fiddle around + ld C,A ; New MSB + ld (HL),$80 ; Set exponent + dec HL ; Point to MSB + ld B,(HL) ; Get MSB + ld (HL),$80 ; Make value -0.5 + ld HL,SEED ; Random number seed + inc (HL) ; Count seed + ld A,(HL) ; Get seed + sub $AB ; 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: defb $68,$B1,$46,$68 ; Table used by RND + defb $99,$E9,$92,$69 + defb $10,$D1,$75,$68 + +; COS and SIN functions +COS: ld HL,HALFPI ; Point to PI/2 + call ADDPHL ; Add it to PPREG +SIN: call STAKFP ; Put angle on stack + ld BC,$8349 ; BCDE = 2 PI + ld DE,$0FDB + 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: defb $DB,$0F,$49,$81 ; 1.5708 (PI/2) + +QUARTR: defb $00,$00,$00,$7F ; 0.25 + +SINTAB: defb $05 ; Table used by SIN + defb $BA,$D7,$1E,$86 ; 39.711 + defb $64,$26,$99,$87 ;-76.575 + defb $58,$34,$23,$87 ; 81.602 + defb $E0,$5D,$A5,$86 ;-41.342 + defb $DA,$0F,$49,$83 ; 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,$8100 ; 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: defb $09 ; Table used by ATN + defb $4A,$D7,$3B,$78 ; 1/17 + defb $02,$6E,$84,$7B ;-1/15 + defb $FE,$C1,$2F,$7C ; 1/13 + defb $74,$31,$9A,$7D ;-1/11 + defb $84,$3D,$5A,$7D ; 1/9 + defb $C8,$7F,$91,$7E ;-1/7 + defb $E4,$BB,$4C,$7E ; 1/5 + defb $6C,$AA,$AA,$7F ;-1/3 + defb $00,$00,$00,$81 ; 1/1 + + +GETINP: rst $10 ; input a character + ret + +CLS: push HL + push DE + ld A,(SCR_MODE) ; check screen mode + cp $02 ; G2 mode? + call Z,EMPTYVIDBUF ; yes, reset video buffer + pop DE + pop HL + ld A,CS ; ASCII Clear screen + call SND2VID ; send to screen + jp MONOUT ; Output character + +WIDTH: call GETINT ; Get integer 0-255 + ld A,E ; Width to A + ld (LWIDTH),A ; Set width + ret + + +; read a word (2 bytes) from a couple of RAM locations, in little-endian format +; i.e., the first location is the LSB, while the second one is the MSB +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 + +; write a word (2 bytes) into a couple of RAM locations, in little-endian format +; i.e., the LSB will go into the first location, while the MSB into the second one +DOKE: call GETNUM ; Get a number + call DEINT ; Get integer -32768 to 32767 + push DE ; Save address + call CHKSYN ; Make sure ',' follows + defb ',' + 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 + +; stop the execution of code for a certain bit of time. The pause +; is between $0000 and $FFFF 100ths of a second (0~655.5 secs) +PAUSE: call GETNUM ; Get a number + call DEINT ; Get integer -32768 to 32767 + ld A,D ; load D into A + or E ; are D & E equal to $00? + ret Z ; if yes, then return + ld A,(TMRCNT) ; Load current value of system timer + ld B,A ; move it into B +RPTPS: call TSTBRK ; Test for break key + ld A,(TMRCNT) ; Load current value of system timer + cp B ; is it the same value? + jr Z,RPTPS ; yes, so read again + ld B,A ; no, so store the new value + dec DE ; decrement interval + ld A,D ; load D into A + or E ; check if DE is equal to 0 (if D & e are $00 then result is 0) + jr NZ,RPTPS ; no, repeat + ret + +; change the screen mode and set some graphic features. Usage: SCREEN X[,Y][,Z] +; where X is graphic mode: +; 0=text mode (40x24), 1=graphic mode 1 (32x24 chars); 2=graphic mode 2 (256x192 pixels); +; 3=multicolor mode (64x48 pixels); 4=extended graphic mode 2 (32x24 chars mixed between G1 and G2) +; Y is: 0=8x8 sprites, 1=16x16 sprites +; Z is: 0=no sprite magnification; 1=sprite magnification x2 (8x8=>16x16, and 16x16=32x32) +; (the latters are accepted only in graphic modes G1, G2, G3, and G4) +SCREEN: xor A + ld (TMPBFR2),A ; sprite size & magnif. byte set to 0 + call GETINT ; Get integer 0-255 + cp $05 ; is it a valid mode (0~4)? + jp NC,FCERR ; No - Illegal function call Error + ld (TMPBFR1),A ; store graphic mode + and A ; is it 0 (text mode)? + jp Z,SCVDP ; yes, ignore other arguments and set mode immediately + call CHKSCAR ; no, check if sprite size follows + jp C,CKMAGN ; no (set to 0 or missing), so jump over + ld A,$02 ; no, so set sprite size + ld (TMPBFR2),A ; ...to 16x16 +CKMAGN: call CHKSCAR ; check if sprite magnification follows + jp C,SCVDP ; no (set to 0 or missing), so jump over + ld A,(TMPBFR2) ; yes, so retrieve sprite attributes... + or $01 ; ...set sprite magnification to 2x... + ld (TMPBFR2),A ; ...and save flags again +SCVDP: di ; disable INTs + push HL ; store HL + ld A,(TMPBFR1) ; recover graphic mode + ld E,A ; and store it into E + ld A,(TMPBFR2) ; recover sprite flags + ld D,A ; and store them into D + push DE ; store D & E + call initVDP ; initialize VDP with mode pointed by E + pop DE ; retrieve D & E + ld A,E ; move graphic mode into A + add A,A + add A,A + add A,A ; multiply A times 8 to get offset of graphic mode + ld E,A ; and pass it into E + push DE ; store sprite flags in E + ld D,$00 ; reset D + ld HL,VDPMODESET+1 ; load address of VDP settings for reg#1 + add HL,DE ; load correct reg#1 setting + pop DE ; retrieve sprite flags from E + ld A,(HL) ; load reg#1 setting + and %11111100 ; reset size & magn. bits + or D ; set size & magn. bits + ld E,A ; value into E + ld A,$01 ; reg #1 + call WRITE_VREG ; send setting to reg #1 + ld HL,(LINEAT) ; Get current line number + inc HL ; -1 means direct statement + ld A,H + or L + call Z,CURSOR_ON ; enable cursor if not in program mode + ei ; re-enable interrupts + pop HL ; restore HL + ld A,(SCR_SIZE_H) ; check the screen mode by looking at the screen height + cp $30 ; is it 48 chars or 192 pixels (MC and G2 modes)? + ret NC ; yes, so exit (in graphics 2 and multicolor no print-on-video) + ld A,$01 ; no (we are in Text, G1 or ExG2), so activate the... + ld (PRNTVIDEO),A ; ...video buffer... + ret ; ...and return to caller + +; check an additional argument for SCREEN - There are 2 ways of working: +; to check if something follows: Carry is 1 is no argument follows, 0 otherwise +; to check the value of the following argument: 0 is argument is 1, 1 is argument is <> 1 +CHKSCAR:dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + scf ; set carry flag + ret Z ; return if nothing follows with Carry=1 + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get value + rra ; Carry=bit #0 + ccf ; invert Carry, so Carry=0 if arg. is 1, and Carry=1 otherwise (arg<>1) + ret ; return + + +; change the colors of the screen - Syntax is COLOR a,b,c where: +; a=foreground color / b=background color / c=border color +; a,b,c must be in a range between 1 and 15 (0 is transparent and it's not supported) +; the number of arguments is based on the current screen mode +COLOR: call GETINT ; get first value + call CHKCLR1 ; check if it's in range 1~15 + ld (TMPBFR1),A ; store it + ld A,(SCR_MODE) ; check screen mode + cp $03 ; is it multicolor mode? + jr NZ,CNTCKCL ; no, continue + ld A,$0F ; white for... + ld (FRGNDCLR),A ; ...foreground (even it's not used in MC) + ld A,(TMPBFR1) ; yes, so we stop here because in MC mode we just support border color + ld (TMPBFR3),A ; move color into temp buffer 3 + jr CLRMC ; jump to set color +CNTCKCL:call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get second value + call CHKCLR1 ; check if it's in range 1~15 + ld (TMPBFR2),A ; store it + ld A,(SCR_MODE) ; check screen mode + and A ; is it text mode? + jr Z,CLRTXT ; yes, stop here because in text mode, background and border colors coincide + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get third value + call CHKCLR1 ; check if it's in range 1~15 + ld (TMPBFR3),A ; store it + ld A,(SCR_MODE) ; check screen mode + cp $01 ; is it G1 mode? + jr Z,CLRG1 ; yes, jump over + cp $02 ; is it G2 mode? + jr Z,CLRG2 ; yes, jump over + jr CLREX2 ; last case can only be ExG2 +CLRTXT: call MIXCLRS ; mix foreground and background color nibbles in 1 byte +CLRMC: ld (TMPBFR3),A ; store color settings (for MC mode, we only set border color) + di ; disable INTs + jr SETBRCL ; set colors and exit +CLRG1: call MIXCLRS ; mix foreground and background color nibbles in 1 byte + ld D,$01 ; repeat 1 time + ld B,$20 ; 32 bytes of colors + jr LOADCLR ; load colors +CLRG2: call MIXCLRS ; mix foreground and background color nibbles in 1 byte + ld D,$18 ; 18 pages of... + ld B,$00 ; ...256 bytes each + jr LOADCLR ; load colors +CLREX2: call MIXCLRS ; mix foreground and background color nibbles in 1 byte + ld D,$08 ; 8 pages of... + ld B,$00 ; ...256 bytes each +LOADCLR:push HL ; store HL + ld HL,$2000 ; color table start: $2000 + di ; disable INTs + call SETVDPADRS + dec C ; VDP data mode +RPTLDCL:out (C),A ; after first byte, the VDP autoincrements VRAM pointer + nop + nop + djnz RPTLDCL ; repeat for 256 bytes (1 page) + dec D ; did we fill up all the pages? + jr NZ,RPTLDCL ; no, repeat + ei + pop HL ; retrieve HL +SETBRCL:ld A,(TMPBFR1) ; retrieve foreground color + ld (FRGNDCLR),A ; store it + ld A,(TMPBFR2) ; retrieve background color + ld (BKGNDCLR),A ; store it + ld A,(TMPBFR3) ; recover border color + ld E,A ; move it into E + ld A,$07 ; set VDP register 7 + di + call WRITE_VREG ; send value to VDP: set border color + ei ; re-enable INTs + ret ; return to caller + + +; mix 2 color nibbles in 1 byte +MIXCLRS:ld A,(TMPBFR2) ; retrieve background color + ld B,A ; move it into B + ld A,(TMPBFR1) ; retrieve foreground color + add A,A ; move foreground color into the high nibble of A + add A,A + add A,A + add A,A + or B ; put background color into the low nibble of A + ret ; return to caller + + +; check if the color is not 0 and into the range 1~15 +CHKCLR1:and A ; is it 0? + jp Z,SNERR ; yes, raise a SN error +CHKCLR0:cp $10 ; is it in range 0~15? + jp NC,SNERR ; no, raise a SN error + ret ; param is OK, can return + + +; check if in graphics 2 mode +CHKG2M: ld A,(SCR_MODE) ; check screen mode + cp $02 ; actually, we can paint only in G2 + jp NZ,GMERR ; no G2, print a No Graphics Mode Error + ret ; return to caller + + +; print a text in screen 2 +; GPRINT text,x,y[,fc[,bc]] +; where "text" is an expression that can be converted into a sequence of ASCII chars, +; x & y are the coordinates (0<=x<=31, 0<=y<=23), fc & bc are foreground and background +; colors (1~15), resp. +; (portions of code are from nippur72) +GX equ TMPBFR3 +GY equ TMPBFR4 +TMPCLR equ TMPBFR2 +MIXCOL equ TMPBFR1 +TMPADR equ VIDEOBUFF +CHRPNT equ VIDEOBUFF+$02 +NUMCHR equ VIDEOBUFF+$04 +TMPHL equ VIDEOBUFF+$06 +GPRINT: call CHKG2M ; check if in graphic mode 2 + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; check if something follows + jp Z,SNERR ; if nothing else, raise a syntax error + ld (TMPADR),HL ; save current code string pointer + call EVAL ; Evaluate expression + call TSTSTR ; Make sure it's a string + ld (TMPHL),HL ; store code string pointer + call GSTRCU ; Current string to pool + call LOADFP ; Move string block to BCDE (BC=pointer, E=length) + ld (CHRPNT),BC ; store string pointer + ld (NUMCHR),DE ; store string lenght + ld HL,(TMPHL) ; restore code string pointer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get X coord. + cp $20 ; is it in rage 0~31? + jp NC,FCERR ; Illegal function call error + ld (GX),A ; store into temp. buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y coord. + cp $18 ; is it in range 0~23? + jp NC,FCERR ; Illegal function call error + ld (GY),A ; store into temp. buffer + ld DE,TMPCLR + ld A,(BKGNDCLR) ; load background color + ld (DE),A ; store into temp buff + ld A,(FRGNDCLR) ; load foreground color + dec DE + dec DE + ld (DE),A ; store into temp buff + call CKCOL ; check color + jp Z,CNTGPT2 ; if anything follows, jump over + inc DE + inc DE + call CKCOL ; check background color +CNTGPT2:call MIXCLRS ; mix foreground & background colors + ld (MIXCOL),A ; store mixed colors + push HL ; store code string address + ld BC,(CHRPNT) ; retrieve string pointer + ld DE,(NUMCHR) ; retrieve string lenght + inc E ; Length + 1 + call GPNT ; print on G2 + pop HL ; recover HL + ret ; return to caller +GPNT: push DE ; store string lenght (E) + ; calculate VRAM address of first char + LD A,(GX) ; load X + ld L,A ; + ld H,0 ; HL = X + add HL,HL ; + add HL,HL ; + add HL,HL ; X=X*8 + ld A,(GY) ; load Y + ld D,A ; move it into D + ld E,0 ; DE =Y*256 + add HL,DE ; address = X*8 + Y*256 + ld (TMPADR),HL ; store VRAM address of first VRAM cell + pop DE ; retrieve # of chars to be printed yet (E) +RPGPNT: dec E ; Count characters + ret Z ; End of string - return + push DE ; store chars counter + ; calculate dest address in color vram + ld HL,(TMPADR) ; recover VRAM address + ld DE,$2000 ; color map address + add HL,DE ; HL = $2000 + XY address + di ; disable INTs + ; send color settings + call SETVDPADRS ; set VRAM address for color cell + ld A,(MIXCOL) ; load color settings + ld B,$08 ; repeat for 8 rows + ld C,VDP_DAT ; VDP data mode +GPNTCO1:out (C),A ; send data (VRAM pointer auto-increments) + nop ; wait... + nop ; ...a... + nop ; ...while + djnz GPNTCO1 ; repeat for 8 cells + ; calculate source address + ld HL,(CHRPNT) ; load char pointer + ld A,(HL) ; get char + inc HL ; increment char pointer + ld (CHRPNT),HL ; store char pointer + ld L,A ; + ld H,$00 ; char into HL + add HL,HL ; + add HL,HL ; + add HL,HL ; get offset of char into ROM (charcode * 8) + ld DE,CHRST88 ; DE = start of 8x8 fonts in ROM + add HL,DE ; HL = start of characters in ROM + ex DE,HL ; store address into DE + ld HL,(TMPADR) ; load VRAM address + call SETVDPADRS ; send it to VDP + ex DE,HL ; restore address into HL + ld B,$08 ; repeat for 8 rows + dec C ; VDP data mode +GPCPCH1:outi ; load a byte from ROM and send to VRAM + nop ; wait... + nop ; ...a... + nop ; ...while + jr NZ,GPCPCH1 ; repeat for 8 chars + ei ; re-enable INTs + ld DE,$0008 ; 8 bytes to go to the next video cell + ld HL,(TMPADR) ; load VRAM address + add HL,DE ; get address of next VRAM cell + ld (TMPADR),HL ; store new VRAM address + ld DE,$1800 ; forbidden address + call CMP16 ; check if the printing has gone out of the screen + pop DE ; retrieve number of chars to be printed + ret NC ; if HL>=$1800 then leave + jp RPGPNT ; otherwise, check if more chars to output + +; used by GPRINT to get a color argument (if present) +CKCOL: dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + ret Z ; return if nothing follows + call CHKSYN ; Make sure ',' follows + defb ',' + push DE ; store DE + call GETINT ; get value + call CHKCLR1 ; check if color is in range 1~15 + pop DE ; retrieve DE + ld (DE),A ; store color into temp buffer + ret ; return to caller + + +; paint X,Y[,C]: in graphics mode, fills an area starting +; at point X,Y, using default color or, if used, with +; color set by C +; TMPBFR1 X +; TMPBFR2 Y +; TMPBFR3 COLOR +PNT equ VIDEOBUFF +ORGSP equ VIDEOBUFF+$02 +PAINT: call CHKG2M ; check if in graphic mode 2 + call GETINT ; get X + ld (TMPBFR1),A ; store X + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y coords, + cp $C0 ; check if Y is in range 0~191 + jp NC,FCERR ; no, raise an FC error + ld (TMPBFR2),A ; store Y + call CLRPRM ; check if color has been passed + ld A,(TMPBFR3) ; load color + and A ; check if 0 + jp Z,FCERR ; yes, raise an error + push HL ; store HL + ; start algorithm + call PNTRTN ; check if pixel is already set + jp NZ,EXITPA2 ; if yes, then leave PAINT + ld (ORGSP),SP ; no, store current Stack Pointer + ld HL,$0001 ; HL=1 + ld (PNT),HL ; set PNT + ld A,(TMPBFR1) ; load starting X... + ld B,A ; ...into B + ld A,(TMPBFR2) ; load starting Y... + ld C,A ; ...into C + push BC ; store starting X,Y into stack + ; main loop +NXTLOOP:ld HL,(PNT) ; retrieve PNT + ld A,H ; check if PNT=0 + or L + jp Z,EXITPAI ; yes, no more points to process - exit + dec HL ; no, so decrement PNT... + ld (PNT),HL ; ...and store it + pop BC ; retrieve pixel coordinates X,Y into BC +PAINT0: call CHECKPA ; check if pixel is set/reset + jr NZ,PAINT11 ; pixel is set, so jump over + ld A,B ; pixel is reset, check if X1=0 + and A ; (reached the limit of the screen) + jp Z,PAINT1 ; yes, jump over + dec B ; no, decrement X1... + jp PAINT0 ; ...and repeat +PAINT11:inc B ; if found a pixel on, the re-increment X1 +PAINT1: xor A ; reset A + ld D,A ; set SA=0 + ld E,A ; set SB=0 +MNPAINT:call CHECKPA ; check if pixel is set/reset + jr NZ,NXTLOOP ; it's set, so goto next loop + ld A,B ; copy X1 + ld (TMPBFR1),A ; into buffer + ld A,C ; copy Y + ld (TMPBFR2),A ; into buffer + call CNTPLOT ; plot pixel X1,Y + ld A,D ; load SA into A + and A ; SA=0? + jr NZ,PAINT2 ; no, jump over + ld A,C ; load Y + cp $01 ; Y>0? + jp C,PAINT2 ; no, jump over + dec A ; yes, Y=Y-1 + call CHECKPY ; check pixel X1,Y-1 + jr NZ,PAINT2 ; it's set, so jump over + dec C ; Y=Y-1 + push BC ; insert pixel(X1,Y-1) into stack + inc C ; retrieve original Y + ld HL,(PNT) ; load PNT + inc HL ; increment PNT + ld (PNT),HL ; store new PNT + ld A,$01 ; set SA=1 and... + ld D,A ; ...store SA into memory + jp PAINT3 ; jump over +PAINT2: ld A,D ; load SA into A + rra ; check if SA=1 + jr NC,PAINT3 ; no, jump over + ld A,C ; load Y + cp $01 ; Y>0? + jp C,PAINT3 ; no, jump over + dec A ; Y=Y-1 + call CHECKPY ; check pixel X1,Y-1 + jp Z,PAINT3 ; if pixel is off, jump over + xor A ; pixel is on, so... + ld D,A ; ...set SA=0 +PAINT3: ld A,E ; check if... + and A ; SB=0 + jr NZ,PAINT4 ; no, jump over + ld A,C ; load Y + cp $BF ; Y<191? + jr NC,PAINT4 ; no, jump over + inc A ; Y=Y+1 + call CHECKPY ; check pixel X1,Y+1 + jr NZ,PAINT4 ; pixel is on, so jump over + inc C ; Y=Y+1 + push BC ; insert pixel(X1,Y+1) into stack + dec C ; retrieve original Y + ld HL,(PNT) ; PNT + inc HL ; PNT=PNT+1 + ld (PNT),HL ; store PNT + ld A,$01 ; SB=1 + ld E,A ; set SB + jp PAINT5 ; jump over +PAINT4: ld A,E ; load SB + rra ; check if SB=1 + jr NC,PAINT5 ; no, jump over + ld A,C ; load Y + cp $BF ; Y<191? + jr NC,PAINT5 ; no, jump over + inc A ; Y=Y+1 + call CHECKPY ; check pixel X1,Y+1 + jp Z,PAINT5 ; if pixel is off, jump over + xor A ; pixel is on, so... + ld E,A ; ...set SB=0 +PAINT5: inc B ; X1=X1+1 + jp Z,NXTLOOP ; if X1>255 (X1=0) then goto next loop + jp MNPAINT ; otherwise, repeat for next X +EXITPAI:ld SP,(ORGSP) ; retrieve original SP pointer +EXITPA2:pop HL ; retrieve HL + ret ; return to caller +CHECKPA:ld A,C ; copy Y into A +CHECKPY:ld (TMPBFR2),A ; store Y + ld A,B ; copy X1 into A + ld (TMPBFR1),A ; store X1 + push BC ; save X1,Y + push DE + call PNTRTN ; check if pixel is set/reset + pop DE + pop BC ; retrieve X1,Y + ret ; return to caller + + +; POINT(x,y): return if a pixel is set (returns color) or if it's reset (0) +POINT: call CHKG2M ; check if in graphic mode 2 + call CHKSYN ; make sure "(" follows + defb '(' + call GETINT ; get X coords. + ld (TMPBFR1),A ; store it into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y coords, + cp $C0 ; check if Y is in range 0~191 + jp NC,FCERR ; no, raise an FC error + ld (TMPBFR2),A ; store into a temp buffer + call CHKSYN ; make sure ")" follows + defb ')' + push HL ; store current string address - the point after the ")" - ... + pop IY ; ...into IY + call PNTRTN ; check if pixel is set or reset + jr NZ,CTPOINT ; it's ON, jump over + xor A ; no, it's OFF. make sure to reset A... + ld B,A ; ...and B +PNTEND: pop HL ; drop original return point + push IY ; load current string address from IY into stack + ld DE,RETNUM ; Address of Return number from function... + push DE ; ...saved on stack + jp ABPASS ; return AB +CTPOINT:set 5,H ; set to read from color VRAM (it's like adding $2000 to HL) + di + call READ_VIDEO_LOC ; load original colors of pixel + ei + srl A ; shift A... + srl A ; ...4 times... + srl A ; ...to move foreground color... + srl A ; ...into lowest nibble + ld B,A ; color into B + xor A ; reset MSB + jp PNTEND ; return AB +PNTRTN: call XY2HL ; find HL address of pixel at X,Y + ld D,A ; store pixel index + di ; disable INTs + call READ_VIDEO_LOC ; read contents of VRAM cell addressed by HL + ei ; re-enable INTs + and D ; is the pixel ON or OFF? (will be checked later) + ret ; return to caller + + +; PLOT X,Y[,color] +; plot a pixel in graphic mode 2 +PLOT: call CHKG2M ; check if in G2 mode + call GETINT ; get X coords. + ld (TMPBFR1),A ; store it into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y coords, + cp $C0 ; check if Y is in range 0~191 + jp NC,FCERR ; no, raise an FC error + ld (TMPBFR2),A ; store into a temp buffer + call CLRPRM ; check if param "color" has been passed +CNTPLOT:push HL ; store HL ** do NOT remove these PUSHs since this + push BC ; store BC ** function is called from other routines + push DE ; store DE *** + call XY2HL ; find VRAM address of byte containing pixel at X,Y & return into HL + jp NC,NOGD ; if carry is reset, there was an error -> so leave + ld D,A ; move pixel value into D + ld A,(TMPBFR3) ; retrieve color + and A ; is it 0? (background, or reset pixel) + jr NZ,CNTPLT1 ; no, continue + di ; yes - so, disable INTs + call READ_VIDEO_LOC ; load original value of VRAM cell pointed by HL + ei ; re-enable INTs + ld E,A ; store value of cell + ld A,D ; retrieve pixel + cpl ; revert bits + and E ; set video pixel to off + di ; disable INTs + call WRITE_VIDEO_LOC ; write new value into VRAM cell + ei ; re-enable INTs + jp NOGD ; leave +CNTPLT1:add A,A ; now we move low nibble + add A,A ; in the high nibble + add A,A ; by adding A to itself + add A,A ; 4 times (this is a shift left 4) + ld E,A ; move it into E + di ; disable INTs + call READ_VIDEO_LOC ; load original value of VRAM cell pointed by HL + ei + or D ; merge new pixel preserving original pattern + di + call WRITE_VIDEO_LOC ; write new value into VRAM cell + ei + set 5,H ; set to read from color VRAM (it's like adding $2000 to HL) + di + call READ_VIDEO_LOC ; load original colors of pixel + ei + and %00001111 ; reset high nibble (the foreground color) + or E ; set new foreground color + di + call WRITE_VIDEO_LOC ; write new color settings + ei ; re-enable INTs + nop ; wait for INTs to be enabled again +NOGD: pop DE ; retrieve DE + pop BC ; retrieve BC + pop HL ; retrieve HL + ret ; return to caller +PXLSET: defb $80,$40,$20,$10,$08,$04,$02,$01 ; pixel to be set ON + ; where R(X/8)=> 0=80h, 1=40h, 2=20h, 3=10h, 4=08h, 5=04h, 6=02h, 7=$01 + + +; compute the VRAM address of the byte containing the pixel +; being pointed by X,Y (TMPBFR1,TMPBFR2) +; byte address is returned into HL +; pixel is returned into A +XY2HL: ; formula is: ADDRESS=(INT(X/8))*8 + (INT(Y/8))*256 + R(Y/8) + ; where R(Y/8) is the remainder of (Y/8) + ; the pixel to be set is given by R(X/8), and data is taken from the array + ld A,(TMPBFR2) ; retrieve Y + cp $C0 ; Y>=192? + ret NC ; yes, so leave + ld E,$08 ; load E with divisor + ld D,A ; and store into D (dividend) + call DIV_8_8 ; get Y/8, D is quotient=INT(Y/8), and A is remainder + ld C,A ; store remainder into C + ld B,D ; B=(INT(Y/8))*256 (we simply copy quotient into B) + ld HL,BC ; copy BC into HL: now HL has the VRAM address of the byte being set + ld A,(TMPBFR1) ; retrieve X + ld D,A ; and move it into D (dividend) + call DIV_8_8 ; get X/8, D is quotient=INT(X/8), and A is remainder + ld C,A ; store remainder into C + ld A,D ; move quotient into A + add A,A ; multiply quotient by 8 + add A,A + add A,A + ld E,A ; store result into E + ld D,$00 ; reset D + ld B,D ; reset B + add HL,DE ; add DE to HL, getting the final VRAM address + ex DE,HL ; move VRAM address into DE + ld HL,PXLSET ; starting address of table for pixel to draw + add HL,BC ; add C (remainder of X/8) to get address of pixel to turn on + ld A,(HL) ; load pixel data + ex DE,HL ; retrieve VRAM pattern address into HL + scf ; set Carry for normal exit + ret ; return to caller + + +; DRAW X1,Y1,X2,Y2[,color] +; Draw a line using Bresenham's line algorithm from X1,Y1 to X2,Y2 +; X1,Y1 can be either less than or greater than X2,Y2 (meaning that) +; the drawing will be ever done from X1,Y2 to X2,Y2, regardless of +; the values. If color is not specified, the foreground color set +; with COLOR will be used +X1 equ TMPBFR1 +Y1 equ TMPBFR2 +X2 equ VIDEOBUFF +Y2 equ VIDEOBUFF+$02 +ER equ VIDEOBUFF+$04 +E2 equ VIDEOBUFF+$06 +SX equ VIDEOBUFF+$08 +SY equ VIDEOBUFF+$0A +DX equ VIDEOBUFF+$0C +DY equ VIDEOBUFF+$0E +DRAW: call CHKG2M ; check if in G2 mode + call CLRTMBF ; clear TMPBFRx + call CLRVDBF ; clear VIDEOBUFF + call GETINT ; get X1 coords. + ld (X1),A ; store it into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y1 coords. + cp $C0 ; check if Y1 is in range 0~191 + jp NC,FCERR ; no, raise an FC error + ld (Y1),A ; store into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get X2 coords. + ld (X2),A ; store it into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y2 coords + cp $C0 ; check if Y2 is in range 0~191 + jp NC,FCERR ; no, raise an FC error + ld (Y2),A ; store it into a temp buffer + call CLRPRM ; check for arg. "color" and store it into TMPBFR3 + push HL ; store register we'll use + ld DE,(X1) ; load X1 and + ld HL,(X2) ; X2 + or A ; clear CARRY + sbc HL,DE ; DX=X2-X1 + call absHL ; DX=ABS(DX) + ld (DX),HL ; store DX + ld BC,$FFFF ; SX=-1 + ld HL,(X1) + ld DE,(X2) + call CMP16 ; X1X2 + ld BC,$0001 ; yes, so set SX=1 +X1GR: ld (SX),BC ; store SX + ld DE,(Y1) + ld HL,(Y2) + or A ; clear Carry + sbc HL,DE ; DY=Y2-Y1 + call absHL ; DY=ABS(DY) + ld (DY),HL ; store DY + ld BC,$FFFF ; SY=-1 + ld HL,(Y1) + ld DE,(Y2) + call CMP16 ; is Y1Y2 - jump over + ld BC,$0001 ; yes, so set SY=1 +Y1GR: ld (SY),BC ; store SY + ld HL,(DY) ; ER=DY + call negHL ; ER=-DY + ld (ER),HL ; store ER + ld HL,(DX) + ld DE,(DY) + call CMP16 ; DX>DY? + jp Z,ER2 ; no, DX=DY + jp M,ER2 ; no, DXDY, so ER=DX +ER2: ld HL,(ER) ; load ER + sra H ; right shift (and preserve sign)... + rr L ; ...of HL, so ER=INT(ER/2) + bit 7,H ; is the number negative? + jp Z,STRE2 ; no, jump over + inc HL ; yes, add 1 'cos INT of a negative number needs to be incremented +STRE2: ld (ER),HL ; store ER +RPTDRW: call CNTPLOT ; plot first pixel + ld HL,(X1) + ld DE,(X2) + call CMP16 ; X1=X2? + jr NZ,CNTDRW ; no, continue drawing + ld HL,(Y1) ; yes, so check + ld DE,(Y2) ; also Y + call CMP16 ; Y1=Y2? + jp Z,ENDDRAW ; yes, finished drawing: exit +CNTDRW: ld DE,(ER) + ld (E2),DE ; E2=ER + ld HL,(DX) + call negHL ; DX=-DX + ex DE,HL ; invert DE and HL => HL=E2, DE=-DX + call CMP16 ; E2>-DX? + jp Z,DXGR ; no, E2=-DX: jump + jp M,DXGR ; no, E2<-DX: jump + ld HL,(ER) ; yes + ld DE,(DY) + or A ; clear CARRY + sbc HL,DE ; ER=ER-DY + ld (ER),HL + ld HL,(X1) + ld DE,(SX) + add HL,DE ; X1=X1+SX (increment X1) + ld (X1),HL +DXGR: ld HL,(E2) + ld DE,(DY) + call CMP16 ; E2DY: jump + ld HL,(ER) ; yes + ld DE,(DX) + add HL,DE ; ER=ER+DX + ld (ER),HL + ld HL,(Y1) + ld DE,(SY) + add HL,DE ; Y1=Y1+SY (increment Y1) + ld (Y1),HL + jp RPTDRW ; repeat +ENDDRAW:pop HL ; retrieve HL + ret ; return to caller + + +; CIRCLE X,Y,R[,C] +; Draw a circle using Bresenham's circle algorithm with center in X,Y +; and radius R, with optional color C. If color is not specified, the +; foreground color set with COLOR will be used +XC equ VIDEOBUFF +YC equ VIDEOBUFF+$02 +RADIUS equ VIDEOBUFF+$04 +XI equ VIDEOBUFF+$06 +YI equ VIDEOBUFF+$08 +DC equ VIDEOBUFF+$0A +CIRCLE: call CHKG2M ; check if in G2 mode + call CLRVDBF ; clear VIDEOBUFF + call GETINT ; get X coords. + ld (XC),A ; store it into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get Y coords, + ld (YC),A ; store it into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get radius + ld (RADIUS),A ; store it into a temp buffer + call CLRPRM ; check if param "color" has been passed + push HL ; store HL + xor A ; clear A, + ld B,A ; B, + ld C,A ; C, + ld D,A ; D, + ld H,A ; and H + ld (XI),BC ; clear XI + ld A,(RADIUS) ; load RADIUS into A + ld L,A ; HL now contains R + ld (YI),HL ; YI=RADIUS + add HL,HL ; R*2 + ex DE,HL ; put HL into DE + ld HL,$0003 ; HL = 3 + xor A ; clear Carry + sbc HL,DE ; D=3-(2*R) => HL + ld (DC),HL ; store D + call DRWCRL ; draw initial point +RPTCRL: ld DE,(XI) ; load XI + ld HL,(YI) ; load YI + call CMP16 ; is YIXI + jp ENDCRL ; yes, so we've finished +RPTCL1: ld HL,XI + inc (HL) ; XI=XI+1 + ld HL,(DC) ; load D + ld A,H + or L ; is D=0? Yes, jump over + jp Z,DLSZ + bit 7,H ; is D<0? + jr NZ,DLSZ ; yes, jump over + ld DE,(YI) ; D>0 + dec DE ; so, YI=YI-1 + ld (YI),DE ; store YI + xor A ; clear Carry + ld HL,(XI) + sbc HL,DE ; HL=XI-YI + add HL,HL + add HL,HL ; HL=HL*4 + ld DE,10 + add HL,DE ; HL=HL+10 + ld DE,(DC) ; load D + ex DE,HL ; invert DE and HL, so that HL=4*(XI-YI)+10 and DE=D + add HL,DE ; D=D+4*(XI-YI)+10 + jr PLTCRL ; plot next pixel +DLSZ: ld HL,(XI) ; load XI + add HL,HL + add HL,HL ; XI=XI*4 + ld DE,$0006 + add HL,DE + ld DE,(DC) + ex DE,HL ; HL=D and DE=4*XI+6 + add HL,DE ; D=D+4*XI+6 +PLTCRL: ld (DC),HL ; store new D + call DRWCRL ; plot pixel + jp RPTCRL ; repeat +ENDCRL: pop HL + ret ; return to caller +DRWCRL: ld HL,(XC) + ld DE,(XI) + add HL,DE ; X=XC+XI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL1 ; if Carry is set, X is not valid + ld HL,(YC) + ld DE,(YI) + add HL,DE ; Y=YC+YI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL1: xor A ; clear Carry + ld HL,(XC) + ld DE,(XI) + sbc HL,DE ; X=XC-XI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL2 ; if Carry is set, X is not valid + ld HL,(YC) + ld DE,(YI) + add HL,DE ; Y=YC+YI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL2: ld HL,(XC) + ld DE,(XI) + add HL,DE ; X=XC+XI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL3 ; if Carry is set, X is not valid + xor A ; clear Carry + ld HL,(YC) + ld DE,(YI) + sbc HL,DE ; Y=YC-YI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL3: xor A ; clear Carry + ld HL,(XC) + ld DE,(XI) + sbc HL,DE ; X=XC-XI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL4 ; if Carry is set, X is not valid + xor A ; clear Carry + ld HL,(YC) + ld DE,(YI) + sbc HL,DE ; Y=YC-YI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL4: ld HL,(XC) + ld DE,(YI) + add HL,DE ; X=XC+YI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL5 ; if Carry is set, X is not valid + ld HL,(YC) + ld DE,(XI) + add HL,DE ; Y=YC+XI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL5: xor A ; clear Carry + ld HL,(XC) + ld DE,(YI) + sbc HL,DE ; X=XC-YI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL6 ; if Carry is set, X is not valid + ld HL,(YC) + ld DE,(XI) + add HL,DE ; Y=YC+XI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL6: ld HL,(XC) + ld DE,(YI) + add HL,DE ; X=XC+YI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + jp C,CNTCL7 ; if Carry is set, X is not valid + xor A ; clear Carry + ld HL,(YC) + ld DE,(XI) + sbc HL,DE ; Y=YC-XI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel +CNTCL7: xor A ; clear Carry + ld HL,(XC) + ld DE,(YI) + sbc HL,DE ; X=XC-YI + ld (X1),HL ; store X + call VALIDX ; check if X is valid (0~255) + ret C ; if Carry is set, X is not valid + xor A ; clear Carry + ld HL,(YC) + ld DE,(XI) + sbc HL,DE ; Y=YC-XI + ld (Y1),HL ; store Y + call VALIDY ; check if Y is valid (0~191) + call NC,CNTPLOT ; if Carry is reset, Y is valid and plot the pixel + ret ; return to caller + +; check if X,Y coordinates are valid: 0<=X<=255 and 0<=Y<=191 +; input: HL (value to check), can be negative +; output: CARRY flag: reset => VALID // set => NOT VALID +; destroys: A +VALIDX: xor A ; reset A + or H ; check if H is 0 (this means that X is in range 0~255 and not negative) + ret Z ; yes, we can return (C is clear) + scf ; set Carry flag to raise error + ret ; return to caller + +VALIDY: xor A ; reset A + or H ; check if H is 0 (this means that Y is in range 0~255 and not negative) + jr Z,CNTVALY ; yes, continue checking + scf ; no, raise error by setting Carry flag + ret ; return to caller +CNTVALY:ld A,L + cp $C0 ; is Y<192? Carry is set if Y<192 + ccf ; invert Carry, so Carry=0 means OK, Carry=1 means ERROR + ret ; return to caller + + + +; cleat TMPBFR1-4 buffers before using them +CLRTMBF:xor A ; reset A + push HL ; store HL + push BC ; store BC + ld HL,TMPBFR1 ; address of 1st location + ld B,$08 ; 8 locations +RPCLTMB:ld (HL),A ; clear byte + inc HL ; next location + djnz RPCLTMB ; repeat + pop BC ; retrieve BC + pop HL ; retrieve HL + ret ; return to caller + + +; clear VIDEOBUFF before using it as temp buffer +CLRVDBF:xor A ; clear A + push BC ; store BC + push HL ; store HL + ld B,$28 ; 40 cells + ld HL,VIDEOBUFF ; address of 1st cell +RPTCVBF:ld (HL),A ; clear cell + inc HL ; next cell + djnz RPTCVBF ; repeat + pop HL ; retrieve HL + pop BC ; retrieve BC + ret ; return to caller + + +; check if a color is passed as argument with PLOT, DRAW, and CIRCLE +; commands. If not present, the default foreground color will be used +CLRPRM: ld A,(FRGNDCLR) ; load foreground color + ld (TMPBFR3),A ; store into temp buffer + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + ret Z ; return foreground color if nothing follows + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get value + call CHKCLR0 ; check if color is in range 0~15 + ld (TMPBFR3),A ; store color into temp buffer + ret ; return to caller + + +; no graphics mode error: raised when a graphics command is invoked +; out of graphic 2 mode. +GMERR: ld E,GM ; load Graphics Mode Error flag + jp ERROR ; print error + + +; set a serial port: params are PORT,BPS,DATA,PARITY,STOP +; PORT=1/2; BPS=1,200~57,600 (see below), DATA=5/6/7/8 +; PARITY: 0=no parity; 1=ODD parity; 2=EVEN parity; +; STOP=0/1/2/3: 0=0 bit; 1=1 bit; 2=1.5 bits; 3=2 bits +; PORT 1 acts as a char device; PORT 2 acts as a block device +; DATA,PARITY, and STOP are optional: if nothing follows BPS, +; they are assumed to be 8,0,1 resp. +PRTNUM equ VIDEOBUFF +BPS equ PRTNUM+$01 +DATABT equ BPS+$02 +PARBT equ DATABT+$01 +STPBT equ PARBT+$01 +SIOBFR equ STPBT+$01 +SERIAL: call GETINT ; get port # + and A ; is it zero? + jp Z,FCERR ; yes, error + cp $03 ; is it 1 or 2? + jp NC,SCERR ; no, error + ld (PRTNUM),A ; store port number into a temp buffer + call CHKSYN ; Make sure ',' follows + defb ',' + dec HL + call GETCHR ; check what's following + jp Z,SNERR ; error if nothing follows + jr NC,SERVAR ; it's not a number, try a variable + call ATOH ; get bps (returned into DE) + jr CHKZSER ; jump over +SERVAR: call GETNUM ; get number + call TSTSGN ; check value + jp M,FCERR ; negative - illegal function call + ld A,(FPEXP) ; Get integer value to DE + call FPINT ; get integer number into BCDE - drop BC 'cause isn't necessary +CHKZSER:ld A,D ; bps is into DE - move MSB into A + or E ; check if bps=0 + jr NZ,CNTSER ; no, continue checking + ; if baud rate is 0, then close the serial comm. +RSTSERS:ld A,(PRTNUM) ; yes, so reset the channel. First, load port number + dec A ; subtract 1, so that serial channel is 0=>A and 1=>B + add SIO_CA ; find correct channel + ld C,A ; store serial channel + di ; disable INTs + xor A ; reset A + ld D,$01 ; start from WR1 + ld B,$05 ; 5 registers +RPTRSSR:out (C),D ; select register + out (C),A ; reset register + inc D ; next register + djnz RPTRSSR ; repeat + ld A,%00110000 ; write into WR0: error reset, select WR0 + out (C),A ; send command to serial channel + ld A,%00011000 ; write into WR0: channel reset + out (C),A ; send command to serial channel + ei ; re-enable INTs + push HL ; store HL + ld HL,SERIALS_EN ; serials enabled status byte + in A,(PIO_DB) ; read status LEDs + bit 0,C ; check serial port + jr NZ,SRPT2 ; if bit is set, jump to port 2 + res 6,A ; it's port 1 + res 4,A ; remove possible error LED + res 0,(HL) ; disable port 1 + jp SERLED ; jump over +SRPT2: res 7,A ; it's port 2 + res 5,A ; remove possible error LED + res 1,(HL) ; disable port 2 +SERLED: out (PIO_DB),A ; send new configuration + pop HL ; retrieve HL + ret ; return to caller + ; check if bps=1, meaning reactivate RX on serial +CNTSER: ld A,D + or D ; check if bps<>1 by first checking D=0 + jr NZ,CNTSER2 ; if not, jump over + ld A,E ; then by checking that + cp $01 ; E=1 + jr NZ,CNTSER2 ; if not, jump over + ld A,(PRTNUM) ; load port number + ld D,A ; store port on D + ld A,(SERIALS_EN) ; load address of serial status cell + and D ; check status + jp Z,SCERR ; port not open, raise error + di ; disable INTs + ld A,D ; move port # into A + ld E,A ; and also into E + add A + add A ; move A to left times 2 + ld D,A ; move value into D + ld A,(SERIALS_EN) ; load serial status byte + or D ; re-enable RX + ld (SERIALS_EN),A ; store new serial status + ld A,E ; recover port # + dec A ; check port + jr NZ,CNTRX2 ; port is #2 + call SIO_A_EI ; re-enable RX on port 1 + in A,(PIO_DB) ; load status LEDs + res 4,A ; remove error LED + jp RXEND ; terminate setting +CNTRX2: call SIO_B_EI ; re-enable RX on port 2 + in A,(PIO_DB) ; load status LEDs + res 5,A ; remove error LED +RXEND: out (PIO_DB),A ; set new status for LEDs + ei ; re-enable INTs + ret ; return to caller + ; set serial port comm. +CNTSER2:push DE ; store BPS + ld A,(PRTNUM) ; load port number + ld D,A ; move port # into D + ld A,(SERIALS_EN) ; check if serial port is already open + and D ; by ANDing A with D + pop DE ; retrieve BPS + jp Z,CNTSER3 ; not open, continue + ld E,SA ; already open, so raise a "Serial Port Already Error" + jp ERROR ; and leave +CNTSER3:push HL ; store HL + ld HL,$E100 ; check bps. start with HL=57,600 + call CMP16 ; is bps<=57,600? + pop HL ; but first, recover HL + jp C,SCERR ; no (bps>57,600) then error + ld (BPS),DE ; store bps + dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + jp Z,DEFSER ; defaults if nothing follows + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get data bits + cp $05 ; is it <5? + jp C,SCERR ; yes, error + cp $09 ; is it >=9? + jp NC,FCERR ; yes, error + ld (DATABT),A ; store data bits + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get parity bits + cp A,$03 ; check if parity is in range 0~2 + jp NC,SCERR ; no, error + ld (PARBT),A ; store parity + call CHKSYN ; Make sure ',' follows + defb ',' + call GETINT ; get stop bits + cp $03 ; is it >=3? + jp NC,SCERR ; yes, error + ld (STPBT),A ; store stop bits + jr SETSER ; jump to set serial +DEFSER: ld A,$08 ; 8 bits for data + ld (DATABT),A + xor A ; no parity bit + ld (PARBT),A + inc A ; 1 bit for stop + ld (STPBT),A + ; check if bps are legal +SETSER: push HL ; store HL + push DE ; store DE + push IX ; store IX + ld IX,SUP_BPS ; allowed BPSs + ld B,$0B ; 11 items + ld C,$00 ; reset pointer +CKBPS: ld HL,(BPS) ; load BPS + ld E,(IX+0) ; load LSB of item + ld D,(IX+1) ; load MSB of item + call CMP16 ; is it equal? + jp Z,SET_PT ; yes, found a correspondance + inc IX + inc IX ; no, go to next entry + inc C ; increment pointer + djnz CKBPS ; repeat for 10 entries + jp SCERR1 ; if nothing found, raise an error +SET_PT: ;init CTC CH0: CH0 provides RX/TX clock to SIO port A + ; TO0 output frequency=INPUT CLK/time constant. Time constant is set to get 16 times + ; the requested baud rate. I.e., if bps is 19,200 then time constast is set to 6 because + ; 1,843,200/6 = 307,200 Hz (that is 19,200 x 16) + di ; disable INTs + ld B,$00 ; reset B + ld HL,CTC_CFG ; address of first CTC divider + add HL,BC ; adjust for correct CTC divider + ld C,CTC_CH0 ; CTC channel 0 + ld A,(PRTNUM) ; load port number + rra ; is it 1 (Carry=1) or 2 (Carry=0) + jp C,SET_CTC ; port 1 => ch. 0, so continue + inc C ; port 2 => ch. 1, increment address port into C +SET_CTC:ld A,%01000111 ; interrupt off, counter mode, prsc=16 (doesn't matter), ext. start, + ; start upon loading time constant, time constant follows, sw reset, command word + out (C),A ; configure CTC channel + ld A,(HL) ; load CTC divider + out (C),A ; send divider + ; configure SIO + ld HL,SIO_A_SETS ; load default settings for SIO + ld DE,SIOBFR ; into a temp buffer + ld BC,$000A ; 10 items to copy + ldir ; copy SIO settings into TEMP buffer + ld A,(SIOBFR+5) ; load WR5 setting + ld B,A ; move it into B + ld A,(DATABT) ; load DATA bits + cp $05 ; is it 5 bits? + jr NZ,BITS6 ; no, jump over + res 6,B + res 5,B ; set D6 & D5 to 0 + jr SETPAR ; jump to set parity +BITS6: cp $06 ; is it 6 bits? + jr NZ,BITS7 ; no, jump over + set 6,B + res 5,B ; set D6 & D5 to 1,0 + jr SETPAR ; jump to set parity +BITS7: cp $07 ; is it 7 bits? + jr NZ,BITS8 ; no, jump over + res 6,B + set 5,B ; set D6 & D5 to 0,1 + jp SETPAR ; jump to set parity +BITS8: set 6,B + set 5,B ; set D6 & D5 to 1,1 +SETPAR: ld HL,SERABITS ; load address for storing data bits + ld A,(PRTNUM) ; check serial port number + dec A ; is it port #1? + jp Z,SETPAR2 ; yes, jump over + inc HL ; port #2, use SERBBITS instead +SETPAR2:ld A,B ; retrieve DATA bits + ld (SIOBFR+5),A ; save DATA bits + and %01100000 ; filter only D5&D6 bits + add A,A ; shift left times 1 + ld (HL),A ; store for SIO_EI & SIO_DI functions + ld A,(STPBT) ; load STOP bits + add A,A + add A,A ; 2 left shifts + ld B,A ; move forming byte into B + ld A,(PARBT) ; load PARITY setting + and A ; is it 0? + jp Z,STRPAR ; yes, jump over + set 0,B ; set PARITY on + dec A ; is parity ODD? + jp Z,STRPAR ; yes, so jump over + set 1,B ; no, it's EVEN so set the corresponding bit +STRPAR: ld A,(SIOBFR+3) ; load WR4 setting + and %11110000 ; reset STOP & PARITY bits + or B ; set new STOP & PARITY bits + ld (SIOBFR+3),A ; store new value + ;set up TX and RX: + ; the followings are settings for channel A + ld HL,SIOBFR ; settings for SIO ch. A + ld B,$06 ; 6 bytes to send + ld C,SIO_CA ; I/O address of SIO ch.A + ld A,(PRTNUM) ; load port number + rra ; is it 1 (Carry=1) or 2 (Carry=0) + jp C,SRLCNT ; port 1, continue + inc C ; port 2, increment address port into C +SRLCNT: otir ; send bytes to SIO + ; the following are settings for channel B (don't need to load HL since settings are contigous) + ld B,$04 ; other 4 bytes to send + ld D,C ; store port address into D + ld C,SIO_CB ; I/O address of SIO ch.B + otir ; send bytes to SIO + ; the following are settings for selected channel + ld A,$01 ; write into WR0: select WR1 + ld C,D ; retrieve port address + out (C),A + ld A,%00011000 ; interrupts on every RX char; parity is no special condition; + ; buffer overrun is special condition + out (C),A + ld HL,SERIALS_EN + ld A,(PRTNUM) ; retrieve serial channel + dec A ; channel A? + jr NZ,ENCHB ; no, jump over + call SIO_A_EI ; enable RX on SIO channel A + set 0,(HL) ; set serial port 1 status ON + set 2,(HL) ; set serial port 1 RX ON + ; back to normal running + ei ; re-enable INTs + in A,(PIO_DB) ; load status LEDs + set 6,A ; set status LED on + res 4,A ; set error LED off + jr EXNRM ; leave +ENCHB: call SIO_B_EI ; enable RX on SIO channel B + set 1,(HL) ; set serial port 2 status ON + set 3,(HL) ; set serial port 2 RX ON + ; back to normal running + ei ; re-enable INTs + in A,(PIO_DB) ; load status LEDs + set 7,A ; set status LED on + res 5,A ; set error LED off +EXNRM: out (PIO_DB),A ; send new configuration + pop IX ; retrieve IX + pop DE ; retrieve DE + pop HL ; retrieve HL + ret ; return to caller + +; allowed bps (Bauds per second) +SUP_BPS:defw 57600,38400,28800,19200,14400,9600,4800,3600,2400,1200,600 +; corresponding CTC divider +CTC_CFG:defb 2,3,4,6,8,12,24,32,48,96,192 + + +; serial configuration error +SCERR1: pop IX ; retrieve IX + pop DE ; retrieve DE + pop HL ; retrieve HL +SCERR: ld E,SC ; Serial Configuration Error + jp ERROR ; print error + + +; serial buffer overrun +SOERR: call PRNTCRLF + ld E,SO ; Serial Buffer Overrun + jp ERROR + + +; check for direct mode: +; Z is set if in direct mode, reset otherwise +DIRMOD: 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 + + +; HELP lists the line program where an error occured +HELP: call DIRMOD ; check if in direct mode + jp NZ,HLPERR ; raise error if in indirect mode + push HL ; store HL + ld HL,(HLPLN) ; load HELP line + inc HL ; increment HL + ld A,H + or L ; check if there is a line into the HELP reg. + pop HL + jp Z,HLPERR ; no line found, raise error + ld DE,(HLPLN) ; recover line + pop BC ; remove BC from stack since it's not needed anymore for LIST + jp LST01H ; jump to list line +HLPERR: ld E,HP ; HELP call error + jp ERROR ; raise error + + +; KEY command to list/modify function keys and auto-repeat +KEY: dec HL ; dec 'cos GETCHR INCs + call GETCHR ; Get next character + jp Z,LSTKEYS ; jump if nothing follows + ; change FN keys + call GETINT ; get a number + and A ; is it 0? + jr NZ,KEYCH ; no, jump over +RESFN: push HL ; yes - reset FN keys to defaults + ld HL,AUTORP ; pointer to default auto-repeat delays and FN keys texts + ld DE,KEYDEL ; pointer to destination + ld BC,$0082 ; 130 chars to be copied (2xauto-delay, 128xFN keys) + ldir ; restore default texts + pop HL ; retrieve HL + ret ; return to caller +KEYCH: cp $09 ; is it >= 9? + jp NC,SETREP ; yes - jump over + dec A ; FN key in range 0~7 + add A,A ; multiply A... + add A,A ; ... times 4... + add A,A ; ... to get the correct... + add A,A ; ... offset fo FN key text + ld (TMPBFR1),A ; store FN key offset... + xor A ; ...in a... + ld (TMPBFR1+1),A ; ...16-bit register + call CHKSYN ; Make sure ',' follows + defb ',' + ld BC,HL ; copy address into BC + call EVAL ; Evaluate expression (in E there is the length) + push HL ; store string pointer + ld A,(TYPE) ; Get variable type + or A ; Is it a string variable? + jp Z,SNERR ; no - syntax error + call GSTRCU ; Current string to pool + call LOADFP ; Move string block data to (BC=pointer, DE=length) + ld A,E ; copy length into A + cp $11 ; is length > 16? + jp C,DECLN1 ; no, jump over + ld E,$10 ; yes, so set length to 16 +DECLN1: ld A,$10 ; calculate how many... + sub E ; ...null chars needed to fill up... + ld D,A ; ...the FN key text + push BC ; store address of string + ld BC,(TMPBFR1) ; load FN key offset + ld HL,FNKEYS ; load address of FN keys texts + add HL,BC ; get corrected address + pop BC ; retrieve address of string chars +CPKEY: ld A,(BC) ; load char from string + cp CR ; return? + jp Z,CPKEY2 ; yes, store char + cp $7B ; if char > "z" ? + jp NC,SNERR ; yes - syntax error + cp $20 ; is char < space? + jp C,SNERR ; yes - syntax error +CPKEY2: cp $61 ; is it >= 'a'? + jp C,CPKEY3 ; no, continue + and %01011111 ; set letters to uppercase +CPKEY3: ld (HL),A ; store char + inc HL ; next string char + inc BC ; next free cell + dec E ; decrement E + jr NZ,CPKEY ; repeat until 0 + xor A ; null char + inc D ; +1 to decrement below +CPKEY1: dec D ; how many null chars to insert? + jp Z,CPKYEND ; no more nulls, so exit + ld (HL),A ; store it + inc HL ; next cell + jr CPKEY1 ; repeat +CPKYEND:pop HL ; retrieve pointer to string + ret ; return to caller + ; list FN keys +LSTKEYS: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 + jp NZ,SNERR ; raise error if in indirect mode + push HL ; store HL + push DE ; store DE + ld HL,FNKEYS ; load starting address of FN keys text + ld C,$01 ; 8 function keys +PRTK4: ld B,$10 ; 16 chars each + ld DE,CHKEY1 ; message "KEY " + call PRTCKEY ; print it + ld A,C ; load FN key + add $30 ; get number in ASCI code + call OUTC ; print it + ld DE,CHKEY2 ; message ": "" + call PRTCKEY ; print it + ld A,$01 ; " opened + ld (TMPBFR1),A +LDKEY: ld A,(HL) ; retrieve char + and A ; is it zero? + jp Z,CNTLTK ; yes, go next char + call OPNQT ; check if quotes are opened + cp $22 ; check if char is "? + jp Z,PRTCHR ; yes, print "chr$(" + cp CR ; is it a CR? + jp Z,PRTCHR ; yes, print "chr$(" +PRTK3: call OUTC ; no, just print it +CNTLTK: inc HL ; next char + djnz LDKEY ; continue until finished + call CLSQT ; check if quotes are still open + ld A,CR ; go next line + call OUTC ; print it + inc C ; next FN key + ld A,C ; check if... + cp $09 ; finished keys? + jp C,PRTK4 ; no, repeat 1 more time + pop DE ; retrieve DE + pop HL ; retrieve HL + ret ; return to caller +PRTCHR: push HL ; store HL + call CLSQT ; check if quotes are closed + ld A,'+' ; '+' char + call OUTC ; print it + ld DE,CHKEY3 ; address of "CHR$(" + call PRTCKEY ; print it + pop HL ; recover HL + inc HL ; next char + dec B ; increment char counter + ld DE,CHKEY4 ; load address of RETURN + ld A,(HL) ; load char + cp CR ; is it a RETURN? + jr NZ,PTCHR1 ; no, jump over + ld DE,CHKEY5 ; yes, load address of " +PTCHR1: call PRTCKEY ; print it + ld A,')' ; char ) + jp PRTK3 ; continue +CLSQT: push AF ; store A + ld A,(TMPBFR1) ; quote status + and A ; are they closed? + jr Z,CLSQT1 ; if yes, return + ld A,$22 ; no, so close them + call OUTC ; print " + xor A ; set quotes + ld (TMPBFR1),A ; as closed +CLSQT1: pop AF ; retrieve A + ret ; return to caller +OPNQT: push AF ; store A + ld A,(TMPBFR1) ; quote status + and A ; are they open? + jr NZ,OPNQT1 ; if yes, return + ld A,'+' ; no, so add '+ + call OUTC ; print it + ld A,$22 ; and then open quotes + call OUTC ; print them + ld A,$01 ; set quotes + ld (TMPBFR1),A ; as opened +OPNQT1: pop AF ; retrieve A + ret ; return to caller +PRTCKEY:push AF ; store original char +PRTK1: ld A,(DE) ; load char + and A ; is it 0? + jp Z,PRTEND ; yes, finished printing + call OUTC ; no, print char + inc DE ; next char + jp PRTK1 ; repeat +PRTEND: pop AF ; retrieve AF + ret ; return to caller +SETREP: cp $09 ; is it special key 9? (stands for auto-repeat) + jp NZ,SNERR ; no, raise an error + call CHKSYN ; Check for comma + defb ',' + call GETINT ; get a number + ld (TMPBFR1),A ; store it + call CHKSYN ; Check for comma + defb ',' + call GETINT ; get another number + push HL ; store HL + ld HL,AUTOKE ; address of second cell for key auto-repeat + ld (HL),A ; store auto-repeat delay + dec HL ; previous cell + ld A,(TMPBFR1) ; retrieve value + ld (HL),A ; store delay for auto-repeat + pop HL ; retrieve HL + ret +CHKEY1: defb "KEY ",0 +CHKEY2: defb ":",34,0 +CHKEY3: defb "chr$(",0 +CHKEY4: defb "13",0 +CHKEY5: defb "34",0 + + +; 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 ; load address of PBUFF into HL + ld A,D ; Get MSB into A + or A ; OR with LSB to see if param=0 + jr Z,HEX2 ; Skip output if both high digits are zero + call BYT2ASC ; Convert D to ASCII + ld A,B ; cechk if B + cp '0' ; is 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 + or A + 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, HEX 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 SPC + 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,HE ; ?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 + push BC ; Save contents of BC + ld HL,PBUFF + ld B,$11 ; One higher than max char count (16+1) + ; Suppress leading zeros +ZEROSUP: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,$00 ; 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, BIN 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 SPC + 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 + + +MONOUT: jp $0008 ; output a char + + +RESET: ld E,$00 ; full RESET +RESET2: call DISNMI ; disable NMI vector + ld A,(SERIALS_EN) ; load status of serial lines + and $11 ; are serial ports open? + call NZ,RSTSERS ; yes, reset serials + ld A,(DOS_EN) ; check DOS status + and A ; DOS enabled? + jr Z,RESETE ; no, jump over + call CF_STANDBY ; yes, put CF into standby mode + xor A + ld (SEQFL),A ; close any seq. file opened + ld A,E + or A + ret NZ ; return if called from soft reset (C= + CTRL) +RESETE: di ; disable INTs + jp ROM2RAM ; Restart + + +INITST: xor A ; Clear break flag + ld (BRKFLG),A + jp SYSINIT + + +OUTNCR: call OUTC ; Output character in A + jp PRNTCRLF ; Output CRLF diff --git a/include/psg/psg-1.02.asm b/include/psg/psg-1.02.asm new file mode 100644 index 0000000..be76c23 --- /dev/null +++ b/include/psg/psg-1.02.asm @@ -0,0 +1,422 @@ +; ------------------------------------------------------------------------------ +; LM80C - PSG ROUTINES - 1.02 +; ------------------------------------------------------------------------------ +; The following code is intended to be used with LM80C Z80-based computer +; designed by Leonardo Miliani. Code and computer schematics are released under +; the therms of the GNU GPL License 3.0 and in the form of "as is", without no +; kind of warranty: you can use them at your own risk. +; You are free to use them for any non-commercial use: you are only asked to +; maintain the copyright notices, include this advice and the note to the +; attribution of the original version to Leonardo Miliani, if you intend to +; redistribuite them. +; https://www.leonardomiliani.com +; +; Please support me by visiting the following links: +; Main project page: https://www.leonardomiliani.com +; Schematics and code: https://github.com/leomil72/LM80C +; Videos about the computer: https://www.youtube.com/user/leomil72/videos +; Hackaday page: https://hackaday.io/project/165246-lm80c-color-computer +; ------------------------------------------------------------------------------ +; +; ------------------------------------------------------------------------------ + +;------------------------------------------------------------------------------ + +; configure the PSG +initPSG: ld HL,CHASNDDTN ; starting address of sound & keyboard RAM registers + ld B,SERIALS_EN-CHASNDDTN; # of PSG sound & keyboard registers + xor A ; reset A +EMPTSNDBFR: ld (HL),A ; reset RAM register + inc HL ; next register + djnz EMPTSNDBFR ; repeat +CLRPSGREGS: ld B,$10 ; 16 registers to set + ld HL,SNDREGCFG ; starting address of register settings + ld D,$00 ; first register +RSTPSG: ld A,D ; register value + call SETSNDREG ; select register + ld A,(HL) ; load value + call WRTSNDREG ; write to register + inc D ; next register + inc HL ; next value + djnz RSTPSG ; repeat for each register + ret ; return to caller + +SNDREGCFG: defb $00,$00,$00,$00,$00,$00,$00,%10111111 + defb $00,$00,$00,$00,$00,$00,$ff,$ff + ; reg. 7: set I/O ch.A to OUTPUT, I/O ch.B to INPUT; set noise to OFF; set audio to OFF + + +; routine to play a welcome beep on channel C (tone 4010) and to shut it off +WLCMBEEP: ld HL,WLCBPDAT ; data address + jp SENDSND +NOBEEP: ld HL,NOBPDAT ; data address +SENDSND: push BC + ld B,$04 ; 4 pairs +RPTWLCMBP: ld A,(HL) ; read register # + call SETSNDREG + inc HL ; next cell + ld A,(HL) ; read value + call WRTSNDREG + inc HL + djnz RPTWLCMBP ; repeat + pop BC + ret ; return to caller + +WLCBPDAT: defb $07,%10111011,$04,$56,$05,$00,$0A,$0F +NOBPDAT: defb $04,$00,$05,$00,$0A,$00,$07,%10111111 + + +; select register on PSG +SETSNDREG: ld C,PSG_REG ; PSG register port + out (C),A ; set register + ret ; return to caller + +; send data to PSG +WRTSNDREG: ld C,PSG_DAT ; PSG data port + out (C),A ; send data + ret ; return to caller + +; manage the sounds' duration: each time this subroutine is called, it +; decrements the single sound durations (measured in ms) and eventually +; shut off the audio channel whose counter has reached 0. +; (this sub-routine is called by CH3 timer ISR) +MNGSNDS: push IX ; store IX + ld IX,CHASNDDTN ; starting address of tones duration + ld B,$03 ; 3 channels to check + ld H,$01 ; mixer channels: A=>bit 1, B=>bit 2, C=>bit 3 +CHKSNDCH: ld E,(IX+0) ; load LSB into E + ld D,(IX+1) ; load MSB into D + ld A,E ; load E into A + or D ; check that DE=0 + jr Z,CNTCHKSND ; yes, jump over + dec DE ; no, so decrement DE + ld A,E ; reload E into A... + ld (IX+0),E ; store new... + ld (IX+1),D ; ...duration and... + or D ; ...do another check to see if DE=0 + jr NZ,CNTCHKSND ; no, so jump over + ; if yes, let's shut down the corresponding channel + ; to shut down a tone we disable it into the mixer + ; then set 0 into its tone registers + ld D,$07 ; mixer register + ld C,PSG_REG ; PSG register selector port + out (C),D ; set mixer register + in A,(C) ; load current value + or H ; set off the channel into the mixer (remember that 1=OFF) + out (C),D ; select mixer register + ld C,PSG_DAT ; PSG data port + out (C),A ; send new value for the mixer + ld A,$03 ; three channels + sub B ; find current channel (0->A, 1->B, 2->C) + add A,A ; and find first register (A=>0, B=>2, C=>4) + ld C,PSG_REG ; PSG register selector port + out (C),A ; select first tone register of channel + ld L,$00 ; value 0 into L + ld C,PSG_DAT ; PSG data selector port + out (C),L ; write 0 into register + ld C,PSG_REG ; PSG register selector port + inc A ; next tone register + out (C),A ; select second tone register of channel + ld C,PSG_DAT ; PSG data selector port + out (C),L ; write 0 into register +CNTCHKSND: inc IX ; set for... + inc IX ; ...next channel... + sla H ; shift left H 1 bit + djnz CHKSNDCH ; repeat for 3 channels + pop IX ; restore IX + ret ; return to caller + +; read a specific row of the keyboard matrix, set by A +; return read into A +READKBLN: push BC ; store BC + ld B,$0F ; reg #15 + ld C,PSG_REG ; PSG register port + out (C),B ; select reg #15 + ld C,PSG_DAT ; PSG data port + out (C),A ; activate the row + ld B,$0E ; register #14 (port B) + ld C,PSG_REG ; PSG register port + out (C),B ; select reg. 14 (port B) + in A,(C) ; read register #14 + pop BC ; retrieve BC + ret + +; read the keyboard matrix to look for a key pressure +KEYBOARD: ld C,PSG_REG ; PSG register port + ld B,$07 ; set register #7... + out (C),B ; ...to work with + in A,(C) ; read register #7 + set 7,A ; port A set to output + res 6,A ; port B set to input + out (C),B ; set register #7 + ld C,PSG_DAT ; PSG data port + out (C),A ; set I/O ports w/o altering the rest of the mixer + ; check for reset combination + ld A,%11111110 ; first line of keyboard matrix + call READKBLN + cp %11011011 ; are C= and CTRL pressed? + jr NZ,CHKSPCKS ; no, jump over +NOMRPRSS: ld A,%11111110 ; wait until the user... + call READKBLN ; ...releases the key combination... + cp %11011011 ; ...to avoid multiple... + jr Z,NOMRPRSS ; ...calls of this code + call initPSG ; reset sounds + ld E,$01 ; flag for soft reset and graphic mode 1 + call RESET2 ; reset serials, close seq. files and put disk into standby + call initVDP ; set video mode + call RUNFST ; clear BASIC pointers + pop HL ; remove HL from stack (put by RUNFST routine) + call Z,CURSOR_ON ; enable cursor + ld A,$01 ; activate the... + ld (PRNTVIDEO),A ; ...video buffer... + ld IX,PRNTOK ; set return address + push IX ; store into stack + ei ; re-enable INTs + reti ; return from ISR and go to BASIC prompt + ; check special keys (SHIFT/ALT/CTRL) +CHKSPCKS: ld A,%11111101 ; select SHIFT row + call READKBLN ; read row + bit 3,A ; test if SHIFT key is pressed (4th bit is reset) + jr NZ,CHECKALT ; no, so go on + ld HL,CONTROLKEYS ; control key flags + ld (HL),%00000001 ; set SHIFT flag, reset CTRL & ALT flags (currently multiply control keys are NOT supported) +CHECKALT: ld A,%11111110 ; select ALT row + call READKBLN ; read ALT row + bit 5,A ; test if ALT key is pressed (5th bit is reset) + jr NZ,CHECKCTRL ; no, so go on + ld HL,CONTROLKEYS ; control key flags + ld (HL),%00000100 ; set ALT flag, reset SHIFT & CTRL flag (currently multiply control keys are NOT supported) +CHECKCTRL: ld A,%11111110 ; select CTRL row + call READKBLN ; read CTRL row + bit 2,A ; test if CTRL key is pressed (3rd bit is reset) + jr NZ,CHECKKBD ; no, so make a normal reading + ld HL,CONTROLKEYS ; control key flags + ld (HL),%00000010 ; set CTRL flag, reset SHIFT & ALT flags (currently multiply control keys are NOT supported) +CHECKKBD: ld B,$08 ; 8 lines + ld A,%01111111 ; start from the last line of the matrix +RPTKBDRD: ld D,$0F ; register #15 (port B) + ld C,PSG_REG ; PSG register port + out (C),D ; select reg. #15 + ld C,PSG_DAT ; PSG data port + out (C),A ; activate 1 line (active line is grounded, i.e. with a LOW signal) + ld E,A ; save current line into E + ld D,$0E ; register #14 (port A) + ld C,PSG_REG ; PSG register port + out (C),D ; select reg. 14 (port A) + nop + in A,(C) ; read register #14 + cp $FF ; is there any line set to 0? + jr Z,NOKEYPRSD ; no, go to the next row + ; check control keys + ld (KBTMP),A ; yes, check if a control key was pressed. First, store current row + ld A,B ; copy current row (B) into A + cp $02 ; is it the row of the SHIFT? + jr NZ,TESTALT ; no, continue checking the other control keys + ld A,(KBTMP) ; yes, retrieve current row data + bit 3,A ; check SHIFT bit line + jr NZ,FINDKEY ; no SHIFT, continue checking + set 3,A ; yes, it's the SHIFT. So remove SHIFT bit + cp $FF ; after deleting the SHIFT bit, is there any other bit selected? + jr NZ,FINDKEY ; yes, go to check which one + jr NOKEYPRSD ; no, go to next row +TESTALT: cp $01 ; is it the line of ALT & CTRL? + ld A,(KBTMP) ; retrieve current row data + jr NZ,FINDKEY ; no, continue + bit 5,A ; yes, check ALT bit line + jr NZ,TESTCTRL ; no ALT, continue checking + set 5,A ; yes, it's the ALT. So remove ALT bit +TESTCTRL: bit 2,A ; check CTRL bit line + jr NZ,ENDCTRLCK ; no CTRL, continue checking + set 2,A ; delete CTRL bit flag +ENDCTRLCK: cp $FF ; after deleting the ALT & CTRL bits, is there any other bit selected? + jr NZ,FINDKEY ; yes, go to check which one +NOKEYPRSD: ld A,E ; no key pressed, load current output port + rrca ; rotate right by 1 + djnz RPTKBDRD ; repeat for 8 lines + xor A ; if exit from here, no key has been pressed... + ld (LASTKEYPRSD),A ; ...so reset the last key cell... + ld (CONTROLKEYS),A ; ...reset contro key flags... + ld (KBDNPT),A ; ...no input from keyboard... + ld (STATUSKEY),A ; ...no auto-repeat... + ret ; ...and leave +FINDKEY: ld E,$FF ; counter +CHKLN: inc E ; E goes from 0 to 7 + srl A ; is the first bit reset? (we're looking for a "0", meaning grounded line) + jr C,CHKLN ; no, check next bit + ld A,(CONTROLKEYS) ; load control key flags + ld HL,KBMAP ; normal keymap + cp $01 ; SHIFT flag? + jr NZ,CHKCTRL ; no, jump over + ld HL,KBMAP_SFT ; SHIFT keymap + jr LOADMAP ; and load it +CHKCTRL: cp $02 ; CTRL flag? + jr NZ,CHKALT ; no, jump over + ld HL,KBMAP_CTRL ; CTRL map + jr LOADMAP ; and load it +CHKALT: cp $04 ; ALT flag? + jr NZ,LOADMAP ; no, check over + ld HL,KBMAP_ALT ; ALT map +LOADMAP: dec B ; decrement row # (rows go from 0 to 7) + ld C,B ; move B into C and... + sla C ; ...multiply it... + sla C ; ...by 8 to find... + sla C ; ...the current row into the matrix + ld B,$00 ; reset B + add HL,BC ; find the address of the current row + ld D,B ; reset D + add HL,DE ; find the current column - now (HL) stores the pressed key + ld A,(LASTKEYPRSD) ; load the last key pressed + cp (HL) ; is it the same key? + jr NZ,NEWKEY ; no, it's a new key + ld BC,HL ; store address of current keycode + ld HL,(TMRCNT) ; load current system timer + ld DE,(KEYTMR) ; load auto-repeat timer + ld A,(STATUSKEY) ; yes, load current status of auto-repeat + cp $01 ; is it initial pressure? + jr NZ,CHKAUTO ; no, jump over + xor A ; clear Carry + sbc HL,DE ; startint time - actual time + ld D,$00 ; 64 ths/s > 640 ms + ld A,(KEYDEL) + ld E,A + call CMP16 ; time elapsed is >= $40? + jp C,LVKBRDCHK2 ; no, so leave +SETNEWAUTO: ld A,$02 ; yes set status to... + ld (STATUSKEY),A ; ...auto-repeat + ld HL,(TMRCNT) ; load system timer + ld (KEYTMR),HL ; store starting time + ld HL,BC ; retrieve address of current keycode + jp SENDKEY ; send key +CHKAUTO: xor A ; clear Carry + sbc HL,DE ; computer interval between initial pressure of key and current time + ld D,$00 + ld A,(AUTOKE) + ld E,A ; auto-repeat delay into DE + call CMP16 ; check if interval is greater than delay + jp C,LVKBRDCHK2 ; no, so leave + jp SETNEWAUTO ; set new loop and send key +NEWKEY: xor A ; set initial state... + inc A ; ...for auto-repeat... + ld (STATUSKEY),A ; ...1=pressure init + ld BC,(TMRCNT) ; load current system timer + ld (KEYTMR),BC ; set starting time +SENDKEY: ld A,(HL) ; then, load key... + ld (LASTKEYPRSD),A ; ...store it... + ld (TMPKEYBFR),A ; ...insert it into the INKEY buffer... + ld (CHR4VID),A ; ...and store char for video + cp CTRLC ; is it RUN/STOP? + jr NZ,CNTKBCK ; no, jump over + call CHARINTOBFR ; yes, send directly to buffer and... + jr LVKBRDCHK2 ; ...leave +CNTKBCK: ld BC,$0800 ; 8 FN keys (B), FN key number (C) + ld HL,FNKEYSORD ; FN keys codes +CHKFNK: cp (HL) ; is it an FN key? + jp Z,PRNTFNKEY ; yes, jump over + inc C ; next FN key + inc HL ; next FN key code + djnz CHKFNK ; continue for 8 FN keys +SNDKEYTOBFR: ld A,$01 ; normal key - set input flag + ld (KBDNPT),A ; to keyboard + ld A,(PRNTVIDEO) ; load status of print-on-video + or A ; is the print-on-video disabled? + jp Z,PUTCHRBUF ; yes, so send char to input buffer + ld A,(CRSR_STATE) ; check cursor state + or A ; is it 0 (cursor OFF)? + jr NZ,PNT2VD ; no, print on screen +PUTCHRBUF: xor A + ld (KBDNPT),A ; if send to input buffer, set RETURN as from BASIC + ld A,(TMPKEYBFR) ; retrieve char + call CHARINTOBFR ; cursor off, so send char to buffer... + jp LVKBRDCHK2 ; ...and leave +PNT2VD: call CHAR2VID ; send char to video +LVKBRDCHK2: xor A + ld (CONTROLKEYS),A ; reset control key flags + ret ; return to caller: the current key code is into TMPKEYBFR + ; manage FN keys +PRNTFNKEY: ld D,A ; copy A into D + ld HL,(LINEAT) ; Get current line number + inc HL ; -1 means direct statement + ld A,H + or L + ld A,D ; retrieve char + jr NZ,SNDKEYTOBFR ; indirect mode - just send FN key code to buffer + ld A,C ; direct mode, so print text - first, get FN key number + add A,A + add A,A + add A,A + add A,A ; FN key number * 16 + ld C,A ; move it into C + ld B,$00 ; reset B, to get offset + ld HL,FNKEYS ; load address of FN keys texts + add HL,BC ; get correct text address + ld B,$10 ; 16 chars +LDFNKEYCHR: ld A,(HL) ; load char + and A ; null char? + jp Z,LVKBRDCHK2 ; yes, so leave + ld D,A ; pass char into D + ld A,(PRNTVIDEO) ; load status of print-on-video + or A ; is the print-on-video disabled? + jp Z,PUTCHRBUF1 ; yes, so send char to input buffer + ld A,(CRSR_STATE) ; check cursor state + or A ; is it 0 (cursor OFF)? + call NZ,PRNTFNK ; no, print on screen +CNTFNK: inc HL ; next char + djnz LDFNKEYCHR ; repeat for max. 16 chars + jp LVKBRDCHK2 ; leave +PUTCHRBUF1: xor A ; if send to input buffer,... + ld (KBDNPT),A ; ...set input as from BASIC + ld A,D ; retrieve char + push HL ; store HL + call CHARINTOBFR ; cursor off, so send char to buffer... + pop HL ; retrieve HL + jp CNTFNK ; repeat +PRNTFNK: ld A,D ; recover char + ld (CHR4VID),A ; store char for printing + ld A,$01 ; normal key - set input flag + ld (KBDNPT),A ; to keyboard + call CHAR2VID ; print on screen + ret ; return to caller + + +;----------------------------------------------------------------------- +FNKEYSORD: defb 1,2,4,5,6,22,23,24 ; order of FN Keys +;----------------------------------------------------------------------- +; key codes +KBMAP: defb '1',25,14,3,' ',16,'q','2' ; 25=HOME 14=CTRL 3=RUN/STOP 16=C= + defb '3','w','a',20,'z','s','e','4' ; 20=SHIFT + defb '5','r','d','x','c','f','t','6' + defb '7','y','g','v','b','h','u','8' + defb '9','i','j','n','m','k','o','0' + defb 31,'p','l',',','.',':','-',30 ; 31=CURSOR DOWN 30=CURSOR UP + defb 28,'*',';','/',27,'=','+',29 ; 28=CURSOR LEFT 27=ESCAPE 29=CURSOR RIGHT + defb 8,13,252,'@',1,2,4,24 ; 8=DEL(backspace) 13=RETURN 252=£ 1=F1 2=F2 4=F3 24=HELP + +; shifted codes - not all the keys have the shifted version +KBMAP_SFT: defb '!',12,14,3,' ',16,'Q',34 ; 12=CLEAR 14=CTRL 3=RUN/STOP 16=C= 34=" + defb '#','W','A',20,'Z','S','E','$' ; 20=SHIFT + defb '%','R','D','X','C','F','T','&' + defb 39,'Y','G','V','B','H','U','(' ; 39=' + defb ')','I','J','N','M','K','O',94 ; 94=^ + defb 31,'P','L','<','>','[','_',30 ; 31=CURSOR DOWN 30=CURSOR UP + defb 28,'*',']','?',27,198,'+',29 ; 28=CURSOR LEFT 27=ESCAPE 29=CURSOR RIGHT + defb 26,13,211,'@',5,6,22,23 ; 26=INSERT, 211=€ 5=F4 6=F5 22=F6 23=F7 + +; ALT (C=) codes - not all the keys have the alt-ed version +KBMAP_ALT: defb '1',12,14,3,' ',16,222,196 ; 12=CLEAR 14=CTRL 3=RUN/STOP 16=C= 34=" + defb '3',221,133,20,131,130,165,'4' ; 20=SHIFT + defb '5',162,166,132,157,163,168,'6' + defb '7',171,169,161,158,172,213,'8' ; + defb '9',214,216,159,160,215,135,195 ; + defb 31,136,138,193,192,123,144,30 ; 31=CURSOR DOWN 123={ 30=CURSOR UP + defb 28,143,125,254,27,209,148,29 ; 28=CURSOR LEFT 125=} 27=ESCAPE 29=CURSOR RIGHT + defb 8,13,224,137,5,6,22,23 ; 8=DEL(backspace) 13=RETURN 252=£ 5=F4 6=F5 22=F6 23=F7 + +; CTRL codes - not all the keys have the control-ed version +KBMAP_CTRL: defb '1',25,14,3,' ',16,154,'2' ; 25=HOME 14=CTRL 3=RUN/STOP 16=C= + defb '3',156,149,20,152,150,153,'4' ; 20=SHIFT + defb '5',155,176,151,177,175,165,'6' + defb '7',166,168,178,179,169,167,'8' + defb '9',184,170,172,171,181,164,'0' + defb 31,163,173,',','.',':',186,30 ; 31=CURSOR DOWN 30=CURSOR UP + defb 28,225,';','/',27,212,185,29 ; 28=CURSOR LEFT 27=ESCAPE 212=π 29=CURSOR RIGHT + defb 8,13,189,162,1,2,4,24 ; 8=DEL(backspace) 13=RETURN 252=£ 1=F1 2=F2 4=F3 24=HELP \ No newline at end of file diff --git a/manuals/LM80C BASIC reference manual.odt b/manuals/LM80C BASIC reference manual.odt index d3129d0..52bda40 100644 Binary files a/manuals/LM80C BASIC reference manual.odt and b/manuals/LM80C BASIC reference manual.odt differ diff --git a/manuals/LM80C BASIC reference manual.pdf b/manuals/LM80C BASIC reference manual.pdf index a6c7f2b..e822c4a 100644 Binary files a/manuals/LM80C BASIC reference manual.pdf and b/manuals/LM80C BASIC reference manual.pdf differ diff --git a/manuals/LM80C hardware reference manual.odt b/manuals/LM80C hardware reference manual.odt index e023802..7745220 100644 Binary files a/manuals/LM80C hardware reference manual.odt and b/manuals/LM80C hardware reference manual.odt differ diff --git a/manuals/LM80C hardware reference manual.pdf b/manuals/LM80C hardware reference manual.pdf index 03737f4..1cd7e12 100644 Binary files a/manuals/LM80C hardware reference manual.pdf and b/manuals/LM80C hardware reference manual.pdf differ