Răsfoiți Sursa

+ started working on a 6502 target

Nikolay Nikolov 1 an în urmă
părinte
comite
564570bbd7

+ 12 - 3
compiler/cgbase.pas

@@ -271,7 +271,7 @@ interface
         R_SUBMMX,     { = 12; 128 BITS }
         R_SUBMMY,     { = 13; 256 BITS }
         R_SUBMMZ,     { = 14; 512 BITS }
-{$ifdef Z80}
+{$if defined(Z80)}
         { Subregisters for the flags register (Z80) }
         R_SUBFLAGCARRY,          { = 15; Carry flag }
         R_SUBFLAGADDSUBTRACT,    { = 16; Add/Subtract flag }
@@ -281,7 +281,16 @@ interface
         R_SUBFLAGUNUSEDBIT5,     { = 20; Unused flag (bit 5) }
         R_SUBFLAGZERO,           { = 21; Zero flag }
         R_SUBFLAGSIGN,           { = 22; Sign flag }
-{$else Z80}
+{$elseif defined(MOS6502)}
+        R_SUBFLAGCARRY,       { = 15; Carry flag }
+        R_SUBFLAGZERO,        { = 16; Zero flag }
+        R_SUBFLAGIRQDISABLE,  { = 17; IRQ disable. Set if maskable interrupts are disabled }
+        R_SUBFLAGDECIMALMODE, { = 18; Decimal mode flag. }
+        R_SUBFLAGBRKCOMMAND,  { = 19; Set if an interrupt caused by BRK, reset if caused by an external interrupt }
+        R_SUBFLAGUNUSEDBIT5,  { = 20; Unused flag (bit 5) }
+        R_SUBFLAGOVERFLOW,    { = 21; Overflow flag }
+        R_SUBFLAGNEGATIVE,    { = 22; Negative flag }
+{$else}
         { Subregisters for the flags register (x86) }
         R_SUBFLAGCARRY,     { = 15; Carry flag }
         R_SUBFLAGPARITY,    { = 16; Parity flag }
@@ -291,7 +300,7 @@ interface
         R_SUBFLAGOVERFLOW,  { = 20; Overflow flag }
         R_SUBFLAGINTERRUPT, { = 21; Interrupt enable flag }
         R_SUBFLAGDIRECTION, { = 22; Direction flag }
-{$endif Z80}
+{$endif}
         { subregisters for the metadata register (llvm) }
         R_SUBMETASTRING    { = 23 }
 {$ifdef aarch64}

+ 13 - 0
compiler/fpcdefs.inc

@@ -408,6 +408,19 @@
   {$define SUPPORT_SAFECALL}
 {$endif loongarch64}
 
