#!/usr/bin/perl -w # # as65.pl # # Simple 65C02 mini-assembler. # # 20181211 LSH # use strict; my $verbose = 1; # Print messages, default to on. my $debug = 0; # Debug mode, default to off. Very chatty if on. my $listing = 0; # Listing for pass 1. my $code_listing = 1; # Generated code listing. my $symbol_table = 1; # Output symbol table. my $error_summary = 1; # Output error summary, default to on. my %symbols = (); # Hash of symbol table values. my %macros = (); # Hash of macros. my @errors = (); my $in_macro = 0; my $cur_macro = ''; my $in_conditional = 0; my $skip = 0; my $edasm = 0; my $base = 0x800; # Default base address. Overide with -a (decimal) or -x (hex) from command line or .org or ORG directives in code. my $output_file = ''; # Output file, required to be set with -o command line flag. my $checksum = 0; my $COUT_BOLD = "\e[1m"; my $COUT_YELLOW = "\e[1;33m"; my $COUT_NORMAL = "\e[1;37m"; my $COUT_DIM = "\e[0;37m"; my $COUT_BROWN = "\e[0;33m"; my $COUT_RED = "\e[1;31m"; my $COUT_GREEN = "\e[1;32m"; my $COUT_VIOLET = "\e[1;35m"; my $COUT_AQUA = "\e[1;36m"; sub usage { print "Usage:\n"; print "$0 [-a addr] [-x \$addr] [-v] [-q] [-d] [-s] [-l] [-c] [-h] \n"; print " -a addr : Start address in decimal (default 2048)\n"; print " -x \$addr : Start address in hex (default $800)\n"; print " -o : Output file name (required).\n"; print " -v : Verbose (default on)\n"; print " -q : Quiet (default off)\n"; print " -d : Debug (default off)\n"; print " -s : Symbol Table\n"; print " -l : Listing (source pass 1) (default off)\n"; print " -c : Generated code listing (default on)\n"; print " -e : Generated error summary (default on)\n"; print " -C : Toggle color output (default on)\n"; print " -edasm : Toggle EDASM mode (default ooff)\n"; print " -h : This help\n"; } # Process command line arguments. while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { # Set base address in decimal. if ($ARGV[0] eq '-a' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) { $base = $ARGV[1]; shift; shift; # Set base address in hex. } elsif ($ARGV[0] eq '-x' && defined $ARGV[1] && $ARGV[1] =~ /^[a-f0-9A-F]+$/) { $base = hex(lc($ARGV[1])); shift; shift; # Get output filename } elsif ($ARGV[0] eq '-o' && defined $ARGV[1] && $ARGV[1] ne '') { $output_file = $ARGV[1]; shift; shift; # Verbose. } elsif ($ARGV[0] eq '-v') { $verbose = 1; shift; # Quiet (opposite of verbose). } elsif ($ARGV[0] eq '-q') { $verbose = 0; shift; # Debug. } elsif ($ARGV[0] eq '-d') { $debug = 1; shift; # Symbol table. } elsif ($ARGV[0] eq '-s') { $symbol_table = 0; shift; # Listing (pass 1). } elsif ($ARGV[0] eq '-l') { $listing = 1; shift; # Code listing. } elsif ($ARGV[0] eq '-c') { $code_listing = 0; shift; # Error summary. } elsif ($ARGV[0] eq '-e') { $error_summary = 0; shift; # Toggle color output (default on). } elsif ($ARGV[0] eq '-C') { $COUT_BOLD = ""; $COUT_YELLOW = ""; $COUT_NORMAL = ""; $COUT_DIM = ""; $COUT_BROWN = ""; $COUT_RED = ""; $COUT_GREEN = ""; $COUT_VIOLET = ""; $COUT_AQUA = ""; shift; # Toggle EDASM mode (default ooff). } elsif ($ARGV[0] eq '-edasm') { $edasm = 1; shift; # Help. } elsif ($ARGV[0] eq '-h') { usage(); exit; } else { die "Invalid argument $ARGV[0]\n"; } } my $input_file = shift; die "Must supply input filename\n" unless defined $input_file && $input_file; die "Must supply output filename with -o flag\n" unless defined $output_file && $output_file; # Functions to check and generate code for each 65C02 addressing mode plus the size for each. my %modefuncs = ( 'Immediate' => { 'check' => \&is_Immediate, 'gen' => \&generate_Immediate, 'size' => 2, }, 'Zero_Page' => { 'check' => \&is_Zero_Page, 'gen' => \&generate_Zero_Page, 'size' => 2, }, 'Zero_Page_X' => { 'check' => \&is_Zero_Page_X, 'gen' => \&generate_Zero_Page_X, 'size' => 2, }, 'Zero_Page_Y' => { 'check' => \&is_Zero_Page_Y, 'gen' => \&generate_Zero_Page_Y, 'size' => 2, }, 'Absolute' => { 'check' => \&is_Absolute, 'gen' => \&generate_Absolute, 'size' => 3, }, 'Indirect_Absolute' => { 'check' => \&is_Indirect_Absolute, 'gen' => \&generate_Indirect_Absolute, 'size' => 3, }, 'Indirect_Absolute_X' => { 'check' => \&is_Indirect_Absolute_X, 'gen' => \&generate_Indirect_Absolute_X, 'size' => 3, }, 'Absolute_X' => { 'check' => \&is_Absolute_X, 'gen' => \&generate_Absolute_X, 'size' => 3, }, 'Absolute_Y' => { 'check' => \&is_Absolute_Y, 'gen' => \&generate_Absolute_Y, 'size' => 3, }, 'Indirect_Zero_Page_X' => { 'check' => \&is_Indirect_Zero_Page_X, 'gen' => \&generate_Indirect_Zero_Page_X, 'size' => 2, }, 'Indirect_Zero_Page_Y' => { 'check' => \&is_Indirect_Zero_Page_Y, 'gen' => \&generate_Indirect_Zero_Page_Y, 'size' => 2, }, 'Indirect_Zero_Page' => { 'check' => \&is_Indirect_Zero_Page, 'gen' => \&generate_Indirect_Zero_Page, 'size' => 2, }, 'Relative' => { 'check' => \&is_Relative, 'gen' => \&generate_Relative, 'size' => 2, }, 'Implied' => { 'check' => \&is_Implied, 'gen' => \&generate_Implied, 'size' => 1, }, 'Accumulator' => { 'check' => \&is_Accumulator, 'gen' => \&generate_Accumulator, 'size' => 1, }, ); # The opcodes for each 65C02 instruction mnemonic. my %mnemonics = ( 'ADC' => { # ADC Immediate ADC #Oper 69 2 2 'Immediate' => 0x69, # Zero Page ADC Zpg 65 2 3 'Zero_Page' => 0x65, # Zero Page,X ADC Zpg,X 75 2 4 'Zero_Page_X' => 0x75, # Absolute ADC Abs 6D 3 4 'Absolute' => 0x6d, # Absolute,X ADC Abs,X 7D 3 4 'Absolute_X' => 0x7d, # Absolute,Y ADC Abs,Y 79 3 4 'Absolute_Y' => 0x79, # (Zero Page,X) ADC (Zpg,X) 61 2 6 'Indirect_Zero_Page_X' => 0x61, # (Zero Page),Y ADC (Zpg),Y 71 2 5 'Indirect_Zero_Page_Y' => 0x71, # (Zero Page) ADC (Zpg) 72 2 5 'Indirect_Zero_Page' => 0x72, }, 'AND' => { # AND Immediate AND #Oper 29 2 2 'Immediate' => 0x29, # Zero Page AND Zpg 25 2 3 'Zero_Page' => 0x25, # Zero Page,X AND Zpg,X 35 2 4 'Zero_Page_X' => 0x35, # Absolute AND Abs 2D 3 4 'Absolute' => 0x2d, # Absolute,X AND Abs,X 3D 3 4 'Absolute_X' => 0x3d, # Absolute,Y AND Abs,Y 39 3 4 'Absolute_Y' => 0x39, # (Zero Page,X) AND (Zpg,X) 21 2 6 'Indirect_Zero_Page_X' => 0x21, # (Zero Page),Y AND (Zpg),Y 31 2 5 'Indirect_Zero_Page_Y' => 0x31, # (Zero Page) AND (Zpg) 32 2 5 'Indirect_Zero_Page' => 0x32, }, 'ASL' => { # AS Accumulator ASL A 0A 1 2 'Accumulator' => 0x0a, # Zero Page ASL Zpg 06 2 5 'Zero_Page' => 0x06, # Zero Page,X ASL Zpg,X 16 2 6 'Zero_Page_X' => 0x16, # Absolute ASL Abs 0E 3 6 'Absolute' => 0x0e, # Absolute,X ASL Abs,X 1E 3 7 'Absolute_X' => 0x1e, }, 'BBR0' => { # BBR0 Relative BBR0 Oper 0F 2 2 'Relative' => 0x0f, }, 'BBR1' => { # BBR1 Relative BBR1 Oper 1F 2 2 'Relative' => 0x1f, }, 'BBR2' => { # BBR2 Relative BBR2 Oper 2F 2 2 'Relative' => 0x2f, }, 'BBR3' => { # BBR3 Relative BBR3 Oper 3F 2 2 'Relative' => 0x3f, }, 'BBR4' => { # BBR4 Relative BBR4 Oper 4F 2 2 'Relative' => 0x4f, }, 'BBR5' => { # BBR5 Relative BBR5 Oper 5F 2 2 'Relative' => 0x5f, }, 'BBR6' => { # BBR6 Relative BBR6 Oper 6F 2 2 'Relative' => 0x6f, }, 'BBR7' => { # BBR7 Relative BBR7 Oper 7F 2 2 'Relative' => 0x7f, }, 'BBS0' => { # BBS0 Relative BBS0 Oper 8F 2 2 'Relative' => 0x8f, }, 'BBS1' => { # BBS1 Relative BBS1 Oper 9F 2 2 'Relative' => 0x9f, }, 'BBS2' => { # BBS2 Relative BBS2 Oper AF 2 2 'Relative' => 0xaf, }, 'BBS3' => { # BBS3 Relative BBS3 Oper BF 2 2 'Relative' => 0xbf, }, 'BBS4' => { # BBS4 Relative BBS4 Oper CF 2 2 'Relative' => 0xcf, }, 'BBS5' => { # BBS5 Relative BBS5 Oper DF 2 2 'Relative' => 0xdf, }, 'BBS6' => { # BBS6 Relative BBS6 Oper EF 2 2 'Relative' => 0xef, }, 'BBS7' => { # BBS7 Relative BBS7 Oper FF 2 2 'Relative' => 0xff, }, 'BCC' => { # BCC Relative BCC Oper 90 2 2 'Relative' => 0x90, }, 'BLT' => { # Pseudo-op same as BCC # BLT Relative BLT Oper 90 2 2 'Relative' => 0x90, }, 'BCS' => { # BCS Relative BCS Oper B0 2 2 'Relative' => 0xb0, }, 'BGE' => { # Pseudo-op same as BCS # BGE Relative BGE Oper B0 2 2 'Relative' => 0xb0, }, 'BEQ' => { # BEQ Relative BEQ Oper F0 2 2 'Relative' => 0xf0, }, 'BFL' => { # Pseudo-op same as BEQ # BFL Relative BFL Oper F0 2 2 'Relative' => 0xf0, }, 'BIT' => { # BIT Immediate BIT #Oper 89 2 2 'Immediate' => 0x89, # Zero Page BIT Zpg 24 2 3 'Zero_Page' => 0x24, # Zero Page,X BIT Zpg,X 34 2 4 'Zero_Page_X' => 0x34, # Absolute BIT Abs 2C 3 4 'Absolute' => 0x2c, # Absolute,X BIT Abs,X 3C 3 4 'Absolute_X' => 0x3c, }, 'BMI' => { # BMI Relative BMI Oper 30 2 2 'Relative' => 0x30, }, 'BNE' => { # BNE Relative BNE Oper D0 2 2 'Relative' => 0xd0, }, 'BTR' => { # Pseudo-op same as BNE # BTR Relative BTR Oper D0 2 2 'Relative' => 0xd0, }, 'BPL' => { # BPL Relative BPL Oper 10 2 2 'Relative' => 0x10, }, 'BRA' => { # BRA Relative BRA Oper 80 2 3 'Relative' => 0x80, }, 'BRK' => { # BRK Implied BRK 00 1 7 'Implied' => 0x00, }, 'BVC' => { # BVC Relative BVC Oper 50 2 2 'Relative' => 0x50, }, 'BVS' => { # BVS Relative BVS Oper 70 2 2 'Relative' => 0x70, }, 'CLC' => { # CLC Implied CLC 18 1 2 'Implied' => 0x18, }, 'CLD' => { # CLD Implied CLD D8 1 2 'Implied' => 0xd8, }, 'CLI' => { # CLI Implied CLI 58 1 2 'Implied' => 0x58, }, 'CLV' => { # CLV Implied CLV B8 1 2 'Implied' => 0xb8, }, 'CMP' => { # CMP Immediate CMP #Oper C9 2 2 'Immediate' => 0xc9, # Zero Page CMP Zpg C5 2 3 'Zero_Page' => 0xc5, # Zero Page,X CMP Zpg,X D5 2 4 'Zero_Page_X' => 0xd5, # Absolute CMP Abs CD 3 4 'Absolute' => 0xcd, # Absolute,X CMP Abs,X DD 3 4 'Absolute_X' => 0xdd, # Absolute,Y CMP Abs,Y D9 3 4 'Absolute_Y' => 0xd9, # (Zero Page,X) CMP (Zpg,X) C1 2 6 'Indirect_Zero_Page_X' => 0xc1, # (Zero Page),Y CMP (Zpg),Y D1 2 5 'Indirect_Zero_Page_Y' => 0xd1, # (Zero Page) CMP (Zpg) D2 2 5 'Indirect_Zero_Page' => 0xd2, }, 'CPX' => { # CPX Immediate CPX #Oper E0 2 2 'Immediate' => 0xe0, # Zero Page CPX Zpg E4 2 3 'Zero_Page' => 0xe4, # Absolute CPX Abs EC 3 4 'Absolute' => 0xec, }, 'CPY' => { # CPY Immediate CPY #Oper C0 2 2 'Immediate' => 0xc0, # Zero Page CPY Zpg C4 2 3 'Zero_Page' => 0xc4, # Absolute CPY Abs CC 3 4 'Absolute' => 0xcc, }, 'DEA' => { # DEA Accumulator DEA 3A 1 2 'Accumulator' => 0x3a, }, 'DEC' => { # DEC Zero Page DEC Zpg C6 2 5 'Zero_Page' => 0xc6, # Zero Page,X DEC Zpg,X D6 2 6 'Zero_Page_X' => 0xd6, # Absolute DEC Abs CE 3 6 'Absolute' => 0xce, # Absolute,X DEC Abs,X DE 3 7 'Absolute_X' => 0xde, }, 'DEX' => { # DEX Implied DEX CA 1 2 'Implied' => 0xca, }, 'DEY' => { # DEY Implied DEY 88 1 2 'Implied' => 0x88, }, 'EOR' => { # EOR Immediate EOR #Oper 49 2 2 'Immediate' => 0x49, # Zero Page EOR Zpg 45 2 3 'Zero_Page' => 0x45, # Zero Page,X EOR Zpg,X 55 2 4 'Zero_Page_X' => 0x55, # Absolute EOR Abs 4D 3 4 'Absolute' => 0x4d, # Absolute,X EOR Abs,X 5D 3 4 'Absolute_X' => 0x5d, # Absolute,Y EOR Abs,Y 59 3 4 'Absolute_Y' => 0x59, # (Zero Page,X) EOR (Zpg,X) 41 2 6 'Indirect_Zero_Page_X' => 0x41, # (Zero Page),Y EOR (Zpg),Y 51 2 5 'Indirect_Zero_Page_Y' => 0x51, # (Zero Page) EOR (Zpg) 52 2 5 'Indirect_Zero_Page' => 0x52, }, 'XOR' => { # Pseudo-op same as EOR # XOR Immediate XOR #Oper 49 2 2 'Immediate' => 0x49, # Zero Page XOR Zpg 45 2 3 'Zero_Page' => 0x45, # Zero Page,X XOR Zpg,X 55 2 4 'Zero_Page_X' => 0x55, # Absolute XOR Abs 4D 3 4 'Absolute' => 0x4d, # Absolute,X XOR Abs,X 5D 3 4 'Absolute_X' => 0x5d, # Absolute,Y XOR Abs,Y 59 3 4 'Absolute_Y' => 0x59, # (Zero Page,X) XOR (Zpg,X) 41 2 6 'Indirect_Zero_Page_X' => 0x41, # (Zero Page),Y XOR (Zpg),Y 51 2 5 'Indirect_Zero_Page_Y' => 0x51, # (Zero Page) XOR (Zpg) 52 2 5 'Indirect_Zero_Page' => 0x52, }, 'INA' => { # INA Accumulator INA 1A 1 2 'Accumulator' => 0x1a, }, 'INC' => { # INC Zero Page INC Zpg E6 2 5 'Zero_Page' => 0xe6, # Zero Page,X INC Zpg,X F6 2 6 'Zero_Page_X' => 0xf6, # Absolute INC Abs EE 3 6 'Absolute' => 0xee, # Absolute,X INC Abs,X FE 3 7 'Absolute_X' => 0xfe, }, 'INX' => { # INX Implied INX E8 1 2 'Implied' => 0xe8, }, 'INY' => { # INY Implied INY C8 1 2 'Implied' => 0xc8, }, 'JMP' => { # JMP Absolute JMP Abs 4C 3 3 'Absolute' => 0x4c, # (Absolute) JMP (Abs) 6C 3 5 'Indirect_Absolute' => 0x6c, # (Absolute,X) JMP (Abs,X) 7C 3 6 'Indirect_Absolute_X' => 0x7c, }, 'JSR' => { # JSR Absolute JSR Abs 20 3 6 'Absolute' => 0x20, }, 'LDA' => { # LDA Immediate LDA #Oper A9 2 2 'Immediate' => 0xa9, # Zero Page LDA Zpg A5 2 3 'Zero_Page' => 0xa5, # Zero Page,X LDA Zpg,X B5 2 4 'Zero_Page_X' => 0xb5, # Absolute LDA Abs AD 3 4 'Absolute' => 0xad, # Absolute,X LDA Abs,X BD 3 4 'Absolute_X' => 0xbd, # Absolute,Y LDA Abs,Y B9 3 4 'Absolute_Y' => 0xb9, # (Zero Page,X) LDA (Zpg,X) A1 2 6 'Indirect_Zero_Page_X' => 0xa1, # (Zero Page),Y LDA (Zpg),Y B1 2 5 'Indirect_Zero_Page_Y' => 0xb1, # (Zero Page) LDA (Zpg) B2 2 5 'Indirect_Zero_Page' => 0xb2, }, 'LDX' => { # LDX Immediate LDX #Oper A2 2 2 'Immediate' => 0xa2, # Zero Page LDX Zpg A6 2 3 'Zero_Page' => 0xa6, # Zero Page,Y LDX Zpg,Y B6 2 4 'Zero_Page_Y' => 0xb6, # Absolute LDX Abs AE 3 4 'Absolute' => 0xae, # Absolute,Y LDX Abs,Y BE 3 4 'Absolute_Y' => 0xbe, }, 'LDY' => { # LDY Immediate LDY #Oper A0 2 2 'Immediate' => 0xa0, # Zero Page LDY Zpg A4 2 3 'Zero_Page' => 0xa4, # Zero Page,X LDY Zpg,X B4 2 4 'Zero_Page_X' => 0xb4, # Absolute LDY Abs AC 3 4 'Absolute' => 0xac, # Absolute,X LDY Abs,X BC 3 4 'Absolute_X' => 0xbc, }, 'LSR' => { # LSR Accumulator LSR A 4A 1 2 'Accumulator' => 0x4a, # Zero Page LSR Zpg 46 2 5 'Zero_Page' => 0x46, # Zero Page,X LSR Zpg,X 56 2 6 'Zero_Page_X' => 0x56, # Absolute LSR Abs 4E 3 6 'Absolute' => 0x4e, # Absolute,X LSR Abs,X 5E 3 7 'Absolute_X' => 0x5e, }, 'NOP' => { # NOP Implied NOP EA 1 2 'Implied' => 0xea, }, 'ORA' => { # ORA Immediate ORA #Oper 09 2 2 'Immediate' => 0x09, # Zero Page ORA Zpg 05 2 3 'Zero_Page' => 0x05, # Zero Page,X ORA Zpg,X 15 2 4 'Zero_Page_X' => 0x15, # Absolute ORA Abs 0D 3 4 'Absolute' => 0x0d, # Absolute,X ORA Abs,X 1D 3 4 'Absolute_X' => 0x1d, # Absolute,Y ORA Abs,Y 19 3 4 'Absolute_Y' => 0x19, # (Zero Page,X) ORA (Zpg,X) 01 2 6 'Indirect_Zero_Page_X' => 0x01, # (Zero Page),Y ORA (Zpg),Y 11 2 5 'Indirect_Zero_Page_Y' => 0x11, # (Zero Page) ORA (Zpg) 12 2 5 'Indirect_Zero_Page' => 0x12, }, 'PHA' => { # PHA Implied PHA 48 1 3 'Implied' => 0x48, }, 'PHP' => { # PHP Implied PHP 08 1 3 'Implied' => 0x08, }, 'PHX' => { # PHX Implied PHX DA 1 3 'Implied' => 0xda, }, 'PHY' => { # PHY Implied PHY 5A 1 3 'Implied' => 0x5a, }, 'PLA' => { # PLA Implied PLA 68 1 4 'Implied' => 0x68, }, 'PLP' => { # PLP Implied PLP 68 1 4 'Implied' => 0x28, }, 'PLX' => { # PLX Implied PLX FA 1 4 'Implied' => 0xfa, }, 'PLY' => { # PLY Implied PLY 7A 1 4 'Implied' => 0x7a, }, 'ROL' => { # ROL Accumulator ROL A 2A 1 2 'Accumulator' => 0x2a, # Zero Page ROL Zpg 26 2 5 'Zero_Page' => 0x26, # Zero Page,X ROL Zpg,X 36 2 6 'Zero_Page_X' => 0x36, # Absolute ROL Abs 2E 3 6 'Absolute' => 0x2e, # Absolute,X ROL Abs,X 3E 3 7 'Absolute_X' => 0x3e, }, 'ROR' => { # ROR Accumulator ROR A 6A 1 2 'Accumulator' => 0x6a, # Zero Page ROR Zpg 66 2 5 'Zero_Page' => 0x66, # Zero Page,X ROR Zpg,X 76 2 6 'Zero_Page_X' => 0x76, # Absolute ROR Abs 6E 3 6 'Absolute' => 0x6e, # Absolute,X ROR Abs,X 7E 3 7 'Absolute_X' => 0x7e, }, 'RTI' => { # RTI Implied RTI 40 1 6 'Implied' => 0x40, }, 'RTS' => { # RTS Implied RTS 60 1 6 'Implied' => 0x60, }, 'SBC' => { # SBC Immediate SBC #Oper E9 2 2 'Immediate' => 0xe9, # Zero Page SBC Zpg E5 2 3 'Zero_Page' => 0xe5, # Zero Page,X SBC Zpg,X F5 2 4 'Zero_Page_X' => 0xf5, # Absolute SBC Abs ED 3 4 'Absolute' => 0xed, # Absolute,X SBC Abs,X FD 3 4 'Absolute_X' => 0xfd, # Absolute,Y SBC Abs,Y F9 3 4 'Absolute_Y' => 0xf9, # (Zero Page,X) SBC (Zpg,X) E1 2 6 'Indirect_Zero_Page_X' => 0xe1, # (Zero Page),Y SBC (Zpg),Y F1 2 5 'Indirect_Zero_Page_Y' => 0xf1, # (Zero Page) SBC (Zpg) F2 2 5 'Indirect_Zero_Page' => 0xf2, }, 'SEC' => { # SEC Implied SEC 38 1 2 'Implied' => 0x38, }, 'SED' => { # SED Implied SED F8 1 2 'Implied' => 0xf8, }, 'SEI' => { # SEI Implied SEI 78 1 2 'Implied' => 0x78, }, 'STA' => { # STA Zero Page STA Zpg 85 2 3 'Zero_Page' => 0x85, # Zero Page,X STA Zpg,X 95 2 4 'Zero_Page_X' => 0x95, # Absolute STA Abs 8D 3 4 'Absolute' => 0x8d, # Absolute,X STA Abs,X 9D 3 5 'Absolute_X' => 0x9d, # Absolute,Y STA Abs,Y 99 3 5 'Absolute_Y' => 0x99, # (Zero Page,X) STA (Zpg,X) 81 2 6 'Indirect_Zero_Page_X' => 0x81, # (Zero Page),Y STA (Zpg),Y 91 2 6 'Indirect_Zero_Page_Y' => 0x91, # (Zero Page) STA (Zpg) 92 2 5 'Indirect_Zero_Page' => 0x92, }, 'STX' => { # STX Zero Page STX Zpg 86 2 3 'Zero_Page' => 0x86, # Zero Page,Y STX Zpg,Y 96 2 4 'Zero_Page_Y' => 0x96, # Absolute STX Abs 8E 3 4 'Absolute' => 0x8e, }, 'STY' => { # STY Zero Page STY Zpg 84 2 3 'Zero_Page' => 0x84, # Zero Page,X STY Zpg,X 94 2 4 'Zero_Page_X' => 0x94, # Absolute STY Abs 8C 3 4 'Absolute' => 0x8c, }, 'STZ' => { # STZ Zero Page STZ Zpg 64 2 3 'Zero_Page' => 0x64, # Zero Page,X STZ Zpg,X 74 2 4 'Zero_Page_X' => 0x74, # Absolute STZ Abs 9C 3 4 'Absolute' => 0x9c, # Absolute,X STZ Abs,X 9E 3 5 'Absolute_X' => 0x9e, }, 'TAX' => { # TAX Implied TAX AA 1 2 'Implied' => 0xaa, }, 'TAY' => { # TAY Implied TAY A8 1 2 'Implied' => 0xa8, }, 'TRB' => { # TRB Zero Page TRB Zpg 14 2 5 'Zero_Page' => 0x14, # Absolute TRB Abs 1C 3 6 'Absolute' => 0x1c, }, 'TSB' => { # TSB Zero Page TSB Zpg 04 2 5 'Zero_Page' => 0x04, # Absolute TSB Abs 0C 3 6 'Absolute' => 0x0c, }, 'TSX' => { # TSX Implied TSX BA 1 2 'Implied' => 0xba, }, 'TXA' => { # TXA Implied TXA 8A 1 2 'Implied' => 0x8a, }, 'TXS' => { # TXS Implied TXS 9A 1 2 'Implied' => 0x9a, }, 'TYA' => { # TYA Implied TYA 98 1 2 'Implied' => 0x98, }, ); sub print_err { my ($line) = @_; push @errors, $line; print $COUT_RED . $line . $COUT_NORMAL; } sub calc_checksum { my ($byte) = @_; # Checksum is exclusive or of all output bytes. This is a Merlin thing. $checksum ^= $byte; } # Generate code for one byte instructions. sub generate_8 { my ($ofh, $addr, $opcode, $lineno, $line) = @_; print sprintf("%04x: %02x %-4d %s\n", $addr, $opcode, $lineno, $line) if $code_listing; print $ofh pack("C", $opcode); calc_checksum($opcode); } # Generate code for two byte instructions. sub generate_16 { my ($ofh, $addr, $opcode, $opval, $lineno, $line) = @_; $opval = 0x00 unless defined $opval; if ($opval =~ /^\$([0-9a-fA-F]{1,2})$/) { $opval = hex(lc($1)); } print sprintf("%04x: %02x %02x %-4d %s\n", $addr, $opcode, $opval, $lineno, $line) if $code_listing; print $ofh pack("C", $opcode); print $ofh pack("C", $opval); calc_checksum($opcode); calc_checksum($opval); } # Generate code for three byte instructions. sub generate_24 { my ($ofh, $addr, $opcode, $opval1, $opval2, $lineno, $line) = @_; $opval1 = 0x00 unless defined $opval1; $opval2 = 0x00 unless defined $opval2; print sprintf("%04x: %02x %02x %02x %-4d %s\n", $addr, $opcode, $opval1, $opval2, $lineno, $line) if $code_listing; print $ofh pack("C", $opcode); print $ofh pack("C", $opval1); print $ofh pack("C", $opval2); calc_checksum($opcode); calc_checksum($opval1); calc_checksum($opval2); } # Generate output for strings, defined storage, etc. sub generate_bytes { my ($ofh, $addr, $bytes, $lineno, $line) = @_; my $firstflag = 1; foreach my $byte (@{$bytes}) { if ($firstflag) { print sprintf("%04x: %02x %-4d %s\n", $addr, ord($byte), $lineno, $line) if $code_listing; $firstflag = 0; } else { print sprintf("%04x: %02x\n", $addr, ord($byte)) if $code_listing; } print $ofh pack("C", ord($byte)); calc_checksum(ord($byte)); $addr++; } $_[1] = $addr; } sub get_symval { my ($prt, $sym) = @_; my $val = $symbols{$sym}; $val = $symbols{$sym . ':'} unless defined $val; $val = $symbols{':' . $sym} unless defined $val; if (defined $val) { # Get high byte. if (defined $prt && $prt eq '<') { # Hex if ($val =~ /\$([0-9a-fA-F]{1,2})/) { $val = '$' . $1; # Binary } elsif ($val =~ /%([01]{8})/) { $val = '$'. sprintf("%02x", unpack('C', pack("B8", $1))); # Decimal } elsif ($val =~ /^(\d+)$/) { $val = '$' . substr(sprintf("%04x", $1), 0, 2); } # Get low byte. } elsif (defined $prt && $prt eq '>') { # 16 bit Hex if ($val =~ /\$[0-9a-fA-F]*([0-9a-fA-F][0-9a-fA-F])/) { $val = '$' . $1; # 8 bit Hex } elsif ($val =~ /\$([0-9a-fA-F][0-9a-fA-F])/) { $val = '$' . $1; # 4 bit Hex } elsif ($val =~ /\$([0-9a-fA-F])/) { $val = '$' . $1; # Binary } elsif ($val =~ /%[01]{8}([01]{8})/) { $val = '$'. sprintf("%02x", unpack('C', pack("B8", $1))); # Decimal } elsif ($val =~ /^(\d+)$/) { $val = '$' . substr(sprintf("%04x", $1), 2, 2); } # Binary } elsif ($val =~ /%([01]{8})([01]{8})/) { $val = '$'. sprintf("%02x%02x", unpack('C', pack("B8", $1)), unpack('C', pack("B8", $2))); # Decimal } } return $val; } sub is_symbol { my ($operand) = @_; return 1 if $operand =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*$/; return 0; } sub parse_symbol { my ($operand) = @_; my $prt = ''; my $sym = ''; if ($operand =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*$/) { $prt = $1; $sym = $2; } $prt = '' unless defined $prt; return get_symval($prt, $sym); } sub parse_symval { my ($symval) = @_; if ($symval =~ /\$([0-9a-fA-F]+)/) { return hex(lc($1)); } elsif ($symval =~ /%([01]{8})/) { my $byte = unpack('C', pack("B8", $1)); return $byte; } elsif ($symval =~ /^(\d+)$/) { return $1; } return $symval; } sub sym_op { my ($symval, $op, $offset) = @_; $symval = 0 unless defined $symval; $offset = 0 unless defined $offset; my $roff = $offset; if ($offset =~ /\$([0-9a-fA-F]*)/) { $roff = hex(lc($1)); } my $val = parse_symval($symval); if (defined $op) { if ($op eq '+') { $val += $roff; } elsif ($op eq '-') { $val -= $roff; } elsif ($op eq '*') { $val *= $roff; } elsif ($op eq '/') { $val /= $roff; } } return $val; } sub handle_8_bit_symbol { my ($ofh, $lineno, $addr, $opcode, $prt, $symbol, $op, $val, $line) = @_; my $symval = $symbols{$symbol}; $symval = $symbols{$symbol . ':'} unless defined $symval; $symval = $symbols{':' . $symbol} unless defined $symval; if (defined $symval) { my $opval = $symval; # $prt is used to specify the 1st or 2nd byte. if (defined $prt && (($prt eq '>' && $edasm) || ($prt eq '<' && !$edasm))) { if ($symval =~ /^\$[0-9a-fA-F]{1,2}([0-9a-fA-F][0-9a-fA-F])$/) { $opval = hex(lc($1)); } elsif ($symval =~ /^\$([0-9a-fA-F])$|^\$([0-9a-fA-F])$/) { $opval = hex(lc($1)); } } elsif (defined $prt && (($prt eq '<' && $edasm) || ($prt = '>' && !$edasm))) { if ($symval =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $opval = hex(lc($1)); } elsif ($symval =~ /^\$([0-9a-fA-F])$/) { $opval = hex(lc($1)); } } else { if ($symval =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $opval = hex(lc($1)); } elsif ($symval =~ /^\$([0-9a-fA-F])$/) { $opval = hex(lc($1)); } elsif ($symval =~ /%([01]{8})$/) { $opval = unpack('C', pack("B8", $1)); } else { } } if ($opval =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $opval = hex(lc($1)); } if ($opval > 255) { $opval -= 256; } my $opval2 = sym_op($opval, $op, $val); if ($opval2 > 255) { $opval2 -= 256; } generate_16($ofh, $addr, $opcode, $opval2, $lineno, $line); } else { print_err("**** $lineno - Unknown symbol '$symbol' in '$line'\n"); generate_16($ofh, $addr, $opcode, 0x00, $lineno, $line); } } sub handle_16_bit_symbol { my ($ofh, $lineno, $addr, $opcode, $symbol, $op, $val, $line) = @_; my $symval = $symbols{$symbol}; $symval = $symbols{$symbol . ':'} unless defined $symval; $symval = $symbols{':' . $symbol} unless defined $symval; if (defined $symval) { my $opval1 = 0; my $opval2 = 0; if ($symval =~ /^\$([0-9a-fA-F]+)$/) { my $opval = sprintf("%04x", sym_op($symval, $op, $val)); $opval1 = hex(lc(substr($opval, 0, 2))); $opval2 = hex(lc(substr($opval, 2, 2))); } generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); } else { print_err("**** $lineno - Unknown symbol '$symbol' in '$line'\n"); generate_24($ofh, $addr, $opcode, 0x00, 0x00, $lineno, $line); } } # ADC #Oper 69 # AND #Oper 29 # BIT #Oper 89 # CMP #Oper C9 # CPX #Oper E0 # CPY #Oper C0 # EOR #Oper 49 # LDA #Oper A9 # LDX #Oper A2 # LDY #Oper A0 # ORA #Oper 09 # SBC #Oper E9 sub is_Immediate { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^#\$[0-9a-fA-f]{0,1}[0-9a-fA-F]$/) { return 2; # Parse binary } elsif ($operand =~ /^#%([01]{8})$/) { return 2; # Parse decimal } elsif ($operand =~ /^#(\d)+$/) { #return 0 if ($1 > 255); return 2; # Parse ASCII } elsif ($operand =~ /^#"(.)["]*$/) { return 2; } elsif ($operand =~ /^#'(.)[']*$/) { return 2; # Handle symbols. } elsif ($operand =~ /^#[<>]*\(*([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\)*$/) { return 2; # Allow arithmetic on symbol } elsif ($operand =~ /^#[<>]*\(*([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*(\$*[0-9a-fA-F]+)\)*$/) { return 2; # For macros } elsif ($operand =~ /^#\](\d+)$/) { return 2; } elsif ($operand =~ /^#\[(\d+)$/) { return 2; #} else { #print "NOT IMMEDIATE! '$operand'\n"; } return 0; } sub generate_Immediate { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^#\$([0-9a-fA-F]{0,1}[0-9a-fA-F])$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^#%([01]{8})$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^#(\d+)$/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Parse ASCII } elsif ($operand =~ /^#"(.)["]*$/) { generate_16($ofh, $addr, $opcode, ord($1), $lineno, $line); } elsif ($operand =~ /^#'(.)[']*$/) { generate_16($ofh, $addr, $opcode, ord($1), $lineno, $line); # Handle symbol } elsif ($operand =~ /^#([<>]*)\(*([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\)*/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^#([<>]*)\(*([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)\)*$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\](\d+)$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Immediate Bad Operand : '$operand' in '$line'\n"); } $_[0] += 2; } # ADC Zpg 65 # AND Zpg 25 # ASL Zpg 06 # BIT Zpg 24 # CMP Zpg C5 # CPX Zpg E4 # CPY Zpg C4 # DEC Zpg C6 # EOR Zpg 45 # INC Zpg E6 # LDA Zpg A5 # LDX Zpg A6 # LDY Zpg A4 # LSR Zpg 46 # ORA Zpg 05 # ROL Zpg 26 # ROR Zpg 66 # SBC Zpg E5 # STA Zpg 85 # STX Zpg 86 # STY Zpg 84 # STZ Zpg 64 # TRB Zpg 14 # TSB Zpg 04 sub is_Zero_Page { my ($operand, $lineno) = @_; # Don't mistake Accumulator mode for instructions like LSR. return 0 if $operand =~ /^[Aa]$/; # Parse hex if ($operand =~ /^\$[0-9a-fA-F]{0,1}[0-9a-fA-F]$/) { return 2; # Parse binary } elsif ($operand =~ /^#%([01]{8})$/) { return 2; # Parse decimal } elsif ($operand =~ /^(\d+)$/) { return 0 if $1 > 255; return 2; # Handle symbols } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { # Not Zero Page if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; # Allow symbol arithmetic } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*\$*[0-9a-fA-F]+$/) { # Not Zero Page if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; # For macros } elsif ($operand =~ /^\](\d+)$/) { return 2; } return 0; } sub generate_Zero_Page { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^%([01]{8})$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^(\d+)$/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\](\d+)$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Zero_Page Bad Operand : '$operand' in '$line'\n"); } $_[0] += 2; } # ADC Zpg,X 75 # AND Zpg,X 35 # ASL Zpg,X 16 # BIT Zpg,X 34 # DEC Zpg,X D6 # EOR Zpg,X 55 # INC Zpg,X F6 # LDA Zpg,X B5 # LDY Zpg,X B4 # LSR Zpg,X 56 # ORA Zpg,X 15 # ROL Zpg,X 36 # ROR Zpg,X 76 # SBC Zpg,X F5 # STA Zpg,X 95 # STY Zpg,X 94 # STZ Zpg,X 74 sub is_Zero_Page_X { my ($operand, $lineno) = @_; # Don't mistake Accumulator mode for instructions like LSR. return 0 if $operand =~ /^[Aa]$/; # Parse hex if ($operand =~ /^\$[0-9a-fA-F]{0,1}[0-9a-fA-F],[Xx]$/) { return 2; # Parse binary } elsif ($operand =~ /^%([01]{8}),[Xx]$/) { return 2; # Parse decimal } elsif ($operand =~ /^(\d+),[Xx]$/) { return 0 if $1 > 255; return 2; # Handle symbols } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]$/) { # Not Zero Page,X if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*\$*[0-9a-fA-F]+,[Xx]$/) { # Not Zero Page,X if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; # For macros } elsif ($operand =~ /^\](\d+),[Xx]$/) { return 2; } return 0; } sub generate_Zero_Page_X { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F]),[Xx]$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^%([01]{8}),[Xx]$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^(\d+),[Xx]$/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Handle symbol arithmetic } elsif ($operand =~ /^([<>]*)([0-9A-Za-z_\.\?:][0-9a-zA-Z_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+),[Xx]$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\](\d+),[Xx]$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Zero_Page_X Bad Operand : '$operand' in '$line'\n"); } $_[0] += 2; } # LDX Zpg,Y B6 # STX Zpg,Y 96 sub is_Zero_Page_Y { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\$[0-9a-fA-F]{0,1}[0-9a-fA-F],[Yy]$/) { return 2; # Parse binary } elsif ($operand =~ /^%([01]{8}),[Yy]$/) { return 2; # Parse decimal } elsif ($operand =~ /^(\d+),[Yy]$/) { return 0 if $1 > 255; return 2; # Handle symbols } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Yy]$/) { # Not Zero Page,Y if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*\$*[0-9a-fA-F]+,[Yy]$/) { # Not Zero Page,Y if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; # For macros } elsif ($operand =~ /^\](\d+),[Yy]$/) { return 2; } return 0; } sub generate_Zero_Page_Y { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F]),[Yy]$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^%([01]{8}),[Yy]$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^(\d+),[Yy]$/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Yy]$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^({<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+),[Yy]$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\](\d+),[Yy]$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Zero_Page_Y Bad Operand : '$operand' in '$line'\n"); } $_[0] += 2; } # ADC Abs 6D # AND Abs 2D # ASL Abs 0E # BIT Abs 2C # CMP Abs CD # CPX Abs EC # CPY Abs CC # DEC Abs CE # EOR Abs 4D # INC Abs EE # JMP Abs 4C # JSR Abs 20 # LDA Abs AD # LDX Abs AE # LDY Abs AC # LSR Abs 4E # ORA Abs 0D # ROL Abs 2E # ROR Abs 6E # SBC Abs ED # STA Abs 8D # STX Abs 8E # STY Abs 8C # STZ Abs 9C # TRB Abs 1C # TSB Abs 0C sub is_Absolute { my ($operand, $lineno) = @_; # Don't mistake Accumulator mode for instructions like LSR. return 0 if $operand =~ /^[Aa]$/; # Parse hex if ($operand =~ /^\$[0-9a-fA-F]{0,1}[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]$/) { return 2; # Parse binary } elsif ($operand =~ /^%([01]{16})$/) { return 2; # Parse decimal } elsif ($operand =~ /^\d+$/) { return 2; # handle symbols } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { # Not Ansolute if the symbol is not 16 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { return 0 if $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*\$*[0-9a-fA-F]+$/) { # Not Ansolute if the symbol is not 16 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { return 0 if $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } return 2; # For macros } elsif ($operand =~ /^\](\d+)$/) { return 2; } return 0; } sub generate_Absolute { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9A-Fa-f][0-9A-Fa-f])$/) { my $opval1 = hex(lc($1)); my $opval2 = hex(lc($2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse binary } elsif ($operand =~ /^%([01]{8})([0-1]{8})$/) { my $opval1 = unpack('C', pack("B8", $1)); my $opval2 = unpack('C', pack("B8", $2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse decimal } elsif ($operand =~ /^(\d+)$/) { my $opval = sprintf("%04x", $1); my $opval1 = hex(lc(substr($opval, 0, 2))); my $opval2 = hex(lc(substr($opval, 2, 2))); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $operand, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $line); # For macros } elsif ($operand =~ /^\](\d+)$/) { generate_24($ofh, $addr, $opcode, $mac2, $mac1, $lineno, $line); } else { print_err(">>>> $lineno - Absolute Bad Operand '$operand' in '$line'\n"); } $_[0] += 3; } # JMP (Abs) 6C sub is_Indirect_Absolute { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]+)\)$/) { return 2; # Parse binary } elsif ($operand =~ /^\(%([01]{16})\)$/) { return 2; # Parse decimal } elsif ($operand =~ /^\((\d+)\)$/) { return 2; # Handle symbol } elsif ($operand =~ /^\([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*\)$/) { return 2; # Allow symbol arithmetic } elsif ($operand =~ /^\([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*\s*[+-\\*\/]\s*[#]*\$*[0-9a-fA-F]+\)/) { return 2; # For macros } elsif ($operand =~ /^\(\](\d+)\)$/) { return 2; } elsif ($operand =~ /^\(\[(\d+)\)$/) { return 2; } return 0; } sub generate_Indirect_Absolute { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9A-Fa-f][0-9A-Fa-f])\)/) { my $opval1 = hex(lc($1)); my $opval2 = hex(lc($2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse binary } elsif ($operand =~ /^\(%([01]{8})([01]{8})\)$/) { my $opval1 = unpack('C', pack("B8", $1)); my $opval2 = unpack('C', pack("B8", $2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse decimal } elsif ($operand =~ /^\((\d+)\)/) { my $opval = sprintf("%04x", $1); my $opval1 = hex(lc(substr($opval, 0, 2))); my $opval2 = hex(lc(substr($opval, 2, 2))); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\)/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)\)/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $line); # For macros } elsif ($operand =~ /^\(\](\d+)\)$/) { generate_24($ofh, $addr, $opcode, $mac2, $mac1, $lineno, $line); } elsif ($operand =~ /^\(\[(\d+)\)$/) { generate_24($ofh, $addr, $opcode, $mac2, $mac1, $lineno, $line); } else { print_err(">>>> $lineno - Indirect_Absolute Bad Operand '$operand' in '$line'\n"); } $_[0] += 3; } # JMP (Abs,X) 7C sub is_Indirect_Absolute_X { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]+),[Xx]\)$/) { return 2; # Parse binary } elsif ($operand =~ /^\(%([01]{16}),[Xx]\)$/) { return 2; # Parse decimal } elsif ($operand =~ /^\((\d+),[Xx]\)$/) { return 2; # Handle symbol } elsif ($operand =~ /^\([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*,[Xx]\)$/) { return 2; # Allow symbol arithmetic } elsif ($operand =~ /^\([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*\s*[+-\\*\/]\s*[#]*\$*[0-9a-fA-F]+,[Xx]\)/) { return 2; # For macros } elsif ($operand =~ /^\(\](\d+),[Xx]\)$/) { return 2; } elsif ($operand =~ /^\(\[(\d+),[Xx]\)$/) { return 2; } return 0; } sub generate_Indirect_Absolute_X { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9A-Fa-f][0-9A-Fa-f]),[Xx]\)/) { my $opval1 = hex(lc($1)); my $opval2 = hex(lc($2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse binary } elsif ($operand =~ /^\(%([01]{8})([01]{8}),[Xx]\)$/) { my $opval1 = unpack('C', pack("B8", $1)); my $opval2 = unpack('C', pack("B8", $2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse decimal } elsif ($operand =~ /^\((\d+),[Xx]\)/) { my $opval = sprintf("%04x", $1); my $opval1 = hex(lc(substr($opval, 0, 2))); my $opval2 = hex(lc(substr($opval, 2, 2))); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]\)$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+),[Xx]\)$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $line); # For macros } elsif ($operand =~ /^\(\](\d+),[Xx]\)$/) { generate_24($ofh, $addr, $opcode, $mac2, $mac1, $lineno, $line); } else { print_err(">>>> $lineno - Indirect_Absolute_X Bad Operand '$operand' in '$line'\n"); } $_[0] += 3; } # ADC Abs,X 7D # AND Abs,X 3D # ASL Abs,X 1E # BIT Abs,X 3C # CMP Abs,X DD # DEC Abs,X DE # EOR Abs,X 5D # INC Abs,X FE # LDA Abs,X BD # LSR Abs,X 5E # ORA Abs,X 1D # ROL Abs,X 3E # ROR Abs,X 7E # SBC Abs,X FD # STA Abs,X 9D # STZ Abs,X 9E sub is_Absolute_X { my ($operand, $lineno) = @_; # Don't mistake Accumulator mode for instructions like LSR. return 0 if $operand =~ /^[Aa]$/; # Parse hex if ($operand =~ /^\$[0-9a-fA-F]{0,1}[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F],[Xx]$/) { return 2; # Parse binary } elsif ($operand =~ /^%([01]{16}),[Xx]$/) { return 2; # Parse decimal } elsif ($operand =~ /^(\d{1,3}),[Xx]$/) { return 0 if $1 > 255; return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]$/) { # Not Ansolute,X if the symbol is not 16 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { return 0 if $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*(\$*[0-9a-fA-F]+),[Xx]$/) { # Not Ansolute,X if the symbol is not 16 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { return 0 if $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } return 2; # For macros } elsif ($operand =~ /^\](\d+),[Xx]$/) { return 2; } return 0; } sub generate_Absolute_X { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9A-Fa-f][0-9A-Fa-f]),[Xx]/) { my $opval1 = hex(lc($1)); my $opval2 = hex(lc($2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse binary } elsif ($operand =~ /^%([01]{8})([01]{8}),[Xx]$/) { my $opval1 = unpack('C', pack("B8", $1)); my $opval2 = unpack('C', pack("B8", $2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse decimal } elsif ($operand =~ /^(\d+),[Xx]/) { my $opval = sprintf("%04x", $1); my $opval1 = hex(lc(substr($opval, 0, 2))); my $opval2 = hex(lc(substr($opval, 2, 2))); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+),[Xx]$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $line); # For macros } elsif ($operand =~ /^\](\d+),[Xx]$/) { generate_24($ofh, $addr, $opcode, $mac2, $mac1, $lineno, $line); } else { print_err(">>>> $lineno - Indirect_Absolute_X Bad Operand '$operand' in '$line'\n"); } $_[0] += 3; } # ADC Abs,Y 79 # AND Abs,Y 39 # CMP Abs,Y D9 # EOR Abs,Y 59 # LDA Abs,Y B9 # LDX Abs,Y BE # LDY Abs,X BC # ORA Abs,Y 19 # SBC Abs,Y F9 # STA Abs,Y 99 sub is_Absolute_Y { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\$[0-9a-fA-F]{0,1}[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F],[Yy]$/) { return 2; # Parse binary } elsif ($operand =~ /^%([01]{16}),[Yy]$/) { return 2; # Parse decimal } elsif ($operand =~ /^\d+,[Yy]$/) { return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Yy]$/) { # Not Ansolute,Y if the symbol is not 16 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { return 0 if $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } return 2; } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*(\$*[0-9a-fA-F]+),[Yy]/) { # Not Ansolute,Y if the symbol is not 16 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { return 0 if $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } return 2; # For macros } elsif ($operand =~ /^\(\](\d+),[Yy]\)$/) { return 2; } elsif ($operand =~ /^\(\[(\d+),[Yy]\)$/) { return 2; } return 0; } sub generate_Absolute_Y { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9A-Fa-f][0-9A-Fa-f]),[Yy]/) { my $opval1 = hex(lc($1)); my $opval2 = hex(lc($2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse binary } elsif ($operand =~ /^%([01]{8})([01]{8}),[Yy]$/) { my $opval1 = unpack('C', pack("B8", $1)); my $opval2 = unpack('C', pack("B8", $2)); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Parse decimal } elsif ($operand =~ /^(\d+),[Yy]/) { my $opval = sprintf("%04x", $1); my $opval1 = hex(lc(substr($opval, 0, 2))); my $opval2 = hex(lc(substr($opval, 2, 2))); generate_24($ofh, $addr, $opcode, $opval2, $opval1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Yy]$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+),[Yy]$/) { handle_16_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $line); # For macros } elsif ($operand =~ /^\(\](\d+),[Yy]\)$/) { generate_24($ofh, $addr, $opcode, $mac2, $mac1, $lineno, $line); } else { print_err(">>>> $lineno - Absolute_Y Bad Operand '$operand' in '$line'\n"); } $_[0] += 3; } # ADC (Zpg,X) 61 # AND (Zpg,X) 21 # CMP (Zpg,X) C1 # EOR (Zpg,X) 41 # LDA (Zpg,X) A1 # ORA (Zpg,X) 01 # SBC (Zpg,X) E1 # STA (Zpg,X) 81 sub is_Indirect_Zero_Page_X { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\(\$[0-9a-fA-F]{0,1}[0-9a-fA-F],[Xx]\)$/) { return 2; # Parse binary } elsif ($operand =~ /^\(%([01]{8}),[Xx]\)$/) { return 2; # Parse decimal } elsif ($operand =~ /^\((\d+),[Xx]\)$/) { return 0 if $1 > 255; return 2; } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]\)$/) { # Not Indirect Zero Page,X if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*(\$*[0-9a-fA-F]+),[Xx]\)/) { # Not Indirect Zero Page,X if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; # For macros } elsif ($operand =~ /^\(\](\d+),[Xx]\)$/) { return 2; } elsif ($operand =~ /^\(\[(\d+),[Xx]\)$/) { return 2; } return 0; } sub generate_Indirect_Zero_Page_X { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-f]{0,1}[0-9a-fA-f]),[Xx]\)$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^\(%([01]{8}),[Xx]\)$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^\((\d+)\),[Xx]/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^\(([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*),[Xx]\)$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^\(([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+),[Xx]\)$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\(\](\d+),[Xx]\)$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Indirect_Zero_Page_X Bad Operand : '$operand' in '$line'\n"); } $_[0] += 2; } # ADC (Zpg),Y 71 # AND (Zpg),Y 31 # CMP (Zpg),Y D1 # EOR (Zpg),Y 51 # LDA (Zpg),Y B1 # ORA (Zpg),Y 11 # SBC (Zpg),Y F1 # STA (Zpg),Y 91 sub is_Indirect_Zero_Page_Y { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]{0,1}[0-9a-fA-F])\),[Yy]$/) { return 2; # Parse binary } elsif ($operand =~ /^\(%([01]{8})\),[Yy]$/) { return 2; # Parse decimal } elsif ($operand =~ /^\((\d+)\),[Yy]/) { return 0 if $1 > 255; return 2; } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\),[Yy]$/) { # Not Indirect Zero Page,Y if the symbol is not 8 bits. return 2; } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*(\$*[0-9a-fA-F]+)\),[Yy]/) { # Not Indirect Zero Page,Y if the symbol is not 8 bits. return 2; # For macros } elsif ($operand =~ /^\(\](\d+)\),[Yy]$/) { return 2; } elsif ($operand =~ /^\(\[(\d+)\),[Yy]$/) { return 2; } return 0; } sub generate_Indirect_Zero_Page_Y { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]{0,1}[0-9a-fA-F])\),[Yy]$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^\(%([01]{8})\),[Yy]$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^\((\d+)\),[Yy]$/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^\(([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\),[Yy]$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^\([<>]*([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)\),[Yy]$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\(\](\d+)\),[Yy]$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Indirect_Zero_Page_Y Bad Operand : '$operand' in '$line'\n"); } $_[0] += 2; } # ADC (Zpg) 72 # AND (Zpg) 32 # CMP (Zpg) D2 # EOR (Zpg) 52 # LDA (Zpg) B2 # ORA (Zpg) 12 # SBC (Zpg) F2 # STA (Zpg) 92 sub is_Indirect_Zero_Page { my ($operand, $lineno) = @_; # Parse hex if ($operand =~ /^\(\$[0-9a-fA-F]{0,1}[0-9a-fA-F]\)$/) { return 2; # Parse binary } elsif ($operand =~ /^\(%([01]{8})\)$/) { return 2; # Parse decimal } elsif ($operand =~ /^\((\d+)\)$/) { return 0 if $1 > 255; return 2; } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\)$/) { # Not Indirect Zero Page if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; } elsif ($operand =~ /^\(([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+-\\*\/]\s*[#]*(\$*[0-9a-fA-F]+)\)$/) { # Not Indirect Zero Page if the symbol is not 8 bits. my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /^\d+$/) { return 0 if ($symval > 255); } else { return 0 unless $symval =~ /^\$[0-9a-fA-F][0-9a-fA-F]$|^%[01]{8}$/; } } else { # Assume that forward declared symbols are addresses. return 0; } return 2; # For macros } elsif ($operand =~ /^\(\](\d+)\)$/) { return 2; } elsif ($operand =~ /^\(\](\d+)\)$/) { return 2; } return 0; } sub generate_Indirect_Zero_Page { my ($addr, $operand, $opcode, $ofh, $lineno, $line, $mac1, $mac2) = @_; # Parse hex if ($operand =~ /^\(\$([0-9a-fA-F]{0,1}[0-9a-fA-F])\)$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse binary } elsif ($operand =~ /^\(%([01]{8})\)$/) { my $opval = unpack('C', pack("B8", $1)); generate_16($ofh, $addr, $opcode, $opval, $lineno, $line); # Parse decimal } elsif ($operand =~ /^\((\d+)\)/) { generate_16($ofh, $addr, $opcode, $1, $lineno, $line); # Return symbol value } elsif ($operand =~ /^\(([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\)$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, undef, undef, $line); # Allow arithmetic on symbol } elsif ($operand =~ /^\(([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)\)$/) { handle_8_bit_symbol($ofh, $lineno, $addr, $opcode, $1, $2, $3, $4, $line); # For macros } elsif ($operand =~ /^\(\](\d+)\)$/) { my $val = $mac1; if ($1 == 2) { $val = $mac2; } generate_16($ofh, $addr, $opcode, $val, $lineno, $line); } else { print_err(">>>> $lineno - Indirect_Zero_Page Bad Operand '$operand' in '$line'\n"); } $_[0] += 2; } # BBR0 Oper 0F # BBR1 Oper 1F # BBR2 Oper 2F # BBR3 Oper 3F # BBR4 Oper 4F # BBR5 Oper 5F # BBR6 Oper 6F # BBR7 Oper 7F # BBS0 Oper 8F # BBS1 Oper 9F # BBS2 Oper AF # BBS3 Oper BF # BBS4 Oper CF # BBS5 Oper DF # BBS6 Oper EF # BBS7 Oper FF # BCC Oper 90 # BCS Oper B0 # BEQ Oper F0 # BMI Oper 30 # BNE Oper D0 # BPL Oper 10 # BRA Oper 80 # BVC Oper 50 # BVS Oper 70 sub is_Relative { my ($operand, $lineno) = @_; # Just needs to have an operand, we'll figure it out if ($operand =~ /^(\S+)/) { return 2; } return 0; } sub generate_Relative { my ($addr, $operand, $opcode, $ofh, $lineno, $line) = @_; # Decode hex if ($operand =~ /^\$([0-9a-fA-F]+$)/) { my $opval = hex(lc($1)); my $rel = (0 - ($addr - $opval)) + 254; if ($rel < 0) { $rel += 256; } if ($rel > 255) { $rel -= 256; } if ($rel < 0 || $rel > 255) { print_err("^^^^ $lineno - Illegal Branch in '$line'\n"); generate_16($ofh, $addr, $opcode, 0x00, $lineno, $line); } else { generate_16($ofh, $addr, $opcode, $rel, $lineno, $line); } # Decode decimal } elsif ($operand =~ /^(\d+)$/) { my $rel = (0 - ($addr - $1)) + 254; if ($rel < 0) { $rel += 256; } if ($rel > 255) { $rel -= 256; } if ($rel < 0 || $rel > 255) { print_err("^^^^ $lineno - Illegal Branch in '$line'\n"); generate_16($ofh, $addr, $opcode, 0x00, $lineno, $line); } else { generate_16($ofh, $addr, $opcode, $rel, $lineno, $line); } # Handle symbols } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $symbol = $1; my $symval = $symbols{$symbol}; $symval = $symbols{$symbol . ':'} unless defined $symval; $symval = $symbols{':' . $symbol} unless defined $symval; if (defined $symval) { my $opval = lc($symval); if ($symval =~ /^\$([0-9a-fA-F]+)$/) { $opval = hex(lc($1)); } else { $opval = $symval; } my $rel = (0 - ($addr - $opval)) + 254; if ($rel < 0) { $rel += 256; } if ($rel > 255) { $rel -= 256; } if ($rel < 0 || $rel > 255) { print_err("^^^^ $lineno - Illegal Branch in '$line'\n"); generate_16($ofh, $addr, $opcode, 0x00, $lineno, $line); } else { generate_16($ofh, $addr, $opcode, $rel, $lineno, $line); } } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } # Handle symbol arithmetic } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { my $sym = $1; my $op = $2; my $val = $3; my $symval = $symbols{$sym}; $symval = $symbols{$sym . ':'} unless defined $symval; $symval = $symbols{':' . $sym} unless defined $symval; if (defined $symval) { my $opval = lc($symval); if ($symval =~ /^\$([0-9a-fA-F]+)$/) { $opval = hex(lc($1)); } else { $opval = $symval; } if ($op eq '+') { $opval += $val; } elsif ($op eq '-') { $opval -= $val; } my $rel = (0 - ($addr - $opval)) + 254; if ($rel < 0) { $rel += 256; } if ($rel > 255) { $rel -= 256; } generate_16($ofh, $addr, $opcode, $rel, $lineno, $line); } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } } else { print_err(">>>> $lineno - Relative Bad Operand '$operand' in '$line'\n"); } $_[0] += 2; } # BRK 00 # CLC 18 # CLD D8 # CLI 58 # CLV B8 # DEX CA # DEY 88 # INX E8 # INY C8 # NOP EA # PHA 48 # PHP 08 # PHX DA # PHY 5A # PLA 68 # PLP 28 # PLX FA # PLY 7A # RTI 40 # RTS 60 # SEC 38 # SED F8 # SEI 78 # TAX AA # TAY A8 # TSX BA # TXA 8A # TXS 9A # TYA 98 sub is_Implied { my ($operand, $lineno) = @_; # No operand on implied instructions if ($operand eq '') { return 1; } elsif ($operand =~ /^\s*;/) { return 1; } return 0; } sub generate_Implied { my ($addr, $operand, $opcode, $ofh, $lineno, $line) = @_; generate_8($ofh, $addr, $opcode, $lineno, $line); $_[0]++; } # ASL A 0A # DEA 3A # INA 1A # LSR A 4A # ROL A 2A # ROR A 6A sub is_Accumulator { my ($operand, $lineno) = @_; if ($operand =~ /^[Aa]$/ || $operand eq '') { return 1; } return 0; } sub generate_Accumulator { my ($addr, $operand, $opcode, $ofh, $lineno, $line) = @_; generate_8($ofh, $addr, $opcode, $lineno, $line); $_[0]++; } sub parse_line { my ($line, $lineno) = @_; my ($label, $mnemonic, $operand, $comment) = ('', '', '', ''); if ($line =~ /^(\S+)\s+(\S+)\s+(\S+)\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $4; # Fix fir LABEL ASC 'text' ; comment } elsif ($line =~ /^(\S+)\s+(\S+)\s+(['].+['])\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $4; # Fix fir ASC 'text' ; comment } elsif ($line =~ /^\s+(\S+)\s+(['].+['])\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $4; # Fix fir LABEL ASC 'text' } elsif ($line =~ /^(\S+)\s+(\S+)\s+(['].+['])\s*$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = ''; # Fix fir ASC 'text' } elsif ($line =~ /^\s+(\S+)\s+(['].+['])\s*$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = ''; } elsif ($line =~ /^(\S+)\s+(\S+)\s+(\S+)\s*$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = ''; } elsif ($line =~ /^\s+(\S+)\s+(\S+)\s*(;.*)$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = $3; } elsif ($line =~ /^\s+(\S+)\s+(\S+)\s*$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = ''; if ($operand =~ /^;/) { $comment = $operand; $operand = ''; } } elsif ($line =~ /^\s+(\S+)\s*(;.*)$/) { $label = ''; $mnemonic = $1; $operand = ''; $comment = $2; } elsif ($line =~ /^\s+(\S+)\s*$/) { $label = ''; $mnemonic = $1; $operand = ''; $comment = ''; } elsif ($line =~ /^(\S+)\s*$/) { $label = $1; $mnemonic = ''; $operand = ''; $comment = ''; } elsif ($line =~ /^(\S+)\s+(\S+)\s*$/) { $label = $1; $mnemonic = $2; $operand = ''; $comment = ''; } elsif ($line =~ /^\s+(\S+)\s*(;.*)$/) { $label = ''; $mnemonic = $1; $operand = ''; $comment = $2; } elsif ($line =~ /^(\S+)\s+(\S+)\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = ''; $comment = $3; } elsif ($line =~ /^(\S+)\s*(;.*)$/) { $label = $1; $mnemonic = ''; $operand = ''; $comment = $2; } elsif ($line =~ /^(\S+)\s+([Aa][Ss][Cc])\s+(".+"[,]*[0-9a-fA-F]*)\s+(;.*)$|^(\S+)\s+([Ddl[Cc][Ii])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^(\S+)\s+([Ii][Nn][Vv])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^(\S+)\s+([Ff][Ll][Ss])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^(\S+)\s+([Rr][Ee][Vv])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^(\S+)\s+([Ss][Tt][Rr])\s+(".+"[0-9a-fA-F]*)\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $4; } elsif ($line =~ /^\s+([Aa][Ss][Cc])\s+(".+"[,]*[0-9a-fA-F]*)\s+(;.*)$|^\s+([Dd][Cc][Ii])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^\s+([Ii][Nn][Vv])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^\s+([Ff][Ll][Ss])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^\s+([Rr][Ee][Vv])\s+(".+"[0-9a-fA-F]*)\s+(;.*)$|^\s+([Ss][Tt][Rr])\s+(".+"[0-9a-fA-F]*)\s*(;.*)$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = $3; } elsif ($line =~ /^(\S+)\s+([Aa][Ss][Cc])\s+(".+"[,]*[0-9a-fA-F]*)\s*$|^(\S+)\s+([Dd][Cc][Ii])\s+(".+"[0-9a-fA-F]*)\s*$|^(\S+)\s+([Ii][Nn][Vv])\s+(".+"[0-9a-fA-F]*)\s*$|^(\S+)\s+([Ff][Ll][Ss])\s+(".+"[0-9a-fA-F]*)\s*$|^(\S+)\s+([Rr][Ee][Vv])\s+(".+"[0-9a-fA-F]*)\s*$|^(\S+)\s+([Ss][Tt][Rr])\s+(".+"[0-9a-fA-F]*)\s*$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = ''; } elsif ($line =~ /^\s+([Aa][Ss][Cc])\s+(".+"[,]*[0-9a-fA-F]*)\s*$|^\s+([Dd][Cc][Ii])\s+(".+"[0-9a-fA-F]*)\s*$|^\s+([Ii][Nn][Vv])\s+(".+"[0-9a-fA-F]*)\s*$|^\s+([Ff][Ll][Ss])\s+(".+"[0-9a-fA-F]*)\s*$|^\s+([Rr][Ee][Vv])\s+(".+"[0-9a-fA-F]*)\s*$|^\s+([Ss][Tt][Rr])\s+(".+"[0-9a-fA-F]*)\s*$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = ''; # Next 4 for things like LDA #" " } elsif ($line =~ /^\s+(\S+)\s+(#\".\")\s*(;.*)$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = $3; } elsif ($line =~ /^\s+(\S+)\s+(#\".\")\s*$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = ''; } elsif ($line =~ /^(\S+)\s+(\S+)\s+(#\".\")\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $3; } elsif ($line =~ /^(\S+)\s+(\S+)\s+(#\".\")\s*$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = ''; # Next 4 for things like DS 255," " } elsif ($line =~ /^\s+([Dd][Ss])\s+(\d+,\".\")\s*(;.*)$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = $3; } elsif ($line =~ /^\s+([Dd][Ss])\s+(\d+,\".\")\s*$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = ''; } elsif ($line =~ /^(\S+)\s+([Dd][Ss])\s+(\d+,\".\")\s*(;.*)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $3; } elsif ($line =~ /^(\S+)\s+([Dd][Ss])\s+(\d+,\".\")\s*$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = ''; # Handle comments w/o ; -- S-C assembler } elsif ($line =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/) { $label = $1; $mnemonic = $2; $operand = $3; $comment = $4; } elsif ($line =~ /^\s+(\S+)\s+(\S+)\s+(.+)$/) { $label = ''; $mnemonic = $1; $operand = $2; $comment = $3; } else { print_err(sprintf("SYNTAX ERROR! %-4d %s\n", $lineno, $line)); } $label = '' unless defined $label; $comment = '' unless defined $comment; $mnemonic = '' unless defined $mnemonic; $operand = '' unless defined $operand; print "label=$label mnemonic=$mnemonic operand=$operand comment=$comment\n" if $debug; return ($label, $mnemonic, $operand, $comment); } my $addr = $base; my $ifh; my $lineno = 0; my $in_include = 0; my $ififh; my $ilineno = 0; # Open the input file. if (open($ifh, "<$input_file")) { print "**** Starting 1st pass ****\n" if $verbose; print "\n" if $verbose; # Pass 1, build symbol table. #while (my $line = readline $ifh) { while (!eof($ifh)) { my $line = ''; if ($in_include) { $line = readline $ififh; chomp $line; $ilineno++; print $COUT_YELLOW . sprintf("%04x: %-4d %s\n", $addr, $ilineno, $line) . $COUT_NORMAL if $listing; #print $COUT_GREEN . "line=$line\n" . $COUT_NORMAL; if (eof($ififh)) { $in_include = 0; print $COUT_GREEN . "---- END INCLUDE ----\n" . $COUT_NORMAL if $debug; } } else { $line = readline $ifh; $lineno++; chomp $line; print sprintf("%04x: %-4d %s\n", $addr, $lineno, $line) if $listing; } # Handle include files. if ($line =~ /^#include\s+"([^"]+)"\s*\;*.*/ || $line =~ /^\.include\s+"([^"]+)"\s*\;*.*/) { if (open($ififh, "<$1")) { print $COUT_GREEN . "---- INCLUDING $1 ----\n" . $COUT_NORMAL if $debug; $in_include = 1; $ilineno = 0; } else { print_err("**** Unable to open $1 - '$line'\n"); } next; } # Skip blank lines. next if $line =~ /^\s*$/; # Skip comment lines. next if $line =~ /^\s*;/; next if $line =~ /^\s*\*/; # Process .org lines. if ($line =~ /^\.org\s+(.+)/) { my $operand = $1; $operand =~ s/^\$//; $base = hex(lc($operand)); $addr = $base; print sprintf("%%%%%%%% base=%s \$%02x\n", $base, $base) if $verbose; next; } # Parse .alias lines. if ($line =~ /^\.alias\s+(\S+)\s+(.+)/) { my $alias = $1; my $val = $2; $val =~ s/\s*;(.+)$//; $symbols{$alias} = $val; print "%%%% alias $alias $val\n" if $verbose; next; } # Parse input lines. my ($label, $mnemonic, $operand, $comment) = parse_line($line, $lineno); my $rv; # Look for symbols. if (defined $label && $label ne '' && $label ne ';' && $mnemonic !~ /EQU|\.EQ|^=$/i) { my $symbol = $label; print $COUT_AQUA . sprintf("%%%%%%%% Saving symbol $label %s \$%04x\n", $addr, $addr) . $COUT_NORMAL if $verbose; $symbols{$symbol} = sprintf("\$%04x", $addr); } next unless defined $mnemonic; next if $mnemonic eq ''; my $ucmnemonic = uc($mnemonic); if ($in_macro) { if ($ucmnemonic ne '<<<') { print $COUT_AQUA . "%%%% Saving $line to macro $cur_macro\n" . $COUT_NORMAL; push @{$macros{$cur_macro}}, $line; } } if ($in_conditional) { print ">>>> IN CONDITIONAL\n"; if ($skip) { print "******** SKIPPING!!!!! ********\n"; next; } } # We only need to look for ORG and EQU on pass 1. if ($ucmnemonic =~ /ORG|\.OR/) { # Set base $operand =~ s/^\$//; $base = hex(lc($operand)); $addr = $base; print sprintf("%%%%%%%% Setting base to \$%04x\n", $base) if $verbose; } elsif ($ucmnemonic =~ /EQU|\.EQ|^=$/i) { # define constant my $symbol = $label; #print $COUT_AQUA . "%%%% Saving Symbol $symbol $operand\n" . $COUT_NORMAL if $verbose; # Hex if ($operand =~ /^\$([0-9a-fA-F]+)$/) { $symbols{$symbol} = lc($operand); # Decimal } elsif ($operand =~ /^(\d+)$/) { $symbols{$symbol} = '$' . sprintf("%x", $operand); # 8 bit binary } elsif ($operand =~ /^%([01]{8})$/) { $symbols{$symbol} = '$' . sprintf("%02x", unpack('C', pack("B8", $1))); print $COUT_AQUA . "%%%% Saving Symbol $symbol $symbols{$symbol}\n" . $COUT_NORMAL if $verbose; # 16 bit binary } elsif ($operand =~ /^%([01]{8})([01]{8})$/) { $symbols{$symbol} = '$' . sprintf("%02x", unpack('C', pack("B8", $1))) . sprintf("%02x", unpack('C', pack("B8", $2))); print $COUT_AQUA . "%%%% Saving Symbol $symbol $symbols{$symbol}\n" . $COUT_NORMAL if $verbose; } elsif ($operand eq '*') { $symbols{$symbol} = sprintf("\$%x", $addr); # Handle symbol } elsif ($operand =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $prt = $1; my $sym = $2; my $symval = $symbols{$sym}; $symval = $symbols{$sym . ':'} unless defined $symval; $symval = $symbols{':' . $sym} unless defined $symval; if (defined $symval) { # Handle < and >. if (defined $prt && $prt eq '<') { if ($symval =~ /\$([0-9a-fA-F]{1,2})/) { $symbols{$symbol} = $1; print $COUT_AQUA . "%%%% Saving Symbol $symbol $1\n" . $COUT_NORMAL if $verbose; } } elsif (defined $prt && $prt eq '>') { if ($symval =~ /\$[0-9a-fA-F]*([0-9a-fA-F]{1,2})/) { $symbols{$symbol} = $1; print $COUT_AQUA . "%%%% Saving Symbol $symbol $1\n" . $COUT_NORMAL if $verbose; } } else { $symbols{$symbol} = $symval; print $COUT_AQUA . "%%%% Saving Symbol $symbol $symval\n" . $COUT_NORMAL if $verbose; } } else { print_err("**** $lineno - Unknown symbol '$2' in '$line'\n"); } # Allow arithmetic on symbol } elsif ($operand =~ /^([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { ##FIXME -- need to handle < and > here. my $sym = $2; my $op = $3; my $opv = $4; if (defined $sym) { my $symv = $symbols{$sym}; $symv = $symbols{$sym . ':'} unless defined $symv; $symv = $symbols{':' . $sym} unless defined $symv; if (defined $symv) { $symbols{$symbol} = sprintf("\$%x", sym_op($symv, $op, $opv)); print $COUT_AQUA . "%%%% Saving Symbol $symbol $symbols{$symbol}\n" . $COUT_NORMAL if $verbose; } else { print_err("**** $lineno - Unknown symbol '$sym' in '$line'\n"); } } } else { print $COUT_AQUA . "%%%% Saving Symbol $symbol $operand\n" . $COUT_NORMAL if $verbose; $symbols{$symbol} = $operand; } } elsif ($ucmnemonic =~ /HEX/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } if ($operand =~ /([0-9a-fA-F]+)/) { $addr += (length($1) / 2); } } elsif ($ucmnemonic =~ /^DS$/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } if ($operand =~ /\$([0-9a-fA-F]+)/) { $addr += hex(lc($1)); } elsif ($operand =~ /^(\d+)/) { $addr += $1; } } elsif ($ucmnemonic =~ /^DB$|^TYP$/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } $addr++; } elsif ($ucmnemonic =~ /^DA$|^\.DA$|^DW$/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } $addr += 2; } elsif ($ucmnemonic =~ /DFB/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } if ($operand =~ /^%([01]{8})/) { $addr++; } elsif ($operand =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $addr++; } elsif ($operand =~ /^#<(.+)/) { $addr++; } elsif ($operand =~ /^#>(.+)/) { $addr++; } elsif ($operand =~ /^#(.+)/) { my @args = split /,/, $1; $addr += scalar @args * 2; # Allow symbol arithmetic. } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])$/) { $addr++; } elsif ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $addr += 2; } #} else { # print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } # Allow symbols. } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*$/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])$/) { $addr++; } elsif ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $addr += 2; } #} else { # print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } } else { my @symbols = split(',', $operand); my @bytes; foreach my $sym (@symbols) { my $prt = ''; my $symbol = $sym; if ($sym =~ /^([\<\>]*)([A-Za-z\.\?:][A-Za-z0-9_\.\?:]+)/) { $prt = $1; $symbol = $2; } my $symval = get_symval($prt, $symbol); if (defined $symval) { push @bytes, sprintf("%02x", parse_symval($symval)); #} else { # print_err("**** $lineno - Unknown symbol '$sym' in '$line'\n"); } } $addr += scalar(@bytes); } } elsif ($ucmnemonic =~ /ASC|DCI|INV|FLS|BLK|REV|STR/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } my $str = ''; my $trl; if ($operand =~ /^\"(.+)\"([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } elsif ($operand =~ /^'(.+)'([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } elsif ($operand =~ /^'(.+)'\s*$/) { $str = $1; $trl = ''; } $addr += (length($str) - 1); $addr++ if defined $trl; ##FIXME -- need to test this } elsif ($ucmnemonic =~ /HBY/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } ##FIXME -- implement this } elsif ($ucmnemonic =~ /^BYT$/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } ##FIXME -- implement this } elsif ($ucmnemonic =~ /DFS/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } ##FIXME -- implement this } elsif ($ucmnemonic =~ /BYTE/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } my @args = split /,/, $operand; $addr += scalar @args; } elsif ($ucmnemonic =~ /WORD/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } my @args = split /,/, $operand; $addr += scalar @args * 2; } elsif ($ucmnemonic =~ /OBJ|CHK|LST|END|SAV|\.TF|XC/) { # Just ignore this } elsif ($ucmnemonic =~ /MAC/) { print "**** MACRO START **** '$line'\n" if $debug; $macros{$label} = (); $in_macro = 1; $cur_macro = $label; } elsif ($ucmnemonic =~ /\<\<\>>> DO $operand\n"; $in_conditional = 1; if ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F]+)$/) { if (hex($1) > 0) { $skip = 1; } } } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } } else { print_err("**** $lineno - ERROR PARSING CONDITIONAL '$operand' in '$line'\n"); } } elsif ($ucmnemonic =~ /^FIN$/) { $in_conditional = 0; $skip = 0; # Mnemonic Addressing mode Form Opcode Size Timing } elsif (defined $mnemonics{$ucmnemonic}) { my $foundit = 0; foreach my $opmode (keys %{$mnemonics{$ucmnemonic}}) { my $checkfunc = $modefuncs{$opmode}{'check'}; if ($checkfunc->($operand, $lineno)) { $addr += $modefuncs{$opmode}{'size'}; $foundit = 1; last; } } if (! $foundit) { print_err("!!!! $lineno - Unrecognized addressing mode '$line'!\n"); } } elsif (defined $macros{$ucmnemonic}) { print "#### MACRO $ucmnemonic ####\n" if $debug; # Add length for the macro. my $maclnno = 0; foreach my $macln (@{$macros{$ucmnemonic}}) { $maclnno++; my ($maclabel, $macmnemonic, $macoperand, $maccomment) = parse_line($macln, $maclnno); my $ucmacmnemonic = uc($macmnemonic); my $foundit = 0; foreach my $opmode (keys %{$mnemonics{$ucmacmnemonic}}) { my $checkfunc = $modefuncs{$opmode}{'check'}; if ($checkfunc->($macoperand, $maclnno)) { $addr += $modefuncs{$opmode}{'size'}; $foundit = 1; last; } } if (! $foundit) { print_err("!!!! $maclnno - Unrecognized addressing mode in macro '$macln'!\n"); } } } else { print_err("$lineno - Unknown mnemonic '$mnemonic' in '$line'\n"); } } print "**** Starting 1st pass again ****\n" if $verbose; print "\n" if $verbose; # Rewind to the beginning of the input file. seek($ifh, 0, 0); $addr = $base; $lineno = 0; $checksum = 0; $in_macro = 0; $in_conditional = 0; $in_include = 0; # Pass 1.5, build symbol table. #while (my $line = readline $ifh) { while (!eof($ifh)) { my $line = ''; if ($in_include) { $line = readline $ififh; $ilineno++; $in_include = 0 if eof($ififh); } else { $line = readline $ifh; $lineno++; } chomp $line; #print sprintf("%04x: %-4d %s\n", $addr, $lineno, $line) if $listing; # Handle include files. if ($line =~ /^#include\s+"([^"]+)"\s*\;*.*/ || $line =~ /^\.include\s+"([^"]+)"\s*\;*.*/) { if (open($ififh, "<$1")) { $in_include = 1; $ilineno = 0; } else { print_err("**** Unable to open $1 - '$line'\n"); } next; } # Skip blank lines. next if $line =~ /^\s*$/; # Skip comment lines. next if $line =~ /^\s*;/; next if $line =~ /^\s*\*/; # Process .org lines. #if ($line =~ /^\.org\s+(.+)/) { # my $operand = $1; # $operand =~ s/^\$//; # $base = hex(lc($operand)); # $addr = $base; # print sprintf("%%%%%%%% base=%s \$%02x\n", $base, $base) if $verbose; # next; #} # Parse .alias lines. #if ($line =~ /^\.alias\s+(\S+)\s+(.+)/) { # my $alias = $1; # my $val = $2; # $val =~ s/\s*;(.+)$//; # $symbols{$alias} = $val; # print "%%%% alias $alias $val\n" if $verbose; # next; #} # Parse input lines. my ($label, $mnemonic, $operand, $comment) = parse_line($line, $lineno); my $rv; # Look for symbols. if (defined $label && $label ne '' && $label ne ';' && $mnemonic !~ /EQU|\.EQ|^=$/i) { my $symbol = $label; if (! defined $symbols{$symbol}) { print $COUT_AQUA . sprintf("%%%%%%%% Saving symbol $label %s \$%04x\n", $addr, $addr) . $COUT_NORMAL if $verbose; $symbols{$symbol} = sprintf("\$%04x", $addr); } } next unless defined $mnemonic; next if $mnemonic eq ''; my $ucmnemonic = uc($mnemonic); #if ($in_macro) { # if ($ucmnemonic ne '<<<') { # print $COUT_AQUA . "%%%% Saving $line to macro $cur_macro\n" . $COUT_NORMAL; # push @{$macros{$cur_macro}}, $line; # } #} # We only need to look for ORG and EQU on pass 1. if ($ucmnemonic =~ /ORG|\.OR/) { # Set base #$operand =~ s/^\$//; #$base = hex(lc($operand)); #$addr = $base; #print sprintf("%%%%%%%% Setting base to \$%04x\n", $base) if $verbose; } elsif ($ucmnemonic =~ /EQU|\.EQ|^=$/i) { # define constant my $symbol = $label; if (! defined $symbols{$symbol}) { #print $COUT_AQUA . "%%%% Saving Symbol $symbol $operand\n" . $COUT_NORMAL if $verbose; #if ($operand =~ /^\$([0-9a-fA-F]+)$/) { # $symbols{$symbol} = lc($operand); ## 8 bit binary #} elsif ($operand =~ /^%([01]{8})$/) { # $symbols{$symbol} = '$' . sprintf("%02x", unpack('C', pack("B8", $1))); ## 16 bit binary #} elsif ($operand =~ /^%([01]{8})([01]{8})$/) { # $symbols{$symbol} = '$' . sprintf("%02x", unpack('C', pack("B8", $1))) . sprintf("%02x", unpack('C', pack("B8", $2))); # Handle symbol #} elsif ($operand =~ /^([<>]*)([A-Za-z\.\?:][A-Za-z0-9_\.\?:]*)$/) { if ($operand =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $prt = $1; my $symval = $symbols{$2}; $symval = $symbols{$2 . ':'} unless defined $symval; $symval = $symbols{':' . $2} unless defined $symval; if (defined $symval) { # Handle < and >. if (defined $prt && (($prt eq '>' && $edasm) || ($prt eq '<' && !$edasm))) { if ($symval =~ /\$([0-9a-fA-F]{1,2})/) { $symbols{$symbol} = $1; print $COUT_AQUA . "%%%% Saving Symbol $symbol $1\n" . $COUT_NORMAL if $verbose; } } elsif (defined $prt && (($prt eq '<' && $edasm) || ($prt = '>' && !$edasm))) { if ($symval =~ /\$[0-9a-fA-F]*([0-9a-fA-F]{1,2})/) { $symbols{$symbol} = $1; print $COUT_AQUA . "%%%% Saving Symbol $symbol $1\n" . $COUT_NORMAL if $verbose; } } else { $symbols{$symbol} = $symval; print $COUT_AQUA . "%%%% Saving Symbol $symbol $symval\n" . $COUT_NORMAL if $verbose; } } else { print_err("**** $lineno - Unknown symbol '$2' in '$line'\n"); } # Allow arithmetic on symbol } elsif ($operand =~ /^([<>]*)([A-Za-z\.\?:][A-Za-z0-9_\.\?:]*)\s*[+]\s*[#]*(\$*[0-9a-fA-F]+)$/) { # Add $symbols{$symbol} = sprintf("\$%x", sym_op($symbols{$2}, '+', $3)); print $COUT_AQUA . "%%%% Saving Symbol $symbol $symbols{$symbol}\n" . $COUT_NORMAL if $verbose; } elsif ($operand =~ /^([<>]*)([A-Za-z\.\?:][A-Za-z0-9_\.\?:]*)\s*[-]\s*[#]*(\$*[0-9a-fA-F]+)$/) { # Subtract $symbols{$symbol} = sprintf("\$%x", sym_op($symbols{$2}, '-', $3)); print $COUT_AQUA . "%%%% Saving Symbol $symbol $symbols{$symbol}\n" . $COUT_NORMAL if $verbose; } else { $symbols{$symbol} = $operand; print $COUT_AQUA . "%%%% Saving Symbol $symbol $operand\n" . $COUT_NORMAL if $verbose; } } } elsif ($ucmnemonic =~ /HEX/) { if ($label ne '') { my $symbol = $label; if (! defined $symbols{$symbol}) { $symbols{$symbol} = sprintf("\$%04x", $addr); } } if ($operand =~ /([0-9a-fA-F]+)/) { $addr += (length($1) / 2); ##FIXME -- need to handle symbols here. } } elsif ($ucmnemonic =~ /^DS$/) { if ($label ne '') { my $symbol = $label; if (! defined $symbols{$symbol}) { $symbols{$symbol} = sprintf("\$%04x", $addr); } } if ($operand =~ /\$([0-9a-fA-F]+)/) { $addr += hex(lc($1)); } elsif ($operand =~ /^(\d+)/) { $addr += $1; ##FIXME -- need to handle symbols here. } } elsif ($ucmnemonic =~ /^DB$|^TYP$/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } $addr++; } elsif ($ucmnemonic =~ /^DA$|^\.DA$|^DW$/) { if ($label ne '') { my $symbol = $label; if (! defined $symbols{$symbol}) { $symbols{$symbol} = sprintf("\$%04x", $addr); } } $addr += 2; } elsif ($ucmnemonic =~ /DFB/) { if ($label ne '') { my $symbol = $label; if (! defined $symbols{$symbol}) { $symbols{$symbol} = sprintf("\$%04x", $addr); } } if ($operand =~ /^%([01]{8})/) { $addr++; } elsif ($operand =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $addr++; } elsif ($operand =~ /^#<(.+)/) { $addr++; } elsif ($operand =~ /^#>(.+)/) { $addr++; } elsif ($operand =~ /^#(.+)/) { my @args = split /,/, $1; $addr += scalar @args * 2; # Allow symbol arithmetic. } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])$/) { $addr++; } elsif ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $addr += 2; } } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } # Allow symbols. } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*$/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])$/) { $addr++; } elsif ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $addr += 2; } } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); } } else { my @symbols = split(',', $operand); my @bytes; foreach my $sym (@symbols) { my $prt = ''; my $symbol = $sym; if ($sym =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]+)/) { $prt = $1; $symbol = $2; } my $symval = get_symval($prt, $symbol); if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])/) { push @bytes, pack('C', hex(sprintf("%02x", hex(lc($1))))); push @bytes, pack('C', hex(sprintf("%02x", hex(lc($2))))); } else { push @bytes, sprintf("%02x", parse_symval($symval)); } } else { print_err("**** $lineno - Unknown symbol '$sym' in '$line'\n"); } } $addr += scalar(@bytes); } } elsif ($ucmnemonic =~ /ASC|DCI|INV|FLS|BLK|REV|STR/) { if ($label ne '') { my $symbol = $label; if (! defined $symbols{$symbol}) { $symbols{$symbol} = sprintf("\$%04x", $addr); } } my $str = ''; my $trl; if ($operand =~ /^\"(.+)\"([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } elsif ($operand =~ /^'(.+)'([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } $addr += (length($str) - 1); $addr++ if defined $trl; ##FIXME -- need to test this } elsif ($ucmnemonic =~ /HBY/) { if ($label ne '') { my $symbol = $label; if (! defined $symbols{$symbol}) { $symbols{$symbol} = sprintf("\$%04x", $addr); } } ##FIXME -- implement this } elsif ($ucmnemonic =~ /^BYT$/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } ##FIXME -- implement this } elsif ($ucmnemonic =~ /DFS/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } ##FIXME -- implement this } elsif ($ucmnemonic =~ /BYTE/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } my @args = split /,/, $operand; $addr += scalar @args; } elsif ($ucmnemonic =~ /WORD/) { if ($label ne '') { my $symbol = $label; $symbols{$symbol} = sprintf("\$%04x", $addr); } my @args = split /,/, $operand; $addr += scalar @args * 2; } elsif ($ucmnemonic =~ /OBJ|CHK|LST|END|SAV|\.TF|XC/) { # Just ignore this } elsif ($ucmnemonic =~ /MAC/) { # print "**** MACRO START **** '$line'\n" if $debug; # $macros{$label} = (); # $in_macro = 1; # $cur_macro = $label; } elsif ($ucmnemonic =~ /\<\<\>>> DO $operand\n"; $in_conditional = 1; } elsif ($ucmnemonic =~ /^FIN$/) { print ">>>> END CONDITIONAL\n"; $in_conditional = 0; # Mnemonic Addressing mode Form Opcode Size Timing } elsif (defined $mnemonics{$ucmnemonic}) { my $foundit = 0; foreach my $opmode (keys %{$mnemonics{$ucmnemonic}}) { my $checkfunc = $modefuncs{$opmode}{'check'}; if ($checkfunc->($operand, $lineno)) { $addr += $modefuncs{$opmode}{'size'}; $foundit = 1; last; } } if (! $foundit) { print_err("!!!! $lineno - Unrecognized addressing mode '$line'!\n"); } } elsif (defined $macros{$ucmnemonic}) { print "#### MACRO $ucmnemonic ####\n" if $debug; # Add length for the macro. my $maclnno = 0; foreach my $macln (@{$macros{$ucmnemonic}}) { $maclnno++; my ($maclabel, $macmnemonic, $macoperand, $maccomment) = parse_line($macln, $maclnno); my $ucmacmnemonic = uc($macmnemonic); my $foundit = 0; foreach my $opmode (keys %{$mnemonics{$ucmacmnemonic}}) { my $checkfunc = $modefuncs{$opmode}{'check'}; if ($checkfunc->($macoperand, $maclnno)) { $addr += $modefuncs{$opmode}{'size'}; $foundit = 1; last; } } if (! $foundit) { print_err("!!!! $maclnno - Unrecognized addressing mode in macro '$macln'!\n"); } } } else { print_err("$lineno - Unknown mnemonic '$mnemonic' in '$line'\n"); } } print "\n" if $verbose; if ($symbol_table) { print "---- Symbol table ----\n\n"; foreach my $ky (keys %symbols) { print sprintf("%-13s : %s\n", $ky, $symbols{$ky}); } print "\n"; } print "**** Starting 2nd pass ****\n" if $verbose; print "\n" if $verbose; # Rewind to the beginning of the input file. seek($ifh, 0, 0); my $ofh; $addr = $base; $lineno = 0; $checksum = 0; $in_macro = 0; $in_conditional = 0; $in_include = 0; # Pass two, generate output open($ofh, ">$output_file") or die "Can't write $output_file\n"; binmode $ofh; #while (my $line = readline $ifh) { while (!eof($ifh)) { my $line = ''; if ($in_include) { $line = readline $ififh; $ilineno++; $in_include = 0 if eof($ififh); } else { $line = readline $ifh; $lineno++; } chomp $line; # Handle include files. if ($line =~ /^#include\s+"([^"]+)"\s*\;*.*/ || $line =~ /^\.include\s+"([^"]+)"\s*\;*.*/) { if (open($ififh, "<$1")) { $in_include = 1; $ilineno = 0; } else { print_err("**** Unable to open $1 - '$line'\n"); } next; } # Skip blank lines, comment lines, .org .alias. if ($line =~ /^\s*$|^\s*;|^\s*\*|^\.org\s+.+|^\.alias\s+\S+\s+.+/) { print sprintf(" %-4d %s\n", $lineno, $line) if $code_listing; next; } # Parse input lines. my ($label, $mnemonic, $operand, $comment) = parse_line($line, $lineno); #next unless defined $mnemonic; #next if $mnemonic eq ''; if (!defined $mnemonic || $mnemonic eq '') { print sprintf(" %-4d %s\n", $lineno, $line) if $code_listing; next; } my $ucmnemonic = uc($mnemonic); # Skip ORG, EQU and OBJ on pass 2. if ($ucmnemonic =~ /ORG|\.OR|EQU|\.EQ|OBJ|LST|^=$|END|SAV|\.TF|XC/) { print sprintf(" %-4d %s\n", $lineno, $line) if $code_listing; next; } if (defined $mnemonics{$ucmnemonic}) { my $foundit = 0; foreach my $opmode (keys %{$mnemonics{$ucmnemonic}}) { my $checkfunc = $modefuncs{$opmode}{'check'}; my $genfunc = $modefuncs{$opmode}{'gen'}; if ($checkfunc->($operand, $lineno)) { $genfunc->($addr, $operand, $mnemonics{$ucmnemonic}{$opmode}, $ofh, $lineno, $line); $foundit = 1; last; } } if (! $foundit) { print_err("!!!! $lineno - Unrecognized addressing mode '$line'!\n"); } } elsif ($ucmnemonic eq 'HEX') { # Unpack hex data. #my @bytes = map { pack('C', hex(lc($_))) } ($operand =~ /(..)/g); my @bytes = map { pack('C', hex(lc($_))) } ($operand =~ /(..)/g); generate_bytes($ofh, $addr, \@bytes, $lineno, $line); } elsif ($ucmnemonic =~ /ASC|DCI|INV|FLS|BLK|REV|STR/) { # Unpack string dats. my ($str, $trl); if ($operand =~ /^\"(.+)\"([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } elsif ($operand =~ /^'(.+)'([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } elsif ($operand =~ /^'(.+)'\s*$/) { $str = $1; $trl = ''; } elsif ($operand =~ /^'(.+)'\s*$/) { $str = $1; $trl = ''; } elsif ($operand =~ /^\"(.+)\",([0-9a-fA-F]*)$/) { $str = $1; $trl = $2; } else { print_err(">>>> $lineno - Macro Bad Operand '$operand' in '$line'\n"); } $str = '' unless defined $str; my @bytes = map { pack('C', ord($_) | 0x80) } ($str =~ /(.)/g); if ($ucmnemonic eq 'REV') { @bytes = reverse @bytes; } if ($ucmnemonic eq 'STR') { # Add byte for size. generate_8($ofh, $addr, scalar(@bytes), $lineno, $line); $addr++; } ##FIXME -- need to implement bit setting for INV, FLS, etc. generate_bytes($ofh, $addr, \@bytes, $lineno, $line); if (defined $trl && $trl ne '') { my @trlbytes = map { pack('C', hex(lc($_))) } ($trl =~ /(..)/g); generate_bytes($ofh, $addr, \@trlbytes, $lineno, ''); } } elsif ($ucmnemonic =~ /DFB/i) { if ($operand =~ /^%([01]{8})/) { my $byte = unpack('C', pack("B8", $1)); generate_8($ofh, $addr, $byte, $lineno, $line); $addr++; } elsif ($operand =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { generate_8($ofh, $addr, hex(lc($1)), $lineno, $line); $addr++; } elsif ($operand =~ /^#<(.+)/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { my $opval = $symval; if ($symval =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $opval = hex(lc($1)); } generate_8($ofh, $addr, $opval, $lineno, $line); } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); generate_8($ofh, $addr, 0x00, $lineno, $line); } $addr++; } elsif ($operand =~ /^#>(.+)/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if (defined $symval) { my $opval = $symval; if ($symval =~ /\$[0-9a-fA-F]*([0-9a-fA-F][0-9a-fA-F])$/) { $opval = hex(lc($1)); } generate_8($ofh, $addr, $opval, $lineno, $line); } else { print_err("**** $lineno - Unknown symbol '$1' in '$line'\n"); generate_8($ofh, $addr, 0x00, $lineno, $line); } $addr++; } elsif ($operand =~ /^#(.+)/) { my @args = split /,/, $1; foreach my $arg (@args) { $arg =~ s/#//g; my $opval = sprintf("%04x", $arg); my $opval1 = hex(substr($opval, 0, 2)); my $opval2 = hex(substr($opval, 2, 2)); generate_16($ofh, $addr, $opval2, $opval1, $lineno, $line); $addr++; } # Allow symbol arithmetic. } elsif ($operand =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*([+-\\*\/])\s*[#]*(\$*[0-9a-fA-F]+)$/) { my $prt = $1; my $sym = $2; my $op = $3; my $val = $4; if ($val =~ /^\$([0-9a-fA-F]+)/) { $val = hex(lc($1)); } my $symval = get_symval($prt, $sym); if (defined $symval) { if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])$/) { my $opval = hex(lc($1)); if ($op eq '+') { $opval += $val; } elsif ($op eq '-') { $opval -= $val; } generate_8($ofh, $addr, $opval, $lineno, $line); $addr++; } elsif ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F])/) { my $opval = hex(lc($1)); if ($op eq '+') { $opval += $val; } elsif ($op eq '-') { $opval -= $val; } my $opv = sprintf("%04x", $opval); my $opval1 = hex(lc(substr($opv, 0, 2))); my $opval2 = hex(lc(substr($opv, 2, 2))); generate_16($ofh, $addr, $opval1, $opval2, $lineno, $line); $addr += 2; } } else { print_err("**** $lineno - Unknown symbol '$sym' in '$line'\n"); generate_8($ofh, $addr, 0x00, $lineno, $line); $addr++; } # Allow symbols } elsif ($operand =~ /^[\<\>]*[0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]+,*/) { my @symbols = split(',', $operand); my @bytes; foreach my $sym (@symbols) { my $prt = ''; my $symbol = $sym; if ($sym =~ /^([<>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]+)/) { $prt = $1; $symbol = $2; } my $symval = get_symval($prt, $symbol); if (defined $symval) { # Split into two bytes if necessary if ($symval =~ /\$([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])/) { push @bytes, pack('C', hex(sprintf("%02x", hex(lc($1))))); push @bytes, pack('C', hex(sprintf("%02x", hex(lc($2))))); } else { push @bytes, pack('C', hex(sprintf("%02x", parse_symval($symval)))); } } else { print_err("**** $lineno - Unknown symbol '$sym' in '$line'\n"); } } generate_bytes($ofh, $addr, \@bytes, $lineno, $line); } else { print_err("$line - Bad byte definition '$operand'\n"); } } elsif ($ucmnemonic =~ /^DS$/) { # Decimal my $strlen = 0; my $val = 0x00; if ($operand =~ /^(\d+)$/) { $strlen = $1; } elsif ($operand =~ /^(\d+),"(.)["]*/) { $strlen = $1; $val = ord($2); } elsif ($operand =~ /^(\d+),'(.)[']*/) { $strlen = $1; $val = ord($2); } elsif ($operand =~ /^(\d+),\$([0-9a-fA-F][0-9a-fA-F])/) { $strlen = $1; $val = hex(lc($2)); # Hex } elsif ($operand =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { $strlen = 1; $val = hex(lc($1)); ##FIXME -- probably need to add ," " support here, etc. } my @bytes; for (my $loopc = 0; $loopc < $strlen; $loopc++) { push @bytes, pack('C', $val); } generate_bytes($ofh, $addr, \@bytes, $lineno, $line); } elsif ($ucmnemonic =~ /^DB$|^TYP$/) { # GPH ADDED 201902016 my $prt = ''; if ($operand =~ /^([<>]*)/) { $prt = $1; } #END GPH if ($operand =~ /^%([01]{8})/) { my $opval = unpack('C', pack("B8", $1)); generate_8($ofh, $addr, $opval, $lineno, $line); $addr++; } elsif ($operand =~ /^(\d+)/) { generate_8($ofh, $addr, $1, $lineno, $line); $addr++; } elsif ($operand =~ /^\$([0-9a-fA-F][0-9a-fA-F])/) { my $opval = hex(lc($1)); generate_8($ofh, $addr, $opval, $lineno, $line); $addr++; # GPH ADDED 20190216 support for db {symbol} } elsif ($operand =~ /^([\<\>]*)([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $rawsym = $2; my $opval1 = ''; my $opval2 = ''; my $symval = $symbols{$rawsym}; if ($prt =~ /^\>/) { # LSB case $symval =~ s/^\$//; my $opval = sprintf("%04x", hex(lc($symval))); $opval1 = hex(lc(substr($opval, 0, 2))); generate_8($ofh, $addr, $opval1, $lineno, $line); $addr++; } else { $symval =~ s/^\$//; my $opval = sprintf("%04x", hex(lc($symval))); $opval1 = hex(lc(substr($opval, 2, 2))); generate_8($ofh, $addr, $opval1, $lineno, $line); $addr++; } } # END GPH } elsif ($ucmnemonic =~ /^DA$|^\.DA$|^DW$/) { # Handle binary. if ($operand =~ /^%([01]{16})/) { my $opval1 = unpack('C', pack("B8", substr($1, 0, 8))); my $opval2 = unpack('C', pack("B8", substr($1, 8, 8))); generate_16($ofh, $addr, $opval2, $opval1, $lineno, $line); $addr += 2; # Handle decimal. } elsif ($operand =~ /^(\d+)$/) { my $opval = sprintf("%04x", $1); my $opval1 = hex(lc(substr($opval, 0, 2))); my $opval2 = hex(lc(substr($opval, 2, 2))); generate_16($ofh, $addr, $opval2, $opval1, $lineno, $line); $addr += 2; # Handle address arithmetic. } elsif ($operand =~ /^\$([0-9a-fA-F]+)\s*([+-\\*\/])\s*(\$*.+)$/) { my $opval = hex(lc($1)); my $op = $2; my $val = $3; if ($val =~ /^\$([0-9a-fA-F]+)/) { $val = hex(lc($1)); } if ($op eq '+') { $opval += $val; } elsif ($op eq '-') { $opval -= $val; } my $opv = sprintf("%04x", $opval); my $opval1 = hex(lc(substr($opv, 0, 2))); my $opval2 = hex(lc(substr($opv, 2, 2))); generate_16($ofh, $addr, $opval2, $opval1, $lineno, $line); $addr += 2; # Handle hex. } elsif ($operand =~ /^\$([0-9a-fA-F]+)([0-9a-fA-F][0-9a-fA-F])$/) { my $opval1 = hex(lc($1)); my $opval2 = hex(lc($2)); generate_16($ofh, $addr, $opval2, $opval1, $lineno, $line); $addr += 2; } elsif ($operand =~ /^\$([0-9a-fA-F][0-9a-fA-F])$/) { my $opval = hex(lc($1)); generate_16($ofh, $addr, $opval, 0x00, $lineno, $line); # GPH ADDED 20190216 symbol support } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $rawsym = $1; my $opval1 = ''; my $opval2 = ''; my $symval = $symbols{$rawsym}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; $symval =~ s/^\$//; my $opval = sprintf("%04x", hex(lc($symval))); $opval1 = hex(lc(substr($opval, 0, 2))); $opval2 = hex(lc(substr($opval, 2, 2))); generate_16($ofh, $addr, $opval2, $opval1, $lineno, $line); $addr += 2; } #END GPH } elsif ($ucmnemonic =~ /HBY/) { ##FIXME -- implement this print "NOT YET IMPLEMENTED!\n"; } elsif ($ucmnemonic =~ /^BYT$/) { ##FIXME -- implement this print "NOT YET IMPLEMENTED!\n"; } elsif ($ucmnemonic =~ /DFS/) { ##FIXME -- implement this print "NOT YET IMPLEMENTED!\n"; } elsif ($ucmnemonic =~ /BYTE/) { my @args = split /,/, $operand; my @bytes = (); foreach my $opval (@args) { # Binary if ($opval =~ /^%([01]{8})/) { push @bytes, unpack('C', pack("B8", $1)); $addr++; # Decimal } elsif ($opval =~ /^\d+$/) { push @bytes, $opval; $addr++; # Hex } elsif ($opval =~ /^\$([0-9a-fA-F]+)$/) { my $ov = sprintf("%02x", hex(lc($1))); push @bytes, hex(lc($ov)); $addr++; ##FIXME -- probably should handle symbols here too. } } generate_bytes($ofh, $addr, \@bytes, $lineno, $line); } elsif ($ucmnemonic =~ /WORD/) { my @args = split /,/, $operand; my @bytes = (); foreach my $opval (@args) { # Binary if ($opval =~ /^%([01]{16})/) { my $ov1 = unpack('C', pack("B8", substr($1, 0, 8))); my $ov2 = unpack('C', pack("B8", substr($1, 8, 8))); push @bytes, $ov1; push @bytes, $ov2; $addr += 2; # Decimal } elsif ($opval =~ /^(\d+)$/) { my $ov = sprintf("%04x", $1); my $ov1 = hex(lc(substr($ov, 0, 2))); my $ov2 = hex(lc(substr($ov, 2, 2))); push @bytes, $ov1; push @bytes, $ov2; $addr += 2; # Hex } elsif ($opval =~ /^\$([0-9a-fA-F]+)$/) { my $ov = sprintf("%04x", hex(lc($1))); my $ov1 = hex(lc(substr($ov, 0, 2))); my $ov2 = hex(lc(substr($ov, 2, 2))); push @bytes, $ov1; push @bytes, $ov2; # Symbol } elsif ($opval =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $rawsym = $1; my $ov1 = ''; my $ov2 = ''; my $symval = $symbols{$rawsym}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; $symval =~ s/^\$//; my $ov = sprintf("%04x", hex(lc($symval))); $ov1 = hex(lc(substr($ov, 0, 2))); $ov2 = hex(lc(substr($ov, 2, 2))); push @bytes, $ov1; push @bytes, $ov2; } } generate_bytes($ofh, $addr, \@bytes, $lineno, $line); } elsif ($ucmnemonic =~ /MAC/) { # Ignore on subsequent passes. } elsif ($ucmnemonic =~ /\<\<\>>> DO $operand\n"; $in_conditional = 1; } elsif ($ucmnemonic =~ /^FIN$/) { print ">>>> END CONDITIONAL\n"; $in_conditional = 0; } elsif ($ucmnemonic eq 'CHK') { generate_8($ofh, $addr, $checksum, $lineno, $line); } elsif (defined $macros{$ucmnemonic}) { #print "#### MACRO $ucmnemonic ####\n" if $debug; print sprintf(" %-4d %s\n", $lineno, $line) if $code_listing; my $opval1 = ''; my $opval2 = ''; # Parse hex if ($operand =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9A-Fa-f][0-9A-Fa-f])$/) { $opval1 = hex(lc($1)); $opval2 = hex(lc($2)); # Parse binary } elsif ($operand =~ /^%([01]{8})([0-1]{8})$/) { $opval1 = unpack('C', pack("B8", $1)); $opval2 = unpack('C', pack("B8", $2)); # Parse decimal } elsif ($operand =~ /^(\d+)$/) { my $opval = sprintf("%04x", $1); $opval1 = hex(lc(substr($opval, 0, 2))); $opval2 = hex(lc(substr($opval, 2, 2))); # Return symbol value } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)$/) { my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if ($symval =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $opval1 = hex(lc($1)); $opval2 = hex(lc($2)); } elsif ($symval =~ /^\$([0-9a-fA-F][0-9a-fA-F])$/) { $opval1 = hex(lc($1)); $opval2 = 0x00; } else { $symval =~ s/^\$//; my $opval = sprintf("%04x", $symval); $opval1 = hex(lc(substr($opval, 0, 2))); $opval2 = hex(lc(substr($opval, 2, 2))); } # Allow arithmetic on symbol } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[+]\s*[#]*(\$*[0-9a-fA-F]+)$/) { # Add my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if ($symval =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $opval1 = hex(lc($1)); $opval2 = hex(lc($2)); } elsif ($symval =~ /^\$([0-9a-fA-F][0-9a-fA-F])$/) { $opval1 = hex(lc($1)); $opval2 = 0x00; } else { $symval =~ s/^\$//; my $opval = sprintf("%04x", $symval); $opval1 = hex(lc(substr($opval, 0, 2))); $opval2 = hex(lc(substr($opval, 2, 2))); } ##FIXME -- need to do add here } elsif ($operand =~ /^([0-9A-Za-z_\.\?:][A-Za-z0-9_\.\?:]*)\s*[-]\s*[#]*(\$*[0-9a-fA-F]+)$/) { # Subtract my $symval = $symbols{$1}; $symval = $symbols{$1 . ':'} unless defined $symval; $symval = $symbols{':' . $1} unless defined $symval; if ($symval =~ /^\$([0-9a-fA-F]{0,1}[0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$/) { $opval1 = hex(lc($1)); $opval2 = hex(lc($2)); } elsif ($symval =~ /^\$([0-9a-fA-F][0-9a-fA-F])$/) { $opval1 = hex(lc($1)); $opval2 = 0x00; } else { $symval =~ s/^\$//; my $opval = sprintf("%04x", $symval); $opval1 = hex(lc(substr($opval, 0, 2))); $opval2 = hex(lc(substr($opval, 2, 2))); } ##FIXME -- need to do sub here #} else { # print_err(">>>> $lineno - Macro Bad Operand '$operand' in '$line'\n"); } my $maclnno = 0; foreach my $macln (@{$macros{$ucmnemonic}}) { $maclnno++; my ($maclabel, $macmnemonic, $macoperand, $maccomment) = parse_line($macln, $maclnno); #print sprintf(" %-4d %s\n", $maclnno, $macln) if $code_listing; my $ucmacmnemonic = uc($macmnemonic); if (defined $mnemonics{$ucmacmnemonic}) { my $foundit = 0; foreach my $opmode (keys %{$mnemonics{$ucmacmnemonic}}) { my $checkfunc = $modefuncs{$opmode}{'check'}; my $genfunc = $modefuncs{$opmode}{'gen'}; if ($checkfunc->($macoperand, $maclnno)) { $genfunc->($addr, $macoperand, $mnemonics{$ucmacmnemonic}{$opmode}, $ofh, $maclnno, $macln, $opval1, $opval2); $foundit = 1; last; } } if (! $foundit) { print_err("!!!! $maclnno - Unrecognized addressing mode '$macln'!\n"); } } else { print_err("$maclnno - Unknown mnemonic '$mnemonic' in macro '$macln'\n"); } } } else { print_err("$lineno - Unknown mnemonic '$mnemonic' in '$line'\n"); } } close $ofh; close $ifh; # Output error summary. if ($error_summary) { print "\n"; if (scalar @errors) { print "**** Summary of errors:\n"; print "\n"; foreach my $line (@errors) { print $line; } print "\n"; } else { print "**** No errors. ****\n"; } } } else { die "Can't open $input_file\n"; } 1;