├── README.md ├── src ├── hex2bin.html ├── tiny2.a80 └── tinybasic.a80 ├── LICENSE ├── i8080_hal.h ├── i8080.h ├── t8080.ino ├── basic2.h ├── basic.h └── i8080.cpp /README.md: -------------------------------------------------------------------------------- 1 | # arduino8080basic 2 | Arduino runs a virtual 8080 CPU with Tiny BASIC 3 | -------------------------------------------------------------------------------- /src/hex2bin.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Martin Malý 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /i8080_hal.h: -------------------------------------------------------------------------------- 1 | // Intel 8080 (KR580VM80A) microprocessor core model 2 | // 3 | // Copyright (C) 2012 Alexander Demin 4 | // 5 | // Credits 6 | // 7 | // Viacheslav Slavinsky, Vector-06C FPGA Replica 8 | // http://code.google.com/p/vector06cc/ 9 | // 10 | // Dmitry Tselikov, Bashrikia-2M and Radio-86RK on Altera DE1 11 | // http://bashkiria-2m.narod.ru/fpga.html 12 | // 13 | // Ian Bartholomew, 8080/8085 CPU Exerciser 14 | // http://www.idb.me.uk/sunhillow/8080.html 15 | // 16 | // Frank Cringle, The origianal exerciser for the Z80. 17 | // 18 | // Thanks to zx.pk.ru and nedopc.org/forum communities. 19 | // 20 | // This program is free software; you can redistribute it and/or modify 21 | // it under the terms of the GNU General Public License as published by 22 | // the Free Software Foundation; either version 2, or (at your option) 23 | // any later version. 24 | // 25 | // This program is distributed in the hope that it will be useful, 26 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | // GNU General Public License for more details. 29 | // 30 | // You should have received a copy of the GNU General Public License 31 | // along with this program; if not, write to the Free Software 32 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 33 | 34 | #ifndef I8080_HAL_H 35 | #define I8080_HAL_H 36 | 37 | extern int i8080_hal_memory_read_word(int addr); 38 | extern void i8080_hal_memory_write_word(int addr, int word); 39 | 40 | extern int i8080_hal_memory_read_byte(int addr); 41 | extern void i8080_hal_memory_write_byte(int addr, int byte); 42 | 43 | extern int i8080_hal_io_input(int port); 44 | extern void i8080_hal_io_output(int port, int value); 45 | 46 | extern void i8080_hal_iff(int on); 47 | 48 | extern unsigned char* i8080_hal_memory(void); 49 | 50 | #endif 51 | -------------------------------------------------------------------------------- /i8080.h: -------------------------------------------------------------------------------- 1 | // Intel 8080 (KR580VM80A) microprocessor core model 2 | // 3 | // Copyright (C) 2012 Alexander Demin 4 | // 5 | // Credits 6 | // 7 | // Viacheslav Slavinsky, Vector-06C FPGA Replica 8 | // http://code.google.com/p/vector06cc/ 9 | // 10 | // Dmitry Tselikov, Bashrikia-2M and Radio-86RK on Altera DE1 11 | // http://bashkiria-2m.narod.ru/fpga.html 12 | // 13 | // Ian Bartholomew, 8080/8085 CPU Exerciser 14 | // http://www.idb.me.uk/sunhillow/8080.html 15 | // 16 | // Frank Cringle, The origianal exerciser for the Z80. 17 | // 18 | // Thanks to zx.pk.ru and nedopc.org/forum communities. 19 | // 20 | // This program is free software; you can redistribute it and/or modify 21 | // it under the terms of the GNU General Public License as published by 22 | // the Free Software Foundation; either version 2, or (at your option) 23 | // any later version. 24 | // 25 | // This program is distributed in the hope that it will be useful, 26 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | // GNU General Public License for more details. 29 | // 30 | // You should have received a copy of the GNU General Public License 31 | // along with this program; if not, write to the Free Software 32 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 33 | 34 | #ifndef I8080_H 35 | #define I8080_H 36 | 37 | void i8080_init(void); 38 | int i8080_instruction(void); 39 | 40 | void i8080_jump(int addr); 41 | int i8080_pc(void); 42 | 43 | extern int i8080_regs_bc(void); 44 | extern int i8080_regs_de(void); 45 | extern int i8080_regs_hl(void); 46 | extern int i8080_regs_sp(void); 47 | 48 | extern int i8080_regs_a(void); 49 | extern int i8080_regs_b(void); 50 | extern int i8080_regs_c(void); 51 | extern int i8080_regs_d(void); 52 | extern int i8080_regs_e(void); 53 | extern int i8080_regs_h(void); 54 | extern int i8080_regs_l(void); 55 | 56 | #endif 57 | -------------------------------------------------------------------------------- /t8080.ino: -------------------------------------------------------------------------------- 1 | /************************************************************** 2 | * Arduino TINY BASIC with a 8080 Emulation 3 | * 4 | * Arduino 8080 Virtual Machine with up to 4kB ROM (0x0000-0x0fff) and 1 kB RAM (0x1000-0x13FF) 5 | * 6 | * OUT 1 sends data to serial port 7 | * IN 1 reads data from serial port 8 | * OUT 0xFE controls LED on pin13 (bit 0) 9 | * IN 0 returns serial status: 0x02 for no data on input buffer, 0x22 means data are available 10 | * 11 | * 8080 emulator part is Copyright (C) 2012 Alexander Demin under GPL2 12 | * Tiny Basic and Tiny Basic 2 are copylefted by LI-CHEN WANG 13 | * Source code for BASIC has been compiled with www.asm80.com 14 | * 15 | */ 16 | 17 | 18 | #include "i8080.h" 19 | #include "i8080_hal.h" 20 | 21 | void setup() { 22 | Serial.begin(115200); 23 | pinMode(13, OUTPUT); 24 | i8080_init(); 25 | i8080_jump(0); 26 | } 27 | 28 | // for debug purposes 29 | void examine() { 30 | Serial.print("\nA:"); 31 | Serial.print(i8080_regs_a()); 32 | Serial.print(" BC:"); 33 | Serial.print(i8080_regs_bc()); 34 | Serial.print(" DE:"); 35 | Serial.print(i8080_regs_de()); 36 | Serial.print(" HL:"); 37 | Serial.print(i8080_regs_hl()); 38 | Serial.print(" PC:"); 39 | Serial.print(i8080_pc()); 40 | //Serial.print("\n"); 41 | } 42 | 43 | void loop() { 44 | //delay(500); 45 | //examine(); 46 | i8080_instruction(); 47 | } 48 | 49 | //// MEMORY DEFINITIONS 50 | 51 | //test for 8080 emu 52 | //const byte PROGMEM ROM[4096] = {0x3e, 0x20, 0xd3, 0x01, 0xd3, 0xfe, 0x3c, 0xc3, 0x02,0x00}; 53 | 54 | //Uncomment for TINY BASIC v1 55 | //#include "basic.h" 56 | 57 | //Uncomment for TINY BASIC v2 58 | #include "basic2.h" 59 | 60 | //some initial RAM constants for Tiny BASIC 1 61 | byte RAM [1024] = {0xff,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0x15,0x10}; 62 | 63 | byte readByte(int addr) { 64 | if (addr>=0 && addr < 0x1000) return pgm_read_byte_near(ROM + addr); 65 | if (addr>=0x1000 && addr < 0x1400) return RAM[addr]; 66 | return 0xFF; //void memory 67 | } 68 | 69 | void writeByte(int addr, byte value) { 70 | if (addr>=0x1000 && addr < 0x1400) RAM[addr]=value; 71 | } 72 | 73 | //// HAL - Hardware Abstraction Layer for Emulator 74 | 75 | int i8080_hal_memory_read_byte(int addr) { 76 | return (int)readByte(addr); 77 | } 78 | 79 | void i8080_hal_memory_write_byte(int addr, int value) { 80 | writeByte(addr,value); 81 | } 82 | 83 | 84 | int i8080_hal_memory_read_word(int addr) { 85 | return readByte(addr) | (readByte(addr + 1) << 8); 86 | } 87 | 88 | void i8080_hal_memory_write_word(int addr, int value) { 89 | writeByte(addr, value & 0xff); 90 | writeByte(addr + 1, (value >> 8) & 0xff); 91 | } 92 | 93 | int i8080_hal_io_input(int port) { 94 | switch (port) { 95 | case 0x00: //serial status 96 | return Serial.available() ? 0x22 : 0x02; 97 | break; 98 | case 0x01: //serial input 99 | return Serial.available() ? Serial.read() : 0; 100 | break; 101 | default: 102 | return 0xff; 103 | } 104 | } 105 | 106 | void i8080_hal_io_output(int port, int value) { 107 | switch (port) { 108 | case 0x01: //serial out 109 | Serial.print((char)(value & 0x7f)); 110 | break; 111 | case 0xfe: //led control 112 | digitalWrite(13, value & 0x01); 113 | break; 114 | default: 115 | break; 116 | } 117 | } 118 | 119 | void i8080_hal_iff(int on) { 120 | //no interrupts implemented 121 | } 122 | -------------------------------------------------------------------------------- /basic2.h: -------------------------------------------------------------------------------- 1 | const byte PROGMEM ROM[2048] = { 2 | 49,0,20,62,255,195,66,6,227,239,190,195,104,0,62,13,245,58,0,16,183,195,108,6,205,113,3,229,195,45,3,87,124,186,192,125,187,201,65,78,26,254,32,192,19,195,40,0,241,205,179,4,195,198,4,71,239,214,64,216,194,88,0,19,205,26,4,41,218,159,0,213,235,205,89,4,231,218,244,4,33,102,19,205,124,4,209,201,254,27,63,216,19,33,102,19,7,133,111,62,0,140,103,201,35,202,115,0,197,78,6,0,9,193,27,19,35,227,201,33,0,0,68,239,254,48,216,254,58,208,62,240,164,194,159,0,4,197,68,77,41,41,9,41,26,19,230,15,133,111,62,0,140,103,193,26,242,124,0,213,17,166,0,195,202,4,72,79,87,63,13,79,75,13,87,72,65,84,63,13,83,79,82,82,89,13,49,0,20,205,14,0,17,171,0,151,205,96,5,33,206,0,34,1,16,33,0,0,34,9,16,34,3,16,62,62,205,250,4,213,17,157,19,205,119,0,239,124,181,193,202,56,7,27,124,18,27,125,18,197,213,121,147,245,205,56,5,213,194,11,1,213,205,84,5,193,42,21,16,205,229,5,96,105,34,21,16,193,42,21,16,241,229,254,3,202,186,0,133,111,62,0,140,103,17,102,19,231,210,243,4,34,21,16,209,205,238,5,209,225,205,229,5,195,214,0,205,194,4,33,23,16,34,21,16,205,194,4,195,186,0,205,194,4,17,23,16,33,0,0,205,64,5,218,186,0,235,34,1,16,235,19,19,205,132,6,33,189,6,195,59,7,223,213,205,194,4,205,56,5,194,160,0,241,195,80,1,205,119,0,205,194,4,205,56,5,218,186,0,205,210,5,205,132,6,205,64,5,195,120,1,14,6,207,59,6,205,14,0,195,87,1,207,13,6,205,14,0,195,71,1,207,35,5,223,77,195,169,1,205,108,5,195,182,1,207,44,6,205,179,4,195,155,1,205,14,0,247,223,197,205,146,5,193,195,169,1,205,25,6,223,213,205,56,5,194,160,0,42,1,16,229,42,3,16,229,33,0,0,34,9,16,57,34,3,16,195,80,1,205,194,4,42,3,16,124,181,202,198,4,249,225,34,3,16,225,34,1,16,209,205,253,5,247,205,25,6,205,160,4,43,34,9,16,33,19,7,195,59,7,223,34,13,16,33,25,7,195,59,7,223,195,25,2,33,1,0,34,11,16,42,1,16,34,15,16,235,34,17,16,1,10,0,42,9,16,235,96,104,57,62,9,126,35,182,202,82,2,126,43,186,194,49,2,126,187,194,49,2,235,33,0,0,57,68,77,33,10,0,25,205,238,5,249,42,17,16,235,247,255,218,198,4,34,5,16,213,235,42,9,16,124,181,202,199,4,231,202,118,2,209,205,253,5,42,5,16,195,94,2,94,35,86,42,11,16,229,124,170,122,25,250,136,2,172,250,170,2,235,42,9,16,115,35,114,42,13,16,241,183,242,152,2,235,205,152,4,209,218,172,2,42,15,16,34,1,16,42,17,16,235,247,225,209,205,253,5,247,33,0,0,62,223,124,181,194,87,1,205,86,5,210,80,1,195,186,0,42,7,16,249,225,34,1,16,209,209,213,205,108,5,195,219,2,255,218,21,3,195,235,2,213,255,218,198,4,26,79,151,18,209,205,96,5,121,27,18,213,235,42,1,16,229,33,205,2,34,1,16,33,0,0,57,34,7,16,213,62,58,205,250,4,17,157,19,223,0,0,0,209,235,115,35,114,225,34,1,16,209,241,207,44,3,195,205,2,247,26,254,13,202,44,3,205,160,4,207,44,3,195,35,3,247,33,33,7,195,59,7,205,92,3,216,111,201,205,92,3,200,111,201,205,92,3,200,216,111,201,205,92,3,111,200,216,108,201,205,92,3,192,111,201,205,92,3,208,111,201,225,201,121,225,193,229,197,79,205,113,3,235,227,205,152,4,209,33,0,0,62,1,201,207,45,6,33,0,0,195,155,3,207,43,0,205,165,3,207,43,21,229,205,165,3,235,227,124,170,122,25,209,250,128,3,172,242,128,3,195,159,0,207,45,134,229,205,165,3,205,134,4,195,135,3,205,5,4,207,42,45,229,205,5,4,6,0,205,131,4,227,205,131,4,235,227,124,183,202,197,3,122,178,235,194,160,0,125,33,0,0,183,202,247,3,25,218,160,0,61,194,205,3,195,247,3,207,47,70,229,205,5,4,6,0,205,131,4,227,205,131,4,235,227,235,122,179,202,160,0,197,205,102,4,96,105,193,209,124,183,250,159,0,120,183,252,134,4,195,168,3,33,1,7,195,59,7,255,218,20,4,126,35,102,111,201,205,119,0,120,183,192,207,40,5,223,207,41,1,201,195,198,4,205,26,4,124,183,250,159,0,181,202,159,0,213,229,42,19,16,17,105,7,231,218,64,4,33,0,0,94,35,86,34,19,16,225,235,197,205,102,4,193,209,35,201,205,26,4,27,205,131,4,19,201,42,21,16,213,235,33,102,19,205,124,4,209,201,229,108,38,0,205,113,4,65,125,225,103,14,255,12,205,124,4,210,115,4,25,201,125,147,111,124,154,103,201,124,183,240,124,245,47,103,125,47,111,35,241,172,242,159,0,120,238,128,71,201,124,170,242,158,4,235,231,201,255,218,198,4,229,207,61,8,223,68,77,225,113,35,112,201,195,198,4,207,59,4,241,195,87,1,207,13,4,241,195,71,1,201,239,254,13,200,213,17,174,0,151,205,96,5,209,26,245,151,18,42,1,16,229,126,35,182,209,202,186,0,126,183,250,195,2,205,210,5,27,241,18,62,63,215,151,205,96,5,195,186,0,213,17,180,0,195,202,4,215,17,157,19,205,132,6,202,254,4,254,127,202,35,5,215,254,10,202,254,4,183,202,254,4,254,125,202,48,5,18,19,254,13,200,123,254,221,194,254,4,123,254,157,202,48,5,27,62,92,215,195,254,4,205,14,0,62,94,195,250,4,124,183,250,159,0,17,23,16,229,42,21,16,43,231,225,216,26,149,71,19,26,156,218,85,5,27,176,201,19,19,26,254,13,194,85,5,19,195,64,5,71,26,19,184,200,215,254,13,194,97,5,201,207,34,15,62,34,205,96,5,254,13,225,202,71,1,35,35,35,233,207,39,5,62,39,195,113,5,207,95,8,62,141,215,215,225,195,122,5,201,6,0,205,131,4,242,157,5,6,45,13,213,17,10,0,213,13,197,205,102,4,120,177,202,180,5,227,45,229,96,105,195,164,5,193,13,121,183,250,193,5,62,32,215,195,181,5,120,183,196,16,0,93,123,254,10,209,200,198,48,215,195,199,5,26,111,19,26,103,19,14,4,205,146,5,62,32,215,151,205,96,5,201,231,200,26,2,19,3,195,229,5,120,146,194,246,5,121,147,200,27,43,26,119,195,238,5,193,225,34,9,16,124,181,202,23,6,225,34,11,16,225,34,13,16,225,34,15,16,225,34,17,16,197,201,33,222,19,205,134,4,193,57,210,243,4,42,9,16,124,181,202,63,6,42,17,16,229,42,15,16,229,42,13,16,229,42,11,16,229,42,9,16,229,197,201,50,0,16,62,3,211,16,62,21,211,16,22,25,205,14,0,21,194,79,6,151,17,163,6,205,96,5,33,0,0,34,19,16,33,23,16,34,21,16,195,186,0,194,113,6,241,201,219,0,230,2,202,113,6,241,211,1,254,13,192,62,10,215,62,13,201,219,0,0,230,32,200,219,1,230,127,254,15,194,157,6,58,0,16,47,50,0,16,195,132,6,254,3,192,195,186,0,84,73,78,89,32,66,65,83,73,67,13,76,73,83,84,129,111,82,85,78,129,65,78,69,87,129,50,78,69,88,84,130,87,76,69,84,131,35,73,70,130,180,71,79,84,79,129,96,71,79,83,85,66,129,191,82,69,84,85,82,78,129,223,82,69,77,130,176,70,79,82,129,248,73,78,80,85,84,130,205,80,82,73,78,84,129,135,83,84,79,80,129,59,131,29,82,78,68,132,37,65,66,83,132,80,83,73,90,69,132,89,132,11,84,79,130,8,132,198,83,84,69,80,130,18,130,22,62,61,131,51,35,131,57,62,131,63,61,131,78,60,61,131,70,60,131,84,131,90,33,173,6,239,213,26,19,254,46,202,90,7,35,190,202,61,7,62,127,27,190,218,97,7,35,190,210,80,7,35,209,195,59,7,62,127,35,190,210,92,7,126,35,110,230,127,103,241,233 3 | }; 4 | -------------------------------------------------------------------------------- /basic.h: -------------------------------------------------------------------------------- 1 | const byte PROGMEM ROM[2048] = { 2 | 243,49,0,20,195,186,0,76,227,239,190,195,104,0,62,13,245,58,0,16,183,195,26,7,205,85,4,229,195,17,4,87,124,186,192,125,187,201,65,78,26,254,32,192,19,195,40,0,241,205,145,5,195,164,5,71,239,214,64,216,194,88,0,19,205,251,4,41,218,159,0,213,235,205,61,5,231,218,208,5,33,0,19,205,96,5,209,201,254,27,63,216,19,33,0,19,7,133,111,62,0,140,103,201,35,202,115,0,197,78,6,0,9,193,27,19,35,227,201,33,0,0,68,239,254,48,216,254,58,208,62,240,164,194,159,0,4,197,68,77,41,41,9,41,26,19,230,15,133,111,62,0,140,103,193,26,242,124,0,213,17,166,0,195,168,5,72,79,87,63,13,79,75,13,87,72,65,84,63,13,83,79,82,82,89,13,205,14,0,17,171,0,151,205,60,6,33,203,0,34,1,16,33,0,0,34,7,16,34,3,16,62,62,205,214,5,213,17,55,19,205,119,0,239,124,181,193,202,245,1,27,124,18,27,125,18,197,213,121,147,245,205,20,6,213,194,8,1,213,205,48,6,193,42,19,16,205,189,6,96,105,34,19,16,193,42,19,16,241,229,254,3,202,0,0,133,111,62,0,140,103,17,0,19,231,210,207,5,34,19,16,209,205,198,6,209,225,205,189,6,195,211,0,76,73,83,84,130,97,82,85,78,130,51,78,69,87,130,38,78,69,88,84,131,73,76,69,84,132,7,73,70,131,154,71,79,84,79,130,82,71,79,83,85,66,130,177,82,69,84,85,82,78,130,209,82,69,77,131,150,70,79,82,130,234,73,78,80,85,84,131,177,80,82,73,78,84,130,121,83,84,79,80,130,47,132,1,89,79,85,32,77,65,89,32,73,78,83,69,82,84,32,32,77,79,82,69,32,67,79,77,77,65,78,68,83,46,82,78,68,133,6,65,66,83,133,49,83,73,90,69,133,61,132,236,89,79,85,32,77,65,89,32,73,78,83,69,82,84,32,32,77,79,82,69,32,70,85,78,67,84,73,79,78,83,84,79,130,250,133,164,83,84,69,80,131,4,131,8,62,61,132,23,35,132,29,62,132,35,61,132,50,60,61,132,42,60,132,56,132,62,33,46,1,239,213,26,19,254,46,202,23,2,35,190,202,250,1,62,127,27,190,218,30,2,35,190,210,13,2,35,209,195,248,1,62,127,35,190,210,25,2,126,35,110,230,127,103,241,233,205,160,5,33,21,16,34,19,16,205,160,5,199,205,160,5,17,21,16,33,0,0,205,28,6,218,0,0,235,34,1,16,235,19,19,205,50,7,33,62,1,195,248,1,223,213,205,160,5,205,20,6,194,160,0,241,195,66,2,205,119,0,205,160,5,205,20,6,218,0,0,205,170,6,205,50,7,205,28,6,195,106,2,14,6,207,59,6,205,14,0,195,73,2,207,13,6,205,14,0,195,57,2,207,35,5,223,77,195,155,2,205,72,6,195,168,2,207,44,6,205,145,5,195,141,2,205,14,0,247,223,197,205,110,6,193,195,155,2,205,241,6,223,213,205,20,6,194,160,0,42,1,16,229,42,3,16,229,33,0,0,34,7,16,57,34,3,16,195,66,2,205,160,5,42,3,16,124,181,202,164,5,249,225,34,3,16,225,34,1,16,209,205,213,6,247,205,241,6,205,126,5,43,34,7,16,33,208,1,195,248,1,223,34,11,16,33,214,1,195,248,1,223,195,11,3,33,1,0,34,9,16,42,1,16,34,13,16,235,34,15,16,1,10,0,42,7,16,235,96,104,57,62,9,126,35,182,202,68,3,126,43,186,194,35,3,126,187,194,35,3,235,33,0,0,57,68,77,33,10,0,25,205,198,6,249,42,15,16,235,247,255,218,164,5,34,5,16,213,235,42,7,16,124,181,202,165,5,231,202,104,3,209,205,213,6,42,5,16,195,80,3,94,35,86,42,9,16,229,25,235,42,7,16,115,35,114,42,11,16,241,183,242,128,3,235,205,118,5,209,218,146,3,42,13,16,34,1,16,42,15,16,235,247,205,213,6,247,33,0,0,62,223,124,181,194,73,2,205,50,6,210,66,2,199,42,5,16,249,225,34,1,16,209,209,213,205,72,6,195,191,3,255,218,249,3,195,207,3,213,255,218,164,5,26,79,151,18,209,205,60,6,121,27,18,213,235,42,1,16,229,33,177,3,34,1,16,33,0,0,57,34,5,16,213,62,58,205,214,5,17,55,19,223,0,0,0,209,235,115,35,114,225,34,1,16,209,241,207,44,3,195,177,3,247,26,254,13,202,16,4,205,126,5,207,44,3,195,7,4,247,33,222,1,195,248,1,205,64,4,216,111,201,205,64,4,200,111,201,205,64,4,200,216,111,201,205,64,4,111,200,216,108,201,205,64,4,192,111,201,205,64,4,208,111,201,225,201,121,225,193,229,197,79,205,85,4,235,227,205,118,5,209,33,0,0,62,1,201,207,45,6,33,0,0,195,127,4,207,43,0,205,137,4,207,43,21,229,205,137,4,235,227,124,170,122,25,209,250,100,4,172,242,100,4,195,159,0,207,45,131,229,205,137,4,205,106,5,195,107,4,205,230,4,207,42,44,229,205,230,4,6,0,205,103,5,235,227,205,103,5,124,183,202,168,4,122,178,235,194,160,0,125,33,0,0,183,202,216,4,25,218,160,0,61,194,176,4,195,216,4,207,47,68,229,205,230,4,6,0,205,103,5,235,227,205,103,5,122,179,202,160,0,197,205,74,5,96,105,193,209,124,183,250,159,0,120,183,252,106,5,195,140,4,33,160,1,195,248,1,255,218,245,4,126,35,102,111,201,205,119,0,120,183,192,207,40,5,223,207,41,1,201,195,164,5,205,251,4,124,183,250,159,0,181,202,159,0,213,229,42,17,16,17,255,7,231,218,33,5,33,0,0,94,35,86,34,17,16,225,235,197,205,74,5,193,209,35,201,205,251,4,205,103,5,124,180,250,159,0,201,42,19,16,213,235,33,0,19,205,96,5,209,201,229,108,38,0,205,85,5,65,125,225,103,14,255,12,205,96,5,210,87,5,25,201,125,147,111,124,154,103,201,124,183,240,124,47,103,125,47,111,35,120,238,128,71,201,124,170,242,124,5,235,231,201,255,218,164,5,229,207,61,8,223,68,77,225,113,35,112,201,195,164,5,207,59,4,241,195,73,2,207,13,4,241,195,57,2,201,239,254,13,200,213,17,174,0,151,205,60,6,209,26,245,151,18,42,1,16,229,126,35,182,209,202,0,0,126,183,250,167,3,205,170,6,27,241,18,62,63,215,151,205,60,6,199,213,17,180,0,195,168,5,215,17,55,19,205,50,7,202,218,5,215,254,10,202,218,5,183,202,218,5,254,127,202,255,5,254,21,202,12,6,18,19,254,13,200,123,254,127,194,218,5,123,254,55,202,12,6,27,62,92,215,195,218,5,205,14,0,62,94,195,214,5,124,183,250,159,0,17,21,16,229,42,19,16,43,231,225,216,26,149,71,19,26,156,218,49,6,27,176,201,19,19,26,254,13,194,49,6,19,195,28,6,71,26,19,184,200,215,254,13,194,61,6,201,207,34,15,62,34,205,60,6,254,13,225,202,57,2,35,35,35,233,207,39,5,62,39,195,77,6,207,95,8,62,141,215,215,225,195,86,6,201,213,17,10,0,213,66,13,205,103,5,242,126,6,6,45,13,197,205,74,5,120,177,202,143,6,227,45,229,96,105,195,127,6,193,13,121,183,250,156,6,62,32,215,195,144,6,120,215,93,123,254,10,209,200,198,48,215,195,159,6,26,111,19,26,103,19,14,4,205,110,6,62,32,215,151,205,60,6,201,231,200,26,2,19,3,195,189,6,120,146,194,206,6,121,147,200,27,43,26,119,195,198,6,193,225,34,7,16,124,181,202,239,6,225,34,9,16,225,34,11,16,225,34,13,16,225,34,15,16,197,201,33,167,19,205,106,5,193,57,210,207,5,42,7,16,124,181,202,23,7,42,15,16,229,42,13,16,229,42,11,16,229,42,9,16,229,42,7,16,229,197,201,194,31,7,241,201,219,0,230,2,202,31,7,241,211,1,254,13,192,62,10,215,62,13,201,219,0,0,230,32,200,219,1,230,127,254,15,194,75,7,58,0,16,47,50,0,16,195,50,7,254,3,192,199,89,79,85,32,77,65,89,32,78,69,69,68,32,84,72,73,83,32,83,80,65,67,69,32,84,79,80,65,84,67,72,32,85,80,32,84,72,69,32,73,47,79,32,82,79,85,84,73,78,69,83,44,84,79,32,70,73,88,32,85,80,32,66,85,71,83,44,32,79,82,32,84,79,32,65,68,68,77,79,82,69,32,67,79,77,77,65,78,68,83,32,65,78,68,32,70,85,78,67,84,73,79,78,83,46,83,75,89,32,40,83,80,65,67,69,41,32,73,83,32,84,72,69,32,76,73,77,73,84,46,71,79,79,68,32,76,85,67,75,32,65,78,68,32,71,79,79,68,32,66,89,69,46,76,73,67,72,69,78,32,87,65,78,71,44,32,49,48,32,74,85,78,69,32,55,54 3 | }; 4 | -------------------------------------------------------------------------------- /i8080.cpp: -------------------------------------------------------------------------------- 1 | // Intel 8080 (KR580VM80A) microprocessor core model 2 | // 3 | // Copyright (C) 2012 Alexander Demin 4 | // 5 | // Credits 6 | // 7 | // Viacheslav Slavinsky, Vector-06C FPGA Replica 8 | // http://code.google.com/p/vector06cc/ 9 | // 10 | // Dmitry Tselikov, Bashrikia-2M and Radio-86RK on Altera DE1 11 | // http://bashkiria-2m.narod.ru/fpga.html 12 | // 13 | // Ian Bartholomew, 8080/8085 CPU Exerciser 14 | // http://www.idb.me.uk/sunhillow/8080.html 15 | // 16 | // Frank Cringle, The original exerciser for the Z80. 17 | // 18 | // Thanks to zx.pk.ru and nedopc.org/forum communities. 19 | // 20 | // This program is free software; you can redistribute it and/or modify 21 | // it under the terms of the GNU General Public License as published by 22 | // the Free Software Foundation; either version 2, or (at your option) 23 | // any later version. 24 | // 25 | // This program is distributed in the hope that it will be useful, 26 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | // GNU General Public License for more details. 29 | // 30 | // You should have received a copy of the GNU General Public License 31 | // along with this program; if not, write to the Free Software 32 | // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 33 | 34 | #include "i8080.h" 35 | #include "i8080_hal.h" 36 | 37 | #define RD_BYTE(addr) i8080_hal_memory_read_byte(addr) 38 | #define RD_WORD(addr) i8080_hal_memory_read_word(addr) 39 | 40 | #define WR_BYTE(addr, value) i8080_hal_memory_write_byte(addr, value) 41 | #define WR_WORD(addr, value) i8080_hal_memory_write_word(addr, value) 42 | 43 | typedef unsigned char uns8; 44 | typedef unsigned short uns16; 45 | typedef unsigned long int uns32; 46 | typedef signed char sgn8; 47 | typedef signed short sgn16; 48 | typedef signed long int sgn32; 49 | 50 | typedef union { 51 | struct { 52 | uns8 l, h; 53 | } b; 54 | uns16 w; 55 | } reg_pair; 56 | 57 | typedef struct { 58 | uns8 carry_flag; 59 | uns8 unused1; 60 | uns8 parity_flag; 61 | uns8 unused3; 62 | uns8 half_carry_flag; 63 | uns8 unused5; 64 | uns8 zero_flag; 65 | uns8 sign_flag; 66 | } flag_reg; 67 | 68 | struct i8080 { 69 | flag_reg f; 70 | reg_pair af, bc, de, hl; 71 | reg_pair sp, pc; 72 | uns16 iff; 73 | uns16 last_pc; 74 | }; 75 | 76 | #define FLAGS cpu.f 77 | #define AF cpu.af.w 78 | #define BC cpu.bc.w 79 | #define DE cpu.de.w 80 | #define HL cpu.hl.w 81 | #define SP cpu.sp.w 82 | #define PC cpu.pc.w 83 | #define A cpu.af.b.h 84 | #define F cpu.af.b.l 85 | #define B cpu.bc.b.h 86 | #define C cpu.bc.b.l 87 | #define D cpu.de.b.h 88 | #define E cpu.de.b.l 89 | #define H cpu.hl.b.h 90 | #define L cpu.hl.b.l 91 | #define HSP cpu.sp.b.h 92 | #define LSP cpu.sp.b.l 93 | #define HPC cpu.pc.b.h 94 | #define LPC cpu.pc.b.l 95 | #define IFF cpu.iff 96 | 97 | #define F_CARRY 0x01 98 | #define F_UN1 0x02 99 | #define F_PARITY 0x04 100 | #define F_UN3 0x08 101 | #define F_HCARRY 0x10 102 | #define F_UN5 0x20 103 | #define F_ZERO 0x40 104 | #define F_NEG 0x80 105 | 106 | #define C_FLAG FLAGS.carry_flag 107 | #define P_FLAG FLAGS.parity_flag 108 | #define H_FLAG FLAGS.half_carry_flag 109 | #define Z_FLAG FLAGS.zero_flag 110 | #define S_FLAG FLAGS.sign_flag 111 | #define UN1_FLAG FLAGS.unused1 112 | #define UN3_FLAG FLAGS.unused3 113 | #define UN5_FLAG FLAGS.unused5 114 | 115 | #define SET(flag) (flag = 1) 116 | #define CLR(flag) (flag = 0) 117 | #define TST(flag) (flag) 118 | #define CPL(flag) (flag = !flag) 119 | 120 | #define POP(reg) { (reg) = RD_WORD(SP); SP += 2; } 121 | #define PUSH(reg) { SP -= 2; WR_WORD(SP, (reg)); } 122 | #define RET() { POP(PC); } 123 | #define STC() { SET(C_FLAG); } 124 | #define CMC() { CPL(C_FLAG); } 125 | 126 | #define INR(reg) \ 127 | { \ 128 | ++(reg); \ 129 | S_FLAG = (((reg) & 0x80) != 0); \ 130 | Z_FLAG = ((reg) == 0); \ 131 | H_FLAG = (((reg) & 0x0f) == 0); \ 132 | P_FLAG = PARITY(reg); \ 133 | } 134 | 135 | #define DCR(reg) \ 136 | { \ 137 | --(reg); \ 138 | S_FLAG = (((reg) & 0x80) != 0); \ 139 | Z_FLAG = ((reg) == 0); \ 140 | H_FLAG = !(((reg) & 0x0f) == 0x0f); \ 141 | P_FLAG = PARITY(reg); \ 142 | } 143 | 144 | #define ADD(val) \ 145 | { \ 146 | work16 = (uns16)A + (val); \ 147 | index = ((A & 0x88) >> 1) | \ 148 | (((val) & 0x88) >> 2) | \ 149 | ((work16 & 0x88) >> 3); \ 150 | A = work16 & 0xff; \ 151 | S_FLAG = ((A & 0x80) != 0); \ 152 | Z_FLAG = (A == 0); \ 153 | H_FLAG = half_carry_table[index & 0x7]; \ 154 | P_FLAG = PARITY(A); \ 155 | C_FLAG = ((work16 & 0x0100) != 0); \ 156 | } 157 | 158 | #define ADC(val) \ 159 | { \ 160 | work16 = (uns16)A + (val) + C_FLAG; \ 161 | index = ((A & 0x88) >> 1) | \ 162 | (((val) & 0x88) >> 2) | \ 163 | ((work16 & 0x88) >> 3); \ 164 | A = work16 & 0xff; \ 165 | S_FLAG = ((A & 0x80) != 0); \ 166 | Z_FLAG = (A == 0); \ 167 | H_FLAG = half_carry_table[index & 0x7]; \ 168 | P_FLAG = PARITY(A); \ 169 | C_FLAG = ((work16 & 0x0100) != 0); \ 170 | } 171 | 172 | #define SUB(val) \ 173 | { \ 174 | work16 = (uns16)A - (val); \ 175 | index = ((A & 0x88) >> 1) | \ 176 | (((val) & 0x88) >> 2) | \ 177 | ((work16 & 0x88) >> 3); \ 178 | A = work16 & 0xff; \ 179 | S_FLAG = ((A & 0x80) != 0); \ 180 | Z_FLAG = (A == 0); \ 181 | H_FLAG = !sub_half_carry_table[index & 0x7]; \ 182 | P_FLAG = PARITY(A); \ 183 | C_FLAG = ((work16 & 0x0100) != 0); \ 184 | } 185 | 186 | #define SBB(val) \ 187 | { \ 188 | work16 = (uns16)A - (val) - C_FLAG; \ 189 | index = ((A & 0x88) >> 1) | \ 190 | (((val) & 0x88) >> 2) | \ 191 | ((work16 & 0x88) >> 3); \ 192 | A = work16 & 0xff; \ 193 | S_FLAG = ((A & 0x80) != 0); \ 194 | Z_FLAG = (A == 0); \ 195 | H_FLAG = !sub_half_carry_table[index & 0x7]; \ 196 | P_FLAG = PARITY(A); \ 197 | C_FLAG = ((work16 & 0x0100) != 0); \ 198 | } 199 | 200 | #define CMP(val) \ 201 | { \ 202 | work16 = (uns16)A - (val); \ 203 | index = ((A & 0x88) >> 1) | \ 204 | (((val) & 0x88) >> 2) | \ 205 | ((work16 & 0x88) >> 3); \ 206 | S_FLAG = ((work16 & 0x80) != 0); \ 207 | Z_FLAG = ((work16 & 0xff) == 0); \ 208 | H_FLAG = !sub_half_carry_table[index & 0x7]; \ 209 | C_FLAG = ((work16 & 0x0100) != 0); \ 210 | P_FLAG = PARITY(work16 & 0xff); \ 211 | } 212 | 213 | #define ANA(val) \ 214 | { \ 215 | H_FLAG = ((A | val) & 0x08) != 0; \ 216 | A &= (val); \ 217 | S_FLAG = ((A & 0x80) != 0); \ 218 | Z_FLAG = (A == 0); \ 219 | P_FLAG = PARITY(A); \ 220 | CLR(C_FLAG); \ 221 | } 222 | 223 | #define XRA(val) \ 224 | { \ 225 | A ^= (val); \ 226 | S_FLAG = ((A & 0x80) != 0); \ 227 | Z_FLAG = (A == 0); \ 228 | CLR(H_FLAG); \ 229 | P_FLAG = PARITY(A); \ 230 | CLR(C_FLAG); \ 231 | } 232 | 233 | #define ORA(val) \ 234 | { \ 235 | A |= (val); \ 236 | S_FLAG = ((A & 0x80) != 0); \ 237 | Z_FLAG = (A == 0); \ 238 | CLR(H_FLAG); \ 239 | P_FLAG = PARITY(A); \ 240 | CLR(C_FLAG); \ 241 | } 242 | 243 | #define DAD(reg) \ 244 | { \ 245 | work32 = (uns32)HL + (reg); \ 246 | HL = work32 & 0xffff; \ 247 | C_FLAG = ((work32 & 0x10000L) != 0); \ 248 | } 249 | 250 | #define CALL \ 251 | { \ 252 | PUSH(PC + 2); \ 253 | PC = RD_WORD(PC); \ 254 | } 255 | 256 | #define RST(addr) \ 257 | { \ 258 | PUSH(PC); \ 259 | PC = (addr); \ 260 | } 261 | 262 | #define PARITY(reg) getParity(reg) 263 | 264 | static struct i8080 cpu; 265 | 266 | static uns32 work32; 267 | static uns16 work16; 268 | static uns8 work8; 269 | static int index; 270 | static uns8 carry, add; 271 | 272 | //int parity_table[] = { 273 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 274 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 275 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 276 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 277 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 278 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 279 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 280 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 281 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 282 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 283 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 284 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 285 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 286 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 287 | // 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 288 | // 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 289 | //}; 290 | 291 | int getParity(int val) { 292 | val ^= val >> 4; 293 | val &= 0xf; 294 | return !((0x6996 >> val) & 1); 295 | } 296 | 297 | int half_carry_table[] = { 0, 0, 1, 0, 1, 0, 1, 1 }; 298 | int sub_half_carry_table[] = { 0, 1, 1, 1, 0, 0, 0, 1 }; 299 | 300 | void i8080_init(void) { 301 | C_FLAG = 0; 302 | S_FLAG = 0; 303 | Z_FLAG = 0; 304 | H_FLAG = 0; 305 | P_FLAG = 0; 306 | UN1_FLAG = 1; 307 | UN3_FLAG = 0; 308 | UN5_FLAG = 0; 309 | 310 | PC = 0xF800; 311 | } 312 | 313 | static void i8080_store_flags(void) { 314 | if (S_FLAG) F |= F_NEG; else F &= ~F_NEG; 315 | if (Z_FLAG) F |= F_ZERO; else F &= ~F_ZERO; 316 | if (H_FLAG) F |= F_HCARRY; else F &= ~F_HCARRY; 317 | if (P_FLAG) F |= F_PARITY; else F &= ~F_PARITY; 318 | if (C_FLAG) F |= F_CARRY; else F &= ~F_CARRY; 319 | F |= F_UN1; // UN1_FLAG is always 1. 320 | F &= ~F_UN3; // UN3_FLAG is always 0. 321 | F &= ~F_UN5; // UN5_FLAG is always 0. 322 | } 323 | 324 | static void i8080_retrieve_flags(void) { 325 | S_FLAG = F & F_NEG ? 1 : 0; 326 | Z_FLAG = F & F_ZERO ? 1 : 0; 327 | H_FLAG = F & F_HCARRY ? 1 : 0; 328 | P_FLAG = F & F_PARITY ? 1 : 0; 329 | C_FLAG = F & F_CARRY ? 1 : 0; 330 | } 331 | 332 | static int i8080_execute(int opcode) { 333 | int cpu_cycles; 334 | switch (opcode) { 335 | case 0x00: /* nop */ 336 | // Undocumented NOP. 337 | case 0x08: /* nop */ 338 | case 0x10: /* nop */ 339 | case 0x18: /* nop */ 340 | case 0x20: /* nop */ 341 | case 0x28: /* nop */ 342 | case 0x30: /* nop */ 343 | case 0x38: /* nop */ 344 | cpu_cycles = 4; 345 | break; 346 | 347 | case 0x01: /* lxi b, data16 */ 348 | cpu_cycles = 10; 349 | BC = RD_WORD(PC); 350 | PC += 2; 351 | break; 352 | 353 | case 0x02: /* stax b */ 354 | cpu_cycles = 7; 355 | WR_BYTE(BC, A); 356 | break; 357 | 358 | case 0x03: /* inx b */ 359 | cpu_cycles = 5; 360 | BC++; 361 | break; 362 | 363 | case 0x04: /* inr b */ 364 | cpu_cycles = 5; 365 | INR(B); 366 | break; 367 | 368 | case 0x05: /* dcr b */ 369 | cpu_cycles = 5; 370 | DCR(B); 371 | break; 372 | 373 | case 0x06: /* mvi b, data8 */ 374 | cpu_cycles = 7; 375 | B = RD_BYTE(PC++); 376 | break; 377 | 378 | case 0x07: /* rlc */ 379 | cpu_cycles = 4; 380 | C_FLAG = ((A & 0x80) != 0); 381 | A = (A << 1) | C_FLAG; 382 | break; 383 | 384 | case 0x09: /* dad b */ 385 | cpu_cycles = 10; 386 | DAD(BC); 387 | break; 388 | 389 | case 0x0A: /* ldax b */ 390 | cpu_cycles = 7; 391 | A = RD_BYTE(BC); 392 | break; 393 | 394 | case 0x0B: /* dcx b */ 395 | cpu_cycles = 5; 396 | BC--; 397 | break; 398 | 399 | case 0x0C: /* inr c */ 400 | cpu_cycles = 5; 401 | INR(C); 402 | break; 403 | 404 | case 0x0D: /* dcr c */ 405 | cpu_cycles = 5; 406 | DCR(C); 407 | break; 408 | 409 | case 0x0E: /* mvi c, data8 */ 410 | cpu_cycles = 7; 411 | C = RD_BYTE(PC++); 412 | break; 413 | 414 | case 0x0F: /* rrc */ 415 | cpu_cycles = 4; 416 | C_FLAG = A & 0x01; 417 | A = (A >> 1) | (C_FLAG << 7); 418 | break; 419 | 420 | case 0x11: /* lxi d, data16 */ 421 | cpu_cycles = 10; 422 | DE = RD_WORD(PC); 423 | PC += 2; 424 | break; 425 | 426 | case 0x12: /* stax d */ 427 | cpu_cycles = 7; 428 | WR_BYTE(DE, A); 429 | break; 430 | 431 | case 0x13: /* inx d */ 432 | cpu_cycles = 5; 433 | DE++; 434 | break; 435 | 436 | case 0x14: /* inr d */ 437 | cpu_cycles = 5; 438 | INR(D); 439 | break; 440 | 441 | case 0x15: /* dcr d */ 442 | cpu_cycles = 5; 443 | DCR(D); 444 | break; 445 | 446 | case 0x16: /* mvi d, data8 */ 447 | cpu_cycles = 7; 448 | D = RD_BYTE(PC++); 449 | break; 450 | 451 | case 0x17: /* ral */ 452 | cpu_cycles = 4; 453 | work8 = (uns8)C_FLAG; 454 | C_FLAG = ((A & 0x80) != 0); 455 | A = (A << 1) | work8; 456 | break; 457 | 458 | case 0x19: /* dad d */ 459 | cpu_cycles = 10; 460 | DAD(DE); 461 | break; 462 | 463 | case 0x1A: /* ldax d */ 464 | cpu_cycles = 7; 465 | A = RD_BYTE(DE); 466 | break; 467 | 468 | case 0x1B: /* dcx d */ 469 | cpu_cycles = 5; 470 | DE--; 471 | break; 472 | 473 | case 0x1C: /* inr e */ 474 | cpu_cycles = 5; 475 | INR(E); 476 | break; 477 | 478 | case 0x1D: /* dcr e */ 479 | cpu_cycles = 5; 480 | DCR(E); 481 | break; 482 | 483 | case 0x1E: /* mvi e, data8 */ 484 | cpu_cycles = 7; 485 | E = RD_BYTE(PC++); 486 | break; 487 | 488 | case 0x1F: /* rar */ 489 | cpu_cycles = 4; 490 | work8 = (uns8)C_FLAG; 491 | C_FLAG = A & 0x01; 492 | A = (A >> 1) | (work8 << 7); 493 | break; 494 | 495 | case 0x21: /* lxi h, data16 */ 496 | cpu_cycles = 10; 497 | HL = RD_WORD(PC); 498 | PC += 2; 499 | break; 500 | 501 | case 0x22: /* shld addr */ 502 | cpu_cycles = 16; 503 | WR_WORD(RD_WORD(PC), HL); 504 | PC += 2; 505 | break; 506 | 507 | case 0x23: /* inx h */ 508 | cpu_cycles = 5; 509 | HL++; 510 | break; 511 | 512 | case 0x24: /* inr h */ 513 | cpu_cycles = 5; 514 | INR(H); 515 | break; 516 | 517 | case 0x25: /* dcr h */ 518 | cpu_cycles = 5; 519 | DCR(H); 520 | break; 521 | 522 | case 0x26: /* mvi h, data8 */ 523 | cpu_cycles = 7; 524 | H = RD_BYTE(PC++); 525 | break; 526 | 527 | case 0x27: /* daa */ 528 | cpu_cycles = 4; 529 | carry = (uns8)C_FLAG; 530 | add = 0; 531 | if (H_FLAG || (A & 0x0f) > 9) { 532 | add = 0x06; 533 | } 534 | if (C_FLAG || (A >> 4) > 9 || ((A >> 4) >= 9 && (A & 0x0f) > 9)) { 535 | add |= 0x60; 536 | carry = 1; 537 | } 538 | ADD(add); 539 | P_FLAG = PARITY(A); 540 | C_FLAG = carry; 541 | break; 542 | 543 | case 0x29: /* dad hl */ 544 | cpu_cycles = 10; 545 | DAD(HL); 546 | break; 547 | 548 | case 0x2A: /* ldhl addr */ 549 | cpu_cycles = 16; 550 | HL = RD_WORD(RD_WORD(PC)); 551 | PC += 2; 552 | break; 553 | 554 | case 0x2B: /* dcx h */ 555 | cpu_cycles = 5; 556 | HL--; 557 | break; 558 | 559 | case 0x2C: /* inr l */ 560 | cpu_cycles = 5; 561 | INR(L); 562 | break; 563 | 564 | case 0x2D: /* dcr l */ 565 | cpu_cycles = 5; 566 | DCR(L); 567 | break; 568 | 569 | case 0x2E: /* mvi l, data8 */ 570 | cpu_cycles = 7; 571 | L = RD_BYTE(PC++); 572 | break; 573 | 574 | case 0x2F: /* cma */ 575 | cpu_cycles = 4; 576 | A ^= 0xff; 577 | break; 578 | 579 | case 0x31: /* lxi sp, data16 */ 580 | cpu_cycles = 10; 581 | SP = RD_WORD(PC); 582 | PC += 2; 583 | break; 584 | 585 | case 0x32: /* sta addr */ 586 | cpu_cycles = 13; 587 | WR_BYTE(RD_WORD(PC), A); 588 | PC += 2; 589 | break; 590 | 591 | case 0x33: /* inx sp */ 592 | cpu_cycles = 5; 593 | SP++; 594 | break; 595 | 596 | case 0x34: /* inr m */ 597 | cpu_cycles = 10; 598 | work8 = RD_BYTE(HL); 599 | INR(work8); 600 | WR_BYTE(HL, work8); 601 | break; 602 | 603 | case 0x35: /* dcr m */ 604 | cpu_cycles = 10; 605 | work8 = RD_BYTE(HL); 606 | DCR(work8); 607 | WR_BYTE(HL, work8); 608 | break; 609 | 610 | case 0x36: /* mvi m, data8 */ 611 | cpu_cycles = 10; 612 | WR_BYTE(HL, RD_BYTE(PC++)); 613 | break; 614 | 615 | case 0x37: /* stc */ 616 | cpu_cycles = 4; 617 | SET(C_FLAG); 618 | break; 619 | 620 | case 0x39: /* dad sp */ 621 | cpu_cycles = 10; 622 | DAD(SP); 623 | break; 624 | 625 | case 0x3A: /* lda addr */ 626 | cpu_cycles = 13; 627 | A = RD_BYTE(RD_WORD(PC)); 628 | PC += 2; 629 | break; 630 | 631 | case 0x3B: /* dcx sp */ 632 | cpu_cycles = 5; 633 | SP--; 634 | break; 635 | 636 | case 0x3C: /* inr a */ 637 | cpu_cycles = 5; 638 | INR(A); 639 | break; 640 | 641 | case 0x3D: /* dcr a */ 642 | cpu_cycles = 5; 643 | DCR(A); 644 | break; 645 | 646 | case 0x3E: /* mvi a, data8 */ 647 | cpu_cycles = 7; 648 | A = RD_BYTE(PC++); 649 | break; 650 | 651 | case 0x3F: /* cmc */ 652 | cpu_cycles = 4; 653 | CPL(C_FLAG); 654 | break; 655 | 656 | case 0x40: /* mov b, b */ 657 | cpu_cycles = 4; 658 | break; 659 | 660 | case 0x41: /* mov b, c */ 661 | cpu_cycles = 5; 662 | B = C; 663 | break; 664 | 665 | case 0x42: /* mov b, d */ 666 | cpu_cycles = 5; 667 | B = D; 668 | break; 669 | 670 | case 0x43: /* mov b, e */ 671 | cpu_cycles = 5; 672 | B = E; 673 | break; 674 | 675 | case 0x44: /* mov b, h */ 676 | cpu_cycles = 5; 677 | B = H; 678 | break; 679 | 680 | case 0x45: /* mov b, l */ 681 | cpu_cycles = 5; 682 | B = L; 683 | break; 684 | 685 | case 0x46: /* mov b, m */ 686 | cpu_cycles = 7; 687 | B = RD_BYTE(HL); 688 | break; 689 | 690 | case 0x47: /* mov b, a */ 691 | cpu_cycles = 5; 692 | B = A; 693 | break; 694 | 695 | case 0x48: /* mov c, b */ 696 | cpu_cycles = 5; 697 | C = B; 698 | break; 699 | 700 | case 0x49: /* mov c, c */ 701 | cpu_cycles = 5; 702 | break; 703 | 704 | case 0x4A: /* mov c, d */ 705 | cpu_cycles = 5; 706 | C = D; 707 | break; 708 | 709 | case 0x4B: /* mov c, e */ 710 | cpu_cycles = 5; 711 | C = E; 712 | break; 713 | 714 | case 0x4C: /* mov c, h */ 715 | cpu_cycles = 5; 716 | C = H; 717 | break; 718 | 719 | case 0x4D: /* mov c, l */ 720 | cpu_cycles = 5; 721 | C = L; 722 | break; 723 | 724 | case 0x4E: /* mov c, m */ 725 | cpu_cycles = 7; 726 | C = RD_BYTE(HL); 727 | break; 728 | 729 | case 0x4F: /* mov c, a */ 730 | cpu_cycles = 5; 731 | C = A; 732 | break; 733 | 734 | case 0x50: /* mov d, b */ 735 | cpu_cycles = 5; 736 | D = B; 737 | break; 738 | 739 | case 0x51: /* mov d, c */ 740 | cpu_cycles = 5; 741 | D = C; 742 | break; 743 | 744 | case 0x52: /* mov d, d */ 745 | cpu_cycles = 5; 746 | break; 747 | 748 | case 0x53: /* mov d, e */ 749 | cpu_cycles = 5; 750 | D = E; 751 | break; 752 | 753 | case 0x54: /* mov d, h */ 754 | cpu_cycles = 5; 755 | D = H; 756 | break; 757 | 758 | case 0x55: /* mov d, l */ 759 | cpu_cycles = 5; 760 | D = L; 761 | break; 762 | 763 | case 0x56: /* mov d, m */ 764 | cpu_cycles = 7; 765 | D = RD_BYTE(HL); 766 | break; 767 | 768 | case 0x57: /* mov d, a */ 769 | cpu_cycles = 5; 770 | D = A; 771 | break; 772 | 773 | case 0x58: /* mov e, b */ 774 | cpu_cycles = 5; 775 | E = B; 776 | break; 777 | 778 | case 0x59: /* mov e, c */ 779 | cpu_cycles = 5; 780 | E = C; 781 | break; 782 | 783 | case 0x5A: /* mov e, d */ 784 | cpu_cycles = 5; 785 | E = D; 786 | break; 787 | 788 | case 0x5B: /* mov e, e */ 789 | cpu_cycles = 5; 790 | break; 791 | 792 | case 0x5C: /* mov c, h */ 793 | cpu_cycles = 5; 794 | E = H; 795 | break; 796 | 797 | case 0x5D: /* mov c, l */ 798 | cpu_cycles = 5; 799 | E = L; 800 | break; 801 | 802 | case 0x5E: /* mov c, m */ 803 | cpu_cycles = 7; 804 | E = RD_BYTE(HL); 805 | break; 806 | 807 | case 0x5F: /* mov c, a */ 808 | cpu_cycles = 5; 809 | E = A; 810 | break; 811 | 812 | case 0x60: /* mov h, b */ 813 | cpu_cycles = 5; 814 | H = B; 815 | break; 816 | 817 | case 0x61: /* mov h, c */ 818 | cpu_cycles = 5; 819 | H = C; 820 | break; 821 | 822 | case 0x62: /* mov h, d */ 823 | cpu_cycles = 5; 824 | H = D; 825 | break; 826 | 827 | case 0x63: /* mov h, e */ 828 | cpu_cycles = 5; 829 | H = E; 830 | break; 831 | 832 | case 0x64: /* mov h, h */ 833 | cpu_cycles = 5; 834 | break; 835 | 836 | case 0x65: /* mov h, l */ 837 | cpu_cycles = 5; 838 | H = L; 839 | break; 840 | 841 | case 0x66: /* mov h, m */ 842 | cpu_cycles = 7; 843 | H = RD_BYTE(HL); 844 | break; 845 | 846 | case 0x67: /* mov h, a */ 847 | cpu_cycles = 5; 848 | H = A; 849 | break; 850 | 851 | case 0x68: /* mov l, b */ 852 | cpu_cycles = 5; 853 | L = B; 854 | break; 855 | 856 | case 0x69: /* mov l, c */ 857 | cpu_cycles = 5; 858 | L = C; 859 | break; 860 | 861 | case 0x6A: /* mov l, d */ 862 | cpu_cycles = 5; 863 | L = D; 864 | break; 865 | 866 | case 0x6B: /* mov l, e */ 867 | cpu_cycles = 5; 868 | L = E; 869 | break; 870 | 871 | case 0x6C: /* mov l, h */ 872 | cpu_cycles = 5; 873 | L = H; 874 | break; 875 | 876 | case 0x6D: /* mov l, l */ 877 | cpu_cycles = 5; 878 | break; 879 | 880 | case 0x6E: /* mov l, m */ 881 | cpu_cycles = 7; 882 | L = RD_BYTE(HL); 883 | break; 884 | 885 | case 0x6F: /* mov l, a */ 886 | cpu_cycles = 5; 887 | L = A; 888 | break; 889 | 890 | case 0x70: /* mov m, b */ 891 | cpu_cycles = 7; 892 | WR_BYTE(HL, B); 893 | break; 894 | 895 | case 0x71: /* mov m, c */ 896 | cpu_cycles = 7; 897 | WR_BYTE(HL, C); 898 | break; 899 | 900 | case 0x72: /* mov m, d */ 901 | cpu_cycles = 7; 902 | WR_BYTE(HL, D); 903 | break; 904 | 905 | case 0x73: /* mov m, e */ 906 | cpu_cycles = 7; 907 | WR_BYTE(HL, E); 908 | break; 909 | 910 | case 0x74: /* mov m, h */ 911 | cpu_cycles = 7; 912 | WR_BYTE(HL, H); 913 | break; 914 | 915 | case 0x75: /* mov m, l */ 916 | cpu_cycles = 7; 917 | WR_BYTE(HL, L); 918 | break; 919 | 920 | case 0x76: /* hlt */ 921 | cpu_cycles = 4; 922 | PC--; 923 | break; 924 | 925 | case 0x77: /* mov m, a */ 926 | cpu_cycles = 7; 927 | WR_BYTE(HL, A); 928 | break; 929 | 930 | case 0x78: /* mov a, b */ 931 | cpu_cycles = 5; 932 | A = B; 933 | break; 934 | 935 | case 0x79: /* mov a, c */ 936 | cpu_cycles = 5; 937 | A = C; 938 | break; 939 | 940 | case 0x7A: /* mov a, d */ 941 | cpu_cycles = 5; 942 | A = D; 943 | break; 944 | 945 | case 0x7B: /* mov a, e */ 946 | cpu_cycles = 5; 947 | A = E; 948 | break; 949 | 950 | case 0x7C: /* mov a, h */ 951 | cpu_cycles = 5; 952 | A = H; 953 | break; 954 | 955 | case 0x7D: /* mov a, l */ 956 | cpu_cycles = 5; 957 | A = L; 958 | break; 959 | 960 | case 0x7E: /* mov a, m */ 961 | cpu_cycles = 7; 962 | A = RD_BYTE(HL); 963 | break; 964 | 965 | case 0x7F: /* mov a, a */ 966 | cpu_cycles = 5; 967 | break; 968 | 969 | case 0x80: /* add b */ 970 | cpu_cycles = 4; 971 | ADD(B); 972 | break; 973 | 974 | case 0x81: /* add c */ 975 | cpu_cycles = 4; 976 | ADD(C); 977 | break; 978 | 979 | case 0x82: /* add d */ 980 | cpu_cycles = 4; 981 | ADD(D); 982 | break; 983 | 984 | case 0x83: /* add e */ 985 | cpu_cycles = 4; 986 | ADD(E); 987 | break; 988 | 989 | case 0x84: /* add h */ 990 | cpu_cycles = 4; 991 | ADD(H); 992 | break; 993 | 994 | case 0x85: /* add l */ 995 | cpu_cycles = 4; 996 | ADD(L); 997 | break; 998 | 999 | case 0x86: /* add m */ 1000 | cpu_cycles = 7; 1001 | work8 = RD_BYTE(HL); 1002 | ADD(work8); 1003 | break; 1004 | 1005 | case 0x87: /* add a */ 1006 | cpu_cycles = 4; 1007 | ADD(A); 1008 | break; 1009 | 1010 | case 0x88: /* adc b */ 1011 | cpu_cycles = 4; 1012 | ADC(B); 1013 | break; 1014 | 1015 | case 0x89: /* adc c */ 1016 | cpu_cycles = 4; 1017 | ADC(C); 1018 | break; 1019 | 1020 | case 0x8A: /* adc d */ 1021 | cpu_cycles = 4; 1022 | ADC(D); 1023 | break; 1024 | 1025 | case 0x8B: /* adc e */ 1026 | cpu_cycles = 4; 1027 | ADC(E); 1028 | break; 1029 | 1030 | case 0x8C: /* adc h */ 1031 | cpu_cycles = 4; 1032 | ADC(H); 1033 | break; 1034 | 1035 | case 0x8D: /* adc l */ 1036 | cpu_cycles = 4; 1037 | ADC(L); 1038 | break; 1039 | 1040 | case 0x8E: /* adc m */ 1041 | cpu_cycles = 7; 1042 | work8 = RD_BYTE(HL); 1043 | ADC(work8); 1044 | break; 1045 | 1046 | case 0x8F: /* adc a */ 1047 | cpu_cycles = 4; 1048 | ADC(A); 1049 | break; 1050 | 1051 | case 0x90: /* sub b */ 1052 | cpu_cycles = 4; 1053 | SUB(B); 1054 | break; 1055 | 1056 | case 0x91: /* sub c */ 1057 | cpu_cycles = 4; 1058 | SUB(C); 1059 | break; 1060 | 1061 | case 0x92: /* sub d */ 1062 | cpu_cycles = 4; 1063 | SUB(D); 1064 | break; 1065 | 1066 | case 0x93: /* sub e */ 1067 | cpu_cycles = 4; 1068 | SUB(E); 1069 | break; 1070 | 1071 | case 0x94: /* sub h */ 1072 | cpu_cycles = 4; 1073 | SUB(H); 1074 | break; 1075 | 1076 | case 0x95: /* sub l */ 1077 | cpu_cycles = 4; 1078 | SUB(L); 1079 | break; 1080 | 1081 | case 0x96: /* sub m */ 1082 | cpu_cycles = 7; 1083 | work8 = RD_BYTE(HL); 1084 | SUB(work8); 1085 | break; 1086 | 1087 | case 0x97: /* sub a */ 1088 | cpu_cycles = 4; 1089 | SUB(A); 1090 | break; 1091 | 1092 | case 0x98: /* sbb b */ 1093 | cpu_cycles = 4; 1094 | SBB(B); 1095 | break; 1096 | 1097 | case 0x99: /* sbb c */ 1098 | cpu_cycles = 4; 1099 | SBB(C); 1100 | break; 1101 | 1102 | case 0x9A: /* sbb d */ 1103 | cpu_cycles = 4; 1104 | SBB(D); 1105 | break; 1106 | 1107 | case 0x9B: /* sbb e */ 1108 | cpu_cycles = 4; 1109 | SBB(E); 1110 | break; 1111 | 1112 | case 0x9C: /* sbb h */ 1113 | cpu_cycles = 4; 1114 | SBB(H); 1115 | break; 1116 | 1117 | case 0x9D: /* sbb l */ 1118 | cpu_cycles = 4; 1119 | SBB(L); 1120 | break; 1121 | 1122 | case 0x9E: /* sbb m */ 1123 | cpu_cycles = 7; 1124 | work8 = RD_BYTE(HL); 1125 | SBB(work8); 1126 | break; 1127 | 1128 | case 0x9F: /* sbb a */ 1129 | cpu_cycles = 4; 1130 | SBB(A); 1131 | break; 1132 | 1133 | case 0xA0: /* ana b */ 1134 | cpu_cycles = 4; 1135 | ANA(B); 1136 | break; 1137 | 1138 | case 0xA1: /* ana c */ 1139 | cpu_cycles = 4; 1140 | ANA(C); 1141 | break; 1142 | 1143 | case 0xA2: /* ana d */ 1144 | cpu_cycles = 4; 1145 | ANA(D); 1146 | break; 1147 | 1148 | case 0xA3: /* ana e */ 1149 | cpu_cycles = 4; 1150 | ANA(E); 1151 | break; 1152 | 1153 | case 0xA4: /* ana h */ 1154 | cpu_cycles = 4; 1155 | ANA(H); 1156 | break; 1157 | 1158 | case 0xA5: /* ana l */ 1159 | cpu_cycles = 4; 1160 | ANA(L); 1161 | break; 1162 | 1163 | case 0xA6: /* ana m */ 1164 | cpu_cycles = 7; 1165 | work8 = RD_BYTE(HL); 1166 | ANA(work8); 1167 | break; 1168 | 1169 | case 0xA7: /* ana a */ 1170 | cpu_cycles = 4; 1171 | ANA(A); 1172 | break; 1173 | 1174 | case 0xA8: /* xra b */ 1175 | cpu_cycles = 4; 1176 | XRA(B); 1177 | break; 1178 | 1179 | case 0xA9: /* xra c */ 1180 | cpu_cycles = 4; 1181 | XRA(C); 1182 | break; 1183 | 1184 | case 0xAA: /* xra d */ 1185 | cpu_cycles = 4; 1186 | XRA(D); 1187 | break; 1188 | 1189 | case 0xAB: /* xra e */ 1190 | cpu_cycles = 4; 1191 | XRA(E); 1192 | break; 1193 | 1194 | case 0xAC: /* xra h */ 1195 | cpu_cycles = 4; 1196 | XRA(H); 1197 | break; 1198 | 1199 | case 0xAD: /* xra l */ 1200 | cpu_cycles = 4; 1201 | XRA(L); 1202 | break; 1203 | 1204 | case 0xAE: /* xra m */ 1205 | cpu_cycles = 7; 1206 | work8 = RD_BYTE(HL); 1207 | XRA(work8); 1208 | break; 1209 | 1210 | case 0xAF: /* xra a */ 1211 | cpu_cycles = 4; 1212 | XRA(A); 1213 | break; 1214 | 1215 | case 0xB0: /* ora b */ 1216 | cpu_cycles = 4; 1217 | ORA(B); 1218 | break; 1219 | 1220 | case 0xB1: /* ora c */ 1221 | cpu_cycles = 4; 1222 | ORA(C); 1223 | break; 1224 | 1225 | case 0xB2: /* ora d */ 1226 | cpu_cycles = 4; 1227 | ORA(D); 1228 | break; 1229 | 1230 | case 0xB3: /* ora e */ 1231 | cpu_cycles = 4; 1232 | ORA(E); 1233 | break; 1234 | 1235 | case 0xB4: /* ora h */ 1236 | cpu_cycles = 4; 1237 | ORA(H); 1238 | break; 1239 | 1240 | case 0xB5: /* ora l */ 1241 | cpu_cycles = 4; 1242 | ORA(L); 1243 | break; 1244 | 1245 | case 0xB6: /* ora m */ 1246 | cpu_cycles = 7; 1247 | work8 = RD_BYTE(HL); 1248 | ORA(work8); 1249 | break; 1250 | 1251 | case 0xB7: /* ora a */ 1252 | cpu_cycles = 4; 1253 | ORA(A); 1254 | break; 1255 | 1256 | case 0xB8: /* cmp b */ 1257 | cpu_cycles = 4; 1258 | CMP(B); 1259 | break; 1260 | 1261 | case 0xB9: /* cmp c */ 1262 | cpu_cycles = 4; 1263 | CMP(C); 1264 | break; 1265 | 1266 | case 0xBA: /* cmp d */ 1267 | cpu_cycles = 4; 1268 | CMP(D); 1269 | break; 1270 | 1271 | case 0xBB: /* cmp e */ 1272 | cpu_cycles = 4; 1273 | CMP(E); 1274 | break; 1275 | 1276 | case 0xBC: /* cmp h */ 1277 | cpu_cycles = 4; 1278 | CMP(H); 1279 | break; 1280 | 1281 | case 0xBD: /* cmp l */ 1282 | cpu_cycles = 4; 1283 | CMP(L); 1284 | break; 1285 | 1286 | case 0xBE: /* cmp m */ 1287 | cpu_cycles = 7; 1288 | work8 = RD_BYTE(HL); 1289 | CMP(work8); 1290 | break; 1291 | 1292 | case 0xBF: /* cmp a */ 1293 | cpu_cycles = 4; 1294 | CMP(A); 1295 | break; 1296 | 1297 | case 0xC0: /* rnz */ 1298 | cpu_cycles = 5; 1299 | if (!TST(Z_FLAG)) { 1300 | cpu_cycles = 11; 1301 | POP(PC); 1302 | } 1303 | break; 1304 | 1305 | case 0xC1: /* pop b */ 1306 | cpu_cycles = 11; 1307 | POP(BC); 1308 | break; 1309 | 1310 | case 0xC2: /* jnz addr */ 1311 | cpu_cycles = 10; 1312 | if (!TST(Z_FLAG)) { 1313 | PC = RD_WORD(PC); 1314 | } 1315 | else { 1316 | PC += 2; 1317 | } 1318 | break; 1319 | 1320 | case 0xC3: /* jmp addr */ 1321 | case 0xCB: /* jmp addr, undocumented */ 1322 | cpu_cycles = 10; 1323 | PC = RD_WORD(PC); 1324 | break; 1325 | 1326 | case 0xC4: /* cnz addr */ 1327 | if (!TST(Z_FLAG)) { 1328 | cpu_cycles = 17; 1329 | CALL; 1330 | } else { 1331 | cpu_cycles = 11; 1332 | PC += 2; 1333 | } 1334 | break; 1335 | 1336 | case 0xC5: /* push b */ 1337 | cpu_cycles = 11; 1338 | PUSH(BC); 1339 | break; 1340 | 1341 | case 0xC6: /* adi data8 */ 1342 | cpu_cycles = 7; 1343 | work8 = RD_BYTE(PC++); 1344 | ADD(work8); 1345 | break; 1346 | 1347 | case 0xC7: /* rst 0 */ 1348 | cpu_cycles = 11; 1349 | RST(0x0000); 1350 | break; 1351 | 1352 | case 0xC8: /* rz */ 1353 | cpu_cycles = 5; 1354 | if (TST(Z_FLAG)) { 1355 | cpu_cycles = 11; 1356 | POP(PC); 1357 | } 1358 | break; 1359 | 1360 | case 0xC9: /* ret */ 1361 | case 0xD9: /* ret, undocumented */ 1362 | cpu_cycles = 10; 1363 | POP(PC); 1364 | break; 1365 | 1366 | case 0xCA: /* jz addr */ 1367 | cpu_cycles = 10; 1368 | if (TST(Z_FLAG)) { 1369 | PC = RD_WORD(PC); 1370 | } else { 1371 | PC += 2; 1372 | } 1373 | break; 1374 | 1375 | case 0xCC: /* cz addr */ 1376 | if (TST(Z_FLAG)) { 1377 | cpu_cycles = 17; 1378 | CALL; 1379 | } else { 1380 | cpu_cycles = 11; 1381 | PC += 2; 1382 | } 1383 | break; 1384 | 1385 | case 0xCD: /* call addr */ 1386 | case 0xDD: /* call, undocumented */ 1387 | case 0xED: 1388 | case 0xFD: 1389 | cpu_cycles = 17; 1390 | CALL; 1391 | break; 1392 | 1393 | case 0xCE: /* aci data8 */ 1394 | cpu_cycles = 7; 1395 | work8 = RD_BYTE(PC++); 1396 | ADC(work8); 1397 | break; 1398 | 1399 | case 0xCF: /* rst 1 */ 1400 | cpu_cycles = 11; 1401 | RST(0x0008); 1402 | break; 1403 | 1404 | case 0xD0: /* rnc */ 1405 | cpu_cycles = 5; 1406 | if (!TST(C_FLAG)) { 1407 | cpu_cycles = 11; 1408 | POP(PC); 1409 | } 1410 | break; 1411 | 1412 | case 0xD1: /* pop d */ 1413 | cpu_cycles = 11; 1414 | POP(DE); 1415 | break; 1416 | 1417 | case 0xD2: /* jnc addr */ 1418 | cpu_cycles = 10; 1419 | if (!TST(C_FLAG)) { 1420 | PC = RD_WORD(PC); 1421 | } else { 1422 | PC += 2; 1423 | } 1424 | break; 1425 | 1426 | case 0xD3: /* out port8 */ 1427 | cpu_cycles = 10; 1428 | i8080_hal_io_output(RD_BYTE(PC++), A); 1429 | break; 1430 | 1431 | case 0xD4: /* cnc addr */ 1432 | if (!TST(C_FLAG)) { 1433 | cpu_cycles = 17; 1434 | CALL; 1435 | } else { 1436 | cpu_cycles = 11; 1437 | PC += 2; 1438 | } 1439 | break; 1440 | 1441 | case 0xD5: /* push d */ 1442 | cpu_cycles = 11; 1443 | PUSH(DE); 1444 | break; 1445 | 1446 | case 0xD6: /* sui data8 */ 1447 | cpu_cycles = 7; 1448 | work8 = RD_BYTE(PC++); 1449 | SUB(work8); 1450 | break; 1451 | 1452 | case 0xD7: /* rst 2 */ 1453 | cpu_cycles = 11; 1454 | RST(0x0010); 1455 | break; 1456 | 1457 | case 0xD8: /* rc */ 1458 | cpu_cycles = 5; 1459 | if (TST(C_FLAG)) { 1460 | cpu_cycles = 11; 1461 | POP(PC); 1462 | } 1463 | break; 1464 | 1465 | case 0xDA: /* jc addr */ 1466 | cpu_cycles = 10; 1467 | if (TST(C_FLAG)) { 1468 | PC = RD_WORD(PC); 1469 | } else { 1470 | PC += 2; 1471 | } 1472 | break; 1473 | 1474 | case 0xDB: /* in port8 */ 1475 | cpu_cycles = 10; 1476 | A = i8080_hal_io_input(RD_BYTE(PC++)); 1477 | break; 1478 | 1479 | case 0xDC: /* cc addr */ 1480 | if (TST(C_FLAG)) { 1481 | cpu_cycles = 17; 1482 | CALL; 1483 | } else { 1484 | cpu_cycles = 11; 1485 | PC += 2; 1486 | } 1487 | break; 1488 | 1489 | case 0xDE: /* sbi data8 */ 1490 | cpu_cycles = 7; 1491 | work8 = RD_BYTE(PC++); 1492 | SBB(work8); 1493 | break; 1494 | 1495 | case 0xDF: /* rst 3 */ 1496 | cpu_cycles = 11; 1497 | RST(0x0018); 1498 | break; 1499 | 1500 | case 0xE0: /* rpo */ 1501 | cpu_cycles = 5; 1502 | if (!TST(P_FLAG)) { 1503 | cpu_cycles = 11; 1504 | POP(PC); 1505 | } 1506 | break; 1507 | 1508 | case 0xE1: /* pop h */ 1509 | cpu_cycles = 11; 1510 | POP(HL); 1511 | break; 1512 | 1513 | case 0xE2: /* jpo addr */ 1514 | cpu_cycles = 10; 1515 | if (!TST(P_FLAG)) { 1516 | PC = RD_WORD(PC); 1517 | } 1518 | else { 1519 | PC += 2; 1520 | } 1521 | break; 1522 | 1523 | case 0xE3: /* xthl */ 1524 | cpu_cycles = 18; 1525 | work16 = RD_WORD(SP); 1526 | WR_WORD(SP, HL); 1527 | HL = work16; 1528 | break; 1529 | 1530 | case 0xE4: /* cpo addr */ 1531 | if (!TST(P_FLAG)) { 1532 | cpu_cycles = 17; 1533 | CALL; 1534 | } else { 1535 | cpu_cycles = 11; 1536 | PC += 2; 1537 | } 1538 | break; 1539 | 1540 | case 0xE5: /* push h */ 1541 | cpu_cycles = 11; 1542 | PUSH(HL); 1543 | break; 1544 | 1545 | case 0xE6: /* ani data8 */ 1546 | cpu_cycles = 7; 1547 | work8 = RD_BYTE(PC++); 1548 | ANA(work8); 1549 | break; 1550 | 1551 | case 0xE7: /* rst 4 */ 1552 | cpu_cycles = 11; 1553 | RST(0x0020); 1554 | break; 1555 | 1556 | case 0xE8: /* rpe */ 1557 | cpu_cycles = 5; 1558 | if (TST(P_FLAG)) { 1559 | cpu_cycles = 11; 1560 | POP(PC); 1561 | } 1562 | break; 1563 | 1564 | case 0xE9: /* pchl */ 1565 | cpu_cycles = 5; 1566 | PC = HL; 1567 | break; 1568 | 1569 | case 0xEA: /* jpe addr */ 1570 | cpu_cycles = 10; 1571 | if (TST(P_FLAG)) { 1572 | PC = RD_WORD(PC); 1573 | } else { 1574 | PC += 2; 1575 | } 1576 | break; 1577 | 1578 | case 0xEB: /* xchg */ 1579 | cpu_cycles = 4; 1580 | work16 = DE; 1581 | DE = HL; 1582 | HL = work16; 1583 | break; 1584 | 1585 | case 0xEC: /* cpe addr */ 1586 | if (TST(P_FLAG)) { 1587 | cpu_cycles = 17; 1588 | CALL; 1589 | } else { 1590 | cpu_cycles = 11; 1591 | PC += 2; 1592 | } 1593 | break; 1594 | 1595 | case 0xEE: /* xri data8 */ 1596 | cpu_cycles = 7; 1597 | work8 = RD_BYTE(PC++); 1598 | XRA(work8); 1599 | break; 1600 | 1601 | case 0xEF: /* rst 5 */ 1602 | cpu_cycles = 11; 1603 | RST(0x0028); 1604 | break; 1605 | 1606 | case 0xF0: /* rp */ 1607 | cpu_cycles = 5; 1608 | if (!TST(S_FLAG)) { 1609 | cpu_cycles = 11; 1610 | POP(PC); 1611 | } 1612 | break; 1613 | 1614 | case 0xF1: /* pop psw */ 1615 | cpu_cycles = 10; 1616 | POP(AF); 1617 | i8080_retrieve_flags(); 1618 | break; 1619 | 1620 | case 0xF2: /* jp addr */ 1621 | cpu_cycles = 10; 1622 | if (!TST(S_FLAG)) { 1623 | PC = RD_WORD(PC); 1624 | } else { 1625 | PC += 2; 1626 | } 1627 | break; 1628 | 1629 | case 0xF3: /* di */ 1630 | cpu_cycles = 4; 1631 | IFF = 0; 1632 | i8080_hal_iff(IFF); 1633 | break; 1634 | 1635 | case 0xF4: /* cp addr */ 1636 | if (!TST(S_FLAG)) { 1637 | cpu_cycles = 17; 1638 | CALL; 1639 | } else { 1640 | cpu_cycles = 11; 1641 | PC += 2; 1642 | } 1643 | break; 1644 | 1645 | case 0xF5: /* push psw */ 1646 | cpu_cycles = 11; 1647 | i8080_store_flags(); 1648 | PUSH(AF); 1649 | break; 1650 | 1651 | case 0xF6: /* ori data8 */ 1652 | cpu_cycles = 7; 1653 | work8 = RD_BYTE(PC++); 1654 | ORA(work8); 1655 | break; 1656 | 1657 | case 0xF7: /* rst 6 */ 1658 | cpu_cycles = 11; 1659 | RST(0x0030); 1660 | break; 1661 | 1662 | case 0xF8: /* rm */ 1663 | cpu_cycles = 5; 1664 | if (TST(S_FLAG)) { 1665 | cpu_cycles = 11; 1666 | POP(PC); 1667 | } 1668 | break; 1669 | 1670 | case 0xF9: /* sphl */ 1671 | cpu_cycles = 5; 1672 | SP = HL; 1673 | break; 1674 | 1675 | case 0xFA: /* jm addr */ 1676 | cpu_cycles = 10; 1677 | if (TST(S_FLAG)) { 1678 | PC = RD_WORD(PC); 1679 | } else { 1680 | PC += 2; 1681 | } 1682 | break; 1683 | 1684 | case 0xFB: /* ei */ 1685 | cpu_cycles = 4; 1686 | IFF = 1; 1687 | i8080_hal_iff(IFF); 1688 | break; 1689 | 1690 | case 0xFC: /* cm addr */ 1691 | if (TST(S_FLAG)) { 1692 | cpu_cycles = 17; 1693 | CALL; 1694 | } else { 1695 | cpu_cycles = 11; 1696 | PC += 2; 1697 | } 1698 | break; 1699 | 1700 | case 0xFE: /* cpi data8 */ 1701 | cpu_cycles = 7; 1702 | work8 = RD_BYTE(PC++); 1703 | CMP(work8); 1704 | break; 1705 | 1706 | case 0xFF: /* rst 7 */ 1707 | cpu_cycles = 11; 1708 | RST(0x0038); 1709 | break; 1710 | 1711 | default: 1712 | cpu_cycles = -1; /* Shouldn't be really here. */ 1713 | break; 1714 | } 1715 | return cpu_cycles; 1716 | } 1717 | 1718 | int i8080_instruction(void) { 1719 | return i8080_execute(RD_BYTE(PC++)); 1720 | } 1721 | 1722 | void i8080_jump(int addr) { 1723 | PC = addr & 0xffff; 1724 | } 1725 | 1726 | int i8080_pc(void) { 1727 | return PC; 1728 | } 1729 | 1730 | int i8080_regs_bc(void) { 1731 | return BC; 1732 | } 1733 | 1734 | int i8080_regs_de(void) { 1735 | return DE; 1736 | } 1737 | 1738 | int i8080_regs_hl(void) { 1739 | return HL; 1740 | } 1741 | 1742 | int i8080_regs_sp(void) { 1743 | return SP; 1744 | } 1745 | 1746 | int i8080_regs_a(void) { 1747 | return A; 1748 | } 1749 | 1750 | int i8080_regs_b(void) { 1751 | return B; 1752 | } 1753 | 1754 | int i8080_regs_c(void) { 1755 | return C; 1756 | } 1757 | 1758 | int i8080_regs_d(void) { 1759 | return D; 1760 | } 1761 | 1762 | int i8080_regs_e(void) { 1763 | return E; 1764 | } 1765 | 1766 | int i8080_regs_h(void) { 1767 | return H; 1768 | } 1769 | 1770 | int i8080_regs_l(void) { 1771 | return L; 1772 | } 1773 | -------------------------------------------------------------------------------- /src/tiny2.a80: -------------------------------------------------------------------------------- 1 | ;************************************************************* 2 | ; 3 | ; TINY BASIC FOR INTEL 8080 4 | ; VERSION 2.0 5 | ; BY LI-CHEN WANG 6 | ; MODIFIED AND TRANSLATED 7 | ; TO INTEL MNEMONICS 8 | ; BY ROGER RAUSKOLB 9 | ; 10 OCTOBER,1976 10 | ; @COPYLEFT 11 | ; ALL WRONGS RESERVED 12 | ; 13 | ;************************************************************* 14 | ; 15 | ; *** ZERO PAGE SUBROUTINES *** 16 | ; 17 | ; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW 18 | ; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7. 19 | ; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS 20 | ; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL 21 | ; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR 22 | ; THE SEVEN MOST FREQUENTLY USED SUBROUTINES. 23 | ; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS 24 | ; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS. 25 | ; 26 | .MACRO DWA 27 | DB >%%1 + 128 28 | DB <%%1 29 | .ENDM 30 | ; 31 | ORG 0H 32 | START: LXI SP,STACK ;*** COLD START *** 33 | MVI A,0FFH 34 | JMP INIT 35 | ; 36 | XTHL ;*** TSTC OR RST 1 *** 37 | RST 5 ;IGNORE BLANKS AND 38 | CMP M ;TEST CHARACTER 39 | JMP TC1 ;REST OF THIS IS AT TC1 40 | ; 41 | CRLF: MVI A,CR ;*** CRLF *** 42 | ; 43 | PUSH PSW ;*** OUTC OR RST 2 *** 44 | LDA OCSW ;PRINT CHARACTER ONLY 45 | ORA A ;IF OCSW SWITCH IS ON 46 | JMP OC2 ;REST OF THIS IS AT OC2 47 | ; 48 | CALL EXPR2 ;*** EXPR OR RST 3 *** 49 | PUSH H ;EVALUATE AN EXPRESSION 50 | JMP EXPR1 ;REST OF IT AT EXPR1 51 | DB 'W' 52 | ; 53 | MOV A,H ;*** COMP OR RST 4 *** 54 | CMP D ;COMPARE HL WITH DE 55 | RNZ ;RETURN CORRECT C AND 56 | MOV A,L ;Z FLAGS 57 | CMP E ;BUT OLD A IS LOST 58 | RET 59 | DB 'AN' 60 | ; 61 | SS1: LDAX D ;*** IGNBLK/RST 5 *** 62 | CPI 20H ;IGNORE BLANKS 63 | RNZ ;IN TEXT (WHERE DE->) 64 | INX D ;AND RETURN THE FIRST 65 | JMP SS1 ;NON-BLANK CHAR. IN A 66 | ; 67 | POP PSW ;*** FINISH/RST 6 *** 68 | CALL FIN ;CHECK END OF COMMAND 69 | JMP QWHAT ;PRINT "WHAT?" IF WRONG 70 | DB 'G' 71 | ; 72 | RST 5 ;*** TSTV OR RST 7 *** 73 | SUI 40H ;TEST VARIABLES 74 | RC ;C:NOT A VARIABLE 75 | JNZ TV1 ;NOT "@" ARRAY 76 | INX D ;IT IS THE "@" ARRAY 77 | CALL PARN ;@ SHOULD BE FOLLOWED 78 | DAD H ;BY (EXPR) AS ITS INDEX 79 | JC QHOW ;IS INDEX TOO BIG? 80 | PUSH D ;WILL IT OVERWRITE 81 | XCHG ;TEXT? 82 | CALL SIZE ;FIND SIZE OF FREE 83 | RST 4 ;AND CHECK THAT 84 | JC ASORRY ;IF SO, SAY "SORRY" 85 | LXI H,VARBGN ;IF NOT GET ADDRESS 86 | CALL SUBDE ;OF @(EXPR) AND PUT IT 87 | POP D ;IN HL 88 | RET ;C FLAG IS CLEARED 89 | TV1: CPI 1BH ;NOT @, IS IT A TO Z? 90 | CMC ;IF NOT RETURN C FLAG 91 | RC 92 | INX D ;IF A THROUGH Z 93 | LXI H,VARBGN ;COMPUTE ADDRESS OF 94 | RLC ;THAT VARIABLE 95 | ADD L ;AND RETURN IT IN HL 96 | MOV L,A ;WITH C FLAG CLEARED 97 | MVI A,0 98 | ADC H 99 | MOV H,A 100 | RET 101 | ; 102 | ;TSTC: XTHL ;*** TSTC OR RST 1 *** 103 | ; RST 5 ;THIS IS AT LOC. 8 104 | ; CMP M ;AND THEN JUMP HERE 105 | TC1: INX H ;COMPARE THE BYTE THAT 106 | JZ TC2 ;FOLLOWS THE RST INST. 107 | PUSH B ;WITH THE TEXT (DE->) 108 | MOV C,M ;IF NOT =, ADD THE 2ND 109 | MVI B,0 ;BYTE THAT FOLLOWS THE 110 | DAD B ;RST TO THE OLD PC 111 | POP B ;I.E., DO A RELATIVE 112 | DCX D ;JUMP IF NOT = 113 | TC2: INX D ;IF =, SKIP THOSE BYTES 114 | INX H ;AND CONTINUE 115 | XTHL 116 | RET 117 | ; 118 | TSTNUM: LXI H,0 ;*** TSTNUM *** 119 | MOV B,H ;TEST IF THE TEXT IS 120 | RST 5 ;A NUMBER 121 | TN1: CPI 30H ;IF NOT, RETURN 0 IN 122 | RC ;B AND HL 123 | CPI 3AH ;IF NUMBERS, CONVERT 124 | RNC ;TO BINARY IN HL AND 125 | MVI A,0F0H ;SET B TO # OF DIGITS 126 | ANA H ;IF H>255, THERE IS NO 127 | JNZ QHOW ;ROOM FOR NEXT DIGIT 128 | INR B ;B COUNTS # OF DIGITS 129 | PUSH B 130 | MOV B,H ;HL=10*HL+(NEW DIGIT) 131 | MOV C,L 132 | DAD H ;WHERE 10* IS DONE BY 133 | DAD H ;SHIFT AND ADD 134 | DAD B 135 | DAD H 136 | LDAX D ;AND (DIGIT) IS FROM 137 | INX D ;STRIPPING THE ASCII 138 | ANI 0FH ;CODE 139 | ADD L 140 | MOV L,A 141 | MVI A,0 142 | ADC H 143 | MOV H,A 144 | POP B 145 | LDAX D ;DO THIS DIGIT AFTER 146 | JP TN1 ;DIGIT. S SAYS OVERFLOW 147 | QHOW: PUSH D ;*** ERROR "HOW?" *** 148 | AHOW: LXI D,HOW 149 | JMP ERROR 150 | HOW: DB 'HOW?' 151 | DB CR 152 | OK: DB 'OK' 153 | DB CR 154 | WHAT: DB 'WHAT?' 155 | DB CR 156 | SORRY: DB 'SORRY' 157 | DB CR 158 | ; 159 | ;************************************************************* 160 | ; 161 | ; *** MAIN *** 162 | ; 163 | ; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM 164 | ; AND STORES IT IN THE MEMORY. 165 | ; 166 | ; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE 167 | ; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS 168 | ; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO 169 | ; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER 170 | ; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) 171 | ; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE 172 | ; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF 173 | ; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED 174 | ; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. 175 | ; 176 | ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM 177 | ; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE 178 | ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE 179 | ; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT". 180 | ; 181 | ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION 182 | ; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS 183 | ; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED 184 | ; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". 185 | ; 186 | ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER 187 | ; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN 188 | ; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND 189 | ; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0. 190 | ; 191 | RSTART: LXI SP,STACK 192 | ST1: CALL CRLF ;AND JUMP TO HERE 193 | LXI D,OK ;DE->STRING 194 | SUB A ;A=0 195 | CALL PRTSTG ;PRINT STRING UNTIL CR 196 | LXI H,ST2+1 ;LITERAL 0 197 | SHLD CURRNT ;CURRENT->LINE # = 0 198 | ST2: LXI H,0 199 | SHLD LOPVAR 200 | SHLD STKGOS 201 | ST3: MVI A,3EH ;PROMPT '>' AND 202 | CALL GETLN ;READ A LINE 203 | PUSH D ;DE->END OF LINE 204 | LXI D,BUFFER ;DE->BEGINNING OF LINE 205 | CALL TSTNUM ;TEST IF IT IS A NUMBER 206 | RST 5 207 | MOV A,H ;HL=VALUE OF THE # OR 208 | ORA L ;0 IF NO # WAS FOUND 209 | POP B ;BC->END OF LINE 210 | JZ DIRECT 211 | DCX D ;BACKUP DE AND SAVE 212 | MOV A,H ;VALUE OF LINE # THERE 213 | STAX D 214 | DCX D 215 | MOV A,L 216 | STAX D 217 | PUSH B ;BC,DE->BEGIN, END 218 | PUSH D 219 | MOV A,C 220 | SUB E 221 | PUSH PSW ;A=# OF BYTES IN LINE 222 | CALL FNDLN ;FIND THIS LINE IN SAVE 223 | PUSH D ;AREA, DE->SAVE AREA 224 | JNZ ST4 ;NZ:NOT FOUND, INSERT 225 | PUSH D ;Z:FOUND, DELETE IT 226 | CALL FNDNXT ;FIND NEXT LINE 227 | ;DE->NEXT LINE 228 | POP B ;BC->LINE TO BE DELETED 229 | LHLD TXTUNF ;HL->UNFILLED SAVE AREA 230 | CALL MVUP ;MOVE UP TO DELETE 231 | MOV H,B ;TXTUNF->UNFILLED AREA 232 | MOV L,C 233 | SHLD TXTUNF ;UPDATE 234 | ST4: POP B ;GET READY TO INSERT 235 | LHLD TXTUNF ;BUT FIRST CHECK IF 236 | POP PSW ;THE LENGTH OF NEW LINE 237 | PUSH H ;IS 3 (LINE # AND CR) 238 | CPI 3 ;THEN DO NOT INSERT 239 | JZ RSTART ;MUST CLEAR THE STACK 240 | ADD L ;COMPUTE NEW TXTUNF 241 | MOV L,A 242 | MVI A,0 243 | ADC H 244 | MOV H,A ;HL->NEW UNFILLED AREA 245 | LXI D,TXTEND ;CHECK TO SEE IF THERE 246 | RST 4 ;IS ENOUGH SPACE 247 | JNC QSORRY ;SORRY, NO ROOM FOR IT 248 | SHLD TXTUNF ;OK, UPDATE TXTUNF 249 | POP D ;DE->OLD UNFILLED AREA 250 | CALL MVDOWN 251 | POP D ;DE->BEGIN, HL->END 252 | POP H 253 | CALL MVUP ;MOVE NEW LINE TO SAVE 254 | JMP ST3 ;AREA 255 | ; 256 | ;************************************************************* 257 | ; 258 | ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT 259 | ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE 260 | ; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST 261 | ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS 262 | ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: 263 | ; 264 | ; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART' 265 | ; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE 266 | ; GO BACK TO 'RSTART'. 267 | ; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. 268 | ; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. 269 | ; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE 270 | ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) 271 | ;************************************************************* 272 | ; 273 | ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** 274 | ; 275 | ; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' 276 | ; 277 | ; 'STOP(CR)' GOES BACK TO 'RSTART' 278 | ; 279 | ; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN 280 | ; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE 281 | ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. 282 | ; 283 | ; THERE ARE 3 MORE ENTRIES IN 'RUN': 284 | ; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. 285 | ; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. 286 | ; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. 287 | ; 288 | ; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET 289 | ; LINE, AND JUMP TO 'RUNTSL' TO DO IT. 290 | ; 291 | NEW: CALL ENDCHK ;*** NEW(CR) *** 292 | LXI H,TXTBGN 293 | SHLD TXTUNF 294 | ; 295 | STOP: CALL ENDCHK ;*** STOP(CR) *** 296 | JMP RSTART 297 | ; 298 | RUN: CALL ENDCHK ;*** RUN(CR) *** 299 | LXI D,TXTBGN ;FIRST SAVED LINE 300 | ; 301 | RUNNXL: LXI H,0 ;*** RUNNXL *** 302 | CALL FNDLP ;FIND WHATEVER LINE # 303 | JC RSTART ;C:PASSED TXTUNF, QUIT 304 | ; 305 | RUNTSL: XCHG ;*** RUNTSL *** 306 | SHLD CURRNT ;SET 'CURRENT'->LINE # 307 | XCHG 308 | INX D ;BUMP PASS LINE # 309 | INX D 310 | ; 311 | RUNSML: CALL CHKIO ;*** RUNSML *** 312 | LXI H,TAB2-1 ;FIND COMMAND IN TAB2 313 | JMP EXEC ;AND EXECUTE IT 314 | ; 315 | GOTO: RST 3 ;*** GOTO EXPR *** 316 | PUSH D ;SAVE FOR ERROR ROUTINE 317 | CALL ENDCHK ;MUST FIND A CR 318 | CALL FNDLN ;FIND THE TARGET LINE 319 | JNZ AHOW ;NO SUCH LINE # 320 | POP PSW ;CLEAR THE PUSH DE 321 | JMP RUNTSL ;GO DO IT 322 | ; 323 | ;************************************************************* 324 | ; 325 | ; *** LIST *** & PRINT *** 326 | ; 327 | ; LIST HAS TWO FORMS: 328 | ; 'LIST(CR)' LISTS ALL SAVED LINES 329 | ; 'LIST #(CR)' START LIST AT THIS LINE # 330 | ; YOU CAN STOP THE LISTING BY CONTROL C KEY 331 | ; 332 | ; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)' 333 | ; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK- 334 | ; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. 335 | ; 336 | ; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS 337 | ; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO 338 | ; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT 339 | ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS 340 | ; SPECIFIED, 6 POSITIONS WILL BE USED. 341 | ; 342 | ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF 343 | ; DOUBLE QUOTES. 344 | ; 345 | ; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) 346 | ; 347 | ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN 348 | ; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST 349 | ; ENDED WITH A COMMA, NO (CRLF) IS GENERATED. 350 | ; 351 | LIST: CALL TSTNUM ;TEST IF THERE IS A # 352 | CALL ENDCHK ;IF NO # WE GET A 0 353 | CALL FNDLN ;FIND THIS OR NEXT LINE 354 | LS1: JC RSTART ;C:PASSED TXTUNF 355 | CALL PRTLN ;PRINT THE LINE 356 | CALL CHKIO ;STOP IF HIT CONTROL-C 357 | CALL FNDLP ;FIND NEXT LINE 358 | JMP LS1 ;AND LOOP BACK 359 | ; 360 | PRINT: MVI C,6 ;C = # OF SPACES 361 | RST 1 ;IF NULL LIST & ";" 362 | DB 3BH 363 | DB PR2-$-1 364 | CALL CRLF ;GIVE CR-LF AND 365 | JMP RUNSML ;CONTINUE SAME LINE 366 | PR2: RST 1 ;IF NULL LIST (CR) 367 | DB CR 368 | DB PR0-$-1 369 | CALL CRLF ;ALSO GIVE CR-LF AND 370 | JMP RUNNXL ;GO TO NEXT LINE 371 | PR0: RST 1 ;ELSE IS IT FORMAT? 372 | DB '#' 373 | DB PR1-$-1 374 | RST 3 ;YES, EVALUATE EXPR. 375 | MOV C,L ;AND SAVE IT IN C 376 | JMP PR3 ;LOOK FOR MORE TO PRINT 377 | PR1: CALL QTSTG ;OR IS IT A STRING? 378 | JMP PR8 ;IF NOT, MUST BE EXPR. 379 | PR3: RST 1 ;IF ",", GO FIND NEXT 380 | DB "," 381 | DB PR6-$-1 382 | CALL FIN ;IN THE LIST. 383 | JMP PR0 ;LIST CONTINUES 384 | PR6: CALL CRLF ;LIST ENDS 385 | RST 6 386 | PR8: RST 3 ;EVALUATE THE EXPR 387 | PUSH B 388 | CALL PRTNUM ;PRINT THE VALUE 389 | POP B 390 | JMP PR3 ;MORE TO PRINT? 391 | ; 392 | ;************************************************************* 393 | ; 394 | ; *** GOSUB *** & RETURN *** 395 | ; 396 | ; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' 397 | ; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER 398 | ; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE 399 | ; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED 400 | ; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED. 401 | ; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS 402 | ; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS' 403 | ; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE), 404 | ; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S. 405 | ; 406 | ; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS 407 | ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT 408 | ; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE 409 | ; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR. 410 | ; 411 | GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR" 412 | RST 3 ;PARAMETERS 413 | PUSH D ;AND TEXT POINTER 414 | CALL FNDLN ;FIND THE TARGET LINE 415 | JNZ AHOW ;NOT THERE. SAY "HOW?" 416 | LHLD CURRNT ;FOUND IT, SAVE OLD 417 | PUSH H ;'CURRNT' OLD 'STKGOS' 418 | LHLD STKGOS 419 | PUSH H 420 | LXI H,0 ;AND LOAD NEW ONES 421 | SHLD LOPVAR 422 | DAD SP 423 | SHLD STKGOS 424 | JMP RUNTSL ;THEN RUN THAT LINE 425 | RETURN: CALL ENDCHK ;THERE MUST BE A CR 426 | LHLD STKGOS ;OLD STACK POINTER 427 | MOV A,H ;0 MEANS NOT EXIST 428 | ORA L 429 | JZ QWHAT ;SO, WE SAY: "WHAT?" 430 | SPHL ;ELSE, RESTORE IT 431 | POP H 432 | SHLD STKGOS ;AND THE OLD 'STKGOS' 433 | POP H 434 | SHLD CURRNT ;AND THE OLD 'CURRNT' 435 | POP D ;OLD TEXT POINTER 436 | CALL POPA ;OLD "FOR" PARAMETERS 437 | RST 6 ;AND WE ARE BACK HOME 438 | ; 439 | ;************************************************************* 440 | ; 441 | ; *** FOR *** & NEXT *** 442 | ; 443 | ; 'FOR' HAS TWO FORMS: 444 | ; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2' 445 | ; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH 446 | ; EXP3=1. (I.E., WITH A STEP OF +1.) 447 | ; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE 448 | ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3 449 | ; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN 450 | ; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 451 | ; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME- 452 | ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO 453 | ; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK 454 | ; BEFORE THE NEW ONE OVERWRITES IT. 455 | ; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME 456 | ; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP. 457 | ; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED. 458 | ; (PURGED FROM THE STACK..) 459 | ; 460 | ; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) 461 | ; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED 462 | ; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN 463 | ; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT 464 | ; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO 465 | ; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT 466 | ; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND 467 | ; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA 468 | ; IS PURGED AND EXECUTION CONTINUES. 469 | ; 470 | FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA 471 | CALL SETVAL ;SET THE CONTROL VAR. 472 | DCX H ;HL IS ITS ADDRESS 473 | SHLD LOPVAR ;SAVE THAT 474 | LXI H,TAB5-1 ;USE 'EXEC' TO LOOK 475 | JMP EXEC ;FOR THE WORD 'TO' 476 | FR1: RST 3 ;EVALUATE THE LIMIT 477 | SHLD LOPLMT ;SAVE THAT 478 | LXI H,TAB6-1 ;USE 'EXEC' TO LOOK 479 | JMP EXEC ;FOR THE WORD 'STEP' 480 | FR2: RST 3 ;FOUND IT, GET STEP 481 | JMP FR4 482 | FR3: LXI H,1H ;NOT FOUND, SET TO 1 483 | FR4: SHLD LOPINC ;SAVE THAT TOO 484 | FR5: LHLD CURRNT ;SAVE CURRENT LINE # 485 | SHLD LOPLN 486 | XCHG ;AND TEXT POINTER 487 | SHLD LOPPT 488 | LXI B,0AH ;DIG INTO STACK TO 489 | LHLD LOPVAR ;FIND 'LOPVAR' 490 | XCHG 491 | MOV H,B 492 | MOV L,B ;HL=0 NOW 493 | DAD SP ;HERE IS THE STACK 494 | DB 3EH 495 | FR7: DAD B ;EACH LEVEL IS 10 DEEP 496 | MOV A,M ;GET THAT OLD 'LOPVAR' 497 | INX H 498 | ORA M 499 | JZ FR8 ;0 SAYS NO MORE IN IT 500 | MOV A,M 501 | DCX H 502 | CMP D ;SAME AS THIS ONE? 503 | JNZ FR7 504 | MOV A,M ;THE OTHER HALF? 505 | CMP E 506 | JNZ FR7 507 | XCHG ;YES, FOUND ONE 508 | LXI H,0H 509 | DAD SP ;TRY TO MOVE SP 510 | MOV B,H 511 | MOV C,L 512 | LXI H,0AH 513 | DAD D 514 | CALL MVDOWN ;AND PURGE 10 WORDS 515 | SPHL ;IN THE STACK 516 | FR8: LHLD LOPPT ;JOB DONE, RESTORE DE 517 | XCHG 518 | RST 6 ;AND CONTINUE 519 | ; 520 | NEXT: RST 7 ;GET ADDRESS OF VAR. 521 | JC QWHAT ;NO VARIABLE, "WHAT?" 522 | SHLD VARNXT ;YES, SAVE IT 523 | NX0: PUSH D ;SAVE TEXT POINTER 524 | XCHG 525 | LHLD LOPVAR ;GET VAR. IN 'FOR' 526 | MOV A,H 527 | ORA L ;0 SAYS NEVER HAD ONE 528 | JZ AWHAT ;SO WE ASK: "WHAT?" 529 | RST 4 ;ELSE WE CHECK THEM 530 | JZ NX3 ;OK, THEY AGREE 531 | POP D ;NO, LET'S SEE 532 | CALL POPA ;PURGE CURRENT LOOP 533 | LHLD VARNXT ;AND POP ONE LEVEL 534 | JMP NX0 ;GO CHECK AGAIN 535 | NX3: MOV E,M ;COME HERE WHEN AGREED 536 | INX H 537 | MOV D,M ;DE=VALUE OF VAR. 538 | LHLD LOPINC 539 | PUSH H 540 | MOV A,H 541 | XRA D 542 | MOV A,D 543 | DAD D ;ADD ONE STEP 544 | JM NX4 545 | XRA H 546 | JM NX5 547 | NX4: XCHG 548 | LHLD LOPVAR ;PUT IT BACK 549 | MOV M,E 550 | INX H 551 | MOV M,D 552 | LHLD LOPLMT ;HL->LIMIT 553 | POP PSW ;OLD HL 554 | ORA A 555 | JP NX1 ;STEP > 0 556 | XCHG ;STEP < 0 557 | NX1: CALL CKHLDE ;COMPARE WITH LIMIT 558 | POP D ;RESTORE TEXT POINTER 559 | JC NX2 ;OUTSIDE LIMIT 560 | LHLD LOPLN ;WITHIN LIMIT, GO 561 | SHLD CURRNT ;BACK TO THE SAVED 562 | LHLD LOPPT ;'CURRNT' AND TEXT 563 | XCHG ;POINTER 564 | RST 6 565 | NX5: POP H 566 | POP D 567 | NX2: CALL POPA ;PURGE THIS LOOP 568 | RST 6 569 | ; 570 | ;************************************************************* 571 | ; 572 | ; *** REM *** IF *** INPUT *** & LET (& DEFLT) *** 573 | ; 574 | ; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. 575 | ; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. 576 | ; 577 | ; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE 578 | ; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS. 579 | ; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE 580 | ; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE 581 | ; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND 582 | ; EXECUTION CONTINUES AT THE NEXT LINE. 583 | ; 584 | ; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED 585 | ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR 586 | ; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS 587 | ; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS 588 | ; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN 589 | ; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE 590 | ; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING 591 | ; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE 592 | ; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. 593 | ; AND SET THE VARIABLE TO THE VALUE OF THE EXPR. 594 | ; 595 | ; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", 596 | ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. 597 | ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. 598 | ; THIS IS HANDLED IN 'INPERR'. 599 | ; 600 | ; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. 601 | ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. 602 | ; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. 603 | ; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. 604 | ; THIS IS DONE BY 'DEFLT'. 605 | ; 606 | REM: LXI H,0H ;*** REM *** 607 | DB 3EH ;THIS IS LIKE 'IF 0' 608 | ; 609 | IFF: RST 3 ;*** IF *** 610 | MOV A,H ;IS THE EXPR.=0? 611 | ORA L 612 | JNZ RUNSML ;NO, CONTINUE 613 | CALL FNDSKP ;YES, SKIP REST OF LINE 614 | JNC RUNTSL ;AND RUN THE NEXT LINE 615 | JMP RSTART ;IF NO NEXT, RE-START 616 | ; 617 | INPERR: LHLD STKINP ;*** INPERR *** 618 | SPHL ;RESTORE OLD SP 619 | POP H ;AND OLD 'CURRNT' 620 | SHLD CURRNT 621 | POP D ;AND OLD TEXT POINTER 622 | POP D ;REDO INPUT 623 | ; 624 | INPUT: ;*** INPUT *** 625 | IP1: PUSH D ;SAVE IN CASE OF ERROR 626 | CALL QTSTG ;IS NEXT ITEM A STRING? 627 | JMP IP2 ;NO 628 | RST 7 ;YES, BUT FOLLOWED BY A 629 | JC IP4 ;VARIABLE? NO. 630 | JMP IP3 ;YES. INPUT VARIABLE 631 | IP2: PUSH D ;SAVE FOR 'PRTSTG' 632 | RST 7 ;MUST BE VARIABLE NOW 633 | JC QWHAT ;"WHAT?" IT IS NOT? 634 | LDAX D ;GET READY FOR 'PRTSTR' 635 | MOV C,A 636 | SUB A 637 | STAX D 638 | POP D 639 | CALL PRTSTG ;PRINT STRING AS PROMPT 640 | MOV A,C ;RESTORE TEXT 641 | DCX D 642 | STAX D 643 | IP3: PUSH D ;SAVE TEXT POINTER 644 | XCHG 645 | LHLD CURRNT ;ALSO SAVE 'CURRNT' 646 | PUSH H 647 | LXI H,IP1 ;A NEGATIVE NUMBER 648 | SHLD CURRNT ;AS A FLAG 649 | LXI H,0H ;SAVE SP TOO 650 | DAD SP 651 | SHLD STKINP 652 | PUSH D ;OLD HL 653 | MVI A,3AH ;PRINT THIS TOO 654 | CALL GETLN ;AND GET A LINE 655 | LXI D,BUFFER ;POINTS TO BUFFER 656 | RST 3 ;EVALUATE INPUT 657 | NOP ;CAN BE 'CALL ENDCHK' 658 | NOP 659 | NOP 660 | POP D ;OK, GET OLD HL 661 | XCHG 662 | MOV M,E ;SAVE VALUE IN VAR. 663 | INX H 664 | MOV M,D 665 | POP H ;GET OLD 'CURRNT' 666 | SHLD CURRNT 667 | POP D ;AND OLD TEXT POINTER 668 | IP4: POP PSW ;PURGE JUNK IN STACK 669 | RST 1 ;IS NEXT CH. ','? 670 | DB "," 671 | DB IP5-$-1 672 | JMP IP1 ;YES, MORE ITEMS. 673 | IP5: RST 6 674 | ; 675 | DEFLT: LDAX D ;*** DEFLT *** 676 | CPI CR ;EMPTY LINE IS OK 677 | JZ LT1 ;ELSE IT IS 'LET' 678 | ; 679 | LET: CALL SETVAL ;*** LET *** 680 | RST 1 ;SET VALUE TO VAR. 681 | DB "," 682 | DB LT1-$-1 683 | JMP LET ;ITEM BY ITEM 684 | LT1: RST 6 ;UNTIL FINISH 685 | ; 686 | ;************************************************************* 687 | ; 688 | ; *** EXPR *** 689 | ; 690 | ; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. 691 | ; :: 692 | ; 693 | ; WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE 694 | ; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. 695 | ; ::=(+ OR -)(+ OR -)(....) 696 | ; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. 697 | ; ::=(* OR />)(....) 698 | ; ::= 699 | ; 700 | ; () 701 | ; IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN 702 | ; AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND 703 | ; CAN BE AN IN PARANTHESE. 704 | ; 705 | ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18 706 | ; PUSH H ;SAVE VALUE 707 | EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP. 708 | JMP EXEC ;GO DO IT 709 | XP11: CALL XP18 ;REL.OP.">=" 710 | RC ;NO, RETURN HL=0 711 | MOV L,A ;YES, RETURN HL=1 712 | RET 713 | XP12: CALL XP18 ;REL.OP."#" 714 | RZ ;FALSE, RETURN HL=0 715 | MOV L,A ;TRUE, RETURN HL=1 716 | RET 717 | XP13: CALL XP18 ;REL.OP.">" 718 | RZ ;FALSE 719 | RC ;ALSO FALSE, HL=0 720 | MOV L,A ;TRUE, HL=1 721 | RET 722 | XP14: CALL XP18 ;REL.OP."<=" 723 | MOV L,A ;SET HL=1 724 | RZ ;REL. TRUE, RETURN 725 | RC 726 | MOV L,H ;ELSE SET HL=0 727 | RET 728 | XP15: CALL XP18 ;REL.OP."=" 729 | RNZ ;FALSE, RETURN HL=0 730 | MOV L,A ;ELSE SET HL=1 731 | RET 732 | XP16: CALL XP18 ;REL.OP."<" 733 | RNC ;FALSE, RETURN HL=0 734 | MOV L,A ;ELSE SET HL=1 735 | RET 736 | XP17: POP H ;NOT .REL.OP 737 | RET ;RETURN HL= 738 | XP18: MOV A,C ;SUBROUTINE FOR ALL 739 | POP H ;REL.OP.'S 740 | POP B 741 | PUSH H ;REVERSE TOP OF STACK 742 | PUSH B 743 | MOV C,A 744 | CALL EXPR2 ;GET 2ND 745 | XCHG ;VALUE IN DE NOW 746 | XTHL ;1ST IN HL 747 | CALL CKHLDE ;COMPARE 1ST WITH 2ND 748 | POP D ;RESTORE TEXT POINTER 749 | LXI H,0H ;SET HL=0, A=1 750 | MVI A,1 751 | RET 752 | ; 753 | EXPR2: RST 1 ;NEGATIVE SIGN? 754 | DB '-' 755 | DB XP21-$-1 756 | LXI H,0H ;YES, FAKE '0-' 757 | JMP XP26 ;TREAT LIKE SUBTRACT 758 | XP21: RST 1 ;POSITIVE SIGN? IGNORE 759 | DB '+' 760 | DB XP22-$-1 761 | XP22: CALL EXPR3 ;1ST 762 | XP23: RST 1 ;ADD? 763 | DB '+' 764 | DB XP25-$-1 765 | PUSH H ;YES, SAVE VALUE 766 | CALL EXPR3 ;GET 2ND 767 | XP24: XCHG ;2ND IN DE 768 | XTHL ;1ST IN HL 769 | MOV A,H ;COMPARE SIGN 770 | XRA D 771 | MOV A,D 772 | DAD D 773 | POP D ;RESTORE TEXT POINTER 774 | JM XP23 ;1ST AND 2ND SIGN DIFFER 775 | XRA H ;1ST AND 2ND SIGN EQUAL 776 | JP XP23 ;SO IS RESULT 777 | JMP QHOW ;ELSE WE HAVE OVERFLOW 778 | XP25: RST 1 ;SUBTRACT? 779 | DB '-' 780 | DB XP42-$-1 781 | XP26: PUSH H ;YES, SAVE 1ST 782 | CALL EXPR3 ;GET 2ND 783 | CALL CHGSGN ;NEGATE 784 | JMP XP24 ;AND ADD THEM 785 | ; 786 | EXPR3: CALL EXPR4 ;GET 1ST 787 | XP31: RST 1 ;MULTIPLY? 788 | DB '*' 789 | DB XP34-$-1 790 | PUSH H ;YES, SAVE 1ST 791 | CALL EXPR4 ;AND GET 2ND 792 | MVI B,0H ;CLEAR B FOR SIGN 793 | CALL CHKSGN ;CHECK SIGN 794 | XTHL ;1ST IN HL 795 | CALL CHKSGN ;CHECK SIGN OF 1ST 796 | XCHG 797 | XTHL 798 | MOV A,H ;IS HL > 255 ? 799 | ORA A 800 | JZ XP32 ;NO 801 | MOV A,D ;YES, HOW ABOUT DE 802 | ORA D 803 | XCHG ;PUT SMALLER IN HL 804 | JNZ AHOW ;ALSO >, WILL OVERFLOW 805 | XP32: MOV A,L ;THIS IS DUMB 806 | LXI H,0H ;CLEAR RESULT 807 | ORA A ;ADD AND COUNT 808 | JZ XP35 809 | XP33: DAD D 810 | JC AHOW ;OVERFLOW 811 | DCR A 812 | JNZ XP33 813 | JMP XP35 ;FINISHED 814 | XP34: RST 1 ;DIVIDE? 815 | DB '/' 816 | DB XP42-$-1 817 | PUSH H ;YES, SAVE 1ST 818 | CALL EXPR4 ;AND GET THE SECOND ONE 819 | MVI B,0H ;CLEAR B FOR SIGN 820 | CALL CHKSGN ;CHECK SIGN OF 2ND 821 | XTHL ;GET 1ST IN HL 822 | CALL CHKSGN ;CHECK SIGN OF 1ST 823 | XCHG 824 | XTHL 825 | XCHG 826 | MOV A,D ;DIVIDE BY 0? 827 | ORA E 828 | JZ AHOW ;SAY "HOW?" 829 | PUSH B ;ELSE SAVE SIGN 830 | CALL DIVIDE ;USE SUBROUTINE 831 | MOV H,B ;RESULT IN HL NOW 832 | MOV L,C 833 | POP B ;GET SIGN BACK 834 | XP35: POP D ;AND TEXT POINTER 835 | MOV A,H ;HL MUST BE + 836 | ORA A 837 | JM QHOW ;ELSE IT IS OVERFLOW 838 | MOV A,B 839 | ORA A 840 | CM CHGSGN ;CHANGE SIGN IF NEEDED 841 | JMP XP31 ;LOOK FOR MORE TERMS 842 | ; 843 | EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4 844 | JMP EXEC ;AND GO DO IT 845 | XP40: RST 7 ;NO, NOT A FUNCTION 846 | JC XP41 ;NOR A VARIABLE 847 | MOV A,M ;VARIABLE 848 | INX H 849 | MOV H,M ;VALUE IN HL 850 | MOV L,A 851 | RET 852 | XP41: CALL TSTNUM ;OR IS IT A NUMBER 853 | MOV A,B ;# OF DIGIT 854 | ORA A 855 | RNZ ;OK 856 | PARN: RST 1 857 | DB '(' 858 | DB XP43-$-1 859 | RST 3 ;"(EXPR)" 860 | RST 1 861 | DB ')' 862 | DB XP43-$-1 863 | XP42: RET 864 | XP43: JMP QWHAT ;ELSE SAY: "WHAT?" 865 | ; 866 | RND: CALL PARN ;*** RND(EXPR) *** 867 | MOV A,H ;EXPR MUST BE + 868 | ORA A 869 | JM QHOW 870 | ORA L ;AND NON-ZERO 871 | JZ QHOW 872 | PUSH D ;SAVE BOTH 873 | PUSH H 874 | LHLD RANPNT ;GET MEMORY AS RANDOM 875 | LXI D,LSTROM ;NUMBER 876 | RST 4 877 | JC RA1 ;WRAP AROUND IF LAST 878 | LXI H,START 879 | RA1: MOV E,M 880 | INX H 881 | MOV D,M 882 | SHLD RANPNT 883 | POP H 884 | XCHG 885 | PUSH B 886 | CALL DIVIDE ;RND(N)=MOD(M,N)+1 887 | POP B 888 | POP D 889 | INX H 890 | RET 891 | ; 892 | ABS: CALL PARN ;*** ABS(EXPR) *** 893 | DCX D 894 | CALL CHKSGN ;CHECK SIGN 895 | INX D 896 | RET 897 | ; 898 | SIZE: LHLD TXTUNF ;*** SIZE *** 899 | PUSH D ;GET THE NUMBER OF FREE 900 | XCHG ;BYTES BETWEEN 'TXTUNF' 901 | LXI H,VARBGN ;AND 'VARBGN' 902 | CALL SUBDE 903 | POP D 904 | RET 905 | ; 906 | ;************************************************************* 907 | ; 908 | ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** 909 | ; 910 | ; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL 911 | ; 912 | ; 'SUBDE' SUBSTRACTS DE FROM HL 913 | ; 914 | ; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE 915 | ; SIGN AND FLIP SIGN OF B. 916 | ; 917 | ; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY. 918 | ; 919 | ; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE 920 | ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER 921 | ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. 922 | ; 923 | DIVIDE: PUSH H ;*** DIVIDE *** 924 | MOV L,H ;DIVIDE H BY DE 925 | MVI H,0 926 | CALL DV1 927 | MOV B,C ;SAVE RESULT IN B 928 | MOV A,L ;(REMINDER+L)/DE 929 | POP H 930 | MOV H,A 931 | DV1: MVI C,0FFH ;RESULT IN C 932 | DV2: INR C ;DUMB ROUTINE 933 | CALL SUBDE ;DIVIDE BY SUBTRACT 934 | JNC DV2 ;AND COUNT 935 | DAD D 936 | RET 937 | ; 938 | SUBDE: MOV A,L ;*** SUBDE *** 939 | SUB E ;SUBSTRACT DE FROM 940 | MOV L,A ;HL 941 | MOV A,H 942 | SBB D 943 | MOV H,A 944 | RET 945 | ; 946 | CHKSGN: MOV A,H ;*** CHKSGN *** 947 | ORA A ;CHECK SIGN OF HL 948 | RP ;IF -, CHANGE SIGN 949 | ; 950 | CHGSGN: MOV A,H ;*** CHGSGN *** 951 | PUSH PSW 952 | CMA ;CHANGE SIGN OF HL 953 | MOV H,A 954 | MOV A,L 955 | CMA 956 | MOV L,A 957 | INX H 958 | POP PSW 959 | XRA H 960 | JP QHOW 961 | MOV A,B ;AND ALSO FLIP B 962 | XRI 80H 963 | MOV B,A 964 | RET 965 | ; 966 | CKHLDE: MOV A,H 967 | XRA D ;SAME SIGN? 968 | JP CK1 ;YES, COMPARE 969 | XCHG ;NO, XCH AND COMP 970 | CK1: RST 4 971 | RET 972 | ; 973 | ;************************************************************* 974 | ; 975 | ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** 976 | ; 977 | ; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND 978 | ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE 979 | ; TO THAT VALUE. 980 | ; 981 | ; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";", 982 | ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE 983 | ; NEXT LINE AND CONTINUE FROM THERE. 984 | ; 985 | ; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS 986 | ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) 987 | ; 988 | ; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). 989 | ; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" 990 | ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP 991 | ; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED 992 | ; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO 993 | ; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT 994 | ; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT' 995 | ; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS 996 | ; NOT TERMINATED BUT CONTINUED AT 'INPERR'. 997 | ; 998 | ; RELATED TO 'ERROR' ARE THE FOLLOWING: 999 | ; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?" 1000 | ; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'. 1001 | ; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. 1002 | ; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS. 1003 | ; 1004 | SETVAL: RST 7 ;*** SETVAL *** 1005 | JC QWHAT ;"WHAT?" NO VARIABLE 1006 | PUSH H ;SAVE ADDRESS OF VAR. 1007 | RST 1 ;PASS "=" SIGN 1008 | DB '=' 1009 | DB SV1-$-1 1010 | RST 3 ;EVALUATE EXPR. 1011 | MOV B,H ;VALUE IS IN BC NOW 1012 | MOV C,L 1013 | POP H ;GET ADDRESS 1014 | MOV M,C ;SAVE VALUE 1015 | INX H 1016 | MOV M,B 1017 | RET 1018 | SV1: JMP QWHAT ;NO "=" SIGN 1019 | ; 1020 | FIN: RST 1 ;*** FIN *** 1021 | DB 3BH 1022 | DB FI1-$-1 1023 | POP PSW ;";", PURGE RET. ADDR. 1024 | JMP RUNSML ;CONTINUE SAME LINE 1025 | FI1: RST 1 ;NOT ";", IS IT CR? 1026 | DB CR 1027 | DB FI2-$-1 1028 | POP PSW ;YES, PURGE RET. ADDR. 1029 | JMP RUNNXL ;RUN NEXT LINE 1030 | FI2: RET ;ELSE RETURN TO CALLER 1031 | ; 1032 | ENDCHK: RST 5 ;*** ENDCHK *** 1033 | CPI CR ;END WITH CR? 1034 | RZ ;OK, ELSE SAY: "WHAT?" 1035 | ; 1036 | QWHAT: PUSH D ;*** QWHAT *** 1037 | AWHAT: LXI D,WHAT ;*** AWHAT *** 1038 | ERROR: SUB A ;*** ERROR *** 1039 | CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' 1040 | POP D ;OR 'SORRY' 1041 | LDAX D ;SAVE THE CHARACTER 1042 | PUSH PSW ;AT WHERE OLD DE -> 1043 | SUB A ;AND PUT A 0 THERE 1044 | STAX D 1045 | LHLD CURRNT ;GET CURRENT LINE # 1046 | PUSH H 1047 | MOV A,M ;CHECK THE VALUE 1048 | INX H 1049 | ORA M 1050 | POP D 1051 | JZ RSTART ;IF ZERO, JUST RESTART 1052 | MOV A,M ;IF NEGATIVE, 1053 | ORA A 1054 | JM INPERR ;REDO INPUT 1055 | CALL PRTLN ;ELSE PRINT THE LINE 1056 | DCX D ;UPTO WHERE THE 0 IS 1057 | POP PSW ;RESTORE THE CHARACTER 1058 | STAX D 1059 | MVI A,3FH ;PRINT A "?" 1060 | RST 2 1061 | SUB A ;AND THE REST OF THE 1062 | CALL PRTSTG ;LINE 1063 | JMP RSTART ;THEN RESTART 1064 | ; 1065 | QSORRY: PUSH D ;*** QSORRY *** 1066 | ASORRY: LXI D,SORRY ;*** ASORRY *** 1067 | JMP ERROR 1068 | ; 1069 | ;************************************************************* 1070 | ; 1071 | ; *** GETLN *** FNDLN (& FRIENDS) *** 1072 | ; 1073 | ; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT 1074 | ; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS 1075 | ; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL 1076 | ; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE 1077 | ; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO 1078 | ; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. 1079 | ; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN. 1080 | ; 1081 | ; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE 1082 | ; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE 1083 | ; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE 1084 | ; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. 1085 | ; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE # 1086 | ; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF 1087 | ; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE 1088 | ; LINE, FLAGS ARE C & NZ. 1089 | ; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE 1090 | ; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS 1091 | ; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. 1092 | ; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #. 1093 | ; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH. 1094 | ; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH. 1095 | ; 1096 | GETLN: RST 2 ;*** GETLN *** 1097 | LXI D,BUFFER ;PROMPT AND INIT. 1098 | GL1: CALL CHKIO ;CHECK KEYBOARD 1099 | JZ GL1 ;NO INPUT, WAIT 1100 | CPI 7FH ;DELETE LAST CHARACTER? 1101 | JZ GL3 ;YES 1102 | RST 2 ;INPUT, ECHO BACK 1103 | CPI 0AH ;IGNORE LF 1104 | JZ GL1 1105 | ORA A ;IGNORE NULL 1106 | JZ GL1 1107 | CPI 7DH ;DELETE THE WHOLE LINE? 1108 | JZ GL4 ;YES 1109 | STAX D ;ELSE SAVE INPUT 1110 | INX D ;AND BUMP POINTER 1111 | CPI 0DH ;WAS IT CR? 1112 | RZ ;YES, END OF LINE 1113 | MOV A,E ;ELSE MORE FREE ROOM? 1114 | CPI TO WHERE BC-> UNTIL 1280 | ; DE = HL 1281 | ; 1282 | ; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> 1283 | ; UNTIL DE = BC 1284 | ; 1285 | ; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE 1286 | ; STACK 1287 | ; 1288 | ; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE 1289 | ; STACK 1290 | ; 1291 | MVUP: RST 4 ;*** MVUP *** 1292 | RZ ;DE = HL, RETURN 1293 | LDAX D ;GET ONE BYTE 1294 | STAX B ;MOVE IT 1295 | INX D ;INCREASE BOTH POINTERS 1296 | INX B 1297 | JMP MVUP ;UNTIL DONE 1298 | ; 1299 | MVDOWN: MOV A,B ;*** MVDOWN *** 1300 | SUB D ;TEST IF DE = BC 1301 | JNZ MD1 ;NO, GO MOVE 1302 | MOV A,C ;MAYBE, OTHER BYTE? 1303 | SUB E 1304 | RZ ;YES, RETURN 1305 | MD1: DCX D ;ELSE MOVE A BYTE 1306 | DCX H ;BUT FIRST DECREASE 1307 | LDAX D ;BOTH POINTERS AND 1308 | MOV M,A ;THEN DO IT 1309 | JMP MVDOWN ;LOOP BACK 1310 | ; 1311 | POPA: POP B ;BC = RETURN ADDR. 1312 | POP H ;RESTORE LOPVAR, BUT 1313 | SHLD LOPVAR ;=0 MEANS NO MORE 1314 | MOV A,H 1315 | ORA L 1316 | JZ PP1 ;YEP, GO RETURN 1317 | POP H ;NOP, RESTORE OTHERS 1318 | SHLD LOPINC 1319 | POP H 1320 | SHLD LOPLMT 1321 | POP H 1322 | SHLD LOPLN 1323 | POP H 1324 | SHLD LOPPT 1325 | PP1: PUSH B ;BC = RETURN ADDR. 1326 | RET 1327 | ; 1328 | PUSHA: LXI H,STKLMT ;*** PUSHA *** 1329 | CALL CHGSGN 1330 | POP B ;BC=RETURN ADDRESS 1331 | DAD SP ;IS STACK NEAR THE TOP? 1332 | JNC QSORRY ;YES, SORRY FOR THAT 1333 | LHLD LOPVAR ;ELSE SAVE LOOP VAR'S 1334 | MOV A,H ;BUT IF LOPVAR IS 0 1335 | ORA L ;THAT WILL BE ALL 1336 | JZ PU1 1337 | LHLD LOPPT ;ELSE, MORE TO SAVE 1338 | PUSH H 1339 | LHLD LOPLN 1340 | PUSH H 1341 | LHLD LOPLMT 1342 | PUSH H 1343 | LHLD LOPINC 1344 | PUSH H 1345 | LHLD LOPVAR 1346 | PU1: PUSH H 1347 | PUSH B ;BC = RETURN ADDR. 1348 | RET 1349 | ; 1350 | ;************************************************************* 1351 | ; 1352 | ; *** OUTC *** & CHKIO *** 1353 | ; 1354 | ; THESE ARE THE ONLY I/O ROUTINES IN TBI. 1355 | ; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0 1356 | ; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, 1357 | ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO 1358 | ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. 1359 | ; ARE RESTORED. 1360 | ; 1361 | ; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO 1362 | ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG 1363 | ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE 1364 | ; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND 1365 | ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL 1366 | ; RESTART TBI AND DO NOT RETURN TO THE CALLER. 1367 | ; 1368 | ;OUTC: PUSH PSW ;THIS IS AT LOC. 10 1369 | ; LDA OCSW ;CHECK SOFTWARE SWITCH 1370 | ; ORA A 1371 | INIT: STA OCSW 1372 | MVI A,3 ;RESET ACIA 1373 | OUT 16 1374 | MVI A,15H ;15H FOR 8N1, 11H FOR 8N2 1375 | OUT 16 1376 | MVI D,19H 1377 | PATLOP: 1378 | CALL CRLF 1379 | DCR D 1380 | JNZ PATLOP 1381 | SUB A 1382 | LXI D,MSG1 1383 | CALL PRTSTG 1384 | LXI H,START 1385 | SHLD RANPNT 1386 | LXI H,TXTBGN 1387 | SHLD TXTUNF 1388 | JMP RSTART 1389 | OC2: JNZ OC3 ;IT IS ON 1390 | POP PSW ;IT IS OFF 1391 | RET ;RESTORE AF AND RETURN 1392 | OC3: IN 0 ;COME HERE TO DO OUTPUT 1393 | ANI 2H ;STATUS BIT 1394 | JZ OC3 ;NOT READY, WAIT 1395 | POP PSW ;READY, GET OLD A BACK 1396 | OUT 1 ;AND SEND IT OUT 1397 | CPI CR ;WAS IT CR? 1398 | RNZ ;NO, FINISHED 1399 | MVI A,LF ;YES, WE SEND LF TOO 1400 | RST 2 ;THIS IS RECURSIVE 1401 | MVI A,CR ;GET CR BACK IN A 1402 | RET 1403 | ; 1404 | CHKIO: IN 0 ;*** CHKIO *** 1405 | NOP ;STATUS BIT FLIPPED? 1406 | ANI 20H ;MASK STATUS BIT 1407 | RZ ;NOT READY, RETURN "Z" 1408 | IN 1 ;READY, READ DATA 1409 | ANI 7FH ;MASK BIT 7 OFF 1410 | CPI 0FH ;IS IT CONTROL-O? 1411 | JNZ CI1 ;NO, MORE CHECKING 1412 | LDA OCSW ;CONTROL-O FLIPS OCSW 1413 | CMA ;ON TO OFF, OFF TO ON 1414 | STA OCSW 1415 | JMP CHKIO ;GET ANOTHER INPUT 1416 | CI1: CPI 3H ;IS IT CONTROL-C? 1417 | RNZ ;NO, RETURN "NZ" 1418 | JMP RSTART ;YES, RESTART TBI 1419 | ; 1420 | MSG1: DB 'TINY ' 1421 | DB 'BASIC' 1422 | DB CR 1423 | ; 1424 | ;************************************************************* 1425 | ; 1426 | ; *** TABLES *** DIRECT *** & EXEC *** 1427 | ; 1428 | ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. 1429 | ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION 1430 | ; OF CODE ACCORDING TO THE TABLE. 1431 | ; 1432 | ; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT 1433 | ; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING. 1434 | ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF 1435 | ; ALL DIRECT AND STATEMENT COMMANDS. 1436 | ; 1437 | ; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL 1438 | ; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.', 1439 | ; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'. 1440 | ; 1441 | ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM 1442 | ; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND 1443 | ; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH 1444 | ; BYTE SET TO 1. 1445 | ; 1446 | ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE 1447 | ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL 1448 | ; MATCH THIS NULL ITEM AS DEFAULT. 1449 | ; 1450 | TAB1: ;DIRECT COMMANDS 1451 | DB 'LIST' 1452 | DWA LIST 1453 | DB 'RUN' 1454 | DWA RUN 1455 | DB 'NEW' 1456 | DWA NEW 1457 | ; 1458 | TAB2: ;DIRECT/STATEMENT 1459 | DB 'NEXT' 1460 | DWA NEXT 1461 | DB 'LET' 1462 | DWA LET 1463 | DB 'IF' 1464 | DWA IFF 1465 | DB 'GOTO' 1466 | DWA GOTO 1467 | DB 'GOSUB' 1468 | DWA GOSUB 1469 | DB 'RETURN' 1470 | DWA RETURN 1471 | DB 'REM' 1472 | DWA REM 1473 | DB 'FOR' 1474 | DWA FOR 1475 | DB 'INPUT' 1476 | DWA INPUT 1477 | DB 'PRINT' 1478 | DWA PRINT 1479 | DB 'STOP' 1480 | DWA STOP 1481 | DWA DEFLT 1482 | ; 1483 | TAB4: ;FUNCTIONS 1484 | DB 'RND' 1485 | DWA RND 1486 | DB 'ABS' 1487 | DWA ABS 1488 | DB 'SIZE' 1489 | DWA SIZE 1490 | DWA XP40 1491 | ; 1492 | TAB5: ;"TO" IN "FOR" 1493 | DB 'TO' 1494 | DWA FR1 1495 | DWA QWHAT 1496 | ; 1497 | TAB6: ;"STEP" IN "FOR" 1498 | DB 'STEP' 1499 | DWA FR2 1500 | DWA FR3 1501 | ; 1502 | TAB8: ;RELATION OPERATORS 1503 | DB '>=' 1504 | DWA XP11 1505 | DB '#' 1506 | DWA XP12 1507 | DB '>' 1508 | DWA XP13 1509 | DB '=' 1510 | DWA XP15 1511 | DB '<=' 1512 | DWA XP14 1513 | DB '<' 1514 | DWA XP16 1515 | DWA XP17 1516 | ; 1517 | DIRECT: LXI H,TAB1-1 ;*** DIRECT *** 1518 | ; 1519 | EXEC: ;*** EXEC *** 1520 | EX0: RST 5 ;IGNORE LEADING BLANKS 1521 | PUSH D ;SAVE POINTER 1522 | EX1: LDAX D ;IF FOUND '.' IN STRING 1523 | INX D ;BEFORE ANY MISMATCH 1524 | CPI 2EH ;WE DECLARE A MATCH 1525 | JZ EX3 1526 | INX H ;HL->TABLE 1527 | CMP M ;IF MATCH, TEST NEXT 1528 | JZ EX1 1529 | MVI A,07FH ;ELSE SEE IF BIT 7 1530 | DCX D ;OF TABLE IS SET, WHICH 1531 | CMP M ;IS THE JUMP ADDR. (HI) 1532 | JC EX5 ;C:YES, MATCHED 1533 | EX2: INX H ;NC:NO, FIND JUMP ADDR. 1534 | CMP M 1535 | JNC EX2 1536 | INX H ;BUMP TO NEXT TAB. ITEM 1537 | POP D ;RESTORE STRING POINTER 1538 | JMP EX0 ;TEST AGAINST NEXT ITEM 1539 | EX3: MVI A,07FH ;PARTIAL MATCH, FIND 1540 | EX4: INX H ;JUMP ADDR., WHICH IS 1541 | CMP M ;FLAGGED BY BIT 7 1542 | JNC EX4 1543 | EX5: MOV A,M ;LOAD HL WITH THE JUMP 1544 | INX H ;ADDRESS FROM THE TABLE 1545 | MOV L,M 1546 | ANI 7FH ;MASK OFF BIT 7 1547 | MOV H,A 1548 | POP PSW ;CLEAN UP THE GABAGE 1549 | PCHL ;AND WE GO DO IT 1550 | ; 1551 | LSTROM: ;ALL ABOVE CAN BE ROM 1552 | ORG 1000H ;HERE DOWN MUST BE RAM 1553 | ; ORG 0800H 1554 | OCSW: DS 1 ;SWITCH FOR OUTPUT 1555 | CURRNT: DS 2 ;POINTS TO CURRENT LINE 1556 | STKGOS: DS 2 ;SAVES SP IN 'GOSUB' 1557 | VARNXT: DS 2 ;TEMP STORAGE 1558 | STKINP: DS 2 ;SAVES SP IN 'INPUT' 1559 | LOPVAR: DS 2 ;'FOR' LOOP SAVE AREA 1560 | LOPINC: DS 2 ;INCREMENT 1561 | LOPLMT: DS 2 ;LIMIT 1562 | LOPLN: DS 2 ;LINE NUMBER 1563 | LOPPT: DS 2 ;TEXT POINTER 1564 | RANPNT: DS 2 ;RANDOM NUMBER POINTER 1565 | TXTUNF: DS 2 ;->UNFILLED TEXT AREA 1566 | TXTBGN: DS 2 ;TEXT SAVE AREA BEGINS 1567 | ORG 1366H 1568 | ; ORG 1F00H 1569 | TXTEND: DS 0 ;TEXT SAVE AREA ENDS 1570 | VARBGN: DS 55 ;VARIABLE @(0) 1571 | BUFFER: DS 64 ;INPUT BUFFER 1572 | BUFEND: DS 1 ;BUFFER ENDS 1573 | STKLMT: DS 1 ;TOP LIMIT FOR STACK 1574 | ORG 1400H 1575 | ; ORG 2000H 1576 | STACK: DS 0 ;STACK STARTS HERE 1577 | ; 1578 | CR EQU 0DH 1579 | LF EQU 0AH 1580 | 1581 | END -------------------------------------------------------------------------------- /src/tinybasic.a80: -------------------------------------------------------------------------------- 1 | ;************************************************************* 2 | ;* 3 | ;* TINY BASIC FOR INTEL 8080 4 | ;* VERSION 1.0 5 | ;* BY LI-CHEN WANG 6 | ;* 10 JUNE, 1976 7 | ;* @COPYLEFT 8 | ;* ALL WRONGS RESERVED 9 | ;* 10 | ;************************************************************* 11 | ;* 12 | ;* *** ZERO PAGE SUBROUTINES *** 13 | ;* 14 | ;* THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW 15 | ;* MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7. 16 | ;* THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS 17 | ;* THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL 18 | ;* USE RST 0 AS START OR RESTART AND RST 1 THROUGH RST 7 FOR 19 | ;* THE SEVEN MOST FREQUENTLY USED SUBROUTINES. 20 | ;* TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS 21 | ;* SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS. 22 | ;* 23 | CR EQU 0DH ;ASCII CR 24 | LF EQU 0AH ;ASCII LF 25 | QT EQU 27H ;ASCII SINGLE QUOTE 26 | CNTLO EQU 0FH ;ASCII CONTROL-O 27 | CNTLC EQU 03H ;ASCII CONTROL-C 28 | DLLN EQU 7DH ;DELETE LINE TELETYPE, BUT WE USE 29 | CNTLU EQU 15H ;ASCII CONTROL-U FOR DELETE LINE 30 | BKS EQU 5CH ;ASCII BACK-SLASH 31 | BKA EQU 5FH ;ASCII UNDERLINE (BACK-ARROW) 32 | UPA EQU 5EH ;ASCII UP-ARROW 33 | DEL EQU 7FH ;ASCII DEL 34 | ; 35 | ; MACRO TO CREATE TABLE ADDRESS ITEMS 36 | ; 37 | .MACRO ITEM 38 | DB >%%1 + 0x80 39 | DB <%%1 40 | .ENDM 41 | ; 42 | ORG 0000H 43 | START: DI ;*** START/RESTART *** 44 | LXI SP,STACK ;INITIALIZE THE STACK 45 | JMP ST1 ;GO TO THE MAIN SECTION 46 | DB 'L' 47 | ; 48 | XTHL ;*** TSTC OR RST 1 *** 49 | RST 5 ;IGNORE BLANKS AND 50 | CMP M ;TEST CHARACTER 51 | JMP TC1 ;REST OF THIS IS AT TC1 52 | ; 53 | CRLF: MVI A,CR ;*** CRLF *** 54 | ; 55 | PUSH PSW ;*** OUTC OR RST 2 *** 56 | LDA OCSW ;PRINT CHARACTER ONLY 57 | ORA A ;IF OCSW SWITCH IS ON 58 | JMP OC2 ;REST OF THIS IS AT OC2 59 | ; 60 | CALL EXPR2 ;*** EXPR OR RST 3 *** 61 | PUSH H ;EVALUATE AN EXPRESSION 62 | JMP EXPR1 ;REST OF IT AT EXPR1 63 | DB 'W' 64 | ; 65 | MOV A,H ;*** COMP OR RST 4 *** 66 | CMP D ;COMPARE HL WITH DE 67 | RNZ ;RETURN CORRECT C AND 68 | MOV A,L ;Z FLAGS 69 | CMP E ;BUT OLD A IS LOST 70 | RET 71 | DB 'AN' 72 | ; 73 | SS1: LDAX D ;*** IGNBLK/RST 5 *** 74 | CPI ' ' ;IGNORE BLANKS 75 | RNZ ;IN TEXT (WHERE DE->) 76 | INX D ;AND RETURN THE FIRST 77 | JMP SS1 ;NON-BLANK CHAR. IN A 78 | ; 79 | POP PSW ;*** FINISH/RST 6 *** 80 | CALL FIN ;CHECK END OF COMMAND 81 | JMP QWHAT ;PRINT "WHAT?" IF WRONG 82 | DB 'G' 83 | ; 84 | RST 5 ;*** TSTV OR RST 7 *** 85 | SUI '@' ;TEST VARIABLES 86 | RC ;C:NOT A VARIABLE 87 | JNZ TV1 ;NOT "@" ARRAY 88 | INX D ;IT IS THE "@" ARRAY 89 | CALL PARN ;@ SHOULD BE FOLLOWED 90 | DAD H ;BY (EXPR) AS ITS INDEX 91 | JC QHOW ;IS INDEX TOO BIG? 92 | PUSH D ;WILL IT OVERWRITE 93 | XCHG ;TEXT? 94 | CALL SIZE ;FIND SIZE OF FREE 95 | RST 4 ;AND CHECK THAT 96 | JC ASORRY ;IF SO, SAY "SORRY" 97 | LXI H,VARBGN ;IF NOT GET ADDRESS 98 | CALL SUBDE ;OF @(EXPR) AND PUT IT 99 | POP D ;IN HL 100 | RET ;C FLAG IS CLEARED 101 | TV1: CPI 27 ;NOT @, IS IT A TO Z? 102 | CMC ;IF NOT RETURN C FLAG 103 | RC 104 | INX D ;IF A THROUGH Z 105 | LXI H,VARBGN ;COMPUTE ADDRESS OF 106 | RLC ;THAT VARIABLE 107 | ADD L ;AND RETURN IT IN HL 108 | MOV L,A ;WITH C FLAG CLEARED 109 | MVI A,0 110 | ADC H 111 | MOV H,A 112 | RET 113 | ; 114 | ;TSTC: XTHL ;*** TSTC OR RST 1 *** 115 | ; RST 5 ;THIS IS AT LOC. 8 116 | ; CMP M ;AND THEN JUMP HERE 117 | TC1: INX H ;COMPARE THE BYTE THAT 118 | JZ TC2 ;FOLLOWS THE RST INST. 119 | PUSH B ;WITH THE TEXT (DE->) 120 | MOV C,M ;IF NOT =, ADD THE 2ND 121 | MVI B,0 ;BYTE THAT FOLLOWS THE 122 | DAD B ;RST TO THE OLD PC 123 | POP B ;I.E., DO A RELATIVE 124 | DCX D ;JUMP IF NOT = 125 | TC2: INX D ;IF =, SKIP THOSE BYTES 126 | INX H ;AND CONTINUE 127 | XTHL 128 | RET 129 | ; 130 | TSTNUM: LXI H,0 ;*** TSTNUM *** 131 | MOV B,H ;TEST IF THE TEXT IS 132 | RST 5 ;A NUMBER 133 | TN1: CPI '0' ;IF NOT, RETURN 0 IN 134 | RC ;B AND HL 135 | CPI 3AH ;IF NUMBERS, CONVERT 136 | RNC ;TO BINARY IN HL AND 137 | MVI A,0F0H ;SET B TO # OF DIGITS 138 | ANA H ;IF H>255, THERE IS NO 139 | JNZ QHOW ;ROOM FOR NEXT DIGIT 140 | INR B ;B COUNTS # OF DIGITS 141 | PUSH B 142 | MOV B,H ;HL=10*HL+(NEW DIGIT) 143 | MOV C,L 144 | DAD H ;WHERE 10* IS DONE BY 145 | DAD H ;SHIFT AND ADD 146 | DAD B 147 | DAD H 148 | LDAX D ;AND (DIGIT) IS FROM 149 | INX D ;STRIPPING THE ASCII 150 | ANI 0FH ;CODE 151 | ADD L 152 | MOV L,A 153 | MVI A,0 154 | ADC H 155 | MOV H,A 156 | POP B 157 | LDAX D ;DO THIS DIGIT AFTER 158 | JP TN1 ;DIGIT. S SAYS OVERFLOW 159 | QHOW: PUSH D ;*** ERROR "HOW?" *** 160 | AHOW: LXI D,HOW 161 | JMP ERROR 162 | HOW: DB 'HOW?',CR 163 | OK: DB 'OK',CR 164 | WHAT: DB 'WHAT?',CR 165 | SORRY: DB 'SORRY',CR 166 | ; 167 | ;************************************************************* 168 | ;* 169 | ;* *** MAIN *** 170 | ;* 171 | ;* THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM 172 | ;* AND STORES IT IN THE MEMORY. 173 | ;* 174 | ;* AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE 175 | ;* STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS 176 | ;* ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO 177 | ;* NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER 178 | ;* (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) 179 | ;* IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE 180 | ;* NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF 181 | ;* THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED 182 | ;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. 183 | ;* 184 | ;* AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM 185 | ;* LOOPS BACK AND ASK FOR ANOTHER LINE. THIS LOOP WILL BE 186 | ;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE 187 | ;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT". 188 | ;* 189 | ;* TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION 190 | ;* LABELED "TXTBGN" AND ENDED AT "TXTEND". WE ALWAYS FILL THIS 191 | ;* AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED 192 | ;* BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". 193 | ;* 194 | ;* THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER 195 | ;* THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN 196 | ;* THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND 197 | ;* (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0. 198 | ;* 199 | ;START: LXI SP,STACK ;THIS IS AT LOC. 0 200 | ST1: CALL CRLF ;AND JUMP TO HERE 201 | LXI D,OK ;DE->STRING 202 | SUB A ;A=0 203 | CALL PRTSTG ;PRINT STRING UNTIL CR 204 | LXI H,ST2+1 ;LITERAL 0 205 | SHLD CURRNT ;CURRENT->LINE # = 0 206 | ST2: LXI H,0 207 | SHLD LOPVAR 208 | SHLD STKGOS 209 | ST3: MVI A,'>' ;PROMPT '>' AND 210 | CALL GETLN ;READ A LINE 211 | PUSH D ;DE->END OF LINE 212 | LXI D,BUFFER ;DE->BEGINNING OF LINE 213 | CALL TSTNUM ;TEST IF IT IS A NUMBER 214 | RST 5 215 | MOV A,H ;HL=VALUE OF THE # OR 216 | ORA L ;0 IF NO # WAS FOUND 217 | POP B ;BC->END OF LINE 218 | JZ DIRECT 219 | DCX D ;BACKUP DE AND SAVE 220 | MOV A,H ;VALUE OF LINE # THERE 221 | STAX D 222 | DCX D 223 | MOV A,L 224 | STAX D 225 | PUSH B ;BC,DE->BEGIN, END 226 | PUSH D 227 | MOV A,C 228 | SUB E 229 | PUSH PSW ;A=# OF BYTES IN LINE 230 | CALL FNDLN ;FIND THIS LINE IN SAVE 231 | PUSH D ;AREA, DE->SAVE AREA 232 | JNZ ST4 ;NZ:NOT FOUND, INSERT 233 | PUSH D ;Z:FOUND, DELETE IT 234 | CALL FNDNXT ;FIND NEXT LINE 235 | ;DE->NEXT LINE 236 | POP B ;BC->LINE TO BE DELETED 237 | LHLD TXTUNF ;HL->UNFILLED SAVE AREA 238 | CALL MVUP ;MOVE UP TO DELETE 239 | MOV H,B ;TXTUNF->UNFILLED AREA 240 | MOV L,C 241 | SHLD TXTUNF ;UPDATE 242 | ST4: POP B ;GET READY TO INSERT 243 | LHLD TXTUNF ;BUT FIRST CHECK IF 244 | POP PSW ;THE LENGTH OF NEW LINE 245 | PUSH H ;IS 3 (LINE # AND CR) 246 | CPI 3 ;THEN DO NOT INSERT 247 | JZ START ;MUST CLEAR THE STACK 248 | ADD L ;COMPUTE NEW TXTUNF 249 | MOV L,A 250 | MVI A,0 251 | ADC H 252 | MOV H,A ;HL->NEW UNFILLED AREA 253 | LXI D,TXTEND ;CHECK TO SEE IF THERE 254 | RST 4 ;IS ENOUGH SPACE 255 | JNC QSORRY ;SORRY, NO ROOM FOR IT 256 | SHLD TXTUNF ;OK, UPDATE TXTUNF 257 | POP D ;DE->OLD UNFILLED AREA 258 | CALL MVDOWN 259 | POP D ;DE->BEGIN, HL->END 260 | POP H 261 | CALL MVUP ;MOVE NEW LINE TO SAVE 262 | JMP ST3 ;AREA 263 | ; 264 | ;************************************************************* 265 | ;* 266 | ;* *** TABLES *** DIRECT *** & EXEC *** 267 | ;* 268 | ;* THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. 269 | ;* WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION 270 | ;* OF CODE ACCORDING TO THE TABLE. 271 | ;* 272 | ;* AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT 273 | ;* TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING. 274 | ;* HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF 275 | ;* ALL DIRECT AND STATEMENT COMMANDS. 276 | ;* 277 | ;* A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL 278 | ;* MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.', 279 | ;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'. 280 | ;* 281 | ;* THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM 282 | ;* IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND 283 | ;* A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH 284 | ;* BYTE SET TO 1. 285 | ;* 286 | ;* END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE 287 | ;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL 288 | ;* MATCH THIS NULL ITEM AS DEFAULT. 289 | ;* 290 | TAB1 EQU $ ;DIRECT COMMANDS 291 | DB 'LIST' 292 | ITEM LIST 293 | DB 'RUN' 294 | ITEM RUN 295 | DB 'NEW' 296 | ITEM NEW 297 | TAB2 EQU $ ;DIRECT/STATEMENT 298 | DB 'NEXT' 299 | ITEM NEXT 300 | DB 'LET' 301 | ITEM LET 302 | DB 'IF' 303 | ITEM IFF 304 | DB 'GOTO' 305 | ITEM GOTO 306 | DB 'GOSUB' 307 | ITEM GOSUB 308 | DB 'RETURN' 309 | ITEM RETURN 310 | DB 'REM' 311 | ITEM REM 312 | DB 'FOR' 313 | ITEM FOR 314 | DB 'INPUT' 315 | ITEM INPUT 316 | DB 'PRINT' 317 | ITEM PRINT 318 | DB 'STOP' 319 | ITEM STOP 320 | ITEM DEFLT 321 | DB 'YOU MAY INSERT MORE COMMANDS.' 322 | TAB4 EQU $ ;FUNCTIONS 323 | DB 'RND' 324 | ITEM RND 325 | DB 'ABS' 326 | ITEM ABS 327 | DB 'SIZE' 328 | ITEM SIZE 329 | ITEM XP40 330 | DB 'YOU MAY INSERT MORE FUNCTIONS' 331 | TAB5 EQU $ ;"TO" IN "FOR" 332 | DB 'TO' 333 | ITEM FR1 334 | ITEM QWHAT 335 | TAB6 EQU $ ;"STEP" IN "FOR" 336 | DB 'STEP' 337 | ITEM FR2 338 | ITEM FR3 339 | TAB8 EQU $ ;RELATION OPERATORS 340 | DB '>=' 341 | ITEM XP11 342 | DB '#' 343 | ITEM XP12 344 | DB '>' 345 | ITEM XP13 346 | DB '=' 347 | ITEM XP15 348 | DB '<=' 349 | ITEM XP14 350 | DB '<' 351 | ITEM XP16 352 | ITEM XP17 353 | ; 354 | DIRECT: LXI H,TAB1-1 ;*** DIRECT *** 355 | ; 356 | EXEC EQU $ ;*** EXEC *** 357 | EX0: RST 5 ;IGNORE LEADING BLANKS 358 | PUSH D ;SAVE POINTER 359 | EX1: LDAX D ;IF FOUND '.' IN STRING 360 | INX D ;BEFORE ANY MISMATCH 361 | CPI '.' ;WE DECLARE A MATCH 362 | JZ EX3 363 | INX H ;HL->TABLE 364 | CMP M ;IF MATCH, TEST NEXT 365 | JZ EX1 366 | MVI A,7FH ;ELSE SEE IF BIT 7 367 | DCX D ;OF TABLE IS SET, WHICH 368 | CMP M ;IS THE JUMP ADDR. (HI) 369 | JC EX5 ;C:YES, MATCHED 370 | EX2: INX H ;NC:NO, FIND JUMP ADDR. 371 | CMP M 372 | JNC EX2 373 | INX H ;BUMP TO NEXT TAB. ITEM 374 | POP D ;RESTORE STRING POINTER 375 | JMP EX0 ;TEST AGAINST NEXT ITEM 376 | EX3: MVI A,7FH ;PARTIAL MATCH, FIND 377 | EX4: INX H ;JUMP ADDR., WHICH IS 378 | CMP M ;FLAGGED BY BIT 7 379 | JNC EX4 380 | EX5: MOV A,M ;LOAD HL WITH THE JUMP 381 | INX H ;ADDRESS FROM THE TABLE 382 | MOV L,M 383 | ANI 07FH ;MASK OFF BIT 7 384 | MOV H,A 385 | POP PSW ;CLEAN UP THE GABAGE 386 | PCHL ;AND WE GO DO IT 387 | ; 388 | ;************************************************************* 389 | ;* 390 | ;* WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT 391 | ;* COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE 392 | ;* COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST 393 | ;* SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS 394 | ;* TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: 395 | ;* 396 | ;* FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'START' 397 | ;* FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE 398 | ;* GO BACK TO 'START'. 399 | ;* FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. 400 | ;* FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. 401 | ;* FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'START', ELSE 402 | ;* GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) 403 | ;************************************************************* 404 | ;* 405 | ;* *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** 406 | ;* 407 | ;* 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' 408 | ;* 409 | ;* 'STOP(CR)' GOES BACK TO 'START' 410 | ;* 411 | ;* 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN 412 | ;* 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE 413 | ;* COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. 414 | ;* 415 | ;* THERE ARE 3 MORE ENTRIES IN 'RUN': 416 | ;* 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. 417 | ;* 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. 418 | ;* 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. 419 | ;* 420 | ;* 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET 421 | ;* LINE, AND JUMP TO 'RUNTSL' TO DO IT. 422 | ;* 423 | NEW: CALL ENDCHK ;*** NEW(CR) *** 424 | LXI H,TXTBGN 425 | SHLD TXTUNF 426 | ; 427 | STOP: CALL ENDCHK ;*** STOP(CR) *** 428 | RST 0 429 | ; 430 | RUN: CALL ENDCHK ;*** RUN(CR) *** 431 | LXI D,TXTBGN ;FIRST SAVED LINE 432 | ; 433 | RUNNXL: LXI H,0 ;*** RUNNXL *** 434 | CALL FDLNP ;FIND WHATEVER LINE # 435 | JC START ;C:PASSED TXTUNF, QUIT 436 | ; 437 | RUNTSL: XCHG ;*** RUNTSL *** 438 | SHLD CURRNT ;SET 'CURRENT'->LINE # 439 | XCHG 440 | INX D ;BUMP PASS LINE # 441 | INX D 442 | ; 443 | RUNSML: CALL CHKIO ;*** RUNSML *** 444 | LXI H,TAB2-1 ;FIND COMMAND IN TAB2 445 | JMP EXEC ;AND EXECUTE IT 446 | ; 447 | GOTO: RST 3 ;*** GOTO EXPR *** 448 | PUSH D ;SAVE FOR ERROR ROUTINE 449 | CALL ENDCHK ;MUST FIND A CR 450 | CALL FNDLN ;FIND THE TARGET LINE 451 | JNZ AHOW ;NO SUCH LINE # 452 | POP PSW ;CLEAR THE PUSH DE 453 | JMP RUNTSL ;GO DO IT 454 | ; 455 | ;************************************************************* 456 | ;* 457 | ;* *** LIST *** & PRINT *** 458 | ;* 459 | ;* LIST HAS TWO FORMS: 460 | ;* 'LIST(CR)' LISTS ALL SAVED LINES 461 | ;* 'LIST #(CR)' START LIST AT THIS LINE # 462 | ;* YOU CAN STOP THE LISTING BY CONTROL C KEY 463 | ;* 464 | ;* PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)' 465 | ;* WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK- 466 | ;* ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. 467 | ;* 468 | ;* A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS 469 | ;* THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO 470 | ;* BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT 471 | ;* COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS 472 | ;* SPECIFIED, 6 POSITIONS WILL BE USED. 473 | ;* 474 | ;* A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF 475 | ;* DOUBLE QUOTES. 476 | ;* 477 | ;* A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) 478 | ;* 479 | ;* A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN 480 | ;* PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST 481 | ;* ENDED WITH A COMMA, NO (CRLF) IS GENERATED. 482 | ;* 483 | LIST: CALL TSTNUM ;TEST IF THERE IS A # 484 | CALL ENDCHK ;IF NO # WE GET A 0 485 | CALL FNDLN ;FIND THIS OR NEXT LINE 486 | LS1: JC START ;C:PASSED TXTUNF 487 | CALL PRTLN ;PRINT THE LINE 488 | CALL CHKIO ;STOP IF HIT CONTROL-C 489 | CALL FDLNP ;FIND NEXT LINE 490 | JMP LS1 ;AND LOOP BACK 491 | ; 492 | PRINT: MVI C,6 ;C = # OF SPACES 493 | RST 1 ;IF NULL LIST & ";" 494 | DB ";" 495 | DB PR2-$-1 496 | CALL CRLF ;GIVE CR-LF AND 497 | JMP RUNSML ;CONTINUE SAME LINE 498 | PR2: RST 1 ;IF NULL LIST (CR) 499 | DB CR 500 | DB PR0-$-1 501 | CALL CRLF ;ALSO GIVE CR-LF AND 502 | JMP RUNNXL ;GO TO NEXT LINE 503 | PR0: RST 1 ;ELSE IS IT FORMAT? 504 | DB '#' 505 | DB PR1-$-1 506 | RST 3 ;YES, EVALUATE EXPR. 507 | MOV C,L ;AND SAVE IT IN C 508 | JMP PR3 ;LOOK FOR MORE TO PRINT 509 | PR1: CALL QTSTG ;OR IS IT A STRING? 510 | JMP PR8 ;IF NOT, MUST BE EXPR. 511 | PR3: RST 1 ;IF ",", GO FIND NEXT 512 | DB "," 513 | DB PR6-$-1 514 | CALL FIN ;IN THE LIST. 515 | JMP PR0 ;LIST CONTINUES 516 | PR6: CALL CRLF ;LIST ENDS 517 | RST 6 518 | PR8: RST 3 ;EVALUATE THE EXPR 519 | PUSH B 520 | CALL PRTNUM ;PRINT THE VALUE 521 | POP B 522 | JMP PR3 ;MORE TO PRINT? 523 | ; 524 | ;************************************************************* 525 | ;* 526 | ;* *** GOSUB *** & RETURN *** 527 | ;* 528 | ;* 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' 529 | ;* COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER 530 | ;* ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE 531 | ;* SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED 532 | ;* (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED. 533 | ;* THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS 534 | ;* SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS' 535 | ;* IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE), 536 | ;* BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S. 537 | ;* 538 | ;* 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS 539 | ;* RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT 540 | ;* 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE 541 | ;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR. 542 | ;* 543 | GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR" 544 | RST 3 ;PARAMETERS 545 | PUSH D ;AND TEXT POINTER 546 | CALL FNDLN ;FIND THE TARGET LINE 547 | JNZ AHOW ;NOT THERE. SAY "HOW?" 548 | LHLD CURRNT ;FOUND IT, SAVE OLD 549 | PUSH H ;'CURRNT' OLD 'STKGOS' 550 | LHLD STKGOS 551 | PUSH H 552 | LXI H,0 ;AND LOAD NEW ONES 553 | SHLD LOPVAR 554 | DAD SP 555 | SHLD STKGOS 556 | JMP RUNTSL ;THEN RUN THAT LINE 557 | RETURN: CALL ENDCHK ;THERE MUST BE A CR 558 | LHLD STKGOS ;OLD STACK POINTER 559 | MOV A,H ;0 MEANS NOT EXIST 560 | ORA L 561 | JZ QWHAT ;SO, WE SAY: "WHAT?" 562 | SPHL ;ELSE, RESTORE IT 563 | POP H 564 | SHLD STKGOS ;AND THE OLD 'STKGOS' 565 | POP H 566 | SHLD CURRNT ;AND THE OLD 'CURRNT' 567 | POP D ;OLD TEXT POINTER 568 | CALL POPA ;OLD "FOR" PARAMETERS 569 | RST 6 ;AND WE ARE BACK HOME 570 | ; 571 | ;************************************************************* 572 | ;* 573 | ;* *** FOR *** & NEXT *** 574 | ;* 575 | ;* 'FOR' HAS TWO FORMS: 576 | ;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2' 577 | ;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH 578 | ;* EXP1=1. (I.E., WITH A STEP OF +1.) 579 | ;* TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE 580 | ;* CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXPR2 AND EXP1 581 | ;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN 582 | ;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 583 | ;* 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME- 584 | ;* THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO 585 | ;* 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK 586 | ;* BEFORE THE NEW ONE OVERWRITES IT. 587 | ;* TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME 588 | ;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP. 589 | ;* IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED. 590 | ;* (PURGED FROM THE STACK..) 591 | ;* 592 | ;* 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) 593 | ;* END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED 594 | ;* WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN 595 | ;* THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT 596 | ;* DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO 597 | ;* THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT 598 | ;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND 599 | ;* FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA 600 | ;* IS PURGED AND EXECUTION CONTINUES. 601 | ;* 602 | FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA 603 | CALL SETVAL ;SET THE CONTROL VAR. 604 | DCX H ;HL IS ITS ADDRESS 605 | SHLD LOPVAR ;SAVE THAT 606 | LXI H,TAB5-1 ;USE 'EXEC' TO LOOK 607 | JMP EXEC ;FOR THE WORD 'TO' 608 | FR1: RST 3 ;EVALUATE THE LIMIT 609 | SHLD LOPLMT ;SAVE THAT 610 | LXI H,TAB6-1 ;USE 'EXEC' TO LOOK 611 | JMP EXEC ;FOR THE WORD 'STEP' 612 | FR2: RST 3 ;FOUND IT, GET STEP 613 | JMP FR4 614 | FR3: LXI H,1 ;NOT FOUND, SET TO 1 615 | FR4: SHLD LOPINC ;SAVE THAT TOO 616 | FR5: LHLD CURRNT ;SAVE CURRENT LINE # 617 | SHLD LOPLN 618 | XCHG ;AND TEXT POINTER 619 | SHLD LOPPT 620 | LXI B,10 ;DIG INTO STACK TO 621 | LHLD LOPVAR ;FIND 'LOPVAR' 622 | XCHG 623 | MOV H,B 624 | MOV L,B ;HL=0 NOW 625 | DAD SP ;HERE IS THE STACK 626 | DB 3EH 627 | FR7: DAD B ;EACH LEVEL IS 10 DEEP 628 | MOV A,M ;GET THAT OLD 'LOPVAR' 629 | INX H 630 | ORA M 631 | JZ FR8 ;0 SAYS NO MORE IN IT 632 | MOV A,M 633 | DCX H 634 | CMP D ;SAME AS THIS ONE? 635 | JNZ FR7 636 | MOV A,M ;THE OTHER HALF? 637 | CMP E 638 | JNZ FR7 639 | XCHG ;YES, FOUND ONE 640 | LXI H,0 641 | DAD SP ;TRY TO MOVE SP 642 | MOV B,H 643 | MOV C,L 644 | LXI H,10 645 | DAD D 646 | CALL MVDOWN ;AND PURGE 10 WORDS 647 | SPHL ;IN THE STACK 648 | FR8: LHLD LOPPT ;JOB DONE, RESTORE DE 649 | XCHG 650 | RST 6 ;AND CONTINUE 651 | ; 652 | NEXT: RST 7 ;GET ADDRESS OF VAR. 653 | JC QWHAT ;NO VARIABLE, "WHAT?" 654 | SHLD VARNXT ;YES, SAVE IT 655 | NX0: PUSH D ;SAVE TEXT POINTER 656 | XCHG 657 | LHLD LOPVAR ;GET VAR. IN 'FOR' 658 | MOV A,H 659 | ORA L ;0 SAYS NEVER HAD ONE 660 | JZ AWHAT ;SO WE ASK: "WHAT?" 661 | RST 4 ;ELSE WE CHECK THEM 662 | JZ NX3 ;OK, THEY AGREE 663 | POP D ;NO, LET'S SEE 664 | CALL POPA ;PURGE CURRENT LOOP 665 | LHLD VARNXT ;AND POP ONE LEVEL 666 | JMP NX0 ;GO CHECK AGAIN 667 | NX3: MOV E,M ;COME HERE WHEN AGREED 668 | INX H 669 | MOV D,M ;DE=VALUE OF VAR. 670 | LHLD LOPINC 671 | PUSH H 672 | DAD D ;ADD ONE STEP 673 | XCHG 674 | LHLD LOPVAR ;PUT IT BACK 675 | MOV M,E 676 | INX H 677 | MOV M,D 678 | LHLD LOPLMT ;HL->LIMIT 679 | POP PSW ;OLD HL 680 | ORA A 681 | JP NX1 ;STEP > 0 682 | XCHG ;STEP < 0 683 | NX1: CALL CKHLDE ;COMPARE WITH LIMIT 684 | POP D ;RESTORE TEXT POINTER 685 | JC NX2 ;OUTSIDE LIMIT 686 | LHLD LOPLN ;WITHIN LIMIT, GO 687 | SHLD CURRNT ;BACK TO THE SAVED 688 | LHLD LOPPT ;'CURRNT' AND TEXT 689 | XCHG ;POINTER 690 | RST 6 691 | NX2: CALL POPA ;PURGE THIS LOOP 692 | RST 6 693 | ; 694 | ;************************************************************* 695 | ;* 696 | ;* *** REM *** IF *** INPUT *** & LET (& DEFLT) *** 697 | ;* 698 | ;* 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. 699 | ;* TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. 700 | ;* 701 | ;* 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE 702 | ;* COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS. 703 | ;* NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE 704 | ;* EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE 705 | ;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND 706 | ;* EXECUTION CONTINUES AT THE NEXT LINE. 707 | ;* 708 | ;* 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED 709 | ;* BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR 710 | ;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS 711 | ;* IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS 712 | ;* PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN 713 | ;* EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE 714 | ;* VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING 715 | ;* (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE 716 | ;* PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. 717 | ;* AND SET THE VARIABLE TO THE VALUE OF THE EXPR. 718 | ;* 719 | ;* IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", 720 | ;* "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. 721 | ;* THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. 722 | ;* THIS IS HANDLED IN 'INPERR'. 723 | ;* 724 | ;* 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. 725 | ;* EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. 726 | ;* TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. 727 | ;* TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. 728 | ;* THIS IS DONE BY 'DEFLT'. 729 | ;* 730 | REM: LXI H,0 ;*** REM *** 731 | DB 3EH ;THIS IS LIKE 'IF 0' 732 | ; 733 | IFF: RST 3 ;*** IF *** 734 | MOV A,H ;IS THE EXPR.=0? 735 | ORA L 736 | JNZ RUNSML ;NO, CONTINUE 737 | CALL FNDSKP ;YES, SKIP REST OF LINE 738 | JNC RUNTSL ;AND RUN THE NEXT LINE 739 | RST 0 ;IF NO NEXT, RE-START 740 | ; 741 | INPERR: LHLD STKINP ;*** INPERR *** 742 | SPHL ;RESTORE OLD SP 743 | POP H ;AND OLD 'CURRNT' 744 | SHLD CURRNT 745 | POP D ;AND OLD TEXT POINTER 746 | POP D 747 | ; 748 | INPUT EQU $ ;*** INPUT *** 749 | IP1: PUSH D ;SAVE IN CASE OF ERROR 750 | CALL QTSTG ;IS NEXT ITEM A STRING? 751 | JMP IP2 ;NO 752 | RST 7 ;YES, BUT FOLLOWED BY A 753 | JC IP4 ;VARIABLE? NO. 754 | JMP IP3 ;YES. INPUT VARIABLE 755 | IP2: PUSH D ;SAVE FOR 'PRTSTG' 756 | RST 7 ;MUST BE VARIABLE NOW 757 | JC QWHAT ;"WHAT?" IT IS NOT? 758 | LDAX D ;GET READY FOR 'PRTSTR' 759 | MOV C,A 760 | SUB A 761 | STAX D 762 | POP D 763 | CALL PRTSTG ;PRINT STRING AS PROMPT 764 | MOV A,C ;RESTORE TEXT 765 | DCX D 766 | STAX D 767 | IP3: PUSH D ;SAVE IN CASE OF ERROR 768 | XCHG 769 | LHLD CURRNT ;ALSO SAVE 'CURRNT' 770 | PUSH H 771 | LXI H,IP1 ;A NEGATIVE NUMBER 772 | SHLD CURRNT ;AS A FLAG 773 | LXI H,0 ;SAVE SP TOO 774 | DAD SP 775 | SHLD STKINP 776 | PUSH D ;OLD HL 777 | MVI A,':' ;PRINT THIS TOO 778 | CALL GETLN ;AND GET A LINE 779 | LXI D,BUFFER ;POINTS TO BUFFER 780 | RST 3 ;EVALUATE INPUT 781 | NOP ;CAN BE 'CALL ENDCHK' 782 | NOP 783 | NOP 784 | POP D ;OK, GET OLD HL 785 | XCHG 786 | MOV M,E ;SAVE VALUE IN VAR. 787 | INX H 788 | MOV M,D 789 | POP H ;GET OLD 'CURRNT' 790 | SHLD CURRNT 791 | POP D ;AND OLD TEXT POINTER 792 | IP4: POP PSW ;PURGE JUNK IN STACK 793 | RST 1 ;IS NEXT CH. ','? 794 | DB "," 795 | DB IP5-$-1 796 | JMP IP1 ;YES, MORE ITEMS. 797 | IP5: RST 6 798 | ; 799 | DEFLT: LDAX D ;*** DEFLT *** 800 | CPI CR ;EMPTY LINE IS OK 801 | JZ LT1 ;ELSE IT IS 'LET' 802 | ; 803 | LET: CALL SETVAL ;*** LET *** 804 | RST 1 ;SET VALUE TO VAR. 805 | DB "," 806 | DB LT1-$-1 807 | JMP LET ;ITEM BY ITEM 808 | LT1: RST 6 ;UNTIL FINISH 809 | ; 810 | ;************************************************************* 811 | ;* 812 | ;* *** EXPR *** 813 | ;* 814 | ;* 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. 815 | ;* :: 816 | ;* 817 | ;* WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE 818 | ;* RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. 819 | ;* ::=(+ OR -)(+ OR -)(....) 820 | ;* WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. 821 | ;* ::=(* OR />)(....) 822 | ;* ::= 823 | ;* 824 | ;* () 825 | ;* IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN 826 | ;* AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND 827 | ;* CAN BE AN IN PARANTHESE. 828 | ;* 829 | ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18 830 | ; PUSH H ;SAVE VALUE 831 | EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP. 832 | JMP EXEC ;GO DO IT 833 | XP11: CALL XP18 ;REL.OP.">=" 834 | RC ;NO, RETURN HL=0 835 | MOV L,A ;YES, RETURN HL=1 836 | RET 837 | XP12: CALL XP18 ;REL.OP."#" 838 | RZ ;FALSE, RETURN HL=0 839 | MOV L,A ;TRUE, RETURN HL=1 840 | RET 841 | XP13: CALL XP18 ;REL.OP.">" 842 | RZ ;FALSE 843 | RC ;ALSO FALSE, HL=0 844 | MOV L,A ;TRUE, HL=1 845 | RET 846 | XP14: CALL XP18 ;REL.OP."<=" 847 | MOV L,A ;SET HL=1 848 | RZ ;REL. TRUE, RETURN 849 | RC 850 | MOV L,H ;ELSE SET HL=0 851 | RET 852 | XP15: CALL XP18 ;REL.OP."=" 853 | RNZ ;FALSE, RETURN HL=0 854 | MOV L,A ;ELSE SET HL=1 855 | RET 856 | XP16: CALL XP18 ;REL.OP."<" 857 | RNC ;FALSE, RETURN HL=0 858 | MOV L,A ;ELSE SET HL=1 859 | RET 860 | XP17: POP H ;NOT .REL.OP 861 | RET ;RETURN HL= 862 | XP18: MOV A,C ;SUBROUTINE FOR ALL 863 | POP H ;REL.OP.'S 864 | POP B 865 | PUSH H ;REVERSE TOP OF STACK 866 | PUSH B 867 | MOV C,A 868 | CALL EXPR2 ;GET 2ND 869 | XCHG ;VALUE IN DE NOW 870 | XTHL ;1ST IN HL 871 | CALL CKHLDE ;COMPARE 1ST WITH 2ND 872 | POP D ;RESTORE TEXT POINTER 873 | LXI H,0 ;SET HL=0, A=1 874 | MVI A,1 875 | RET 876 | ; 877 | EXPR2: RST 1 ;NEGATIVE SIGN? 878 | DB '-' 879 | DB XP21-$-1 880 | LXI H,0 ;YES, FAKE '0-' 881 | JMP XP26 ;TREAT LIKE SUBTRACT 882 | XP21: RST 1 ;POSITIVE SIGN? IGNORE 883 | DB '+' 884 | DB XP22-$-1 885 | XP22: CALL EXPR3 ;1ST 886 | XP23: RST 1 ;ADD? 887 | DB '+' 888 | DB XP25-$-1 889 | PUSH H ;YES, SAVE VALUE 890 | CALL EXPR3 ;GET 2ND 891 | XP24: XCHG ;2ND IN DE 892 | XTHL ;1ST IN HL 893 | MOV A,H ;COMPARE SIGN 894 | XRA D 895 | MOV A,D 896 | DAD D 897 | POP D ;RESTORE TEXT POINTER 898 | JM XP23 ;1ST AND 2ND SIGN DIFFER 899 | XRA H ;1ST AND 2ND SIGN EQUAL 900 | JP XP23 ;SO IS RESULT 901 | JMP QHOW ;ELSE WE HAVE OVERFLOW 902 | XP25: RST 1 ;SUBTRACT? 903 | DB '-' 904 | DB XP42-$-1 905 | XP26: PUSH H ;YES, SAVE 1ST 906 | CALL EXPR3 ;GET 2ND 907 | CALL CHGSGN ;NEGATE 908 | JMP XP24 ;AND ADD THEM 909 | ; 910 | EXPR3: CALL EXPR4 ;GET 1ST 911 | XP31: RST 1 ;MULTIPLY? 912 | DB '*' 913 | DB XP34-$-1 914 | PUSH H ;YES, SAVE 1ST 915 | CALL EXPR4 ;AND GET 2ND 916 | MVI B,0 ;CLEAR B FOR SIGN 917 | CALL CHKSGN ;CHECK SIGN 918 | XCHG ;2ND IN DE NOW 919 | XTHL ;1ST IN HL 920 | CALL CHKSGN ;CHECK SIGN OF 1ST 921 | MOV A,H ;IS HL > 255 ? 922 | ORA A 923 | JZ XP32 ;NO 924 | MOV A,D ;YES, HOW ABOUT DE 925 | ORA D 926 | XCHG ;PUT SMALLER IN HL 927 | JNZ AHOW ;ALSO >, WILL OVERFLOW 928 | XP32: MOV A,L ;THIS IS DUMB 929 | LXI H,0 ;CLEAR RESULT 930 | ORA A ;ADD AND COUNT 931 | JZ XP35 932 | XP33: DAD D 933 | JC AHOW ;OVERFLOW 934 | DCR A 935 | JNZ XP33 936 | JMP XP35 ;FINISHED 937 | XP34: RST 1 ;DIVIDE? 938 | DB '/' 939 | DB XP42-$-1 940 | PUSH H ;YES, SAVE 1ST 941 | CALL EXPR4 ;AND GET THE SECOND ONE 942 | MVI B,0 ;CLEAR B FOR SIGN 943 | CALL CHKSGN ;CHECK SIGN OF 2ND 944 | XCHG ;PUT 2ND IN DE 945 | XTHL ;GET 1ST IN HL 946 | CALL CHKSGN ;CHECK SIGN OF 1ST 947 | MOV A,D ;DIVIDE BY 0? 948 | ORA E 949 | JZ AHOW ;SAY "HOW?" 950 | PUSH B ;ELSE SAVE SIGN 951 | CALL DIVIDE ;USE SUBROUTINE 952 | MOV H,B ;RESULT IN HL NOW 953 | MOV L,C 954 | POP B ;GET SIGN BACK 955 | XP35: POP D ;AND TEXT POINTER 956 | MOV A,H ;HL MUST BE + 957 | ORA A 958 | JM QHOW ;ELSE IT IS OVERFLOW 959 | MOV A,B 960 | ORA A 961 | CM CHGSGN ;CHANGE SIGN IF NEEDED 962 | JMP XP31 ;LOOK FOR MORE TERMS 963 | ; 964 | EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4 965 | JMP EXEC ;AND GO DO IT 966 | XP40: RST 7 ;NO, NOT A FUNCTION 967 | JC XP41 ;NOR A VARIABLE 968 | MOV A,M ;VARIABLE 969 | INX H 970 | MOV H,M ;VALUE IN HL 971 | MOV L,A 972 | RET 973 | XP41: CALL TSTNUM ;OR IS IT A NUMBER 974 | MOV A,B ;# OF DIGIT 975 | ORA A 976 | RNZ ;OK 977 | PARN: RST 1 978 | DB '(' 979 | DB XP43-$-1 980 | RST 3 ;"(EXPR)" 981 | RST 1 982 | DB ')' 983 | DB XP43-$-1 984 | XP42: RET 985 | XP43: JMP QWHAT ;ELSE SAY: "WHAT?" 986 | ; 987 | RND: CALL PARN ;*** RND(EXPR) *** 988 | MOV A,H ;EXPR MUST BE + 989 | ORA A 990 | JM QHOW 991 | ORA L ;AND NON-ZERO 992 | JZ QHOW 993 | PUSH D ;SAVE BOTH 994 | PUSH H 995 | LHLD RANPNT ;GET MEMORY AS RANDOM 996 | LXI D,LSTROM ;NUMBER 997 | RST 4 998 | JC RA1 ;WRAP AROUND IF LAST 999 | LXI H,START 1000 | RA1: MOV E,M 1001 | INX H 1002 | MOV D,M 1003 | SHLD RANPNT 1004 | POP H 1005 | XCHG 1006 | PUSH B 1007 | CALL DIVIDE ;RND(N)=MOD(M,N)+1 1008 | POP B 1009 | POP D 1010 | INX H 1011 | RET 1012 | ; 1013 | ABS: CALL PARN ;*** ABS(EXPR) *** 1014 | CALL CHKSGN ;CHECK SIGN 1015 | MOV A,H ;NOTE THAT -32768 1016 | ORA H ;CANNOT CHANGE SIGN 1017 | JM QHOW ;SO SAY: "HOW?" 1018 | RET 1019 | ; 1020 | SIZE: LHLD TXTUNF ;*** SIZE *** 1021 | PUSH D ;GET THE NUMBER OF FREE 1022 | XCHG ;BYTES BETWEEN 'TXTUNF' 1023 | LXI H,VARBGN ;AND 'VARBGN' 1024 | CALL SUBDE 1025 | POP D 1026 | RET 1027 | ; 1028 | ;************************************************************* 1029 | ;* 1030 | ;* *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** 1031 | ;* 1032 | ;* 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL 1033 | ;* 1034 | ;* 'SUBDE' SUBSTRACTS DE FROM HL 1035 | ;* 1036 | ;* 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE 1037 | ;* SIGN AND FLIP SIGN OF B. 1038 | ;* 1039 | ;* 'CHGSGN' CHANGES SIGN OF HL AND B UNCONDITIONALLY. 1040 | ;* 1041 | ;* 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE 1042 | ;* ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER 1043 | ;* CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. 1044 | ;* 1045 | DIVIDE: PUSH H ;*** DIVIDE *** 1046 | MOV L,H ;DIVIDE H BY DE 1047 | MVI H,0 1048 | CALL DV1 1049 | MOV B,C ;SAVE RESULT IN B 1050 | MOV A,L ;(REMINDER+L)/DE 1051 | POP H 1052 | MOV H,A 1053 | DV1: MVI C,-1 ;RESULT IN C 1054 | DV2: INR C ;DUMB ROUTINE 1055 | CALL SUBDE ;DIVIDE BY SUBTRACT 1056 | JNC DV2 ;AND COUNT 1057 | DAD D 1058 | RET 1059 | ; 1060 | SUBDE: MOV A,L ;*** SUBDE *** 1061 | SUB E ;SUBSTRACT DE FROM 1062 | MOV L,A ;HL 1063 | MOV A,H 1064 | SBB D 1065 | MOV H,A 1066 | RET 1067 | ; 1068 | CHKSGN: MOV A,H ;*** CHKSGN *** 1069 | ORA A ;CHECK SIGN OF HL 1070 | RP ;IF -, CHANGE SIGN 1071 | ; 1072 | CHGSGN: MOV A,H ;*** CHGSGN *** 1073 | CMA ;CHANGE SIGN OF HL 1074 | MOV H,A 1075 | MOV A,L 1076 | CMA 1077 | MOV L,A 1078 | INX H 1079 | MOV A,B ;AND ALSO FLIP B 1080 | XRI 80H 1081 | MOV B,A 1082 | RET 1083 | ; 1084 | CKHLDE: MOV A,H 1085 | XRA D ;SAME SIGN? 1086 | JP CK1 ;YES, COMPARE 1087 | XCHG ;NO, XCH AND COMP 1088 | CK1: RST 4 1089 | RET 1090 | ; 1091 | ;************************************************************* 1092 | ;* 1093 | ;* *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** 1094 | ;* 1095 | ;* "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND 1096 | ;* THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE 1097 | ;* TO THAT VALUE. 1098 | ;* 1099 | ;* "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";", 1100 | ;* EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE 1101 | ;* NEXT LINE AND CONTINUE FROM THERE. 1102 | ;* 1103 | ;* "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS 1104 | ;* REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) 1105 | ;* 1106 | ;* "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). 1107 | ;* IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" 1108 | ;* INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP 1109 | ;* OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED 1110 | ;* AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO 1111 | ;* (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT 1112 | ;* PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT' 1113 | ;* COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS 1114 | ;* NOT TERMINATED BUT CONTINUED AT 'INPERR'. 1115 | ;* 1116 | ;* RELATED TO 'ERROR' ARE THE FOLLOWING: 1117 | ;* 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?" 1118 | ;* 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'. 1119 | ;* 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. 1120 | ;* 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS. 1121 | ;* 1122 | SETVAL: RST 7 ;*** SETVAL *** 1123 | JC QWHAT ;"WHAT?" NO VARIABLE 1124 | PUSH H ;SAVE ADDRESS OF VAR. 1125 | RST 1 ;PASS "=" SIGN 1126 | DB '=' 1127 | DB SV1-$-1 1128 | RST 3 ;EVALUATE EXPR. 1129 | MOV B,H ;VALUE IS IN BC NOW 1130 | MOV C,L 1131 | POP H ;GET ADDRESS 1132 | MOV M,C ;SAVE VALUE 1133 | INX H 1134 | MOV M,B 1135 | RET 1136 | SV1: JMP QWHAT ;NO "=" SIGN 1137 | ; 1138 | FIN: RST 1 ;*** FIN *** 1139 | DB ";" 1140 | DB FI1-$-1 1141 | POP PSW ;";", PURGE RET. ADDR. 1142 | JMP RUNSML ;CONTINUE SAME LINE 1143 | FI1: RST 1 ;NOT ";", IS IT CR? 1144 | DB CR 1145 | DB FI2-$-1 1146 | POP PSW ;YES, PURGE RET. ADDR. 1147 | JMP RUNNXL ;RUN NEXT LINE 1148 | FI2: RET ;ELSE RETURN TO CALLER 1149 | ; 1150 | ENDCHK: RST 5 ;*** ENDCHK *** 1151 | CPI CR ;END WITH CR? 1152 | RZ ;OK, ELSE SAY: "WHAT?" 1153 | ; 1154 | QWHAT: PUSH D ;*** QWHAT *** 1155 | AWHAT: LXI D,WHAT ;*** AWHAT *** 1156 | ERROR: SUB A ;*** ERROR *** 1157 | CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' 1158 | POP D ;OR 'SORRY' 1159 | LDAX D ;SAVE THE CHARACTER 1160 | PUSH PSW ;AT WHERE OLD DE -> 1161 | SUB A ;AND PUT A 0 THERE 1162 | STAX D 1163 | LHLD CURRNT ;GET CURRENT LINE # 1164 | PUSH H 1165 | MOV A,M ;CHECK THE VALUE 1166 | INX H 1167 | ORA M 1168 | POP D 1169 | JZ START ;IF ZERO, JUST RESTART 1170 | MOV A,M ;IF NEGATIVE, 1171 | ORA A 1172 | JM INPERR ;REDO INPUT 1173 | CALL PRTLN ;ELSE PRINT THE LINE 1174 | DCX D ;UPTO WHERE THE 0 IS 1175 | POP PSW ;RESTORE THE CHARACTER 1176 | STAX D 1177 | MVI A,'?' ;PRINT A "?" 1178 | RST 2 1179 | SUB A ;AND THE REST OF THE 1180 | CALL PRTSTG ;LINE 1181 | RST 0 ;THEN RESTART 1182 | ; 1183 | QSORRY: PUSH D ;*** QSORRY *** 1184 | ASORRY: LXI D,SORRY ;*** ASORRY *** 1185 | JMP ERROR 1186 | ; 1187 | ;************************************************************* 1188 | ;* 1189 | ;* *** GETLN *** FNDLN (& FRIENDS) *** 1190 | ;* 1191 | ;* 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT 1192 | ;* THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS 1193 | ;* THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL 1194 | ;* ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE 1195 | ;* THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO 1196 | ;* CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. 1197 | ;* CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN. 1198 | ;* 1199 | ;* 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE 1200 | ;* TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE 1201 | ;* LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE 1202 | ;* (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. 1203 | ;* IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE # 1204 | ;* IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF 1205 | ;* WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE 1206 | ;* LINE, FLAGS ARE C & NZ. 1207 | ;* 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE 1208 | ;* AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS 1209 | ;* ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. 1210 | ;* 'FDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #. 1211 | ;* 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH. 1212 | ;* 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH. 1213 | ;* 1214 | GETLN: RST 2 ;*** GETLN *** 1215 | LXI D,BUFFER ;PROMPT AND INIT. 1216 | GL1: CALL CHKIO ;CHECK KEYBOARD 1217 | JZ GL1 ;NO INPUT, WAIT 1218 | RST 2 ;INPUT, ECHO BACK 1219 | CPI LF ;IGNORE LF 1220 | JZ GL1 1221 | ORA A ;IGNORE NULL 1222 | JZ GL1 1223 | CPI DEL ;DELETE LAST CHARACTER? 1224 | JZ GL3 ;YES 1225 | ; CPI DLLN ;DELETE THE WHOLE LINE? 1226 | CPI CNTLU 1227 | JZ GL4 ;YES 1228 | STAX D ;ELSE SAVE INPUT 1229 | INX D ;AND BUMP POINTER 1230 | CPI CR ;WAS IT CR? 1231 | RZ ;YES, END OF LINE 1232 | MOV A,E ;ELSE MORE FREE ROOM? 1233 | CPI BUFEND 1234 | JNZ GL1 ;YES, GET NEXT INPUT 1235 | GL3: MOV A,E ;DELETE LAST CHARACTER 1236 | CPI BUFFER ;BUT DO WE HAVE ANY? 1237 | JZ GL4 ;NO, REDO WHOLE LINE 1238 | DCX D ;YES, BACKUP POINTER 1239 | MVI A,BKS ;AND ECHO A BACK-SLASH 1240 | RST 2 1241 | JMP GL1 ;GO GET NEXT INPUT 1242 | GL4: CALL CRLF ;REDO ENTIRE LINE 1243 | MVI A,UPA ;CR, LF AND UP-ARROW 1244 | JMP GETLN 1245 | ; 1246 | FNDLN: MOV A,H ;*** FNDLN *** 1247 | ORA A ;CHECK SIGN OF HL 1248 | JM QHOW ;IT CANNOT BE - 1249 | LXI D,TXTBGN ;INIT TEXT POINTER 1250 | ; 1251 | FDLNP EQU $ ;*** FDLNP *** 1252 | FL1: PUSH H ;SAVE LINE # 1253 | LHLD TXTUNF ;CHECK IF WE PASSED END 1254 | DCX H 1255 | RST 4 1256 | POP H ;GET LINE # BACK 1257 | RC ;C,NZ PASSED END 1258 | LDAX D ;WE DID NOT, GET BYTE 1 1259 | SUB L ;IS THIS THE LINE? 1260 | MOV B,A ;COMPARE LOW ORDER 1261 | INX D 1262 | LDAX D ;GET BYTE 2 1263 | SBB H ;COMPARE HIGH ORDER 1264 | JC FL2 ;NO, NOT THERE YET 1265 | DCX D ;ELSE WE EITHER FOUND 1266 | ORA B ;IT, OR IT IS NOT THERE 1267 | RET ;NC,Z:FOUND, NC,NZ:NO 1268 | ; 1269 | FNDNXT EQU $ ;*** FNDNXT *** 1270 | INX D ;FIND NEXT LINE 1271 | FL2: INX D ;JUST PASSED BYTE 1 & 2 1272 | ; 1273 | FNDSKP: LDAX D ;*** FNDSKP *** 1274 | CPI CR ;TRY TO FIND CR 1275 | JNZ FL2 ;KEEP LOOKING 1276 | INX D ;FOUND CR, SKIP OVER 1277 | JMP FL1 ;CHECK IF END OF TEXT 1278 | ; 1279 | ;************************************************************* 1280 | ;* 1281 | ;* *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN *** 1282 | ;* 1283 | ;* 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING 1284 | ;* AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN 1285 | ;* THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE 1286 | ;* CALLER). OLD A IS STORED IN B, OLD B IS LOST. 1287 | ;* 1288 | ;* 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE 1289 | ;* QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW, 1290 | ;* OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT 1291 | ;* THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. 1292 | ;* AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED 1293 | ;* OVER (USUALLY A JUMP INSTRUCTION. 1294 | ;* 1295 | ;* 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED 1296 | ;* IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. 1297 | ;* HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN 1298 | ;* C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO 1299 | ;* PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT. 1300 | ;* 1301 | ;* 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL. 1302 | ;* 1303 | PRTSTG: MOV B,A ;*** PRTSTG *** 1304 | PS1: LDAX D ;GET A CHARACTER 1305 | INX D ;BUMP POINTER 1306 | CMP B ;SAME AS OLD A? 1307 | RZ ;YES, RETURN 1308 | RST 2 ;ELSE PRINT IT 1309 | CPI CR ;WAS IT A CR? 1310 | JNZ PS1 ;NO, NEXT 1311 | RET ;YES, RETURN 1312 | ; 1313 | QTSTG: RST 1 ;*** QTSTG *** 1314 | DB 0x22 ;'"' 1315 | DB QT3-$-1 1316 | MVI A,0x22 ;IT IS A " 1317 | QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER 1318 | CPI CR ;WAS LAST ONE A CR? 1319 | POP H ;RETURN ADDRESS 1320 | JZ RUNNXL ;WAS CR, RUN NEXT LINE 1321 | QT2: INX H ;SKIP 3 BYTES ON RETURN 1322 | INX H 1323 | INX H 1324 | PCHL ;RETURN 1325 | QT3: RST 1 ;IS IT A '? 1326 | DB QT 1327 | DB QT4-$-1 1328 | MVI A,QT ;YES, DO THE SAME 1329 | JMP QT1 ;AS IN " 1330 | QT4: RST 1 ;IS IT BACK-ARROW? 1331 | DB BKA 1332 | DB QT5-$-1 1333 | MVI A,8DH ;YES, CR WITHOUT LF 1334 | RST 2 ;DO IT TWICE TO GIVE 1335 | RST 2 ;TTY ENOUGH TIME 1336 | POP H ;RETURN ADDRESS 1337 | JMP QT2 1338 | QT5: RET ;NONE OF ABOVE 1339 | ; 1340 | PRTNUM: PUSH D ;*** PRTNUM *** 1341 | LXI D,10 ;DECIMAL 1342 | PUSH D ;SAVE AS A FLAG 1343 | MOV B,D ;B=SIGN 1344 | DCR C ;C=SPACES 1345 | CALL CHKSGN ;CHECK SIGN 1346 | JP PN1 ;NO SIGN 1347 | MVI B,'-' ;B=SIGN 1348 | DCR C ;'-' TAKES SPACE 1349 | PN1: PUSH B ;SAVE SIGN & SPACE 1350 | PN2: CALL DIVIDE ;DIVIDE HL BY 10 1351 | MOV A,B ;RESULT 0? 1352 | ORA C 1353 | JZ PN3 ;YES, WE GOT ALL 1354 | XTHL ;NO, SAVE REMAINDER 1355 | DCR L ;AND COUNT SPACE 1356 | PUSH H ;HL IS OLD BC 1357 | MOV H,B ;MOVE RESULT TO BC 1358 | MOV L,C 1359 | JMP PN2 ;AND DIVIDE BY 10 1360 | PN3: POP B ;WE GOT ALL DIGITS IN 1361 | PN4: DCR C ;THE STACK 1362 | MOV A,C ;LOOK AT SPACE COUNT 1363 | ORA A 1364 | JM PN5 ;NO LEADING BLANKS 1365 | MVI A,' ' ;LEADING BLANKS 1366 | RST 2 1367 | JMP PN4 ;MORE? 1368 | PN5: MOV A,B ;PRINT SIGN 1369 | RST 2 ;MAYBE - OR NULL 1370 | MOV E,L ;LAST REMAINDER IN E 1371 | PN6: MOV A,E ;CHECK DIGIT IN E 1372 | CPI 10 ;10 IS FLAG FOR NO MORE 1373 | POP D 1374 | RZ ;IF SO, RETURN 1375 | ADI '0' ;ELSE CONVERT TO ASCII 1376 | RST 2 ;AND PRINT THE DIGIT 1377 | JMP PN6 ;GO BACK FOR MORE 1378 | ; 1379 | PRTLN: LDAX D ;*** PRTLN *** 1380 | MOV L,A ;LOW ORDER LINE # 1381 | INX D 1382 | LDAX D ;HIGH ORDER 1383 | MOV H,A 1384 | INX D 1385 | MVI C,4 ;PRINT 4 DIGIT LINE # 1386 | CALL PRTNUM 1387 | MVI A,' ' ;FOLLOWED BY A BLANK 1388 | RST 2 1389 | SUB A ;AND THEN THE NEXT 1390 | CALL PRTSTG 1391 | RET 1392 | ; 1393 | ;************************************************************* 1394 | ;* 1395 | ;* *** MVUP *** MVDOWN *** POPA *** & PUSHA *** 1396 | ;* 1397 | ;* 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL 1398 | ;* DE = HL 1399 | ;* 1400 | ;* 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> 1401 | ;* UNTIL DE = BC 1402 | ;* 1403 | ;* 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE 1404 | ;* STACK 1405 | ;* 1406 | ;* 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE 1407 | ;* STACK 1408 | ;* 1409 | MVUP: RST 4 ;*** MVUP *** 1410 | RZ ;DE = HL, RETURN 1411 | LDAX D ;GET ONE BYTE 1412 | STAX B ;MOVE IT 1413 | INX D ;INCREASE BOTH POINTERS 1414 | INX B 1415 | JMP MVUP ;UNTIL DONE 1416 | ; 1417 | MVDOWN: MOV A,B ;*** MVDOWN *** 1418 | SUB D ;TEST IF DE = BC 1419 | JNZ MD1 ;NO, GO MOVE 1420 | MOV A,C ;MAYBE, OTHER BYTE? 1421 | SUB E 1422 | RZ ;YES, RETURN 1423 | MD1: DCX D ;ELSE MOVE A BYTE 1424 | DCX H ;BUT FIRST DECREASE 1425 | LDAX D ;BOTH POINTERS AND 1426 | MOV M,A ;THEN DO IT 1427 | JMP MVDOWN ;LOOP BACK 1428 | ; 1429 | POPA: POP B ;BC = RETURN ADDR. 1430 | POP H ;RESTORE LOPVAR, BUT 1431 | SHLD LOPVAR ;=0 MEANS NO MORE 1432 | MOV A,H 1433 | ORA L 1434 | JZ PP1 ;YEP, GO RETURN 1435 | POP H ;NOP, RESTORE OTHERS 1436 | SHLD LOPINC 1437 | POP H 1438 | SHLD LOPLMT 1439 | POP H 1440 | SHLD LOPLN 1441 | POP H 1442 | SHLD LOPPT 1443 | PP1: PUSH B ;BC = RETURN ADDR. 1444 | RET 1445 | ; 1446 | PUSHA: LXI H,STKLMT ;*** PUSHA *** 1447 | CALL CHGSGN 1448 | POP B ;BC=RETURN ADDRESS 1449 | DAD SP ;IS STACK NEAR THE TOP? 1450 | JNC QSORRY ;YES, SORRY FOR THAT 1451 | LHLD LOPVAR ;ELSE SAVE LOOP VAR'S 1452 | MOV A,H ;BUT IF LOPVAR IS 0 1453 | ORA L ;THAT WILL BE ALL 1454 | JZ PU1 1455 | LHLD LOPPT ;ELSE, MORE TO SAVE 1456 | PUSH H 1457 | LHLD LOPLN 1458 | PUSH H 1459 | LHLD LOPLMT 1460 | PUSH H 1461 | LHLD LOPINC 1462 | PUSH H 1463 | LHLD LOPVAR 1464 | PU1: PUSH H 1465 | PUSH B ;BC = RETURN ADDR. 1466 | RET 1467 | ; 1468 | ;************************************************************* 1469 | ;* 1470 | ;* *** OUTC *** & CHKIO *** 1471 | ;* 1472 | ;* THESE ARE THE ONLY I/O ROUTINES IN TBI. 1473 | ;* 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0 1474 | ;* 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, 1475 | ;* IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO 1476 | ;* SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. 1477 | ;* ARE RESTORED. 1478 | ;* 1479 | ;* 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO 1480 | ;* THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG 1481 | ;* IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE 1482 | ;* INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND 1483 | ;* Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL 1484 | ;* RESTART TBI AND DO NOT RETURN TO THE CALLER. 1485 | ;* 1486 | ;OUTC: PUSH PSW ;THIS IS AT LOC. 10 1487 | ; LDA OCSW ;CHECK SOFTWARE SWITCH 1488 | ; ORA A 1489 | OC2: JNZ OC3 ;IT IS ON 1490 | POP PSW ;IT IS OFF 1491 | RET ;RESTORE AF AND RETURN 1492 | OC3: IN 0 ;COME HERE TO DO OUTPUT 1493 | ANI 02H ;STATUS BIT 1494 | JZ OC3 ;NOT READY, WAIT 1495 | POP PSW ;READY, GET OLD A BACK 1496 | OUT 1 ;AND SEND IT OUT 1497 | CPI CR ;WAS IT CR? 1498 | RNZ ;NO, FINISHED 1499 | MVI A,LF ;YES, WE SEND LF TOO 1500 | RST 2 ;THIS IS RECURSIVE 1501 | MVI A,CR ;GET CR BACK IN A 1502 | RET 1503 | ; 1504 | CHKIO: IN 0 ;*** CHKIO *** 1505 | NOP ;STATUS BIT FLIPPED? 1506 | ANI 20H ;MASK STATUS BIT 1507 | RZ ;NOT READY, RETURN "Z" 1508 | IN 1 ;READY, READ DATA 1509 | ANI 7FH ;MASK BIT 7 OFF 1510 | CPI CNTLO ;IS IT CONTROL-O? 1511 | JNZ CI1 ;NO, MORE CHECKING 1512 | LDA OCSW ;CONTROL-O FLIPS OCSW 1513 | CMA ;ON TO OFF, OFF TO ON 1514 | STA OCSW 1515 | JMP CHKIO ;GET ANOTHER INPUT 1516 | CI1: CPI CNTLC ;IS IT CONTROL-C? 1517 | RNZ ;NO, RETURN "NZ" 1518 | RST 0 ;YES, RESTART TBI 1519 | ; 1520 | DB 'YOU MAY NEED THIS SPACE TO' 1521 | DB "PATCH UP THE I/O ROUTINES," 1522 | DB "TO FIX UP BUGS, OR TO ADD" 1523 | DB 'MORE COMMANDS AND FUNCTIONS.' 1524 | DB 'SKY (SPACE) IS THE LIMIT.' 1525 | DB 'GOOD LUCK AND GOOD BYE.' 1526 | DB "LICHEN WANG, 10 JUNE 76" 1527 | ; 1528 | LSTROM EQU $ ;ALL ABOVE CAN BE ROM 1529 | 1530 | ORG 1000H ;HERE DOWN MUST BE RAM 1531 | OCSW: DB 0FFH ;SWITCH FOR OUTPUT 1532 | CURRNT: DW 0 ;POINTS TO CURRENT LINE 1533 | STKGOS: DW 0 ;SAVES SP IN 'GOSUB' 1534 | VARNXT EQU $ ;TEMP STORAGE 1535 | STKINP: DW 0 ;SAVES SP IN 'INPUT' 1536 | LOPVAR: DW 0 ;'FOR' LOOP SAVE AREA 1537 | LOPINC: DW 0 ;INCREMENT 1538 | LOPLMT: DW 0 ;LIMIT 1539 | LOPLN: DW 0 ;LINE NUMBER 1540 | LOPPT: DW 0 ;TEXT POINTER 1541 | RANPNT: DW START ;RANDOM NUMBER POINTER 1542 | TXTUNF: DW TXTBGN ;->UNFILLED TEXT AREA 1543 | TXTBGN: DS 1 ;TEXT SAVE AREA BEGINS 1544 | ORG 1300H 1545 | TXTEND EQU $ ;TEXT SAVE AREA ENDS 1546 | VARBGN: DS 2*27 ;VARIABLE @(0) 1547 | DS 1 ;EXTRA BYTE FOR BUFFER 1548 | BUFFER: DS 72 ;INPUT BUFFER 1549 | BUFEND EQU $ ;BUFFER ENDS 1550 | DS 40 ;EXTRA BYTES FOR STACK 1551 | STKLMT EQU $ ;TOP LIMIT FOR STACK 1552 | ORG 1400H 1553 | STACK EQU $ ;STACK STARTS HERE 1554 | 1555 | END --------------------------------------------------------------------------------