+{$ifdef mos6502}
+  {$define cpu8bit}
+  {$define cpu16bitaddr}
+  {$define cpu8bitalu}
+  {$define cpufpemu}
+  {$define cpuflags}
+  {$define cpunofpu}
+  {$define cpunodefaultint}
+  {$define cpuneedsdivhelper}
+  {$define cpuneedsmulhelper}
+  {$define cpucapabilities}
+{$endif mos6502}
+
 { Stabs is not officially supported on 64 bit targets by gdb, except on Mac OS X
   (but there we don't support it)
 }

+ 6 - 0
compiler/globals.pas

@@ -665,6 +665,12 @@ Const
         asmcputype : cpu_none;
         fputype : fpu_fd;
   {$endif loongarch64}
+  {$ifdef mos6502}
+        cputype : cpu_mos_6502;
+        optimizecputype : cpu_mos_6502;
+        asmcputype : cpu_none;
+        fputype : fpu_soft;
+  {$endif mos6502}
 {$endif not GENERIC_CPU}
         asmmode : asmmode_standard;
 {$ifndef jvm}

+ 616 - 0
compiler/mos6502/cpubase.pas

@@ -0,0 +1,616 @@
+{
+    Copyright (c) 2006 by Florian Klaempfl
+
+    Contains the base types for the MOS Technology 6502
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{# Base unit for processor information. This unit contains
+   enumerations of registers, opcodes, sizes, and other
+   such things which are processor specific.
+}
+unit cpubase;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cutils,cclasses,
+      globtype,globals,
+      cpuinfo,
+      aasmbase,
+      cgbase
+      ;
+
+
+{*****************************************************************************
+                                Assembler Opcodes
+*****************************************************************************}
+
+    type
+      TAsmOp=(A_None);//{$i mos6502op.inc}
+
+
+      { This should define the array of instructions as string }
+      op2strtable=array[tasmop] of string[4];
+
+    const
+      { First value of opcode enumeration }
+      firstop = low(tasmop);
+      { Last value of opcode enumeration  }
+      lastop  = high(tasmop);
+
+      std_op2str:op2strtable=('None');//{$i mos6502stdopnames.inc}
+
+      { call/reg instructions are not considered as jmp instructions for the usage cases of
+        this set }
+      //jmp_instructions = [A_JMP,A_JR,A_JRJP,A_DJNZ];
+      //call_jmp_instructions = [A_JSR]+jmp_instructions;
+
+      { instructions that can have a condition }
+      //cond_instructions = [A_CALL,A_JP,A_JR,A_JRJP,A_RET];
+
+{*****************************************************************************
+                                  Registers
+*****************************************************************************}
+
+    type
+      { Number of registers used for indexing in tables }
+      tregisterindex=0..{$i rmos6502nor.inc}-1;
+
+    const
+      { Available Superregisters }
+      {$i rmos6502sup.inc}
+
+      { No Subregisters }
+      R_SUBWHOLE = R_SUBL;
+
+      { Available Registers }
+      {$i rmos6502con.inc}
+
+      { Integer Super registers first and last }
+      first_int_supreg = RS_A;
+      first_int_imreg = $20;
+
+      { Float Super register first and last }
+      first_fpu_supreg    = RS_INVALID;
+      first_fpu_imreg     = 0;
+
+      { MM Super register first and last }
+      first_mm_supreg    = RS_INVALID;
+      first_mm_imreg     = 0;
+
+      regnumber_count_bsstart = 32;
+
+      regnumber_table : array[tregisterindex] of tregister = (
+        {$i rmos6502num.inc}
+      );
+
+      regstabs_table : array[tregisterindex] of shortint = (
+        {$i rmos6502sta.inc}
+      );
+
+      regdwarf_table : array[tregisterindex] of shortint = (
+        {$i rmos6502dwa.inc}
+      );
+      { registers which may be destroyed by calls }
+      VOLATILE_INTREGISTERS = [RS_A,RS_X,RS_Y];
+      VOLATILE_FPUREGISTERS = [];
+
+    type
+      totherregisterset = set of tregisterindex;
+
+{*****************************************************************************
+                                Conditions
+*****************************************************************************}
+
+    type
+      TAsmCond=(C_None,
+        C_CC,C_CS,C_EQ,C_MI,C_NE,C_PL,C_VC,C_VS
+      );
+
+    const
+      cond2str : array[TAsmCond] of string[2]=('',
+        'cc','cs','eq','mi','ne','pl','vc','vs'
+      );
+
+      uppercond2str : array[TAsmCond] of string[2]=('',
+        'CC','CS','EQ','MI','NE','PL','VC','VS'
+      );
+
+{*****************************************************************************
+                                   Flags
+*****************************************************************************}
+
+    type
+      TResFlags = (F_NotPossible,F_NE,F_E,F_NC,F_C,F_PO,F_PE,F_P,F_M);
+
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+    const
+      max_operands = 2;
+
+      maxintregs = 15;
+      maxfpuregs = 0;
+      maxaddrregs = 0;
+
+{*****************************************************************************
+                                Operand Sizes
+*****************************************************************************}
+
+    type
+      topsize = (S_NO,
+        S_B,S_W,S_L,S_BW,S_BL,S_WL,
+        S_IS,S_IL,S_IQ,
+        S_FS,S_FL,S_FX,S_D,S_Q,S_FV,S_FXX
+      );
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+    const
+      firstsaveintreg = RS_INVALID;
+      lastsaveintreg  = RS_INVALID;
+      firstsavefpureg = RS_INVALID;
+      lastsavefpureg  = RS_INVALID;
+      firstsavemmreg  = RS_INVALID;
+      lastsavemmreg   = RS_INVALID;
+
+{*****************************************************************************
+                          Default generic sizes
+*****************************************************************************}
+
+      { Defines the default address size for a processor, }
+      OS_ADDR = OS_16;
+      { the natural int size for a processor,
+        has to match osuinttype/ossinttype as initialized in psystem,
+        initially, this was OS_16/OS_S16 on avr, but experience has
+        proven that it is better to make it 8 Bit thus having the same
+        size as a register.
+      }
+      OS_INT = OS_8;
+      OS_SINT = OS_S8;
+      { the maximum float size for a processor,           }
+      OS_FLOAT = OS_F64;
+      { the size of a vector register for a processor     }
+      OS_VECTOR = OS_M32;
+
+{*****************************************************************************
+                          Generic Register names
+*****************************************************************************}
+
+      { Stack pointer register }
+      NR_STACK_POINTER_REG = NR_S;
+      RS_STACK_POINTER_REG = RS_S;
+      { Frame pointer register }
+      //RS_FRAME_POINTER_REG = RS_IX;
+      //NR_FRAME_POINTER_REG = NR_IX;
+      { Register for addressing absolute data in a position independant way,
+        such as in PIC code. The exact meaning is ABI specific. For
+        further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
+      }
+      NR_PIC_OFFSET_REG = NR_INVALID;
+      { Results are returned in this register (32-bit values) }
+      //NR_FUNCTION_RETURN_REG = NR_L;
+      //RS_FUNCTION_RETURN_REG = RS_L;
+      { Low part of 64bit return value }
+      //NR_FUNCTION_RETURN64_LOW_REG = NR_L;
+      //RS_FUNCTION_RETURN64_LOW_REG = RS_L;
+      { High part of 64bit return value }
+      //NR_FUNCTION_RETURN64_HIGH_REG = NR_C;
+      //RS_FUNCTION_RETURN64_HIGH_REG = RS_C;
+      { The value returned from a function is available in this register }
+      //NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG;
+      //RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG;
+      { The lowh part of 64bit value returned from a function }
+      //NR_FUNCTION_RESULT64_LOW_REG = NR_FUNCTION_RETURN64_LOW_REG;
+      //RS_FUNCTION_RESULT64_LOW_REG = RS_FUNCTION_RETURN64_LOW_REG;
+      { The high part of 64bit value returned from a function }
+      //NR_FUNCTION_RESULT64_HIGH_REG = NR_FUNCTION_RETURN64_HIGH_REG;
+      //RS_FUNCTION_RESULT64_HIGH_REG = RS_FUNCTION_RETURN64_HIGH_REG;
+
+      NR_FPU_RESULT_REG = NR_NO;
+
+      NR_MM_RESULT_REG  = NR_NO;
+
+      //NR_RETURN_ADDRESS_REG = NR_FUNCTION_RETURN_REG;
+
+      { Offset where the parent framepointer is pushed }
+      PARENT_FRAMEPOINTER_OFFSET = 0;
+
+      NR_DEFAULTFLAGS = NR_P;
+      RS_DEFAULTFLAGS = RS_P;
+
+{*****************************************************************************
+                       GCC /ABI linking information
+*****************************************************************************}
+
+    const
+      { Registers which must be saved when calling a routine declared as
+        cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
+        saved should be the ones as defined in the target ABI and / or GCC.
+
+        This value can be deduced from the CALLED_USED_REGISTERS array in the
+        GCC source.
+      }
+      { on avr, gen_entry/gen_exit code saves/restores registers, so
+        we don't need this array }
+      saved_standard_registers : array[0..0] of tsuperregister =
+        (RS_INVALID);
+      { Required parameter alignment when calling a routine declared as
+        stdcall and cdecl. The alignment value should be the one defined
+        by GCC or the target ABI.
+
+        The value of this constant is equal to the constant
+        PARM_BOUNDARY / BITS_PER_UNIT in the GCC source.
+      }
+      std_param_align = 4;
+
+      saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
+      saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    { Returns the tcgsize corresponding with the size of reg.}
+    function reg_cgsize(const reg: tregister) : tcgsize;
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
+    procedure inverse_flags(var f: TResFlags);
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+    function findreg_by_number(r:Tregister):tregisterindex;
+    function std_regnum_search(const s:string):Tregister;
+    function std_regname(r:Tregister):string;
+    function is_regpair(r:Tregister):boolean;
+    procedure split_regpair(regpair:Tregister;out reglo,reghi:Tregister);
+    { Checks if sreg is a subset of reg (e.g. NR_H is a subset of NR_HL }
+    function register_in(sreg,reg:Tregister):boolean;
+    function super_registers_equal(reg1,reg2 : TRegister) : Boolean;
+    function registers_interfere(reg1,reg2: TRegister) : Boolean;
+
+    function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+
+    { Checks if Subset is a subset of c (e.g. "less than" is a subset of "less than or equal" }
+    function condition_in(const Subset, c: TAsmCond): Boolean;
+
+    function dwarf_reg(r:tregister):byte;
+    function dwarf_reg_no_error(r:tregister):shortint;
+    function eh_return_data_regno(nr: longint): longint;
+
+    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+
+  implementation
+
+    uses
+      rgBase,verbose;
+
+
+    const
+      std_regname_table : TRegNameTable = (
+        {$i rmos6502std.inc}
+      );
+
+      regnumber_index : array[tregisterindex] of tregisterindex = (
+        {$i rmos6502rni.inc}
+      );
+
+      std_regname_index : array[tregisterindex] of tregisterindex = (
+        {$i rmos6502sri.inc}
+      );
+
+
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
+      begin
+        cgsize2subreg:=R_SUBWHOLE;
+      end;
+
+
+    function reg_cgsize(const reg: tregister): tcgsize;
+      begin
+        case getregtype(reg) of
+          R_INTREGISTER,
+          R_SPECIALREGISTER:
+            case getsubreg(reg) of
+              R_SUBNONE,
+              R_SUBL,
+              R_SUBH:
+                reg_cgsize:=OS_8;
+              R_SUBW:
+                reg_cgsize:=OS_16;
+              else
+                internalerror(2020041901);
+            end;
+          R_ADDRESSREGISTER:
+            reg_cgsize:=OS_16;
+          else
+            internalerror(2011021905);
+          end;
+        end;
+
+
+    procedure inverse_flags(var f: TResFlags);
+      const
+        inv_flags: array[TResFlags] of TResFlags =
+          (F_NotPossible,F_E,F_NE,F_C,F_NC,F_PE,F_PO,F_M,F_P);
+      begin
+        f:=inv_flags[f];
+      end;
+
+
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+      //const
+      //  flag_2_cond: array[F_NE..F_M] of TAsmCond =
+      //    (C_NZ,C_Z,C_NC,C_C,C_PO,C_PE,C_P,C_M);
+      begin
+        internalerror(2024040601);
+        //if f=F_NotPossible then
+        //  internalerror(2011022101);
+        //if f>high(flag_2_cond) then
+        //  internalerror(200112301);
+        //result:=flag_2_cond[f];
+      end;
+
+
+    function findreg_by_number(r:Tregister):tregisterindex;
+      begin
+        result:=rgBase.findreg_by_number_table(r,regnumber_index);
+      end;
+
+
+    function std_regnum_search(const s:string):Tregister;
+      begin
+        result:=regnumber_table[findreg_by_name_table(s,std_regname_table,std_regname_index)];
+      end;
+
+
+    function std_regname(r:Tregister):string;
+      var
+        p : tregisterindex;
+      begin
+        p:=findreg_by_number_table(r,regnumber_index);
+        if p<>0 then
+          result:=std_regname_table[p]
+        else
+          result:=generic_regname(r);
+      end;
+
+
+    function is_regpair(r: Tregister): boolean;
+      begin
+        internalerror(2024040601);
+        //result:=(r=NR_AF) or (r=NR_BC) or (r=NR_DE) or (r=NR_HL);
+      end;
+
+
+    procedure split_regpair(regpair: Tregister; out reglo, reghi: Tregister);
+      begin
+        internalerror(2024040601);
+        //case regpair of
+        //  NR_AF:
+        //    begin
+        //      reglo:=NR_F;
+        //      reghi:=NR_A;
+        //    end;
+        //  NR_BC:
+        //    begin
+        //      reglo:=NR_C;
+        //      reghi:=NR_B;
+        //    end;
+        //  NR_DE:
+        //    begin
+        //      reglo:=NR_E;
+        //      reghi:=NR_D;
+        //    end;
+        //  NR_HL:
+        //    begin
+        //      reglo:=NR_L;
+        //      reghi:=NR_H;
+        //    end;
+        //  else
+        //    internalerror(2020042804);
+        //end;
+      end;
+
+
+    function register_in(sreg,reg: Tregister):boolean;
+      var
+        tmpreg1, tmpreg2: Tregister;
+      begin
+        if sreg=reg then
+          result:=true
+        else if is_regpair(reg) then
+          begin
+            split_regpair(reg,tmpreg1,tmpreg2);
+            result:=(sreg=tmpreg1) or (sreg=tmpreg2);
+          end
+        else
+          result:=false;
+      end;
+
+
+    function super_registers_equal(reg1, reg2: TRegister): Boolean;
+      begin
+        internalerror(2024040601);
+        //case reg1 of
+        //  NR_A,NR_F,NR_AF,NR_CARRYFLAG,NR_ADDSUBTRACTFLAG,NR_PARITYOVERFLOWFLAG,NR_HALFCARRYFLAG,NR_ZEROFLAG,NR_SIGNFLAG:
+        //    result:=(reg2=NR_A) or (reg2=NR_F) or (reg2=NR_AF) or
+        //            (reg2=NR_CARRYFLAG) or (reg2=NR_ADDSUBTRACTFLAG) or
+        //            (reg2=NR_PARITYOVERFLOWFLAG) or (reg2=NR_HALFCARRYFLAG) or
+        //            (reg2=NR_ZEROFLAG) or (reg2=NR_SIGNFLAG);
+        //  NR_B,NR_C,NR_BC:
+        //    result:=(reg2=NR_B) or (reg2=NR_C) or (reg2=NR_BC);
+        //  NR_D,NR_E,NR_DE:
+        //    result:=(reg2=NR_D) or (reg2=NR_E) or (reg2=NR_DE);
+        //  NR_H,NR_L,NR_HL:
+        //    result:=(reg2=NR_H) or (reg2=NR_L) or (reg2=NR_HL);
+        //  NR_A_,NR_F_,NR_AF_,NR_CARRYFLAG_,NR_ADDSUBTRACTFLAG_,NR_PARITYOVERFLOWFLAG_,NR_HALFCARRYFLAG_,NR_ZEROFLAG_,NR_SIGNFLAG_:
+        //    result:=(reg2=NR_A_) or (reg2=NR_F_) or (reg2=NR_AF_) or
+        //            (reg2=NR_CARRYFLAG_) or (reg2=NR_ADDSUBTRACTFLAG_) or
+        //            (reg2=NR_PARITYOVERFLOWFLAG_) or (reg2=NR_HALFCARRYFLAG_) or
+        //            (reg2=NR_ZEROFLAG_) or (reg2=NR_SIGNFLAG_);
+        //  NR_B_,NR_C_,NR_BC_:
+        //    result:=(reg2=NR_B_) or (reg2=NR_C_) or (reg2=NR_BC_);
+        //  NR_D_,NR_E_,NR_DE_:
+        //    result:=(reg2=NR_D_) or (reg2=NR_E_) or (reg2=NR_DE_);
+        //  NR_H_,NR_L_,NR_HL_:
+        //    result:=(reg2=NR_H_) or (reg2=NR_L_) or (reg2=NR_HL_);
+        //  else
+        //    result:=reg1=reg2;
+        //end;
+      end;
+
+
+    function registers_interfere(reg1, reg2: TRegister): Boolean;
+      begin
+        internalerror(2024040601);
+        //case reg1 of
+        //  NR_A:
+        //    result:=(reg2=NR_A) or (reg2=NR_AF);
+        //  NR_F:
+        //    result:=(reg2=NR_F) or (reg2=NR_AF) or
+        //            (reg2=NR_CARRYFLAG) or (reg2=NR_ADDSUBTRACTFLAG) or
+        //            (reg2=NR_PARITYOVERFLOWFLAG) or (reg2=NR_HALFCARRYFLAG) or
+        //            (reg2=NR_ZEROFLAG) or (reg2=NR_SIGNFLAG);
+        //  NR_AF:
+        //    result:=(reg2=NR_A) or (reg2=NR_F) or (reg2=NR_AF) or
+        //            (reg2=NR_CARRYFLAG) or (reg2=NR_ADDSUBTRACTFLAG) or
+        //            (reg2=NR_PARITYOVERFLOWFLAG) or (reg2=NR_HALFCARRYFLAG) or
+        //            (reg2=NR_ZEROFLAG) or (reg2=NR_SIGNFLAG);
+        //  NR_CARRYFLAG,NR_ADDSUBTRACTFLAG,NR_PARITYOVERFLOWFLAG,NR_HALFCARRYFLAG,NR_ZEROFLAG,NR_SIGNFLAG:
+        //    result:=(reg2=NR_F) or (reg2=NR_AF) or (reg2=reg1);
+        //  NR_B:
+        //    result:=(reg2=NR_B) or (reg2=NR_BC);
+        //  NR_C:
+        //    result:=(reg2=NR_C) or (reg2=NR_BC);
+        //  NR_BC:
+        //    result:=(reg2=NR_B) or (reg2=NR_C) or (reg2=NR_BC);
+        //  NR_D:
+        //    result:=(reg2=NR_D) or (reg2=NR_DE);
+        //  NR_E:
+        //    result:=(reg2=NR_E) or (reg2=NR_DE);
+        //  NR_DE:
+        //    result:=(reg2=NR_D) or (reg2=NR_E) or (reg2=NR_DE);
+        //  NR_H:
+        //    result:=(reg2=NR_H) or (reg2=NR_HL);
+        //  NR_L:
+        //    result:=(reg2=NR_L) or (reg2=NR_HL);
+        //  NR_HL:
+        //    result:=(reg2=NR_H) or (reg2=NR_L) or (reg2=NR_HL);
+        //  NR_A_:
+        //    result:=(reg2=NR_A_) or (reg2=NR_AF_);
+        //  NR_F_:
+        //    result:=(reg2=NR_F_) or (reg2=NR_AF_) or
+        //            (reg2=NR_CARRYFLAG_) or (reg2=NR_ADDSUBTRACTFLAG_) or
+        //            (reg2=NR_PARITYOVERFLOWFLAG_) or (reg2=NR_HALFCARRYFLAG_) or
+        //            (reg2=NR_ZEROFLAG_) or (reg2=NR_SIGNFLAG_);
+        //  NR_AF_:
+        //    result:=(reg2=NR_A_) or (reg2=NR_F_) or (reg2=NR_AF_) or
+        //            (reg2=NR_CARRYFLAG_) or (reg2=NR_ADDSUBTRACTFLAG_) or
+        //            (reg2=NR_PARITYOVERFLOWFLAG_) or (reg2=NR_HALFCARRYFLAG_) or
+        //            (reg2=NR_ZEROFLAG_) or (reg2=NR_SIGNFLAG_);
+        //  NR_CARRYFLAG_,NR_ADDSUBTRACTFLAG_,NR_PARITYOVERFLOWFLAG_,NR_HALFCARRYFLAG_,NR_ZEROFLAG_,NR_SIGNFLAG_:
+        //    result:=(reg2=NR_F_) or (reg2=NR_AF_) or (reg2=reg1);
+        //  NR_B_:
+        //    result:=(reg2=NR_B_) or (reg2=NR_BC_);
+        //  NR_C_:
+        //    result:=(reg2=NR_C_) or (reg2=NR_BC_);
+        //  NR_BC_:
+        //    result:=(reg2=NR_B_) or (reg2=NR_C_) or (reg2=NR_BC_);
+        //  NR_D_:
+        //    result:=(reg2=NR_D_) or (reg2=NR_DE_);
+        //  NR_E_:
+        //    result:=(reg2=NR_E_) or (reg2=NR_DE_);
+        //  NR_DE_:
+        //    result:=(reg2=NR_D_) or (reg2=NR_E_) or (reg2=NR_DE_);
+        //  NR_H_:
+        //    result:=(reg2=NR_H_) or (reg2=NR_HL_);
+        //  NR_L_:
+        //    result:=(reg2=NR_L_) or (reg2=NR_HL_);
+        //  NR_HL_:
+        //    result:=(reg2=NR_H_) or (reg2=NR_L_) or (reg2=NR_HL_);
+        //  else
+        //    result:=reg1=reg2;
+        //end;
+      end;
+
+
+    function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+      const
+        inverse: array[TAsmCond] of TAsmCond=(C_None,
+          C_CS,C_CC,C_NE,C_PL,C_EQ,C_MI,C_VS,C_VC);
+      begin
+        result := inverse[c];
+      end;
+
+
+    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+      begin
+        result := c1 = c2;
+      end;
+
+
+    { Checks if Subset is a subset of c (e.g. "less than" is a subset of "less than or equal" }
+    function condition_in(const Subset, c: TAsmCond): Boolean;
+      begin
+        { Z80 has no condition subsets }
+        Result := {(c.cond = C_None) or} conditions_equal(Subset, c);
+      end;
+
+
+    function rotl(d : dword;b : byte) : dword;
+      begin
+         result:=(d shr (32-b)) or (d shl b);
+      end;
+
+
+    function dwarf_reg(r:tregister):byte;
+      var
+        reg : shortint;
+      begin
+        reg:=regdwarf_table[findreg_by_number(r)];
+        if reg=-1 then
+          internalerror(200603251);
+        result:=reg;
+      end;
+
+
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
+
+
+    function eh_return_data_regno(nr: longint): longint;
+      begin
+        result:=-1;
+      end;
+
+
+    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+      begin
+        internalerror(2024040601);
+        //is_calljmp:= o in call_jmp_instructions;
+      end;
+
+
+end.

+ 125 - 0
compiler/mos6502/cpuinfo.pas

@@ -0,0 +1,125 @@
+{
+    Copyright (c) 2024 by the Free Pascal development team
+
+    Basic Processor information for the MOS Technology 6502
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Unit CPUInfo;
+
+{$i fpcdefs.inc}
+
+Interface
+
+  uses
+    globtype;
+
+Type
+   bestreal = double;
+   bestrealrec = TDoubleRec;
+   ts32real = single;
+   ts64real = double;
+   ts80real = type extended;
+   ts128real = type extended;
+   ts64comp = comp;
+
+   pbestreal=^bestreal;
+
+   { possible supported processors for this target }
+   tcputype =
+      (cpu_none,
+       cpu_mos_6502
+      );
+
+   tfputype =
+     (fpu_none,
+      fpu_soft
+     );
+
+   tcontrollertype =
+     (ct_none
+     );
+
+   tcontrollerdatatype = record
+      controllertypestr, controllerunitstr: string[20];
+      cputype: tcputype; fputype: tfputype;
+      flashbase, flashsize, srambase, sramsize, eeprombase, eepromsize, bootbase, bootsize: dword;
+   end;
+
+Const
+   {# Size of native extended floating point type }
+   extended_size = 12;
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'mos6502';
+
+   { Is there support for dealing with multiple microcontrollers available }
+   { for this platform? }
+   ControllerSupport = false;
+
+   { We know that there are fields after sramsize
+     but we don't care about this warning }
+   {$PUSH}
+    {$WARN 3177 OFF}
+   embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
+   (
+      (controllertypestr:''; controllerunitstr:''; cputype:cpu_none; fputype:fpu_none; flashbase:0; flashsize:0; srambase:0; sramsize:0));
+   {$POP}
+
+   { calling conventions supported by the code generator }
+   supported_calling_conventions : tproccalloptions = [
+     pocall_internproc,
+     pocall_safecall,
+     pocall_stdcall,
+     { same as stdcall only different name mangling }
+     pocall_cdecl,
+     { same as stdcall only different name mangling }
+     pocall_cppdecl,
+     { same as stdcall but floating point numbers are handled like equal sized integers }
+     pocall_softfloat
+   ];
+
+   cputypestr : array[tcputype] of string[5] = ('',
+     'MOS6502'
+   );
+
+   fputypestr : array[tfputype] of string[6] = (
+     'NONE',
+     'SOFT'
+   );
+
+   { Supported optimizations, only used for information }
+   supported_optimizerswitches = genericlevel1optimizerswitches+
+                                 genericlevel2optimizerswitches+
+                                 genericlevel3optimizerswitches-
+                                 { no need to write info about those }
+                                 [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
+                                 [{cs_opt_regvar,}cs_opt_loopunroll,cs_opt_tailrecursion,
+                                  cs_opt_stackframe,cs_opt_nodecse,cs_opt_reorder_fields,cs_opt_fastmath];
+
+   level1optimizerswitches = genericlevel1optimizerswitches;
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches +
+     [{cs_opt_regvar,}cs_opt_stackframe,cs_opt_tailrecursion];
+   level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches;
+   level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
+
+ type
+   tcpuflags =
+      (CPU6502_HAS_ROR
+      );
+
+ const
+   cpu_capabilities : array[tcputype] of set of tcpuflags =
+     ( { cpu_none  } [],
+       { cpu_mos_6502  } []
+     );
+
+Implementation
+
+end.

+ 265 - 0
compiler/mos6502/mos6502ins.dat

@@ -0,0 +1,265 @@
+[None]
+void                  void
+
+[ADC]
+(ind,X)               $61
+zpg                   $65
+#                     $69
+abs                   $6D
+(ind),Y               $71
+zpg,X                 $75
+abs,Y                 $79
+abs,X                 $7D
+
+[AND]
+(ind,X)               $21
+zpg                   $25
+#                     $29
+abs                   $2D
+(ind),Y               $31
+zpg,X                 $35
+abs,Y                 $39
+abs,X                 $3D
+
+[ASL]
+zpg                   $06
+A                     $0A
+abs                   $0E
+zpg,X                 $16
+abs,X                 $1E
+
+[BCC]
+rel                   $90
+
+[BCS]
+rel                   $B0
+
+[BEQ]
+rel                   $F0
+
+[BIT]
+zpg                   $24
+abs                   $2C
+
+[BMI]
+rel                   $30
+
+[BNE]
+rel                   $D0
+
+[BPL]
+rel                   $10
+
+[BRK]
+void                  $00
+
+[BVC]
+rel                   $50
+
+[BVS]
+rel                   $70
+
+[CLC]
+void                  $18
+
+[CLD]
+void                  $D8
+
+[CLI]
+void                  $58
+
+[CLV]
+void                  $B8
+
+[CMP]
+(ind,X)               $C1
+zpg                   $C5
+#                     $C9
+abs                   $CD
+(ind),Y               $D1
+zpg,X                 $D5
+abs,Y                 $D9
+abs,X                 $DD
+
+[CPX]
+#                     $E0
+zpg                   $E4
+abs                   $EC
+
+[CPY]
+#                     $C0
+zpg                   $C4
+abs                   $CC
+
+[DEC]
+zpg                   $C6
+abs                   $CE
+zpg,X                 $D6
+abs,X                 $DE
+
+[DEX]
+void                  $CA
+
+[DEY]
+void                  $88
+
+[EOR]
+(ind,X)               $41
+zpg                   $45
+#                     $49
+abs                   $4D
+(ind),Y               $51
+zpg,X                 $55
+abs,Y                 $59
+abs,X                 $5D
+
+[INC]
+zpg                   $E6
+abs                   $EE
+zpg,X                 $F6
+abs,X                 $FE
+
+[INX]
+void                  $E8
+
+[INY]
+void                  $C8
+
+[JMP]
+abs                   $4C
+(ind)                 $6C
+
+[JSR]
+abs                   $20
+
+[LDA]
+(ind,X)               $A1
+zpg                   $A5
+#                     $A9
+abs                   $AD
+(ind),Y               $B1
+zpg,X                 $B5
+abs,Y                 $B9
+abs,X                 $BD
+
+[LDX]
+#                     $A2
+zpg                   $A6
+abs                   $AE
+zpg,Y                 $B6
+abs,Y                 $BE
+
+[LDY]
+#                     $A0
+zpg                   $A4
+abs                   $AC
+zpg,X                 $B4
+abs,X                 $BC
+
+[LSR]
+zpg                   $46
+A                     $4A
+abs                   $4E
+zpg,X                 $56
+abs,X                 $5E
+
+[NOP]
+void                  $EA
+
+[ORA]
+(ind,X)               $01
+zpg                   $05
+#                     $09
+abs                   $0D
+(ind),Y               $11
+zpg,X                 $15
+abs,Y                 $19
+abs,X                 $1D
+
+[PHA]
+void                  $48
+
+[PHP]
+void                  $08
+
+[PLA]
+void                  $68
+
+[PLP]
+void                  $28
+
+[ROL]
+zpg                   $26
+A                     $2A
+abs                   $2E
+zpg,X                 $36
+abs,X                 $3E
+
+[ROR]
+zpg                   $66
+A                     $6A
+abs                   $6E
+zpg,X                 $76
+abs,X                 $7E
+
+[RTI]
+void                  $40
+
+[RTS]
+void                  $60
+
+[SBC]
+(ind,X)               $E1
+zpg                   $E5
+#                     $E9
+abs                   $ED
+(ind),Y               $F1
+zpg,X                 $F5
+abs,Y                 $F9
+abs,X                 $FD
+
+[SEC]
+void                  $38
+
+[SED]
+void                  $F8
+
+[SEI]
+void                  $78
+
+[STA]
+(ind,X)               $81
+zpg                   $85
+abs                   $8D
+(ind),Y               $91
+zpg,X                 $95
+abs,Y                 $99
+abs,X                 $9D
+
+[STX]
+zpg                   $86
+abs                   $8E
+zpg,Y                 $96
+
+[STY]
+zpg                   $84
+abs                   $8C
+zpg,X                 $94
+
+[TAX]
+void                  $AA
+
+[TAY]
+void                  $A8
+
+[TSX]
+void                  $BA
+
+[TXA]
+void                  $8A
+
+[TXS]
+void                  $9A
+
+[TYA]
+void                  $98

+ 28 - 0
compiler/mos6502/mos6502reg.dat

@@ -0,0 +1,28 @@
+;
+; MOS Technology 6502 registers
+;
+; layout
+; <name>,<value>,<stdname>,<stabidx>,<dwarfidx>
+;
+NO,$00000000,INVALID,0,0
+
+; Main registers
+A,$01010000,a,1,1
+X,$01010001,x,2,2
+Y,$01010002,y,3,3
+
+; Flags
+P,$05010000,p,4,4
+CARRYFLAG,$050f0000,carryflag,-1,-1
+ZEROFLAG,$05100000,zeroflag,-1,-1
+IRQDISABLEFLAG,$05110000,irqdisableflag,-1,-1
+DECIMALMODEFLAG,$05120000,decimalmodeflag,-1,-1
+BRKCOMMANDFLAG,$05130000,brkcommandflag,-1,-1
+OVERFLOWFLAG,$05150000,overflowflag,-1,-1
+NEGATIVEFLAG,$05160000,negativeflag,-1,-1
+
+; Stack pointer
+S,$05010001,s,5,5
+
+; Program counter
+PC,$05030002,pc,6,6

+ 15 - 0
compiler/mos6502/rmos6502con.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+NR_NO = tregister($00000000);
+NR_A = tregister($01010000);
+NR_X = tregister($01010001);
+NR_Y = tregister($01010002);
+NR_P = tregister($05010000);
+NR_CARRYFLAG = tregister($050f0000);
+NR_ZEROFLAG = tregister($05100000);
+NR_IRQDISABLEFLAG = tregister($05110000);
+NR_DECIMALMODEFLAG = tregister($05120000);
+NR_BRKCOMMANDFLAG = tregister($05130000);
+NR_OVERFLOWFLAG = tregister($05150000);
+NR_NEGATIVEFLAG = tregister($05160000);
+NR_S = tregister($05010001);
+NR_PC = tregister($05030002);

+ 15 - 0
compiler/mos6502/rmos6502dwa.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+0,
+1,
+2,
+3,
+4,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+5,
+6

+ 2 - 0
compiler/mos6502/rmos6502nor.inc

@@ -0,0 +1,2 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+14

+ 15 - 0
compiler/mos6502/rmos6502num.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+tregister($00000000),
+tregister($01010000),
+tregister($01010001),
+tregister($01010002),
+tregister($05010000),
+tregister($050f0000),
+tregister($05100000),
+tregister($05110000),
+tregister($05120000),
+tregister($05130000),
+tregister($05150000),
+tregister($05160000),
+tregister($05010001),
+tregister($05030002)

+ 15 - 0
compiler/mos6502/rmos6502rni.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+0,
+1,
+2,
+3,
+4,
+12,
+13,
+5,
+6,
+7,
+8,
+9,
+10,
+11

+ 15 - 0
compiler/mos6502/rmos6502sri.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+0,
+1,
+9,
+5,
+8,
+7,
+11,
+10,
+4,
+13,
+12,
+2,
+3,
+6

+ 15 - 0
compiler/mos6502/rmos6502sta.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+0,
+1,
+2,
+3,
+4,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+5,
+6

+ 15 - 0
compiler/mos6502/rmos6502std.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+'INVALID',
+'a',
+'x',
+'y',
+'p',
+'carryflag',
+'zeroflag',
+'irqdisableflag',
+'decimalmodeflag',
+'brkcommandflag',
+'overflowflag',
+'negativeflag',
+'s',
+'pc'

+ 15 - 0
compiler/mos6502/rmos6502sup.inc

@@ -0,0 +1,15 @@
+{ don't edit, this file is generated from mos6502reg.dat }
+RS_NO = 0;
+RS_A = 0;
+RS_X = 1;
+RS_Y = 2;
+RS_P = 0;
+RS_CARRYFLAG = 0;
+RS_ZEROFLAG = 0;
+RS_IRQDISABLEFLAG = 0;
+RS_DECIMALMODEFLAG = 0;
+RS_BRKCOMMANDFLAG = 0;
+RS_OVERFLOWFLAG = 0;
+RS_NEGATIVEFLAG = 0;
+RS_S = 1;
+RS_PC = 2;

+ 7 - 0
compiler/pp.pas

@@ -36,6 +36,7 @@ program pp;
   M68K                generate a compiler for the M68000
   MIPS                generate a compiler for the MIPS (Big Endian)
   MIPSEL              generate a compiler for the MIPSEL (Littel Endian)
+  MOS6502             generate a compiler for the MOS Technology 6502
   POWERPC             generate a compiler for the PowerPC
   POWERPC64           generate a compiler for the PowerPC64 architecture
   RISCV32             generate a compiler for the RiscV32 architecture
@@ -208,6 +209,12 @@ program pp;
   {$endif CPUDEFINED}
   {$define CPUDEFINED}
 {$endif LOONGARCH64}
+{$ifdef MOS6502}
+  {$ifdef CPUDEFINED}
+    {$fatal ONLY one of the switches for the CPU type must be defined}
+  {$endif CPUDEFINED}
+  {$define CPUDEFINED}
+{$endif MOS6502}
 
 {$ifndef CPUDEFINED}
   {$fatal A CPU type switch must be defined}

+ 84 - 0
compiler/ppcmos6502.lpi

@@ -0,0 +1,84 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="ppcmos6502"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="z80\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="mos6502\ppcmos6502"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="mos6502"/>
+      <OtherUnitFiles Value="mos6502;systems"/>
+      <UnitOutputDirectory Value="mos6502\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CustomOptions Value="-dEXTDEBUG
+-dmos6502"/>
+      <OtherDefines Count="2">
+        <Define0 Value="EXTDEBUG"/>
+        <Define1 Value="mos6502"/>
+      </OtherDefines>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

+ 270 - 0
compiler/utils/mk6502reg.pp

@@ -0,0 +1,270 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl
+
+    Convert mos6502reg.dat to several .inc files for usage with
+    the Free pascal compiler
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+program mk6502reg;
+
+uses
+  sysutils;
+
+const Version = '1.00';
+      max_regcount = 200;
+
+var s : string;
+    i : longint;
+    line : longint;
+    regcount:byte;
+    regcount_bsstart:byte;
+    names,
+    numbers,
+    stdnames,
+    stabs,dwarf : array[0..max_regcount-1] of string[63];
+    regnumber_index,
+    std_regname_index : array[0..max_regcount-1] of byte;
+
+function tostr(l : longint) : string;
+
+begin
+  str(l,tostr);
+end;
+
+function readstr : string;
+
+  begin
+     result:='';
+     while (s[i]<>',') and (i<=length(s)) do
+       begin
+          result:=result+s[i];
+          inc(i);
+       end;
+  end;
+
+
+procedure readcomma;
+  begin
+     if s[i]<>',' then
+       begin
+         writeln('Missing "," at line ',line);
+         writeln('Line: "',s,'"');
+         halt(1);
+       end;
+     inc(i);
+  end;
+
+
+procedure skipspace;
+
+  begin
+     while (s[i] in [' ',#9]) do
+       inc(i);
+  end;
+
+procedure openinc(out f:text;const fn:string);
+begin
+  writeln('creating ',fn);
+  assign(f,fn);
+  rewrite(f);
+  writeln(f,'{ don''t edit, this file is generated from mos6502reg.dat }');
+end;
+
+
+procedure closeinc(var f:text);
+begin
+  writeln(f);
+  close(f);
+end;
+
+procedure build_regnum_index;
+
+var h,i,j,p,t:byte;
+
+begin
+  {Build the registernumber2regindex index.
+   Step 1: Fill.}
+  for i:=0 to regcount-1 do
+    regnumber_index[i]:=i;
+  {Step 2: Sort. We use a Shell-Metzner sort.}
+  p:=regcount_bsstart;
+  repeat
+    for h:=0 to regcount-p-1 do
+      begin
+        i:=h;
+        repeat
+          j:=i+p;
+          if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then
+            break;
+          t:=regnumber_index[i];
+          regnumber_index[i]:=regnumber_index[j];
+          regnumber_index[j]:=t;
+          if i<p then
+            break;
+          dec(i,p);
+        until false;
+      end;
+    p:=p shr 1;
+  until p=0;
+end;
+
+procedure build_std_regname_index;
+
+var h,i,j,p,t:byte;
+
+begin
+  {Build the registernumber2regindex index.
+   Step 1: Fill.}
+  for i:=0 to regcount-1 do
+    std_regname_index[i]:=i;
+  {Step 2: Sort. We use a Shell-Metzner sort.}
+  p:=regcount_bsstart;
+  repeat
+    for h:=0 to regcount-p-1 do
+      begin
+        i:=h;
+        repeat
+          j:=i+p;
+          if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then
+            break;
+          t:=std_regname_index[i];
+          std_regname_index[i]:=std_regname_index[j];
+          std_regname_index[j]:=t;
+          if i<p then
+            break;
+          dec(i,p);
+        until false;
+      end;
+    p:=p shr 1;
+  until p=0;
+end;
+
+
+procedure read_spreg_file;
+
+var infile:text;
+
+begin
+   { open dat file }
+   assign(infile,'mos6502reg.dat');
+   reset(infile);
+   while not(eof(infile)) do
+     begin
+        { handle comment }
+        readln(infile,s);
+        inc(line);
+        while (s[1]=' ') do
+         delete(s,1,1);
+        if (s='') or (s[1]=';') then
+          continue;
+
+        i:=1;
+        names[regcount]:=readstr;
+        readcomma;
+        numbers[regcount]:=readstr;
+        readcomma;
+        stdnames[regcount]:=readstr;
+        readcomma;
+        stabs[regcount]:=readstr;
+        readcomma;
+        dwarf[regcount]:=readstr;
+        { Create register number }
+        if numbers[regcount][1]<>'$' then
+          begin
+            writeln('Missing $ before number, at line ',line);
+            writeln('Line: "',s,'"');
+            halt(1);
+          end;
+        if i<length(s) then
+          begin
+            writeln('Extra chars at end of line, at line ',line);
+            writeln('Line: "',s,'"');
+            halt(1);
+          end;
+        inc(regcount);
+        if regcount>max_regcount then
+          begin
+            writeln('Error: Too much registers, please increase maxregcount in source');
+            halt(2);
+          end;
+     end;
+   close(infile);
+end;
+
+procedure write_inc_files;
+
+var
+    norfile,stdfile,supfile,
+    numfile,stabfile,dwarffile,confile,
+    rnifile,srifile:text;
+    first:boolean;
+
+begin
+  { create inc files }
+  openinc(confile,'rmos6502con.inc');
+  openinc(supfile,'rmos6502sup.inc');
+  openinc(numfile,'rmos6502num.inc');
+  openinc(stdfile,'rmos6502std.inc');
+  openinc(stabfile,'rmos6502sta.inc');
+  openinc(dwarffile,'rmos6502dwa.inc');
+  openinc(norfile,'rmos6502nor.inc');
+  openinc(rnifile,'rmos6502rni.inc');
+  openinc(srifile,'rmos6502sri.inc');
+  first:=true;
+  for i:=0 to regcount-1 do
+    begin
+      if not first then
+        begin
+          writeln(numfile,',');
+          writeln(stdfile,',');
+          writeln(stabfile,',');
+          writeln(dwarffile,',');
+          writeln(rnifile,',');
+          writeln(srifile,',');
+        end
+      else
+        first:=false;
+      writeln(supfile,'RS_',names[i],' = ',StrToInt(numbers[i]) and $ff,';');
+      writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';');
+      write(numfile,'tregister(',numbers[i],')');
+      write(stdfile,'''',stdnames[i],'''');
+      write(stabfile,stabs[i]);
+      write(dwarffile,dwarf[i]);
+      write(rnifile,regnumber_index[i]);
+      write(srifile,std_regname_index[i]);
+    end;
+  write(norfile,regcount);
+  close(confile);
+  close(supfile);
+  closeinc(numfile);
+  closeinc(stdfile);
+  closeinc(stabfile);
+  closeinc(dwarffile);
+  closeinc(norfile);
+  closeinc(rnifile);
+  closeinc(srifile);
+  writeln('Done!');
+  writeln(regcount,' registers processed');
+end;
+
+
+begin
+   writeln('Register Table Converter Version ',Version);
+   line:=0;
+   regcount:=0;
+   read_spreg_file;
+   regcount_bsstart:=1;
+   while 2*regcount_bsstart<regcount do
+     regcount_bsstart:=regcount_bsstart*2;
+   build_regnum_index;
+   build_std_regname_index;
+   write_inc_files;
+end.