From 8a6f1654ee4102a34baf7e354cdac4f4fe9eb17c Mon Sep 17 00:00:00 2001 From: Tamas Rudnai Date: Wed, 11 Sep 2019 00:11:45 -0700 Subject: [PATCH] Refactoring instruction handler in switch Fixed some issues --- A2Mac.xcodeproj/project.pbxproj | 7 + .../xcschemes/xcschememanagement.plist | 5 + A2Mac/6502.c | 240 +- A2Mac/Apple2_mmio.h | 62 +- A2Mac/Apple2_mmio_8bit_ioaddr.h | 581 ++ A2Mac/instructions/6502_instr_branch.h | 49 +- A2Mac/instructions/6502_instr_call_ret_jump.h | 2 +- A2Mac/instructions/6502_instr_compare_test.h | 7 +- A2Mac/instructions/6502_instr_load_store.h | 31 +- A2Mac/instructions/6502_instr_shift_rotate.h | 44 +- Apple_II_ROM.s | 6914 +++++++++++++++++ 11 files changed, 7785 insertions(+), 157 deletions(-) create mode 100644 A2Mac/Apple2_mmio_8bit_ioaddr.h create mode 100644 Apple_II_ROM.s diff --git a/A2Mac.xcodeproj/project.pbxproj b/A2Mac.xcodeproj/project.pbxproj index ab70999..cda2552 100644 --- a/A2Mac.xcodeproj/project.pbxproj +++ b/A2Mac.xcodeproj/project.pbxproj @@ -56,6 +56,8 @@ 32439F8422ECD8AD0077AAE0 /* apple.rom */ = {isa = PBXFileReference; lastKnownFileType = file; path = apple.rom; sourceTree = ""; }; 32439F8522ECD8AD0077AAE0 /* 6502.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = 6502.h; sourceTree = ""; }; 32439F8622ECD8AD0077AAE0 /* common.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = common.h; sourceTree = ""; }; + 3264261023284F6F008B615F /* Apple2_mmio_8bit_ioaddr.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Apple2_mmio_8bit_ioaddr.h; sourceTree = ""; }; + 326426112328ADF4008B615F /* Apple_II_ROM.s */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.asm; path = Apple_II_ROM.s; sourceTree = ""; }; 32BFFB5722EACC630003B53F /* A2Mac.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = A2Mac.app; sourceTree = BUILT_PRODUCTS_DIR; }; 32BFFB5A22EACC630003B53F /* AppDelegate.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AppDelegate.swift; sourceTree = ""; }; 32BFFB5C22EACC630003B53F /* ViewController.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ViewController.swift; sourceTree = ""; }; @@ -121,6 +123,7 @@ 32BFFB4E22EACC630003B53F = { isa = PBXGroup; children = ( + 326426112328ADF4008B615F /* Apple_II_ROM.s */, 32BFFB5922EACC630003B53F /* A2Mac */, 32BFFB6C22EACC660003B53F /* A2MacTests */, 32BFFB7722EACC660003B53F /* A2MacUITests */, @@ -146,6 +149,7 @@ 32439F8522ECD8AD0077AAE0 /* 6502.h */, 32439F8422ECD8AD0077AAE0 /* apple.rom */, 32439F7322ECD8AD0077AAE0 /* Apple2_mmio.h */, + 3264261023284F6F008B615F /* Apple2_mmio_8bit_ioaddr.h */, 32439F8622ECD8AD0077AAE0 /* common.h */, 32BFFB5A22EACC630003B53F /* AppDelegate.swift */, 32BFFB5C22EACC630003B53F /* ViewController.swift */, @@ -483,6 +487,7 @@ CODE_SIGN_STYLE = Automatic; COMBINE_HIDPI_IMAGES = YES; DEVELOPMENT_TEAM = W6TFQTZ4DA; + GCC_FAST_MATH = YES; INFOPLIST_FILE = A2Mac/Info.plist; LD_RUNPATH_SEARCH_PATHS = ( "$(inherited)", @@ -505,6 +510,8 @@ CODE_SIGN_STYLE = Automatic; COMBINE_HIDPI_IMAGES = YES; DEVELOPMENT_TEAM = W6TFQTZ4DA; + GCC_FAST_MATH = YES; + GCC_OPTIMIZATION_LEVEL = fast; INFOPLIST_FILE = A2Mac/Info.plist; LD_RUNPATH_SEARCH_PATHS = ( "$(inherited)", diff --git a/A2Mac.xcodeproj/xcuserdata/trudnai.xcuserdatad/xcschemes/xcschememanagement.plist b/A2Mac.xcodeproj/xcuserdata/trudnai.xcuserdatad/xcschemes/xcschememanagement.plist index cbc6fdb..b357688 100644 --- a/A2Mac.xcodeproj/xcuserdata/trudnai.xcuserdatad/xcschemes/xcschememanagement.plist +++ b/A2Mac.xcodeproj/xcuserdata/trudnai.xcuserdatad/xcschemes/xcschememanagement.plist @@ -9,6 +9,11 @@ orderHint 0 + Debug.xcscheme + + orderHint + 1 + SuppressBuildableAutocreation diff --git a/A2Mac/6502.c b/A2Mac/6502.c index f81a5c3..cc3169f 100644 --- a/A2Mac/6502.c +++ b/A2Mac/6502.c @@ -45,31 +45,31 @@ static inline int m6502_step() { // switch ( fetch() ) { case 0x00: BRK(); return 2; // BRK - case 0x01: ORA( memread( addr_X_ind() ) ); return 6; // ORA X,ind + case 0x01: ORA( src_X_ind() ); return 6; // ORA X,ind // case 0x02: // t jams // case 0x03: // SLO* (undocumented) // case 0x04: // NOP* (undocumented) - case 0x05: ORA( memread_zp( fetch() ) ); return 3; // ORA zpg - case 0x06: ASL( & RAM[ fetch() ] ); return 5; // ASL zpg + case 0x05: ORA( src_zp() ); return 3; // ORA zpg + case 0x06: ASL( dest_zp() ); return 5; // ASL zpg // case 0x07: // SLO* (undocumented) case 0x08: PHP(); return 3; // PHP - case 0x09: ORA( fetch() ); return 2; // ORA imm - case 0x0A: ASL( & m6502.A ); return 2; // ASL A + case 0x09: ORA( imm() ); return 2; // ORA imm + case 0x0A: ASLA(); return 2; // ASL A // case 0x0B: // ANC** (undocumented) // case 0x0C: // NOP* (undocumented) - case 0x0D: ORA( memread( fetch16() ) ); return 4; // ORA abs - case 0x0E: ASL( & RAM[ fetch16() ] ); return 6; // ASL abs + case 0x0D: ORA( src_abs() ); return 4; // ORA abs + case 0x0E: ASL( dest_abs() ); return 6; // ASL abs // case 0x0F: // SLO* (undocumented) - case 0x10: BPL( (int8_t)fetch() ); return 2; // BPL rel - case 0x11: ORA( memread( addr_ind_Y() ) ); return 5; // ORA ind,Y + case 0x10: BPL( rel_addr() ); return 2; // BPL rel + case 0x11: ORA( src_ind_Y() ); return 5; // ORA ind,Y // case 0x12: // t jams // case 0x13: // SLO* (undocumented) // case 0x14: // NOP* (undocumented) - case 0x15: ORA( memread_zp( fetch() + m6502.X ) ); return 4; // ORA zpg,X - case 0x16: ASL( & RAM[ fetch() + m6502.X ] ); return 6; // ASL zpg,X + case 0x15: ORA( src_zp_X() ); return 4; // ORA zpg,X + case 0x16: ASL( dest_zp_X() ); return 6; // ASL zpg,X // case 0x17: // SLO* (undocumented) case 0x18: CLC(); return 2; // CLC - case 0x19: ORA( memread( fetch16() + m6502.Y ) ); return 4; // ORA abs,Y + case 0x19: ORA( src_abs_Y() ); return 4; // ORA abs,Y // case 0x1A: // NOP* (undocumented) // case 0x1B: // SLO* (undocumented) // case 0x1C: // NOP* (undocumented) @@ -82,223 +82,223 @@ static inline int m6502_step() { // case 0x23: case 0x24: BIT( src_zp() ); return 3; // BIT zpg case 0x25: AND( src_zp() ); return 3; // AND zpg - case 0x26: ROL( & RAM[ fetch() ] ); return 5; // ROL zpg + case 0x26: ROL( dest_zp() ); return 5; // ROL zpg // case 0x27: case 0x28: PLP(); return 4; // PLP - case 0x29: AND( fetch() ); return 2; // AND imm - case 0x2A: ROL( & m6502.A ); return 2; // ROL A + case 0x29: AND( imm() ); return 2; // AND imm + case 0x2A: ROLA(); return 2; // ROL A // case 0x2B: - case 0x2C: BIT( memread( fetch16() ) ); return 4; // BIT abs - case 0x2D: AND( memread( fetch16() ) ); return 4; // AND abs - case 0x2E: ROL( & RAM[ fetch16() ] ); return 6; // ROL abs + case 0x2C: BIT( src_abs() ); return 4; // BIT abs + case 0x2D: AND( src_abs() ); return 4; // AND abs + case 0x2E: ROL( dest_abs() ); return 6; // ROL abs // case 0x2F: - case 0x30: BMI( (int8_t)fetch() ); return 2; // BMI rel - case 0x31: AND( memread( addr_ind_Y() ) ); return 5; // AND ind,Y + case 0x30: BMI( rel_addr() ); return 2; // BMI rel + case 0x31: AND( src_ind_Y() ); return 5; // AND ind,Y // case 0x32: // case 0x33: // case 0x34: - case 0x35: AND( memread_zp( addr_zp_X() ) ); return 4; // AND zpg,X - case 0x36: ROL( & RAM[ addr_zp_X() ] ); return 6; // ROL zpg,X + case 0x35: AND( src_zp_X() ); return 4; // AND zpg,X + case 0x36: ROL( dest_zp_X() ); return 6; // ROL zpg,X // case 0x37: case 0x38: SEC(); return 2; // SEC - case 0x39: AND( memread( addr_abs_Y() ) ); return 4; // AND abs,Y + case 0x39: AND( src_abs_Y() ); return 4; // AND abs,Y // case 0x3A: // case 0x3B: // case 0x3C: - case 0x3D: AND( memread( addr_abs_X() ) ); return 4; // AND abs,X - case 0x3E: ROL( & RAM[ addr_abs_X() ] ); return 7; // ROL abs,X + case 0x3D: AND( src_abs_X() ); return 4; // AND abs,X + case 0x3E: ROL( dest_abs_X() ); return 7; // ROL abs,X // case 0x3F: case 0x40: RTI(); return 6; // RTI - case 0x41: EOR( memread( addr_X_ind() ) ); return 6; // EOR X,ind + case 0x41: EOR( src_X_ind() ); return 6; // EOR X,ind // case 0x42: // case 0x43: // case 0x44: - case 0x45: EOR( memread_zp( fetch() ) ); return 3; // EOR zpg - case 0x46: LSR( & RAM[ fetch() ] ); return 5; // LSR zpg + case 0x45: EOR( src_zp() ); return 3; // EOR zpg + case 0x46: LSR( dest_zp() ); return 5; // LSR zpg // case 0x47: case 0x48: PHA(); return 3; // PHA - case 0x49: EOR( fetch() ); return 2; // EOR imm - case 0x4A: LSR( & m6502.A ); return 2; // LSR A + case 0x49: EOR( imm() ); return 2; // EOR imm + case 0x4A: LSRA(); return 2; // LSR A // case 0x4B: - case 0x4C: JMP( fetch16() ); return 3; // JMP abs - case 0x4D: EOR( memread( fetch16() ) ); return 4; // EOR abs - case 0x4E: LSR( & RAM[ fetch16() ] ); return 6; // LSR abs + case 0x4C: JMP( abs_addr() ); return 3; // JMP abs + case 0x4D: EOR( src_abs() ); return 4; // EOR abs + case 0x4E: LSR( dest_abs() ); return 6; // LSR abs // case 0x4F: - case 0x50: BVC( (int8_t)fetch() ); return 2; // BVC rel - case 0x51: EOR( memread( addr_ind_Y() ) ); return 5; // EOR ind,Y + case 0x50: BVC( rel_addr() ); return 2; // BVC rel + case 0x51: EOR( src_ind_Y() ); return 5; // EOR ind,Y // case 0x52: // case 0x53: // case 0x54: - case 0x55: EOR( memread_zp( addr_zp_X() ) ); return 4; // AND zpg,X - case 0x56: LSR( & RAM[ addr_zp_X() ] ); return 6; // LSR zpg,X + case 0x55: EOR( src_zp_X() ); return 4; // AND zpg,X + case 0x56: LSR( dest_zp_X() ); return 6; // LSR zpg,X // case 0x57: case 0x58: CLI(); return 2; // CLI - case 0x59: EOR( memread( addr_abs_Y() ) ); return 4; // EOR abs,Y + case 0x59: EOR( src_abs_Y() ); return 4; // EOR abs,Y // case 0x5A: // case 0x5B: // case 0x5C: - case 0x5D: EOR( memread( addr_abs_X() ) ); return 4; // EOR abs,X - case 0x5E: LSR( & RAM[ addr_abs_X() ] ); return 7; // LSR abs,X + case 0x5D: EOR( src_abs_X() ); return 4; // EOR abs,X + case 0x5E: LSR( dest_abs_X() ); return 7; // LSR abs,X // case 0x5F: case 0x60: RTS(); return 6; // RTS - case 0x61: ADC( memread( addr_X_ind() ) ); return 6; // ADC X,ind + case 0x61: ADC( src_X_ind() ); return 6; // ADC X,ind // case 0x62: // case 0x63: // case 0x64: - case 0x65: ADC( memread_zp( fetch() ) ); return 3; // ADC zpg - case 0x66: ROR( & RAM[ fetch() ] ); return 5; // ROR zpg + case 0x65: ADC( src_zp() ); return 3; // ADC zpg + case 0x66: ROR( dest_zp() ); return 5; // ROR zpg // case 0x67: case 0x68: PLA(); break; // PLA - case 0x69: ADC( fetch() ); return 2; // ADC imm - case 0x6A: ROR( & m6502.A ); return 2; // ROR A + case 0x69: ADC( imm() ); return 2; // ADC imm + case 0x6A: RORA(); return 2; // ROR A // case 0x6B: - case 0x6C: JMP( memread16( fetch16() ) ); return 5; // JMP ind - case 0x6D: ADC( memread( fetch16() ) ); return 4; // ADC abs - case 0x6E: ROR( & RAM[ fetch16() ] ); return 6; // ROR abs + case 0x6C: JMP( ind_addr() ); return 5; // JMP ind + case 0x6D: ADC( src_abs() ); return 4; // ADC abs + case 0x6E: ROR( dest_abs() ); return 6; // ROR abs // case 0x6F: - case 0x70: BVS( (int8_t)fetch() ); break; // BVS rel - case 0x71: ADC( memread( addr_ind_Y() ) ); return 5; // ADC ind,Y + case 0x70: BVS( rel_addr() ); break; // BVS rel + case 0x71: ADC( src_ind_Y() ); return 5; // ADC ind,Y // case 0x72: // case 0x73: // case 0x74: - case 0x75: ADC( memread_zp( addr_zp_X() ) ); return 4; // ADC zpg,X - case 0x76: ROR( & RAM[ addr_zp_X() ] ); return 6; // ROR zpg,X + case 0x75: ADC( src_zp_X() ); return 4; // ADC zpg,X + case 0x76: ROR( dest_zp_X() ); return 6; // ROR zpg,X // case 0x77: case 0x78: SEI(); break; // SEI - case 0x79: ADC( memread( addr_abs_Y() ) ); return 4; // ADC abs,Y + case 0x79: ADC( src_abs_Y() ); return 4; // ADC abs,Y // case 0x7A: // case 0x7B: // case 0x7C: - case 0x7D: ADC( memread( addr_abs_X() ) ); return 4; // ADC abs,X - case 0x7E: ROR( & RAM[ addr_abs_X() ] ); return 7; // ROR abs,X + case 0x7D: ADC( src_abs_X() ); return 4; // ADC abs,X + case 0x7E: ROR( dest_abs_X() ); return 7; // ROR abs,X // case 0x7F: // case 0x80: - case 0x81: STA( & RAM[ addr_X_ind() ] ) ; return 6; // STA X,ind + case 0x81: STA( dest_X_ind() ) ; return 6; // STA X,ind // case 0x82: // case 0x83: - case 0x84: STY( & RAM[ fetch() ] ); return 3; // STY zpg - case 0x85: STA( & RAM[ fetch() ] ); return 3; // STA zpg - case 0x86: STX( & RAM[ fetch() ] ); return 3; // STX zpg + case 0x84: STY( dest_zp() ); return 3; // STY zpg + case 0x85: STA( dest_zp() ); return 3; // STA zpg + case 0x86: STX( dest_zp() ); return 3; // STX zpg // case 0x87: case 0x88: DEY(); return 2; // DEY // case 0x89: case 0x8A: TXA(); return 2; // TXA // case 0x8B: - case 0x8C: STY( & RAM[ fetch16() ] ); return 4; // STY abs - case 0x8D: STA( & RAM[ fetch16() ] ); return 4; // STA abs - case 0x8E: STX( & RAM[ fetch16() ] ); return 4; // STX abs + case 0x8C: STY( dest_abs() ); return 4; // STY abs + case 0x8D: STA( dest_abs() ); return 4; // STA abs + case 0x8E: STX( dest_abs() ); return 4; // STX abs // case 0x8F: - case 0x90: BCC( (int8_t)fetch() ); return 2; // BCC rel - case 0x91: STA( & RAM[ addr_ind_Y() ] ); return 6; // STA ind,Y + case 0x90: BCC( rel_addr() ); return 2; // BCC rel + case 0x91: STA( dest_ind_Y() ); return 6; // STA ind,Y // case 0x92: // case 0x93: - case 0x94: STY( & RAM[ addr_zp_X() ] ); return 4; // STY zpg,X - case 0x95: STA( & RAM[ addr_zp_X() ] ); return 4; // STA zpg,X - case 0x96: STX( & RAM[ addr_zp_Y() ] ); return 4; // STX zpg,Y + case 0x94: STY( dest_zp_X() ); return 4; // STY zpg,X + case 0x95: STA( dest_zp_X() ); return 4; // STA zpg,X + case 0x96: STX( dest_zp_X() ); return 4; // STX zpg,Y // case 0x97: case 0x98: TYA(); return 2; // TYA - case 0x99: STA( & RAM[ addr_abs_Y() ] ); return 5; // STA abs,Y + case 0x99: STA( dest_abs_Y() ); return 5; // STA abs,Y case 0x9A: TXS(); return 2; // TXS // case 0x9B: // case 0x9C: - case 0x9D: STA( & RAM[ addr_abs_X() ] ); return 5; // STA abs,X + case 0x9D: STA( dest_abs_X() ); return 5; // STA abs,X // case 0x9E: // case 0x9F: - case 0xA0: LDY( fetch() ); return 2; // LDY imm - case 0xA1: LDA( memread( addr_X_ind() ) ) ; return 6; // LDA X,ind - case 0xA2: LDX( fetch() ); return 2; // LDX imm + case 0xA0: LDY( imm() ); return 2; // LDY imm + case 0xA1: LDA( src_X_ind() ) ; return 6; // LDA X,ind + case 0xA2: LDX( imm() ); return 2; // LDX imm // case 0xA3: - case 0xA4: LDY( memread_zp( fetch() ) ); return 3; // LDY zpg - case 0xA5: LDA( memread_zp( fetch() ) ); return 3; // LDA zpg - case 0xA6: LDX( memread_zp( fetch() ) ); return 3; // LDX zpg + case 0xA4: LDY( src_zp() ); return 3; // LDY zpg + case 0xA5: LDA( src_zp() ); return 3; // LDA zpg + case 0xA6: LDX( src_zp() ); return 3; // LDX zpg // case 0xA7: case 0xA8: TAY(); return 2; // TAY - case 0xA9: LDA( fetch() ); return 2; // LDA imm + case 0xA9: LDA( imm() ); return 2; // LDA imm case 0xAA: TAX(); return 2; // TAX // case 0xAB: - case 0xAC: LDY( memread( fetch16() ) ); return 4; // LDY abs - case 0xAD: LDA( memread( fetch16() ) ); return 4; // LDA abs - case 0xAE: LDX( memread( fetch16() ) ); return 4; // LDX abs + case 0xAC: LDY( src_abs() ); return 4; // LDY abs + case 0xAD: LDA( src_abs() ); return 4; // LDA abs + case 0xAE: LDX( src_abs() ); return 4; // LDX abs // case 0xAF: - case 0xB0: BCS( (int8_t)fetch() ); return 2; // BCS rel - case 0xB1: LDA( memread( addr_ind_Y() ) ); return 5; // LDA ind,Y + case 0xB0: BCS( rel_addr() ); return 2; // BCS rel + case 0xB1: LDA( src_ind_Y() ); return 5; // LDA ind,Y // case 0xB2: // case 0xB3: - case 0xB4: LDY( memread_zp( addr_zp_X() ) ); return 4; // LDY zpg,X - case 0xB5: LDA( memread_zp( addr_zp_X() ) ); return 4; // LDA zpg,X - case 0xB6: LDX( memread_zp( addr_zp_Y() ) ); return 4; // LDX zpg,Y + case 0xB4: LDY( src_zp_X() ); return 4; // LDY zpg,X + case 0xB5: LDA( src_zp_X() ); return 4; // LDA zpg,X + case 0xB6: LDX( src_zp_Y() ); return 4; // LDX zpg,Y // case 0xB7: case 0xB8: CLV(); return 2; // CLV - case 0xB9: LDA( memread( addr_abs_Y() ) ); return 4; // LDA abs,Y + case 0xB9: LDA( src_abs_Y() ); return 4; // LDA abs,Y case 0xBA: TSX(); return 2; // TSX // case 0xBB: - case 0xBC: LDY( memread( addr_abs_X() ) ); return 4; // LDY abs,X - case 0xBD: LDA( memread( addr_abs_X() ) ); return 4; // LDA abs,X - case 0xBE: LDX( memread( addr_abs_Y() ) ); return 4; // LDX abs,Y + case 0xBC: LDY( src_abs_X() ); return 4; // LDY abs,X + case 0xBD: LDA( src_abs_X() ); return 4; // LDA abs,X + case 0xBE: LDX( src_abs_Y() ); return 4; // LDX abs,Y // case 0xBF: - case 0xC0: CPY( fetch() ); break; // CPY imm - case 0xC1: CMP( memread( addr_X_ind() ) ) ; break; // LDA X,ind + case 0xC0: CPY( imm() ); break; // CPY imm + case 0xC1: CMP( src_X_ind() ) ; break; // LDA X,ind // case 0xC2: // case 0xC3: - case 0xC4: CPY( memread_zp( fetch() ) ); return 3; // CPY zpg - case 0xC5: CMP( memread_zp( fetch() ) ); return 3; // CMP zpg - case 0xC6: DEC( & RAM[ fetch() ] ); return 5; // DEC zpg + case 0xC4: CPY( src_zp() ); return 3; // CPY zpg + case 0xC5: CMP( src_zp() ); return 3; // CMP zpg + case 0xC6: DEC( dest_zp() ); return 5; // DEC zpg // case 0xC7: case 0xC8: INY(); return 2; // INY - case 0xC9: CMP( fetch() ); return 2; // CMP imm + case 0xC9: CMP( imm() ); return 2; // CMP imm case 0xCA: DEX(); return 2; // DEX // case 0xCB: - case 0xCC: CPY( memread( fetch16() ) ); return 4; // CPY abs - case 0xCD: CMP( memread( fetch16() ) ); return 4; // CMP abs - case 0xCE: DEC( & RAM[ fetch16() ] ); return 4; // DEC abs + case 0xCC: CPY( src_abs() ); return 4; // CPY abs + case 0xCD: CMP( src_abs() ); return 4; // CMP abs + case 0xCE: DEC( dest_abs() ); return 4; // DEC abs // case 0xCF: - case 0xD0: BNE( (int8_t)fetch() ); return 2; // BNE rel - case 0xD1: CMP( memread( addr_ind_Y() ) ); return 5; // CMP ind,Y + case 0xD0: BNE( rel_addr() ); return 2; // BNE rel + case 0xD1: CMP( src_ind_Y() ); return 5; // CMP ind,Y // case 0xD2: // case 0xD3: // case 0xD4: - case 0xD5: CMP( memread_zp( addr_zp_X() ) ); return 4; // CMP zpg,X - case 0xD6: DEC( & RAM[ addr_zp_X() ] ); return 6; // DEC zpg,X + case 0xD5: CMP( src_zp_X() ); return 4; // CMP zpg,X + case 0xD6: DEC( dest_zp_X() ); return 6; // DEC zpg,X // case 0xD7: case 0xD8: CLD(); return 2; // CLD - case 0xD9: CMP( memread( addr_abs_Y() ) ); return 4; // CMP abs,Y + case 0xD9: CMP( src_abs_Y() ); return 4; // CMP abs,Y // case 0xDA: // case 0xDB: // case 0xDC: - case 0xDD: CMP( memread( addr_abs_X() ) ); return 4; // CMP abs,X - case 0xDE: DEC( & RAM[ addr_abs_X() ] ); return 7; // DEC abs,X + case 0xDD: CMP( src_abs_X() ); return 4; // CMP abs,X + case 0xDE: DEC( dest_abs_X() ); return 7; // DEC abs,X // case 0xDF: - case 0xE0: CPX( fetch() ); return 2; // CPX imm - case 0xE1: SBC( memread( addr_X_ind() ) ) ; return 6; // SBC (X,ind) + case 0xE0: CPX( imm() ); return 2; // CPX imm + case 0xE1: SBC( src_X_ind() ) ; return 6; // SBC (X,ind) // case 0xE2: // case 0xE3: - case 0xE4: CPX( memread_zp( fetch() ) ); return 3; // CPX zpg - case 0xE5: SBC( memread_zp( fetch() ) ); return 3; // SBC zpg - case 0xE6: INC( & RAM[ fetch() ] ); return 5; // INC zpg + case 0xE4: CPX( src_zp() ); return 3; // CPX zpg + case 0xE5: SBC( src_zp() ); return 3; // SBC zpg + case 0xE6: INC( dest_zp() ); return 5; // INC zpg // case 0xE7: case 0xE8: INX(); return 2; // INX - case 0xE9: SBC( fetch() ); return 2; // SBC imm + case 0xE9: SBC( imm() ); return 2; // SBC imm case 0xEA: NOP(); return 2; // NOP // case 0xEB: - case 0xEC: CPX( memread( fetch16() ) ); return 4; // CPX abs - case 0xED: SBC( fetch16() ); return 4; // SBC abs - case 0xEE: INC( & RAM[ fetch16() ] ); return 6; // INC abs + case 0xEC: CPX( src_abs() ); return 4; // CPX abs + case 0xED: SBC( src_abs() ); return 4; // SBC abs + case 0xEE: INC( dest_abs() ); return 6; // INC abs // case 0xEF: - case 0xF0: BEQ( (int8_t)fetch() ); return 2; // BEQ rel - case 0xF1: SBC( memread( addr_ind_Y() ) ); return 5; // SBC ind,Y + case 0xF0: BEQ( rel_addr() ); return 2; // BEQ rel + case 0xF1: SBC( src_ind_Y() ); return 5; // SBC ind,Y // case 0xF2: // case 0xF3: // case 0xF4: - case 0xF5: SBC( memread_zp( addr_zp_X() ) ); return 4; // SBC zpg,X - case 0xF6: INC( & RAM[ addr_zp_X() ] ); return 6; // INC zpg,X + case 0xF5: SBC( src_zp_X() ); return 4; // SBC zpg,X + case 0xF6: INC( dest_zp_X() ); return 6; // INC zpg,X // case 0xF7: case 0xF8: SED(); break; // SED - case 0xF9: SBC( memread( addr_abs_Y() ) ); return 4; // SBC abs,Y + case 0xF9: SBC( src_abs_Y() ); return 4; // SBC abs,Y // case 0xFA: // case 0xFB: // case 0xFC: - case 0xFD: SBC( memread( addr_abs_X() ) ); return 4; // SBC abs,X - case 0xFE: INC( & RAM[ addr_abs_X() ] ); return 6; // INC abs,X + case 0xFD: SBC( src_abs_X() ); return 4; // SBC abs,X + case 0xFE: INC( dest_abs_X() ); return 6; // INC abs,X // case 0xFF: default: diff --git a/A2Mac/Apple2_mmio.h b/A2Mac/Apple2_mmio.h index f0d9cc3..62cabb4 100644 --- a/A2Mac/Apple2_mmio.h +++ b/A2Mac/Apple2_mmio.h @@ -75,9 +75,11 @@ static inline uint8_t ioRead( uint16_t addr ) { // printf("mmio:%04X\n", addr); switch (addr) { case io_KBD: - return RAM[addr]; + return RAM[io_KBD]; case io_KBDSTRB: + // TODO: This is very slow! + dbgPrintf("io_KBDSTRB\n"); return RAM[io_KBD] &= 0x7F; default: @@ -230,9 +232,40 @@ static inline uint8_t * dest_X_ind() { effective address is word in (LL, LL + 1) incremented by Y with carry: C.w($00LL) + Y **/ static inline uint16_t addr_ind_Y() { - uint8_t a = fetch(); +// uint8_t a = fetch(); // dbgPrintf("addr_ind_Y: %04X + %02X = %04X ", addr_zpg_ind( a ), m6502.Y, addr_zpg_ind( a ) + m6502.Y); - return addr_zp_ind( a ) + m6502.Y; + return addr_zp_ind( fetch() ) + m6502.Y; +} +static inline uint8_t src_ind_Y() { + return memread( addr_ind_Y() ); +} +static inline uint8_t * dest_ind_Y() { + return & RAM[ addr_ind_Y() ]; +} + +/** + abs .... absolute OPC $LLHH,X + operand is address; effective address is address incremented by X with carry ** + **/ +static inline uint16_t addr_abs() { + return fetch16(); +} +static inline uint8_t src_abs() { + return memread( addr_abs() ); +} +static inline uint8_t * dest_abs() { + return & RAM[ addr_abs() ]; +} + + +static inline int8_t rel_addr() { + return fetch(); +} +static inline uint16_t abs_addr() { + return fetch16(); +} +static inline uint16_t ind_addr() { + return memread16( fetch16() ); } /** @@ -250,16 +283,12 @@ static inline uint8_t * dest_abs_X() { } -static inline uint16_t abs_addr() { - return fetch16(); -} - /** abs,Y .... absolute, Y-indexed OPC $LLHH,Y operand is address; effective address is address incremented by Y with carry ** **/ static inline uint16_t addr_abs_Y() { - return fetch16() + m6502.Y; + return abs_addr() + m6502.Y; } static inline uint8_t src_abs_Y() { return memread(addr_abs_Y()); @@ -268,6 +297,11 @@ static inline uint8_t * dest_abs_Y() { return & RAM[ addr_abs_Y() ]; } +static inline uint16_t imm() { + return fetch(); +} + + /** zpg .... zeropage OPC $LL operand is zeropage address (hi-byte is zero, address = $00LL) @@ -290,6 +324,12 @@ static inline uint8_t * dest_zp() { static inline uint16_t addr_zp_X() { return addr_zp() + m6502.X; } +static inline uint8_t src_zp_X() { + return memread_zp(addr_zp_X()); +} +static inline uint8_t * dest_zp_X() { + return & RAM[ addr_zp_X() ]; +} /** zpg,Y .... zeropage, Y-indexed OPC $LL,Y @@ -299,6 +339,12 @@ static inline uint16_t addr_zp_X() { static inline uint16_t addr_zp_Y() { return addr_zp() + m6502.Y; } +static inline uint8_t src_zp_Y() { + return memread_zp(addr_zp_Y()); +} +static inline uint8_t * dest_zp_Y() { + return & RAM[ addr_zp_Y() ]; +} #endif // __APPLE2_MMIO_H__ diff --git a/A2Mac/Apple2_mmio_8bit_ioaddr.h b/A2Mac/Apple2_mmio_8bit_ioaddr.h new file mode 100644 index 0000000..1b9d9fa --- /dev/null +++ b/A2Mac/Apple2_mmio_8bit_ioaddr.h @@ -0,0 +1,581 @@ +// +// main.c +// 6502 +// +// Created by Tamas Rudnai on 7/14/19. +// Copyright © 2019 GameAlloy. All rights reserved. +// + +#ifndef __APPLE2_MMIO_H__ +#define __APPLE2_MMIO_H__ + +#include "common.h" +#include "6502.h" + + +enum mmio { + io_KBD = 0xC000, + io_KBDSTRB = 0xC010, +}; + + +uint8_t RAM[ 64 * KB ] = {0}; + +#define PAGESIZE 256 +#define PAGES 16 + +//uint8_t ram_0[PAGESIZE]; +//uint8_t ram_1[PAGESIZE]; +//uint8_t ram_2[PAGESIZE]; +//uint8_t ram_3[PAGESIZE]; +//uint8_t ram_4[PAGESIZE]; +//uint8_t ram_5[PAGESIZE]; +//uint8_t ram_6[PAGESIZE]; +//uint8_t ram_7[PAGESIZE]; +//uint8_t ram_8[PAGESIZE]; +//uint8_t ram_9[PAGESIZE]; +//uint8_t ram_A[PAGESIZE]; +//uint8_t ram_B[PAGESIZE]; +//uint8_t aui_C[PAGESIZE]; +//uint8_t rom_D[PAGESIZE]; +//uint8_t rom_E[PAGESIZE]; +//uint8_t rom_F[PAGESIZE]; +// +//uint8_t * ram[PAGES] = { +// ram_0, +// ram_1, +// ram_2, +// ram_3, +// ram_4, +// ram_5, +// ram_6, +// ram_7, +// ram_8, +// ram_9, +// ram_A, +// ram_B, +// aui_C, +// rom_D, +// rom_E, +// rom_F, +//}; + +//uint8_t ( * mmio_read [ 64 * KB ] )( uint16_t addr ); + +typedef union address16_u { + uint16_t addr; + struct { + uint8_t offs; + uint8_t page; + }; +} address16_t; + + +static inline uint8_t ioRead( uint16_t addr ) { +// printf("mmio:%04X\n", addr); + + // C0xx + switch ((uint8_t)addr) { + case 0x00: + return RAM[io_KBD]; + + case 0x10: + // TODO: This is very slow! + dbgPrintf("io_KBDSTRB\n"); + return RAM[io_KBD] &= 0x7F; + + case 0x01: + case 0x02: + case 0x03: + case 0x04: + case 0x05: + case 0x06: + case 0x07: + case 0x08: + case 0x09: + case 0x0A: + case 0x0B: + case 0x0C: + case 0x0D: + case 0x0E: + case 0x0F: + + case 0x11: + case 0x12: + case 0x13: + case 0x14: + case 0x15: + case 0x16: + case 0x17: + case 0x18: + case 0x19: + case 0x1A: + case 0x1B: + case 0x1C: + case 0x1D: + case 0x1E: + case 0x1F: + + case 0x20: + case 0x21: + case 0x22: + case 0x23: + case 0x24: + case 0x25: + case 0x26: + case 0x27: + case 0x28: + case 0x29: + case 0x2A: + case 0x2B: + case 0x2C: + case 0x2D: + case 0x2E: + case 0x2F: + + case 0x30: + case 0x31: + case 0x32: + case 0x33: + case 0x34: + case 0x35: + case 0x36: + case 0x37: + case 0x38: + case 0x39: + case 0x3A: + case 0x3B: + case 0x3C: + case 0x3D: + case 0x3E: + case 0x3F: + + case 0x40: + case 0x41: + case 0x42: + case 0x43: + case 0x44: + case 0x45: + case 0x46: + case 0x47: + case 0x48: + case 0x49: + case 0x4A: + case 0x4B: + case 0x4C: + case 0x4D: + case 0x4E: + case 0x4F: + + case 0x50: + case 0x51: + case 0x52: + case 0x53: + case 0x54: + case 0x55: + case 0x56: + case 0x57: + case 0x58: + case 0x59: + case 0x5A: + case 0x5B: + case 0x5C: + case 0x5D: + case 0x5E: + case 0x5F: + + case 0x60: + case 0x61: + case 0x62: + case 0x63: + case 0x64: + case 0x65: + case 0x66: + case 0x67: + case 0x68: + case 0x69: + case 0x6A: + case 0x6B: + case 0x6C: + case 0x6D: + case 0x6E: + case 0x6F: + + case 0x70: + case 0x71: + case 0x72: + case 0x73: + case 0x74: + case 0x75: + case 0x76: + case 0x77: + case 0x78: + case 0x79: + case 0x7A: + case 0x7B: + case 0x7C: + case 0x7D: + case 0x7E: + case 0x7F: + + case 0x80: + case 0x81: + case 0x82: + case 0x83: + case 0x84: + case 0x85: + case 0x86: + case 0x87: + case 0x88: + case 0x89: + case 0x8A: + case 0x8B: + case 0x8C: + case 0x8D: + case 0x8E: + case 0x8F: + + case 0x90: + case 0x91: + case 0x92: + case 0x93: + case 0x94: + case 0x95: + case 0x96: + case 0x97: + case 0x98: + case 0x99: + case 0x9A: + case 0x9B: + case 0x9C: + case 0x9D: + case 0x9E: + case 0x9F: + + case 0xA0: + case 0xA1: + case 0xA2: + case 0xA3: + case 0xA4: + case 0xA5: + case 0xA6: + case 0xA7: + case 0xA8: + case 0xA9: + case 0xAA: + case 0xAB: + case 0xAC: + case 0xAD: + case 0xAE: + case 0xAF: + + case 0xB0: + case 0xB1: + case 0xB2: + case 0xB3: + case 0xB4: + case 0xB5: + case 0xB6: + case 0xB7: + case 0xB8: + case 0xB9: + case 0xBA: + case 0xBB: + case 0xBC: + case 0xBD: + case 0xBE: + case 0xBF: + + case 0xC0: + case 0xC1: + case 0xC2: + case 0xC3: + case 0xC4: + case 0xC5: + case 0xC6: + case 0xC7: + case 0xC8: + case 0xC9: + case 0xCA: + case 0xCB: + case 0xCC: + case 0xCD: + case 0xCE: + case 0xCF: + + case 0xD0: + case 0xD1: + case 0xD2: + case 0xD3: + case 0xD4: + case 0xD5: + case 0xD6: + case 0xD7: + case 0xD8: + case 0xD9: + case 0xDA: + case 0xDB: + case 0xDC: + case 0xDD: + case 0xDE: + case 0xDF: + + case 0xE0: + case 0xE1: + case 0xE2: + case 0xE3: + case 0xE4: + case 0xE5: + case 0xE6: + case 0xE7: + case 0xE8: + case 0xE9: + case 0xEA: + case 0xEB: + case 0xEC: + case 0xED: + case 0xEE: + case 0xEF: + + case 0xF0: + case 0xF1: + case 0xF2: + case 0xF3: + case 0xF4: + case 0xF5: + case 0xF6: + case 0xF7: + case 0xF8: + case 0xF9: + case 0xFA: + case 0xFB: + case 0xFC: + case 0xFD: + case 0xFE: + case 0xFF: + + + + default: + break; + } + return 0; +} + +static inline void ioWrite( uint16_t addr ) { + // printf("mmio:%04X\n", addr); + switch (addr) { + case io_KBD: + return; + + default: + break; + } + return; +} + +/** + Naive implementation of RAM read from address + **/ + +static inline uint8_t memread_zp( uint8_t addr ) { + return RAM[ addr ]; +} + +static inline uint8_t memread( uint16_t addr ) { +// switch ( ((address16_t)addr).page ) { +// case 0xC0: +// case 0xC1: +// case 0xC2: +// case 0xC3: +// case 0xC4: +// case 0xC5: +// case 0xC6: +// case 0xC7: +// case 0xC8: +// case 0xC9: +// case 0xCA: +// case 0xCB: +// case 0xCC: +// case 0xCD: +// case 0xCE: +// case 0xCF: +// return ioRead(addr); +// +// defaut: +// break; +// } + + if ( (addr >= 0xC000) && (addr < 0xD000) ) { + ioRead(addr); + } + + return RAM[ addr ]; +} + +/** + Naive implementation of RAM read from address + **/ +static inline uint16_t memread16( uint16_t addr ) { +// if ( ( addr >= 0xC000 ) && ( addr < 0xD000 ) ) { +// return mmioRead(addr); +// } + +// dbgPrintf("%04X ", * (uint16_t*) (& RAM[ addr ])); + return * (uint16_t*) (& RAM[ addr ]); +} + +/** + Naive implementation of RAM read from address + **/ +//static inline uint16_t memioread16( uint16_t addr ) { +// return (uint16_t)mmio_read[ addr ](addr); +//} + + +/** + Naive implementation of RAM write to address + **/ +static void memwrite_zp( uint8_t addr, uint8_t byte ) { + RAM[ addr ] = byte; +} + + +/** + Naive implementation of RAM write to address + **/ +static void memwrite( uint16_t addr, uint8_t byte ) { +// if ( addr >= 0xD000 ) { +// // ROM +// return; +// } +// if ( addr >= 0xC000 ) { +// return mmioWrite(addr); +// } +// + + RAM[ addr ] = byte; +} + + +/** + Fetching 1 byte from memory address pc (program counter) + increase pc by one + **/ +static inline uint8_t fetch() { + dbgPrintf("%02X ", RAM[m6502.pc]); + return memread( m6502.pc++ ); +} + +/** + Fetching 2 bytes as a 16 bit number from memory address pc (program counter) + increase pc by one + **/ +static inline uint16_t fetch16() { + dbgPrintf("%04X ", memread16(m6502.pc)); + uint16_t word = memread16( m6502.pc ); + m6502.pc += 2; + return word; +} + +/** + get a 16 bit address from the zp:zp+1 + **/ +static inline uint16_t addr_zp_ind( uint8_t addr ) { + return memread16(addr); +} + +/** + X,ind .... X-indexed, indirect OPC ($LL,X) + operand is zeropage address; + effective address is word in (LL + X, LL + X + 1), inc. without carry: C.w($00LL + X) + **/ +static inline uint16_t addr_X_ind() { + return addr_zp_ind( fetch() + m6502.X ); +} +static inline uint8_t src_X_ind() { + return memread( addr_X_ind() ); +} +static inline uint8_t * dest_X_ind() { + return & RAM[ addr_X_ind() ]; +} + +/** + ind,Y .... indirect, Y-indexed OPC ($LL),Y + operand is zeropage address; + effective address is word in (LL, LL + 1) incremented by Y with carry: C.w($00LL) + Y + **/ +static inline uint16_t addr_ind_Y() { + uint8_t a = fetch(); +// dbgPrintf("addr_ind_Y: %04X + %02X = %04X ", addr_zpg_ind( a ), m6502.Y, addr_zpg_ind( a ) + m6502.Y); + return addr_zp_ind( a ) + m6502.Y; +} + +/** + abs,X .... absolute, X-indexed OPC $LLHH,X + operand is address; effective address is address incremented by X with carry ** + **/ +static inline uint16_t addr_abs_X() { + return fetch16() + m6502.X; +} +static inline uint8_t src_abs_X() { + return memread( addr_abs_X() ); +} +static inline uint8_t * dest_abs_X() { + return & RAM[ addr_abs_X() ]; +} + + +static inline uint16_t abs_addr() { + return fetch16(); +} + +/** + abs,Y .... absolute, Y-indexed OPC $LLHH,Y + operand is address; effective address is address incremented by Y with carry ** + **/ +static inline uint16_t addr_abs_Y() { + return fetch16() + m6502.Y; +} +static inline uint8_t src_abs_Y() { + return memread(addr_abs_Y()); +} +static inline uint8_t * dest_abs_Y() { + return & RAM[ addr_abs_Y() ]; +} + +/** + zpg .... zeropage OPC $LL + operand is zeropage address (hi-byte is zero, address = $00LL) + **/ +static inline uint16_t addr_zp() { + return fetch(); +} +static inline uint8_t src_zp() { + return memread_zp(addr_zp()); +} +static inline uint8_t * dest_zp() { + return & RAM[ addr_zp() ]; +} + +/** + zpg,X .... zeropage, X-indexed OPC $LL,X + operand is zeropage address; + effective address is address incremented by X without carry ** + **/ +static inline uint16_t addr_zp_X() { + return addr_zp() + m6502.X; +} + +/** + zpg,Y .... zeropage, Y-indexed OPC $LL,Y + operand is zeropage address; + effective address is address incremented by Y without carry ** + **/ +static inline uint16_t addr_zp_Y() { + return addr_zp() + m6502.Y; +} + + +#endif // __APPLE2_MMIO_H__ + diff --git a/A2Mac/instructions/6502_instr_branch.h b/A2Mac/instructions/6502_instr_branch.h index 8574553..b05ebe4 100644 --- a/A2Mac/instructions/6502_instr_branch.h +++ b/A2Mac/instructions/6502_instr_branch.h @@ -11,6 +11,7 @@ static inline void BRA( int8_t reladdr ) { m6502.pc += reladdr; + dbgPrintf("BRA %04X ", m6502.pc); } /** @@ -25,8 +26,12 @@ static inline void BRA( int8_t reladdr ) { **/ static inline void BCC( int8_t reladdr ) { dbgPrintf("BCC "); - if ( m6502.flags.C == 0 ) + if ( m6502.flags.C == 0 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -41,8 +46,12 @@ static inline void BCC( int8_t reladdr ) { **/ static inline void BCS( int8_t reladdr ) { dbgPrintf("BCS "); - if ( m6502.flags.C == 1 ) + if ( m6502.flags.C == 1 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -57,8 +66,12 @@ static inline void BCS( int8_t reladdr ) { **/ static inline void BNE( int8_t reladdr ) { dbgPrintf("BNE "); - if ( m6502.flags.Z == 0 ) + if ( m6502.flags.Z == 0 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -73,8 +86,12 @@ static inline void BNE( int8_t reladdr ) { **/ static inline void BEQ( int8_t reladdr ) { dbgPrintf("BEQ "); - if ( m6502.flags.Z == 1 ) + if ( m6502.flags.Z == 1 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -89,8 +106,12 @@ static inline void BEQ( int8_t reladdr ) { **/ static inline void BPL( int8_t reladdr ) { dbgPrintf("BPL "); - if ( m6502.flags.N == 0 ) + if ( m6502.flags.N == 0 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -105,8 +126,12 @@ static inline void BPL( int8_t reladdr ) { **/ static inline void BMI( int8_t reladdr ) { dbgPrintf("BMI "); - if ( m6502.flags.N == 1 ) + if ( m6502.flags.N == 1 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -121,8 +146,12 @@ static inline void BMI( int8_t reladdr ) { **/ static inline void BVC( int8_t reladdr ) { dbgPrintf("BVC "); - if ( m6502.flags.V == 0 ) + if ( m6502.flags.V == 0 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } /** @@ -137,8 +166,12 @@ static inline void BVC( int8_t reladdr ) { **/ static inline void BVS( int8_t reladdr ) { dbgPrintf("BVS "); - if ( m6502.flags.V == 1 ) + if ( m6502.flags.V == 1 ) { BRA( reladdr ); + } + else { + dbgPrintf("-no-"); + } } #endif // __6502_INSTR_BRANCH_H__ diff --git a/A2Mac/instructions/6502_instr_call_ret_jump.h b/A2Mac/instructions/6502_instr_call_ret_jump.h index 84b52b6..5fb9e52 100644 --- a/A2Mac/instructions/6502_instr_call_ret_jump.h +++ b/A2Mac/instructions/6502_instr_call_ret_jump.h @@ -22,7 +22,7 @@ indirect JMP (oper) 6C 3 5 **/ static inline void JMP( uint16_t addr ) { - dbgPrintf("JMP "); + dbgPrintf("JMP %04X ", addr); m6502.pc = addr; } diff --git a/A2Mac/instructions/6502_instr_compare_test.h b/A2Mac/instructions/6502_instr_compare_test.h index a7e38f9..1a8b214 100644 --- a/A2Mac/instructions/6502_instr_compare_test.h +++ b/A2Mac/instructions/6502_instr_compare_test.h @@ -26,10 +26,9 @@ **/ static inline void BIT( uint8_t imm ) { dbgPrintf("BIT(%02X) ", imm); - uint8_t m = m6502.A & imm; - m6502.flags.N = BITTEST(m, 7); - m6502.flags.V = BITTEST(m, 6); - m6502.flags.Z = m == 0; + m6502.flags.N = BITTEST(imm, 7); + m6502.flags.V = BITTEST(imm, 6); + m6502.flags.Z = (imm & m6502.A) == 0; } /** diff --git a/A2Mac/instructions/6502_instr_load_store.h b/A2Mac/instructions/6502_instr_load_store.h index 849b9ab..c9f6298 100644 --- a/A2Mac/instructions/6502_instr_load_store.h +++ b/A2Mac/instructions/6502_instr_load_store.h @@ -30,7 +30,7 @@ (indirect),Y LDA (oper),Y B1 2 5* **/ static inline void LDA( uint8_t imm ) { - dbgPrintf("LDA "); + dbgPrintf("LDA(%02X) ", imm); m6502.A = imm; set_flags_NZ(imm); } @@ -50,7 +50,7 @@ static inline void LDA( uint8_t imm ) { absolute,Y LDX oper,Y BE 3 4* **/ static inline void LDX( uint8_t imm ) { - dbgPrintf("LDX "); + dbgPrintf("LDX(%02X) ", imm); m6502.X = imm; set_flags_NZ(imm); } @@ -95,14 +95,29 @@ static inline void STR( uint8_t * dst, uint8_t imm ) { // uint16_t v = dst - RAM; // if ( ( v >= 0x400 ) && ( v < 0x800 ) ) { // char c = charConv[imm]; -// if ( c == '?' ) { -// printf("? SYNTAX ERROR\n"); -// } - +//// if ( c == '?' ) { +//// printf("? SYNTAX ERROR\n"); +//// } +// // if (( imm > ' ' ) && ( c < 0x7F )) -// printf("%04X: t:%02X '%c'\n", v, imm, isprint(c) ? c : ' '); +// printf("*** PRINT: %04X: t:%02X '%c'\n", v, imm, isprint(c) ? c : ' '); +// } +// +// +// else switch ( v ) { +// case 0x36: +// case 0x37: +// dbgPrintf("*** OUTROUT %04X: %02X\n", v, imm); +// break; +// +// case 0x9B: +// case 0x9C: +// dbgPrintf("*** LOWTR %04X: %02X\n", v, imm); +// break; +// +// default: +// break; // } - } /** diff --git a/A2Mac/instructions/6502_instr_shift_rotate.h b/A2Mac/instructions/6502_instr_shift_rotate.h index 0ab4aad..2f07598 100644 --- a/A2Mac/instructions/6502_instr_shift_rotate.h +++ b/A2Mac/instructions/6502_instr_shift_rotate.h @@ -27,8 +27,14 @@ static inline void ASL( uint8_t * dst ) { dbgPrintf("ASL "); m6502.flags.C = *dst >> 7; - *dst <<= 1; - set_flags_NZ( *dst ); + ; + set_flags_NZ( *dst <<= 1 ); +} +static inline void ASLA() { + dbgPrintf("ASL "); + m6502.flags.C = m6502.A >> 7; + ; + set_flags_NZ( m6502.A <<= 1 ); } /** @@ -48,8 +54,14 @@ static inline void ASL( uint8_t * dst ) { static inline void LSR( uint8_t * dst ) { dbgPrintf("LSR "); m6502.flags.C = *dst & 1; - *dst >>= 1; - set_flags_NZ( *dst ); + ; + set_flags_NZ( *dst >>= 1 ); +} +static inline void LSRA() { + dbgPrintf("LSR "); + m6502.flags.C = m6502.A & 1; + ; + set_flags_NZ( m6502.A >>= 1 ); } /** @@ -71,8 +83,16 @@ static inline void ROL( uint8_t * dst ) { uint8_t C = m6502.flags.C; m6502.flags.C = *dst >> 7; *dst <<= 1; - *dst |= C; - set_flags_NZ( *dst ); + ; + set_flags_NZ( *dst |= C ); +} +static inline void ROLA() { + dbgPrintf("ROL "); + uint8_t C = m6502.flags.C; + m6502.flags.C = m6502.A >> 7; + m6502.A <<= 1; + ; + set_flags_NZ( m6502.A |= C ); } /** @@ -94,8 +114,16 @@ static inline void ROR( uint8_t * dst ) { uint8_t C = m6502.flags.C << 7; m6502.flags.C = *dst & 1; *dst >>= 1; - *dst |= C; - set_flags_NZ( *dst ); + ; + set_flags_NZ( *dst |= C ); +} +static inline void RORA() { + dbgPrintf("ROR "); + uint8_t C = m6502.flags.C << 7; + m6502.flags.C = m6502.A & 1; + m6502.A >>= 1; + ; + set_flags_NZ( m6502.A |= C ); } diff --git a/Apple_II_ROM.s b/Apple_II_ROM.s new file mode 100644 index 0000000..0321310 --- /dev/null +++ b/Apple_II_ROM.s @@ -0,0 +1,6914 @@ +include(`asm.m4h') +; -------------------------------- +; +; Applesoft BASIC, V2 +; +; Written by Marc McDonald and Randy Wigginton. +; +; Original copyright 1976 by Microsoft, +; 1977 by Apple Computer. +; +; Disassembled by (unknown). +; Fixed by Chris Mosher. +; +; For the cc65.org Assembler (ca65) +; +; Applesoft BASIC was first written by +; Marc McDonald, the first employee of Microsoft, +; in mid-1976. That version was bought by Apple +; and released (on casette) in Nov. 1977. +; +; Version 2 was written by Randy Wigginton and +; others at Apple in spring 1978. This version +; was released in several different forms. The +; one reproduced by this source assembly file is +; the main-board ROM form, which appeared in the +; Apple ][ plus ROM at $D000-$F7FF. +; +; -------------------------------- + + + +; -------------------------------- +; ZERO PAGE LOCATIONS: +; -------------------------------- +GOWARM = $00 ; GETS "JMP RESTART" +GOSTROUT = $03 ; GETS "JMP STROUT" +USR = $0A ; GETS "JMP " +; (INITIALLY $E199) +CHARAC = $0D ; ALTERNATE STRING TERMINATOR +ENDCHR = $0E ; STRING TERMINATOR +TKN_CNTR = $0F ; USED IN PARSE +EOL_PNTR = $0F ; USED IN NXLIN +NUMDIM = $0F ; USED IN ARRAY ROUTINES +DIMFLG = $10 ; +VALTYP = $11 ; $:VALTYP=$FF; %:VALTYP+1=$80 +DATAFLG = $13 ; USED IN PARSE +GARFLG = $13 ; USED IN GARBAG +SUBFLG = $14 ; +INPUTFLG = $15 ; = $40 FOR GET, $98 FOR READ +CPRMASK = $16 ; RECEIVES CPRTYP IN FRMEVL +SIGNFLG = $16 ; FLAGS SIGN IN TAN +HGR_SHAPE = $1A ; +HGR_BITS = $1C ; +HGR_COUNT = $1D ; +MON_CH = $24 ; +MON_GBASL = $26 ; +MON_GBASH = $27 ; +MON_H2 = $2C ; +MON_V2 = $2D ; +MON_HMASK = $30 ; +MON_INVFLG = $32 ; +MON_PROMPT = $33 ; +MON_A1L = $3C ; USED BY TAPE I/O ROUTINES +MON_A1H = $3D ; " +MON_A2L = $3E ; " +MON_A2H = $3F ; " +LINNUM = $50 ; CONVERTED LINE # +TEMPPT = $52 ; LAST USED TEMP STRING DESC +LASTPT = $53 ; LAST USED TEMP STRING PNTR +TEMPST = $55 ; HOLDS UP TO 3 DESCRIPTORS +INDEX = $5E ; +DEST = $60 ; +RESULT = $62 ; RESULT OF LAST * OR / +TXTTAB = $67 ; START OF PROGRAM TEXT +VARTAB = $69 ; START OF VARIABLE STORAGE +ARYTAB = $6B ; START OF ARRAY STORAGE +STREND = $6D ; END OF ARRAY STORAGE +FRETOP = $6F ; START OF STRING STORAGE +FRESPC = $71 ; TEMP PNTR, STRING ROUTINES +MEMSIZ = $73 ; END OF STRING SPACE (HIMEM) +CURLIN = $75 ; CURRENT LINE NUMBER +; ( = $FFXX IF IN DIRECT MODE) +OLDLIN = $77 ; ADDR. OF LAST LINE EXECUTED +OLDTEXT = $79 ; +DATLIN = $7B ; LINE # OF CURRENT DATA STT. +DATPTR = $7D ; ADDR OF CURRENT DATA STT. +INPTR = $7F ; +VARNAM = $81 ; NAME OF VARIABLE +VARPNT = $83 ; ADDR OF VARIABLE +FORPNT = $85 ; +TXPSV = $87 ; USED IN INPUT +LASTOP = $87 ; SCRATCH FLAG USED IN FRMEVL +CPRTYP = $89 ; >,=,< FLAG IN FRMEVL +TEMP3 = $8A ; +FNCNAM = $8A ; +DSCPTR = $8C ; +DSCLEN = $8F ; USED IN GARBAG +JMPADRS = $90 ; GETS "JMP ...." +LENGTH = $91 ; USED IN GARBAG +ARG_EXTENSION = $92 ; FP EXTRA PRECISION +TEMP1 = $93 ; SAVE AREAS FOR FAC +ARYPNT = $94 ; USED IN GARBAG +HIGHDS = $94 ; PNTR FOR BLTU +HIGHTR = $96 ; PNTR FOR BLTU +TEMP2 = $98 ; +TMPEXP = $99 ; USED IN FIN (EVAL) +INDX = $99 ; USED BY ARRAY RTNS +EXPON = $9A ; " +DPFLG = $9B ; FLAGS DEC PNT IN FIN +LOWTR = $9B ; +EXPSGN = $9C ; +FAC = $9D ; MAIN FLT PT ACCUMULATOR +DSCTMP = $9D ; +VPNT = $A0 ; TEMP VAR PTR +FAC_SIGN = $A2 ; HOLDS UNPACKED SIGN +SERLEN = $A3 ; HOLDS LENGTH OF SERIES-1 +SHIFT_SIGN_EXT = $A4 ; SIGN EXTENSION, RIGHT SHIFTS +ARG = $A5 ; SECONDARY FP ACC +ARG_SIGN = $AA ; +SGNCPR = $AB ; FLAGS OPP SIGN IN FP ROUT. +FAC_EXTENSION = $AC ; FAC EXTENSION BYTE +SERPNT = $AD ; PNTR TO SERIES DATA IN FP +STRNG1 = $AB ; +STRNG2 = $AD ; +PRGEND = $AF ; +CHRGET = $B1 ; +CHRGOT = $B7 ; +TXTPTR = $B8 ; +RNDSEED = $C9 ; +HGR_DX = $D0 ; +HGR_DY = $D2 ; +HGR_QUADRANT = $D3 ; +HGR_E = $D4 ; +LOCK = $D6 ; NO USER ACCESS IF > 127 +ERRFLG = $D8 ; $80 IF ON ERR ACTIVE +ERRLIN = $DA ; LINE # WHERE ERROR OCCURRED +ERRPOS = $DC ; TXTPTR SAVE FOR HANDLERR +ERRNUM = $DE ; WHICH ERROR OCCURRED +ERRSTK = $DF ; STACK PNTR BEFORE ERROR +HGR_X = $E0 ; +HGR_Y = $E2 ; +HGR_COLOR = $E4 ; +HGR_HORIZ = $E5 ; BYTE INDEX FROM GBASH,L +HGR_PAGE = $E6 ; HGR=$20, HGR2=$40 +HGR_SCALE = $E7 ; +HGR_SHAPE_PNTR = $E8 ; +HGR_COLLISIONS = $EA ; +FIRST = $F0 ; +SPEEDZ = $F1 ; OUTPUT SPEED +TRCFLG = $F2 ; +FLASH_BIT = $F3 ; = $40 FOR FLASH, ELSE =$00 +TXTPSV = $F4 ; +CURLSV = $F6 ; +REMSTK = $F8 ; STACK PNTR BEFORE EACH STT. +HGR_ROTATION = $F9 ; +; $FF IS ALSO USED BY THE STRING OUT ROUTINES +; -------------------------------- +STACK = $0100 +INPUT_BUFFER = $0200 +AMPERSAND_VECTOR = $03F5 ; - 3F7 GETS "JMP ...." +; -------------------------------- +; I/O & SOFT SWITCHES +; -------------------------------- +KEYBOARD = $C000 +SW_TXTCLR = $C050 +SW_MIXCLR = $C052 +SW_MIXSET = $C053 +SW_LOWSCR = $C054 +SW_HISCR = $C055 +SW_LORES = $C056 +SW_HIRES = $C057 +; -------------------------------- +; MONITOR SUBROUTINES +; -------------------------------- +MON_PLOT = $F800 +MON_HLINE = $F819 +MON_VLINE = $F828 +MON_SETCOL = $F864 +MON_SCRN = $F871 +MON_PREAD = $FB1E +MON_SETTXT = $FB39 +MON_SETGR = $FB40 +MON_TABV = $FB5B +MON_HOME = $FC58 +MON_WAIT = $FCA8 +MON_RD2BIT = $FCFA +MON_RDKEY = $FD0C +MON_GETLN = $FD6A +MON_COUT = $FDED +MON_INPORT = $FE8B +MON_OUTPORT = $FE95 +MON_WRITE = $FECD +MON_READ = $FEFD +MON_READ2 = $FF02 +; -------------------------------- +; -------------------------------- +; APPLESOFT TOKENS +; -------------------------------- +TOKEN_FOR = $81 +TOKENDWTA = $83 +TOKEN_POP = $A1 +TOKEN_GOTO = $AB +TOKEN_GOSUB = $B0 +TOKEN_REM = $B2 +TOKEN_PRINT = $BA +TOKEN_TAB = $C0 +TOKEN_TO = $C1 +TOKEN_FN = $C2 +TOKEN_SPC = $C3 +TOKEN_THEN = $C4 +TOKENDB = $C5 +TOKEN_NOT = $C6 +TOKEN_STEP = $C7 +TOKEN_PLUS = $C8 +TOKEN_MINUS = $C9 +TOKEN_GREATER = $CF +TOKENEQUUAL = $D0 +TOKEN_SGN = $D2 +TOKEN_SCRN = $D7 +TOKEN_LEFTSTR = $E8 +; -------------------------------- +; BRANCH TABLE FOR TOKENS +; -------------------------------- +TOKEN_ADDRESS_TABLE ASM_ADDR(`ENDX-1') ; $80...128...END +ASM_ADDR(`FOR-1') ; $81...129...FOR +ASM_ADDR(`NEXT-1') ; $82...130...NEXT +ASM_ADDR(`DATA-1') ; $83...131..DWTA +ASM_ADDR(`INPUT-1') ; $84...132...INPUT +ASM_ADDR(`DEL-1') ; $85...133...DEL +ASM_ADDR(`DIM-1') ; $86...134...DIM +ASM_ADDR(`READ-1') ; $87...135...READ +ASM_ADDR(`GR-1') ; $88...136...GR +ASM_ADDR(`TEXT-1') ; $89...137...TEXT +ASM_ADDR(`PR_NUMBER-1') ; $8A...138...PR# +ASM_ADDR(`IN_NUMBER-1') ; $8B...139...IN# +ASM_ADDR(`CALL-1') ; $8C...140...CALL +ASM_ADDR(`PLOT-1') ; $8D...141...PLOT +ASM_ADDR(`HLIN-1') ; $8E...142...HLIN +ASM_ADDR(`VLIN-1') ; $8F...143...VLIN +ASM_ADDR(`HGR2-1') ; $90...144...HGR2 +ASM_ADDR(`HGR-1') ; $91...145...HGR +ASM_ADDR(`HCOLOR-1') ; $92...146...HCOLOR= +ASM_ADDR(`HPLOT-1') ; $93...147...HPLOT +ASM_ADDR(`DRAW-1') ; $94...148...DRAW +ASM_ADDR(`XDRAW-1') ; $95...149...XDRAW +ASM_ADDR(`HTAB-1') ; $96...150...HTAB +ASM_ADDR(`MON_HOME-1') ; $97...151...HOME +ASM_ADDR(`ROT-1') ; $98...152...ROT= +ASM_ADDR(`SCALE-1') ; $99...153...SCALE= +ASM_ADDR(`SHLOAD-1') ; $9A...154...SHLOAD +ASM_ADDR(`TRACE-1') ; $9B...155...TRACE +ASM_ADDR(`NOTRACE-1') ; $9C...156...NOTRACE +ASM_ADDR(`NORMAL-1') ; $9D...157...NORMAL +ASM_ADDR(`INVERSE-1') ; $9E...158...INVERSE +ASM_ADDR(`FLASH-1') ; $9F...159...FLASH +ASM_ADDR(`COLOR-1') ; $A0...160...COLOR= +ASM_ADDR(`POP-1') ; $A1...161...POP +ASM_ADDR(`VTAB-1') ; $A2...162...VTAB +ASM_ADDR(`HIMEM-1') ; $A3...163...HIMEM: +ASM_ADDR(`LOMEM-1') ; $A4...164...LOMEM: +ASM_ADDR(`ONERR-1') ; $A5...165...ONERR +ASM_ADDR(`RESUME-1') ; $A6...166...RESUME +ASM_ADDR(`RECALL-1') ; $A7...167...RECALL +ASM_ADDR(`STORE-1') ; $A8...168...STORE +ASM_ADDR(`SPEED-1') ; $A9...169...SPEED= +ASM_ADDR(`LET-1') ; $AA...170...LET +ASM_ADDR(`GOTO-1') ; $AB...171...GOTO +ASM_ADDR(`RUN-1') ; $AC...172...RUN +ASM_ADDR(`IF-1') ; $AD...173...IF +ASM_ADDR(`RESTORE-1') ; $AE...174...RESTORE +ASM_ADDR(`AMPERSAND_VECTOR-1') ; $AF...175...& +ASM_ADDR(`GOSUB-1') ; $B0...176...GOSUB +ASM_ADDR(`POP-1') ; $B1...177...RETURN +ASM_ADDR(`REM-1') ; $B2...178...REM +ASM_ADDR(`STOP-1') ; $B3...179...STOP +ASM_ADDR(`ONGOTO-1') ; $B4...180...ON +ASM_ADDR(`WAIT-1') ; $B5...181...WAIT +ASM_ADDR(`LOAD-1') ; $B6...182...LOAD +ASM_ADDR(`SAVE-1') ; $B7...183...SAVE +ASM_ADDR(`DEF-1') ; $B8...184...DEF +ASM_ADDR(`POKE-1') ; $B9...185...POKE +ASM_ADDR(`PRINT-1') ; $BA...186...PRINT +ASM_ADDR(`CONT-1') ; $BB...187...CONT +ASM_ADDR(`LIST-1') ; $BC...188...LIST +ASM_ADDR(`CLEAR-1') ; $BD...189...CLEAR +ASM_ADDR(`GET-1') ; $BE...190...GET +ASM_ADDR(`NEW-1') ; $BF...191...NEW +; -------------------------------- +UNFNC ASM_ADDR(`SGN') ; $D2...210...SGN +ASM_ADDR(`INT') ; $D3...211...INT +ASM_ADDR(`ABS') ; $D4...212...ABS +ASM_ADDR(`USR') ; $D5...213...USR +ASM_ADDR(`FRE') ; $D6...214...FRE +ASM_ADDR(`ERROR') ; $D7...215...SCRN( +ASM_ADDR(`PDL') ; $D8...216...PDL +ASM_ADDR(`POS') ; $D9...217...POS +ASM_ADDR(`SQR') ; $DA...218...SQR +ASM_ADDR(`RND') ; $DB...219...RND +ASM_ADDR(`LOG') ; $DC...220...LOG +ASM_ADDR(`EXP') ; $DD...221...EXP +ASM_ADDR(`COS') ; $DE...222...COS +ASM_ADDR(`SIN') ; $DF...223...SIN +ASM_ADDR(`TAN') ; $E0...224...TAN +ASM_ADDR(`ATN') ; $E1...225...ATN +ASM_ADDR(`PEEK') ; $E2...226...PEEK +ASM_ADDR(`LEN') ; $E3...227...LEN +ASM_ADDR(`STR') ; $E4...228...STR$ +ASM_ADDR(`VAL') ; $E5...229...VAL +ASM_ADDR(`ASC') ; $E6...230...ASC +ASM_ADDR(`CHRSTR') ; $E7...231...CHR$ +ASM_ADDR(`LEFTSTR') ; $E8...232...LEFT$ +ASM_ADDR(`RIGHTSTR') ; $E9...233...RIGHT$ +ASM_ADDR(`MIDSTR') ; $EA...234...MID$ +; -------------------------------- +; MATH OPERATOR BRANCH TABLE +; +; ONE-BYTE PRECEDENCE CODE +; TWO-BYTE ADDRESS +; -------------------------------- +P_OR = $46 ; "OR" IS LOWEST PRECEDENCE +P_AND = $50 ; +P_REL = $64 ; RELATIONAL OPERATORS +P_ADD = $79 ; BINARY + AND - +P_MUL = $7B ; * AND / +P_PWR = $7D ; EXPONENTIATION +P_NEQ = $7F ; UNARY - AND COMPARISON = +; -------------------------------- +MATHTBL ASM_DATA(`P_ADD') +ASM_ADDR(`FADDT-1') ; $C8...200...+ +ASM_DATA(`P_ADD') +ASM_ADDR(`FSUBT-1') ; $C9...201...- +ASM_DATA(`P_MUL') +ASM_ADDR(`FMULTT-1') ; $CA...202...* +ASM_DATA(`P_MUL') +ASM_ADDR(`FDIVT-1') ; $CB...203.../ +ASM_DATA(`P_PWR') +ASM_ADDR(`FPWRT-1') ; $CC...204...^ +ASM_DATA(`P_AND') +ASM_ADDR(`ANDOP-1') ; $CD...205...AND +ASM_DATA(`P_OR') +ASM_ADDR(`OR-1') ; $CE...206...OR +M_NEG ASM_DATA(`P_NEQ') +ASM_ADDR(`NEGOP-1') ; $CF...207...> +MEQUU ASM_DATA(`P_NEQ') +ASM_ADDR(`EQUOP-1') ; $D0...208...= +M_REL ASM_DATA(`P_REL') +ASM_ADDR(`RELOPS-1') ; $D1...209...< + +; -------------------------------- +; TOKEN NAME TABLE +; -------------------------------- +; + +TOKEN_NAME_TABLE LHASCII(`END') ; $80...128 +LHASCII(`FOR') ; $81...129 +LHASCII(`NEXT') ; $82...130 +LHASCII(`DATA') ; $83...131 +LHASCII(`INPUT') ; $84...132 +LHASCII(`DEL') ; $85...133 +LHASCII(`DIM') ; $86...134 +LHASCII(`READ') ; $87...135 +LHASCII(`GR') ; $88...136 +LHASCII(`TEXT') ; $89...137 +LHASCII(`PR#') ; $8A...138 +LHASCII(`IN#') ; $8B...139 +LHASCII(`CALL') ; $8C...140 +LHASCII(`PLOT') ; $8D...141 +LHASCII(`HLIN') ; $8E...142 +LHASCII(`VLIN') ; $8F...143 +LHASCII(`HGR2') ; $90...144 +LHASCII(`HGR') ; $91...145 +LHASCII(`HCOLOR=') ; $92...146 +LHASCII(`HPLOT') ; $93...147 +LHASCII(`DRAW') ; $94...148 +LHASCII(`XDRAW') ; $95...149 +LHASCII(`HTAB') ; $96...150 +LHASCII(`HOME') ; $97...151 +LHASCII(`ROT=') ; $98...152 +LHASCII(`SCALE=') ; $99...153 +LHASCII(`SHLOAD') ; $9A...154 +LHASCII(`TRACE') ; $9B...155 +LHASCII(`NOTRACE') ; $9C...156 +LHASCII(`NORMAL') ; $9D...157 +LHASCII(`INVERSE') ; $9E...158 +LHASCII(`FLASH') ; $9F...159 +LHASCII(`COLOR=') ; $A0...160 +LHASCII(`POP') ; $A1...161 +LHASCII(`VTAB') ; $A2...162 +LHASCII(`HIMEM:') ; $A3...163 +LHASCII(`LOMEM:') ; $A4...164 +LHASCII(`ONERR') ; $A5...165 +LHASCII(`RESUME') ; $A6...166 +LHASCII(`RECALL') ; $A7...167 +LHASCII(`STORE') ; $A8...168 +LHASCII(`SPEED=') ; $A9...169 +LHASCII(`LET') ; $AA...170 +LHASCII(`GOTO') ; $AB...171 +LHASCII(`RUN') ; $AC...172 +LHASCII(`IF') ; $AD...173 +LHASCII(`RESTORE') ; $AE...174 +LHASCII(`&') ; $AF...175 +LHASCII(`GOSUB') ; $B0...176 +LHASCII(`RETURN') ; $B1...177 +LHASCII(`REM') ; $B2...178 +LHASCII(`STOP') ; $B3...179 +LHASCII(`ON') ; $B4...180 +LHASCII(`WAIT') ; $B5...181 +LHASCII(`LOAD') ; $B6...182 +LHASCII(`SAVE') ; $B7...183 +LHASCII(`DEF') ; $B8...184 +LHASCII(`POKE') ; $B9...185 +LHASCII(`PRINT') ; $BA...186 +LHASCII(`CONT') ; $BB...187 +LHASCII(`LIST') ; $BC...188 +LHASCII(`CLEAR') ; $BD...189 +LHASCII(`GET') ; $BE...190 +LHASCII(`NEW') ; $BF...191 +LOASCII(`TAB') ; $C0...192 +ASM_DATA($A8) +LHASCII(`TO') ; $C1...193 +LHASCII(`FN') ; $C2...194 +LOASCII(`SPC') ; $C3...195 +ASM_DATA($A8) +LHASCII(`THEN') ; $C4...196 +LHASCII(`AT') ; $C5...197 +LHASCII(`NOT') ; $C6...198 +LHASCII(`STEP') ; $C7...199 +LHASCII(`+') ; $C8...200 +LHASCII(`-') ; $C9...201 +LHASCII(`*') ; $CA...202 +LHASCII(`/') ; $CB...203 +ASM_DATA($DE) +; LHASCII(`^') ; $CC...204 +LHASCII(`AND') ; $CD...205 +LHASCII(`OR') ; $CE...206 +LHASCII(`>') ; $CF...207 +LHASCII(`=') ; $D0...208 +LHASCII(`<') ; $D1...209 +LHASCII(`SGN') ; $D2...210 +LHASCII(`INT') ; $D3...211 +LHASCII(`ABS') ; $D4...212 +LHASCII(`USR') ; $D5...213 +LHASCII(`FRE') ; $D6...214 +LOASCII(`SCRN') ; $D7...215 +ASM_DATA($A8) +LHASCII(`PDL') ; $D8...216 +LHASCII(`POS') ; $D9...217 +LHASCII(`SQR') ; $DA...218 +LHASCII(`RND') ; $DB...219 +LHASCII(`LOG') ; $DC...220 +LHASCII(`EXP') ; $DD...221 +LHASCII(`COS') ; $DE...222 +LHASCII(`SIN') ; $DF...223 +LHASCII(`TAN') ; $E0...224 +LHASCII(`ATN') ; $E1...225 +LHASCII(`PEEK') ; $E2...226 +LHASCII(`LEN') ; $E3...227 +LHASCII(`STR$') ; $E4...228 +LHASCII(`VAL') ; $E5...229 +LHASCII(`ASC') ; $E6...230 +LHASCII(`CHR$') ; $E7...231 +LHASCII(`LEFT$') ; $E8...232 +LHASCII(`RIGHT$') ; $E9...233 +LHASCII(`MID$') ; $EA...234 + +ASM_DATA(0) ; END OF TOKEN NAME TABLE +; -------------------------------- +; -------------------------------- +; ERROR MESSAGES +; -------------------------------- +ERROR_MESSAGES +ERR_NOFOR = *-ERROR_MESSAGES +LHASCII(`NEXT WITHOUT FOR') +ERR_SYNTAX = *-ERROR_MESSAGES +LHASCII(`SYNTAX') +ERR_NOGOSUB = *-ERROR_MESSAGES +LHASCII(`RETURN WITHOUT GOSUB') +ERR_NODATA = *-ERROR_MESSAGES +LHASCII(`OUT OF DATA') +ERR_ILLQTY = *-ERROR_MESSAGES +LHASCII(`ILLEGAL QUANTITY') +ERR_OVERFLOW = *-ERROR_MESSAGES +LHASCII(`OVERFLOW') +ERR_MEMFULL = *-ERROR_MESSAGES +LHASCII(`OUT OF MEMORY') +ERR_UNDEFSTAT = *-ERROR_MESSAGES +LOASCII(`UNDEF') +ASM_DATA($27) +LHASCII(`D STATEMENT') +ERR_BADSUBS = *-ERROR_MESSAGES +LHASCII(`BAD SUBSCRIPT') +ERR_REDIMD = *-ERROR_MESSAGES +LOASCII(`REDIM') +ASM_DATA($27) +LHASCII(`D ARRAY') +ERR_ZERODIV = *-ERROR_MESSAGES +LHASCII(`DIVISION BY ZERO') +ERR_ILLDIR = *-ERROR_MESSAGES +LHASCII(`ILLEGAL DIRECT') +ERR_BADTYPE = *-ERROR_MESSAGES +LHASCII(`TYPE MISMATCH') +ERR_STRLONG = *-ERROR_MESSAGES +LHASCII(`STRING TOO LONG') +ERR_FRMCPX = *-ERROR_MESSAGES +LHASCII(`FORMULA TOO COMPLEX') +ERR_CANTCONT = *-ERROR_MESSAGES +LOASCII(`CAN') +ASM_DATA($27) +LHASCII(`T CONTINUE') +ERR_UNDEFFUNC = *-ERROR_MESSAGES +LOASCII(`UNDEF') +ASM_DATA($27) +LHASCII(`D FUNCTION') +; -------------------------------- + +QT_ERROR LOASCII(` ERROR') +ASM_DATA($07,0) + +QT_IN LOASCII(` IN ') +ASM_DATA(0) + +QT_BREAK ASM_DATA($0D) +LOASCII(`BREAK') +ASM_DATA($07,0) +; -------------------------------- +; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH +; THE STACK FOR A FRAME WITH THE SAME VARIABLE. +; +; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT" +; = $XXFF IF CALLED FROM "RETURN" +; <<< BUG: SHOULD BE $FFXX >>> +; +; RETURNS .NE. IF VARIABLE NOT FOUND, +; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES +; +; EQU. IF FOUND +; (X) = STACK PNTR OF FRAME FOUND +; -------------------------------- +GTFORPNT +TSX +INX +INX +INX +INX +L_GTFORPNT_1 LDA STACK+1,X ; "FOR" FRAME HERE? +CMP #TOKEN_FOR ; +BNE L_GTFORPNT_4 ; NO +LDA FORPNT+1 ; YES -- "NEXT" WITH NO VARIABLE? +BNE L_GTFORPNT_2 ; NO, VARIABLE SPECIFIED +LDA STACK+2,X ; YES, SO USE THIS FRAME +STA FORPNT ; +LDA STACK+3,X ; +STA FORPNT+1 ; +L_GTFORPNT_2 CMP STACK+3,X ; IS VARIABLE IN THIS FRAME? +BNE L_GTFORPNT_3 ; NO +LDA FORPNT ; LOOK AT 2ND BYTE TOO +CMP STACK+2,X ; SAME VARIABLE? +BEQ L_GTFORPNT_4 ; YES +L_GTFORPNT_3 TXA ; NO, SO TRY NEXT FRAME (IF ANY) +CLC ; 18 BYTES PER FRAME +ADC #18 ; +TAX +BNE L_GTFORPNT_1 ; ...ALWAYS? +L_GTFORPNT_4 RTS +; -------------------------------- +; MOVE BLOCK OF MEMORY UP +; +; ON ENTRY: +; (Y,A) = (HIGHDS) = DESTINATION END+1 +; (LOWTR) = LOWEST ADDRESS OF SOURCE +; (HIGHTR) = HIGHEST SOURCE ADDRESS+1 +; -------------------------------- +BLTU JSR REASON ; BE SURE (Y,A) < FRETOP +STA STREND ; NEW TOP OF ARRAY STORAGE +STY STREND+1 ; +BLTU2 SEC ; +LDA HIGHTR ; COMPUTE # OF BYTES TO BE MOVED +SBC LOWTR ; (FROM LOWTR THRU HIGHTR-1) +STA INDEX ; PARTIAL PAGE AMOUNT +TAY ; +LDA HIGHTR+1 ; +SBC LOWTR+1 ; +TAX ; # OF WHOLE PAGES IN X-REG +INX ; +TYA ; # BYTES IN PARTIAL PAGE +BEQ L_BLTU2_4 ; NO PARTIAL PAGE +LDA HIGHTR ; BACK UP HIGHTR # BYTES IN PARTIAL PAGE +SEC ; +SBC INDEX ; +STA HIGHTR ; +BCS L_BLTU2_1 ; +DEC HIGHTR+1 ; +SEC ; +L_BLTU2_1 LDA HIGHDS ; BACK UP HIGHDS # BYTES IN PARTIAL PAGE +SBC INDEX ; +STA HIGHDS ; +BCS L_BLTU2_3 ; +DEC HIGHDS+1 ; +BCC L_BLTU2_3 ; ...ALWAYS +L_BLTU2_2 LDA (HIGHTR),Y ; MOVE THE BYTES +STA (HIGHDS),Y +L_BLTU2_3 DEY +BNE L_BLTU2_2 ; LOOP TO END OF THIS 256 BYTES +LDA (HIGHTR),Y ; MOVE ONE MORE BYTE +STA (HIGHDS),Y +L_BLTU2_4 DEC HIGHTR+1 ; DOWN TO NEXT BLOCK OF 256 +DEC HIGHDS+1 +DEX ; ANOTHER BLOCK OF 256 TO MOVE? +BNE L_BLTU2_3 ; YES +RTS ; NO, FINISHED +; -------------------------------- +; CHECK IF ENOUGH ROOM LEFT ON STACK +; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION +; -------------------------------- +CHKMEM ASL +ADC #54 +BCS MEMERR ; ...MEM FULL ERR +STA INDEX +TSX +CPX INDEX +BCC MEMERR ; ...MEM FULL ERR +RTS +; -------------------------------- +; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS +; (Y,A) = ADDR ARRAYS NEED TO GROW TO +; -------------------------------- +REASON CPY FRETOP+1 ; HIGH BYTE +BCC L_REASON_4 ; PLENTY OF ROOM +BNE L_REASON_1 ; NOT ENOUGH, TRY GARBAGE COLLECTION +CMP FRETOP ; LOW BYTE +BCC L_REASON_4 ; ENOUGH ROOM +; -------------------------------- +L_REASON_1 PHA ; SAVE (Y,A), TEMP1, AND TEMP2 +LDX #FAC-TEMP1-1 +TYA +L_REASON_2 PHA +LDA TEMP1,X +DEX +BPL L_REASON_2 +JSR GARBAG ; MAKE AS MUCH ROOM AS POSSIBLE +LDX #TEMP1+256-FAC+1 ; RESTORE TEMP1 AND TEMP2 +L_REASON_3 PLA ; AND (Y,A) +STA FAC,X +INX +BMI L_REASON_3 +PLA +TAY +PLA ; DID WE FIND ENOUGH ROOM? +CPY FRETOP+1 ; HIGH BYTE +BCC L_REASON_4 ; YES, AT LEAST A PAGE +BNE MEMERR ; NO, MEM FULL ERR +CMP FRETOP ; LOW BYTE +BCS MEMERR ; NO, MEM FULL ERR +L_REASON_4 RTS ; YES, RETURN +; -------------------------------- +MEMERR LDX #ERR_MEMFULL +; -------------------------------- +; HANDLE AN ERROR +; +; (X)=OFFSET IN ERROR MESSAGE TABLE +; (ERRFLG) > 128 IF "ON ERR" TURNED ON +; (CURLIN+1) = $FF IF IN DIRECT MODE +; -------------------------------- +ERROR BIT ERRFLG ; "ON ERR" TURNED ON? +BPL L_ERROR_1 ; NO +JMP HANDLERR ; YES +L_ERROR_1 JSR CRDO ; PRINT +JSR OUTQUES ; PRINT "?" +L_ERROR_2 LDA ERROR_MESSAGES,X +PHA ; PRINT MESSAGE +JSR OUTDO +INX +PLA +BPL L_ERROR_2 +JSR STKINI ; FIX STACK, ET AL +LDA #QT_ERROR +; -------------------------------- +; PRINT STRING AT (Y,A) +; PRINT CURRENT LINE # UNLESS IN DIRECT MODE +; FALL INTO WARM RESTART +; -------------------------------- +PRINT_ERROR_LINNUM +JSR STROUT ; PRINT STRING AT (Y,A) +LDY CURLIN+1 ; RUNNING, OR DIRECT? +INY +BEQ RESTART ; WAS $FF, SO DIRECT MODE +JSR INPRT ; RUNNING, SO PRINT LINE NUMBER +; -------------------------------- +; WARM RESTART ENTRY +; +; COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G +; -------------------------------- +RESTART +JSR CRDO ; PRINT +LDX #HICHAR(`]') ; PROMPT CHARACTER +JSR INLIN2 ; READ A LINE +STX TXTPTR ; SET UP CHRGET TO SCAN THE LINE +STY TXTPTR+1 ; +LSR ERRFLG ; CLEAR FLAG +JSR CHRGET ; +TAX ; +BEQ RESTART ; EMPTY LINE +LDX #$FF ; $FF IN HI-BYTE OF CURLIN MEANS +STX CURLIN+1 ; WE ARE IN DIRECT MODE +BCC NUMBERED_LINE ; CHRGET SAW DIGIT, NUMBERED LINE +JSR PARSE_INPUT_LINE ; NO NUMBER, SO PARSE IT +JMP TRACE_ ; AND TRY EXECUTING IT +; -------------------------------- +; HANDLE NUMBERED LINE +; -------------------------------- +NUMBERED_LINE +LDX PRGEND ; SQUASH VARIABLE TABLE +STX VARTAB +LDX PRGEND+1 +STX VARTAB+1 +JSR LINGET ; GET LINE # +JSR PARSE_INPUT_LINE ; AND PARSE THE INPUT LINE +STY EOL_PNTR ; SAVE INDEX TO INPUT BUFFER +JSR FNDLIN ; IS THIS LINE # ALREADY IN PROGRAM? +BCC PUT_NEW_LINE ; NO +LDY #1 ; YES, SO DELETE IT +LDA (LOWTR),Y ; LOWTR POINTS AT LINE +STA INDEX+1 ; GET HIGH BYTE OF FORWARD PNTR +LDA VARTAB +STA INDEX +LDA LOWTR+1 +STA DEST+1 +LDA LOWTR +DEY +SBC (LOWTR),Y +CLC +ADC VARTAB +STA VARTAB +STA DEST +LDA VARTAB+1 +ADC #$FF +STA VARTAB+1 +SBC LOWTR+1 +TAX +SEC +LDA LOWTR +SBC VARTAB +TAY +BCS L_NUMBERED_LINE_1 +INX +DEC DEST+1 +L_NUMBERED_LINE_1 CLC +ADC INDEX +BCC L_NUMBERED_LINE_2 +DEC INDEX+1 +CLC +; -------------------------------- +L_NUMBERED_LINE_2 LDA (INDEX),Y ; MOVE HIGHER LINES OF PROGRAM +STA (DEST),Y ; DOWN OVER THE DELETED LINE. +INY +BNE L_NUMBERED_LINE_2 +INC INDEX+1 +INC DEST+1 +DEX +BNE L_NUMBERED_LINE_2 +; -------------------------------- +PUT_NEW_LINE +LDA INPUT_BUFFER ; ANY CHARACTERS AFTER LINE #? +BEQ FIX_LINKS ; NO, SO NOTHING TO INSERT. +LDA MEMSIZ ; YES, SO MAKE ROOM AND INSERT LINE +LDY MEMSIZ+1 ; WIPE STRING AREA CLEAN +STA FRETOP ; +STY FRETOP+1 ; +LDA VARTAB ; SET UP BLTU SUBROUTINE +STA HIGHTR ; INSERT NEW LINE. +ADC EOL_PNTR +STA HIGHDS +LDY VARTAB+1 +STY HIGHTR+1 +BCC L_PUT_NEW_LINE_1 +INY +L_PUT_NEW_LINE_1 STY HIGHDS+1 +JSR BLTU ; MAKE ROOM FOR THE LINE +LDA LINNUM ; PUT LINE NUMBER IN LINE IMAGE +LDY LINNUM+1 +STA INPUT_BUFFER-2 +STY INPUT_BUFFER-1 +LDA STREND +LDY STREND+1 +STA VARTAB +STY VARTAB+1 +LDY EOL_PNTR +; ---COPY LINE INTO PROGRAM------- +L_PUT_NEW_LINE_2 LDA INPUT_BUFFER-5,Y +DEY +STA (LOWTR),Y +BNE L_PUT_NEW_LINE_2 +; -------------------------------- +; CLEAR ALL VARIABLES +; RE-ESTABLISH ALL FORWARD LINKS +; -------------------------------- +FIX_LINKS +JSR SETPTRS ; CLEAR ALL VARIABLES +LDA TXTTAB ; POINT INDEX AT START OF PROGRAM +LDY TXTTAB+1 +STA INDEX +STY INDEX+1 +CLC +L_FIX_LINKS_1 LDY #1 ; HI-BYTE OF NEXT FORWARD PNTR +LDA (INDEX),Y ; END OF PROGRAM YET? +BNE L_FIX_LINKS_2 ; NO, KEEP GOING +LDA VARTAB ; YES +STA PRGEND +LDA VARTAB+1 +STA PRGEND+1 +JMP RESTART +L_FIX_LINKS_2 LDY #4 ; FIND END OF THIS LINE +L_FIX_LINKS_3 INY ; (NOTE MAXIMUM LENGTH < 256) +LDA (INDEX),Y ; +BNE L_FIX_LINKS_3 ; +INY ; COMPUTE ADDRESS OF NEXT LINE +TYA ; +ADC INDEX ; +TAX ; +LDY #0 ; STORE FORWARD PNTR IN THIS LINE +STA (INDEX),Y ; +LDA INDEX+1 ; +ADC #0 ; (NOTE: THIS CLEARS CARRY) +INY ; +STA (INDEX),Y ; +STX INDEX ; +STA INDEX+1 ; +BCC L_FIX_LINKS_1 ; ...ALWAYS +; -------------------------------- +; -------------------------------- +; READ A LINE, AND STRIP OFF SIGN BITS +; -------------------------------- +INLIN LDX #$80 ; NULL PROMPT +INLIN2 STX MON_PROMPT +JSR MON_GETLN +CPX #239 ; MAXIMUM LINE LENGTH +BCC L_INLIN2_1 +LDX #239 ; TRUNCATE AT 239 CHARS +L_INLIN2_1 LDA #0 ; MARK END OF LINE WITH $00 BYTE +STA INPUT_BUFFER,X +TXA +BEQ L_INLIN2_3 ; NULL INPUT LINE +L_INLIN2_2 LDA INPUT_BUFFER-1,X ; DROP SIGN BITS +AND #$7F +STA INPUT_BUFFER-1,X +DEX +BNE L_INLIN2_2 +L_INLIN2_3 LDA #0 ; (Y,X) POINTS AT BUFFER-1 +LDX #<(INPUT_BUFFER-1) +LDY #>(INPUT_BUFFER-1) +RTS +; -------------------------------- +INCHR JSR MON_RDKEY ; *** OUGHT TO BE "BIT $C010" *** +AND #$7F +RTS +; -------------------------------- +; TOKENIZE THE INPUT LINE +; -------------------------------- +PARSE_INPUT_LINE +LDX TXTPTR ; INDEX INTO UNPARSED LINE +DEX ; PREPARE FOR INX AT "PARSE" +LDY #4 ; INDEX TO PARSED OUTPUT LINE +STY DATAFLG ; CLEAR SIGN-BIT OF DATAFLG +BIT LOCK ; IS THIS PROGRAM LOCKED? +BPL PARSE ; NO, GO AHEAD AND PARSE THE LINE +PLA ; YES, IGNORE INPUT AND "RUN" +PLA ; THE PROGRAM +JSR SETPTRS ; CLEAR ALL VARIABLES +JMP NEWSTT ; START RUNNING +; -------------------------------- +PARSE INX ; NEXT INPUT CHARACTER +L_PARSE_1 LDA INPUT_BUFFER,X +BIT DATAFLG ; IN A "DATA" STATEMENT? +BVS L_PARSE_2 ; YES (DATAFLG = $49) +CMP #LOCHAR(` ') ; IGNORE BLANKS +BEQ PARSE ; +L_PARSE_2 STA ENDCHR ; +CMP #$22 ; START OF QUOTATION? +BEQ L_PARSE_13 ; +BVS L_PARSE_9 ; BRANCH IF IN "DATA" STATEMENT +CMP #LOCHAR(`?') ; SHORTHAND FOR "PRINT"? +BNE L_PARSE_3 ; NO +LDA #TOKEN_PRINT ; YES, REPLACE WITH "PRINT" TOKEN +BNE L_PARSE_9 ; ...ALWAYS +L_PARSE_3 CMP #LOCHAR(`0') ; IS IT A DIGIT, COLON, OR SEMI-COLON? +BCC L_PARSE_4 ; NO, PUNCTUATION !"#$%&'()*+,-./ +CMP #LOCHAR(`;')+1 +BCC L_PARSE_9 ; YES, NOT A TOKEN +; -------------------------------- +; SEARCH TOKEN NAME TABLE FOR MATCH STARTING +; WITH CURRENT CHAR FROM INPUT LINE +; -------------------------------- +L_PARSE_4 STY STRNG2 ; SAVE INDEX TO OUTPUT LINE +LDA #<(TOKEN_NAME_TABLE-$100) +STA FAC ; MAKE PNTR FOR SEARCH +LDA #>(TOKEN_NAME_TABLE-$100) +STA FAC+1 +LDY #0 ; USE Y-REG WITH (FAC) TO ADDRESS TABLE +STY TKN_CNTR ; HOLDS CURRENT TOKEN-$80 +DEY ; PREPARE FOR "INY" A FEW LINES DOWN +STX TXTPTR ; SAVE POSITION IN INPUT LINE +DEX ; PREPARE FOR "INX" A FEW LINES DOWN +L_PARSE_5 INY ; ADVANCE POINTER TO TOKEN TABLE +BNE L_PARSE_6 ; Y=Y+1 IS ENOUGH +INC FAC+1 ; ALSO NEED TO BUMP THE PAGE +L_PARSE_6 INX ; ADVANCE POINTER TO INPUT LINE +L_PARSE_7 LDA INPUT_BUFFER,X ; NEXT CHAR FROM INPUT LINE +CMP #LOCHAR(` ') ; THIS CHAR A BLANK? +BEQ L_PARSE_6 ; YES, IGNORE ALL BLANKS +SEC ; NO, COMPARE TO CHAR IN TABLE +SBC (FAC),Y ; SAME AS NEXT CHAR OF TOKEN NAME? +BEQ L_PARSE_5 ; YES, CONTINUE MATCHING +CMP #$80 ; MAYBE; WAS IT SAME EXCEPT FOR BIT 7? +BNE L_PARSE_14 ; NO, SKIP TO NEXT TOKEN +ORA TKN_CNTR ; YES, END OF TOKEN; GET TOKEN # +CMP #TOKENDB ; DID WE MATCH "AT"? +BNE L_PARSE_8 ; NO, SO NO AMBIGUITY +LDA INPUT_BUFFER+1,X ; "AT" COULD BE "ATN" OR "A TO" +CMP #LOCHAR(`N') ; "ATN" HAS PRECEDENCE OVER "AT" +BEQ L_PARSE_14 ; IT IS "ATN", FIND IT THE HARD WAY +CMP #LOCHAR(`O') ; "TO" HAS PRECEDENCE OVER "AT" +BEQ L_PARSE_14 ; IT IS "A TO", FIN IT THE HARD WAY +LDA #TOKENDB ; NOT "ATN" OR "A TO", SO USE "AT" +; -------------------------------- +; STORE CHARACTER OR TOKEN IN OUTPUT LINE +; -------------------------------- +L_PARSE_8 LDY STRNG2 ; GET INDEX TO OUTPUT LINE IN Y-REG +L_PARSE_9 INX ; ADVANCE INPUT INDEX +INY ; ADVANCE OUTPUT INDEX +STA INPUT_BUFFER-5,Y ; STORE CHAR OR TOKEN +LDA INPUT_BUFFER-5,Y ; TEST FOR EOL OR EOS +BEQ L_PARSE_17 ; END OF LINE +SEC ; +SBC #LOCHAR(`:') ; END OF STATEMENT? +BEQ L_PARSE_10 ; YES, CLEAR DATAFLG +CMP #TOKENDWTA+128-$BA ; "DATA" TOKEN? +BNE L_PARSE_11 ; NO, LEAVE DATAFLG ALONE +L_PARSE_10 STA DATAFLG ; DATAFLG = 0 OR $83-$3A = $49 +L_PARSE_11 SEC ; IS IT A "REM" TOKEN? +SBC #TOKEN_REM+128-$BA +BNE L_PARSE_1 ; NO, CONTINUE PARSING LINE +STA ENDCHR ; YES, CLEAR LITERAL FLAG +; -------------------------------- +; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK, +; BY COPYING CHARS UP TO ENDCHR. +; -------------------------------- +L_PARSE_12 LDA INPUT_BUFFER,X +BEQ L_PARSE_9 ; END OF LINE +CMP ENDCHR +BEQ L_PARSE_9 ; FOUND ENDCHR +L_PARSE_13 INY ; NEXT OUTPUT CHAR +STA INPUT_BUFFER-5,Y +INX ; NEXT INPUT CHAR +BNE L_PARSE_12 ; ...ALWAYS +; -------------------------------- +; ADVANCE POINTER TO NEXT TOKEN NAME +; -------------------------------- +L_PARSE_14 LDX TXTPTR ; GET POINTER TO INPUT LINE IN X-REG +INC TKN_CNTR ; BUMP (TOKEN # - $80) +L_PARSE_15 LDA (FAC),Y ; SCAN THROUGH TABLE FOR BIT7 = 1 +INY ; NEXT TOKEN ONE BEYOND THAT +BNE L_PARSE_16 ; ...USUALLY ENOUGH TO BUMP Y-REG +INC FAC+1 ; NEXT SET OF 256 TOKEN CHARS +L_PARSE_16 ASL ; SEE IF SIGN BIT SET ON CHAR +BCC L_PARSE_15 ; NO, MORE IN THIS NAME +LDA (FAC),Y ; YES, AT NEXT NAME. END OF TABLE? +BNE L_PARSE_7 ; NO, NOT END OF TABLE +LDA INPUT_BUFFER,X ; YES, SO NOT A KEYWORD +BPL L_PARSE_8 ; ...ALWAYS, COPY CHAR AS IS +; ---END OF LINE------------------ +L_PARSE_17 STA INPUT_BUFFER-3,Y ; STORE ANOTHER 00 ON END +DEC TXTPTR+1 ; SET TXTPTR = INPUT.BUFFER-1 +LDA #<(INPUT_BUFFER-1) +STA TXTPTR +RTS +; -------------------------------- +; SEARCH FOR LINE +; +; (LINNUM) = LINE # TO FIND +; IF NOT FOUND: CARRY = 0 +; LOWTR POINTS AT NEXT LINE +; IF FOUND: CARRY = 1 +; LOWTR POINTS AT LINE +; -------------------------------- +FNDLIN LDA TXTTAB ; SEARCH FROM BEGINNING OF PROGRAM +LDX TXTTAB+1 ; +FL1 LDY #1 ; SEARCH FROM (X,A) +STA LOWTR ; +STX LOWTR+1 ; +LDA (LOWTR),Y ; +BEQ L_FL1_3 ; END OF PROGRAM, AND NOT FOUND +INY ; +INY ; +LDA LINNUM+1 ; +CMP (LOWTR),Y ; +BCC RTS_1 ; IF NOT FOUND +BEQ L_FL1_1 ; +DEY ; +BNE L_FL1_2 ; +L_FL1_1 LDA LINNUM ; +DEY ; +CMP (LOWTR),Y ; +BCC RTS_1 ; PAST LINE, NOT FOUND +BEQ RTS_1 ; IF FOUND +L_FL1_2 DEY ; +LDA (LOWTR),Y ; +TAX ; +DEY ; +LDA (LOWTR),Y ; +BCS FL1 ; ALWAYS +L_FL1_3 CLC ; RETURN CARRY = 0 +RTS_1 RTS +; -------------------------------- +; "NEW" STATEMENT +; -------------------------------- +NEW BNE RTS_1 ; IGNORE IF MORE TO THE STATEMENT +SCRTCH LDA #0 +STA LOCK +TAY +STA (TXTTAB),Y +INY +STA (TXTTAB),Y +LDA TXTTAB +ADC #2 ; (CARRY WASN'T CLEARED, SO "NEW" USUALLY +STA VARTAB ; ADDS 3, WHEREAS "FP" ADDS 2.) +STA PRGEND +LDA TXTTAB+1 +ADC #0 +STA VARTAB+1 +STA PRGEND+1 +; -------------------------------- +SETPTRS +JSR STXTPT ; SET TXTPTR TO TXTTAB - 1 +LDA #0 ; (THIS COULD HAVE BEEN ".HS 2C") +; -------------------------------- +; "CLEAR" STATEMENT +; -------------------------------- +CLEAR BNE RTS_2 ; IGNORE IF NOT AT END OF STATEMENT +CLEARC LDA MEMSIZ ; CLEAR STRING AREA +LDY MEMSIZ+1 ; +STA FRETOP ; +STY FRETOP+1 ; +LDA VARTAB ; CLEAR ARRAY AREA +LDY VARTAB+1 ; +STA ARYTAB ; +STY ARYTAB+1 ; +STA STREND ; LOW END OF FREE SPACE +STY STREND+1 ; +JSR RESTORE ; SET "DATA" POINTER TO BEGINNING +; -------------------------------- +STKINI LDX #TEMPST +STX TEMPPT +PLA ; SAVE RETURN ADDRESS +TAY ; +PLA ; +LDX #$F8 ; START STACK AT $F8, +TXS ; LEAVING ROOM FOR PARSING LINES +PHA ; RESTORE RETURN ADDRESS +TYA +PHA +LDA #0 +STA OLDTEXT+1 +STA SUBFLG +RTS_2 RTS +; -------------------------------- +; SET TXTPTR TO BEGINNING OF PROGRAM +; -------------------------------- +STXTPT CLC ; TXTPTR = TXTTAB - 1 +LDA TXTTAB +ADC #$FF +STA TXTPTR +LDA TXTTAB+1 +ADC #$FF +STA TXTPTR+1 +RTS +; -------------------------------- +; "LIST" STATEMENT +; -------------------------------- +LIST BCC L_LIST_1 ; NO LINE # SPECIFIED +BEQ L_LIST_1 ; ---DITTO--- +CMP #TOKEN_MINUS ; IF DASH OR COMMA, START AT LINE 0 +BEQ L_LIST_1 ; IS IS A DASH +CMP #LOCHAR(`,') ; COMMA? +BNE RTS_2 ; NO, ERROR +L_LIST_1 JSR LINGET ; CONVERT LINE NUMBER IF ANY +JSR FNDLIN ; POINT LOWTR TO 1ST LINE +JSR CHRGOT ; RANGE SPECIFIED? +BEQ L_LIST_3 ; NO +CMP #TOKEN_MINUS +BEQ L_LIST_2 +CMP #LOCHAR(`,') +BNE RTS_1 +L_LIST_2 JSR CHRGET ; GET NEXT CHAR +JSR LINGET ; CONVERT SECOND LINE # +BNE RTS_2 ; BRANCH IF SYNTAX ERR +L_LIST_3 PLA ; POP RETURN ADRESS +PLA ; (GET BACK BY "JMP NEWSTT") +LDA LINNUM ; IF NO SECOND NUMBER, USE $FFFF +ORA LINNUM+1 ; +BNE LIST_0 ; THERE WAS A SECOND NUMBER +LDA #$FF ; MAX END RANGE +STA LINNUM ; +STA LINNUM+1 ; +LIST_0 LDY #1 ; +LDA (LOWTR),Y ; HIGH BYTE OF LINK +BEQ LIST_3 ; END OF PROGRAM +JSR ISCNTC ; CHECK IF CONTROL-C HAS BEEN TYPED +JSR CRDO ; NO, PRINT +INY ; +LDA (LOWTR),Y ; GET LINE #, COMPARE WITH END RANGE +TAX ; +INY ; +LDA (LOWTR),Y ; +CMP LINNUM+1 ; +BNE L_LIST_0_5 ; +CPX LINNUM ; +BEQ L_LIST_0_6 ; ON LAST LINE OF RANGE +L_LIST_0_5 BCS LIST_3 ; FINISHED THE RANGE +; ---LIST ONE LINE---------------- +L_LIST_0_6 STY FORPNT ; +JSR LINPRT ; PRINT LINE # FROM X,A +LDA #LOCHAR(` ') ; PRINT SPACE AFTER LINE # +LIST_1 LDY FORPNT ; +AND #$7F ; +LIST_2 JSR OUTDO ; +LDA MON_CH ; IF PAST COLUMN 33, START A NEW LINE +CMP #33 ; +BCC L_LIST_2_1 ; < 33 +JSR CRDO ; PRINT +LDA #5 ; AND TAB OVER 5 +STA MON_CH ; +L_LIST_2_1 INY ; +LDA (LOWTR),Y ; +BNE LIST_4 ; NOT END OF LINE YET +TAY ; END OF LINE +LDA (LOWTR),Y ; GET LINK TO NEXT LINE +TAX ; +INY ; +LDA (LOWTR),Y ; +STX LOWTR ; POINT TO NEXT LINE +STA LOWTR+1 ; +BNE LIST_0 ; BRANCH IF NOT END OF PROGRAM +LIST_3 LDA #$0D ; PRINT +JSR OUTDO ; +JMP NEWSTT ; TO NEXT STATEMENT +; -------------------------------- +GETCHR INY ; PICK UP CHAR FROM TABLE +BNE L_GETCHR_1 ; +INC FAC+1 ; +L_GETCHR_1 LDA (FAC),Y ; +RTS ; +; -------------------------------- +LIST_4 BPL LIST_2 ; BRANCH IF NOT A TOKEN +SEC ; +SBC #$7F ; CONVERT TOKEN TO INDEX +TAX ; +STY FORPNT ; SAVE LINE POINTER +LDY #<(TOKEN_NAME_TABLE-$100) +STY FAC ; POINT FAC TO TABLE +LDY #>(TOKEN_NAME_TABLE-$100) +STY FAC+1 +LDY #$FF +L_LIST_4_1 DEX ; SKIP KEYWORDS UNTIL REACH THIS ONE +BEQ L_LIST_4_3 ; +L_LIST_4_2 JSR GETCHR ; BUMP Y, GET CHAR FROM TABLE +BPL L_LIST_4_2 ; NOT AT END OF KEYWORD YET +BMI L_LIST_4_1 ; END OF KEYWORD, ALWAYS BRANCHES +L_LIST_4_3 LDA #LOCHAR(` ') ; FOUND THE RIGHT KEYWORD +JSR OUTDO ; PRINT LEADING SPACE +L_LIST_4_4 JSR GETCHR ; PRINT THE KEYWORD +BMI L_LIST_4_5 ; LAST CHAR OF KEYWORD +JSR OUTDO ; +BNE L_LIST_4_4 ; ...ALWAYS +L_LIST_4_5 JSR OUTDO ; PRINT LAST CHAR OF KEYWORD +LDA #LOCHAR(` ') ; PRINT TRAILING SPACE +BNE LIST_1 ; ...ALWAYS, BACK TO ACTUAL LINE +; -------------------------------- +; "FOR" STATEMENT +; +; FOR PUSHES 18 BYTES ON THE STACK: +; 2 -- TXTPTR +; 2 -- LINE NUMBER +; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE +; 1 -- STEP SIGN +; 5 -- STEP VALUE +; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB +; 1 -- FOR TOKEN ($81) +; -------------------------------- +FOR LDA #$80 ; +STA SUBFLG ; SUBSCRIPTS NOT ALLOWED +JSR LET ; DO = , STORE ADDR IN FORPNT +JSR GTFORPNT ; IS THIS FOR VARIABLE ACTIVE? +BNE L_FOR_1 ; NO +TXA ; YES, CANCEL IT AND ENCLOSED LOOPS +ADC #15 ; CARRY=1, THIS ADDS 16 +TAX ; X WAS ALREADY S+2 +TXS ; +L_FOR_1 PLA ; POP RETURN ADDRESS TOO +PLA ; +LDA #9 ; BE CERTAIN ENOUGH ROOM IN STACK +JSR CHKMEM ; +JSR DATAN ; SCAN AHEAD TO NEXT STATEMENT +CLC ; PUSH STATEMENT ADDRESS ON STACK +TYA ; +ADC TXTPTR ; +PHA ; +LDA TXTPTR+1 ; +ADC #0 ; +PHA ; +LDA CURLIN+1 ; PUSH LINE NUMBER ON STACK +PHA ; +LDA CURLIN ; +PHA ; +LDA #TOKEN_TO ; +JSR SYNCHR ; REQUIRE "TO" +JSR CHKNUM ; = MUST BE NUMERIC +JSR FRMNUM ; GET FINAL VALUE, MUST BE NUMERIC +LDA FAC_SIGN ; PUT SIGN INTO VALUE IN FAC +ORA #$7F ; +AND FAC+1 ; +STA FAC+1 ; +LDA #STEP ; TO STEP +STA INDEX +STY INDEX+1 +JMP FRM_STACK_3 ; RETURNS BY "JMP (INDEX)" +; -------------------------------- +; "STEP" PHRASE OF "FOR" STATEMENT +; -------------------------------- +STEP LDA #CON_ONE +JSR LOAD_FAC_FROM_YA +JSR CHRGOT +CMP #TOKEN_STEP +BNE L_STEP_1 ; USE DEFAULT VALUE OF 1.0 +JSR CHRGET ; STEP SPECIFIED, GET IT +JSR FRMNUM +L_STEP_1 JSR SIGN +JSR FRM_STACK_2 +LDA FORPNT+1 +PHA +LDA FORPNT +PHA +LDA #TOKEN_FOR +PHA +; -------------------------------- +; PERFORM NEXT STATEMENT +; -------------------------------- +NEWSTT TSX ; REMEMBER THE STACK POSITION +STX REMSTK ; +JSR ISCNTC ; SEE IF CONTROL-C HAS BEEN TYPED +LDA TXTPTR ; NO, KEEP EXECUTING +LDY TXTPTR+1 ; +LDX CURLIN+1 ; =$FF IF IN DIRECT MODE +INX ; $FF TURNS INTO $00 +BEQ L_NEWSTT_1 ; IN DIRECT MODE +STA OLDTEXT ; IN RUNNING MODE +STY OLDTEXT+1 ; +L_NEWSTT_1 LDY #0 ; +LDA (TXTPTR),Y ; END OF LINE YET? +BNE COLON_ ; NO +LDY #2 ; YES, SEE IF END OF PROGRAM +LDA (TXTPTR),Y ; +CLC ; +BEQ GOEND ; YES, END OF PROGRAM +INY ; +LDA (TXTPTR),Y ; GET LINE # OF NEXT LINE +STA CURLIN ; +INY ; +LDA (TXTPTR),Y ; +STA CURLIN+1 ; +TYA ; ADJUST TXTPTR TO START +ADC TXTPTR ; OF NEW LINE +STA TXTPTR +BCC L_NEWSTT_2 +INC TXTPTR+1 +L_NEWSTT_2 +; -------------------------------- +TRACE_ BIT TRCFLG ; IS TRACE ON? +BPL L_TRACE__1 ; NO +LDX CURLIN+1 ; YES, ARE WE RUNNING? +INX ; +BEQ L_TRACE__1 ; NOT RUNNING, SO DON'T TRACE +LDA #LOCHAR(`#') ; PRINT "#" +JSR OUTDO ; +LDX CURLIN ; +LDA CURLIN+1 ; +JSR LINPRT ; PRINT LINE NUMBER +JSR OUTSP ; PRINT TRAILING SPACE +L_TRACE__1 JSR CHRGET ; GET FIRST CHR OF STATEMENT +JSR EXECUTE_STATEMENT ; AND START PROCESSING +JMP NEWSTT ; BACK FOR MORE +; -------------------------------- +GOEND BEQ END4 +; -------------------------------- +; EXECUTE A STATEMENT +; +; (A) IS FIRST CHAR OF STATEMENT +; CARRY IS SET +; -------------------------------- +EXECUTE_STATEMENT +BEQ RTS_3 ; END OF LINE, NULL STATEMENT +EXECUTE_STATEMENT_1 ; +SBC #$80 ; FIRST CHAR A TOKEN? +BCC L_EXECUTE_STATEMENT_1_1 ; NOT TOKEN, MUST BE "LET" +CMP #$40 ; STATEMENT-TYPE TOKEN? +BCS SYNERR_1 ; NO, SYNTAX ERROR +ASL ; DOUBLE TO GET INDEX +TAY ; INTO ADDRESS TABLE +LDA TOKEN_ADDRESS_TABLE+1,Y +PHA ; PUT ADDRESS ON STACK +LDA TOKEN_ADDRESS_TABLE,Y +PHA +JMP CHRGET ; GET NEXT CHR & RTS TO ROUTINE +; -------------------------------- +L_EXECUTE_STATEMENT_1_1 JMP LET ; MUST BE = +; -------------------------------- +COLON_ CMP #LOCHAR(`:') +BEQ TRACE_ +SYNERR_1 JMP SYNERR +; -------------------------------- +; "RESTORE" STATEMENT +; -------------------------------- +RESTORE +SEC ; SET DATPTR TO BEGINNING OF PROGRAM +LDA TXTTAB +SBC #1 +LDY TXTTAB+1 +BCS SETDA +DEY +; ---SET DATPTR TO Y,A------------ +SETDA STA DATPTR +STY DATPTR+1 +RTS_3 RTS +; -------------------------------- +; SEE IF CONTROL-C TYPED +; -------------------------------- +ISCNTC LDA KEYBOARD +CMP #$83 +BEQ L_ISCNTC_1 +RTS +L_ISCNTC_1 JSR INCHR ; <<< SHOULD BE "BIT $C010" >>> +CONTROL_C_TYPED +LDX #$FF ; CONTROL C ATTEMPTED +BIT ERRFLG ; "ON ERR" ENABLED? +BPL L_CONTROL_C_TYPED_2 ; NO +JMP HANDLERR ; YES, RETURN ERR CODE = 255 +L_CONTROL_C_TYPED_2 CMP #3 ; SINCE IT IS CTRL-C, SET Z AND C BITS +; -------------------------------- +; "STOP" STATEMENT +; -------------------------------- +STOP BCS END2 ; CARRY=1 TO FORCE PRINTING "BREAK AT.." +; -------------------------------- +; "END" STATEMENT +; -------------------------------- +ENDX CLC ; CARRY=0 TO AVOID PRINTING MESSAGE +END2 BNE RTS_4 ; IF NOT END OF STATEMENT, DO NOTHING +LDA TXTPTR +LDY TXTPTR+1 +LDX CURLIN+1 +INX ; RUNNING? +BEQ L_END2_1 ; NO, DIRECT MODE +STA OLDTEXT +STY OLDTEXT+1 +LDA CURLIN +LDY CURLIN+1 +STA OLDLIN +STY OLDLIN+1 +L_END2_1 PLA +PLA +END4 LDA #QT_BREAK +BCC L_END4_1 +JMP PRINT_ERROR_LINNUM +L_END4_1 JMP RESTART +; -------------------------------- +; "CONT" COMMAND +; -------------------------------- +CONT BNE RTS_4 ; IF NOT END OF STATEMENT, DO NOTHING +LDX #ERR_CANTCONT +LDY OLDTEXT+1 ; MEANINGFUL RE-ENTRY? +BNE L_CONT_1 ; YES +JMP ERROR ; NO +L_CONT_1 LDA OLDTEXT ; RESTORE TXTPTR +STA TXTPTR ; +STY TXTPTR+1 ; +LDA OLDLIN ; RESTORE LINE NUMBER +LDY OLDLIN+1 +STA CURLIN +STY CURLIN+1 +RTS_4 RTS +; -------------------------------- +; "SAVE" COMMAND +; WRITES PROGRAM ON CASSETTE TAPE +; -------------------------------- +SAVE SEC +LDA PRGEND ; COMPUTE PROGRAM LENGTH +SBC TXTTAB +STA LINNUM +LDA PRGEND+1 +SBC TXTTAB+1 +STA LINNUM+1 +JSR VARTIO ; SET UP TO WRITE 3 BYTE HEADER +JSR MON_WRITE ; WRITE 'EM +JSR PROGIO ; SET UP TO WRITE THE PROGRAM +JMP MON_WRITE ; WRITE IT +; -------------------------------- +; "LOAD" COMMAND +; READS A PROGRAM FROM CASSETTE TAPE +; -------------------------------- +LOAD JSR VARTIO ; SET UP TO READ 3 BYTE HEADER +JSR MON_READ ; READ LENGTH, LOCK BYTE +CLC ; +LDA TXTTAB ; COMPUTE END ADDRESS +ADC LINNUM ; +STA VARTAB ; +LDA TXTTAB+1 ; +ADC LINNUM+1 ; +STA VARTAB+1 ; +LDA TEMPPT ; LOCK BYTE +STA LOCK ; +JSR PROGIO ; SET UP TO READ PROGRAM +JSR MON_READ ; READ IT +BIT LOCK ; IF LOCKED, START RUNNING NOW +BPL L_LOAD_1 ; NOT LOCKED +JMP SETPTRS ; LOCKED, START RUNNING +L_LOAD_1 JMP FIX_LINKS ; JUST FIX FORWARD POINTERS +; -------------------------------- +VARTIO LDA #LINNUM ; SET UP TO READ/WRITE 3 BYTE HEADER +LDY #0 +STA MON_A1L +STY MON_A1H +LDA #TEMPPT +STA MON_A2L +STY MON_A2H +STY LOCK +RTS +; -------------------------------- +PROGIO LDA TXTTAB ; SET UP TO READ/WRITE PROGRAM +LDY TXTTAB+1 +STA MON_A1L +STY MON_A1H +LDA VARTAB +LDY VARTAB+1 +STA MON_A2L +STY MON_A2H +RTS +; -------------------------------- +; -------------------------------- +; "RUN" COMMAND +; -------------------------------- +RUN PHP ; SAVE STATUS WHILE SUBTRACTING +DEC CURLIN+1 ; IF WAS $FF (MEANING DIRECT MODE) +; MAKE IT "RUNNING MODE" +PLP ; GET STATUS AGAIN (FROM CHRGET) +BNE L_RUN_1 ; PROBABLY A LINE NUMBER +JMP SETPTRS ; START AT BEGINNING OF PROGRAM +L_RUN_1 JSR CLEARC ; CLEAR VARIABLES +JMP GO_TO_LINE ; JOIN GOSUB STATEMENT +; -------------------------------- +; "GOSUB" STATEMENT +; +; LEAVES 7 BYTES ON STACK: +; 2 -- RETURN ADDRESS (NEWSTT) +; 2 -- TXTPTR +; 2 -- LINE # +; 1 -- GOSUB TOKEN ($B0) +; -------------------------------- +GOSUB LDA #3 ; BE SURE ENOUGH ROOM ON STACK +JSR CHKMEM +LDA TXTPTR+1 +PHA +LDA TXTPTR +PHA +LDA CURLIN+1 +PHA +LDA CURLIN +PHA +LDA #TOKEN_GOSUB +PHA +GO_TO_LINE +JSR CHRGOT +JSR GOTO +JMP NEWSTT +; -------------------------------- +; "GOTO" STATEMENT +; ALSO USED BY "RUN" AND "GOSUB" +; -------------------------------- +GOTO JSR LINGET ; GET GOTO LINE +JSR REMN ; POINT Y TO EOL +LDA CURLIN+1 ; IS CURRENT PAGE < GOTO PAGE? +CMP LINNUM+1 ; +BCS L_GOTO_1 ; SEARCH FROM PROG START IF NOT +TYA ; OTHERWISE SEARCH FROM NEXT LINE +SEC ; +ADC TXTPTR ; +LDX TXTPTR+1 ; +BCC L_GOTO_2 ; +INX ; +BCS L_GOTO_2 ; +L_GOTO_1 LDA TXTTAB ; GET PROGRAM BEGINNING +LDX TXTTAB+1 ; +L_GOTO_2 JSR FL1 ; SEARCH FOR GOTO LINE +BCC UNDERR ; ERROR IF NOT THERE +LDA LOWTR ; TXTPTR = START OF THE DESTINATION LINE +SBC #1 ; +STA TXTPTR ; +LDA LOWTR+1 ; +SBC #0 ; +STA TXTPTR+1 ; +RTS_5 RTS ; RETURN TO NEWSTT OR GOSUB +; -------------------------------- +; "POP" AND "RETURN" STATEMENTS +; -------------------------------- +POP BNE RTS_5 +LDA #$FF +STA FORPNT ; <<< BUG: SHOULD BE FORPNT+1 >>> +; <<< SEE "ALL ABOUT APPLESOFT", PAGES 100,101 >>> +JSR GTFORPNT ; TO CANCEL FOR/NEXT IN SUB +TXS +CMP #TOKEN_GOSUB ; LAST GOSUB FOUND? +BEQ RETURN +LDX #ERR_NOGOSUB +ASM_DATA($2C) ; FAKE +UNDERR LDX #ERR_UNDEFSTAT +JMP ERROR +; -------------------------------- +SYNERR_2 JMP SYNERR +; -------------------------------- +RETURN PLA ; DISCARD GOSUB TOKEN +PLA +CPY #<(TOKEN_POP*2) +BEQ PULL3 ; BRANCH IF A POP +STA CURLIN ; PULL LINE # +PLA +STA CURLIN+1 +PLA +STA TXTPTR ; PULL TXTPTR +PLA +STA TXTPTR+1 +; -------------------------------- +; "DATA" STATEMENT +; EXECUTED BY SKIPPING TO NEXT COLON OR EOL +; -------------------------------- +DATA JSR DATAN ; MOVE TO NEXT STATEMENT +; -------------------------------- +; ADD (Y) TO TXTPTR +; -------------------------------- +ADDON TYA +CLC +ADC TXTPTR +STA TXTPTR +BCC L_ADDON_1 +INC TXTPTR+1 +L_ADDON_1 +RTS_6 RTS +; -------------------------------- +; SCAN AHEAD TO NEXT ":" OR EOL +; -------------------------------- +DATAN LDX #LOCHAR(`:') ; GET OFFSET IN Y TO EOL OR ":" +ASM_DATA($2C) ; FAKE +; -------------------------------- +REMN LDX #0 ; TO EOL ONLY +STX CHARAC +LDY #0 +STY ENDCHR +L_REMN_1 LDA ENDCHR ; TRICK TO COUNT QUOTE PARITY +LDX CHARAC +STA CHARAC +STX ENDCHR +L_REMN_2 LDA (TXTPTR),Y +BEQ RTS_6 ; END OF LINE +CMP ENDCHR +BEQ RTS_6 ; COLON IF LOOKING FOR COLONS +INY +CMP #$22 +BNE L_REMN_2 +BEQ L_REMN_1 ; ...ALWAYS +; -------------------------------- +PULL3 PLA +PLA +PLA +RTS +; -------------------------------- +; "IF" STATEMENT +; -------------------------------- +IF JSR FRMEVL +JSR CHRGOT +CMP #TOKEN_GOTO +BEQ L_IF_1 +LDA #TOKEN_THEN +JSR SYNCHR +L_IF_1 LDA FAC ; CONDITION TRUE OR FALSE? +BNE IF_TRUE ; BRANCH IF TRUE +; -------------------------------- +; "REM" STATEMENT, OR FALSE "IF" STATEMENT +; -------------------------------- +REM JSR REMN ; SKIP REST OF LINE +BEQ ADDON ; ...ALWAYS +; -------------------------------- +IF_TRUE +JSR CHRGOT ; COMMAND OR NUMBER? +BCS L_IF_TRUE_1 ; COMMAND +JMP GOTO ; NUMBER +L_IF_TRUE_1 JMP EXECUTE_STATEMENT +; -------------------------------- +; "ON" STATEMENT +; +; ON GOTO +; ON GOSUB +; -------------------------------- +ONGOTO JSR GETBYT ; EVALUATE , AS BYTE IN FAC+4 +PHA ; SAVE NEXT CHAR ON STACK +CMP #TOKEN_GOSUB +BEQ ON_2 +ON_1 CMP #TOKEN_GOTO +BNE SYNERR_2 +ON_2 DEC FAC+4 ; COUNTED TO RIGHT ONE YET? +BNE L_ON_2_3 ; NO, KEEP LOOKING +PLA ; YES, RETRIEVE CMD +JMP EXECUTE_STATEMENT_1 ; AND GO. +L_ON_2_3 JSR CHRGET ; PRIME CONVERT SUBROUTINE +JSR LINGET ; CONVERT LINE # +CMP #LOCHAR(`,') ; TERMINATE WITH COMMA? +BEQ ON_2 ; YES +PLA ; NO, END OF LIST, SO IGNORE +RTS_7 RTS +; -------------------------------- +; CONVERT LINE NUMBER +; -------------------------------- +LINGET LDX #0 ; ASC # TO HEX ADDRESS +STX LINNUM ; IN LINNUM. +STX LINNUM+1 ; +L_LINGET_1 BCS RTS_7 ; NOT A DIGIT +SBC #LOCHAR(`0')-1 ; CONVERT DIGIT TO BINARY +STA CHARAC ; SAVE THE DIGIT +LDA LINNUM+1 ; CHECK RANGE +STA INDEX ; +CMP #>6400 ; LINE # TOO LARGE? +BCS ON_1 ; YES, > 63999, GO INDIRECTLY TO +; "SYNTAX ERROR". +; <<<<>>>> +; NOTE THAT IF (A) = $AB ON THE LINE ABOVE, +; ON_1 WILL COMPARE = AND CAUSE A CATASTROPHIC +; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS +; FOR OTHER CALLS TO LINGET. +; +; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9, +; THEN TYPE "GO TO 437761". +; +; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE +; THE PROBLEM. ($AB00 - $ABFF) +; <<<<>>>> +LDA LINNUM ; MULTIPLY BY TEN +ASL +ROL INDEX +ASL +ROL INDEX +ADC LINNUM +STA LINNUM +LDA INDEX +ADC LINNUM+1 +STA LINNUM+1 +ASL LINNUM +ROL LINNUM+1 +LDA LINNUM +ADC CHARAC ; ADD DIGIT +STA LINNUM +BCC L_LINGET_2 +INC LINNUM+1 +L_LINGET_2 JSR CHRGET ; GET NEXT CHAR +JMP L_LINGET_1 ; MORE CONVERTING +; -------------------------------- +; "LET" STATEMENT +; +; LET = +; = +; -------------------------------- +LET JSR PTRGET ; GET +STA FORPNT +STY FORPNT+1 +LDA #TOKENEQUUAL +JSR SYNCHR +LDA VALTYP+1 ; SAVE VARIABLE TYPE +PHA +LDA VALTYP +PHA +JSR FRMEVL ; EVALUATE +PLA +ROL +JSR CHKVAL +BNE LET_STRING +PLA +; -------------------------------- +LET2 BPL L_LET2_1 ; REAL VARIABLE +JSR ROUND_FAC ; INTEGER VAR: ROUND TO 32 BITS +JSR AYINT ; TRUNCATE TO 16-BITS +LDY #0 +LDA FAC+3 +STA (FORPNT),Y +INY +LDA FAC+4 +STA (FORPNT),Y +RTS +; -------------------------------- +; REAL VARIABLE = EXPRESSION +; -------------------------------- +L_LET2_1 JMP SETFOR +; -------------------------------- +LET_STRING +PLA +; -------------------------------- +; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4 +; -------------------------------- +PUTSTR LDY #2 ; STRING DATA ALREADY IN STRING AREA? +LDA (FAC+3),Y ; (STRING AREA IS BTWN FRETOP +CMP FRETOP+1 ; HIMEM) +BCC L_PUTSTR_2 ; YES, DATA ALREADY UP THERE +BNE L_PUTSTR_1 ; NO +DEY ; MAYBE, TEST LOW BYTE OF POINTER +LDA (FAC+3),Y ; +CMP FRETOP ; +BCC L_PUTSTR_2 ; YES, ALREADY THERE +L_PUTSTR_1 LDY FAC+4 ; NO. DESCRIPTOR ALREADY AMONG VARIABLES? +CPY VARTAB+1 ; +BCC L_PUTSTR_2 ; NO +BNE L_PUTSTR_3 ; YES +LDA FAC+3 ; MAYBE, COMPARE LO-BYTE +CMP VARTAB ; +BCS L_PUTSTR_3 ; YES, DESCRIPTOR IS AMONG VARIABLES +L_PUTSTR_2 LDA FAC+3 ; EITHER STRING ALREADY ON TOP, OR +LDY FAC+4 ; DESCRIPTOR IS NOT A VARIABLE +JMP L_PUTSTR_4 ; SO JUST STORE THE DESCRIPTOR +; -------------------------------- +; STRING NOT YET IN STRING AREA, +; AND DESCRIPTOR IS A VARIABLE +; -------------------------------- +L_PUTSTR_3 LDY #0 ; POINT AT LENGTH IN DESCRIPTOR +LDA (FAC+3),Y ; GET LENGTH +JSR STRINI ; MAKE A STRING THAT LONG UP ABOVE +LDA DSCPTR ; SET UP SOURCE PNTR FOR MONINS +LDY DSCPTR+1 ; +STA STRNG1 ; +STY STRNG1+1 ; +JSR MOVINS ; MOVE STRING DATA TO NEW AREA +LDA #FAC ; +L_PUTSTR_4 STA DSCPTR ; +STY DSCPTR+1 ; +JSR FRETMS ; DISCARD DESCRIPTOR IF 'TWAS TEMPORARY +LDY #0 ; COPY STRING DESCRIPTOR +LDA (DSCPTR),Y +STA (FORPNT),Y +INY +LDA (DSCPTR),Y +STA (FORPNT),Y +INY +LDA (DSCPTR),Y +STA (FORPNT),Y +RTS +; -------------------------------- +PR_STRING +JSR STRPRT +JSR CHRGOT +; -------------------------------- +; "PRINT" STATEMENT +; -------------------------------- +PRINT BEQ CRDO ; NO MORE LIST, PRINT +; -------------------------------- +PRINT2 BEQ RTS_8 ; NO MORE LIST, DON'T PRINT +CMP #TOKEN_TAB +BEQ PR_TAB_OR_SPC ; C=1 FOR TAB( +CMP #TOKEN_SPC +CLC +BEQ PR_TAB_OR_SPC ; C=0 FOR SPC( +CMP #LOCHAR(`,') +CLC ; <<< NO PURPOSE TO THIS >>> +BEQ PR_COMMA ; +CMP #LOCHAR(`;') +BEQ PR_NEXT_CHAR ; +JSR FRMEVL ; EVALUATE EXPRESSION +BIT VALTYP ; STRING OR FP VALUE? +BMI PR_STRING ; STRING +JSR FOUT ; FP: CONVERT INTO BUFFER +JSR STRLIT ; MAKE BUFFER INTO STRING +JMP PR_STRING ; PRINT THE STRING +; -------------------------------- +CRDO LDA #$0D ; PRINT +JSR OUTDO +NEGATE EOR #$FF ; <<< WHY??? >>> +RTS_8 RTS +; -------------------------------- +; TAB TO NEXT COMMA COLUMN +; <<< NOTE BUG IF WIDTH OF WINDOW LESS THAN 33 >>> +PR_COMMA +LDA MON_CH +CMP #24 ; <<< BUG: IT SHOULD BE 32 >>> +BCC L_PR_COMMA_1 ; NEXT COLUMN, SAME LINE +JSR CRDO ; FIRST COLUMN, NEXT LINT +BNE PR_NEXT_CHAR ; ...ALWAYS +L_PR_COMMA_1 ADC #16 +AND #$F0 ; ROUND TO 16 OR 32 +STA MON_CH +BCC PR_NEXT_CHAR ; ...ALWAYS +; -------------------------------- +PR_TAB_OR_SPC +PHP ; C=0 FOR SPC(, C=1 FOR TAB( +JSR GTBYTC ; GET VALUE +CMP #LOCHAR(`)') ; TRAILING PARENTHESIS +BEQ L_PR_TAB_OR_SPC_1 ; GOOD +JMP SYNERR ; NO, SYNTAX ERROR +L_PR_TAB_OR_SPC_1 PLP ; TAB( OR SPC( +BCC L_PR_TAB_OR_SPC_2 ; SPC( +DEX ; TAB( +TXA ; CALCULATE SPACES NEEDED FOR TAB( +SBC MON_CH +BCC PR_NEXT_CHAR ; ALREADY PAST THAT COLUMN +TAX ; NOW DO A SPC( TO THE SPECIFIED COLUMN +L_PR_TAB_OR_SPC_2 INX +NXSPC DEX +BNE DOSPC ; MORE SPACES TO PRINT +; -------------------------------- +PR_NEXT_CHAR +JSR CHRGET +JMP PRINT2 ; CONTINUE PARSING PRINT LIST +; -------------------------------- +DOSPC JSR OUTSP +BNE NXSPC ; ...ALWAYS +; -------------------------------- +; PRINT STRING AT (Y,A) +STROUT JSR STRLIT ; MAKE (Y,A) PRINTABLE +; -------------------------------- +; PRINT STRING AT (FACMO,FACLO) +; -------------------------------- +STRPRT JSR FREFAC ; GET ADDRESS INTO INDEX, (A)=LENGTH +TAX ; USE X-REG FOR COUNTER +LDY #0 ; USE Y-REG FOR SCANNER +INX ; +L_STRPRT_1 DEX ; +BEQ RTS_8 ; FINISHED +LDA (INDEX),Y ; NEXT CHAR FROM STRING +JSR OUTDO ; PRINT THE CHAR +INY ; +; <<< NEXT THREE LINES ARE USELESS >>> +CMP #$0D ; WAS IT ? +BNE L_STRPRT_1 ; NO +JSR NEGATE ; EOR #$FF WOULD DO IT, BUT WHY? +; <<< ABOVE THREE LINES ARE USELESS >>> +JMP L_STRPRT_1 +; -------------------------------- +OUTSP LDA #LOCHAR(` ') ; PRINT A SPACE +ASM_DATA($2C) ; SKIP OVER NEXT LINE +OUTQUES LDA #LOCHAR(`?') ; PRINT QUESTION MARK +; -------------------------------- +; PRINT CHAR FROM (A) +; +; NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT +; OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED +; BY NORMAL, INVERSE, OR FLASH OR POKE 243,0. +; -------------------------------- +OUTDO ORA #$80 ; PRINT (A) +CMP #$A0 ; CONTROL CHR? +BCC L_OUTDO_1 ; SKIP IF SO +ORA FLASH_BIT ; =$40 FOR FLASH, ELSE $00 +L_OUTDO_1 JSR MON_COUT ; "AND"S WITH $3F (INVERSE), $7F (FLASH) +AND #$7F ; +PHA ; +LDA SPEEDZ ; COMPLEMENT OF SPEED # +JSR MON_WAIT ; SO SPEED=255 BECOMES (A)=1 +PLA +RTS +; -------------------------------- +; INPUT CONVERSION ERROR: ILLEGAL CHARACTER +; IN NUMERIC FIELD. MUST DISTINGUISH +; BETWEEN INPUT, READ, AND GET +; -------------------------------- +INPUTERR +LDA INPUTFLG +BEQ RESPERR ; TAKEN IF INPUT +BMI READERR ; TAKEN IF READ +LDY #$FF ; FROM A GET +BNE ERLIN ; ...ALWAYS +; -------------------------------- +READERR +LDA DATLIN ; TELL WHERE THE "DATA" IS, RATHER +LDY DATLIN+1 ; THAN THE "READ" +; -------------------------------- +ERLIN STA CURLIN +STY CURLIN+1 +JMP SYNERR +; -------------------------------- +INPERR PLA +; -------------------------------- +RESPERR +BIT ERRFLG ; "ON ERR" TURNED ON? +BPL L_RESPERR_1 ; NO, GIVE REENTRY A TRY +LDX #254 ; ERROR CODE = 254 +JMP HANDLERR +L_RESPERR_1 LDA #ERR_REENTRY +JSR STROUT +LDA OLDTEXT ; RE-EXECUTE THE WHOLE INPUT STATEMENT +LDY OLDTEXT+1 +STA TXTPTR +STY TXTPTR+1 +RTS +; -------------------------------- +; "GET" STATEMENT +; -------------------------------- +GET JSR ERRDIR ; ILLEGAL IF IN DIRECT MODE +LDX #<(INPUT_BUFFER+1) ; SIMULATE INPUT +LDY #>(INPUT_BUFFER+1) +LDA #0 +STA INPUT_BUFFER+1 +LDA #$40 ; SET UP INPUTFLG +JSR PROCESS_INPUT_LIST ; <<< CAN SAVE 1 BYTE HERE>>> +RTS ; <<>> +; -------------------------------- +; "INPUT" STATEMENT +; -------------------------------- +INPUT CMP #$22 ; CHECK FOR OPTIONAL PROMPT STRING +BNE L_INPUT_1 ; NO, PRINT "?" PROMPT +JSR STRTXT ; MAKE A PRINTABLE STRING OUT OF IT +LDA #LOCHAR(`;') ; MUST HAVE ; NOW +JSR SYNCHR ; +JSR STRPRT ; PRINT THE STRING +JMP L_INPUT_2 ; +L_INPUT_1 JSR OUTQUES ; NO STRING, PRINT "?" +L_INPUT_2 JSR ERRDIR ; ILLEGAL IF IN DIRECT MODE +LDA #LOCHAR(`,') ; PRIME THE BUFFER +STA INPUT_BUFFER-1 +JSR INLIN +LDA INPUT_BUFFER +CMP #$03 ; CONTROL C? +BNE INPUT_FLAG_ZERO ; NO +JMP CONTROL_C_TYPED +; -------------------------------- +NXIN JSR OUTQUES ; PRINT "?" +JMP INLIN +; -------------------------------- +; "READ" STATEMENT +; -------------------------------- +READ LDX DATPTR ; Y,X POINTS AT NEXT DATA STATEMENT +LDY DATPTR+1 ; +LDA #$98 ; SET INPUTFLG = $98 +ASM_DATA($2C) ; TRICK TO PROCESS.INPUT.LIST +; -------------------------------- +INPUT_FLAG_ZERO LDA #0 ; SET INPUTFLG = $00 +; -------------------------------- +; PROCESS INPUT LIST +; +; (Y,X) IS ADDRESS OF INPUT DATA STRING +; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT +; $40 FOR GET +; $98 FOR READ +; -------------------------------- +PROCESS_INPUT_LIST STA INPUTFLG +STX INPTR ; ADDRESS OF INPUT STRING +STY INPTR+1 +; -------------------------------- +PROCESS_INPUT_ITEM JSR PTRGET ; GET ADDRESS OF VARIABLE +STA FORPNT ; +STY FORPNT+1 ; +LDA TXTPTR ; SAVE CURRENT TXTPTR, +LDY TXTPTR+1 ; WHICH POINTS INTO PROGRAM +STA TXPSV ; +STY TXPSV+1 ; +LDX INPTR ; SET TXTPTR TO POINT AT INPUT BUFFER +LDY INPTR+1 ; OR "DATA" LINE +STX TXTPTR ; +STY TXTPTR+1 ; +JSR CHRGOT ; GET CHAR AT PNTR +BNE INSTART ; NOT END OF LINE OR COLON +BIT INPUTFLG ; DOING A "GET"? +BVC L_PROCESS_INPUT_ITEM_1 ; NO +JSR MON_RDKEY ; YES, GET CHAR +AND #$7F +STA INPUT_BUFFER +LDX #<(INPUT_BUFFER-1) +LDY #>(INPUT_BUFFER-1) +BNE L_PROCESS_INPUT_ITEM_2 ; ...ALWAYS +; -------------------------------- +L_PROCESS_INPUT_ITEM_1 BMI FINDATA ; DOING A "READ" +JSR OUTQUES ; DOING AN "INPUT", PRINT "?" +JSR NXIN ; PRINT ANOTHER "?", AND INPUT A LINE +L_PROCESS_INPUT_ITEM_2 STX TXTPTR +STY TXTPTR+1 +; -------------------------------- +INSTART +JSR CHRGET ; GET NEXT INPUT CHAR +BIT VALTYP ; STRING OR NUMERIC? +BPL L_INSTART_5 ; NUMERIC +BIT INPUTFLG ; STRING -- NOW WHAT INPUT TYPE? +BVC L_INSTART_1 ; NOT A "GET" +INX ; "GET" +STX TXTPTR +LDA #0 +STA CHARAC ; NO OTHER TERMINATORS THAN $00 +BEQ L_INSTART_2 ; ...ALWAYS +; -------------------------------- +L_INSTART_1 STA CHARAC +CMP #$22 ; TERMINATE ON $00 OR QUOTE +BEQ L_INSTART_3 +LDA #LOCHAR(`:') ; TERMINATE ON $00, COLON, OR COMMA +STA CHARAC +LDA #LOCHAR(`,') +L_INSTART_2 CLC +L_INSTART_3 STA ENDCHR +LDA TXTPTR +LDY TXTPTR+1 +ADC #0 ; SKIP OVER QUOTATION MARK, IF +BCC L_INSTART_4 ; THERE WAS ONE +INY +L_INSTART_4 JSR STRLT2 ; BUILD STRING STARTING AT (Y,A) +; TERMINATED BY $00, (CHARAC), OR (ENDCHR) +JSR POINT ; SET TXTPTR TO POINT AT STRING +JSR PUTSTR ; STORE STRING IN VARIABLE +JMP INPUT_MORE +; -------------------------------- +L_INSTART_5 PHA +LDA INPUT_BUFFER ; ANYTHING IN BUFFER? +BEQ INPFIN ; NO, SEE IF READ OR INPUT +; -------------------------------- +INPUTDWTA +PLA ; "READ" +JSR FIN ; GET FP NUMBER AT TXTPTR +LDA VALTYP+1 ; +JSR LET2 ; STORE RESULT IN VARIABLE +; -------------------------------- +INPUT_MORE +JSR CHRGOT +BEQ L_INPUT_MORE_1 ; END OF LINE OR COLON +CMP #LOCHAR(`,') ; COMMA IN INPUT? +BEQ L_INPUT_MORE_1 ; YES +JMP INPUTERR ; NOTHING ELSE WILL DO +L_INPUT_MORE_1 LDA TXTPTR ; SAVE POSITION IN INPUT BUFFER +LDY TXTPTR+1 ; +STA INPTR ; +STY INPTR+1 ; +LDA TXPSV ; RESTORE PROGRAM POINTER +LDY TXPSV+1 ; +STA TXTPTR ; +STY TXTPTR+1 ; +JSR CHRGOT ; NEXT CHAR FROM PROGRAM +BEQ INPDONE ; END OF STATEMENT +JSR CHKCOM ; BETTER BE A COMMA THEN +JMP PROCESS_INPUT_ITEM +; -------------------------------- +INPFIN LDA INPUTFLG ; "INPUT" OR "READ" +BNE INPUTDWTA ; "READ" +JMP INPERR +; -------------------------------- +FINDATA +JSR DATAN ; GET OFFSET TO NEXT COLON OR EOL +INY ; TO FIRST CHAR OF NEXT LINE +TAX ; WHICH: EOL OR COLON? +BNE L_FINDATA_1 ; COLON +LDX #ERR_NODATA ; EOL: MIGHT BE OUT OF DATA +INY ; CHECK HI-BYTE OF FORWARD PNTR +LDA (TXTPTR),Y ; END OF PROGRAM? +BEQ GERR ; YES, WE ARE OUT OF DATA +INY ; PICK UP THE LINE # +LDA (TXTPTR),Y +STA DATLIN +INY +LDA (TXTPTR),Y +INY ; POINT AT FIRST TEXT CHAR IN LINE +STA DATLIN+1 +L_FINDATA_1 LDA (TXTPTR),Y ; GET 1ST TOKEN OF STATEMENT +TAX ; SAVE TOKEN IN X-REG +JSR ADDON ; ADD (Y) TO TXTPTR +CPX #TOKENDWTA ; DID WE FIND A "DATA" STATEMENT? +BNE FINDATA ; NOT YET +JMP INSTART ; YES, READ IT +; ---NO MORE INPUT REQUESTED------ +INPDONE +LDA INPTR ; GET POINTER IN CASE IT WAS "READ" +LDY INPTR+1 +LDX INPUTFLG ; "READ" OR "INPUT"? +BPL L_INPDONE_1 ; "INPUT" +JMP SETDA ; "DATA", SO STORE (Y,X) AT DATPTR +L_INPDONE_1 LDY #0 ; "INPUT": ANY MORE CHARS ON LINE? +LDA (INPTR),Y +BEQ L_INPDONE_2 ; NO, ALL IS WELL +LDA #ERR_EXTRA ; "EXTRA IGNORED" +JMP STROUT +L_INPDONE_2 RTS +; -------------------------------- +ERR_EXTRA LOASCII(`?EXTRA IGNORED') +ASM_DATA($0D,0) + +ERR_REENTRY LOASCII(`?REENTER') +ASM_DATA($0D,0) +; -------------------------------- +; -------------------------------- +; "NEXT" STATEMENT +; -------------------------------- +NEXT BNE NEXT_1 ; VARIABLE AFTER "NEXT" +LDY #0 ; FLAG BY SETTING FORPNT+1 = 0 +BEQ NEXT_2 ; ...ALWAYS +; -------------------------------- +NEXT_1 JSR PTRGET ; GET PNTR TO VARIABLE IN (Y,A) +NEXT_2 STA FORPNT +STY FORPNT+1 +JSR GTFORPNT ; FIND FOR-FRAME FOR THIS VARIABLE +BEQ NEXT_3 ; FOUND IT +LDX #ERR_NOFOR ; NOT THERE, ABORT +GERR BEQ JERROR ; ...ALWAYS +NEXT_3 TXS ; SET STACK PTR TO POINT TO THIS FRAME, +INX ; WHICH TRIMS OFF ANY INNER LOOPS +INX +INX +INX +TXA ; LOW BYTE OF ADRS OF STEP VALUE +INX +INX +INX +INX +INX +INX +STX DEST ; LOW BYTE ADRS OF FOR VAR VALUE +LDY #>STACK ; (Y,A) IS ADDRESS OF STEP VALUE +JSR LOAD_FAC_FROM_YA ; STEP TO FAC +TSX +LDA STACK+9,X +STA FAC_SIGN +LDA FORPNT +LDY FORPNT+1 +JSR FADD ; ADD TO FOR VALUE +JSR SETFOR ; PUT NEW VALUE BACK +LDY #>STACK ; (Y,A) IS ADDRESS OF END VALUE +JSR FCOMP2 ; COMPARE TO END VALUE +TSX +SEC +SBC STACK+9,X ; SIGN OF STEP +BEQ L_NEXT_3_2 ; BRANCH IF FOR COMPLETE +LDA STACK+15,X ; OTHERWISE SET UP +STA CURLIN ; FOR LINE # +LDA STACK+16,X +STA CURLIN+1 +LDA STACK+18,X ; AND SET TXTPTR TO JUST +STA TXTPTR ; AFTER FOR STATEMENT +LDA STACK+17,X +STA TXTPTR+1 +L_NEXT_3_1 JMP NEWSTT +L_NEXT_3_2 TXA ; POP OFF FOR-FRAME, LOOP IS DONE +ADC #17 ; CARRY IS SET, SO ADDS 18 +TAX +TXS +JSR CHRGOT ; CHAR AFTER VARIABLE +CMP #LOCHAR(`,') ; ANOTHER VARIABLE IN NEXT_ +BNE L_NEXT_3_1 ; NO, GO TO NEXT STATEMENT +JSR CHRGET ; YES, PRIME FOR NEXT VARIABLE +JSR NEXT_1 ; (DOES NOT RETURN) +; -------------------------------- +; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC +; -------------------------------- +FRMNUM JSR FRMEVL +; -------------------------------- +; MAKE SURE (FAC) IS NUMERIC +; -------------------------------- +CHKNUM CLC +ASM_DATA($24) ; DUMMY FOR SKIP +; -------------------------------- +; MAKE SURE (FAC) IS STRING +; -------------------------------- +CHKSTR SEC +; -------------------------------- +; MAKE SURE (FAC) IS CORRECT TYPE +; IF C=0, TYPE MUST BE NUMERIC +; IF C=1, TYPE MUST BE STRING +; -------------------------------- +CHKVAL BIT VALTYP ; $00 IF NUMERIC, $FF IF STRING +BMI L_CHKVAL_2 ; TYPE IS STRING +BCS L_CHKVAL_3 ; NOT STRING, BUT WE NEED STRING +L_CHKVAL_1 RTS ; TYPE IS CORRECT +L_CHKVAL_2 BCS L_CHKVAL_1 ; IS STRING AND WE WANTED STRING +L_CHKVAL_3 LDX #ERR_BADTYPE ; TYPE MISMATCH +JERROR JMP ERROR +; -------------------------------- +; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE +; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC +; EXPRESSIONS. +; -------------------------------- +FRMEVL LDX TXTPTR ; DECREMENT TXTPTR +BNE L_FRMEVL_1 +DEC TXTPTR+1 +L_FRMEVL_1 DEC TXTPTR +LDX #0 ; START WITH PRECEDENCE = 0 +ASM_DATA($24) ; TRICK TO SKIP FOLLOWING "PHA" +; -------------------------------- +FRMEVL_1 +PHA ; PUSH RELOPS FLAGS +TXA ; +PHA ; SAVE LAST PRECEDENCE +LDA #1 ; +JSR CHKMEM ; CHECK IF ENOUGH ROOM ON STACK +JSR FRM_ELEMENT ; GET AN ELEMENT +LDA #0 +STA CPRTYP ; CLEAR COMPARISON OPERATOR FLAGS +; -------------------------------- +FRMEVL_2 +JSR CHRGOT ; CHECK FOR RELATIONAL OPERATORS +L_FRMEVL_2_1 SEC ; > IS $CF, = IS $D0, < IS $D1 +SBC #TOKEN_GREATER ; > IS 0, = IS 1, < IS 2 +BCC L_FRMEVL_2_2 ; NOT RELATIONAL OPERATOR +CMP #3 ; +BCS L_FRMEVL_2_2 ; NOT RELATIONAL OPERATOR +CMP #1 ; SET CARRY IF "=" OR "<" +ROL ; NOW > IS 0, = IS 3, < IS 5 +EOR #1 ; NOW > IS 1, = IS 2, < IS 4 +EOR CPRTYP ; SET BITS OF CPRTYP: 00000<=> +CMP CPRTYP ; CHECK FOR ILLEGAL COMBINATIONS +BCC SNTXERR ; IF LESS THAN, A RELOP WAS REPEATED +STA CPRTYP ; +JSR CHRGET ; ANOTHER OPERATOR? +JMP L_FRMEVL_2_1 ; CHECK FOR <,=,> AGAIN +; -------------------------------- +L_FRMEVL_2_2 LDX CPRTYP ; DID WE FIND A RELATIONAL OPERATOR? +BNE FRM_RELATIONAL ; YES +BCS NOTMATH ; NO, AND NEXT TOKEN IS > $D1 +ADC #$CF-TOKEN_PLUS ; NO, AND NEXT TOKEN < $CF +BCC NOTMATH ; IF NEXT TOKEN < "+" +ADC VALTYP ; + AND LAST RESULT A STRING? +BNE L_FRMEVL_2_3 ; BRANCH IF NOT +JMP CAT ; CONCATENATE IF SO. +; -------------------------------- +L_FRMEVL_2_3 ADC #$FF ; +-*/ IS 0123 +STA INDEX +ASL ; MULTIPLY BY 3 +ADC INDEX ; +-*/ IS 0,3,6,9 +TAY +; -------------------------------- +FRM_PRECEDENCE_TEST +PLA ; GET LAST PRECEDENCE +CMP MATHTBL,Y +BCS FRM_PERFORM_1 ; DO NOW IF HIGHER PRECEDENCE +JSR CHKNUM ; WAS LAST RESULT A #? +NXOP PHA ; YES, SAVE PRECEDENCE ON STACK +SAVOP JSR FRM_RECURSE ; SAVE REST, CALL FRMEVL RECURSIVELY +PLA +LDY LASTOP +BPL PREFNC +TAX +BEQ GOEX ; EXIT IF NO MATH IN EXPRESSION +BNE FRM_PERFORM_2 ; ...ALWAYS +; -------------------------------- +; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,> +; -------------------------------- +FRM_RELATIONAL +LSR VALTYP ; (VALTYP) = 0 (NUMERIC), = $FF (STRING) +TXA ; SET CPRTYP TO 0000<=>C +ROL ; WHERE C=0 IF #, C=1 IF STRING +LDX TXTPTR ; BACK UP TXTPTR +BNE L_FRM_RELATIONAL_1 +DEC TXTPTR+1 +L_FRM_RELATIONAL_1 DEC TXTPTR +LDY #M_REL-MATHTBL ; POINT AT RELOPS ENTRY +STA CPRTYP +BNE FRM_PRECEDENCE_TEST ; ...ALWAYS +; -------------------------------- +PREFNC CMP MATHTBL,Y +BCS FRM_PERFORM_2 ; DO NOW IF HIGHER PRECEDENCE +BCC NXOP ; ...ALWAYS +; -------------------------------- +; STACK THIS OPERATION AND CALL FRMEVL FOR +; ANOTHER ONE +; -------------------------------- +FRM_RECURSE +LDA MATHTBL+2,Y +PHA ; PUSH ADDRESS OF OPERATION PERFORMER +LDA MATHTBL+1,Y +PHA +JSR FRM_STACK_1 ; STACK FAC.SIGN AND FAC +LDA CPRTYP ; A=RELOP FLAGS, X=PRECEDENCE BYTE +JMP FRMEVL_1 ; RECURSIVELY CALL FRMEVL +; -------------------------------- +SNTXERR JMP SYNERR +; -------------------------------- +; STACK (FAC) +; +; THREE ENTRY POINTS: +; L_SNTXERR_1, FROM FRMEVL +; L_SNTXERR_2, FROM "STEP" +; L_SNTXERR_3, FROM "FOR" +; -------------------------------- +FRM_STACK_1 +LDA FAC_SIGN ; GET FAC.SIGN TO PUSH IT +; Note: XA65 assembler (Andre Fachat) requires ! here when asm with "xa -R -bt 0" for some reason: +LDX !MATHTBL,Y ; PRECEDENCE BYTE FROM MATHTBL +; -------------------------------- +; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE +; -------------------------------- +FRM_STACK_2 +TAY ; FAC.SIGN OR SGN(STEP VALUE) +PLA ; PULL RETURN ADDRESS AND ADD 1 +STA INDEX ; <<< ASSUMES NOT ON PAGE BOUNDARY! >>> +INC INDEX ; PLACE BUMPED RETURN ADDRESS IN +PLA ; INDEX,INDEX+1 +STA INDEX+1 ; +TYA ; FAC.SIGN OR SGN(STEP VALUE) +PHA ; PUSH FAC.SIGN OR SGN(STEP VALUE) +; -------------------------------- +; ENTER HERE FROM "FOR", WITH (INDEX) = STEP, +; TO PUSH INITIAL VALUE OF "FOR" VARIABLE +; -------------------------------- +FRM_STACK_3 +JSR ROUND_FAC ; ROUND TO 32 BITS +LDA FAC+4 ; PUSH (FAC) +PHA +LDA FAC+3 +PHA +LDA FAC+2 +PHA +LDA FAC+1 +PHA +LDA FAC +PHA +JMP (INDEX) ; DO RTS FUNNY WAY +; -------------------------------- +; +; -------------------------------- +NOTMATH LDY #$FF ; SET UP TO EXIT ROUTINE +PLA +GOEX BEQ EXIT ; EXIT IF NO MATH TO DO +; -------------------------------- +; PERFORM STACKED OPERATION +; +; (A) = PRECEDENCE BYTE +; STACK: 1 -- CPRMASK +; 5 -- (ARG) +; 2 -- ADDR OF PERFORMER +; -------------------------------- +FRM_PERFORM_1 +CMP #P_REL ; WAS IT RELATIONAL OPERATOR? +BEQ L_FRM_PERFORM_1_1 ; YES, ALLOW STRING COMPARE +JSR CHKNUM ; MUST BE NUMERIC VALUE +L_FRM_PERFORM_1_1 STY LASTOP ; +; -------------------------------- +FRM_PERFORM_2 ; +PLA ; GET 0000<=>C FROM STACK +LSR ; SHIFT TO 00000<=> FORM +STA CPRMASK ; 00000<=> +PLA ; +STA ARG ; GET FLOATING POINT VALUE OFF STACK, +PLA ; AND PUT IT IN ARG +STA ARG+1 ; +PLA ; +STA ARG+2 ; +PLA ; +STA ARG+3 ; +PLA ; +STA ARG+4 ; +PLA ; +STA ARG+5 ; +EOR FAC_SIGN ; SAVE EOR OF SIGNS OF THE OPERANDS, +STA SGNCPR ; IN CASE OF MULTIPLY OR DIVIDE +EXIT LDA FAC ; FAC EXPONENT IN A-REG +RTS ; STATUS EQU. IF (FAC)=0 +; RTS GOES TO PERFORM OPERATION +; -------------------------------- +; GET ELEMENT IN EXPRESSION +; +; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT +; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC. +; -------------------------------- +FRM_ELEMENT ; +LDA #0 ; ASSUME NUMERIC +STA VALTYP ; +L_FRM_ELEMENT_1 JSR CHRGET ; +BCS L_FRM_ELEMENT_3 ; NOT A DIGIT +L_FRM_ELEMENT_2 JMP FIN ; NUMERIC CONSTANT +L_FRM_ELEMENT_3 JSR ISLETC ; VARIABLE NAME? +BCS FRM_VARIABLE ; YES +CMP #LOCHAR(`.') ; DECIMAL POINT +BEQ L_FRM_ELEMENT_2 ; YES, NUMERIC CONSTANT +CMP #TOKEN_MINUS ; UNARY MINUS? +BEQ MIN ; YES +CMP #TOKEN_PLUS ; UNARY PLUS +BEQ L_FRM_ELEMENT_1 ; YES +CMP #$22 ; STRING CONSTANT? +BNE NOT_ ; NO +; -------------------------------- +; STRING CONSTANT ELEMENT +; +; SET Y,A = (TXTPTR)+CARRY +; -------------------------------- +STRTXT LDA TXTPTR ; ADD (CARRY) TO GET ADDRESS OF 1ST CHAR +LDY TXTPTR+1 ; OF STRING IN Y,A +ADC #0 ; +BCC L_STRTXT_1 ; +INY ; +L_STRTXT_1 JSR STRLIT ; BUILD DESCRIPTOR TO STRING +; GET ADDRESS OF DESCRIPTOR IN FAC +JMP POINT ; POINT TXTPTR AFTER TRAILING QUOTE +; -------------------------------- +; "NOT" FUNCTION +; IF FAC=0, RETURN FAC=1 +; IF FAC<>0, RETURN FAC=0 +; -------------------------------- +NOT_ CMP #TOKEN_NOT +BNE FN_ ; NOT "NOT", TRY "FN" +LDY #MEQUU-MATHTBL ; POINT AT = COMPARISON +BNE EQUL ; ...ALWAYS +; -------------------------------- +; COMPARISON FOR EQUALITY (= OPERATOR) +; ALSO USED TO EVALUATE "NOT" FUNCTION +; -------------------------------- +EQUOP LDA FAC ; SET "TRUE" IF (FAC) = ZERO +BNE L_EQUOP_1 ; FALSE +LDY #1 ; TRUE +ASM_DATA($2C) ; TRICK TO SKIP NEXT 2 BYTES +L_EQUOP_1 LDY #0 ; FALSE +JMP SNGFLT ; +; -------------------------------- +FN_ CMP #TOKEN_FN +BNE SGN_ +JMP FUNCT +; -------------------------------- +SGN_ CMP #TOKEN_SGN +BCC PARCHK +JMP UNARY +; -------------------------------- +; EVALUATE "(EXPRESSION)" +; -------------------------------- +PARCHK JSR CHKOPN ; IS THERE A '(' AT TXTPTR? +JSR FRMEVL ; YES, EVALUATE EXPRESSION +; -------------------------------- +CHKCLS LDA #$29 ; CHECK FOR ')' +ASM_DATA($2C) ; TRICK +; -------------------------------- +CHKOPN LDA #$28 ; +ASM_DATA($2C) ; TRICK +; -------------------------------- +CHKCOM LDA #LOCHAR(`,') ; COMMA AT TXTPTR? +; -------------------------------- +; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR +; -------------------------------- +SYNCHR LDY #0 +CMP (TXTPTR),Y +BNE SYNERR +JMP CHRGET ; MATCH, GET NEXT CHAR & RETURN +; -------------------------------- +SYNERR LDX #ERR_SYNTAX +JMP ERROR +; -------------------------------- +MIN LDY #M_NEG-MATHTBL ; POINT AT UNARY MINUS +EQUL PLA +PLA +JMP SAVOP +; -------------------------------- +FRM_VARIABLE +JSR PTRGET +FRM_VARIABLE_CALL = *-1 ; SO PTRGET CAN TELL WE CALLED +STA VPNT ; ADDRESS OF VARIABLE +STY VPNT+1 ; +LDX VALTYP ; NUMERIC OR STRING? +BEQ L_FRM_VARIABLE_CALL_1 ; NUMERIC +LDX #0 ; STRING +STX STRNG1+1 ; +RTS ; +L_FRM_VARIABLE_CALL_1 LDX VALTYP+1 ; NUMERIC, WHICH TYPE? +BPL L_FRM_VARIABLE_CALL_2 ; FLOATING POINT +LDY #0 ; INTEGER +LDA (VPNT),Y ; +TAX ; GET VALUE IN A,Y +INY ; +LDA (VPNT),Y ; +TAY ; +TXA ; +JMP GIVAYF ; CONVERT A,Y TO FLOATING POINT +L_FRM_VARIABLE_CALL_2 JMP LOAD_FAC_FROM_YA +; -------------------------------- +; -------------------------------- +; "SCRN(" FUNCTION +; -------------------------------- +SCREEN JSR CHRGET +JSR PLOTFNS ; GET COLUMN AND ROW +TXA ; ROW +LDY FIRST ; COLUMN +JSR MON_SCRN ; GET 4-BIT COLOR THERE +TAY ; +JSR SNGFLT ; CONVERT (Y) TO REAL IN FAC +JMP CHKCLS ; REQUIRE ")" +; -------------------------------- +; PROCESS UNARY OPERATORS (FUNCTIONS) +; -------------------------------- +UNARY CMP #TOKEN_SCRN ; NOT UNARY, DO SPECIAL +BEQ SCREEN +ASL ; DOUBLE TOKEN TO GET INDEX +PHA +TAX +JSR CHRGET +CPX #<(TOKEN_LEFTSTR*2-1) ; LEFT$, RIGHT$, AND MID$ +BCC L_UNARY_1 ; NOT ONE OF THE STRING FUNCTIONS +JSR CHKOPN ; STRING FUNCTION, NEED "(" +JSR FRMEVL ; EVALUATE EXPRESSION FOR STRING +JSR CHKCOM ; REQUIRE A COMMA +JSR CHKSTR ; MAKE SURE EXPRESSION IS A STRING +PLA ; +TAX ; RETRIEVE ROUTINE POINTER +LDA VPNT+1 ; STACK ADDRESS OF STRING +PHA ; +LDA VPNT ; +PHA ; +TXA ; +PHA ; STACK DOUBLED TOKEN +JSR GETBYT ; CONVERT NEXT EXPRESSION TO BYTE IN X-REG +PLA ; GET DOUBLED TOKEN OFF STACK +TAY ; USE AS INDEX TO BRANCH +TXA ; VALUE OF SECOND PARAMETER +PHA ; PUSH 2ND PARAM +JMP L_UNARY_2 ; JOIN UNARY FUNCTIONS +L_UNARY_1 JSR PARCHK ; REQUIRE "(EXPRESSION)" +PLA +TAY ; INDEX INTO FUNCTION ADDRESS TABLE +L_UNARY_2 LDA UNFNC-TOKEN_SGN-TOKEN_SGN+$100,Y +STA JMPADRS+1 ; PREPARE TO JSR TO ADDRESS +LDA UNFNC-TOKEN_SGN-TOKEN_SGN+$101,Y +STA JMPADRS+2 +JSR JMPADRS ; DOES NOT RETURN FOR +; CHR$, LEFT$, RIGHT$, OR MID$ +JMP CHKNUM ; REQUIRE NUMERIC RESULT +; -------------------------------- +OR LDA ARG ; "OR" OPERATOR +ORA FAC ; IF RESULT NONZERO, IT IS TRUE +BNE TRUE ; +; -------------------------------- +ANDOP LDA ARG ; "AND" OPERATOR +BEQ FALSE ; IF EITHER IS ZERO, RESULT IS FALSE +LDA FAC ; +BNE TRUE ; +; -------------------------------- +FALSE LDY #0 ; RETURN FAC=0 +ASM_DATA($2C) ; TRICK +; -------------------------------- +TRUE LDY #1 ; RETURN FAC=1 +JMP SNGFLT ; +; -------------------------------- +; PERFORM RELATIONAL OPERATIONS +; -------------------------------- +RELOPS JSR CHKVAL ; MAKE SURE FAC IS CORRECT TYPE +BCS STRCMP ; TYPE MATCHES, BRANCH IF STRINGS +LDA ARG_SIGN ; NUMERIC COMPARISON +ORA #$7F ; RE-PACK VALUE IN ARG FOR FCOMP +AND ARG+1 ; +STA ARG+1 ; +LDA #ARG ; +JSR FCOMP ; RETURN A-REG = -1,0,1 +TAX ; AS ARG <,=,> FAC +JMP NUMCMP ; +; -------------------------------- +; STRING COMPARISON +; -------------------------------- +STRCMP LDA #0 ; SET RESULT TYPE TO NUMERIC +STA VALTYP ; +DEC CPRTYP ; MAKE CPRTYP 0000<=>0 +JSR FREFAC ; +STA FAC ; STRING LENGTH +STX FAC+1 +STY FAC+2 +LDA ARG+3 +LDY ARG+4 +JSR FRETMP +STX ARG+3 +STY ARG+4 +TAX ; LEN (ARG) STRING +SEC ; +SBC FAC ; SET X TO SMALLER LEN +BEQ L_STRCMP_1 ; +LDA #1 ; +BCC L_STRCMP_1 ; +LDX FAC ; +LDA #$FF ; +L_STRCMP_1 STA FAC_SIGN ; FLAG WHICH SHORTER +LDY #$FF ; +INX ; +STRCMP_1 ; +INY ; +DEX ; +BNE STRCMP_2 ; MORE CHARS IN BOTH STRINGS +LDX FAC_SIGN ; IF = SO FAR, DECIDE BY LENGTH +; -------------------------------- +NUMCMP BMI CMPDONE ; +CLC ; +BCC CMPDONE ; ...ALWAYS +; -------------------------------- +STRCMP_2 ; +LDA (ARG+3),Y ; +CMP (FAC+1),Y ; +BEQ STRCMP_1 ; SAME, KEEP COMPARING +LDX #$FF ; IN CASE ARG GREATER +BCS CMPDONE ; IT IS +LDX #1 ; FAC GREATER +; -------------------------------- +CMPDONE ; +INX ; CONVERT FF,0,1 TO 0,1,2 +TXA ; +ROL ; AND TO 0,2,4 IF C=0, ELSE 1,2,5 +AND CPRMASK ; 00000<=> +BEQ L_CMPDONE_1 ; IF NO MATCH: FALSE +LDA #1 ; AT LEAST ONE MATCH: TRUE +L_CMPDONE_1 JMP FLOAT ; +; -------------------------------- +; "PDL" FUNCTION +; <<< NOTE: ARG<4 IS NOT CHECKED >>> +; -------------------------------- +PDL JSR CONINT ; GET # IN X +JSR MON_PREAD ; READ PADDLE +JMP SNGFLT ; FLOAT RESULT +; -------------------------------- +; "DIM" STATEMENT +; -------------------------------- +NXDIM JSR CHKCOM ; SEPARATED BY COMMAS +DIM TAX ; NON-ZERO, FLAGS PTRGET DIM CALLED +JSR PTRGET2 ; ALLOCATE THE ARRAY +JSR CHRGOT ; NEXT CHAR +BNE NXDIM ; NOT END OF STATEMENT +RTS ; +; -------------------------------- +; PTRGET -- GENERAL VARIABLE SCAN +; +; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE +; VARTAB AND ARYTAB FOR THE NAME. +; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE. +; RETURN WITH ADDRESS IN VARPNT AND Y,A +; +; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS: +; DIMFLG -- NONZERO IF CALLED FROM "DIM" +; ELSE = 0 +; +; SUBFLG -- = $00 +; = $40 IF CALLED FROM "GETARYPT" +; = $80 IF CALLED FROM "DEF FN" +; = $C1-DA IF CALLED FROM "FN" +; -------------------------------- +PTRGET LDX #0 ; +JSR CHRGOT ; GET FIRST CHAR OF VARIABLE NAME +; -------------------------------- +PTRGET2 ; +STX DIMFLG ; X IS NONZERO IF FROM DIM +; -------------------------------- +PTRGET3 ; +STA VARNAM ; +JSR CHRGOT ; +JSR ISLETC ; IS IT A LETTER? +BCS NAMOK ; YES, OKAY SO FAR +BADNAM JMP SYNERR ; NO, SYNTAX ERROR +NAMOK LDX #0 ; +STX VALTYP ; +STX VALTYP+1 ; +JMP PTRGET4 ; TO BRANCH ACROSS $E000 VECTORS +; -------------------------------- +; DOS AND MONITOR CALL BASIC AT $E000 AND $E003 +; -------------------------------- +BASIC JMP COLD_START +BASIC2 JMP RESTART +BRK ; <<< WASTED BYTE >>> +; -------------------------------- +PTRGET4 +JSR CHRGET ; SECOND CHAR OF VARIABLE NAME +BCC L_PTRGET4_1 ; NUMERIC +JSR ISLETC ; LETTER? +BCC L_PTRGET4_3 ; NO, END OF NAME +L_PTRGET4_1 TAX ; SAVE SECOND CHAR OF NAME IN X +L_PTRGET4_2 JSR CHRGET ; SCAN TO END OF VARIABLE NAME +BCC L_PTRGET4_2 ; NUMERIC +JSR ISLETC ; +BCS L_PTRGET4_2 ; ALPHA +L_PTRGET4_3 CMP #LOCHAR(`$') ; STRING? +BNE L_PTRGET4_4 ; NO +LDA #$FF ; +STA VALTYP ; +BNE L_PTRGET4_5 ; ...ALWAYS +L_PTRGET4_4 CMP #LOCHAR(`%') ; INTEGER? +BNE L_PTRGET4_6 ; NO +LDA SUBFLG ; YES; INTEGER VARIABLE ALLOWED? +BMI BADNAM ; NO, SYNTAX ERROR +LDA #$80 ; YES +STA VALTYP+1 ; FLAG INTEGER MODE +ORA VARNAM ; +STA VARNAM ; SET SIGN BIT ON VARNAME +L_PTRGET4_5 TXA ; SECOND CHAR OF NAME +ORA #$80 ; SET SIGN +TAX ; +JSR CHRGET ; GET TERMINATING CHAR +L_PTRGET4_6 STX VARNAM+1 ; STORE SECOND CHAR OF NAME +SEC ; +ORA SUBFLG ; $00 OR $40 IF SUBSCRIPTS OK, ELSE $80 +SBC #$28 ; IF SUBFLG=$00 AND CHAR="("... +BNE L_PTRGET4_8 ; NOPE +L_PTRGET4_7 JMP ARRAY ; YES +L_PTRGET4_8 BIT SUBFLG ; CHECK TOP TWO BITS OF SUBFLG +BMI L_PTRGET4_9 ; $80 +BVS L_PTRGET4_7 ; $40, CALLED FROM GETARYPT +L_PTRGET4_9 LDA #0 ; CLEAR SUBFLG +STA SUBFLG ; +LDA VARTAB ; START LOWTR AT SIMPLE VARIABLE TABLE +LDX VARTAB+1 ; +LDY #0 ; +L_PTRGET4_10 STX LOWTR+1 ; +L_PTRGET4_11 STA LOWTR ; +CPX ARYTAB+1 ; END OF SIMPLE VARIABLES? +BNE L_PTRGET4_12 ; NO, GO ON +CMP ARYTAB ; YES; END OF ARRAYS? +BEQ NAME_NOT_FOUND ; YES, MAKE ONE +L_PTRGET4_12 LDA VARNAM ; SAME FIRST LETTER? +CMP (LOWTR),Y ; +BNE L_PTRGET4_13 ; NOT SAME FIRST LETTER +LDA VARNAM+1 ; SAME SECOND LETTER? +INY +CMP (LOWTR),Y +BEQ SET_VARPNT_AND_YA ; YES, SAME VARIABLE NAME +DEY ; NO, BUMP TO NEXT NAME +L_PTRGET4_13 CLC +LDA LOWTR +ADC #7 +BCC L_PTRGET4_11 +INX +BNE L_PTRGET4_10 ; ...ALWAYS +; -------------------------------- +; CHECK IF (A) IS ASCII LETTER A-Z +; +; RETURN CARRY = 1 IF A-Z +; = 0 IF NOT +; +; <<>> +; <<< CMP #LOCHAR(`Z')+1 COMPARE HI END +; <<< BCS L_PTRGET4_1 ABOVE A-Z +; <<< CMP #LOCHAR(`A') COMPARE LO END +; <<< RTS C=0 IF LO, C=1 IF A-Z +; <<FRM_VARIABLE_CALL +BNE MAKE_NEW_VARIABLE ; NO +LDA #C_ZERO ; POINT TO A CONSTANT ZERO +RTS ; NEW VARIABLE USED IN EXPRESSION = 0 +; -------------------------------- +C_ZERO ASM_DATA(00,00) ; INTEGER OR REAL ZERO, OR NULL STRING +; -------------------------------- +; MAKE A NEW SIMPLE VARIABLE +; +; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE +; ENTER 7-BYTE VARIABLE DATA IN THE HOLE +; -------------------------------- +MAKE_NEW_VARIABLE +LDA ARYTAB ; SET UP CALL TO BLTU TO +LDY ARYTAB+1 ; TO MOVE FROM ARYTAB THRU STREND-1 +STA LOWTR ; 7 BYTES HIGHER +STY LOWTR+1 ; +LDA STREND ; +LDY STREND+1 ; +STA HIGHTR ; +STY HIGHTR+1 ; +CLC ; +ADC #7 ; +BCC L_MAKE_NEW_VARIABLE_1 ; +INY ; +L_MAKE_NEW_VARIABLE_1 STA ARYPNT ; +STY ARYPNT+1 ; +JSR BLTU ; MOVE ARRAY BLOCK UP +LDA ARYPNT ; STORE NEW START OF ARRAYS +LDY ARYPNT+1 ; +INY ; +STA ARYTAB ; +STY ARYTAB+1 ; +LDY #0 ; +LDA VARNAM ; FIRST CHAR OF NAME +STA (LOWTR),Y ; +INY ; +LDA VARNAM+1 ; SECOND CHAR OF NAME +STA (LOWTR),Y ; +LDA #0 ; SET FIVE-BYTE VALUE TO 0 +INY ; +STA (LOWTR),Y ; +INY ; +STA (LOWTR),Y ; +INY ; +STA (LOWTR),Y ; +INY ; +STA (LOWTR),Y ; +INY ; +STA (LOWTR),Y ; +; -------------------------------- +; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A +; -------------------------------- +SET_VARPNT_AND_YA ; +LDA LOWTR ; LOWTR POINTS AT NAME OF VARIABLE, +CLC ; SO ADD 2 TO GET TO VALUE +ADC #2 ; +LDY LOWTR+1 ; +BCC L_SET_VARPNT_AND_YA_1 ; +INY ; +L_SET_VARPNT_AND_YA_1 STA VARPNT ; ADDRESS IN VARPNT AND Y,A +STY VARPNT+1 ; +RTS ; +; -------------------------------- +; COMPUTE ADDRESS OF FIRST VALUE IN ARRAY +; ARYPNT = (LOWTR) + #DIMS*2 + 5 +; -------------------------------- +GETARY LDA NUMDIM ; GET # OF DIMENSIONS +; -------------------------------- +GETARY2 ; +ASL ; #DIMS*2 (SIZE OF EACH DIM IN 2 BYTES) +ADC #5 ; + 5 (2 FOR NAME, 2 FOR OFFSET TO NEXT +; ARRAY, AND 1 FOR #DIMS +ADC LOWTR ; ADDRESS OF TH IS ARRAY IN ARYTAB +LDY LOWTR+1 ; +BCC L_GETARY2_1 ; +INY ; +L_GETARY2_1 STA ARYPNT ; ADDRESS OF FIRST VALUE IN ARRAY +STY ARYPNT+1 ; +RTS ; +; -------------------------------- + +NEG32768 ASM_DATA($90,$80,$00,$00) ; -32768.00049 IN FLOATING POINT +; <<< MEANT TO BE -32768, WHICH WOULD BE 9080000000 >>> +; <<< 1 BYTE SHORT, SO PICKS UP $20 FROM NEXT INSTRUCTION +; -------------------------------- +; EVALUATE NUMERIC FORMULA AT TXTPTR +; CONVERTING RESULT TO INTEGER 0 <= X <= 32767 +; IN FAC+3,4 +; -------------------------------- +MAKINT JSR CHRGET +JSR FRMNUM +; -------------------------------- +; CONVERT FAC TO INTEGER +; MUST BE POSITIVE AND LESS THAN 32768 +; -------------------------------- +MKINT LDA FAC_SIGN ; ERROR IF - +BMI MI1 +; -------------------------------- +; CONVERT FAC TO INTEGER +; MUST BE -32767 <= FAC <= 32767 +; -------------------------------- +AYINT LDA FAC ; EXPONENT OF VALUE IN FAC +CMP #$90 ; ABS(VALUE) < 32768? +BCC MI2 ; YES, OK FOR INTEGER +LDA #NEG32768 ; ALLOW -32768 ($8000), BUT DO NOT! +JSR FCOMP ; BECAUSE COMPARED TO -32768.00049 +; <<< BUG: A=-32768.00049:A%=A IS ACCEPTED >>> +; <<< BUT PRINT A,A% SHOWS THAT >>> +; <<< A=-32768.0005 (OK), A%=32767 >>> +; <<< WRONG! WRONG! WRONG! >>> +; -------------------------------- +MI1 BNE IQERR ; ILLEGAL QUANTITY +MI2 JMP QINT ; CONVERT TO INTEGER +; -------------------------------- +; LOCATE ARRAY ELEMENT OR CREATE AN ARRAY +; -------------------------------- +ARRAY LDA SUBFLG ; SUBSCRIPTS GIVEN? +BNE L_ARRAY_2 ; NO +; -------------------------------- +; PARSE THE SUBSCRIPT LIST +; -------------------------------- +LDA DIMFLG ; YES +ORA VALTYP+1 ; SET HIGH BIT IF % +PHA ; SAVE VALTYP AND DIMFLG ON STACK +LDA VALTYP ; +PHA ; +LDY #0 ; COUNT # DIMENSIONS IN Y-REG +L_ARRAY_1 TYA ; SAVE #DIMS ON STACK +PHA ; +LDA VARNAM+1 ; SAVE VARIABLE NAME ON STACK +PHA ; +LDA VARNAM ; +PHA ; +JSR MAKINT ; EVALUATE SUBSCRIPT AS INTEGER +PLA ; RESTORE VARIABLE NAME +STA VARNAM ; +PLA ; +STA VARNAM+1 ; +PLA ; RESTORE # DIMS TO Y-REG +TAY ; +TSX ; COPY VALTYP AND DIMFLG ON STACK +LDA STACK+2,X ; TO LEAVE ROOM FOR THE SUBSCRIPT +PHA ; +LDA STACK+1,X ; +PHA ; +LDA FAC+3 ; GET SUBSCRIPT VALUE AND PLACE IN THE +STA STACK+2,X ; STACK WHERE VALTYP & DIMFLG WERE +LDA FAC+4 ; +STA STACK+1,X ; +INY ; COUNT THE SUBSCRIPT +JSR CHRGOT ; NEXT CHAR +CMP #LOCHAR(`,') ; +BEQ L_ARRAY_1 ; COMMA, PARSE ANOTHER SUBSCRIPT +STY NUMDIM ; NO MORE SUBSCRIPTS, SAVE # +JSR CHKCLS ; NOW NEED ")" +PLA ; RESTORE VALTYPE AND DIMFLG +STA VALTYP ; +PLA ; +STA VALTYP+1 ; +AND #$7F ; ISOLATE DIMFLG +STA DIMFLG ; +; -------------------------------- +; SEARCH ARRAY TABLE FOR THIS ARRAY NAME +; -------------------------------- +L_ARRAY_2 LDX ARYTAB ; (A,X) = START OF ARRAY TABLE +LDA ARYTAB+1 ; +L_ARRAY_3 STX LOWTR ; USE LOWTR FOR RUNNING POINTER +STA LOWTR+1 ; +CMP STREND+1 ; DID WE REACH THE END OF ARRAYS YET? +BNE L_ARRAY_4 ; NO, KEEP SEARCHING +CPX STREND ; +BEQ MAKE_NEW_ARRAY ; YES, THIS IS A NEW ARRAY NAME +L_ARRAY_4 LDY #0 ; POINT AT 1ST CHAR OF ARRAY NAME +LDA (LOWTR),Y ; GET 1ST CHAR OF NAME +INY ; POINT AT 2ND CHAR +CMP VARNAM ; 1ST CHAR SAME? +BNE L_ARRAY_5 ; NO, MOVE TO NEXT ARRAY +LDA VARNAM+1 ; YES, TRY 2ND CHAR +CMP (LOWTR),Y ; SAME? +BEQ USE_OLD_ARRAY ; YES, ARRAY FOUND +L_ARRAY_5 INY ; POINT AT OFFSET TO NEXT ARRAY +LDA (LOWTR),Y ; ADD OFFSET TO RUNNING POINTER +CLC +ADC LOWTR +TAX +INY +LDA (LOWTR),Y +ADC LOWTR+1 +BCC L_ARRAY_3 ; ...ALWAYS +; -------------------------------- +; ERROR: BAD SUBSCRIPTS +; -------------------------------- +SUBERR LDX #ERR_BADSUBS +ASM_DATA($2C) ; TRICK TO SKIP NEXT LINE +; -------------------------------- +; ERROR: ILLEGAL QUANTITY +; -------------------------------- +IQERR LDX #ERR_ILLQTY +JER JMP ERROR +; -------------------------------- +; FOUND THE ARRAY +; -------------------------------- +USE_OLD_ARRAY +LDX #ERR_REDIMD ; SET UP FOR REDIM'D ARRAY ERROR +LDA DIMFLG ; CALLED FROM "DIM" STATEMENT? +BNE JER ; YES, ERROR +LDA SUBFLG ; NO, CHECK IF ANY SUBSCRIPTS +BEQ L_USE_OLD_ARRAY_1 ; YES, NEED TO CHECK THE NUMBER +SEC ; NO, SIGNAL ARRAY FOUND +RTS +; -------------------------------- +L_USE_OLD_ARRAY_1 JSR GETARY ; SET (ARYPNT) = ADDR OF FIRST ELEMENT +LDA NUMDIM ; COMPARE NUMBER OF DIMENSIONS +LDY #4 +CMP (LOWTR),Y +BNE SUBERR ; NOT SAME, SUBSCRIPT ERROR +JMP FIND_ARRAY_ELEMENT +; -------------------------------- +; -------------------------------- +; CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT +; -------------------------------- +MAKE_NEW_ARRAY +LDA SUBFLG ; CALLED FROM GETARYPT? +BEQ L_MAKE_NEW_ARRAY_1 ; NO +LDX #ERR_NODATA ; YES, GIVE "OUT OF DATA" ERROR +JMP ERROR +L_MAKE_NEW_ARRAY_1 JSR GETARY ; PUT ADDR OF 1ST ELEMENT IN ARYPNT +JSR REASON ; MAKE SURE ENOUGH MEMORY LEFT +; -------------------------------- +; <<< NEXT 3 LINES COULD BE WRITTEN: >>> +; LDY #0 +; STY STRNG2+1 +; -------------------------------- +LDA #0 ; POINT Y-REG AT VARIABLE NAME SLOT +TAY ; +STA STRNG2+1 ; START SIZE COMPUTATION +LDX #5 ; ASSUME 5-BYTES PER ELEMENT +LDA VARNAM ; STUFF VARIABLE NAME IN ARRAY +STA (LOWTR),Y ; +BPL L_MAKE_NEW_ARRAY_2 ; NOT INTEGER ARRAY +DEX ; INTEGER ARRAY, DECR. SIZE TO 4-BYTES +L_MAKE_NEW_ARRAY_2 INY ; POINT Y-REG AT NEXT CHAR OF NAME +LDA VARNAM+1 ; REST OF ARRAY NAME +STA (LOWTR),Y ; +BPL L_MAKE_NEW_ARRAY_3 ; REAL ARRAY, STICK WITH SIZE = 5 BYTES +DEX ; INTEGER OR STRING ARRAY, ADJUST SIZE +DEX ; TO INTEGER=3, STRING=2 BYTES +L_MAKE_NEW_ARRAY_3 STX STRNG2 ; STORE LOW-BYTE OF ARRAY ELEMENT SIZE +LDA NUMDIM ; STORE NUMBER OF DIMENSIONS +INY ; IN 5TH BYTE OF ARRAY +INY ; +INY ; +STA (LOWTR),Y ; +L_MAKE_NEW_ARRAY_4 LDX #11 ; DEFAULT DIMENSION = 11 ELEMENTS +LDA #0 ; FOR HI-BYTE OF DIMENSION IF DEFAULT +BIT DIMFLG ; DIMENSIONED ARRAY? +BVC L_MAKE_NEW_ARRAY_5 ; NO, USE DEFAULT VALUE +PLA ; GET SPECIFIED DIM IN A,X +CLC ; # ELEMENTS IS 1 LARGER THAN +ADC #1 ; DIMENSION VALUE +TAX ; +PLA ; +ADC #0 ; +L_MAKE_NEW_ARRAY_5 INY ; ADD THIS DIMENSION TO ARRAY DESCRIPTOR +STA (LOWTR),Y +INY +TXA +STA (LOWTR),Y +JSR MULTIPLY_SUBSCRIPT ; MULTIPLY THIS +; DIMENSION BY RUNNING SIZE +; ((LOWTR)) * (STRNG2) --> A,X +STX STRNG2 ; STORE RUNNING SIZE IN STRNG2 +STA STRNG2+1 ; +LDY INDEX ; RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT +DEC NUMDIM ; COUNT DOWN # DIMS +BNE L_MAKE_NEW_ARRAY_4 ; LOOP TILL DONE +; -------------------------------- +; NOW A,X HAS TOTAL # BYTES OF ARRAY ELEMENTS +; -------------------------------- +ADC ARYPNT+1 ; COMPUTE ADDRESS OF END OF THIS ARRAY +BCS GME ; ...TOO LARGE, ERROR +STA ARYPNT+1 ; +TAY ; +TXA ; +ADC ARYPNT ; +BCC L_MAKE_NEW_ARRAY_6 ; +INY ; +BEQ GME ; ...TOO LARGE, ERROR +L_MAKE_NEW_ARRAY_6 JSR REASON ; MAKE SURE THERE IS ROOM UP TO Y,A +STA STREND ; THERE IS ROOM SO SAVE NEW END OF TABLE +STY STREND+1 ; AND ZERO THE ARRAY +LDA #0 ; +INC STRNG2+1 ; PREPARE FOR FAST ZEROING LOOP +LDY STRNG2 ; # BYTES MOD 256 +BEQ L_MAKE_NEW_ARRAY_8 ; FULL PAGE +L_MAKE_NEW_ARRAY_7 DEY ; CLEAR PAGE FULL +STA (ARYPNT),Y +BNE L_MAKE_NEW_ARRAY_7 +L_MAKE_NEW_ARRAY_8 DEC ARYPNT+1 ; POINT TO NEXT PAGE +DEC STRNG2+1 ; COUNT THE PAGES +BNE L_MAKE_NEW_ARRAY_7 ; STILL MORE TO CLEAR +INC ARYPNT+1 ; RECOVER LAST DEC, POINT AT 1ST ELEMENT +SEC ; +LDA STREND ; COMPUTE OFFSET TO END OF ARRAYS +SBC LOWTR ; AND STORE IN ARRAY DESCRIPTOR +LDY #2 ; +STA (LOWTR),Y ; +LDA STREND+1 ; +INY ; +SBC LOWTR+1 ; +STA (LOWTR),Y ; +LDA DIMFLG ; WAS THIS CALLED FROM "DIM" STATEMENT? +BNE RTS_9 ; YES, WE ARE FINISHED +INY ; NO, NOW NEED TO FIND THE ELEMENT +; -------------------------------- +; FIND SPECIFIED ARRAY ELEMENT +; +; (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR +; THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS +; -------------------------------- +FIND_ARRAY_ELEMENT +LDA (LOWTR),Y ; GET # OF DIMENSIONS +STA NUMDIM ; +LDA #0 ; ZERO SUBSCRIPT ACCUMULATOR +STA STRNG2 ; +FAE_1 STA STRNG2+1 ; +INY ; +PLA ; PULL NEXT SUBSCRIPT FROM STACK +TAX ; SAVE IN FAC+3,4 +STA FAC+3 ; AND COMPARE WITH DIMENSIONED SIZE +PLA ; +STA FAC+4 ; +CMP (LOWTR),Y ; +BCC FAE_2 ; SUBSCRIPT NOT TOO LARGE +BNE GSE ; SUBSCRIPT IS TOO LARGE +INY ; CHECK LOW-BYTE OF SUBSCRIPT +TXA ; +CMP (LOWTR),Y ; +BCC FAE_3 ; NOT TOO LARGE +; -------------------------------- +GSE JMP SUBERR ; BAD SUBSCRIPTS ERROR +GME JMP MEMERR ; MEM FULL ERROR +; -------------------------------- +FAE_2 INY ; BUMP POINTER INTO DESCRIPTOR +FAE_3 LDA STRNG2+1 ; BYPASS MULTIPLICATION IF VALUE SO +ORA STRNG2 ; FAR = 0 +CLC ; +BEQ L_FAE_3_1 ; IT IS ZERO SO FAR +JSR MULTIPLY_SUBSCRIPT ; NOT ZERO, SO MULTIPLY +TXA ; ADD CURRENT SUBSCRIPT +ADC FAC+3 ; +TAX ; +TYA ; +LDY INDEX ; RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT +L_FAE_3_1 ADC FAC+4 ; FINISH ADDING CURRENT SUBSCRIPT +STX STRNG2 ; STORE ACCUMULATED OFFSET +DEC NUMDIM ; LAST SUBSCRIPT YET? +BNE FAE_1 ; NO, LOOP TILL DONE +STA STRNG2+1 ; YES, NOW MULTIPLY BE ELEMENT SIZE +LDX #5 ; START WITH SIZE = 5 +LDA VARNAM ; DETERMINE VARIABLE TYPE +BPL L_FAE_3_2 ; NOT INTEGER +DEX ; INTEGER, BACK DOWN SIZE TO 4 BYTES +L_FAE_3_2 LDA VARNAM+1 ; DISCRIMINATE BETWEEN REAL AND STR +BPL L_FAE_3_3 ; IT IS REAL +DEX ; SIZE = 3 IF STRING, =2 IF INTEGER +DEX ; +L_FAE_3_3 STX RESULT+2 ; SET UP MULTIPLIER +LDA #0 ; HI-BYTE OF MULTIPLIER +JSR MULTIPLY_SUBS_1 ; (STRNG2) BY ELEMENT SIZE +TXA ; ADD ACCUMULATED OFFSET +ADC ARYPNT ; TO ADDRESS OF 1ST ELEMENT +STA VARPNT ; TO GET ADDRESS OF SPECIFIED ELEMENT +TYA ; +ADC ARYPNT+1 ; +STA VARPNT+1 ; +TAY ; RETURN WITH ADDR IN VARPNT +LDA VARPNT ; AND IN Y,A +RTS_9 RTS ; +; -------------------------------- +; MULTIPLY (STRNG2) BY ((LOWTR),Y) +; LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.) +; USED ONLY BY ARRAY SUBSCRIPT ROUTINES +; -------------------------------- +MULTIPLY_SUBSCRIPT +STY INDEX ; SAVE Y-REG +LDA (LOWTR),Y ; GET MULTIPLIER +STA RESULT+2 ; SAVE IN RESULT+2,3 +DEY ; +LDA (LOWTR),Y ; +; -------------------------------- +MULTIPLY_SUBS_1 ; +STA RESULT+3 ; LOW BYTE OF MULTIPLIER +LDA #16 ; MULTIPLY 16 BITS +STA INDX ; +LDX #0 ; PRODUCT = 0 INITIALLY +LDY #0 ; +L_MULTIPLY_SUBS_1_1 TXA ; DOUBLE PRODUCT +ASL ; LOW BYTE +TAX ; +TYA ; HIGH BYTE +ROL ; IF TOO LARGE, SET CARRY +TAY ; +BCS GME ; TOO LARGE, "MEM FULL ERROR" +ASL STRNG2 ; NEXT BIT OF MUTLPLICAND +ROL STRNG2+1 ; INTO CARRY +BCC L_MULTIPLY_SUBS_1_2 ; BIT=0, DON'T NEED TO ADD +CLC ; BIT=1, ADD INTO PARTIAL PRODUCT +TXA ; +ADC RESULT+2 ; +TAX ; +TYA ; +ADC RESULT+3 ; +TAY ; +BCS GME ; TOO LARGE, "MEM FULL ERROR" +L_MULTIPLY_SUBS_1_2 DEC INDX ; 16-BITS YET? +BNE L_MULTIPLY_SUBS_1_1 ; NO, KEEP SHUFFLING +RTS ; YES, PRODUCT IN Y,X AND A,X +; -------------------------------- +; "FRE" FUNCTION +; +; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT +; -------------------------------- +FRE LDA VALTYP ; LOOK AT VALUE OF ARGUMENT +BEQ L_FRE_1 ; =0 MEANS REAL, =$FF MEANS STRING +JSR FREFAC ; STRING, SO SET IT FREE IS TEMP +L_FRE_1 JSR GARBAG ; COLLECT ALL THE GARBAGE IN SIGHT +SEC ; COMPUTE SPACE BETWEEN ARRAYS AND +LDA FRETOP ; STRING TEMP AREA +SBC STREND ; +TAY ; +LDA FRETOP+1 ; +SBC STREND+1 ; FREE SPACE IN Y,A +; FALL INTO GIVAYF TO FLOAT THE VALUE +; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE +; -------------------------------- +; FLOAT THE SIGNED INTEGER IN A,Y +; -------------------------------- +GIVAYF LDX #0 ; MARK FAC VALUE TYPE REAL +STX VALTYP ; +STA FAC+1 ; SAVE VALUE FROM A,Y IN MANTISSA +STY FAC+2 ; +LDX #$90 ; SET EXPONENT TO 2^16 +JMP FLOAT_1 ; CONVERT TO SIGNED FP +; -------------------------------- +; "POS" FUNCTION +; +; RETURNS CURRENT LINE POSITION FROM MON.CH +; -------------------------------- +POS LDY MON_CH ; GET A,Y = (MON.CH, GO TO GIVAYF +; -------------------------------- +; FLOAT (Y) INTO FAC, GIVING VALUE 0-255 +; -------------------------------- +SNGFLT LDA #0 ; MSB = 0 +SEC ; <<< NO PURPOSE WHATSOEVER >>> +BEQ GIVAYF ; ...ALWAYS +; -------------------------------- +; CHECK FOR DIRECT OR RUNNING MODE +; GIVING ERROR IF DIRECT MODE +; -------------------------------- +ERRDIR LDX CURLIN+1 ; =$FF IF DIRECT MODE +INX ; MAKES $FF INTO ZERO +BNE RTS_9 ; RETURN IF RUNNING MODE +LDX #ERR_ILLDIR ; DIRECT MODE, GIVE ERROR +ASM_DATA($2C) ; TRICK TO SKIP NEXT 2 BYTES +; -------------------------------- +UNDFNC LDX #ERR_UNDEFFUNC ; UNDEFINDED FUNCTION ERROR +JMP ERROR +; -------------------------------- +; "DEF" STATEMENT +; -------------------------------- +DEF JSR FNC_ ; PARSE "FN", FUNCTION NAME +JSR ERRDIR ; ERROR IF IN DIRECT MODE +JSR CHKOPN ; NEED "(" +LDA #$80 ; FLAG PTRGET THAT CALLED FROM "DEF FN" +STA SUBFLG ; ALLOW ONLY SIMPLE FP VARIABLE FOR ARG +JSR PTRGET ; GET PNTR TO ARGUMENT +JSR CHKNUM ; MUST BE NUMERIC +JSR CHKCLS ; MUST HAVE ")" NOW +LDA #TOKENEQUUAL ; NOW NEED "=" +JSR SYNCHR ; OR ELSE SYNTAX ERROR +PHA ; SAVE CHAR AFTER "=" +LDA VARPNT+1 ; SAVE PNTR TO ARGUMENT +PHA +LDA VARPNT +PHA +LDA TXTPTR+1 ; SAVE TXTPTR +PHA +LDA TXTPTR +PHA +JSR DATA ; SCAN TO NEXT STATEMENT +JMP FNCDATA ; STORE ABOVE 5 BYTES IN "VALUE" +; -------------------------------- +; COMMON ROUTINE FOR "DEFFN" AND "FN", TO +; PARSE "FN" AND THE FUNCTION NAME +; -------------------------------- +FNC_ LDA #TOKEN_FN ; MUST NOW SEE "FN" TOKEN +JSR SYNCHR ; OR ELSE SYNTAX ERROR +ORA #$80 ; SET SIGN BIT ON 1ST CHAR OF NAME, +STA SUBFLG ; MAKING $C0 < SUBFLG < $DB +JSR PTRGET3 ; WHICH TELLS PTRGET WHO CALLED +STA FNCNAM ; FOUND VALID FUNCTION NAME, SO +STY FNCNAM+1 ; SAVE ADDRESS +JMP CHKNUM ; MUST BE NUMERIC +; -------------------------------- +; "FN" FUNCTION CALL +; -------------------------------- +FUNCT JSR FNC_ ; PARSE "FN", FUNCTION NAME +LDA FNCNAM+1 ; STACK FUNCTION ADDRESS +PHA ; IN CASE OF A NESTED FN CALL +LDA FNCNAM ; +PHA ; +JSR PARCHK ; MUST NOW HAVE "(EXPRESSION)" +JSR CHKNUM ; MUST BE NUMERIC EXPRESSION +PLA ; GET FUNCTION ADDRESS BACK +STA FNCNAM ; +PLA ; +STA FNCNAM+1 ; +LDY #2 ; POINT AT ADD OF ARGUMENT VARIABLE +LDA (FNCNAM),Y +STA VARPNT +TAX +INY +LDA (FNCNAM),Y +BEQ UNDFNC ; UNDEFINED FUNCTION +STA VARPNT+1 +INY ; Y=4 NOW +L_FUNCT_1 LDA (VARPNT),Y ; SAVE OLD VALUE OF ARGUMENT VARIABLE +PHA ; ON STACK, IN CASE ALSO USED AS +DEY ; A NORMAL VARIABLE! +BPL L_FUNCT_1 +LDY VARPNT+1 ; (Y,X)= ADDRESS, STORE FAC IN VARIABLE +JSR STORE_FACDB_YX_ROUNDED +LDA TXTPTR+1 ; REMEMBER TXTPTR AFTER FN CALL +PHA +LDA TXTPTR +PHA +LDA (FNCNAM),Y ; Y=0 FROM MOVMF +STA TXTPTR ; POINT TO FUNCTION DEF'N +INY +LDA (FNCNAM),Y +STA TXTPTR+1 +LDA VARPNT+1 ; SAVE ADDRESS OF ARGUMENT VARIABLE +PHA ; +LDA VARPNT ; +PHA ; +JSR FRMNUM ; EVALUATE THE FUNCTION EXPRESSION +PLA ; GET ADDRESS OF ARGUMENT VARIABLE +STA FNCNAM ; AND SAVE IT +PLA ; +STA FNCNAM+1 ; +JSR CHRGOT ; MUST BE AT ":" OR EOL +BEQ L_FUNCT_2 ; WE ARE +JMP SYNERR ; WE ARE NOT, SLYNTAX ERROR +L_FUNCT_2 PLA ; RETRIEVE TXTPTR AFTER "FN" CALL +STA TXTPTR +PLA +STA TXTPTR+1 +; STACK NOW HAS 5-BYTE VALUE +; OF THE ARGUMENT VARIABLE, +; AND FNCNAM POINTS AT THE VARIABLE +; -------------------------------- +; STORE FIVE BYTES FROM STACK AT (FNCNAM) +; -------------------------------- +FNCDATA +LDY #0 +PLA +STA (FNCNAM),Y +PLA +INY +STA (FNCNAM),Y +PLA +INY +STA (FNCNAM),Y +PLA +INY +STA (FNCNAM),Y +PLA +INY +STA (FNCNAM),Y +RTS +; -------------------------------- +; "STR$" FUNCTION +; -------------------------------- +STR JSR CHKNUM ; EXPRESSION MUST BE NUMERIC +LDY #0 ; START STRING AT STACK-1 ($00FF) +; SO STRLIT CAN DIFFRENTIATE STR$ CALLS +JSR FOUT_1 ; CONVERT FAC TO STRING +PLA ; POP RETURN OFF STACK +PLA ; +LDA #STACK-1 ; (WHICH=0) +BEQ STRLIT ; ...ALWAYS, CREATE DESC & MOVE STRING +; -------------------------------- +; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE +; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG +; -------------------------------- +STRINI LDX FAC+3 ; Y,X = STRING ADDRESS +LDY FAC+4 ; +STX DSCPTR ; +STY DSCPTR+1 ; +; -------------------------------- +; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE +; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG +; -------------------------------- +STRSPA JSR GETSPA ; A HOLDS LENGTH +STX FAC+1 ; SAVE DESCRIPTOR IN FAC +STY FAC+2 ; ---FAC--- --FAC+1-- --FAC+2-- +STA FAC ; +RTS ; +; -------------------------------- +; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A +; AND TERMINATED BY $00 OR QUOTATION MARK +; RETURN WITH DESCRIPTOR IN A TEMPORARY +; AND ADDRESS OF DESCRIPTOR IN FAC+3,4 +; -------------------------------- +STRLIT LDX #$22 ; SET UP LITERAL SCAN TO STOP ON +STX CHARAC ; QUOTATION MARK OR $00 +STX ENDCHR ; +; -------------------------------- +; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A +; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR) +; +; RETURN WITH DESCRIPTOR IN A TEMPORARY +; AND ADDRESS OF DESCRIPTOR IN FAC+3,4 +; -------------------------------- +STRLT2 STA STRNG1 ; SAVE ADDRESS OF STRING +STY STRNG1+1 ; +STA FAC+1 ; ...AGAIN +STY FAC+2 ; +LDY #$FF ; +L_STRLT2_1 INY ; FIND END OF STRING +LDA (STRNG1),Y ; NEXT STRING CHAR +BEQ L_STRLT2_3 ; END OF STRING +CMP CHARAC ; ALTERNATE TERMINATOR # 1? +BEQ L_STRLT2_2 ; YES +CMP ENDCHR ; ALTERNATE TERMINATOR # 2? +BNE L_STRLT2_1 ; NO, KEEP SCANNING +L_STRLT2_2 CMP #$22 ; IS STRING ENDED WITH QUOTE MARK? +BEQ L_STRLT2_4 ; YES, C=1 TO INCLUDE " IN STRING +L_STRLT2_3 CLC ; +L_STRLT2_4 STY FAC ; SAVE LENGTH +TYA ; +ADC STRNG1 ; COMPUTE ADDRESS OF END OF STRING +STA STRNG2 ; (OF 00 BYTE, OR JUST AFTER ") +LDX STRNG1+1 ; +BCC L_STRLT2_5 ; +INX ; +L_STRLT2_5 STX STRNG2+1 ; +LDA STRNG1+1 ; WHERE DOES THE STRING START? +BEQ L_STRLT2_6 ; PAGE 0, MUST BE FROM STR$ FUNCTION +CMP #2 ; PAGE 2? +BNE PUTNEW ; NO, NOT PAGE 0 OR 2 +L_STRLT2_6 TYA ; LENGTH OF STRING +JSR STRINI ; MAKE SPACE FOR STRING +LDX STRNG1 ; +LDY STRNG1+1 ; +JSR MOVSTR ; MOVE IT IN +; -------------------------------- +; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK +; +; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2 +; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4 +; -------------------------------- +PUTNEW LDX TEMPPT ; POINTER TO NEXT TEMP STRING SLOT +CPX #TEMPST+9 ; MAX OF 3 TEMP STRINGS +BNE PUTEMP ; ROOM FOR ANOTHER ONE +LDX #ERR_FRMCPX ; TOO MANY, FORMULA TOO COMPLEX +JERR JMP ERROR +; -------------------------------- +PUTEMP LDA FAC ; COPY TEMP DESCRIPTOR INTO TEMP STACK +STA 0,X +LDA FAC+1 +STA 1,X +LDA FAC+2 +STA 2,X +LDY #0 +STX FAC+3 ; ADDRESS OF TEMP DESCRIPTOR +STY FAC+4 ; IN Y,X AND FAC+3,4 +DEY ; Y=$FF +STY VALTYP ; FLAG (FAC ) AS STRING +STX LASTPT ; INDEX OF LAST POINTER +INX ; UPDATE FOR NEXT TEMP ENTRY +INX +INX +STX TEMPPT +RTS +; -------------------------------- +; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE +; (A)=# BYTES SPACE TO MAKE +; +; RETURN WITH (A) SAME, +; AND Y,X = ADDRESS OF SPACE ALLOCATED +; -------------------------------- +GETSPA LSR GARFLG ; CLEAR SIGNBIT OF FLAG +L_GETSPA_1 PHA ; A HOLDS LENGTH +EOR #$FF ; GET -LENGTH +SEC ; +ADC FRETOP ; COMPUTE STARTING ADDRESS OF SPACE +LDY FRETOP+1 ; FOR THE STRING +BCS L_GETSPA_2 ; +DEY ; +L_GETSPA_2 CPY STREND+1 ; SEE IF FITS IN REMAINING MEMORY +BCC L_GETSPA_4 ; NO, TRY GARBAGE +BNE L_GETSPA_3 ; YES, IT FITS +CMP STREND ; HAVE TO CHECK LOWER BYTES +BCC L_GETSPA_4 ; NOT ENUF ROOM YET +L_GETSPA_3 STA FRETOP ; THERE IS ROOM SO SAVE NEW FRETOP +STY FRETOP+1 ; +STA FRESPC ; +STY FRESPC+1 ; +TAX ; ADDR IN Y,X +PLA ; LENGTH IN A +RTS +L_GETSPA_4 LDX #ERR_MEMFULL +LDA GARFLG ; GARBAGE DONE YET? +BMI JERR ; YES, MEMORY IS REALLY FULL +JSR GARBAG ; NO, TRY COLLECTING NOW +LDA #$80 ; FLAG THAT COLLECTED GARBAGE ALREADY +STA GARFLG ; +PLA ; GET STRING LENGTH AGAIN +BNE L_GETSPA_1 ; ...ALWAYS +; -------------------------------- +; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE +; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE +; BELOW STRING AREA DOWN TO STREND. +; -------------------------------- +GARBAG LDX MEMSIZ ; COLLECT FROM TOP DOWN +LDA MEMSIZ+1 ; +FIND_HIGHEST_STRING ; +STX FRETOP ; ONE PASS THROUGH ALL VARS +STA FRETOP+1 ; FOR EACH ACTIVE STRING! +LDY #0 ; +STY FNCNAM+1 ; FLAG IN CASE NO STRINGS TO COLLECT +LDA STREND ; +LDX STREND+1 ; +STA LOWTR ; +STX LOWTR+1 ; +; -------------------------------- +; START BY COLLECTING TEMPORARIES +; -------------------------------- +LDA #TEMPST ; +STA INDEX ; +STX INDEX+1 ; +L_FIND_HIGHEST_STRING_1 CMP TEMPPT ; FINISHED WITH TEMPS YET? +BEQ L_FIND_HIGHEST_STRING_2 ; YES, NOW DO SIMPLE VARIABLES +JSR CHECK_VARIABLE ; DO A TEMP +BEQ L_FIND_HIGHEST_STRING_1 ; ...ALWAYS +; -------------------------------- +; NOW COLLECT SIMPLE VARIABLES +; -------------------------------- +L_FIND_HIGHEST_STRING_2 LDA #7 ; LENGTH OF EACH VARIABLE IS 7 BYTES +STA DSCLEN ; +LDA VARTAB ; START AT BEGINNING OF VARTAB +LDX VARTAB+1 +STA INDEX +STX INDEX+1 +L_FIND_HIGHEST_STRING_3 CPX ARYTAB+1 ; FINISHED WITH SIMPLE VARIABLES? +BNE L_FIND_HIGHEST_STRING_4 ; NO +CMP ARYTAB ; MAYBE, CHECK LO-BYTE +BEQ L_FIND_HIGHEST_STRING_5 ; YES, NOW DO ARRAYS +L_FIND_HIGHEST_STRING_4 JSR CHECK_SIMPLE_VARIABLE +BEQ L_FIND_HIGHEST_STRING_3 ; ...ALWAYS +; -------------------------------- +; NOW COLLECT ARRAY VARIABLES +; -------------------------------- +L_FIND_HIGHEST_STRING_5 STA ARYPNT +STX ARYPNT+1 +LDA #3 ; DESCRIPTORS IN ARRAYS ARE 3-BYTES EACH +STA DSCLEN ; +L_FIND_HIGHEST_STRING_6 LDA ARYPNT ; COMPARE TO END OF ARRAYS +LDX ARYPNT+1 ; +L_FIND_HIGHEST_STRING_7 CPX STREND+1 ; FINISHED WITH ARRAYS YET? +BNE L_FIND_HIGHEST_STRING_8 ; NOT YET +CMP STREND ; MAYBE, CHECK LO-BYTE +BNE L_FIND_HIGHEST_STRING_8 ; NOT FINISHED YET +JMP MOVE_HIGHEST_STRING_TO_TOP ; FINISHED +L_FIND_HIGHEST_STRING_8 STA INDEX ; SET UP PNTR TO START OF ARRAY +STX INDEX+1 ; +LDY #0 ; POINT AT NAME OF ARRAY +LDA (INDEX),Y ; +TAX ; 1ST LETTER OF NAME IN X-REG +INY ; +LDA (INDEX),Y ; +PHP ; STATUS FROM SECOND LETTER OF NAME +INY ; +LDA (INDEX),Y ; OFFSET TO NEXT ARRAY +ADC ARYPNT ; (CARRY ALWAYS CLEAR) +STA ARYPNT ; CALCULATE START OF NEXT ARRAY +INY ; +LDA (INDEX),Y ; HI-BYTE OF OFFSET +ADC ARYPNT+1 ; +STA ARYPNT+1 ; +PLP ; GET STATUS FROM 2ND CHAR OF NAME +BPL L_FIND_HIGHEST_STRING_6 ; NOT A STRING ARRAY +TXA ; SET STATUS WITH 1ST CHAR OF NAME +BMI L_FIND_HIGHEST_STRING_6 ; NOT A STRING ARRAY +INY ; +LDA (INDEX),Y ; # OF DIMENSIONS FOR THIS ARRAY +LDY #0 ; +ASL ; PREAMBLE SIZE = 2*#DIMS + 5 +ADC #5 ; +ADC INDEX ; MAKE INDEX POINT AT FIRST ELEMENT +STA INDEX ; IN THE ARRAY +BCC L_FIND_HIGHEST_STRING_9 ; +INC INDEX+1 ; +L_FIND_HIGHEST_STRING_9 ; +LDX INDEX+1 ; STEP THRU EACH STRING IN THIS ARRAY +L_FIND_HIGHEST_STRING_10 CPX ARYPNT+1 ; ARRAY DONE? +BNE L_FIND_HIGHEST_STRING_11 ; NO, PROCESS NEXT ELEMENT +CMP ARYPNT ; MAYBE, CHECK LO-BYTE +BEQ L_FIND_HIGHEST_STRING_7 ; YES, MOVE TO NEXT ARRAY +L_FIND_HIGHEST_STRING_11 JSR CHECK_VARIABLE ; PROCESS THE ARRAY +BEQ L_FIND_HIGHEST_STRING_10 ; ...ALWAYS +; -------------------------------- +; PROCESS A SIMPLE VARIABLE +; -------------------------------- +CHECK_SIMPLE_VARIABLE +LDA (INDEX),Y ; LOOK AT 1ST CHAR OF NAME +BMI CHECK_BUMP ; NOT A STRING VARIABLE +INY ; +LDA (INDEX),Y ; LOOK AT 2ND CHAR OF NAME +BPL CHECK_BUMP ; NOT A STRING VARIABLE +INY ; +; -------------------------------- +; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST +; -------------------------------- +CHECK_VARIABLE ; +LDA (INDEX),Y ; GET LENGTH OF STRING +BEQ CHECK_BUMP ; IGNORE STRING IF LENGTH IS ZERO +INY ; +LDA (INDEX),Y ; GET ADDRESS OF STRING +TAX ; +INY ; +LDA (INDEX),Y ; +CMP FRETOP+1 ; CHECK IF ALREADY COLLECTED +BCC L_CHECK_VARIABLE_1 ; NO, BELOW FRETOP +BNE CHECK_BUMP ; YES, ABOVE FRETOP +CPX FRETOP ; MAYBE, CHECK LO-BYTE +BCS CHECK_BUMP ; YES, ABOVE FRETOP +L_CHECK_VARIABLE_1 CMP LOWTR+1 ; ABOVE HIGHEST STRING FOUND? +BCC CHECK_BUMP ; NO, IGNORE FOR NOW +BNE L_CHECK_VARIABLE_2 ; YES, THIS IS THE NEW HIGHEST +CPX LOWTR ; MAYBE, TRY LO-BYTE +BCC CHECK_BUMP ; NO, IGNORE FOR NOW +L_CHECK_VARIABLE_2 STX LOWTR ; MAKE THIS THE HIGHEST STRING +STA LOWTR+1 +LDA INDEX ; SAVE ADDRESS OF DESCRIPTOR TOO +LDX INDEX+1 +STA FNCNAM +STX FNCNAM+1 +LDA DSCLEN +STA LENGTH +; -------------------------------- +; ADD (DSCLEN) TO PNTR IN INDEX +; RETURN WITH Y=0, PNTR ALSO IN X,A +; -------------------------------- +CHECK_BUMP +LDA DSCLEN ; BUMP TO NEXT VARIABLE +CLC +ADC INDEX +STA INDEX +BCC CHECK_EXIT +INC INDEX+1 +; -------------------------------- +CHECK_EXIT +LDX INDEX+1 +LDY #0 +RTS +; -------------------------------- +; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT +; TO TOP AND GO BACK FOR ANOTHER +; -------------------------------- +MOVE_HIGHEST_STRING_TO_TOP +LDX FNCNAM+1 ; ANY STRING FOUND? +BEQ CHECK_EXIT ; NO, RETURN +LDA LENGTH ; GET LENGTH OF VARIABLE ELEMENT +AND #4 ; WAS 7 OR 3, MAKE 4 OR 0 +LSR ; 2 0R 0; IN SIMPLE VARIABLES, +TAY ; NAME PRECEDES DESCRIPTOR +STA LENGTH ; 2 OR 0 +LDA (FNCNAM),Y ; GET LENGTH FROM DESCRIPTOR +ADC LOWTR ; CARRY ALREADY CLEARED BY LSR +STA HIGHTR ; STRING IS BTWN (LOWTR) AND (HIGHTR) +LDA LOWTR+1 ; +ADC #0 ; +STA HIGHTR+1 ; +LDA FRETOP ; HIGH END DESTINATION +LDX FRETOP+1 ; +STA HIGHDS ; +STX HIGHDS+1 ; +JSR BLTU2 ; MOVE STRING UP +LDY LENGTH ; FIX ITS DESCRIPTOR +INY ; POINT AT ADDRESS IN DESCRIPTOR +LDA HIGHDS ; STORE NEW ADDRESS +STA (FNCNAM),Y +TAX +INC HIGHDS+1 ; CORRECT BLTU'S OVERSHOOT +LDA HIGHDS+1 +INY +STA (FNCNAM),Y +JMP FIND_HIGHEST_STRING +; -------------------------------- +; -------------------------------- +; CONCATENATE TWO STRINGS +; -------------------------------- +CAT LDA FAC+4 ; SAVE ADDRESS OF FIRST DESCRIPTOR +PHA +LDA FAC+3 +PHA +JSR FRM_ELEMENT ; GET SECOND STRING ELEMENT +JSR CHKSTR ; MUST BE A STRING +PLA ; RECOVER ADDRES OF 1ST DESCRIPTOR +STA STRNG1 +PLA +STA STRNG1+1 +LDY #0 +LDA (STRNG1),Y ; ADD LENGTHS, GET CONCATENATED SIZE +CLC +ADC (FAC+3),Y +BCC L_CAT_1 ; OK IF < $100 +LDX #ERR_STRLONG +JMP ERROR +L_CAT_1 JSR STRINI ; GET SPACE FOR CONCATENATED STRINGS +JSR MOVINS ; MOVE 1ST STRING +LDA DSCPTR ; +LDY DSCPTR+1 ; +JSR FRETMP ; +JSR MOVSTR_1 ; MOVE 2ND STRING +LDA STRNG1 ; +LDY STRNG1+1 ; +JSR FRETMP ; +JSR PUTNEW ; SET UP DESCRIPTOR +JMP FRMEVL_2 ; FINISH EXPRESSION +; -------------------------------- +; GET STRING DESCRIPTOR POINTED AT BY (STRNG1) +; AND MOVE DESCRIBED STRING TO (FRESPC) +; -------------------------------- +MOVINS LDY #0 +LDA (STRNG1),Y +PHA ; LENGTH +INY +LDA (STRNG1),Y +TAX ; PUT STRING POINTER IN X,Y +INY +LDA (STRNG1),Y +TAY +PLA ; RETRIEVE LENGTH +; -------------------------------- +; MOVE STRING AT (Y,X) WITH LENGTH (A) +; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1 +; -------------------------------- +MOVSTR STX INDEX ; PUT POINTER IN INDEX +STY INDEX+1 ; +MOVSTR_1 ; +TAY ; LENGTH TO Y-REG +BEQ L_MOVSTR_1_2 ; IF LENGTH IS ZERO, FINISHED +PHA ; SAVE LENGTH ON STACK +L_MOVSTR_1_1 DEY ; MOVE BYTES FROM (INDEX) TO (FRESPC) +LDA (INDEX),Y +STA (FRESPC),Y +TYA ; TEST IF ANY LEFT TO MOVE +BNE L_MOVSTR_1_1 ; YES, KEEP MOVING +PLA ; NO, FINISHED. GET LENGTH +L_MOVSTR_1_2 CLC ; AND ADD TO FRESPC, SO +ADC FRESPC ; FRESPC POINTS TO NEXT HIGHER +STA FRESPC ; BYTE. (USED BY CONCATENATION) +BCC L_MOVSTR_1_3 +INC FRESPC+1 +L_MOVSTR_1_3 RTS +; -------------------------------- +; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR +; -------------------------------- +FRESTR JSR CHKSTR ; LAST RESULT A STRING? +; -------------------------------- +; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS +; A TEMPORARY STRING, RELEASE IT. +; -------------------------------- +FREFAC LDA FAC+3 ; GET DESCRIPTOR POINTER +LDY FAC+4 +; -------------------------------- +; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS +; A TEMPORARY STRING, RELEASE IT. +; -------------------------------- +FRETMP STA INDEX ; SAVE THE ADDRESS OF THE DESCRIPTOR +STY INDEX+1 ; +JSR FRETMS ; FREE DESCRIPTOR IF IT IS TEMPORARY +PHP ; REMEMBER IF TEMP +LDY #0 ; POINT AT LENGTH OF STRING +LDA (INDEX),Y ; +PHA ; SAVE LENGTH ON STACK +INY ; +LDA (INDEX),Y ; +TAX ; GET ADDRESS OF STRING IN Y,X +INY ; +LDA (INDEX),Y ; +TAY ; +PLA ; LENGTH IN A +PLP ; RETRIEVE STATUS, Z=1 IF TEMP +BNE L_FRETMP_2 ; NOT A TEMPORARY STRING +CPY FRETOP+1 ; IS IT THE LOWEST STRING? +BNE L_FRETMP_2 ; NO +CPX FRETOP ; +BNE L_FRETMP_2 ; NO +PHA ; YES, PUSH LENGTH AGAIN +CLC ; RECOVER THE SPACE USED BY +ADC FRETOP ; THE STRING +STA FRETOP ; +BCC L_FRETMP_1 ; +INC FRETOP+1 ; +L_FRETMP_1 PLA ; RETRIEVE LENGTH AGAIN +L_FRETMP_2 STX INDEX ; ADDRESS OF STRING IN Y,X +STY INDEX+1 ; LENGTH OF STRING IN A-REG +RTS ; +; -------------------------------- +; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT +; -------------------------------- +FRETMS CPY LASTPT+1 ; COMPARE Y,A TO LATEST TEMP +BNE L_FRETMS_1 ; NOT SAME ONE, CANNOT RELEASE +CMP LASTPT ; +BNE L_FRETMS_1 ; NOT SAME ONE, CANNOT RELEASE +STA TEMPPT ; UPDATE TEMPT FOR NEXT TEMP +SBC #3 ; BACK OFF LASTPT +STA LASTPT ; +LDY #0 ; NOW Y,A POINTS TO TOP TEMP +L_FRETMS_1 RTS ; Z=0 IF NOT TEMP, Z=1 IF TEMP +; -------------------------------- +; "CHR$" FUNCTION +; -------------------------------- +CHRSTR JSR CONINT ; CONVERT ARGUMENT TO BYTE IN X +TXA ; +PHA ; SAVE IT +LDA #1 ; GET SPACE FOR STRING OF LENGTH 1 +JSR STRSPA ; +PLA ; RECALL THE CHARACTER +LDY #0 ; PUT IN STRING +STA (FAC+1),Y ; +PLA ; POP RETURN ADDRESS +PLA ; +JMP PUTNEW ; MAKE IT A TEMPORARY STRING +; -------------------------------- +; "LEFT$" FUNCTION +; -------------------------------- +LEFTSTR +JSR SUBSTRING_SETUP +CMP (DSCPTR),Y ; COMPARE 1ST PARAMETER TO LENGTH +TYA ; Y=A=0 +SUBSTRING_1 ; +BCC L_SUBSTRING_1_1 ; 1ST PARAMETER SMALLER, USE IT +LDA (DSCPTR),Y ; 1ST IS LONGER, USE STRING LENGTH +TAX ; IN X-REG +TYA ; Y=A=0 AGAIN +L_SUBSTRING_1_1 PHA ; PUSH LEFT END OF SUBSTRING +SUBSTRING_2 ; +TXA ; +SUBSTRING_3 ; +PHA ; PUSH LENGTH OF SUBSTRING +JSR STRSPA ; MAKE ROOM FOR STRING OF (A) BYTES +LDA DSCPTR ; RELEASE PARAMETER STRING IF TEMP +LDY DSCPTR+1 ; +JSR FRETMP ; +PLA ; GET LENGTH OF SUBSTRING +TAY ; IN Y-REG +PLA ; GET LEFT END OF SUBSTRING +CLC ; ADD TO POINTER TO STRING +ADC INDEX ; +STA INDEX ; +BCC L_SUBSTRING_3_1 ; +INC INDEX+1 ; +L_SUBSTRING_3_1 TYA ; LENGTH +JSR MOVSTR_1 ; COPY STRING INTO SPACE +JMP PUTNEW ; ADD TO TEMPS +; -------------------------------- +; "RIGHT$" FUNCTION +; -------------------------------- +RIGHTSTR +JSR SUBSTRING_SETUP +CLC ; COMPUTE LENGTH-WIDTH OF SUBSTRING +SBC (DSCPTR),Y ; TO GET STARTING POINT IN STRING +EOR #$FF +JMP SUBSTRING_1 ; JOIN LEFT$ +; -------------------------------- +; "MID$" FUNCTION +; -------------------------------- +MIDSTR LDA #$FF ; FLAG WHETHER 2ND PARAMETER +STA FAC+4 ; +JSR CHRGOT ; SEE IF ")" YET +CMP #LOCHAR(`)') ; +BEQ L_MIDSTR_1 ; YES, NO 2ND PARAMETER +JSR CHKCOM ; NO, MUST HAVE COMMA +JSR GETBYT ; GET 2ND PARAM IN X-REG +L_MIDSTR_1 JSR SUBSTRING_SETUP +DEX ; 1ST PARAMETER - 1 +TXA +PHA +CLC +LDX #0 +SBC (DSCPTR),Y +BCS SUBSTRING_2 +EOR #$FF +CMP FAC+4 ; USE SMALLER OF TWO +BCC SUBSTRING_3 +LDA FAC+4 +BCS SUBSTRING_3 ; ...ALWAYS +; -------------------------------- +; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$: +; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR +; ADDRESS, GET 1ST PARAMETER OF COMMAND +; -------------------------------- +SUBSTRING_SETUP +JSR CHKCLS ; REQUIRE ")" +PLA ; SAVE RETURN ADDRESS +TAY ; IN Y-REG AND LENGTH +PLA ; +STA LENGTH ; +PLA ; POP PREVIOUS RETURN ADDRESS +PLA ; (FROM GOROUT). +PLA ; RETRIEVE 1ST PARAMETER +TAX ; +PLA ; GET ADDRESS OF STRING DESCRIPTOR +STA DSCPTR ; +PLA ; +STA DSCPTR+1 ; +LDA LENGTH ; RESTORE RETURN ADDRESS +PHA ; +TYA ; +PHA ; +LDY #0 ; +TXA ; GET 1ST PARAMETER IN A-REG +BEQ GOIQ ; ERROR IF 0 +RTS +; -------------------------------- +; "LEN" FUNCTION +; -------------------------------- +LEN JSR GETSTR ; GET LENTGH IN Y-REG, MAKE FAC NUMERIC +JMP SNGFLT ; FLOAT Y-REG INTO FAC +; -------------------------------- +; IF LAST RESULT IS A TEMPORARY STRING, FREE IT +; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG +; -------------------------------- +GETSTR JSR FRESTR ; IF LAST RESULT IS A STRING, FREE IT +LDX #0 ; MAKE VALTYP NUMERIC +STX VALTYP ; +TAY ; LENGTH OF STRING TO Y-REG +RTS +; -------------------------------- +; "ASC" FUNCTION +; -------------------------------- +ASC JSR GETSTR ; GET STRING, GET LENGTH IN Y-REG +BEQ GOIQ ; ERROR IF LENGTH 0 +LDY #0 ; +LDA (INDEX),Y ; GET 1ST CHAR OF STRING +TAY ; +JMP SNGFLT ; FLOAT Y-REG INTO FAC +; -------------------------------- +GOIQ JMP IQERR ; ILLEGAL QUANTITY ERROR +; -------------------------------- +; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION +; TO SINGLE BYTE IN X-REG +; -------------------------------- +GTBYTC JSR CHRGET +; -------------------------------- +; EVALUATE EXPRESSION AT TXTPTR, AND +; CONVERT IT TO SINGLE BYTE IN X-REG +; -------------------------------- +GETBYT JSR FRMNUM +; -------------------------------- +; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG +; -------------------------------- +CONINT JSR MKINT ; CONVERT IF IN RANGE -32767 TO +32767 +LDX FAC+3 ; HI-BYTE MUST BE ZERO +BNE GOIQ ; VALUE > 255, ERROR +LDX FAC+4 ; VALUE IN X-REG +JMP CHRGOT ; GET NEXT CHAR IN A-REG +; -------------------------------- +; "VAL" FUNCTION +; -------------------------------- +VAL JSR GETSTR ; GET POINTER TO STRING IN INDEX +BNE L_VAL_1 ; LENGTH NON-ZERO +JMP ZERO_FAC ; RETURN 0 IF LENGTH=0 +L_VAL_1 LDX TXTPTR ; SAVE CURRENT TXTPTR +LDY TXTPTR+1 ; +STX STRNG2 ; +STY STRNG2+1 ; +LDX INDEX ; +STX TXTPTR ; POINT TXTPTR TO START OF STRING +CLC ; +ADC INDEX ; ADD LENGTH +STA DEST ; POINT DEST TO END OF STRING + 1 +LDX INDEX+1 ; +STX TXTPTR+1 ; +BCC L_VAL_2 ; +INX ; +L_VAL_2 STX DEST+1 ; +LDY #0 ; SAVE BYTE THAT FOLLOWS STRING +LDA (DEST),Y ; ON STACK +PHA ; +LDA #0 ; AND STORE $00 IN ITS PLACE +STA (DEST),Y ; +; <<< THAT CAUSES A BUG IF HIMEM = $BFFF, >>> +; <<< BECAUSE STORING $00 AT $C000 IS NO >>> +; <<< USE; $C000 WILL ALWAYS BE LAST CHAR >>> +; <<< TYPED, SO FIN WON'T TERMINATE UNTIL >>> +; <<< IT SEES A ZERO AT $C010! >>> +JSR CHRGOT ; PRIME THE PUMP +JSR FIN ; EVALUATE STRING +PLA ; GET BYTE THAT SHOULD FOLLOW STRING +LDY #0 ; AND PUT IT BACK +STA (DEST),Y ; +; RESTORE TXTPTR +; -------------------------------- +; COPY STRNG2 INTO TXTPTR +; -------------------------------- +POINT LDX STRNG2 ; +LDY STRNG2+1 ; +STX TXTPTR ; +STY TXTPTR+1 ; +RTS ; +; -------------------------------- +; EVALUATE "EXP1,EXP2" +; +; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM +; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG +; -------------------------------- +GTNUM JSR FRMNUM ; +JSR GETADR ; +; -------------------------------- +; EVALUATE ",EXPRESSION" +; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG +; -------------------------------- +COMBYTE ; +JSR CHKCOM ; MUST HAVE COMMA FIRST +JMP GETBYT ; CONVERT EXPRESSION TO BYTE IN X-REG +; -------------------------------- +; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM +; -------------------------------- +GETADR LDA FAC ; FAC < 2^16? +CMP #$91 ; +BCS GOIQ ; NO, ILLEGAL QUANTITY +JSR QINT ; CONVERT TO INTEGER +LDA FAC+3 ; COPY IT INTO LINNUM +LDY FAC+4 ; +STY LINNUM ; TO LINNUM +STA LINNUM+1 ; +RTS ; +; -------------------------------- +; "PEEK" FUNCTION +; -------------------------------- +PEEK LDA LINNUM ; SAVE (LINNUM) ON STACK DURING PEEK +PHA ; +LDA LINNUM+1 ; +PHA ; +JSR GETADR ; GET ADDRESS PEEKING AT +LDY #0 +LDA (LINNUM),Y ; TAKE A QUICK LOOK +TAY ; VALUE IN Y-REG +PLA ; RESTORE LINNUM FROM STACK +STA LINNUM+1 ; +PLA ; +STA LINNUM ; +JMP SNGFLT ; FLOAT Y-REG INTO FAC +; -------------------------------- +; "POKE" STATEMENT +; -------------------------------- +POKE JSR GTNUM ; GET THE ADDRESS AND VALUE +TXA ; VALUE IN A, +LDY #0 ; +STA (LINNUM),Y ; STORE IT AWAY, +RTS ; AND THAT'S ALL FOR TODAY +; -------------------------------- +; "WAIT" STATEMENT +; -------------------------------- +WAIT JSR GTNUM ; GET ADDRESS IN LINNUM, MASK IN X +STX FORPNT ; SAVE MASK +LDX #0 ; +JSR CHRGOT ; ANOTHER PARAMETER? +BEQ L_WAIT_1 ; NO, USE $00 FOR EXCLUSIVE-OR +JSR COMBYTE ; GET XOR-MASK +L_WAIT_1 STX FORPNT+1 ; SAVE XOR-MASK HERE +LDY #0 +L_WAIT_2 LDA (LINNUM),Y ; GET BYTE AT ADDRESS +EOR FORPNT+1 ; INVERT SPECIFIED BITS +AND FORPNT ; SELECT SPECIFIED BITS +BEQ L_WAIT_2 ; LOOP TILL NOT 0 +RTS_10 RTS +; -------------------------------- +; ADD 0L_RTS_10_5 TO FAC +; -------------------------------- +FADDH LDA # FAC +LDY #>CON_HALF +JMP FADD +; -------------------------------- +; FAC = (Y,A) - FAC +; -------------------------------- +FSUB JSR LOAD_ARG_FROM_YA +; -------------------------------- +; FAC = ARG - FAC +; -------------------------------- +FSUBT LDA FAC_SIGN ; COMPLEMENT FAC AND ADD +EOR #$FF ; +STA FAC_SIGN ; +EOR ARG_SIGN ; FIX SGNCPR TOO +STA SGNCPR ; +LDA FAC ; MAKE STATUS SHOW FAC EXPONENT +JMP FADDT ; JOIN FADD +; -------------------------------- +; SHIFT SMALLER ARGUMENT MORE THAN 7 BITS +; -------------------------------- +FADD_1 JSR SHIFT_RIGHT ; ALIGN RADIX BY SHIFTING +BCC FADD_3 ; ...ALWAYS +; -------------------------------- +; FAC = (Y,A) + FAC +; -------------------------------- +FADD JSR LOAD_ARG_FROM_YA +; -------------------------------- +; FAC = ARG + FAC +; -------------------------------- +FADDT BNE L_FADDT_1 ; FAC IS NON-ZERO +JMP COPY_ARG_TO_FAC ; FAC = 0 + ARG +L_FADDT_1 LDX FAC_EXTENSION +STX ARG_EXTENSION +LDX #ARG ; SET UP TO SHIFT ARG +LDA ARG ; EXPONENT +; -------------------------------- +FADD_2 TAY +BEQ RTS_10 ; IF ARG=0, WE ARE FINISHED +SEC ; +SBC FAC ; GET DIFFNCE OF EXP +BEQ FADD_3 ; GO ADD IF SAME EXP +BCC L_FADD_2_1 ; ARG HAS SMALLER EXPONENT +STY FAC ; EXP HAS SMALLER EXPONENT +LDY ARG_SIGN ; +STY FAC_SIGN ; +EOR #$FF ; COMPLEMENT SHIFT COUNT +ADC #0 ; CARRY WAS SET +LDY #0 +STY ARG_EXTENSION +LDX #FAC ; SET UP TO SHIFT FAC +BNE L_FADD_2_2 ; ...ALWAYS +L_FADD_2_1 LDY #0 +STY FAC_EXTENSION +L_FADD_2_2 CMP #$F9 ; SHIFT MORE THAN 7 BITS? +BMI FADD_1 ; YES +TAY ; INDEX TO # OF SHIFTS +LDA FAC_EXTENSION +LSR 1,X ; START SHIFTING... +JSR SHIFT_RIGHT_4 ; ...COMPLETE SHIFTING +FADD_3 BIT SGNCPR ; DO FAC AND ARG HAVE SAME SIGNS? +BPL FADD_4 ; YES, ADD THE MANTISSAS +LDY #FAC ; NO, SUBTRACT SMALLER FROM LARGER +CPX #ARG ; WHICH WAS ADJUSTED? +BEQ L_FADD_3_1 ; IF ARG, DO FAC-ARG +LDY #ARG ; IF FAC, DO ARG-FAC +L_FADD_3_1 SEC ; SUBTRACT SMALLER FROM LARGER (WE HOPE) +EOR #$FF ; (IF EXPONENTS WERE EQUAL, WE MIGHT BE +ADC ARG_EXTENSION ; SUBTRACTING LARGER FROM SMALLER) +STA FAC_EXTENSION +LDA 4,Y +SBC 4,X +STA FAC+4 +LDA 3,Y +SBC 3,X +STA FAC+3 +LDA 2,Y +SBC 2,X +STA FAC+2 +LDA 1,Y +SBC 1,X +STA FAC+1 +; -------------------------------- +; NORMALIZE VALUE IN FAC +; -------------------------------- +NORMALIZE_FAC_1 +BCS NORMALIZE_FAC_2 +JSR COMPLEMENT_FAC +; -------------------------------- +NORMALIZE_FAC_2 +LDY #0 ; SHIFT UP SIGNIF DIGIT +TYA ; START A=0, COUNT SHIFTS IN A-REG +CLC +L_NORMALIZE_FAC_2_1 LDX FAC+1 ; LOOK AT MOST SIGNIFICANT BYTE +BNE NORMALIZE_FAC_4 ; SOME 1-BITS HERE +LDX FAC+2 ; HI-BYTE OF MANTISSA STILL ZERO, +STX FAC+1 ; SO DO A FAST 8-BIT SHUFFLE +LDX FAC+3 +STX FAC+2 +LDX FAC+4 +STX FAC+3 +LDX FAC_EXTENSION +STX FAC+4 +STY FAC_EXTENSION ; ZERO EXTENSION BYTE +ADC #8 ; BUMP SHIFT COUNT +CMP #32 ; DONE 4 TIMES YET? +BNE L_NORMALIZE_FAC_2_1 ; NO, STILL MIGHT BE SOME 1'S +; YES, VALUE OF FAC IS ZERO +; -------------------------------- +; SET FAC = 0 +; (ONLY NECESSARY TO ZERO EXPONENT AND SIGN CELLS) +; -------------------------------- +ZERO_FAC +LDA #0 +; -------------------------------- +STA_IN_FAC_SIGN_AND_EXP +STA FAC +; -------------------------------- +STA_IN_FAC_SIGN +STA FAC_SIGN +RTS +; -------------------------------- +; ADD MANTISSAS OF FAC AND ARG INTO FAC +; -------------------------------- +FADD_4 ADC ARG_EXTENSION +STA FAC_EXTENSION +LDA FAC+4 +ADC ARG+4 +STA FAC+4 +LDA FAC+3 +ADC ARG+3 +STA FAC+3 +LDA FAC+2 +ADC ARG+2 +STA FAC+2 +LDA FAC+1 +ADC ARG+1 +STA FAC+1 +JMP NORMALIZE_FAC_5 +; -------------------------------- +; FINISH NORMALIZING FAC +; -------------------------------- +NORMALIZE_FAC_3 +ADC #1 ; COUNT BITS SHIFTED +ASL FAC_EXTENSION +ROL FAC+4 +ROL FAC+3 +ROL FAC+2 +ROL FAC+1 +; -------------------------------- +NORMALIZE_FAC_4 +BPL NORMALIZE_FAC_3 ; UNTIL TOP BIT = 1 +SEC +SBC FAC ; ADJUST EXPONENT BY BITS SHIFTED +BCS ZERO_FAC ; UNDERFLOW, RETURN ZERO +EOR #$FF ; +ADC #1 ; 2'S COMPLEMENT +STA FAC ; CARRY=0 NOW +; -------------------------------- +NORMALIZE_FAC_5 ; +BCC RTS_11 ; UNLESS MANTISSA CARRIED +; -------------------------------- +NORMALIZE_FAC_6 ; +INC FAC ; MANTISSA CARRIED, SO SHIFT RIGHT +BEQ OVERFLOW ; OVERFLOW IF EXPONENT TOO BIG +ROR FAC+1 +ROR FAC+2 +ROR FAC+3 +ROR FAC+4 +ROR FAC_EXTENSION +RTS_11 RTS +; -------------------------------- +; 2'S COMPLEMENT OF FAC +; -------------------------------- +COMPLEMENT_FAC +LDA FAC_SIGN +EOR #$FF +STA FAC_SIGN +; -------------------------------- +; 2'S COMPLEMENT OF FAC MANTISSA ONLY +; -------------------------------- +COMPLEMENT_FAC_MANTISSA +LDA FAC+1 +EOR #$FF +STA FAC+1 +LDA FAC+2 +EOR #$FF +STA FAC+2 +LDA FAC+3 +EOR #$FF +STA FAC+3 +LDA FAC+4 +EOR #$FF +STA FAC+4 +LDA FAC_EXTENSION +EOR #$FF +STA FAC_EXTENSION +INC FAC_EXTENSION ; START INCREMENTING MANTISSA +BNE RTS_12 +; -------------------------------- +; INCREMENT FAC MANTISSA +; -------------------------------- +INCREMENT_FAC_MANTISSA +INC FAC+4 ; ADD CARRY FROM EXTRA +BNE RTS_12 +INC FAC+3 +BNE RTS_12 +INC FAC+2 +BNE RTS_12 +INC FAC+1 +RTS_12 RTS +; -------------------------------- +OVERFLOW +LDX #ERR_OVERFLOW +JMP ERROR +; -------------------------------- +; SHIFT 1,X THRU 5,X RIGHT +; (A) = NEGATIVE OF SHIFT COUNT +; (X) = POINTER TO BYTES TO BE SHIFTED +; +; RETURN WITH (Y)=0, CARRY=0, EXTENSION BITS IN A-REG +; -------------------------------- +SHIFT_RIGHT_1 +LDX #RESULT-1 ; SHIFT RESULT RIGHT +SHIFT_RIGHT_2 ; +LDY 4,X ; SHIFT 8 BITS RIGHT +STY FAC_EXTENSION ; +LDY 3,X ; +STY 4,X ; +LDY 2,X ; +STY 3,X ; +LDY 1,X ; +STY 2,X ; +LDY SHIFT_SIGN_EXT ; $00 IF +, $FF IF - +STY 1,X +; -------------------------------- +; MAIN ENTRY TO RIGHT SHIFT SUBROUTINE +; -------------------------------- +SHIFT_RIGHT +ADC #8 +BMI SHIFT_RIGHT_2 ; STILL MORE THAN 8 BITS TO GO +BEQ SHIFT_RIGHT_2 ; EXACTLY 8 MORE BITS TO GO +SBC #8 ; UNDO ADC ABOVE +TAY ; REMAINING SHIFT COUNT +LDA FAC_EXTENSION ; +BCS SHIFT_RIGHT_5 ; FINISHED SHIFTING +SHIFT_RIGHT_3 ; +L ASL 1,X ; SIGN -> CARRY (SIGN EXTENSION) +BCC L_L_1 ; SIGN + +INC 1,X ; PUT SIGN IN LSB +L_L_1 ROR 1,X ; RESTORE VALUE, SIGN STILL IN CARRY +ROR 1,X ; START RIGHT SHIFT, INSERTING SIGN +; -------------------------------- +; ENTER HERE FOR SHORT SHIFTS WITH NO SIGN EXTENSION +; -------------------------------- +SHIFT_RIGHT_4 +ROR 2,X +ROR 3,X +ROR 4,X +ROR ; EXTENSION +INY ; COUNT THE SHIFT +BNE SHIFT_RIGHT_3 ; +SHIFT_RIGHT_5 ; +CLC ; RETURN WITH CARRY CLEAR +RTS +; -------------------------------- +; -------------------------------- + +CON_ONE ASM_DATA($81,$00,$00,$00,$00) +; -------------------------------- +POLY_LOG ASM_DATA(3) ; # OF COEFFICIENTS - 1 +ASM_DATA($7F,$5E,$56,$CB,$79) ; * X^7 + +ASM_DATA($80,$13,$9B,$0B,$64) ; * X^5 + +ASM_DATA($80,$76,$38,$93,$16) ; * X^3 + +ASM_DATA($82,$38,$AA,$3B,$20) ; * X +; -------------------------------- + +CON_SQR_HALF ASM_DATA($80,$35,$04,$F3,$34) +CON_SQR_TWO ASM_DATA($81,$35,$04,$F3,$34) +CON_NEG_HALF ASM_DATA($80,$80,$00,$00,$00) +CON_LOG_TWO ASM_DATA($80,$31,$72,$17,$F8) +; -------------------------------- +; "LOG" FUNCTION +; -------------------------------- +LOG JSR SIGN ; GET -1,0,+1 IN A-REG FOR FAC +BEQ GIQ ; LOG (0) IS ILLEGAL +BPL LOG_2 ; >0 IS OK +GIQ JMP IQERR ; <= 0 IS NO GOOD +LOG_2 LDA FAC ; FIRST GET LOG BASE 2 +SBC #$7F ; SAVE UNBIASED EXPONENT +PHA ; +LDA #$80 ; NORMALIZE BETWEEN L_LOG_2_5 AND 1 +STA FAC +LDA #CON_SQR_HALF +JSR FADD ; COMPUTE VIA SERIES OF ODD +LDA #CON_SQR_TWO ; (SQR(2)X-1)/(SQR(2)X+1) +JSR FDIV +LDA #CON_ONE +JSR FSUB +LDA #POLY_LOG +JSR POLYNOMIAL_ODD +LDA #CON_NEG_HALF +JSR FADD +PLA +JSR ADDACC ; ADD ORIGINAL EXPONENT +LDA #CON_LOG_TWO ; NATURAL LOG OF X +; -------------------------------- +; FAC = (Y,A) * FAC +; -------------------------------- +FMULT JSR LOAD_ARG_FROM_YA +; -------------------------------- +; FAC = ARG * FAC +; -------------------------------- +FMULTT BNE L_FMULTT_1 ; FAC .NE. ZERO +JMP RTS_13 ; FAC = 0 * ARG = 0 +; <<< WHY IS LINE ABOVE JUST "RTS"? >>> +; -------------------------------- +; +; -------------------------------- +L_FMULTT_1 JSR ADD_EXPONENTS +LDA #0 +STA RESULT ; INIT PRODUCT = 0 +STA RESULT+1 +STA RESULT+2 +STA RESULT+3 +LDA FAC_EXTENSION +JSR MULTIPLY_1 +LDA FAC+4 +JSR MULTIPLY_1 +LDA FAC+3 +JSR MULTIPLY_1 +LDA FAC+2 +JSR MULTIPLY_1 +LDA FAC+1 +JSR MULTIPLY_2 +JMP COPY_RESULT_INTO_FAC +; -------------------------------- +; MULTIPLY ARG BY (A) INTO RESULT +; -------------------------------- +MULTIPLY_1 +BNE MULTIPLY_2 ; THIS BYTE NON-ZERO +JMP SHIFT_RIGHT_1 ; (A)=0, JUST SHIFT ARG RIGHT 8 +; -------------------------------- +MULTIPLY_2 ; +LSR ; SHIFT BIT INTO CARRY +ORA #$80 ; SUPPLY SENTINEL BIT +L_MULTIPLY_2_1 TAY ; REMAINING MULTIPLIER TO Y +BCC L_MULTIPLY_2_2 ; THIS MULTIPLIER BIT = 0 +CLC ; = 1, SO ADD ARG TO RESULT +LDA RESULT+3 +ADC ARG+4 +STA RESULT+3 +LDA RESULT+2 +ADC ARG+3 +STA RESULT+2 +LDA RESULT+1 +ADC ARG+2 +STA RESULT+1 +LDA RESULT +ADC ARG+1 +STA RESULT +L_MULTIPLY_2_2 ROR RESULT ; SHIFT RESULT RIGHT 1 +ROR RESULT+1 ; +ROR RESULT+2 ; +ROR RESULT+3 ; +ROR FAC_EXTENSION ; +TYA ; REMAINING MULTIPLIER +LSR ; LSB INTO CARRY +BNE L_MULTIPLY_2_1 ; IF SENTINEL STILL HERE, MULTIPLY +RTS_13 RTS ; 8 X 32 COMPLETED +; -------------------------------- +; UNPACK NUMBER AT (Y,A) INTO ARG +; -------------------------------- +LOAD_ARG_FROM_YA +STA INDEX ; USE INDEX FOR PNTR +STY INDEX+1 ; +LDY #4 ; FIVE BYTES TO MOVE +LDA (INDEX),Y ; +STA ARG+4 ; +DEY ; +LDA (INDEX),Y ; +STA ARG+3 ; +DEY ; +LDA (INDEX),Y ; +STA ARG+2 ; +DEY ; +LDA (INDEX),Y ; +STA ARG_SIGN ; +EOR FAC_SIGN ; SET COMBINED SIGN FOR MULT/DIV +STA SGNCPR ; +LDA ARG_SIGN ; TURN ON NORMALIZED INVISIBLE BIT +ORA #$80 ; TO COMPLETE MANTISSA +STA ARG+1 ; +DEY ; +LDA (INDEX),Y ; +STA ARG ; EXPONENT +LDA FAC ; SET STATUS BITS ON FAC EXPONENT +RTS ; +; -------------------------------- +; ADD EXPONENTS OF ARG AND FAC +; (CALLED BY FMULT AND FDIV) +; +; ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN +; -------------------------------- +ADD_EXPONENTS +LDA ARG +; -------------------------------- +ADD_EXPONENTS_1 +BEQ ZERO ; IF ARG=0, RESULT IS ZERO +CLC ; +ADC FAC ; +BCC L_ADD_EXPONENTS_1_1 ; IN RANGE +BMI JOV ; OVERFLOW +CLC ; +ASM_DATA($2C) ; TRICK TO SKIP +L_ADD_EXPONENTS_1_1 BPL ZERO ; OVERFLOW +ADC #$80 ; RE-BIAS +STA FAC ; RESULT +BNE L_ADD_EXPONENTS_1_2 +JMP STA_IN_FAC_SIGN ; RESULT IS ZERO +; <<< CRAZY TO JUMP WAY BACK THERE! >>> +; <<< SAME IDENTICAL CODE IS BELOW! >>> +; <<< INSTEAD OF BNE L_ADD_EXPONENTS_1_2, JMP STA.IN.FAC.SIGN >>> +; <<< ONLY NEEDED BEQ L_ADD_EXPONENTS_1_3 >>> +L_ADD_EXPONENTS_1_2 LDA SGNCPR ; SET SIGN OF RESULT +L_ADD_EXPONENTS_1_3 STA FAC_SIGN +RTS +; -------------------------------- +; IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR +; IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS +; CALLED FROM "EXP" FUNCTION +; -------------------------------- +OUTOFRNG +LDA FAC_SIGN +EOR #$FF +BMI JOV ; ERROR IF POSITIVE # +; -------------------------------- +; POP RETURN ADDRESS AND SET FAC=0 +; -------------------------------- +ZERO PLA +PLA +JMP ZERO_FAC +; -------------------------------- +JOV JMP OVERFLOW +; -------------------------------- +; MULTIPLY FAC BY 10 +; -------------------------------- +MUL10 JSR COPY_FAC_TO_ARG_ROUNDED +TAX ; TEXT FAC EXPONENT +BEQ L_MUL10_1 ; FINISHED IF FAC=0 +CLC ; +ADC #2 ; ADD 2 TO EXPONENT GIVES (FAC)*4 +BCS JOV ; OVERFLOW +LDX #0 ; +STX SGNCPR ; +JSR FADD_2 ; MAKES (FAC)*5 +INC FAC ; *2, MAKES (FAC)*10 +BEQ JOV ; OVERFLOW +L_MUL10_1 RTS +; -------------------------------- + +CON_TEN ASM_DATA($84,$20,$00,$00,$00) +; -------------------------------- +; DIVIDE FAC BY 10 +; -------------------------------- +DIV10 JSR COPY_FAC_TO_ARG_ROUNDED +LDA #CON_TEN ; 10 IN FAC +LDX #0 +; -------------------------------- +; FAC = ARG / (Y,A) +; -------------------------------- +DIV STX SGNCPR +JSR LOAD_FAC_FROM_YA +JMP FDIVT ; DIVIDE ARG BY FAC +; -------------------------------- +; FAC = (Y,A) / FAC +; -------------------------------- +FDIV JSR LOAD_ARG_FROM_YA +; -------------------------------- +; FAC = ARG / FAC +; -------------------------------- +FDIVT BEQ L_FDIVT_8 ; FAC = 0, DIVIDE BY ZERO ERROR +JSR ROUND_FAC ; +LDA #0 ; NEGATE FAC EXPONENT, SO +SEC ; ADD.EXPONENTS FORMS DIFFERENCE +SBC FAC +STA FAC +JSR ADD_EXPONENTS +INC FAC +BEQ JOV ; OVERFLOW +LDX #$FC ; INDEX FOR RESULT +LDA #1 ; SENTINEL +L_FDIVT_1 LDY ARG+1 ; SEE IF FAC CAN BE SUBTRACTED +CPY FAC+1 +BNE L_FDIVT_2 +LDY ARG+2 +CPY FAC+2 +BNE L_FDIVT_2 +LDY ARG+3 +CPY FAC+3 +BNE L_FDIVT_2 +LDY ARG+4 +CPY FAC+4 +L_FDIVT_2 PHP ; SAVE THE ANSWER, AND ALSO ROLL THE +ROL ; BIT INTO THE QUOTIENT, SENTINEL OUT +BCC L_FDIVT_3 ; NO SENTINEL, STILL NOT 8 TRIPS +INX ; 8 TRIPS, STORE BYTE OF QUOTIENT +STA RESULT+3,X +BEQ L_FDIVT_6 ; 32-BITS COMPLETED +BPL L_FDIVT_7 ; FINAL EXIT WHEN X=1 +LDA #1 ; RE-START SENTINEL +L_FDIVT_3 PLP ; GET ANSWER, CAN FAC BE SUBTRACTED? +BCS L_FDIVT_5 ; YES, DO IT +L_FDIVT_4 ASL ARG+4 ; NO, SHIFT ARG LEFT +ROL ARG+3 ; +ROL ARG+2 ; +ROL ARG+1 ; +BCS L_FDIVT_2 ; ANOTHER TRIP +BMI L_FDIVT_1 ; HAVE TO COMPARE FIRST +BPL L_FDIVT_2 ; ...ALWAYS +L_FDIVT_5 TAY ; SAVE QUOTIENT/SENTINEL BYTE +LDA ARG+4 ; SUBTRACT FAC FROM ARG ONCE +SBC FAC+4 ; +STA ARG+4 ; +LDA ARG+3 ; +SBC FAC+3 ; +STA ARG+3 ; +LDA ARG+2 ; +SBC FAC+2 ; +STA ARG+2 ; +LDA ARG+1 ; +SBC FAC+1 ; +STA ARG+1 ; +TYA ; RESTORE QUOTIENT/SENTINEL BYTE +JMP L_FDIVT_4 ; GO TO SHIFT ARG AND CONTINUE +; -------------------------------- +L_FDIVT_6 LDA #$40 ; DO A FEW EXTENSION BITS +BNE L_FDIVT_3 ; ...ALWAYS +; -------------------------------- +L_FDIVT_7 ASL ; LEFT JUSTIFY THE EXTENSION BITS WE DID +ASL +ASL +ASL +ASL +ASL +STA FAC_EXTENSION +PLP +JMP COPY_RESULT_INTO_FAC +; -------------------------------- +L_FDIVT_8 LDX #ERR_ZERODIV +JMP ERROR +; -------------------------------- +; COPY RESULT INTO FAC MANTISSA, AND NORMALIZE +; -------------------------------- +COPY_RESULT_INTO_FAC +LDA RESULT +STA FAC+1 +LDA RESULT+1 +STA FAC+2 +LDA RESULT+2 +STA FAC+3 +LDA RESULT+3 +STA FAC+4 +JMP NORMALIZE_FAC_2 +; -------------------------------- +; UNPACK (Y,A) INTO FAC +; -------------------------------- +LOAD_FAC_FROM_YA +STA INDEX ; USE INDEX FOR PNTR +STY INDEX+1 ; +LDY #4 ; PICK UP 5 BYTES +LDA (INDEX),Y ; +STA FAC+4 ; +DEY ; +LDA (INDEX),Y ; +STA FAC+3 ; +DEY ; +LDA (INDEX),Y ; +STA FAC+2 ; +DEY ; +LDA (INDEX),Y ; +STA FAC_SIGN ; FIRST BIT IS SIGN +ORA #$80 ; SET NORMALIZED INVISIBLE BIT +STA FAC+1 ; +DEY ; +LDA (INDEX),Y ; +STA FAC ; EXPONENT +STY FAC_EXTENSION ; Y=0 +RTS +; -------------------------------- +; ROUND FAC, STORE IN TEMP2 +; -------------------------------- +STORE_FAC_IN_TEMP2_ROUNDED +LDX #TEMP2 ; PACK FAC INTO TEMP2 +ASM_DATA($2C) ; TRICK TO BRANCH +; -------------------------------- +; ROUND FAC, STORE IN TEMP1 +; -------------------------------- +STORE_FAC_IN_TEMP1_ROUNDED +LDX #TEMP1 ; HI-BYTE OF TEMP1 SAME AS TEMP2 +BEQ STORE_FACDB_YX_ROUNDED ; ...ALWAYS +; -------------------------------- +; ROUND FAC, AND STORE WHERE FORPNT POINTS +; -------------------------------- +SETFOR LDX FORPNT +LDY FORPNT+1 +; -------------------------------- +; ROUND FAC, AND STORE AT (Y,X) +; -------------------------------- +STORE_FACDB_YX_ROUNDED +JSR ROUND_FAC ; ROUND VALUE IN FAC USING EXTENSION +STX INDEX ; USE INDEX FOR PNTR +STY INDEX+1 ; +LDY #4 ; STORING 5 PACKED BYTES +LDA FAC+4 ; +STA (INDEX),Y ; +DEY ; +LDA FAC+3 ; +STA (INDEX),Y ; +DEY ; +LDA FAC+2 ; +STA (INDEX),Y ; +DEY ; +LDA FAC_SIGN ; PACK SIGN IN TOP BIT OF MANTISSA +ORA #$7F ; +AND FAC+1 ; +STA (INDEX),Y ; +DEY ; +LDA FAC ; EXPONENT +STA (INDEX),Y ; +STY FAC_EXTENSION ; ZERO THE EXTENSION +RTS +; -------------------------------- +; COPY ARG INTO FAC +; -------------------------------- +COPY_ARG_TO_FAC +LDA ARG_SIGN ; COPY SIGN +MFA STA FAC_SIGN ; +LDX #5 ; MOVE 5 BYTES +L_MFA_1 LDA ARG-1,X ; +STA FAC-1,X ; +DEX ; +BNE L_MFA_1 ; +STX FAC_EXTENSION ; ZERO EXTENSION +RTS ; +; -------------------------------- +; ROUND FAC AND COPY TO ARG +; -------------------------------- +COPY_FAC_TO_ARG_ROUNDED +JSR ROUND_FAC ; ROUND FAC USING EXTENSION +MAF LDX #6 ; COPY 6 BYTES, INCLUDES SIGN +L_MAF_1 LDA FAC-1,X ; +STA ARG-1,X ; +DEX ; +BNE L_MAF_1 ; +STX FAC_EXTENSION ; ZERO FAC EXTENSION +RTS_14 RTS ; +; -------------------------------- +; ROUND FAC USING EXTENSION BYTE +; -------------------------------- +ROUND_FAC +LDA FAC +BEQ RTS_14 ; FAC = 0, RETURN +ASL FAC_EXTENSION ; IS FAC.EXTENSION >= 128? +BCC RTS_14 ; NO, FINISHED +; -------------------------------- +; INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY +; -------------------------------- +INCREMENT_MANTISSA +JSR INCREMENT_FAC_MANTISSA ; YES, INCREMENT FAC +BNE RTS_14 ; HIGH BYTE HAS BITS, FINISHED +JMP NORMALIZE_FAC_6 ; HI-BYTE=0, SO SHIFT LEFT +; -------------------------------- +; TEST FAC FOR ZERO AND SIGN +; +; FAC > 0, RETURN +1 +; FAC = 0, RETURN 0 +; FAC < 0, RETURN -1 +; -------------------------------- +SIGN LDA FAC ; CHECK SIGN OF FAC AND +BEQ RTS_15 ; RETURN -1,0,1 IN A-REG +; -------------------------------- +SIGN1 LDA FAC_SIGN ; +; -------------------------------- +SIGN2 ROL ; MSBIT TO CARRY +LDA #$FF ; -1 +BCS RTS_15 ; MSBIT = 1 +LDA #1 ; +1 +RTS_15 RTS ; +; -------------------------------- +; "SGN" FUNCTION +; -------------------------------- +SGN JSR SIGN ; CONVERT FAC TO -1,0,1 +; -------------------------------- +; CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127 +; -------------------------------- +FLOAT STA FAC+1 ; PUT IN HIGH BYTE OF MANTISSA +LDA #0 ; CLEAR 2ND BYTE OF MANTISSA +STA FAC+2 ; +LDX #$88 ; USE EXPONENT 2^9 +; -------------------------------- +; FLOAT UNSIGNED VALUE IN FAC+1,2 +; (X) = EXPONENT +; -------------------------------- +FLOAT_1 ; +LDA FAC+1 ; MSBIT=0, SET CARRY; =1, CLEAR CARRY +EOR #$FF ; +ROL ; +; -------------------------------- +; FLOAT UNSIGNED VALUE IN FAC+1,2 +; (X) = EXPONENT +; C=0 TO MAKE VALUE NEGATIVE +; C=1 TO MAKE VALUE POSITIVE +; -------------------------------- +FLOAT_2 ; +LDA #0 ; CLEAR LOWER 16-BITS OF MANTISSA +STA FAC+4 ; +STA FAC+3 ; +STX FAC ; STORE EXPONENT +STA FAC_EXTENSION ; CLEAR EXTENSION +STA FAC_SIGN ; MAKE SIGN POSITIVE +JMP NORMALIZE_FAC_1 ; IF C=0, WILL NEGATE FAC +; -------------------------------- +; "ABS" FUNCTION +; -------------------------------- +ABS LSR FAC_SIGN ; CHANGE SIGN TO + +RTS +; -------------------------------- +; COMPARE FAC WITH PACKED # AT (Y,A) +; RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC +; -------------------------------- +FCOMP STA DEST ; USE DEST FOR PNTR +; -------------------------------- +; SPECIAL ENTRY FROM "NEXT" PROCESSOR +; "DEST" ALREADY SET UP +; -------------------------------- +FCOMP2 STY DEST+1 ; +LDY #0 ; GET EXPONENT OF COMPARAND +LDA (DEST),Y ; +INY ; POINT AT NEXT BYTE +TAX ; EXPONENT TO X-REG +BEQ SIGN ; IF COMPARAND=0, "SIGN" COMPARES FAC +LDA (DEST),Y ; GET HI-BYTE OF MANTISSA +EOR FAC_SIGN ; COMPARE WITH FAC SIGN +BMI SIGN1 ; DIFFERENT SIGNS, "SIGN" GIVES ANSWER +CPX FAC ; SAME SIGN, SO COMPARE EXPONENTS +BNE L_FCOMP2_1 ; DIFFERENT, SO SUFFICIENT TEST +LDA (DEST),Y ; SAME EXPONENT, COMPARE MANTISSA +ORA #$80 ; SET INVISIBLE NORMALIZED BIT +CMP FAC+1 ; +BNE L_FCOMP2_1 ; NOT SAME, SO SUFFICIENT +INY ; SAME, COMPARE MORE MANTISSA +LDA (DEST),Y ; +CMP FAC+2 ; +BNE L_FCOMP2_1 ; NOT SAME, SO SUFFICIENT +INY ; SAME, COMPARE MORE MANTISSA +LDA (DEST),Y ; +CMP FAC+3 ; +BNE L_FCOMP2_1 ; NOT SAME, SO SUFFICIENT +INY ; SAME, COMPARE REST OF MANTISSA +LDA #$7F ; ARTIFICIAL EXTENSION BYTE FOR COMPARAND +CMP FAC_EXTENSION +LDA (DEST),Y +SBC FAC+4 +BEQ RTS_16 ; NUMBERS ARE EQUAL, RETURN (A)=0 +L_FCOMP2_1 LDA FAC_SIGN ; NUMBERS ARE DIFFERENT +BCC L_FCOMP2_2 ; FAC IS LARGER MAGNITUDE +EOR #$FF ; FAC IS SMALLER MAGNITUDE +; <<< NOTE THAT ABOVE THREE LINES CAN BE SHORTENED: >>> +; <<< L_FCOMP2_1 ROR PUT CARRY INTO SIGN BIT >>> +; <<< EOR FAC.SIGN TOGGLE WITH SIGN OF FAC >>> +L_FCOMP2_2 JMP SIGN2 ; CONVERT +1 OR -1 +; -------------------------------- +; QUICK INTEGER FUNCTION +; +; CONVERTS FP VALUE IN FAC TO INTEGER VALUE +; IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN +; EXTENSION UNTIL FRACTIONAL BITS ARE OUT. +; +; THIS SUBROUTINE ASSUMES THE EXPONENT < 32. +; -------------------------------- +QINT LDA FAC ; LOOK AT FAC EXPONENT +BEQ QINT_3 ; FAC=0, SO FINISHED +SEC ; GET -(NUMBER OF FRACTIONAL BITS) +SBC #$A0 ; IN A-REG FOR SHIFT COUNT +BIT FAC_SIGN ; CHECK SIGN OF FAC +BPL L_QINT_1 ; POSITIVE, CONTINUE +TAX ; NEGATIVE, SO COMPLEMENT MANTISSA +LDA #$FF ; AND SET SIGN EXTENSION FOR SHIFT +STA SHIFT_SIGN_EXT +JSR COMPLEMENT_FAC_MANTISSA +TXA ; RESTORE BIT COUNT TO A-REG +L_QINT_1 LDX #FAC ; POINT SHIFT SUBROUTINE AT FAC +CMP #$F9 ; MORE THAN 7 BITS TO SHIFT? +BPL QINT_2 ; NO, SHORT SHIFT +JSR SHIFT_RIGHT ; YES, USE GENERAL ROUTINE +STY SHIFT_SIGN_EXT ; Y=0, CLEAR SIGN EXTENSION +RTS_16 RTS +; -------------------------------- +QINT_2 TAY ; SAVE SHIFT COUNT +LDA FAC_SIGN ; GET SIGN BIT +AND #$80 ; +LSR FAC+1 ; START RIGHT SHIFT +ORA FAC+1 ; AND MERGE WITH SIGN +STA FAC+1 +JSR SHIFT_RIGHT_4 ; JUMP INTO MIDDLE OF SHIFTER +STY SHIFT_SIGN_EXT ; Y=0, CLEAR SIGN EXTENSION +RTS +; -------------------------------- +; "INT" FUNCTION +; +; USES QINT TO CONVERT (FAC) TO INTEGER FORM, +; AND THEN REFLOATS THE INTEGER. +; <<< A FASTER APPROACH WOULD SIMPLY CLEAR >>> +; <<< THE FRACTIONAL BITS BY ZEROING THEM >>> +; -------------------------------- +INT LDA FAC ; CHECK IF EXPONENT < 32 +CMP #$A0 ; BECAUSE IF > 31 THERE IS NO FRACTION +BCS RTS_17 ; NO FRACTION, WE ARE FINISHED +JSR QINT ; USE GENERAL INTEGER CONVERSION +STY FAC_EXTENSION ; Y=0, CLEAR EXTENSION +LDA FAC_SIGN ; GET SIGN OF VALUE +STY FAC_SIGN ; Y=0, CLEAR SIGN +EOR #$80 ; TOGGLE ACTUAL SIGN +ROL ; AND SAVE IN CARRY +LDA #$A0 ; SET EXPONENT TO 32 +STA FAC ; BECAUSE 4-BYTE INTEGER NOW +LDA FAC+4 ; SAVE LOW 8-BITS OF INTEGER FORM +STA CHARAC ; FOR EXP AND POWER +JMP NORMALIZE_FAC_1 ; NORMALIZE TO FINISH CONVERSION +; -------------------------------- +QINT_3 STA FAC+1 ; FAC=0, SO CLEAR ALL 4 BYTES FOR +STA FAC+2 ; INTEGER VERSION +STA FAC+3 ; +STA FAC+4 ; +TAY ; Y=0 TOO +RTS_17 RTS ; +; -------------------------------- +; CONVERT STRING TO FP VALUE IN FAC +; +; STRING POINTED TO BY TXTPTR +; FIRST CHAR ALREADY SCANNED BY CHRGET +; (A) = FIRST CHAR, C=0 IF DIGIT. +; -------------------------------- +FIN LDY #0 ; CLEAR WORKING AREA ($99...$A3) +LDX #10 ; TMPEXP, EXPON, DPFLG, EXPSGN, FAC, SERLEN +L_FIN_1 STY TMPEXP,X +DEX +BPL L_FIN_1 +; -------------------------------- +BCC FIN_2 ; FIRST CHAR IS A DIGIT +CMP #LOCHAR(`-') ; CHECK FOR LEADING SIGN +BNE L_FIN_2 ; NOT MINUS +STX SERLEN ; MINUS, SET SERLEN = $FF FOR FLAG +BEQ FIN_1 ; ...ALWAYS +L_FIN_2 CMP #LOCHAR(`+') ; MIGHT BE PLUS +BNE FIN_3 ; NOT PLUS EITHER, CHECK DECIMAL POINT +; -------------------------------- +FIN_1 JSR CHRGET ; GET NEXT CHAR OF STRING +; -------------------------------- +FIN_2 BCC FIN_9 ; INSERT THIS DIGIT +; -------------------------------- +FIN_3 CMP #LOCHAR(`.') ; CHECK FOR DECIMAL POINT +BEQ FIN_10 ; YES +CMP #LOCHAR(`E') ; CHECK FOR EXPONENT PART +BNE FIN_7 ; NO, END OF NUMBER +JSR CHRGET ; YES, START CONVERTING EXPONENT +BCC FIN_5 ; EXPONENT DIGIT +CMP #TOKEN_MINUS ; NEGATIVE EXPONENT? +BEQ L_FIN_3_1 ; YES +CMP #LOCHAR(`-') ; MIGHT NOT BE TOKENIZED YET +BEQ L_FIN_3_1 ; YES, IT IS NEGATIVE +CMP #TOKEN_PLUS ; OPTIONAL "+" +BEQ FIN_4 ; YES +CMP #LOCHAR(`+') ; MIGHT NOT BE TOKENIZED YET +BEQ FIN_4 ; YES, FOUND "+" +BNE FIN_6 ; ...ALWAYS, NUMBER COMPLETED +L_FIN_3_1 ROR EXPSGN ; C=1, SET FLAG NEGATIVE +; -------------------------------- +FIN_4 JSR CHRGET ; GET NEXT DIGIT OF EXPONENT +; -------------------------------- +FIN_5 BCC GETEXP ; CHAR IS A DIGIT OF EXPONENT +; -------------------------------- +FIN_6 BIT EXPSGN ; END OF NUMBER, CHECK EXP SIGN +BPL FIN_7 ; POSITIVE EXPONENT +LDA #0 ; NEGATIVE EXPONENT +SEC ; MAKE 2'S COMPLEMENT OF EXPONENT +SBC EXPON ; +JMP FIN_8 ; +; -------------------------------- +; FOUND A DECIMAL POINT +; -------------------------------- +FIN_10 ROR DPFLG ; C=1, SET DPFLG FOR DECIMAL POINT +BIT DPFLG ; CHECK IF PREVIOUS DEC. PT. +BVC FIN_1 ; NO PREVIOUS DECIMAL POINT +; A SECOND DECIMAL POINT IS TAKEN AS A TERMINATOR +; TO THE NUMERIC STRING. +; "A=11..22" WILL GIVE A SYNTAX ERROR, BECAUSE +; IT IS TWO NUMBERS WITH NO OPERATOR BETWEEN. +; "PRINT 11..22" GIVES NO ERROR, BECAUSE IT IS +; JUST THE CONCATENATION OF TWO NUMBERS. +; -------------------------------- +; NUMBER TERMINATED, ADJUST EXPONENT NOW +; -------------------------------- +FIN_7 LDA EXPON ; E-VALUE +FIN_8 SEC ; MODIFY WITH COUNT OF DIGITS +SBC TMPEXP ; AFTER THE DECIMAL POINT +STA EXPON ; COMPLETE CURRENT EXPONENT +BEQ L_FIN_8_15 ; NO ADJUST NEEDED IF EXP=0 +BPL L_FIN_8_14 ; EXP>0, MULTIPLY BY TEN +L_FIN_8_13 JSR DIV10 ; EXP<0, DIVIDE BY TEN +INC EXPON ; UNTIL EXP=0 +BNE L_FIN_8_13 ; +BEQ L_FIN_8_15 ; ...ALWAYS, WE ARE FINISHED +L_FIN_8_14 JSR MUL10 ; EXP>0, MULTIPLY BKY TEN +DEC EXPON ; UNTIL EXP=0 +BNE L_FIN_8_14 ; +L_FIN_8_15 LDA SERLEN ; IS WHOLE NUMBER NEGATIVE? +BMI L_FIN_8_16 ; YES +RTS ; NO, RETURN, WHOLE JOB DONE! +L_FIN_8_16 JMP NEGOP ; NEGATIVE NUMBER, SO NEGATE FAC +; -------------------------------- +; ACCUMULATE A DIGIT INTO FAC +; -------------------------------- +FIN_9 PHA ; SAVE DIGIT +BIT DPFLG ; SEEN A DECIMAL POINT YET? +BPL L_FIN_9_1 ; NO, STILL IN INTEGER PART +INC TMPEXP ; YES, COUNT THE FRACTIONAL DIGIT +L_FIN_9_1 JSR MUL10 ; FAC = FAC * 10 +PLA ; CURRENT DIGIT +SEC ; <<>> +SBC #LOCHAR(`0') ; <<>> +JSR ADDACC ; ADD THE DIGIT +JMP FIN_1 ; GO BACK FOR MORE +; -------------------------------- +; ADD (A) TO FAC +; -------------------------------- +ADDACC PHA ; SAVE ADDEND +JSR COPY_FAC_TO_ARG_ROUNDED +PLA ; GET ADDEND AGAIN +JSR FLOAT ; CONVERT TO FP VALUE IN FAC +LDA ARG_SIGN ; +EOR FAC_SIGN ; +STA SGNCPR ; +LDX FAC ; TO SIGNAL IF FAC=0 +JMP FADDT ; PERFORM THE ADDITION +; -------------------------------- +; ACCUMULATE DIGIT OF EXPONENT +; -------------------------------- +GETEXP LDA EXPON ; CHECK CURRENT VALUE +CMP #10 ; FOR MORE THAN 2 DIGITS +BCC L_GETEXP_1 ; NO, THIS IS 1ST OR 2ND DIGIT +LDA #100 ; EXPONENT TOO BIG +BIT EXPSGN ; UNLESS IT IS NEGATIVE +BMI L_GETEXP_2 ; LARGE NEGATIVE EXPONENT MAKES FAC=0 +JMP OVERFLOW ; LARGE POSITIVE EXPONENT IS ERROR +L_GETEXP_1 ASL ; EXPONENT TIMES 10 +ASL ; +CLC ; +ADC EXPON ; +ASL ; +CLC ; <<< ASL ALREADY DID THIS! >>> +LDY #0 ; ADD THE NEW DIGIT +ADC (TXTPTR),Y ; BUT THIS IS IN ASCII, +SEC ; SO ADJUST BACK TO BINARY +SBC #LOCHAR(`0') +L_GETEXP_2 STA EXPON ; NEW VALUE +JMP FIN_4 ; BACK FOR MORE +; -------------------------------- +; -------------------------------- + +CON_99999999P9 ASM_DATA($9B,$3E,$BC,$1F,$FD) ; 99,999,999.9 +CON_999999999 ASM_DATA($9E,$6E,$6B,$27,$FD) ; 999,999,999 +CON_BILLION ASM_DATA($9E,$6E,$6B,$28,$00) ; 1,000,000,000 +; -------------------------------- +; PRINT "IN " +; -------------------------------- +INPRT LDA #QT_IN +JSR GO_STROUT +LDA CURLIN+1 +LDX CURLIN +; -------------------------------- +; PRINT A,X AS DECIMAL INTEGER +; -------------------------------- +LINPRT STA FAC+1 ; PRINT A,X IN DECIMAL +STX FAC+2 ; +LDX #$90 ; EXPONENT = 2^16 +SEC ; CONVERT UNSIGNED +JSR FLOAT_2 ; CONVERT LINE # TO FP +; -------------------------------- +; CONVERT (FAC) TO STRING, AND PRINT IT +; -------------------------------- +PRINT_FAC ; +JSR FOUT ; CONVERT (FAC) TO STRING AT STACK +; -------------------------------- +; PRINT STRING STARTING AT Y,A +; -------------------------------- +GO_STROUT ; +JMP STROUT ; PRINT STRING AT A,Y +; -------------------------------- +; CONVERT (FAC) TO STRING STARTING AT STACK +; RETURN WITH (Y,A) POINTING AT STRING +; -------------------------------- +FOUT LDY #1 ; NORMAL ENTRY PUTS STRING AT STACK... +; -------------------------------- +; "STR$" FUNCTION ENTERS HERE, WITH (Y)=0 +; SO THAT RESULT STRING STARTS AT STACK-1 +; (THIS IS USED AS A FLAG) +; -------------------------------- +FOUT_1 LDA #LOCHAR(`-') ; IN CASE VALUE NEGATIVE +DEY ; BACK UP PNTR +BIT FAC_SIGN ; +BPL L_FOUT_1_1 ; VALUE IS + +INY ; VALUE IS - +STA STACK-1,Y ; EMIT "-" +L_FOUT_1_1 STA FAC_SIGN ; MAKE FAC.SIGN POSITIVE ($2D) +STY STRNG2 ; SAVE STRING PNTR +INY ; +LDA #LOCHAR(`0') ; IN CASE (FAC)=0 +LDX FAC ; NUMBER=0? +BNE L_FOUT_1_2 ; NO, (FAC) NOT ZERO +JMP FOUT_4 ; YES, FINISHED +; -------------------------------- +L_FOUT_1_2 LDA #0 ; STARTING VALUE FOR TMPEXP +CPX #$80 ; ANY INTEGER PART? +BEQ L_FOUT_1_3 ; NO, BTWN L_FOUT_1_5 AND L_FOUT_1_999999999 +BCS L_FOUT_1_4 ; YES +; -------------------------------- +L_FOUT_1_3 LDA #CON_BILLION ; TO GIVE ADJUSTMENT A HEAD START +JSR FMULT ; +LDA #$100-9 ; EXPONENT ADJUSTMENT +L_FOUT_1_4 STA TMPEXP ; 0 OR -9 +; -------------------------------- +; ADJUST UNTIL 1E8 <= (FAC) <1E9 +; -------------------------------- +L_FOUT_1_5 LDA #CON_999999999 +JSR FCOMP ; COMPARE TO 1E9-1 +BEQ L_FOUT_1_10 ; (FAC) = 1E9-1 +BPL L_FOUT_1_8 ; TOO LARGE, DIVIDE BY TEN +L_FOUT_1_6 LDA #CON_99999999P9 +JSR FCOMP ; COMPARE TO 1E8-L_FOUT_1_1 +BEQ L_FOUT_1_7 ; (FAC) = 1E8-L_FOUT_1_1 +BPL L_FOUT_1_9 ; IN RANGE, ADJUSTMENT FINISHED +L_FOUT_1_7 JSR MUL10 ; TOO SMALL, MULTIPLY BY TEN +DEC TMPEXP ; KEEP TRACK OF MULTIPLIES +BNE L_FOUT_1_6 ; ...ALWAYS +L_FOUT_1_8 JSR DIV10 ; TOO LARGE, DIVIDE BY TEN +INC TMPEXP ; KEEP TRACK OF DIVISIONS +BNE L_FOUT_1_5 ; ...ALWAYS +; -------------------------------- +L_FOUT_1_9 JSR FADDH ; ROUND ADJUSTED RESULT +L_FOUT_1_10 JSR QINT ; CONVERT ADJUSTED VALUE TO 32-BIT INTEGER +; -------------------------------- +; FAC+1...FAC+4 IS NOW IN INTEGER FORM +; WITH POWER OF TEN ADJUSTMENT IN TMPEXP +; +; IF -10 < TMPEXP > 1, PRINT IN DECIMAL FORM +; OTHERWISE, PRINT IN EXPONENTIAL FORM +; -------------------------------- +FOUT_2 LDX #1 ; ASSUME 1 DIGIT BEFORE "." +LDA TMPEXP ; CHECK RANGE +CLC ; +ADC #10 ; +BMI L_FOUT_2_1 ; < .01, USE EXPONENTIAL FORM +CMP #11 ; +BCS L_FOUT_2_2 ; >= 1E10, USE EXPONENTIAL FORM +ADC #$FF ; LESS 1 GIVES INDEX FOR "." +TAX ; +LDA #2 ; SET REMAINING EXPONENT = 0 +L_FOUT_2_1 SEC ; COMPUTE REMAINING EXPONENT +L_FOUT_2_2 SBC #2 ; +STA EXPON ; VALUE FOR "E+XX" OR "E-XX" +STX TMPEXP ; INDEX FOR DECIMAL POINT +TXA ; SEE IF "." COMES FIRST +BEQ L_FOUT_2_3 ; YES +BPL L_FOUT_2_5 ; NO, LATER +L_FOUT_2_3 LDY STRNG2 ; GET INDEX INTO STRING BEING BUILT +LDA #LOCHAR(`.') ; STORE A DECIMAL POINT +INY ; +STA STACK-1,Y ; +TXA ; SEE IF NEED ".0" +BEQ L_FOUT_2_4 ; NO +LDA #LOCHAR(`0') ; YES, STORE "0" +INY ; +STA STACK-1,Y ; +L_FOUT_2_4 STY STRNG2 ; SAVE OUTPUT INDEX AGAIN +; -------------------------------- +; NOW DIVIDE BY POWERS OF TEN TO GET SUCCESSIVE DIGITS +; -------------------------------- +L_FOUT_2_5 LDY #0 ; INDEX TO TABLE OF POWERS OF TEN +LDX #$80 ; STARTING VALUE FOR DIGIT WITH DIRECTION +L_FOUT_2_6 LDA FAC+4 ; START BY ADDING -100000000 UNTIL +CLC ; OVERSHOOT. THEN ADD +10000000, +ADC DECTBL+3,Y ; THEN ADD -1000000, THEN ADD +STA FAC+4 ; +100000, AND SO ON. +LDA FAC+3 ; THE # OF TIMES EACH POWER IS ADDED +ADC DECTBL+2,Y ; IS 1 MORE THAN CORRESPONDING DIGIT +STA FAC+3 +LDA FAC+2 +ADC DECTBL+1,Y +STA FAC+2 +LDA FAC+1 +ADC DECTBL,Y +STA FAC+1 +INX ; COUNT THE ADD +BCS L_FOUT_2_7 ; IF C=1 AND X NEGATIVE, KEEP ADDING +BPL L_FOUT_2_6 ; IF C=0 AND X POSITIVE, KEEP ADDING +BMI L_FOUT_2_8 ; IF C=0 AND X NEGATIVE, WE OVERSHOT +L_FOUT_2_7 BMI L_FOUT_2_6 ; IF C=1 AND X POSITIVE, WE OVERSHOT +L_FOUT_2_8 TXA ; OVERSHOT, SO MAKE X INTO A DIGIT +BCC L_FOUT_2_9 ; HOW DEPENDS ON DIRECTION WE WERE GOING +EOR #$FF ; DIGIT = 9-X +ADC #10 ; +L_FOUT_2_9 ADC #LOCHAR(`0')-1 ; MAKE DIGIT INTO ASCII +INY ; ADVANCE TO NEXT SMALLER POWER OF TEN +INY ; +INY ; +INY ; +STY VARPNT ; SAVE PNTR TO POWERS +LDY STRNG2 ; GET OUTPUT PNTR +INY ; STORE THE DIGIT +TAX ; SAVE DIGIT, HI-BIT IS DIRECTION +AND #$7F ; MAKE SURE $30...$39 FOR STRING +STA STACK-1,Y ; +DEC TMPEXP ; COUNT THE DIGIT +BNE L_FOUT_2_10 ; NOT TIME FOR "." YET +LDA #LOCHAR(`.') ; TIME, SO STORE THE DECIMAL POINT +INY ; +STA STACK-1,Y ; +L_FOUT_2_10 STY STRNG2 ; SAVE OUTPUT PNTR AGAIN +LDY VARPNT ; GET PNTR TO POWERS +TXA ; GET DIGIT WITH HI-BIT = DIRECTION +EOR #$FF ; CHANGE DIRECTION +AND #$80 ; $00 IF ADDING, $80 IF SUBTRACTING +TAX +CPY #DECTBL_END-DECTBL +BNE L_FOUT_2_6 ; NOT FINISHED YET +; -------------------------------- +; NINE DIGITS HAVE BEEN STORED IN STRING. NOW LOOK +; BACK AND LOP OFF TRAILING ZEROES AND A TRAILING +; DECIMAL POINT. +; -------------------------------- +FOUT_3 LDY STRNG2 ; POINTS AT LAST STORED CHAR +L_FOUT_3_1 LDA STACK-1,Y ; SEE IF LOPPABLE +DEY ; +CMP #LOCHAR(`0') ; SUPPRESS TRAILING ZEROES +BEQ L_FOUT_3_1 ; YES, KEEP LOOPING +CMP #LOCHAR(`.') ; SUPPRESS TRAILING DECIMAL POINT +BEQ L_FOUT_3_2 ; ".", SO WRITE OVER IT +INY ; NOT ".", SO INCLUDE IN STRING AGAIN +L_FOUT_3_2 LDA #LOCHAR(`+') ; PREPARE FOR POSITIVE EXPONENT "E+XX" +LDX EXPON ; SEE IF ANY E-VALUE +BEQ FOUT_5 ; NO, JUST MARK END OF STRING +BPL L_FOUT_3_3 ; YES, AND IT IS POSITIVE +LDA #0 ; YES, AND IT IS NEGATIVE +SEC ; COMPLEMENT THE VALUE +SBC EXPON ; +TAX ; GET MAGNITUDE IN X +LDA #LOCHAR(`-') ; E SIGN +L_FOUT_3_3 STA STACK+1,Y ; STORE SIGN IN STRING +LDA #LOCHAR(`E') ; STORE "E" IN STRING BEFORE SIGN +STA STACK,Y ; +TXA ; EXPONENT MAGNITUDE IN A-REG +LDX #LOCHAR(`0')-1 ; SEED FOR EXPONENT DIGIT +SEC ; CONVERT TO DECIMAL +L_FOUT_3_4 INX ; COUNT THE SUBTRACTION +SBC #10 ; TEN'S DIGIT +BCS L_FOUT_3_4 ; MORE TENS TO SUBTRACT +ADC #LOCHAR(`0')+10 ; CONVERT REMAINDER TO ONE'S DIGIT +STA STACK+3,Y ; STORE ONE'S DIGIT +TXA ; +STA STACK+2,Y ; STORE TEN'S DIGIT +LDA #0 ; MARK END OF STRING WITH $00 +STA STACK+4,Y ; +BEQ FOUT_6 ; ...ALWAYS +FOUT_4 STA STACK-1,Y ; STORE "0" IN ASCII +FOUT_5 LDA #0 ; STORE $00 ON END OF STRING +STA STACK,Y ; +FOUT_6 LDA #STACK ; (STR$ STARTED STRING AT STACK-1, BUT +RTS ; STR$ DOESN'T USE Y,A ANYWAY.) +; -------------------------------- + +CON_HALF ASM_DATA($80,$00,$00,$00,$00) ; FP CONSTANT 0L_CON_HALF_5 +; -------------------------------- +; POWERS OF 10 FROM 1E8 DOWN TO 1, +; AS 32-BIT INTEGERS, WITH ALTERNATING SIGNS +; -------------------------------- + +DECTBL ASM_DATA($FA,$0A,$1F,$00) ; -100000000 +ASM_DATA($00,$98,$96,$80) ; 10000000 +ASM_DATA($FF,$F0,$BD,$C0) ; -1000000 +ASM_DATA($00,$01,$86,$A0) ; 100000 +ASM_DATA($FF,$FF,$D8,$F0) ; -10000 +ASM_DATA($00,$00,$03,$E8) ; 1000 +ASM_DATA($FF,$FF,$FF,$9C) ; -100 +ASM_DATA($00,$00,$00,$0A) ; 10 +ASM_DATA($FF,$FF,$FF,$FF) ; -1 +DECTBL_END +; -------------------------------- +; -------------------------------- +; "SQR" FUNCTION +; +; <<< UNFORTUNATELY, RATHER THAN A NEWTON-RAPHSON >>> +; <<< ITERATION, APPLESOFT USES EXPONENTIATION >>> +; <<< SQR(X) = X^L_DECTBL_END_5 >>> +; -------------------------------- +SQR JSR COPY_FAC_TO_ARG_ROUNDED +LDA #CON_HALF +JSR LOAD_FAC_FROM_YA +; -------------------------------- +; EXPONENTIATION OPERATION +; +; ARG ^ FAC = EXP( LOG(ARG) * FAC ) +; -------------------------------- +FPWRT BEQ EXP ; IF FAC=0, ARG^FAC=EXP(0) +LDA ARG ; IF ARG=0, ARG^FAC=0 +BNE L_FPWRT_1 ; NEITHER IS ZERO +JMP STA_IN_FAC_SIGN_AND_EXP ; SET FAC = 0 +L_FPWRT_1 LDX #TEMP3 ; SAVE FAC IN TEMP3 +LDY #0 +JSR STORE_FACDB_YX_ROUNDED +LDA ARG_SIGN ; NORMALLY, ARG MUST BE POSITIVE +BPL L_FPWRT_2 ; IT IS POSITIVE, SO ALL IS WELL +JSR INT ; NEGATIVE, BUT OK IF INTEGRAL POWER +LDA #TEMP3 ; SEE IF INT(FAC)=FAC +LDY #0 ; +JSR FCOMP ; IS IT AN INTEGER POWER? +BNE L_FPWRT_2 ; NOT INTEGRAL, WILL CAUSE ERROR LATER +TYA ; MAKE ARG SIGN + AS IT IS MOVED TO FAC +LDY CHARAC ; INTEGRAL, SO ALLOW NEGATIVE ARG +L_FPWRT_2 JSR MFA ; MOVE ARGUMENT TO FAC +TYA ; SAVE FLAG FOR NEGATIVE ARG (0=+) +PHA ; +JSR LOG ; GET LOG(ARG) +LDA #TEMP3 ; MULTIPLY BY POWER +LDY #0 ; +JSR FMULT ; +JSR EXP ; E ^ LOG(FAC) +PLA ; GET FLAG FOR NEGATIVE ARG +LSR ; <<>> +BCC RTS_18 ; NOT NEGATIVE, FINISHED +; NEGATIVE ARG, SO NEGATE RESULT +; -------------------------------- +; NEGATE VALUE IN FAC +; -------------------------------- +NEGOP LDA FAC ; IF FAC=0, NO NEED TO COMPLEMENT +BEQ RTS_18 ; YES, FAC=0 +LDA FAC_SIGN ; NO, SO TOGGLE SIGN +EOR #$FF +STA FAC_SIGN +RTS_18 RTS +; -------------------------------- + +CON_LOG_E ASM_DATA($81,$38,$AA,$3B,$29) ; LOG(E) TO BASE 2 +; -------------------------------- +POLY_EXP ASM_DATA(7) ; ( # OF TERMS IN POLYNOMIAL) - 1 +ASM_DATA($71,$34,$58,$3E,$56) ; (LOG(2)^7)/8! +ASM_DATA($74,$16,$7E,$B3,$1B) ; (LOG(2)^6)/7! +ASM_DATA($77,$2F,$EE,$E3,$85) ; (LOG(2)^5)/6! +ASM_DATA($7A,$1D,$84,$1C,$2A) ; (LOG(2)^4)/5! +ASM_DATA($7C,$63,$59,$58,$0A) ; (LOG(2)^3)/4! +ASM_DATA($7E,$75,$FD,$E7,$C6) ; (LOG(2)^2)/3! +ASM_DATA($80,$31,$72,$18,$10) ; LOG(2)/2! +ASM_DATA($81,$00,$00,$00,$00) ; 1 +; -------------------------------- +; "EXP" FUNCTION +; +; FAC = E ^ FAC +; -------------------------------- +EXP LDA #CON_LOG_E ; E^X = 2^(LOG2(E)*X) +JSR FMULT ; +LDA FAC_EXTENSION ; NON-STANDARD ROUNDING HERE +ADC #$50 ; ROUND UP IF EXTENSION > $AF +BCC L_EXP_1 ; NO, DON'T ROUND UP +JSR INCREMENT_MANTISSA +L_EXP_1 STA ARG_EXTENSION ; STRANGE VALUE +JSR MAF ; COPY FAC INTO ARG +LDA FAC ; MAXIMUM EXPONENT IS < 128 +CMP #$88 ; WITHIN RANGE? +BCC L_EXP_3 ; YES +L_EXP_2 JSR OUTOFRNG ; OVERFLOW IF +, RETURN 0.0 IF - +L_EXP_3 JSR INT ; GET INT(FAC) +LDA CHARAC ; THIS IS THE INETGRAL PART OF THE POWER +CLC ; ADD TO EXPONENT BIAS + 1 +ADC #$81 ; +BEQ L_EXP_2 ; OVERFLOW +SEC ; BACK OFF TO NORMAL BIAS +SBC #1 ; +PHA ; SAVE EXPONENT +; -------------------------------- +LDX #5 ; SWAP ARG AND FAC +L_EXP_4 LDA ARG,X ; <<< WHY SWAP? IT IS DOING >>> +LDY FAC,X ; <<< -(A-B) WHEN (B-A) IS THE >>> +STA FAC,X ; <<< SAME THING! >>> +STY ARG,X +DEX +BPL L_EXP_4 +LDA ARG_EXTENSION +STA FAC_EXTENSION +JSR FSUBT ; POWER-INT(POWER) --> FRACTIONAL PART +JSR NEGOP +LDA #POLY_EXP +JSR POLYNOMIAL ; COMPUTE F(X) ON FRACTIONAL PART +LDA #0 +STA SGNCPR +PLA ; GET EXPONENT +JSR ADD_EXPONENTS_1 +RTS ; <<< WASTED BYTE HERE, COULD HAVE >>> +; <<< JUST USED "JMP ADD.EXPO..." >>> +; -------------------------------- +; ODD POLYNOMIAL SUBROUTINE +; +; F(X) = X * P(X^2) +; +; WHERE: X IS VALUE IN FAC +; Y,A POINTS AT COEFFICIENT TABLE +; FIRST BYTE OF COEFF. TABLE IS N +; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST +; +; P(X^2) COMPUTED USING NORMAL POLYNOMIAL SUBROUTINE +; +; -------------------------------- +POLYNOMIAL_ODD +STA SERPNT ; SAVE ADDRESS OF COEFFICIENT TABLE +STY SERPNT+1 +JSR STORE_FAC_IN_TEMP1_ROUNDED +LDA #TEMP1 ; Y=0 ALREADY, SO Y,A POINTS AT TEMP1 +JSR FMULT ; FORM X^2 +JSR SERMAIN ; DO SERIES IN X^2 +LDA #TEMP1 ; +JMP FMULT ; MULTIPLY X BY P(X^2) AND EXIT +; -------------------------------- +; NORMAL POLYNOMIAL SUBROUTINE +; +; P(X) = C(0)*X^N + C(1)*X^(N-1) + ... + C(N) +; +; WHERE: X IS VALUE IN FAC +; Y,A POINTS AT COEFFICIENT TABLE +; FIRST BYTE OF COEFF. TABLE IS N +; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST +; +; -------------------------------- +POLYNOMIAL +STA SERPNT ; POINTER TO COEFFICIENT TABLE +STY SERPNT+1 +; -------------------------------- +SERMAIN +JSR STORE_FAC_IN_TEMP2_ROUNDED +LDA (SERPNT),Y ; GET N +STA SERLEN ; SAVE N +LDY SERPNT ; BUMP PNTR TO HIGHEST COEFFICIENT +INY ; AND GET PNTR INTO Y,A +TYA +BNE L_SERMAIN_1 +INC SERPNT+1 +L_SERMAIN_1 STA SERPNT +LDY SERPNT+1 +L_SERMAIN_2 JSR FMULT ; ACCUMULATE SERIES TERMS +LDA SERPNT ; BUMP PNTR TO NEXT COEFFICIENT +LDY SERPNT+1 +CLC +ADC #5 +BCC L_SERMAIN_3 +INY +L_SERMAIN_3 STA SERPNT +STY SERPNT+1 +JSR FADD ; ADD NEXT COEFFICIENT +LDA #TEMP2 ; POINT AT X AGAIN +LDY #0 ; +DEC SERLEN ; IF SERIES NOT FINISHED, +BNE L_SERMAIN_2 ; THEN ADD ANOTHER TERM +RTS_19 RTS ; FINISHED +; -------------------------------- + +CON_RND_1 ASM_DATA($98,$35,$44,$7A) ; <<< THESE ARE MISSING ONE BYTE >>> +CON_RND_2 ASM_DATA($68,$28,$B1,$46) ; <<< FOR FP VALUES >>> +; -------------------------------- +; "RND" FUNCTION +; -------------------------------- +RND JSR SIGN ; REDUCE ARGUMENT TO -1, 0, OR +1 +TAX ; SAVE ARGUMENT +BMI L_RND_1 ; = -1, USE CURRENT ARGUMENT FOR SEED +LDA #RNDSEED +JSR LOAD_FAC_FROM_YA +TXA ; RECALL SIGN OF ARGUMENT +BEQ RTS_19 ; =0, RETURN SEED UNCHANGED +LDA #CON_RND_1 +JSR FMULT +LDA #CON_RND_2 ; <<>> +; <<>> +JSR FADD +L_RND_1 LDX FAC+4 ; SHUFFLE HI AND LO BYTES +LDA FAC+1 ; TO SUPPOSEDLY MAKE IT MORE RANDOM +STA FAC+4 ; +STX FAC+1 ; +LDA #0 ; MAKE IT POSITIVE +STA FAC_SIGN ; +LDA FAC ; A SOMEWHAT RANDOM EXTENSION +STA FAC_EXTENSION +LDA #$80 ; EXPONENT TO MAKE VALUE < 1.0 +STA FAC +JSR NORMALIZE_FAC_2 +LDX #RNDSEED +GO_MOVMF JMP STORE_FACDB_YX_ROUNDED +; -------------------------------- +; -------------------------------- +; "COS" FUNCTION +; -------------------------------- +COS LDA #CON_PI_HALF +JSR FADD +; -------------------------------- +; "SIN" FUNCTION +; -------------------------------- +SIN JSR COPY_FAC_TO_ARG_ROUNDED +LDA #CON_PI_DOUB ; BY DIVIDING AND SAVING +LDX ARG_SIGN ; THE FRACTIONAL PART +JSR DIV ; USE SIGN OF ARGUMENT +JSR COPY_FAC_TO_ARG_ROUNDED +JSR INT ; TAKE INTEGER PART +LDA #0 ; <<< WASTED LINES, BECAUSE FSUBT >>> +STA SGNCPR ; <<< CHANGES SGNCPR AGAIN >>> +JSR FSUBT ; SUBTRACT TO GET FRACTIONAL PART +; -------------------------------- +; (FAC) = ANGLE AS A FRACTION OF A FULL CIRCLE +; +; NOW FOLD THE RANGE INTO A QUARTER CIRCLE +; +; <<< THERE ARE MUCH SIMPLER WAYS TO DO THIS >>> +; -------------------------------- +LDA #QUARTER ; -3/4 <= FRACTION < 1/4 +JSR FSUB ; +LDA FAC_SIGN ; TEST SIGN OF RESULT +PHA ; SAVE SIGN FOR LATER UNFOLDING +BPL SIN_1 ; ALREADY 0...1/4 +JSR FADDH ; ADD 1/2 TO SHIFT TO -1/4...1/2 +LDA FAC_SIGN ; TEST SIGN +BMI SIN_2 ; -1/4...0 +; 0...1/2 +LDA SIGNFLG ; SIGNFLG INITIALIZED = 0 IN "TAN" +EOR #$FF ; FUNCTION +STA SIGNFLG ; "TAN" IS ONLY USER OF SIGNFLG TOO +; -------------------------------- +; IF FALL THRU, RANGE IS 0...1/2 +; IF BRANCH HERE, RANGE IS 0...1/4 +; -------------------------------- +SIN_1 JSR NEGOP +; -------------------------------- +; IF FALL THRU, RANGE IS -1/2...0 +; IF BRANCH HERE, RANGE IS -1/4...0 +; -------------------------------- +SIN_2 LDA #QUARTER ; TO -1/4...1/4 +JSR FADD ; +PLA ; GET SAVED SIGN FROM ABOVE +BPL L_SIN_2_1 ; +JSR NEGOP ; MAKE RANGE 0...1/4 +L_SIN_2_1 LDA #POLY_SIN ; +JMP POLYNOMIAL_ODD ; +; -------------------------------- +; "TAN" FUNCTION +; +; COMPUTE TAN(X) = SIN(X) / COS(X) +; -------------------------------- +TAN JSR STORE_FAC_IN_TEMP1_ROUNDED +LDA #0 ; SIGNFLG WILL BE TOGGLED IF 2ND OR 3RD +STA SIGNFLG ; QUADRANT +JSR SIN ; GET SIN(X) +LDX #TEMP3 ; +JSR GO_MOVMF ; <<>> +LDA #TEMP1 ; +JSR LOAD_FAC_FROM_YA +LDA #0 ; AND COMPUTE COS(X) +STA FAC_SIGN ; +LDA SIGNFLG ; +JSR TAN_1 ; WEIRD & DANGEROUS WAY TO GET INTO SIN +LDA #TEMP3 ; +JMP FDIV ; +; -------------------------------- +TAN_1 PHA ; SHAME, SHAME! +JMP SIN_1 +; -------------------------------- + +CON_PI_HALF ASM_DATA($81,$49,$0F,$DA,$A2) +CON_PI_DOUB ASM_DATA($83,$49,$0F,$DA,$A2) +QUARTER ASM_DATA($7F,$00,$00,$00,$00) +; -------------------------------- +POLY_SIN ASM_DATA(5) ; POWER OF POLYNOMIAL +ASM_DATA($84,$E6,$1A,$2D,$1B) ; (2PI)^11/11! +ASM_DATA($86,$28,$07,$FB,$F8) ; (2PI)^9/9! +ASM_DATA($87,$99,$68,$89,$01) ; (2PI)^7/7! +ASM_DATA($87,$23,$35,$DF,$E1) ; (2PI)^5/5! +ASM_DATA($86,$A5,$5D,$E7,$28) ; (2PI)^3/3! +ASM_DATA($83,$49,$0F,$DA,$A2) ; 2PI + + + +; -------------------------------- +; <<< NEXT TEN BYTES ARE NEVER REFERENCED >>> +; OBFUSCATED "MICROSOFT!" BY BILL GATES +; (REVERSED, HIGH BIT SET, XOR 7) +; -------------------------------- + +define(`GATES_OBFUSCATE', +`STR_FORCHAR(__,STR_REVERSE($1),`ASM_DATA(HICHAR(__)^7) NL()')') + + +GATES_OBFUSCATE(`MICROSOFT!') + + + + + +; -------------------------------- +; "ATN" FUNCTION +; -------------------------------- +ATN LDA FAC_SIGN ; FOLD THE ARGUMENT RANGE FIRST +PHA ; SAVE SIGN FOR LATER UNFOLDING +BPL L_ATN_1 ; .GE. 0 +JSR NEGOP ; .LT. 0, SO COMPLEMENT +L_ATN_1 LDA FAC ; IF .GE. 1, FORM RECIPROCAL +PHA ; SAVE FOR LATER UNFOLDING +CMP #$81 ; (EXPONENT FOR .GE. 1 +BCC L_ATN_2 ; X < 1 +LDA #CON_ONE +JSR FDIV +; -------------------------------- +; 0 <= X <= 1 +; 0 <= ATN(X) <= PI/8 +; -------------------------------- +L_ATN_2 LDA #POLY_ATN +JSR POLYNOMIAL_ODD +PLA ; START TO UNFOLD +CMP #$81 ; WAS IT .GE. 1? +BCC L_ATN_3 ; NO +LDA #CON_PI_HALF ; +JSR FSUB ; +L_ATN_3 PLA ; WAS IT NEGATIVE? +BPL RTS_20 ; NO +JMP NEGOP ; YES, COMPLEMENT +RTS_20 RTS +; -------------------------------- +POLY_ATN ASM_DATA(11) ; POWER OF POLYNOMIAL +ASM_DATA($76,$B3,$83,$BD,$D3) +ASM_DATA($79,$1E,$F4,$A6,$F5) +ASM_DATA($7B,$83,$FC,$B0,$10) +ASM_DATA($7C,$0C,$1F,$67,$CA) +ASM_DATA($7C,$DE,$53,$CB,$C1) +ASM_DATA($7D,$14,$64,$70,$4C) +ASM_DATA($7D,$B7,$EA,$51,$7A) +ASM_DATA($7D,$63,$30,$88,$7E) +ASM_DATA($7E,$92,$44,$99,$3A) +ASM_DATA($7E,$4C,$CC,$91,$C7) +ASM_DATA($7F,$AA,$AA,$AA,$13) +ASM_DATA($81,$00,$00,$00,$00) +; -------------------------------- +; GENERIC COPY OF CHRGET SUBROUTINE, WHICH +; IS COPIED INTO $00B1...$00C8 DURING INITIALIZATION +; +; CORNELIS BONGERS DESCRIBED SEVERAL IMPROVEMENTS +; TO CHRGET IN MICRO MAGAZINE OR CALL A.P.P.L.E. +; (I DON'T REMEMBER WHICH OR EXACTLY WHEN) +; -------------------------------- +GENERIC_CHRGET +INC TXTPTR +BNE L_GENERIC_CHRGET_1 +INC TXTPTR+1 +L_GENERIC_CHRGET_1 LDA $EA60 ; <<< ACTUAL ADDRESS FILLED IN LATER >>> +CMP #LOCHAR(`:') ; EOS, ALSO TOP OF NUMERIC RANGE +BCS L_GENERIC_CHRGET_2 ; NOT NUMBER, MIGHT BE EOS +CMP #LOCHAR(` ') ; IGNORE BLANKS +BEQ GENERIC_CHRGET +SEC ; TEST FOR NUMERIC RANGE IN WAY THAT +SBC #LOCHAR(`0') ; CLEARS CARRY IF CHAR IS DIGIT +SEC ; AND LEAVES CHAR IN A-REG +SBC #$D0 +L_GENERIC_CHRGET_2 RTS +; -------------------------------- +; INITIAL VALUE FOR RANDOM NUMBER, ALSO COPIED +; IN ALONG WITH CHRGET, BUT ERRONEOUSLY: +; <<< THE LAST BYTE IS NOT COPIED >>> +; -------------------------------- + +ASM_DATA($80,$4F,$C7,$52,$58) ; APPROX. = L_GENERIC_CHRGET_811635157 +GENERIC_END +; -------------------------------- +COLD_START +LDX #$FF ; SET DIRECT MODE FLAG +STX CURLIN+1 ; +LDX #$FB ; SET STACK POINTER, LEAVING ROOM FOR +TXS ; LINE BUFFER DURING PARSING +LDA #COLD_START ; UNTIL COLDSTART IS COMPLETED +STA GOWARM+1 ; +STY GOWARM+2 ; +STA GOSTROUT+1 ; ALSO SECOND USER VECTOR... +STY GOSTROUT+2 ; ..WE SIMPLY MUST FINISH COLD.START! +JSR NORMAL ; SET NORMAL DISPLAY MODE +LDA #$4C ; "JMP" OPCODE FOR 4 VECTORS +STA GOWARM ; WARM START +STA GOSTROUT ; ANYONE EVER USE THIS ONE? +STA JMPADRS ; USED BY FUNCTIONS (JSR JMPADRS) +STA USR ; "USR" FUNCTION VECTOR +LDA #IQERR ; ERROR, UNTIL USER SETS IT UP +STA USR+1 +STY USR+2 +; -------------------------------- +; MOVE GENERIC CHRGET AND RANDOM SEED INTO PLACE +; +; <<< NOTE THAT LOOP VALUE IS WRONG! >>> +; <<< THE LAST BYTE OF THE RANDOM SEED IS NOT >>> +; <<< COPIED INTO PAGE ZERO! >>> +; -------------------------------- +LDX #GENERIC_END-GENERIC_CHRGET-1 +L_COLD_START_1 LDA GENERIC_CHRGET-1,X +STA CHRGET-1,X +STX SPEEDZ ; ON LAST PASS STORES $01) +DEX +BNE L_COLD_START_1 +; -------------------------------- +STX TRCFLG ; X=0, TURN OFF TRACING +TXA ; A=0 +STA SHIFT_SIGN_EXT +STA LASTPT+1 +PHA ; PUT $00 ON STACK (WHAT FOR?) +LDA #3 ; SET LENGTH OF TEMP. STRING DESCRIPTORS +STA DSCLEN ; FOR GARBAGE COLLECTION SUBROUTINE +JSR CRDO ; PRINT +LDA #1 ; SET UP FAKE FORWARD LINK +STA INPUT_BUFFER-3 +STA INPUT_BUFFER-4 +LDX #TEMPST ; INIT INDEX TO TEMP STRING DESCRIPTORS +STX TEMPPT +; -------------------------------- +; FIND HIGH END OF RAM +; -------------------------------- +LDA #<$0800 ; SET UP POINTER TO LOW END OF RAM +LDY #>$0800 +STA LINNUM +STY LINNUM+1 +LDY #0 +L_COLD_START_2 INC LINNUM+1 ; TEST FIRST BYTE OF EACH PAGE +LDA (LINNUM),Y ; BY COMPLEMENTING IT AND WATCHING +EOR #$FF ; IT CHANGE THE SAME WAY +STA (LINNUM),Y ; +CMP (LINNUM),Y ; ROM OR EMPTY SOCKETS WON'T TRACK +BNE L_COLD_START_3 ; NOT RAM HERE +EOR #$FF ; RESTORE ORIGINAL VALUE +STA (LINNUM),Y ; +CMP (LINNUM),Y ; DID IT TRACK AGAIN? +BEQ L_COLD_START_2 ; YES, STILL IN RAM +L_COLD_START_3 LDY LINNUM ; NO, END OF RAM +LDA LINNUM+1 ; +AND #$F0 ; FORCE A MULTIPLE OF 4096 BYTES +STY MEMSIZ ; (BAD RAM MAY HAVE YIELDED NON-MULTIPLE) +STA MEMSIZ+1 ; +STY FRETOP ; SET HIMEM AND BOTTOM OF STRINGS +STA FRETOP+1 ; +LDX #<$0800 ; SET PROGRAM POINTER TO $0800 +LDY #>$0800 ; +STX TXTTAB ; +STY TXTTAB+1 ; +LDY #0 ; TURN OFF SEMI-SECRET LOCK FLAG +STY LOCK ; +TYA ; A=0 TOO +STA (TXTTAB),Y ; FIRST BYTE IN PROGRAM SPACE = 0 +INC TXTTAB ; ADVANCE PAST THE $00 +BNE L_COLD_START_4 ; +INC TXTTAB+1 ; +L_COLD_START_4 LDA TXTTAB ; +LDY TXTTAB+1 ; +JSR REASON ; SET REST OF POINTERS UP +JSR SCRTCH ; MORE POINTERS +LDA #STROUT ; USER VECTORS +STA GOSTROUT+1 +STY GOSTROUT+2 +LDA #RESTART +STA GOWARM+1 +STY GOWARM+2 +JMP (GOWARM+1) ; SILLY, WHY NOT JUST "JMP RESTART" +; -------------------------------- +; -------------------------------- +; "CALL" STATEMENT +; +; EFFECTIVELY PERFORMS A "JSR" TO THE SPECIFIED +; ADDRESS, WITH THE FOLLOWING REGISTER CONTENTS: +; (A,Y) = CALL ADDRESS +; (X) = $9D +; +; THE CALLED ROUTINE CAN RETURN WITH "RTS", +; AND APPLESOFT WILL CONTINUE WITH THE NEXT +; STATEMENT. +; -------------------------------- +CALL JSR FRMNUM ; EVALUATE EXPRESSION FOR CALL ADDRESS +JSR GETADR ; CONVERT EXPRESSION TO 16-BIT INTEGER +JMP (LINNUM) ; IN LINNUM, AND JUMP THERE. +; -------------------------------- +; "IN#" STATEMENT +; +; NOTE: NO CHECK FOR VALID SLOT #, AS LONG +; AS VALUE IS < 256 IT IS ACCEPTED. +; MONITOR MASKS VALUE TO 4 BITS (0-15). +; -------------------------------- +IN_NUMBER +JSR GETBYT ; GET SLOT NUMBER IN X-REG +TXA ; MONITOR WILL INSTALL IN VECTOR +JMP MON_INPORT ; AT $38,39. +; -------------------------------- +; "PR#" STATEMENT +; +; NOTE: NO CHECK FOR VALID SLOT #, AS LONG +; AS VALUE IS < 256 IT IS ACCEPTED. +; MONITOR MASKS VALUE TO 4 BITS (0-15). +; -------------------------------- +PR_NUMBER +JSR GETBYT ; GET SLOT NUMBER IN X-REG +TXA ; MONITOR WILL INSTALL IN VECTOR +JMP MON_OUTPORT ; AT $36,37 +; -------------------------------- +; GET TWO VALUES < 48, WITH COMMA SEPARATOR +; +; CALLED FOR "PLOT X,Y" +; AND "HLIN A,B AT Y" +; AND "VLIN A,B AT X" +; +; -------------------------------- +PLOTFNS +JSR GETBYT ; GET FIRST VALUE IN X-REG +CPX #48 ; MUST BE < 48 +BCS GOERR ; TOO LARGE +STX FIRST ; SAVE FIRST VALUE +LDA #LOCHAR(`,') ; MUST HAVE A COMMA +JSR SYNCHR ; +JSR GETBYT ; GET SECOND VALUE IN X-REG +CPX #48 ; MUST BE < 48 +BCS GOERR ; TOO LARGE +STX MON_H2 ; SAVE SECOND VALUE +STX MON_V2 ; +RTS ; SECOND VALUE STILL IN X-REG +; -------------------------------- +GOERR JMP IQERR ; ILLEGAL QUANTITY ERROR +; -------------------------------- +; GET "A,B AT C" VALUES FOR "HLIN" AND "VLIN" +; +; PUT SMALLER OF (A,B) IN FIRST, +; AND LARGER OF (A,B) IN H2 AND V2. +; RETURN WITH (X) = C-VALUE. +; -------------------------------- +LINCOOR +JSR PLOTFNS ; GET A,B VALUES +CPX FIRST ; IS A < B? +BCS L_LINCOOR_1 ; YES, IN RIGHT ORDER +LDA FIRST ; NO, INTERCHANGE THEM +STA MON_H2 ; +STA MON_V2 ; +STX FIRST ; +L_LINCOOR_1 LDA #TOKENDB ; MUST HAVE "AT" NEXT +JSR SYNCHR ; +JSR GETBYT ; GET C-VALUE IN X-REG +CPX #48 ; MUST BE < 48 +BCS GOERR ; TOO LARGE +RTS ; C-VALUE IN X-REG +; -------------------------------- +; "PLOT" STATEMENT +; -------------------------------- +PLOT JSR PLOTFNS ; GET X,Y VALUES +TXA ; Y-COORD TO A-REG FOR MONITOR +LDY FIRST ; X-COORD TO Y-YEG FOR MONITOR +CPY #40 ; X-COORD MUST BE < 40 +BCS GOERR ; X-COORD IS TOO LARGE +JMP MON_PLOT ; PLOT! +; -------------------------------- +; "HLIN" STATEMENT +; -------------------------------- +HLIN JSR LINCOOR ; GET "A,B AT C" +TXA ; Y-COORD IN A-REG +LDY MON_H2 ; RIGHT END OF LINE +CPY #40 ; MUST BE < 40 +BCS GOERR ; TOO LARGE +LDY FIRST ; LEFT END OF LINE IN Y-REG +JMP MON_HLINE ; LET MONITOR DRAW LINE +; -------------------------------- +; "VLIN" STATEMENT +; -------------------------------- +VLIN JSR LINCOOR ; GET "A,B AT C" +TXA ; X-COORD IN Y-REG +TAY ; +CPY #40 ; X-COORD MUST BE < 40 +BCS GOERR ; TOO LARGE +LDA FIRST ; TOP END OF LINE IN A-REG +JMP MON_VLINE ; LET MONITOR DRAW LINE +; -------------------------------- +; "COLOR=" STATEMENT +; -------------------------------- +COLOR JSR GETBYT ; GET COLOR VALUE IN X-REG +TXA ; +JMP MON_SETCOL ; LET MONITOR STORE COLOR +; -------------------------------- +; "VTAB" STATEMENT +; -------------------------------- +VTAB JSR GETBYT ; GET LINE # IN X-REG +DEX ; CONVERT TO ZERO BASE +TXA ; +CMP #24 ; MUST BE 0-23 +BCS GOERR ; TOO LARGE, OR WAS "VTAB 0" +JMP MON_TABV ; LET MONITOR COMPUTE BASE +; -------------------------------- +; "SPEED=" STATEMENT +; -------------------------------- +SPEED JSR GETBYT ; GET SPEED SETTING IN X-REG +TXA ; SPEEDZ = $100-SPEED +EOR #$FF ; SO "SPEED=255" IS FASTEST +TAX ; +INX ; +STX SPEEDZ ; +RTS ; +; -------------------------------- +; "TRACE" STATEMENT +; SET SIGN BIT IN TRCFLG +; -------------------------------- +TRACE SEC ; +ASM_DATA($90) ; FAKE BCC TO SKIP NEXT OPCODE +; -------------------------------- +; "NOTRACE" STATEMENT +; CLEAR SIGN BIT IN TRCFLG +; -------------------------------- +NOTRACE ; +CLC ; +ROR TRCFLG ; SHIFT CARRY INTO TRCFLG +RTS ; +; -------------------------------- +; "NORMAL" STATEMENT +; -------------------------------- +NORMAL LDA #$FF ; SET INVFLG = $FF +BNE N_I_ ; AND FLASH.BIT = $00 +; -------------------------------- +; "INVERSE" STATEMENT +; -------------------------------- +INVERSE ; +LDA #$3F ; SET INVFLG = $3F +N_I_ LDX #0 ; AND FLASH.BIT = $00 +N_I_F_ STA MON_INVFLG +STX FLASH_BIT +RTS +; -------------------------------- +; "FLASH" STATEMENT +; -------------------------------- +FLASH LDA #$7F ; SET INVFLG = $7F +LDX #$40 ; AND FLASH.BIT = $40 +BNE N_I_F_ ; ...ALWAYS +; -------------------------------- +; "HIMEM:" STATEMENT +; -------------------------------- +HIMEM JSR FRMNUM ; GET VALUE SPECIFIED FOR HIMEM +JSR GETADR ; AS 16-BIT INTEGER +LDA LINNUM ; MUST BE ABOVE VARIABLES AND ARRAYS +CMP STREND ; +LDA LINNUM+1 ; +SBC STREND+1 ; +BCS SETHI ; IT IS ABOVE THEM +JMM JMP MEMERR ; NOT ENOUGH MEMORY +SETHI LDA LINNUM ; STORE NEW HIMEM: VALUE +STA MEMSIZ ; +STA FRETOP ; <<>> +LDA LINNUM+1 ; <<>> +STA MEMSIZ+1 ; <<>> +STA FRETOP+1 ; +RTS ; +; -------------------------------- +; "LOMEM:" STATEMENT +; -------------------------------- +LOMEM JSR FRMNUM ; GET VALUE SPECIFIED FOR LOMEM +JSR GETADR ; AS 16-BIT INTEGER IN LINNUM +LDA LINNUM ; MUST BE BELOW HIMEM +CMP MEMSIZ ; +LDA LINNUM+1 ; +SBC MEMSIZ+1 ; +BCS JMM ; ABOVE HIMEM, MEMORY ERROR +LDA LINNUM ; MUST BE ABOVE PROGRAM +CMP VARTAB ; +LDA LINNUM+1 ; +SBC VARTAB+1 ; +BCC JMM ; NOT ABOVE PROGRAM, ERROR +LDA LINNUM ; STORE NEW LOMEM VALUE +STA VARTAB ; +LDA LINNUM+1 ; +STA VARTAB+1 ; +JMP CLEARC ; LOMEM CLEARS VARIABLES AND ARRAYS +; -------------------------------- +; "ON ERR GO TO" STATEMENT +; -------------------------------- +ONERR LDA #TOKEN_GOTO ; MUST BE "GOTO" NEXT +JSR SYNCHR +LDA TXTPTR ; SAVE TXTPTR FOR HANDLERR +STA TXTPSV ; +LDA TXTPTR+1 ; +STA TXTPSV+1 ; +SEC ; SET SIGN BIT OF ERRFLG +ROR ERRFLG ; +LDA CURLIN ; SAVE LINE # OF CURRENT LINE +STA CURLSV ; +LDA CURLIN+1 ; +STA CURLSV+1 ; +JSR REMN ; IGNORE REST OF LINE <<>> +JMP ADDON ; CONTINUE PROGRAM +; -------------------------------- +; ROUTINE TO HANDLE ERRORS IF ONERR GOTO ACTIVE +; -------------------------------- +HANDLERR ; +STX ERRNUM ; SAVE ERROR CODE NUMBER +LDX REMSTK ; GET STACK PNTR SAVED AT NEWSTT +STX ERRSTK ; REMEMBER IT +; <<>> +; <<>> +; <<>> +LDA CURLIN ; GET LINE # OF OFFENDING STATEMENT +STA ERRLIN ; SO USER CAN SEE IT IF DESIRED +LDA CURLIN+1 ; +STA ERRLIN+1 ; +LDA OLDTEXT ; ALSO THE POSITION IN THE LINE +STA ERRPOS ; IN CASE USER WANTS TO "RESUME" +LDA OLDTEXT+1 ; +STA ERRPOS+1 ; +LDA TXTPSV ; SET UP TXTPTR TO READ TARGET LINE # +STA TXTPTR ; IN "ON ERR GO TO XXXX" +LDA TXTPSV+1 ; +STA TXTPTR+1 ; +LDA CURLSV ; +STA CURLIN ; LINE # OF "ON ERR" STATEMENT +LDA CURLSV+1 ; +STA CURLIN+1 ; +JSR CHRGOT ; START CONVERSION +JSR GOTO ; GOTO SPECIFIED ONERR LINE +JMP NEWSTT ; +; -------------------------------- +; "RESUME" STATEMENT +; -------------------------------- +RESUME LDA ERRLIN ; RESTORE LINE # AND TXTPTR +STA CURLIN ; TO RE-TRY OFFENDING LINE +LDA ERRLIN+1 ; +STA CURLIN+1 ; +LDA ERRPOS ; +STA TXTPTR ; +LDA ERRPOS+1 ; +STA TXTPTR+1 ; +; <<< ONERR CORRECTION IN MANUAL IS EASILY >>> +; <<< BY "CALL -3288", WHICH IS $F328 HERE >>> +LDX ERRSTK ; RETRIEVE STACK PNTR AS IT WAS +TXS ; BEFORE STATEMENT SCANNED +JMP NEWSTT ; DO STATEMENT AGAIN +; -------------------------------- +JSYN JMP SYNERR ; +; -------------------------------- +; "DEL" STATEMENT +; -------------------------------- +DEL BCS JSYN ; ERROR IF # NOT SPECIFIED +LDX PRGEND ; +STX VARTAB ; +LDX PRGEND+1 ; +STX VARTAB+1 ; +JSR LINGET ; GET BEGINNING OF RANGE +JSR FNDLIN ; FIND THIS LINE OR NEXT +LDA LOWTR ; UPPER PORTION OF PROGRAM WILL +STA DEST ; BE MOVED DOWN TO HERE +LDA LOWTR+1 ; +STA DEST+1 ; +LDA #LOCHAR(`,') ; MUST HAVE A COMMA NEXT +JSR SYNCHR ; +JSR LINGET ; GET END RANGE +; (DOES NOTHING IF END RANGE +; IS NOT SPECIFIED) +INC LINNUM ; POINT ONE PAST IT +BNE L_DEL_1 ; +INC LINNUM+1 ; +L_DEL_1 JSR FNDLIN ; FIND START LINE AFTER SPECIFIED LINE +LDA LOWTR ; WHICH IS BEGINNING OF PORTION +CMP DEST ; TO BE MOVED DOWN +LDA LOWTR+1 ; IT MUST BE ABOVE THE TARGET +SBC DEST+1 ; +BCS L_DEL_2 ; IT IS OKAY +RTS ; NOTHING TO DELETE +L_DEL_2 LDY #0 ; MOVE UPPER PORTION DOWN NOW +L_DEL_3 LDA (LOWTR),Y ; SOURCE . . . +STA (DEST),Y ; ...TO DESTINATION +INC LOWTR ; BUMP SOURCE PNTR +BNE L_DEL_4 ; +INC LOWTR+1 ; +L_DEL_4 INC DEST ; BUMP DESTINATION PNTR +BNE L_DEL_5 ; +INC DEST+1 ; +L_DEL_5 LDA VARTAB ; REACHED END OF PROGRAM YET? +CMP LOWTR ; +LDA VARTAB+1 ; +SBC LOWTR+1 ; +BCS L_DEL_3 ; NO, KEEP MOVING +LDX DEST+1 ; STORE NEW END OF PROGRAM +LDY DEST ; MUST SUBTRACT 1 FIRST +BNE L_DEL_6 ; +DEX ; +L_DEL_6 DEY ; +STX VARTAB+1 ; +STY VARTAB ; +JMP FIX_LINKS ; RESET LINKS AFTER A DELETE +; -------------------------------- +; "GR" STATEMENT +; -------------------------------- +GR LDA SW_LORES +LDA SW_MIXSET +JMP MON_SETGR +; -------------------------------- +; "TEXT" STATEMENT +; -------------------------------- +TEXT LDA SW_LOWSCR ; JMP $FB36 WOULD HAVE +JMP MON_SETTXT ; DONE BOTH OF THESE +; <<< BETTER CODE WOULD BE: >>> +; <<< LDA SW.MIXSET >>> +; <<< JMP $FB33 >>> +; -------------------------------- +; "STORE" STATEMENT +; -------------------------------- +STORE JSR GETARYPT ; GET ADDRESS OF ARRAY TO BE SAVED +LDY #3 ; FORWARD OFFSET - 1 IS SIZE OF +LDA (LOWTR),Y ; THIS ARRAY +TAX +DEY +LDA (LOWTR),Y +SBC #1 +BCS L_STORE_1 +DEX +L_STORE_1 STA LINNUM +STX LINNUM+1 +JSR MON_WRITE +JSR TAPEPNT +JMP MON_WRITE +; -------------------------------- +; "RECALL" STATEMENT +; -------------------------------- +RECALL JSR GETARYPT ; FIND ARRAY IN MEMORY +JSR MON_READ ; READ HEADER +LDY #2 ; MAKE SURE THE NEW DATA FITS +LDA (LOWTR),Y ; +CMP LINNUM ; +INY ; +LDA (LOWTR),Y ; +SBC LINNUM+1 ; +BCS L_RECALL_1 ; IT FITS +JMP MEMERR ; DOESN'T FIT +L_RECALL_1 JSR TAPEPNT ; READ THE DATA +JMP MON_READ ; +; -------------------------------- +; "HGR" AND "HGR2" STATEMENTS +; -------------------------------- +HGR2 BIT SW_HISCR ; SELECT PAGE 2 ($4000-5FFF) +BIT SW_MIXCLR ; DEFAULT TO FULL SCREEN +LDA #>$4000 ; SET STARTING PAGE FOR HIRES +BNE SETHPG ; ...ALWAYS +HGR LDA #>$2000 ; SET STARTING PAGE FOR HIRES +BIT SW_LOWSCR ; SELECT PAGE 1 ($2000-3FFF) +BIT SW_MIXSET ; DEFAULT TO MIXED SCREEN +SETHPG STA HGR_PAGE ; BASE PAGE OF HIRES BUFFER +LDA SW_HIRES ; TURN ON HIRES +LDA SW_TXTCLR ; TURN ON GRAPHICS +; -------------------------------- +; CLEAR SCREEN +; -------------------------------- +HCLR LDA #0 ; SET FOR BLACK BACKGROUND +STA HGR_BITS +; -------------------------------- +; FILL SCREEN WITH (HGR.BITS) +; -------------------------------- +BKGND LDA HGR_PAGE ; PUT BUFFER ADDRESS IN HGR.SHAPE +STA HGR_SHAPE+1 +LDY #0 +STY HGR_SHAPE +L_BKGND_1 LDA HGR_BITS ; COLOR BYTE +STA (HGR_SHAPE),Y ; CLEAR HIRES TO HGR.BITS +JSR COLOR_SHIFT ; CORRECT FOR COLOR SHIFT +INY ; (SLOWS CLEAR BY FACTOR OF 2) +BNE L_BKGND_1 +INC HGR_SHAPE+1 +LDA HGR_SHAPE+1 +AND #$1F ; DONE? ($40 OR$60) +BNE L_BKGND_1 ; NO +RTS ; YES, RETURN +; -------------------------------- +; SET THE HIRES CURSOR POSITION +; +; (Y,X) = HORIZONTAL COORDINATE (0-279) +; (A) = VERTICAL COORDINATE (0-191) +; -------------------------------- +HPOSN STA HGR_Y ; SAVE Y- AND X-POSITIONS +STX HGR_X ; +STY HGR_X+1 ; +PHA ; Y-POS ALSO ON STACK +AND #$C0 ; CALCULATE BASE ADDRESS FOR Y-POS +STA MON_GBASL ; FOR Y=ABCDEFGH +LSR ; GBASL=ABAB0000 +LSR ; +ORA MON_GBASL ; +STA MON_GBASL ; +PLA ; (A) (GBASH) (GBASL) +STA MON_GBASH ; ?-ABCDEFGH ABCDEFGH ABAB0000 +ASL ; A-BCDEFGH0 ABCDEFGH ABAB0000 +ASL ; B-CDEFGH00 ABCDEFGH ABAB0000 +ASL ; C-DEFGH000 ABCDEFGH ABAB0000 +ROL MON_GBASH ; A-DEFGH000 BCDEFGHC ABAB0000 +ASL ; D-EFGH0000 BCDEFGHC ABAB0000 +ROL MON_GBASH ; B-EFGH0000 CDEFGHCD ABAB0000 +ASL ; E-FGH00000 CDEFGHCD ABAB0000 +ROR MON_GBASL ; 0-FGH00000 CDEFGHCD EABAB000 +LDA MON_GBASH ; 0-CDEFGHCD CDEFGHCD EABAB000 +AND #$1F ; 0-000FGHCD CDEFGHCD EABAB000 +ORA HGR_PAGE ; 0-PPPFGHCD CDEFGHCD EABAB000 +STA MON_GBASH ; 0-PPPFGHCD PPPFGHCD EABAB000 +TXA ; DIVIDE X-POS BY 7 FOR INDEX FROM BASE +CPY #0 ; IS X-POS < 256? +BEQ L_HPOSN_2 ; YES +LDY #35 ; NO: 256/7 = 36 REM 4 +; CARRY=1, SO ADC #4 IS TOO LARGE; +; HOWEVER, ADC #4 CLEARS CARRY +; WHICH MAKES SBC #7 ONLY -6 +; BALANCING IT OUT. +ADC #4 ; FOLLOWING INY MAKES Y=36 +L_HPOSN_1 INY +L_HPOSN_2 SBC #7 +BCS L_HPOSN_1 +STY HGR_HORIZ ; HORIZONTAL INDEX +TAX ; USE REMAINDER-7 TO LOOK UP THE +LDA MSKTBL-$100+7,X ; BIT MASK +STA MON_HMASK +TYA ; QUOTIENT GIVES BYTE INDEX +LSR ; ODD OR EVEN COLUMN? +LDA HGR_COLOR ; IF ON ODD BYTE (CARRY SET) +STA HGR_BITS ; THEN ROTATE BITS +BCS COLOR_SHIFT ; ODD COLUMN +RTS ; EVEN COLUMN +; -------------------------------- +; PLOT A DOT +; +; (Y,X) = HORIZONTAL POSITION +; (A) = VERTICAL POSITION +; -------------------------------- +HPLOT0 JSR HPOSN +LDA HGR_BITS ; CALCULATE BIT POSN IN GBAS, +EOR (MON_GBASL),Y ; HGR.HORIZ, AND HMASK FROM +AND MON_HMASK ; Y-COOR IN A-REG, +EOR (MON_GBASL),Y ; X-COOR IN X,Y REGS. +STA (MON_GBASL),Y ; FOR ANY 1-BITS, SUBSTITUTE +RTS ; CORRESPONDING BIT OF HGR.BITS +; -------------------------------- +; MOVE LEFT OR RIGHT ONE PIXEL +; +; IF STATUS IS +, MOVE RIGHT; IF -, MOVE LEFT +; IF ALREADY AT LEFT OR RIGHT EDGE, WRAP AROUND +; +; REMEMBER BITS IN HI-RES BYTE ARE BACKWARDS ORDER: +; BYTE N BYTE N+1 +; S7654321 SEDCBA98 +; -------------------------------- +MOVE_LEFT_OR_RIGHT +BPL MOVE_RIGHT ; + MOVE RIGHT, - MOVE LEFT +LDA MON_HMASK ; MOVE LEFT ONE PIXEL +LSR ; SHIFT MASK RIGHT, MOVES DOT LEFT +BCS LR_2 ; ...DOT MOVED TO NEXT BYTE +EOR #$C0 ; MOVE SIGN BIT BACK WHERE IT WAS +LR_1 STA MON_HMASK ; NEW MASK VALUE +RTS ; +LR_2 DEY ; MOVED TO NEXT BYTE, SO DECR INDEX +BPL LR_3 ; STILL NOT PAST EDGE +LDY #39 ; OFF LEFT EDGE, SO WRAP AROUND SCREEN +LR_3 LDA #$C0 ; NEW HMASK, RIGHTMOST BIT ON SCREEN +LR_4 STA MON_HMASK ; NEW MASK AND INDEX +STY HGR_HORIZ ; +LDA HGR_BITS ; ALSO NEED TO ROTATE COLOR +; -------------------------------- +COLOR_SHIFT +ASL ; ROTATE LOW-ORDER 7 BITS +CMP #$C0 ; OF HGR.BITS ONE BIT POSN. +BPL L_COLOR_SHIFT_1 +LDA HGR_BITS +EOR #$7F +STA HGR_BITS +L_COLOR_SHIFT_1 RTS +; -------------------------------- +; MOVE RIGHT ONE PIXEL +; IF ALREADY AT RIGHT EDGE, WRAP AROUND +; -------------------------------- +MOVE_RIGHT +LDA MON_HMASK +ASL ; SHIFTING BYTE LEFT MOVES PIXEL RIGHT +EOR #$80 ; +; ORIGINAL: C0 A0 90 88 84 82 81 +; SHIFTED: 80 40 20 10 08 02 01 +; EOR #$80: 00 C0 A0 90 88 84 82 +BMI LR_1 ; FINISHED +LDA #$81 ; NEW MASK VALUE +INY ; MOVE TO NEXT BYTE RIGHT +CPY #40 ; UNLESS THAT IS TOO FAR +BCC LR_4 ; NOT TOO FAR +LDY #0 ; TOO FAR, SO WRAP AROUND +BCS LR_4 ; ...ALWAYS +; -------------------------------- +; -------------------------------- +; "XDRAW" ONE BIT +; -------------------------------- +LRUDX1 CLC ; C=0 MEANS NO 90 DEGREE ROTATION +LRUDX2 LDA HGR_DX+1 ; C=1 MEANS ROTATE 90 DEGREES +AND #4 ; IF BIT2=0 THEN DON'T PLOT +BEQ LRUD4 ; YES, DO NOT PLOT +LDA #$7F ; NO, LOOK AT WHAT IS ALREADY THERE +AND MON_HMASK +AND (MON_GBASL),Y ; SCREEN BIT = 1? +BNE LRUD3 ; YES, GO CLEAR IT +INC HGR_COLLISIONS ; NO, COUNT THE COLLISION +LDA #$7F ; AND TURN THE BIT ON +AND MON_HMASK ; +BPL LRUD3 ; ...ALWAYS +; -------------------------------- +; "DRAW" ONE BIT +; -------------------------------- +LRUD1 CLC ; C=0 MEANS NO 90 DEGREE ROTATION +LRUD2 LDA HGR_DX+1 ; C=1 MEANS ROTATE +AND #4 ; IF BIT2=0 THEN DO NOT PLOT +BEQ LRUD4 ; DO NOT PLOT +LDA (MON_GBASL),Y +EOR HGR_BITS ; 1'S WHERE ANY BITS NOT IN COLOR +AND MON_HMASK ; LOOK AT JUST THIS BIT POSITION +BNE LRUD3 ; THE BIT WAS ZERO, SO PLOT IT +INC HGR_COLLISIONS ; BIT IS ALREADY 1; COUNT COLLSN +; -------------------------------- +; TOGGLE BIT ON SCREEN WITH (A) +; -------------------------------- +LRUD3 EOR (MON_GBASL),Y +STA (MON_GBASL),Y +; -------------------------------- +; DETERMINE WHERE NEXT POINT WILL BE, AND MOVE THERE +; C=0 IF NO 90 DEGREE ROTATION +; C=1 ROTATES 90 DEGREES +; -------------------------------- +LRUD4 LDA HGR_DX+1 ; CALCULATE THE DIRECTION TO MOVE +ADC HGR_QUADRANT +AND #3 ; WRAP AROUND THE CIRCLE +CON_03 = *-1 ; (( A CONSTANT )) +; +; 00 -- UP +; 01 -- DOWN +; 10 -- RIGHT +; 11 -- LEFT +; +CMP #2 ; C=0 IF 0 OR 1, C=1 IF 2 OR 3 +ROR ; PUT C INTO SIGN, ODD/EVEN INTO C +BCS MOVE_LEFT_OR_RIGHT +; -------------------------------- +MOVE_UP_OR_DOWN +BMI MOVE_DOWN ; SIGN FOR UP/DOWN SELECT_ +; -------------------------------- +; MOVE UP ONE PIXEL +; IF ALREADY AT TOP, GO TO BOTTOM +; +; REMEMBER: Y-COORD GBASH GBASL +; ABCDEFGH PPPFGHCD EABAB000 +; -------------------------------- +CLC ; MOVE UP +LDA MON_GBASH ; CALC. BASE ADDRESS OF PREV. LINE +BIT CON_1C ; LOOK AT BITS 000FGH00 IN GBASH +BNE L_MOVE_UP_OR_DOWN_5 ; SIMPLE, JUST FGH=FGH-1 +; GBASH=PPP000CD, GBASL=EABAB000 +ASL MON_GBASL ; WHAT IS "E"? +BCS L_MOVE_UP_OR_DOWN_3 ; E=1, THEN EFGH=EFGH-1 +BIT CON_03 ; LOOK AT 000000CD IN GBASH +BEQ L_MOVE_UP_OR_DOWN_1 ; Y-POS IS AB000000 FORM +ADC #$1F ; CD <> 0, SO CDEFGH=CDEFGH-1 +SEC ; +BCS L_MOVE_UP_OR_DOWN_4 ; ...ALWAYS +L_MOVE_UP_OR_DOWN_1 ADC #$23 ; ENOUGH TO MAKE GBASH=PPP11111 LATER +PHA ; SAVE FOR LATER +LDA MON_GBASL ; GBASL IS NOW ABAB0000 (AB=00,01,10) +ADC #$B0 ; 0000+1011=1011 AND CARRY CLEAR +; OR 0101+1011=0000 AND CARRY SET +; OR 1010+1011=0101 AND CARRY SET +BCS L_MOVE_UP_OR_DOWN_2 ; NO WRAP-AROUND NEEDED +ADC #$F0 ; CHANGE 1011 TO 1010 (WRAP-AROUND) +L_MOVE_UP_OR_DOWN_2 STA MON_GBASL ; FORM IS NOW STILL ABAB0000 +PLA ; PARTIALLY MODIFIED GBASH +BCS L_MOVE_UP_OR_DOWN_4 ; ...ALWAYS +L_MOVE_UP_OR_DOWN_3 ADC #$1F ; +L_MOVE_UP_OR_DOWN_4 ROR MON_GBASL ; SHIFT IN E, TO GET EABAB000 FORM +L_MOVE_UP_OR_DOWN_5 ADC #$FC ; FINISH GBASH MODS +UD_1 STA MON_GBASH ; +RTS +; -------------------------------- +CLC ; <<>> +; -------------------------------- +; MOVE DOWN ONE PIXEL +; IF ALREADY AT BOTTOM, GO TO TOP +; +; REMEMBER: Y-COORD GBASH GBASL +; ABCDEFGH PPPFGHCD EABAB000 +; -------------------------------- +MOVE_DOWN +LDA MON_GBASH ; TRY IT FIRST, BY FGH=FGH+1 +ADC #4 ; GBASH = PPPFGHCD +CON_04 = *-1 ; (( CONSTANT )) +BIT CON_1C ; IS FGH FIELD NOW ZERO? +BNE UD_1 ; NO, SO WE ARE FINISHED +; YES, RIPPLE THE CARRY AS HIGH +; AS NECESSARY +ASL MON_GBASL ; LOOK AT "E" BIT +BCC L_CON_04_2 ; NOW ZERO; MAKE IT 1 AND LEAVE +ADC #$E0 ; CARRY = 1, SO ADDS $E1 +CLC ; IS "CD" NOT ZERO? +BIT CON_04 ; TESTS BIT 2 FOR CARRY OUT OF "CD" +BEQ L_CON_04_3 ; NO CARRY, FINISHED +; INCREMENT "AB" THEN +; 0000 --> 0101 +; 0101 --> 1010 +; 1010 --> WRAP AROUND TO LINE 0 +LDA MON_GBASL ; 0000 0101 1010 +ADC #$50 ; 0101 1010 1111 +EOR #$F0 ; 1010 0101 0000 +BEQ L_CON_04_1 ; +EOR #$F0 ; 0101 1010 +L_CON_04_1 STA MON_GBASL ; NEW ABAB0000 +LDA HGR_PAGE ; WRAP AROUND TO LINE ZERO OF GROUP +BCC L_CON_04_3 ; ...ALWAYS +L_CON_04_2 ADC #$E0 +L_CON_04_3 ROR MON_GBASL +BCC UD_1 ; ...ALWAYS +; -------------------------------- +; HLINRL IS NEVER CALLED BY APPLESOFT +; +; ENTER WITH: (A,X) = DX FROM CURRENT POINT +; (Y) = DY FROM CURRENT POINT +; -------------------------------- +HLINRL PHA ; SAVE (A) +LDA #0 ; CLEAR CURRENT POINT SO HGLIN WILL +STA HGR_X ; ACT RELATIVELY +STA HGR_X+1 ; +STA HGR_Y ; +PLA ; RESTORE (A) +; -------------------------------- +; DRAW LINE FROM LAST PLOTTED POINT TO (A,X),(Y) +; +; ENTER WITH: (A,X) = X OF TARGET POINT +; (Y) = Y OF TARGET POINT +; -------------------------------- +HGLIN PHA ; COMPUTE DX = X- X0 +SEC +SBC HGR_X +PHA +TXA +SBC HGR_X+1 +STA HGR_QUADRANT ; SAVE DX SIGN (+ = RIGHT, - = LEFT) +BCS L_HGLIN_1 ; NOW FIND ABS (DX) +PLA ; FORMS 2'S COMPLEMENT +EOR #$FF +ADC #1 +PHA +LDA #0 +SBC HGR_QUADRANT +L_HGLIN_1 STA HGR_DX+1 +STA HGR_E+1 ; INIT HGR.E TO ABS(X-X0) +PLA +STA HGR_DX +STA HGR_E +PLA +STA HGR_X ; TARGET X POINT +STX HGR_X+1 ; +TYA ; TARGET Y POINT +CLC ; COMPUTE DY = Y-HGR.Y +SBC HGR_Y ; AND SAVE -ABS(Y-HGR.Y)-1 IN HGR.DY +BCC L_HGLIN_2 ; (SO + MEANS UP, - MEANS DOWN) +EOR #$FF ; 2'S COMPLEMENT OF DY +ADC #$FE ; +L_HGLIN_2 STA HGR_DY ; +STY HGR_Y ; TARGET Y POINT +ROR HGR_QUADRANT ; SHIFT Y-DIRECTION INTO QUADRANT +SEC ; COUNT = DX -(-DY) = # OF DOTS NEEDED +SBC HGR_DX ; +TAX ; COUNTL IS IN X-REG +LDA #$FF +SBC HGR_DX+1 +STA HGR_COUNT +LDY HGR_HORIZ ; HORIZONTAL INDEX +BCS MOVEX2 ; ...ALWAYS +; -------------------------------- +; MOVE LEFT OR RIGHT ONE PIXEL +; (A) BIT 6 HAS DIRECTION +; -------------------------------- +MOVEX ASL ; PUT BIT 6 INTO SIGN POSITION +JSR MOVE_LEFT_OR_RIGHT +SEC +; -------------------------------- +; DRAW LINE NOW +; -------------------------------- +MOVEX2 LDA HGR_E ; CARRY IS SET +ADC HGR_DY ; E = E-DELTY +STA HGR_E ; NOTE: DY IS (-DELTA Y)-1 +LDA HGR_E+1 ; CARRY CLR IF HGR.E GOES NEGATIVE +SBC #0 +L_MOVEX2_1 STA HGR_E+1 +LDA (MON_GBASL),Y +EOR HGR_BITS ; PLOT A DOT +AND MON_HMASK +EOR (MON_GBASL),Y +STA (MON_GBASL),Y +INX ; FINISHED ALL THE DOTS? +BNE L_MOVEX2_2 ; NO +INC HGR_COUNT ; TEST REST OF COUNT +BEQ RTS_22 ; YES, FINISHED. +L_MOVEX2_2 LDA HGR_QUADRANT ; TEST DIRECTION +BCS MOVEX ; NEXT MOVE IS IN THE X DIRECTION +JSR MOVE_UP_OR_DOWN ; IF CLR, NEG, MOVE +CLC ; E = E+DX +LDA HGR_E +ADC HGR_DX +STA HGR_E +LDA HGR_E+1 +ADC HGR_DX+1 +BVC L_MOVEX2_1 ; ...ALWAYS +; -------------------------------- + + +MSKTBL ASM_DATA(%10000001) +ASM_DATA(%10000010) +ASM_DATA(%10000100) +ASM_DATA(%10001000) +ASM_DATA(%10010000) +ASM_DATA(%10100000) +ASM_DATA(%11000000) +; -------------------------------- +CON_1C ASM_DATA(%00011100) ; MASK FOR "FGH" BITS +; -------------------------------- + +; -------------------------------- +; TABLE OF COS(90*X/16 DEGREES)*$100 - 1 +; WITH ONE BYTE PRECISION, X=0 TO 16: +; -------------------------------- +COSINE_TABLE ASM_DATA($FF,$FE,$FA,$F4,$EC,$E1,$D4,$C5) +ASM_DATA($B4,$A1,$8D,$78,$61,$49,$31,$18) +ASM_DATA($FF) +; -------------------------------- +; HFIND -- CALCULATES CURRENT POSITION OF HI-RES CURSOR +; (NOT CALLED BY ANY APPLESOFT ROUTINE) +; +; CALCULATE Y-COORD FROM GBASL,H +; AND X-COORD FROM HORIZ AND HMASK +; -------------------------------- +HFIND LDA MON_GBASL ; GBASL = EABAB000 +ASL ; E INTO CARRY +LDA MON_GBASH ; GBASH = PPPFGHCD +AND #3 ; 000000CD +ROL ; 00000CDE +ORA MON_GBASL ; EABABCDE +ASL ; ABABCDE0 +ASL ; BABCDE00 +ASL ; ABCDE000 +STA HGR_Y ; ALL BUT FGH +LDA MON_GBASH ; PPPFGHCD +LSR ; 0PPPFGHC +LSR ; 00PPPFGH +AND #7 ; 00000FGH +ORA HGR_Y ; ABCDEFGH +STA HGR_Y ; THAT TAKES CARE OF Y-COORDINATE! +LDA HGR_HORIZ ; X = 7*HORIZ + BIT POS. IN HMASK +ASL ; MULTIPLY BY 7 +ADC HGR_HORIZ ; 3* SO FAR +ASL ; 6* +TAX ; SINCE 7* MIGHT NOT FIT IN 1 BYTE, +; WAIT TILL LATER FOR LAST ADD +DEX ; +LDA MON_HMASK ; NOW FIND BIT POSITION IN HMASK +AND #$7F ; ONLY LOOK AT LOW SEVEN +L_HFIND_1 INX ; COUNT A SHIFT +LSR ; +BNE L_HFIND_1 ; STILL IN THERE +STA HGR_X+1 ; ZERO TO HI-BYTE +TXA ; 6*HORIZ+LOG2(HMASK) +CLC ; ADD HORIZ ONE MORE TIME +ADC HGR_HORIZ ; 7*HORIZ+LOG2(HMASK) +BCC L_HFIND_2 ; UPPER BYTE = 0 +INC HGR_X+1 ; UPPER BYTE = 1 +L_HFIND_2 STA HGR_X ; STORE LOWER BYTE +RTS_22 RTS +; -------------------------------- +; DRAW A SHAPE +; +; (Y,X) = SHAPE STARTING ADDRESS +; (A) = ROTATION (0-3F) +; -------------------------------- +; APPLESOFT DOES NOT CALL DRAW0 +; -------------------------------- +DRAW0 STX HGR_SHAPE ; SAVE SHAPE ADDRESS +STY HGR_SHAPE+1 +; -------------------------------- +; APPLESOFT ENTERS HERE +; -------------------------------- +DRAW1 TAX ; SAVE ROTATION (0-$3F) +LSR ; DIVIDE ROTATION BY 16 TO GET +LSR ; QUADRANT (0=UP, 1=RT, 2=DWN, 3=LFT) +LSR +LSR +STA HGR_QUADRANT +TXA ; USE LOW 4 BITS OF ROTATION TO INDEX +AND #$0F ; THE TRIG TABLE +TAX +LDY COSINE_TABLE,X ; SAVE COSINE IN HGR.DX +STY HGR_DX ; +EOR #$F ; AND SINE IN DY +TAX +LDY COSINE_TABLE+1,X +INY +STY HGR_DY +LDY HGR_HORIZ ; INDEX FROM GBASL,H TO BYTE WE'RE IN +LDX #0 +STX HGR_COLLISIONS ; CLEAR COLLISION COUNTER +LDA (HGR_SHAPE,X) ; GET FIRST BYTE OF SHAPE DEFN +L_DRAW1_1 STA HGR_DX+1 ; KEEP SHAPE BYTE IN HGR.DX+1 +LDX #$80 ; INITIAL VALUES FOR FRACTIONAL VECTORS +STX HGR_E ; L_DRAW1_5 IN COSINE COMPONENT +STX HGR_E+1 ; L_DRAW1_5 IN SINE COMPONENT +LDX HGR_SCALE ; SCALE FACTOR +L_DRAW1_2 LDA HGR_E ; ADD COSINE VALUE TO X-VALUE +SEC ; IF >= 1, THEN DRAW +ADC HGR_DX ; +STA HGR_E ; ONLY SAVE FRACTIONAL PART +BCC L_DRAW1_3 ; NO INTEGRAL PART +JSR LRUD1 ; TIME TO PLOT COSINE COMPONENT +CLC ; +L_DRAW1_3 LDA HGR_E+1 ; ADD SINE VALUE TO Y-VALUE +ADC HGR_DY ; IF >= 1, THEN DRAW +STA HGR_E+1 ; ONLY SAVE FRACTIONAL PART +BCC L_DRAW1_4 ; NO INTEGRAL PART +JSR LRUD2 ; TIME TO PLOT SINE COMPONENT +L_DRAW1_4 DEX ; LOOP ON SCALE FACTOR. +BNE L_DRAW1_2 ; STILL ON SAME SHAPE ITEM +LDA HGR_DX+1 ; GET NEXT SHAPE ITEM +LSR ; NEXT 3 BIT VECTOR +LSR ; +LSR ; +BNE L_DRAW1_1 ; MORE IN THIS SHAPE BYTE +INC HGR_SHAPE ; GO TO NEXT SHAPE BYTE +BNE L_DRAW1_5 +INC HGR_SHAPE+1 +L_DRAW1_5 LDA (HGR_SHAPE,X) ; NEXT BYTE OF SHAPE DEFINITION +BNE L_DRAW1_1 ; PROCESS IF NOT ZERO +RTS ; FINISHED +; -------------------------------- +; XDRAW A SHAPE (SAME AS DRAW, EXCEPT TOGGLES SCREEN) +; +; (Y,X) = SHAPE STARTING ADDRESS +; (A) = ROTATION (0-3F) +; -------------------------------- +; APPLESOFT DOES NOT CALL XDRAW0 +; -------------------------------- +XDRAW0 STX HGR_SHAPE ; SAVE SHAPE ADDRESS +STY HGR_SHAPE+1 +; -------------------------------- +; APPLESOFT ENTERS HERE +; -------------------------------- +XDRAW1 TAX ; SAVE ROTATION (0-$3F) +LSR ; DIVIDE ROTATION BY 16 TO GET +LSR ; QUADRANT (0=UP, 1=RT, 2=DWN, 3=LFT) +LSR +LSR +STA HGR_QUADRANT +TXA ; USE LOW 4 BITS OF ROTATION TO INDEX +AND #$0F ; THE TRIG TABLE +TAX +LDY COSINE_TABLE,X ; SAVE COSINE IN HGR.DX +STY HGR_DX ; +EOR #$F ; AND SINE IN DY +TAX +LDY COSINE_TABLE+1,X +INY +STY HGR_DY +LDY HGR_HORIZ ; INDEX FROM GBASL,H TO BYTE WE'RE IN +LDX #0 +STX HGR_COLLISIONS ; CLEAR COLLISION COUNTER +LDA (HGR_SHAPE,X) ; GET FIRST BYTE OF SHAPE DEFN +L_XDRAW1_1 STA HGR_DX+1 ; KEEP SHAPE BYTE IN HGR.DX+1 +LDX #$80 ; INITIAL VALUES FOR FRACTIONAL VECTORS +STX HGR_E ; L_XDRAW1_5 IN COSINE COMPONENT +STX HGR_E+1 ; L_XDRAW1_5 IN SINE COMPONENT +LDX HGR_SCALE ; SCALE FACTOR +L_XDRAW1_2 LDA HGR_E ; ADD COSINE VALUE TO X-VALUE +SEC ; IF >= 1, THEN DRAW +ADC HGR_DX ; +STA HGR_E ; ONLY SAVE FRACTIONAL PART +BCC L_XDRAW1_3 ; NO INTEGRAL PART +JSR LRUDX1 ; TIME TO PLOT COSINE COMPONENT +CLC ; +L_XDRAW1_3 LDA HGR_E+1 ; ADD SINE VALUE TO Y-VALUE +ADC HGR_DY ; IF >= 1, THEN DRAW +STA HGR_E+1 ; ONLY SAVE FRACTIONAL PART +BCC L_XDRAW1_4 ; NO INTEGRAL PART +JSR LRUDX2 ; TIME TO PLOT SINE COMPONENT +L_XDRAW1_4 DEX ; LOOP ON SCALE FACTOR. +BNE L_XDRAW1_2 ; STILL ON SAME SHAPE ITEM +LDA HGR_DX+1 ; GET NEXT SHAPE ITEM +LSR ; NEXT 3 BIT VECTOR +LSR ; +LSR ; +BNE L_XDRAW1_1 ; MORE IN THIS SHAPE BYTE +INC HGR_SHAPE ; GO TO NEXT SHAPE BYTE +BNE L_XDRAW1_5 +INC HGR_SHAPE+1 +L_XDRAW1_5 LDA (HGR_SHAPE,X) ; NEXT BYTE OF SHAPE DEFINITION +BNE L_XDRAW1_1 ; PROCESS IF NOT ZERO +RTS ; FINISHED +; -------------------------------- +; GET HI-RES PLOTTING COORDINATES (0-279,0-191) FROM +; TXTPTR. LEAVE REGISTERS SET UP FOR HPOSN: +; (Y,X)=X-COORD +; (A) =Y-COORD +; -------------------------------- +HFNS JSR FRMNUM ; EVALUATE EXPRESSION, MUST BE NUMERIC +JSR GETADR ; CONVERT TO 2-BYTE INTEGER IN LINNUM +LDY LINNUM+1 ; GET HORIZ COOR IN X,Y +LDX LINNUM ; +CPY #>280 ; MAKE SURE IT IS < 280 +BCC L_HFNS_1 ; IN RANGE +BNE GGERR ; +CPX #<280 ; +BCS GGERR ; +L_HFNS_1 TXA ; SAVE HORIZ COOR ON STACK +PHA ; +TYA ; +PHA ; +LDA #LOCHAR(`,') ; REQUIRE A COMMA +JSR SYNCHR ; +JSR GETBYT ; EVAL EXP TO SINGLE BYTE IN X-REG +CPX #192 ; CHECK FOR RANGE +BCS GGERR ; TOO BIG +STX FAC ; SAVE Y-COORD +PLA ; RETRIEVE HORIZONTAL COORDINATE +TAY ; +PLA ; +TAX ; +LDA FAC ; AND VERTICAL COORDINATE +RTS ; +; -------------------------------- +GGERR JMP GOERR ; ILLEGAL QUANTITY ERROR +; -------------------------------- +; "HCOLOR=" STATEMENT +; -------------------------------- +HCOLOR JSR GETBYT ; EVAL EXP TO SINGLE BYTE IN X +CPX #8 ; VALUE MUST BE 0-7 +BCS GGERR ; TOO BIG +LDA COLORTBL,X ; GET COLOR PATTERN +STA HGR_COLOR +RTS_23 RTS +; -------------------------------- + + +COLORTBL ASM_DATA(%00000000) +ASM_DATA(%00101010) +ASM_DATA(%01010101) +ASM_DATA(%01111111) +ASM_DATA(%00000000 | %10000000) +ASM_DATA(%00101010 | %10000000) +ASM_DATA(%01010101 | %10000000) +ASM_DATA(%01111111 | %10000000) + +; -------------------------------- +; "HPLOT" STATEMENT +; +; HPLOT X,Y +; HPLOT TO X,Y +; HPLOT X1,Y1 TO X2,Y2 +; -------------------------------- +HPLOT CMP #TOKEN_TO ; "PLOT TO" FORM? +BEQ L_HPLOT_2 ; YES, START FROM CURRENT LOCATION +JSR HFNS ; NO, GET STARTING POINT OF LINE +JSR HPLOT0 ; PLOT THE POINT, AND SET UP FOR +; DRAWING A LINE FROM THAT POINT +L_HPLOT_1 JSR CHRGOT ; CHARACTER AT END OF EXPRESSION +CMP #TOKEN_TO ; IS A LINE SPECIFIED? +BNE RTS_23 ; NO, EXIT +L_HPLOT_2 JSR SYNCHR ; YES. ADV. TXTPTR (WHY NOT CHRGET) +JSR HFNS ; GET COORDINATES OF LINE END +STY DSCTMP ; SET UP FOR LINE +TAY ; +TXA ; +LDX DSCTMP ; +JSR HGLIN ; PLOT LINE +JMP L_HPLOT_1 ; LOOP TILL NO MORE "TO" PHRASES +; -------------------------------- +; "ROT=" STATEMENT +; -------------------------------- +ROT JSR GETBYT ; EVAL EXP TO A BYTE IN X-REG +STX HGR_ROTATION +RTS +; -------------------------------- +; "SCALE=" STATEMENT +; -------------------------------- +SCALE JSR GETBYT ; EVAL EXP TO A BYTE IN X-REG +STX HGR_SCALE +RTS +; -------------------------------- +; SET UP FOR DRAW AND XDRAW +; -------------------------------- +DRWPNT JSR GETBYT ; GET SHAPE NUMBER IN X-REG +LDA HGR_SHAPE_PNTR ; SEARCH FOR THAT SHAPE +STA HGR_SHAPE ; SET UP PNTR TO BEGINNING OF TABLE +LDA HGR_SHAPE_PNTR+1 +STA HGR_SHAPE+1 +TXA +LDX #0 +CMP (HGR_SHAPE,X) ; COMPARE TO # OF SHAPES IN TABLE +BEQ L_DRWPNT_1 ; LAST SHAPE IN TABLE +BCS GGERR ; SHAPE # TOO LARGE +L_DRWPNT_1 ASL ; DOUBLE SHAPE# TO MAKE AN INDEX +BCC L_DRWPNT_2 ; ADD 256 IF SHAPE # > 127 +INC HGR_SHAPE+1 +CLC +L_DRWPNT_2 TAY ; USE INDEX TO LOOK UP OFFSET FOR SHAPE +LDA (HGR_SHAPE),Y ; IN OFFSET TABLE +ADC HGR_SHAPE +TAX +INY +LDA (HGR_SHAPE),Y +ADC HGR_SHAPE_PNTR+1 +STA HGR_SHAPE+1 ; SAVE ADDRESS OF SHAPE +STX HGR_SHAPE +JSR CHRGOT ; IS THERE ANY "AT" PHRASE? +CMP #TOKENDB ; +BNE L_DRWPNT_3 ; NO, DRAW RIGHT WHERE WE ARE +JSR SYNCHR ; SCAN OVER "AT" +JSR HFNS ; GET X- AND Y-COORDS TO START DRAWING AT +JSR HPOSN ; SET UP CURSOR THERE +L_DRWPNT_3 LDA HGR_ROTATION ; ROTATION VALUE +RTS +; -------------------------------- +; "DRAW" STATEMENT +; -------------------------------- +DRAW JSR DRWPNT +JMP DRAW1 +; -------------------------------- +; "XDRAW" STATEMENT +; -------------------------------- +XDRAW JSR DRWPNT +JMP XDRAW1 +; -------------------------------- +; "SHLOAD" STATEMENT +; +; READS A SHAPE TABLE FROM CASSETTE TAPE +; TO A POSITION JUST BELOW HIMEM. +; HIMEM IS THEN MOVED TO JUST BELOW THE TABLE +; -------------------------------- +SHLOAD LDA #>LINNUM ; SET UP TO READ TWO BYTES +STA MON_A1H ; INTO LINNUM,LINNUM+1 +STA MON_A2H ; +LDY #LINNUM ; +STY MON_A1L ; +INY ; LINNUM+1 +STY MON_A2L ; +JSR MON_READ ; READ TAPE +CLC ; SETUP TO READ (LINNUM) BYTES +LDA MEMSIZ ; ENDING AT HIMEM-1 +TAX ; +DEX ; FORMING HIMEM-1 +STX MON_A2L ; +SBC LINNUM ; FORMING HIMEM-(LINNUM) +PHA ; +LDA MEMSIZ+1 ; +TAY ; +INX ; SEE IF HIMEM LOW-BYTE WAS ZERO +BNE L_SHLOAD_1 ; NO +DEY ; YES, HAVE TO DECREMENT HIGH BYTE +L_SHLOAD_1 STY MON_A2H ; +SBC LINNUM+1 ; +CMP STREND+1 ; RUNNING INTO VARIABLES? +BCC L_SHLOAD_2 ; YES, OUT OF MEMORY +BNE L_SHLOAD_3 ; NO, STILL ROOM +L_SHLOAD_2 JMP MEMERR ; MEM FULL ERR +L_SHLOAD_3 STA MEMSIZ+1 ; +STA FRETOP+1 ; CLEAR STRING SPACE +STA MON_A1H ; (BUT NAMES ARE STILL IN VARTBL!) +STA HGR_SHAPE_PNTR+1 +PLA +STA HGR_SHAPE_PNTR +STA MEMSIZ +STA FRETOP +STA MON_A1L +JSR MON_RD2BIT ; READ TO TAPE TRANSITIONS +LDA #3 ; SHORT DELAY FOR INTERMEDIATE HEADER +JMP MON_READ2 ; READ SHAPES +; -------------------------------- +; CALLED FROM STORE AND RECALL +; -------------------------------- +TAPEPNT +CLC +LDA LOWTR +ADC LINNUM +STA MON_A2L +LDA LOWTR+1 +ADC LINNUM+1 +STA MON_A2H +LDY #4 +LDA (LOWTR),Y +JSR GETARY2 +LDA HIGHDS +STA MON_A1L +LDA HIGHDS+1 +STA MON_A1H +RTS +; -------------------------------- +; CALLED FROM STORE AND RECALL +; -------------------------------- +GETARYPT +LDA #$40 +STA SUBFLG +JSR PTRGET +LDA #0 +STA SUBFLG +JMP VARTIO +; -------------------------------- +; "HTAB" STATEMENT +; +; NOTE THAT IF WNDLEFT IS NOT 0, HTAB CAN PRINT +; OUTSIDE THE SCREEN (EG., IN THE PROGRAM) +; -------------------------------- +HTAB JSR GETBYT +DEX +TXA +L_HTAB_1 CMP #40 +BCC L_HTAB_2 +SBC #40 +PHA +JSR CRDO +PLA +JMP L_HTAB_1 +L_HTAB_2 STA MON_CH +RTS +; -------------------------------- +HIASCII(`KRW') ; UNKNOWN