Added compiler support for SPC32 and initial embedded RTL.

Added SPC32 support to FPCMake

git-svn-id: branches/laksen/spc32@27973 -

.gitattributes

@@ -601,6 +601,7 @@ compiler/ppcmipsel.lpi svneol=native#text/plain
 compiler/ppcppc.lpi svneol=native#text/plain
 compiler/ppcppc64.lpi svneol=native#text/plain
 compiler/ppcsparc.lpi svneol=native#text/plain
+compiler/ppcspc32.lpi svneol=native#text/plain
 compiler/ppheap.pas svneol=native#text/plain
 compiler/ppu.pas svneol=native#text/plain
 compiler/ppx86_64.lpi svneol=native#text/plain
@@ -658,6 +659,38 @@ compiler/sparc/rspsup.inc svneol=native#text/plain
 compiler/sparc/spreg.dat svneol=native#text/plain
 compiler/sparc/strinst.inc svneol=native#text/plain
 compiler/sparc/symcpu.pas svneol=native#text/plain
+compiler/spc32/aasmcpu.pas svneol=native#text/plain
+compiler/spc32/agspc32gas.pas svneol=native#text/plain
+compiler/spc32/aoptcpu.pas svneol=native#text/plain
+compiler/spc32/aoptcpub.pas svneol=native#text/plain
+compiler/spc32/aoptcpud.pas svneol=native#text/plain
+compiler/spc32/cgcpu.pas svneol=native#text/plain
+compiler/spc32/cpubase.pas svneol=native#text/plain
+compiler/spc32/cpuelf.pas svneol=native#text/plain
+compiler/spc32/cpuinfo.pas svneol=native#text/plain
+compiler/spc32/cpunode.pas svneol=native#text/plain
+compiler/spc32/cpupara.pas svneol=native#text/plain
+compiler/spc32/cpupi.pas svneol=native#text/plain
+compiler/spc32/cputarg.pas svneol=native#text/plain
+compiler/spc32/hlcgcpu.pas svneol=native#text/plain
+compiler/spc32/itcpugas.pas svneol=native#text/plain
+compiler/spc32/nspc32add.pas svneol=native#text/plain
+compiler/spc32/nspc32cnv.pas svneol=native#text/plain
+compiler/spc32/nspc32mat.pas svneol=native#text/plain
+compiler/spc32/raspc32.pas svneol=native#text/plain
+compiler/spc32/raspc32gas.pas svneol=native#text/plain
+compiler/spc32/rgcpu.pas svneol=native#text/plain
+compiler/spc32/rspc32con.inc svneol=native#text/plain
+compiler/spc32/rspc32dwa.inc svneol=native#text/plain
+compiler/spc32/rspc32nor.inc svneol=native#text/plain
+compiler/spc32/rspc32num.inc svneol=native#text/plain
+compiler/spc32/rspc32rni.inc svneol=native#text/plain
+compiler/spc32/rspc32sri.inc svneol=native#text/plain
+compiler/spc32/rspc32sta.inc svneol=native#text/plain
+compiler/spc32/rspc32std.inc svneol=native#text/plain
+compiler/spc32/rspc32sup.inc svneol=native#text/plain
+compiler/spc32/spc32reg.dat svneol=native#text/plain
+compiler/spc32/symcpu.pas svneol=native#text/plain
 compiler/switches.pas svneol=native#text/plain
 compiler/symbase.pas svneol=native#text/plain
 compiler/symconst.pas svneol=native#text/plain
@@ -752,6 +785,7 @@ compiler/utils/mkia64reg.pp svneol=native#text/pascal
 compiler/utils/mkjvmreg.pp svneol=native#text/plain
 compiler/utils/mkmpsreg.pp svneol=native#text/plain
 compiler/utils/mkppcreg.pp svneol=native#text/plain
+compiler/utils/mkspc32reg.pp svneol=native#text/plain
 compiler/utils/mkspreg.pp svneol=native#text/plain
 compiler/utils/mkx86ins.pp svneol=native#text/plain
 compiler/utils/mkx86reg.pp svneol=native#text/plain
@@ -8004,6 +8038,7 @@ rtl/embedded/empty.cfg svneol=native#text/plain
 rtl/embedded/heapmgr.pp svneol=native#text/pascal
 rtl/embedded/rtl.cfg svneol=native#text/plain
 rtl/embedded/rtldefs.inc svneol=native#text/plain
+rtl/embedded/spc32/spc32v1.pp svneol=native#text/plain
 rtl/embedded/sysdir.inc svneol=native#text/plain
 rtl/embedded/sysfile.inc svneol=native#text/plain
 rtl/embedded/sysheap.inc svneol=native#text/plain
@@ -9043,6 +9078,15 @@ rtl/sparc/setjumph.inc svneol=native#text/plain
 rtl/sparc/sparc.inc svneol=native#text/plain
 rtl/sparc/strings.inc svneol=native#text/plain
 rtl/sparc/stringss.inc svneol=native#text/plain
+rtl/spc32/int64p.inc svneol=native#text/plain
+rtl/spc32/makefile.cpu svneol=native#text/plain
+rtl/spc32/math.inc svneol=native#text/plain
+rtl/spc32/set.inc svneol=native#text/plain
+rtl/spc32/setjump.inc svneol=native#text/plain
+rtl/spc32/setjumph.inc svneol=native#text/plain
+rtl/spc32/spc32.inc svneol=native#text/plain
+rtl/spc32/strings.inc svneol=native#text/plain
+rtl/spc32/stringss.inc svneol=native#text/plain
 rtl/symbian/Makefile svneol=native#text/plain
 rtl/symbian/Makefile.fpc svneol=native#text/plain
 rtl/symbian/bindings/pbeexe.cpp -text

Makefile.fpc

@@ -79,6 +79,9 @@ endif
 ifeq ($(CPU_TARGET),avr)
 PPSUF=avr
 endif
+ifeq ($(CPU_TARGET),spc32)
+PPSUF=spc32
+endif
 
 # cross compilers uses full cpu_target, not just ppc-suffix
 # (except if the target cannot run a native compiler)

compiler/Makefile.fpc

@@ -32,7 +32,7 @@ fpcdir=..
 unexport FPC_VERSION FPC_COMPILERINFO
 
 # Which platforms are ready for inclusion in the cycle
-CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr jvm i8086
+CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr jvm i8086 spc32
 
 # All supported targets used for clean
 ALLTARGETS=$(CYCLETARGETS)
@@ -74,6 +74,9 @@ endif
 ifdef AVR
 PPC_TARGET=avr
 endif
+ifdef SPC32
+PPC_TARGET=spc32
+endif
 ifdef JVM
 PPC_TARGET=jvm
 endif
@@ -199,6 +202,9 @@ endif
 ifeq ($(CPC_TARGET),avr)
 CPUSUF=avr
 endif
+ifeq ($(CPC_TARGET),spc32)
+CPUSUF=spc32
+endif
 ifeq ($(CPC_TARGET),jvm)
 CPUSUF=jvm
 endif
@@ -397,7 +403,7 @@ endif
 # CPU targets
 #####################################################################
 
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm i8086
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm i8086 spc32
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 
 .PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)
@@ -452,12 +458,12 @@ tempclean:
         -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) pp1.wpo pp2.wpo
 
 execlean :
-        -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
+        -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppcspc32$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2)
 
 $(addsuffix _clean,$(ALLTARGETS)):
         -$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
         -$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT))
-        -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) $(EXENAME))
+        -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppcspc32$(EXEEXT) $(EXENAME))
 
 cycleclean: cleanall $(addsuffix _clean,$(CPC_TARGET))
         -$(DEL) $(EXENAME)

compiler/cgbase.pas

@@ -101,6 +101,10 @@ interface
          ,addr_dgroup      // the data segment group
          ,addr_seg         // used for getting the segment of an object, e.g. 'mov ax, SEG symbol'
          {$ENDIF}
+         {$IFDEF SPC32}
+         ,addr_lo16
+         ,addr_hi16
+         {$ENDIF}
          );
 
 

compiler/elfbase.pas

@@ -83,6 +83,7 @@ interface
     EM_PPC        = 20;
     EM_ARM        = 40;
     EM_X86_64     = 62;
+    EM_SPC32      = 353; // Invented machine index
 
     { ElfSechdr.sh_num }
     SHN_UNDEF     = 0;

compiler/fpcdefs.inc

@@ -224,6 +224,20 @@
   {$define SUPPORT_SAFECALL}
 {$endif mips}
 
+{$ifdef spc32}
+  {$define cpu32bit}
+  {$define cpu32bitalu}
+  {$define cpu32bitaddr}
+  {$define cpuflags}
+  {$define cputargethasfixedstack}
+  {$define cpurequiresproperalignment}
+  {$define cpufpemu}
+  {$define cpuneedsdiv32helper}
+  {$define cpuneedsmulhelper}
+  {$define cpucapabilities}
+  { define cpumm}
+{$endif mips}
+
 {$ifdef jvm}
   {$define cpu32bit}
   {$define cpu64bitalu}

compiler/globals.pas

@@ -483,6 +483,11 @@ interface
         optimizecputype : cpu_8086;
         fputype : fpu_x87;
   {$endif i8086}
+  {$ifdef spc32}
+        cputype : cpu_spc32v1;
+        optimizecputype : cpu_spc32v1;
+        fputype : fpu_soft;
+  {$endif spc32}
 {$endif not GENERIC_CPU}
         asmmode : asmmode_standard;
 {$ifndef jvm}

compiler/ncgutil.pas

@@ -867,9 +867,9 @@ implementation
         paraloc  : pcgparalocation;
         href     : treference;
         sizeleft : aint;
-{$if defined(sparc) or defined(arm) or defined(mips)}
+{$if defined(sparc) or defined(arm) or defined(mips) or defined(spc32)}
         tempref  : treference;
-{$endif defined(sparc) or defined(arm) or defined(mips)}
+{$endif defined(sparc) or defined(arm) or defined(mips) or defined(spc32)}
 {$ifdef mips}
         tmpreg   : tregister;
 {$endif mips}
@@ -1147,7 +1147,7 @@ implementation
                   tg.UnGetTemp(list,tempref);
                 end;
 {$else mips}
-{$if defined(sparc) or defined(arm)}
+{$if defined(sparc) or defined(arm) or defined(spc32)}
               { Arm and Sparc passes floats in int registers, when loading to fpu register
                 we need a temp }
               sizeleft := TCGSize2Size[destloc.size];
@@ -1164,14 +1164,14 @@ implementation
               gen_alloc_regloc(list,destloc);
               cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
               tg.UnGetTemp(list,tempref);
-{$else defined(sparc) or defined(arm)}
+{$else defined(sparc) or defined(arm) or defined(spc32)}
               unget_para(paraloc^);
               gen_alloc_regloc(list,destloc);
               { from register to register -> alignment is irrelevant }
               cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
               if assigned(paraloc^.next) then
                 internalerror(200410109);
-{$endif defined(sparc) or defined(arm)}
+{$endif defined(sparc) or defined(arm) or defined(spc32)}
 {$endif mips}
             end;
           LOC_MMREGISTER,

compiler/ogbase.pas

@@ -69,6 +69,10 @@ interface
 {$ifdef arm}
          RELOC_RELATIVE_24,
 {$endif arm}
+{$ifdef spc32}
+         RELOC_LO16,
+         RELOC_HI16,
+{$endif spc32}
          { Relative relocation }
          RELOC_RELATIVE,
          { PECoff (Windows) RVA relocation }

compiler/options.pas

@@ -3068,6 +3068,12 @@ begin
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
 {$endif jvm}
+{$ifdef spc32}
+  def_system_macro('CPUSPC32');
+  def_system_macro('CPU32');
+  def_system_macro('FPC_CURRENCY_IS_INT64');
+  def_system_macro('FPC_COMP_IS_INT64');
+{$endif spc32}
 
 {$ifdef mipsel}
   def_system_macro('CPUMIPS');
@@ -3369,14 +3375,14 @@ begin
   if not(option.FPUSetExplicitly) and
      ((target_info.system in [system_arm_wince,system_arm_gba,
          system_m68k_amiga,system_m68k_atari,system_m68k_linux,
-         system_arm_nds,system_arm_embedded])
+         system_arm_nds,system_arm_embedded,system_spc32_embedded])
 {$ifdef arm}
       or (target_info.abi=abi_eabi)
 {$endif arm}
      )
-{$if defined(arm) or defined (m68k)}
+{$if defined(arm) or defined (m68k) or defined (spc32)}
      or (init_settings.fputype=fpu_soft)
-{$endif arm or m68k}
+{$endif arm or m68k or spc32}
   then
     begin
 {$ifdef cpufpemu}

compiler/pp.pas

@@ -153,6 +153,12 @@ program pp;
   {$endif CPUDEFINED}
   {$define CPUDEFINED}
 {$endif AARCH64}
+{$ifdef SPC32}
+  {$ifdef CPUDEFINED}
+    {$fatal ONLY one of the switches for the CPU type must be defined}
+  {$endif CPUDEFINED}
+  {$define CPUDEFINED}
+{$endif SPC32}
 {$ifndef CPUDEFINED}
   {$fatal A CPU type switch must be defined}
 {$endif CPUDEFINED}

compiler/ppcspc32.lpi

@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ppcm68k"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-O4 -Cfsoft test -B -s -Cn -al"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <WorkingDirectory Value="C:\Users\jepjoh2\Desktop\benc"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="pp"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="m68k\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aasmcpu"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="spc32\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="spc32"/>
+      <OtherUnitFiles Value="spc32;systems"/>
+      <UnitOutputDirectory Value="spc32\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="-dspc32"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 170;
+  CurrentPPUVersion = 171;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -188,7 +188,8 @@ const
     { 12 } 16 {'avr'},
     { 13 } 32 {'mipsel'},
     { 14 } 32 {'jvm'},
-    { 15 } 16 {'i8086'}
+    { 15 } 16 {'i8086'},
+    { 16 } 32 {'spc32'}
     );
   CpuAluBitSize : array[tsystemcpu] of longint =
     (
@@ -207,7 +208,8 @@ const
     { 12 }  8 {'avr'},
     { 13 } 32 {'mipsel'},
     { 14 } 64 {'jvm'},
-    { 15 } 16 {'i8086'}
+    { 15 } 16 {'i8086'},
+    { 16 } 32 {'spc32'}
     );
 {$endif generic_cpu}
 

compiler/psub.pas

@@ -951,7 +951,7 @@ implementation
       begin
         tg:=tgobjclass.create;
 
-{$if defined(i386) or defined(x86_64) or defined(arm)}
+{$if defined(i386) or defined(x86_64) or defined(arm) or defined(spc32)}
 {$if defined(arm)}
         { frame and stack pointer must be always the same on arm thumb so it makes no
           sense to fiddle with a frame pointer }
@@ -1049,7 +1049,7 @@ implementation
 {$endif defined(arm)}
               end;
           end;
-{$endif defined(x86) or defined(arm)}
+{$endif defined(x86) or defined(arm) or defined(spc32)}
         { set the start offset to the start of the temp area in the stack }
         set_first_temp_offset;
       end;

compiler/psystem.pas

@@ -106,6 +106,8 @@ implementation
         systemunit.insert(csyssym.create('Default',in_default_x));
         systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool8type));
         systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool8type));
+
+
       end;
 
 
@@ -293,6 +295,13 @@ implementation
 {$else i8086}
         parentfpvoidpointertype:=cpointerdef.create(voidtype);
 {$endif i8086}
+{$ifdef spc32}
+        s32floattype:=tfloatdef.create(s32real);
+        s64floattype:=tfloatdef.create(s64real);
+        s80floattype:=tfloatdef.create(s80real);
+        sc80floattype:=tfloatdef.create(sc80real);
+        s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
+{$endif spc32}
 {$ifdef x86}
         voidnearpointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near);
         voidnearcspointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_cs);

compiler/rgobj.pas

@@ -24,6 +24,7 @@
 { Allow duplicate allocations, can be used to get the .s file written }
 { $define ALLOWDUPREG}
 
+{$define EXTDEBUG}
 
 unit rgobj;
 
@@ -2152,7 +2153,7 @@ unit rgobj;
         if not spilled then
           exit;
 
-{$if defined(x86) or defined(mips) or defined(sparc) or defined(arm)}
+{$if defined(x86) or defined(mips) or defined(sparc) or defined(arm) or defined(spc32)}
         { Try replacing the register with the spilltemp. This is useful only
           for the i386,x86_64 that support memory locations for several instructions
 
@@ -2167,7 +2168,7 @@ unit rgobj;
                     mustbespilled:=false;
                 end;
             end;
-{$endif defined(x86) or defined(mips) or defined(sparc) or defined(arm)}
+{$endif defined(x86) or defined(mips) or defined(sparc) or defined(arm) or defined(spc32)}
 
         {
           There are registers that need are spilled. We generate the
@@ -2283,7 +2284,8 @@ unit rgobj;
             begin
               if mustbespilled and regwritten then
                 begin
-                  do_spill_written(list,tai(storepos.previous),spilltemplist[orgreg],tempreg);
+                  do_spill_written(list,instr,spilltemplist[orgreg],tempreg);
+                  //do_spill_written(list,tai(storepos.previous),spilltemplist[orgreg],tempreg);
                   ungetregisterinline(list,tempreg);
                 end;
             end;

compiler/spc32/aasmcpu.pas

@@ -0,0 +1,579 @@
+{
+    Copyright (c) 1999-2008 by Mazen Neifer and Florian Klaempfl
+
+    Contains the assembler object for the SPC32
+
+    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.
+
+ ****************************************************************************
+}
+unit aasmcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  cclasses,
+  globtype,globals,verbose,
+  aasmbase,aasmtai,aasmdata,aasmsym,
+  cgbase,cgutils,cpubase,cpuinfo,
+  ogbase;
+
+    const
+      { "mov reg,reg" source operand number }
+      O_MOV_SOURCE = 1;
+      { "mov reg,reg" source operand number }
+      O_MOV_DEST = 0;
+
+      maxinfolen = 5;
+
+    type
+      tinsentry = record
+        opcode  : tasmop;
+        ops     : byte;
+        optypes : array[0..3] of longint;
+        code    : array[0..maxinfolen] of char;
+        flags   : longint;
+      end;
+
+      pinsentry=^tinsentry;
+
+      { taicpu }
+
+      taicpu = class(tai_cpu_abstract_sym)
+         constructor op_none(op : tasmop);
+
+         constructor op_reg(op : tasmop;_op1 : tregister);
+         constructor op_const(op : tasmop;_op1 : LongInt);
+         constructor op_ref(op : tasmop;const _op1 : treference);
+
+         constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+         constructor op_reg_ref(op : tasmop;_op1: tregister; _op2 : treference);
+
+         { this is for Jmp instructions }
+         constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+         constructor op_sym(op : tasmop;_op1 : tasmsymbol);
+         constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+         procedure loadbool(opidx:longint;_b:boolean);
+         { register allocation }
+         function is_same_reg_move(regtype: Tregistertype):boolean; override;
+
+         { register spilling code }
+         function spilling_get_operation_type(opnr: longint): topertype;override;
+
+         { assembler }
+      public
+         { the next will reset all instructions that can change in pass 2 }
+         procedure ResetPass1;override;
+         procedure ResetPass2;override;
+{         function  CheckIfValid:boolean;
+         function GetString:string; }
+         function  Pass1(objdata:TObjData):longint;override;
+         procedure Pass2(objdata:TObjData);override;
+         function calcsize(p:PInsEntry):shortint;
+      private
+         { next fields are filled in pass1, so pass2 is faster }
+         inssize   : shortint;
+         insoffset : longint;
+         insentry  : PInsEntry;
+         LastInsOffset : longint; { need to be public to be reset }
+         function  FindInsentry(objdata:TObjData):boolean;
+      end;
+
+      tai_align = class(tai_align_abstract)
+        { nothing to add }
+      end;
+
+    procedure InitAsm;
+    procedure DoneAsm;
+
+    function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+    function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+
+    function setcondition(i : taicpu;c : tasmcond) : taicpu;
+
+    { replaces cond. branches by rjmp/jmp and the inverse cond. branch if needed
+      and transforms special instructions to valid instruction encodings }
+    procedure finalizespc32code(list : TAsmList);
+
+implementation
+
+{*****************************************************************************
+                                 taicpu Constructors
+*****************************************************************************}
+
+    procedure taicpu.loadbool(opidx:longint;_b:boolean);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx]^ do
+         begin
+           if typ=top_ref then
+            dispose(ref);
+           b:=_b;
+           typ:=top_bool;
+         end;
+      end;
+
+
+    constructor taicpu.op_none(op : tasmop);
+      begin
+         inherited create(op);
+      end;
+
+
+    constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadreg(0,_op1);
+      end;
+
+
+    constructor taicpu.op_ref(op : tasmop;const _op1 : treference);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadref(0,_op1);
+      end;
+
+
+    constructor taicpu.op_const(op : tasmop;_op1 : LongInt);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadconst(0,_op1);
+      end;
+
+
+    constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_ref(op: tasmop; _op1: tregister; _op2: treference);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadreg(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         is_jmp:=op in jmp_instructions;
+         condition:=cond;
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         is_jmp:=op in jmp_instructions;
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadsymbol(0,_op1,_op1ofs);
+      end;
+
+
+    function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
+      begin
+        result:=(opcode = A_MOV) and
+                (ops = 2) and
+                (oper[0]^.reg = oper[1]^.reg);
+      end;
+
+
+    function taicpu.spilling_get_operation_type(opnr: longint): topertype;
+      begin
+        result:=operand_read;
+        case opcode of
+          A_LOAD,
+          A_MOV:
+            begin
+              if opnr = 0 then
+                result:=operand_write
+              else
+                result:=operand_readwrite;
+            end;
+          A_STORE:
+            begin
+              if opnr = 1 then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            end;
+
+          A_ST:
+            result:=operand_write;
+          else
+            result:=operand_read;
+        end;
+      end;
+
+
+    function  taicpu.calcsize(p:PInsEntry):shortint;
+      begin
+        result:=1;
+        if (ops=1) and
+           (oper[0]^.typ in [top_ref,top_const]) then
+          result:=3;
+
+        if opcode in [A_PUSH,A_POP,A_INC,A_XCHG,A_CAS] then
+          inc(result);
+      end;
+
+
+    procedure taicpu.ResetPass1;
+      begin
+        { we need to reset everything here, because the choosen insentry
+          can be invalid for a new situation where the previously optimized
+          insentry is not correct }
+        InsEntry:=nil;
+        InsSize:=0;
+        LastInsOffset:=-1;
+      end;
+
+
+    procedure taicpu.ResetPass2;
+      begin
+        { we are here in a second pass, check if the instruction can be optimized }
+{
+        if assigned(InsEntry) and
+           ((InsEntry^.flags and IF_PASS2)<>0) then
+         begin
+           InsEntry:=nil;
+           InsSize:=0;
+         end;
+}
+        LastInsOffset:=-1;
+      end;
+
+
+    function taicpu.FindInsentry(objdata:TObjData):boolean;
+      begin
+        result:=true;
+      end;
+
+
+    function taicpu.Pass1(objdata:TObjData):longint;
+      begin
+        Pass1:=0;
+        { Save the old offset and set the new offset }
+        InsOffset:=ObjData.CurrObjSec.Size;
+        InsSize:=calcsize(InsEntry);
+        { Error? }
+        if (Insentry=nil) and (InsSize=-1) then
+          exit;
+        { set the file postion }
+        current_filepos:=fileinfo;
+
+        { Get InsEntry }
+        if FindInsEntry(objdata) then
+         begin
+           LastInsOffset:=InsOffset;
+           Pass1:=InsSize;
+           exit;
+         end;
+        LastInsOffset:=-1;
+      end;
+
+
+    procedure taicpu.Pass2(objdata: TObjData);
+      var
+        b, code : longword;
+        objsym : TObjSymbol;
+      begin
+        code:=0;
+
+        case opcode of
+          A_LD:   code:=$00;
+          A_ST:   code:=$08;
+          A_ADD:  code:=$10;
+          A_SUB:  code:=$18;
+          A_MUL:  code:=$20;
+          A_LSL:  code:=$28;
+          A_LSR:  code:=$30;
+          A_ASR:  code:=$38;
+          A_AND:  code:=$40;
+          A_ORR:  code:=$48;
+          A_XOR:  code:=$50;
+          A_LDU:  code:=$58;
+          A_ADC:  code:=$60;
+          A_SBC:  code:=$68;
+          A_NUL:  code:=$70;
+          A_LDW:  code:=$78;
+          A_LDH:  code:=$80;
+          A_LDB:  code:=$88;
+          A_STW:  code:=$90;
+          A_StH:  code:=$98;
+          A_STB:  code:=$A0;
+          A_JMP:  code:=$A8;
+          A_CALL: code:=$B0;
+          A_Jxx:
+            case condition of
+              C_EQ:  code:=$B8;
+              C_NE:  code:=$C0;
+              C_LT:  code:=$C8;
+              C_LE:  code:=$D0;
+              C_B:   code:=$D8;
+              C_BE:  code:=$E0;
+            end;
+          //A_:   code:=$E8;
+          A_GS:   code:=$E8;
+          A_SS:   code:=$F0;
+
+          A_PUSH: code:=$00;
+          A_POP:  code:=$08;
+          A_INC:  code:=$10;
+          A_XCHG: code:=$18;
+          A_CAS:  code:=$20;
+          A_IRET: code:=$28;
+          else
+            internalerror(2014041603);
+        end;
+
+        if opcode in [A_PUSH,A_POP,A_INC,A_XCHG,A_CAS,A_IRET] then
+          begin
+            b:=$F8;
+
+            if opcode = A_CAS then
+              begin
+                if ops<>2 then
+                  internalerror(2014042101);
+
+                case oper[1]^.typ of
+                  top_reg:
+                    b:=b or getsupreg(oper[1]^.reg);
+                  top_const,
+                  top_ref:
+                    b:=b or $7;
+                end;
+
+                if oper[1]^.typ=top_ref then
+                  begin
+                    objdata.writebytes(b,1);
+
+                    objsym:=objdata.symbolref(oper[1]^.ref^.symbol);
+
+                    if oper[1]^.ref^.refaddr = addr_hi16 then
+                      b:=(oper[1]^.ref^.offset shr 16) and $FFFF
+                    else if oper[1]^.ref^.refaddr = addr_lo16 then
+                      b:=(oper[1]^.ref^.offset) and $FFFF
+                    else
+                      b:=(oper[1]^.ref^.offset+6) and $FFFF;
+
+                    case oper[1]^.ref^.refaddr of
+                      addr_lo16:
+                        objdata.writeReloc(b,2,objsym,RELOC_LO16);
+                      addr_hi16:
+                        objdata.writeReloc(b,2,objsym,RELOC_HI16);
+                      else
+                        objdata.writeReloc(b,2,objsym,RELOC_RELATIVE);
+                    end;
+                  end
+                else if oper[1]^.typ=top_const then
+                  begin
+                    b:=b or ((oper[1]^.val and $FFFF) shl 8);
+
+                    objdata.writebytes(b,3);
+                  end
+                else
+                  objdata.writebytes(b,1);
+              end
+            else
+              objdata.writebytes(b, 1);
+          end;
+
+        if ops=1 then
+          begin
+            case oper[0]^.typ of
+              top_reg:
+                code:=code or getsupreg(oper[0]^.reg);
+              top_const,
+              top_ref:
+                code:=code or $7;
+            end;
+          end;
+
+        if (ops=1) and
+           (oper[0]^.typ=top_ref) then
+          begin
+            objdata.writebytes(code,1);
+
+            objsym:=objdata.symbolref(oper[0]^.ref^.symbol);
+
+            if oper[0]^.ref^.refaddr = addr_hi16 then
+              code:=(oper[0]^.ref^.offset shr 16) and $FFFF
+            else if oper[0]^.ref^.refaddr = addr_lo16 then
+              code:=(oper[0]^.ref^.offset) and $FFFF
+            else
+              code:=(oper[0]^.ref^.offset+6) and $FFFF;
+
+            case oper[0]^.ref^.refaddr of
+              addr_lo16:
+                objdata.writeReloc(code,2,objsym,RELOC_LO16);
+              addr_hi16:
+                objdata.writeReloc(code,2,objsym,RELOC_HI16);
+              else
+                objdata.writeReloc(code,2,objsym,RELOC_RELATIVE);
+            end;
+          end
+        else if (ops=1) and
+                (oper[0]^.typ=top_const) then
+          begin
+            code:=code or ((oper[0]^.val and $FFFF) shl 8);
+
+            objdata.writebytes(code,3);
+          end
+        else
+          objdata.writebytes(code,1);
+      end;
+
+
+    function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+      begin
+        case getregtype(r) of
+          R_INTREGISTER,
+          R_ADDRESSREGISTER,
+          R_FPUREGISTER:
+            result:=taicpu.op_reg_ref(A_LOAD,r,ref);
+          else
+            internalerror(200401041);
+        end;
+      end;
+
+
+    function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+      begin
+        case getregtype(r) of
+          R_INTREGISTER,
+          R_ADDRESSREGISTER,
+          R_FPUREGISTER:
+            result:=taicpu.op_reg_ref(A_STORE,r,ref);
+          else
+            internalerror(200401041);
+        end;
+      end;
+
+
+    procedure InitAsm;
+      begin
+      end;
+
+
+    procedure DoneAsm;
+      begin
+      end;
+
+
+    function setcondition(i : taicpu;c : tasmcond) : taicpu;
+      begin
+        i.condition:=c;
+        result:=i;
+      end;
+
+
+    procedure finalizespc32code(list : TAsmList);
+      var
+        CurrOffset : longint;
+        curtai : tai;
+        again : boolean;
+        l : tasmlabel;
+      begin
+        again:=true;
+        while again do
+          begin
+            again:=false;
+            CurrOffset:=0;
+            curtai:=tai(list.first);
+            while assigned(curtai) do
+              begin
+                { instruction? }
+                if not(curtai.typ in SkipInstr) then
+                  case curtai.typ of
+                    ait_instruction:
+                      begin
+                        if taicpu(curtai).opcode=A_MOV then
+                          begin
+                            list.InsertAfter(taicpu.op_reg(A_ST,taicpu(curtai).oper[0]^.reg), curtai);
+
+                            taicpu(curtai).opcode:=A_LD;
+                            taicpu(curtai).loadreg(0, taicpu(curtai).oper[1]^.reg);
+                            taicpu(curtai).ops:=1;
+                          end;
+
+                        taicpu(curtai).InsOffset:=CurrOffset;
+                        inc(CurrOffset,taicpu(curtai).calcsize(nil));
+                      end;
+                    ait_align:
+                      inc(CurrOffset,tai_align(curtai).aligntype);
+                    ait_weak,
+                    ait_set,
+                    ait_marker,
+                    ait_const:
+                      ;
+                    ait_label:
+                      begin
+                        //tai_label(curtai).labsym.offset:=CurrOffset;
+                      end;
+                    else
+                      internalerror(2011082401);
+                  end;
+                curtai:=tai(curtai.next);
+              end;
+
+            {curtai:=tai(list.first);
+            while assigned(curtai) do
+              begin
+                if (curtai.typ=ait_instruction) and
+                  (taicpu(curtai).opcode in [A_BRxx]) and
+                  ((taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset>64) or
+                   (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset<-63)
+                  ) then
+                  begin
+                    current_asmdata.getjumplabel(l);
+                    list.insertafter(tai_label.create(l),curtai);
+                    list.insertafter(taicpu.op_sym(A_JMP,taicpu(curtai).oper[0]^.ref^.symbol),curtai);
+                    taicpu(curtai).oper[0]^.ref^.symbol:=l;
+                    taicpu(curtai).condition:=inverse_cond(taicpu(curtai).condition);
+                    again:=true;
+                  end;
+                curtai:=tai(curtai.next);
+              end;}
+          end;
+      end;
+
+
+begin
+  cai_cpu:=taicpu;
+  cai_align:=tai_align;
+end.

compiler/spc32/agspc32gas.pas

@@ -0,0 +1,203 @@
+{
+    Copyright (c) 2003 by Florian Klaempfl
+
+    This unit implements an asm for the spc32
+
+    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.
+
+ ****************************************************************************
+}
+{ This unit implements the GNU Assembler writer for the spc32
+}
+
+unit agspc32gas;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       globtype,
+       aasmtai,aasmdata,
+       aggas,
+       cpubase;
+
+    type
+
+      { Tspc32GNUAssembler }
+
+      Tspc32GNUAssembler=class(TGNUassembler)
+        constructor create(smart: boolean); override;
+       function MakeCmdLine: TCmdStr; override;
+      end;
+
+     Tspc32InstrWriter=class(TCPUInstrWriter)
+        procedure WriteInstruction(hp : tai);override;
+     end;
+
+
+  implementation
+
+    uses
+       cutils,globals,verbose,
+       systems,
+       assemble,
+       aasmbase,aasmcpu,
+       itcpugas,
+       cpuinfo,
+       cgbase,cgutils;
+
+{****************************************************************************}
+{                         GNU spc32 Assembler writer                           }
+{****************************************************************************}
+
+    constructor Tspc32GNUAssembler.create(smart: boolean);
+      begin
+        inherited create(smart);
+        InstrWriter := Tspc32InstrWriter.create(self);
+      end;
+
+
+{****************************************************************************}
+{                  Helper routines for Instruction Writer                    }
+{****************************************************************************}
+
+
+    Procedure Tspc32InstrWriter.WriteInstruction(hp : tai);
+
+      function getreferencestring(var ref : treference) : string;
+        var
+          s : string;
+        begin
+           with ref do
+            begin
+  {$ifdef extdebug}
+              // if base=NR_NO then
+              //   internalerror(200308292);
+
+              // if ((index<>NR_NO) or (shiftmode<>SM_None)) and ((offset<>0) or (symbol<>nil)) then
+              //   internalerror(200308293);
+  {$endif extdebug}
+              if index<>NR_NO then
+                internalerror(2011021701)
+              else if base<>NR_NO then
+                begin
+                  s:=gas_regname(base);
+
+                  if offset>0 then
+                    s:=s+'+'+tostr(offset)
+                  else if offset<0 then
+                    s:=s+tostr(offset)
+                end
+              else if assigned(symbol) or (offset<>0) then
+                begin
+                  if assigned(symbol) then
+                    s:=ReplaceForbiddenAsmSymbolChars(symbol.name)
+                  else
+                     s:='';
+
+                  if offset<0 then
+                    s:=s+tostr(offset)
+                  else if offset>0 then
+                    s:=s+'+'+tostr(offset);
+
+                  case refaddr of
+                    addr_hi16:
+                      s:='hi16('+s+')';
+                    addr_lo16:
+                      s:='lo16('+s+')';
+                    else
+                      s:='('+s+')';
+                  end;
+                end;
+            end;
+          getreferencestring:=s;
+        end;
+
+
+      function getopstr(const o:toper) : string;
+        var
+          hs : string;
+          first : boolean;
+          r : tsuperregister;
+        begin
+          case o.typ of
+            top_reg:
+              getopstr:=gas_regname(o.reg);
+            top_const:
+              getopstr:=tostr(longint(o.val));
+            top_ref:
+              if o.ref^.refaddr=addr_full then
+                begin
+                  hs:=ReplaceForbiddenAsmSymbolChars(o.ref^.symbol.name);
+                  if o.ref^.offset>0 then
+                   hs:=hs+'+'+tostr(o.ref^.offset)
+                  else
+                   if o.ref^.offset<0 then
+                    hs:=hs+tostr(o.ref^.offset);
+                  getopstr:=hs;
+                end
+              else
+                getopstr:=getreferencestring(o.ref^);
+            else
+              internalerror(2002070604);
+          end;
+        end;
+
+    var op: TAsmOp;
+        s: string;
+        i: byte;
+        sep: string[3];
+    begin
+      op:=taicpu(hp).opcode;
+      s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition];
+      if taicpu(hp).ops<>0 then
+        begin
+          sep:=#9;
+          for i:=0 to taicpu(hp).ops-1 do
+            begin
+              s:=s+sep+getopstr(taicpu(hp).oper[i]^);
+              sep:=',';
+            end;
+        end;
+      owner.AsmWriteLn(s);
+    end;
+
+
+    function Tspc32GNUAssembler.MakeCmdLine: TCmdStr;
+      begin
+        result := '-mmcu='+lower(cputypestr[current_settings.cputype])+' '+inherited MakeCmdLine;
+      end;
+
+
+    const
+       as_spc32_gas_info : tasminfo =
+          (
+            id     : as_gas;
+
+            idtxt  : 'AS';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $EXTRAOPT $ASM';
+            supported_targets : [system_spc32_embedded];
+            flags : [af_needar,af_smartlink_sections];
+            labelprefix : '.L';
+            comment : '# ';
+            dollarsign: 's';
+          );
+
+
+begin
+  RegisterAssembler(as_spc32_gas_info,TSPC32GNUAssembler);
+end.

compiler/spc32/aoptcpu.pas

@@ -0,0 +1,905 @@
+{
+    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit implements the SPC32 optimizer object
+
+    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.
+
+ ****************************************************************************
+}
+
+
+Unit aoptcpu;
+
+{$i fpcdefs.inc}
+
+{$define DEBUG_AOPTCPU}
+
+Interface
+
+uses cpubase, cgbase, aasmtai, aopt, aoptcpub;
+
+Type
+
+  { TCpuAsmOptimizer }
+
+  TCpuAsmOptimizer = class(TAsmOptimizer)
+  private
+    function SkipMarkers(var p: tai): boolean;
+  public
+    Function GetNextInstructionUsingReg(Current: tai; Var Next: tai;reg : TRegister): Boolean;
+
+    { uses the same constructor as TAopObj }
+    function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
+    procedure PeepHoleOptPass2;override;
+
+    procedure DebugMsg(const s: string; p: tai);
+  End;
+
+Implementation
+
+  uses
+    cpuinfo,
+    aasmbase,aasmcpu,
+    globals,globtype,
+    cutils;
+
+  function CanBeCond(p : tai) : boolean;
+    begin
+      result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
+    end;
+
+
+  function TCpuAsmOptimizer.SkipMarkers(var p: tai): boolean;
+    begin
+      result:=assigned(p);
+      while result and
+            assigned(p) and
+            (p.typ in [ait_marker,ait_force_line]) do
+        begin
+          p:=tai(p.next);
+          result:=assigned(p);
+        end;
+    end;
+
+
+  function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
+    var Next: tai; reg: TRegister): Boolean;
+    begin
+      Next:=Current;
+      repeat
+        Result:=GetNextInstruction(Next,Next);
+      until not(cs_opt_level3 in current_settings.optimizerswitches) or not(Result) or (Next.typ<>ait_instruction) or (RegInInstruction(reg,Next)) or
+        (is_calljmp(taicpu(Next).opcode));
+    end;
+
+
+{$ifdef DEBUG_AOPTCPU}
+  procedure TCpuAsmOptimizer.DebugMsg(const s: string;p : tai);
+    begin
+      asml.insertbefore(tai_comment.Create(strpnew(s)), p);
+    end;
+{$else DEBUG_AOPTCPU}
+  procedure TCpuAsmOptimizer.DebugMsg(const s: string;p : tai);inline;
+    begin
+    end;
+{$endif DEBUG_AOPTCPU}
+
+
+  function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
+    var
+      hp1,hp2,hp3: tai;
+      alloc, dealloc: tai_regalloc;
+      i: integer;
+    begin
+      result := false;
+      case p.typ of
+        ait_instruction:
+          begin
+            case taicpu(p).opcode of
+              A_LD:
+                begin
+                  {
+                    turn
+                      ld rx
+                      st rx
+                    into
+                      ld rx
+                  }
+                  if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_ST) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                    begin
+                      DebugMsg('LdSt2Ld', p);
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      ld *
+                      ld rx
+                    into
+                      ld rx
+                  }
+                  else if (taicpu(p).ops=1) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_LD,A_NUL,A_GS]) then
+                    begin
+                      DebugMsg('LdLd2Ld', p);
+
+                      AsmL.Remove(p);
+                      p.free;
+                      p:=hp1;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      ld rx
+                      ldX #0
+                    into
+                      nul
+                      ldX rx
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_LDB,A_LDH,A_LDW]) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_const) and
+                     (taicpu(hp1).oper[0]^.val=0) then
+                    begin
+                      DebugMsg('LdLdx2Ldx', p);
+
+                      taicpu(hp1).loadreg(0,taicpu(p).oper[0]^.reg);
+
+                      taicpu(p).ops:=0;
+                      taicpu(p).opcode:=A_NUL;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      ld rx
+                      alloc ry
+                      st ry
+                      ...
+                      op ry
+                      dealloc ry
+                    into
+                      ld rx
+                      ...
+                      op rx
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_ST) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     GetNextInstructionUsingReg(hp1,hp2,taicpu(hp1).oper[0]^.reg) and
+                     (hp2.typ=ait_instruction) and
+                     (taicpu(hp2).ops=1) and
+                     (taicpu(hp2).opcode<>A_ST) and
+                     (taicpu(hp2).oper[0]^.typ=top_reg) and
+                     (taicpu(hp2).oper[0]^.reg=taicpu(hp1).oper[0]^.reg) and
+                     assigned(FindRegDeAlloc(taicpu(hp1).oper[0]^.reg,tai(hp2.Next))) and
+                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg,p,hp2)) then
+                    begin
+                      DebugMsg('LdStOp2LdOp', p);
+
+                      alloc:=FindRegAllocBackward(taicpu(hp1).oper[0]^.reg, tai(hp1.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(hp1).oper[0]^.reg,tai(hp2.next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.free;
+
+                          asml.Remove(dealloc);
+                          dealloc.free;
+                        end;
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      taicpu(hp2).oper[0]^.reg:=taicpu(p).oper[0]^.reg;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      ld rx
+                      stX *
+                      ld rx
+                    into
+                      ld rx
+                      stX *
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_STB,A_STH,A_STW]) and
+                     (taicpu(hp1).ops=1) and
+                     GetNextInstruction(hp1,hp2) and
+                     (hp2.typ=ait_instruction) and
+                     (taicpu(hp2).opcode=A_LD) and
+                     (taicpu(hp2).ops=1) and
+                     (taicpu(hp2).oper[0]^.typ=top_reg) and
+                     (taicpu(hp2).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                    begin
+                      DebugMsg('LdStxLd2LdStx', p);
+
+                      asml.remove(hp2);
+                      hp2.free;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      ld 0
+                    into
+                      nul
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_const) and
+                     (taicpu(p).oper[0]^.val=0) then
+                    begin
+                      DebugMsg('Ld2Nul', p);
+
+                      taicpu(p).ops:=0;
+                      taicpu(p).opcode:=A_NUL;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      ld rX
+                      ss 6
+                      ...
+                      gs 6
+                    into
+                      ...
+                      ld rX
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_SS) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_const) and
+                     (taicpu(hp1).oper[0]^.val=6) then
+                    begin
+                      hp2:=hp1;
+
+                      for i:=0 to 4 do
+                        begin
+                          if not GetNextInstruction(hp2,hp2) then
+                            exit;
+
+                          if (hp2.typ=ait_instruction) and
+                             taicpu(hp2).is_jmp then
+                            exit;
+
+                          if (hp2.typ=ait_instruction) and
+                             (taicpu(hp2).opcode=A_GS) and
+                             (taicpu(hp2).ops=1) and
+                             (taicpu(hp2).oper[0]^.typ=top_const) and
+                             (taicpu(hp2).oper[0]^.val=6) then
+                            begin
+                              DebugMsg('LdSS6_2_...Ld', p);
+
+                              if RegModifiedBetween(taicpu(p).oper[0]^.reg,hp1,hp2) then
+                                exit;
+
+                              asml.Remove(p);
+                              asml.InsertAfter(p,hp2);
+
+                              asml.Remove(hp2);
+                              hp2.Free;
+
+                              GetNextInstruction(hp1,p);
+
+                              asml.Remove(hp1);
+                              hp1.Free;
+
+                              result:=true;
+
+                              break;
+                            end;
+                        end;
+                    end;
+                end;
+              A_ST:
+                begin
+                  {
+                    turn
+                      st rx
+                      ld rx
+                      dealloc rx
+                    into
+                      ...
+                  }
+                  if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     SkipMarkers(hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_LD) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.next))) then
+                    begin
+                      DebugMsg('StLd2*', p);
+
+                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg, tai(p.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.free;
+
+                          asml.Remove(dealloc);
+                          dealloc.free;
+                        end;
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      GetNextInstruction(p,hp1);
+                      AsmL.Remove(p);
+                      p.free;
+                      p:=hp1;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      st rx
+                      ld rx
+                    into
+                      st rx
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     SkipMarkers(hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_LD) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                    begin
+                      DebugMsg('StLd2St', p);
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      st rx
+                      st rx
+                    into
+                      st rx
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     SkipMarkers(hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_ST) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                    begin
+                      DebugMsg('StSt2St', p);
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      st rx
+                      ...
+                      st rx
+                    into
+                      st rx
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+                     SkipMarkers(hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_ST) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg,p,hp1)) and
+                     (not RegUsedBetween(taicpu(p).oper[0]^.reg,p,hp1)) then
+                    begin
+                      DebugMsg('St...St2...St', p);
+
+                      GetNextInstruction(p,hp1);
+                      AsmL.Remove(p);
+                      p.free;
+                      p:=hp1;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      st rx
+                      nul
+                      ldw rx
+                      dealloc rx
+                    into
+                      ldw 0
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_NUL) and
+                     GetNextInstruction(hp1,hp2) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp2).opcode=A_LDW) and
+                     (taicpu(hp2).ops=1) and
+                     (taicpu(hp2).oper[0]^.typ=top_reg) and
+                     (taicpu(hp2).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                     Assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.next))) then
+                    begin
+                      DebugMsg('StNulLdw2Ldw', p);
+
+                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg, tai(p.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.free;
+
+                          asml.Remove(dealloc);
+                          dealloc.free;
+                        end;
+
+                      AsmL.Remove(p);
+                      p.free;
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      taicpu(hp2).loadconst(0,0);
+                      p:=taicpu(hp2);
+
+                      if p.Previous<>nil then
+                        p:=tai(p.Previous); // try to enable some extra optimizations
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      st rx
+                      ld ry
+                      [dealloc ry]
+                      op rx
+                      dealloc rx
+                    into
+                      op ry
+                      [dealloc ry]
+                  }
+                  else if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     SkipMarkers(hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_LD) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(hp1,hp2) and
+                     SkipMarkers(hp2) and
+                     (hp2.typ=ait_instruction) and
+                     (taicpu(hp2).opcode in [A_ADD,A_ADC,A_MUL,
+                                             A_AND,A_ORR,A_XOR]) and
+                     (taicpu(hp2).ops=1) and
+                     (taicpu(hp2).oper[0]^.typ=top_reg) and
+                     (taicpu(hp2).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.next))) then
+                    begin
+                      DebugMsg('StLdOp2Op', p);
+
+                      dealloc:=FindRegDeAlloc(taicpu(hp1).oper[0]^.reg,tai(hp1.next));
+                      if assigned(dealloc) then
+                        begin
+                          asml.Remove(dealloc);
+                          asml.InsertAfter(dealloc,hp2);
+                        end;
+
+                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg, tai(p.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.free;
+
+                          asml.Remove(dealloc);
+                          dealloc.free;
+                        end;
+
+                      taicpu(hp2).oper[0]^.reg:=taicpu(hp1).oper[0]^.reg;
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      AsmL.Remove(p);
+                      p.free;
+
+                      p:=hp2;
+
+                      result:=true;
+                    end;
+                end;
+              A_GS:
+                begin
+                  {
+                    turn
+                      gs pc
+                      j...
+                      gs pc
+                      ...
+                    into
+                      gs pc
+                      j...
+                      ...
+                  }
+                  if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_const) and
+                     (taicpu(p).oper[0]^.val=SS_PC) then
+                    begin
+                      hp1:=p;
+
+                      {while GetNextInstruction(hp1,hp2) and
+                            (hp2.typ=ait_instruction) and
+                            (taicpu(hp2).is_jmp) do
+                        begin
+                          if GetNextInstruction(hp2,hp3) and
+                             (hp3.typ=ait_instruction) and
+                             (taicpu(hp3).opcode=A_GS) and
+                             (taicpu(hp3).ops=1) and
+                             (taicpu(hp3).oper[0]^.typ=top_const) and
+                             (taicpu(hp3).oper[0]^.val=SS_PC) then
+                            begin
+                              DebugMsg('GsJGs2GsJ', hp1);
+
+                              asml.Remove(hp3);
+                              hp3.free;
+
+
+
+                              result:=true;
+                            end
+                          else
+                            break;
+
+                          hp1:=hp2;
+                        end;}
+                    end;
+                end;
+              A_SS:
+                begin
+                  {
+                    turn
+                      ss 6
+                      ...
+                      gs 6
+                      ld rX
+                    into
+                      ...
+                      ld rX
+                  }
+                  if (taicpu(p).opcode=A_SS) and
+                     (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_const) and
+                     (taicpu(p).oper[0]^.val=6) then
+                    begin
+                      hp1:=p;
+                      hp2:=p;
+
+                      for i:=0 to 4 do
+                        begin
+                          if not GetNextInstruction(hp2,hp2) then
+                            exit;
+
+                          if (hp2.typ=ait_instruction) and
+                             taicpu(hp2).is_jmp then
+                            exit;
+
+                          if (hp2.typ=ait_instruction) and
+                             (taicpu(hp2).opcode=A_GS) and
+                             (taicpu(hp2).ops=1) and
+                             (taicpu(hp2).oper[0]^.typ=top_const) and
+                             (taicpu(hp2).oper[0]^.val=6) then
+                            begin
+                              if not GetNextInstruction(hp2,p) then
+                                exit;
+
+                              if (p.typ=ait_instruction) and
+                                 (taicpu(p).opcode in [A_LD,A_NUL,A_GS]) then
+                                begin
+                                  DebugMsg('Ss6 Removal', p);
+
+                                  GetNextInstruction(hp1,p);
+
+                                  asml.Remove(hp2);
+                                  hp2.Free;
+
+                                  asml.Remove(hp1);
+                                  hp1.Free;
+
+                                  result:=true;
+                                end;
+
+                              break;
+
+                              {if RegModifiedBetween(taicpu(p).oper[0]^.reg,hp1,hp2) then
+                                exit;
+
+                              asml.Remove(p);
+                              asml.InsertAfter(p,hp2);
+
+                              asml.Remove(hp2);
+                              hp2.Free;
+
+                              GetNextInstruction(hp1,p);
+
+                              asml.Remove(hp1);
+                              hp1.Free;
+
+                              break;}
+                            end;
+                        end;
+                    end;
+                end;
+              A_ADD:
+                begin
+                  if (taicpu(p).ops=1) and
+                     (taicpu(p).oper[0]^.typ=top_reg) and
+                     GetNextInstruction(p,hp1) and
+                     (taicpu(hp1).opcode in [A_LDW,A_LDH,A_LDB]) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_const) and
+                     (taicpu(hp1).oper[0]^.val=0) then
+                    begin
+                      DebugMsg('AddLdw2Ldw', p);
+
+                      taicpu(hp1).loadreg(0,taicpu(p).oper[0]^.reg);
+
+                      asml.remove(p);
+                      p.free;
+
+                      p:=hp1;
+
+                      result:=true;
+                    end;
+                end;
+              A_MOV:
+                begin
+                  {
+                    turn
+                      mov rx,ry
+                    info
+                      ld ry
+                      st rx
+                  }
+
+                  dealloc:=FindRegDeAlloc(taicpu(p).oper[1]^.reg,tai(p.next));
+
+                  hp1:=taicpu.op_reg(A_ST,taicpu(p).oper[0]^.reg);
+
+                  if assigned(dealloc) then
+                    AsmL.InsertAfter(hp1, dealloc)
+                  else
+                    AsmL.InsertAfter(hp1, p);
+
+                  taicpu(p).loadreg(0,taicpu(p).oper[1]^.reg);
+                  taicpu(p).ops:=1;
+                  taicpu(p).opcode:=A_LD;
+
+                  result:=true;
+                end;
+              A_NUL:
+                begin
+                  {
+                    turn
+                      nul
+                      alloc ry
+                      st ry
+                      ...
+                      op ry
+                      dealloc ry
+                    into
+                      ...
+                      op 0
+                  }
+                  if GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode=A_ST) and
+                     (taicpu(hp1).ops=1) and
+                     (taicpu(hp1).oper[0]^.typ=top_reg) and
+                     GetNextInstructionUsingReg(hp1,hp2,taicpu(hp1).oper[0]^.reg) and
+                     (hp2.typ=ait_instruction) and
+                     (taicpu(hp2).ops=1) and
+                     (taicpu(hp2).opcode<>A_ST) and
+                     (taicpu(hp2).oper[0]^.typ=top_reg) and
+                     (taicpu(hp2).oper[0]^.reg=taicpu(hp1).oper[0]^.reg) and
+                     assigned(FindRegDeAlloc(taicpu(hp1).oper[0]^.reg,tai(hp2.Next))) then
+                    begin
+                      alloc:=FindRegAllocBackward(taicpu(hp1).oper[0]^.reg, tai(hp1.Previous));
+                      dealloc:=FindRegDeAlloc(taicpu(hp1).oper[0]^.reg,tai(hp2.next));
+
+                      if assigned(alloc) and assigned(dealloc) then
+                        begin
+                          asml.Remove(alloc);
+                          alloc.free;
+
+                          asml.Remove(dealloc);
+                          dealloc.free;
+                        end;
+
+                      AsmL.Remove(hp1);
+                      hp1.free;
+
+                      taicpu(hp2).loadconst(0,0);
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      nul
+                      ld/nul
+                    into
+                      ld/nul
+                  }
+                  else if GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_NUL,A_LD]) then
+                    begin
+                      asml.remove(p);
+                      p.free;
+                      p:=hp1;
+
+                      result:=true;
+                    end
+                  {
+                    turn
+                      nul
+                      add *
+                    into
+                      ld *
+                  }
+                  else if GetNextInstruction(p,hp1) and
+                     (hp1.typ=ait_instruction) and
+                     (taicpu(hp1).opcode in [A_ADD]) then
+                    begin
+                      asml.remove(p);
+                      p.free;
+                      p:=hp1;
+
+                      taicpu(p).opcode:=A_LD;
+
+                      result:=true;
+                    end;
+                end;
+              A_LOAD:
+                begin
+                  {
+                    ss 6
+                    ld ref.offset
+                    add ref.index
+                    ldw ref.base
+                    st reg
+                    gs 6
+
+                    ss 6
+                    ld ref.offset
+                    ldw ref.base
+                    st reg
+                    gs 6
+                  }
+                  if GetNextInstruction(p,hp1) and
+                     (tai(hp1).typ=ait_instruction) and
+                     (not (taicpu(hp1).opcode in [A_LD,A_NUL,A_GS])) then
+                    begin
+                      AsmL.InsertBefore(taicpu.op_const(A_SS,6),p);
+                      AsmL.InsertAfter(taicpu.op_const(A_GS,6),p);
+                    end;
+
+                  AsmL.InsertAfter(taicpu.op_reg(A_ST,taicpu(p).oper[0]^.reg),p);
+                  AsmL.InsertAfter(taicpu.op_reg(A_LDW,taicpu(p).oper[1]^.ref^.base),p);
+
+                  if taicpu(p).oper[1]^.ref^.index<>NR_NO then
+                    AsmL.InsertAfter(taicpu.op_reg(A_ADD,taicpu(p).oper[1]^.ref^.index),p);
+
+                  taicpu(p).opcode:=A_LD;
+                  taicpu(p).loadconst(0, taicpu(p).oper[1]^.ref^.offset);
+                  taicpu(p).ops:=1;
+
+                  result:=true;
+                end;
+              A_STORE:
+                begin
+                  {
+                    ss 6
+                    ld ref.offset
+                    add ref.index
+                    add ref.base
+                    stw reg
+                    gs 6
+                  }
+                  if GetNextInstruction(p,hp1) and
+                     (tai(hp1).typ=ait_instruction) and
+                     (not (taicpu(hp1).opcode in [A_LD,A_NUL,A_GS])) then
+                    begin
+                      AsmL.InsertBefore(taicpu.op_const(A_SS,6),p);
+                      AsmL.InsertAfter(taicpu.op_const(A_GS,6),p);
+                    end;
+                  //AsmL.InsertBefore(taicpu.op_const(A_SS,6),p);
+                  //AsmL.InsertAfter(taicpu.op_const(A_GS,6),p);
+
+                  AsmL.InsertAfter(taicpu.op_reg(A_STW,taicpu(p).oper[0]^.reg),p);
+                  AsmL.InsertAfter(taicpu.op_reg(A_ADD,taicpu(p).oper[1]^.ref^.base),p);
+
+                  if taicpu(p).oper[1]^.ref^.index<>NR_NO then
+                    AsmL.InsertAfter(taicpu.op_reg(A_ADD,taicpu(p).oper[1]^.ref^.index),p);
+
+                  taicpu(p).opcode:=A_LD;
+                  taicpu(p).loadconst(0, taicpu(p).oper[1]^.ref^.offset);
+                  taicpu(p).ops:=1;
+
+                  result:=true;
+                end;
+            end;
+          end;
+      end;
+    end;
+
+
+  procedure TCpuAsmOptimizer.PeepHoleOptPass2;
+    begin
+    end;
+
+begin
+  casmoptimizer:=TCpuAsmOptimizer;
+End.

compiler/spc32/aoptcpub.pas

@@ -0,0 +1,132 @@
+ {
+    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains several types and constants necessary for the
+    optimizer to work on the SPC32 architecture
+
+    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.
+
+ ****************************************************************************
+}
+Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
+
+{$i fpcdefs.inc}
+
+{ enable the following define if memory references can have a scaled index }
+{ define RefsHaveScale}
+
+{ enable the following define if memory references can have a segment }
+{ override                                                            }
+
+{ define RefsHaveSegment}
+
+Interface
+
+Uses
+  cpubase,
+  cgbase,
+  aasmcpu,aasmtai,
+  AOptBase;
+
+Type
+
+{ type of a normal instruction }
+  TInstr = Taicpu;
+  PInstr = ^TInstr;
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+{ Info about the conditional registers                                      }
+  TCondRegs = Object
+    Constructor Init;
+    Destructor Done;
+  End;
+
+{ ************************************************************************* }
+{ **************************** TAoptBaseCpu ******************************* }
+{ ************************************************************************* }
+
+  TAoptBaseCpu = class(TAoptBase)
+    function RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean; override;
+  End;
+
+
+{ ************************************************************************* }
+{ ******************************* Constants ******************************* }
+{ ************************************************************************* }
+Const
+
+{ the maximum number of things (registers, memory, ...) a single instruction }
+{ changes                                                                    }
+
+  MaxCh = 1;
+
+{ the maximum number of operands an instruction has }
+
+  MaxOps = 2;
+
+{Oper index of operand that contains the source (reference) with a load }
+{instruction                                                            }
+
+  LoadSrc = 1;
+
+{Oper index of operand that contains the destination (register) with a load }
+{instruction                                                                }
+
+  LoadDst = 0;
+
+{Oper index of operand that contains the source (register) with a store }
+{instruction                                                            }
+
+  StoreSrc = 0;
+
+{Oper index of operand that contains the destination (reference) with a load }
+{instruction                                                                 }
+
+  StoreDst = 1;
+
+  aopt_uncondjmp = A_JMP;
+  aopt_condjmp = A_Jxx;
+
+Implementation
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+  Constructor TCondRegs.init;
+    Begin
+    End;
+
+  Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
+    Begin
+    End;
+
+
+  function TAoptBaseCpu.RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean;
+    var
+      i : Longint;
+    begin
+      result:=false;
+      for i:=0 to taicpu(p1).ops-1 do
+        if (taicpu(p1).oper[i]^.typ=top_reg) and (taicpu(p1).oper[i]^.reg=Reg) and (taicpu(p1).spilling_get_operation_type(i) in [operand_write,operand_readwrite]) then
+          begin
+            result:=true;
+            exit;
+          end;
+    end;
+
+End.

compiler/spc32/aoptcpud.pas

@@ -0,0 +1,40 @@
+{
+    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the processor specific implementation of the
+    assembler optimizer data flow analyzer.
+
+    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.
+
+ ****************************************************************************
+}
+Unit aoptcpud;
+
+{$i fpcdefs.inc}
+
+Interface
+
+uses
+  AOptDA;
+
+Type
+  TAOptDFACpu = class(TAOptDFA)
+  End;
+
+Implementation
+
+
+End.

compiler/spc32/cgcpu.pas

@@ -0,0 +1,1605 @@
+{
+
+    Copyright (c) 2008 by Florian Klaempfl
+    Member of the Free Pascal development team
+
+    This unit implements the code generator for the SPC32
+
+    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.
+
+ ****************************************************************************
+}
+unit cgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       globtype,symtype,symdef,
+       cgbase,cgutils,cgobj,
+       aasmbase,aasmcpu,aasmtai,aasmdata,
+       parabase,
+       cpubase,cpuinfo,node,cg64f32,rgcpu;
+
+    type
+
+      { tcgspc32 }
+
+      tcgspc32 = class(tcg)
+        { true, if the next arithmetic operation should modify the flags }
+        cgsetflags : boolean;
+        procedure init_register_allocators;override;
+        procedure done_register_allocators;override;
+
+        function getaddressregister(list:TAsmList):TRegister;override;
+        function getfpuregister(list:TAsmList;size:Tcgsize):TRegister;override;
+
+        procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
+        procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
+        procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
+        procedure a_load_reg_cgpara(list : TAsmList; size : tcgsize;r : tregister; const cgpara : tcgpara);override;
+
+        procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
+        procedure a_call_reg(list : TAsmList;reg: tregister);override;
+
+        procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
+        procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); override;
+
+        procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); override;
+        procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); override;
+
+        { move instructions }
+        procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override;
+        procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
+        procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
+        procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
+
+        { fpu move instructions }
+        procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
+        procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
+        procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
+
+        {  comparison operations }
+        procedure a_cmp_const_reg_label(list: TAsmList; size: tcgsize; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
+        procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
+
+        procedure a_jmp_name(list : TAsmList;const s : string); override;
+        procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
+        procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
+
+        procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
+
+        procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
+        procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override;
+
+        procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
+
+        procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
+        procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
+
+        procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override;
+
+        procedure g_save_registers(list : TAsmList);override;
+        procedure g_restore_registers(list : TAsmList);override;
+
+        procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
+        procedure fixref(list : TAsmList;var ref : treference);
+        function normalize_ref(list : TAsmList;ref : treference) : treference;
+
+        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+        procedure g_stackpointer_alloc(list : TAsmList;size : longint);override;
+
+        procedure a_adjust_sp(list: TAsmList; value: longint);
+
+        procedure call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
+        procedure call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
+
+        procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
+      end;
+
+      tcg64fspc32 = class(tcg64f32)
+        procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override;
+        procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
+      end;
+
+    procedure create_codegen;
+
+    const
+      TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_None,A_None,A_ADD,A_AND,A_None,
+                                             A_None,A_MUL,A_None,A_None,A_None,A_ORR,
+                                             A_ASR,A_LSL,A_LSR,A_SUB,A_XOR,A_None,A_None);
+  implementation
+
+    uses
+       globals,verbose,systems,cutils,
+       fmodule,
+       symconst,symsym,symtable,
+       tgobj,rgobj,
+       procinfo,cpupi,
+       paramgr;
+
+
+    procedure tcgspc32.init_register_allocators;
+      begin
+        inherited init_register_allocators;
+        rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
+            [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5],first_int_imreg,[]);
+        { rg[R_ADDRESSREGISTER]:=trgintcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
+            [RS_R26,RS_R30],first_int_imreg,[]); }
+      end;
+
+
+    procedure tcgspc32.done_register_allocators;
+      begin
+        rg[R_INTREGISTER].free;
+        // rg[R_ADDRESSREGISTER].free;
+        inherited done_register_allocators;
+      end;
+
+
+    function tcgspc32.getaddressregister(list: TAsmList): TRegister;
+      begin
+        Result:=getintregister(list,OS_ADDR);
+      end;
+
+
+    function tcgspc32.getfpuregister(list:TAsmList;size:Tcgsize): TRegister;
+      begin
+        case size of
+          OS_F32:
+            Result:=getintregister(list,OS_32);
+          OS_F64:
+            Result:=getintregister(list,OS_64);
+          else
+            internalerror(2014041704);
+        end;
+      end;
+
+
+    procedure tcgspc32.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
+
+      procedure load_para_loc(r : TRegister;paraloc : PCGParaLocation);
+        var
+          ref : treference;
+        begin
+          paramanager.allocparaloc(list,paraloc);
+          case paraloc^.loc of
+             LOC_REGISTER,LOC_CREGISTER:
+               a_load_reg_reg(list,paraloc^.size,paraloc^.size,r,paraloc^.register);
+             LOC_REFERENCE,LOC_CREFERENCE:
+               begin
+                  reference_reset_base(ref,paraloc^.reference.index,paraloc^.reference.offset,4);
+                  a_load_reg_ref(list,paraloc^.size,paraloc^.size,r,ref);
+               end;
+             else
+               internalerror(2002071004);
+          end;
+        end;
+
+      var
+        i, i2 : longint;
+        hp : PCGParaLocation;
+
+      begin
+        {if use_push(cgpara) then
+          begin
+            if tcgsize2size[cgpara.Size] > 2 then
+              begin
+                if tcgsize2size[cgpara.Size] <> 4 then
+                  internalerror(2013031101);
+                if cgpara.location^.Next = nil then
+                  begin
+                    if tcgsize2size[cgpara.location^.size] <> 4 then
+                      internalerror(2013031101);
+                  end
+                else
+                  begin
+                    if tcgsize2size[cgpara.location^.size] <> 2 then
+                      internalerror(2013031101);
+                    if tcgsize2size[cgpara.location^.Next^.size] <> 2 then
+                      internalerror(2013031101);
+                    if cgpara.location^.Next^.Next <> nil then
+                      internalerror(2013031101);
+                  end;
+
+                if tcgsize2size[cgpara.size]>cgpara.alignment then
+                  pushsize:=cgpara.size
+                else
+                  pushsize:=int_cgsize(cgpara.alignment);
+                pushsize2 := int_cgsize(tcgsize2size[pushsize] - 2);
+                list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize2],makeregsize(list,GetNextReg(r),pushsize2)));
+                list.concat(taicpu.op_reg(A_PUSH,S_W,makeregsize(list,r,OS_16)));
+              end
+            else
+              begin
+                cgpara.check_simple_location;
+                if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
+                  pushsize:=cgpara.location^.size
+                else
+                  pushsize:=int_cgsize(cgpara.alignment);
+                list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],makeregsize(list,r,pushsize)));
+              end;
+
+          end
+        else}
+          begin
+            if not(tcgsize2size[cgpara.Size] in [1..4]) then
+              internalerror(2014011101);
+
+            hp:=cgpara.location;
+
+            i:=0;
+            while i<tcgsize2size[cgpara.Size] do
+              begin
+                if not(assigned(hp)) then
+                  internalerror(2014011102);
+
+                inc(i, tcgsize2size[hp^.Size]);
+
+                if hp^.Loc=LOC_REGISTER then
+                  begin
+                    load_para_loc(r,hp);
+                    hp:=hp^.Next;
+                    r:=GetNextReg(r);
+                  end
+                else
+                  begin
+                    load_para_loc(r,hp);
+
+                    for i2:=1 to tcgsize2size[hp^.Size] do
+                      r:=GetNextReg(r);
+
+                    hp:=hp^.Next;
+                  end;
+              end;
+            if assigned(hp) then
+              internalerror(2014011103);
+          end;
+      end;
+
+
+    procedure tcgspc32.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);
+      var
+        i : longint;
+        hp : PCGParaLocation;
+        val : tcgint;
+      begin
+        paraloc.check_simple_location;
+        if not(tcgsize2size[paraloc.Size] in [1..4]) then
+          internalerror(2014011101);
+
+        hp:=paraloc.location;
+
+        i:=0;
+        while i < tcgsize2size[paraloc.Size] do
+          begin
+            val:=a shr (i*8);
+
+            case tcgsize2size[hp^.size] of
+              1: val:=val and $FF;
+              2: val:=val and $FFFF;
+              4: val:=val and $FFFFFFFF;
+            end;
+
+            case hp^.loc of
+              LOC_REGISTER,LOC_CREGISTER:
+                a_load_const_reg(list,hp^.size,val,hp^.register);
+              LOC_REFERENCE,LOC_CREFERENCE:
+                begin
+                  list.concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+
+                  if ((val and $7FFF)=val) or
+                     (((-val) and $7FFF)=-val) then
+                    begin
+                      list.concat(taicpu.op_const(A_SUB,4));
+                      list.concat(taicpu.op_const(A_STW,val));
+                    end
+                  else
+                    begin
+                      list.concat(taicpu.op_const(A_SUB,2));
+                      list.concat(taicpu.op_const(A_STH,val and $FFFF));
+                      list.concat(taicpu.op_const(A_SUB,2));
+                      list.concat(taicpu.op_const(A_STH,val shr 16));
+                    end;
+
+                  list.concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+                end
+                //list.concat(taicpu.op_const(A_PUSH,a));
+              else
+                internalerror(2002071004);
+            end;
+            inc(i, tcgsize2size[hp^.size]);
+            hp:=hp^.Next;
+          end;
+        if assigned(hp) then
+          internalerror(2014011104);
+      end;
+
+
+    procedure tcgspc32.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
+      var
+        tmpref, ref: treference;
+        location: pcgparalocation;
+        sizeleft: tcgint;
+      begin
+        location := paraloc.location;
+        tmpref := r;
+        sizeleft := paraloc.intsize;
+        while assigned(location) do
+          begin
+            paramanager.allocparaloc(list,location);
+            case location^.loc of
+              LOC_REGISTER,LOC_CREGISTER:
+                a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
+              LOC_REFERENCE:
+                begin
+                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,paraloc.alignment);
+                  { doubles in softemu mode have a strange order of registers and references }
+                  if location^.size=OS_32 then
+                    g_concatcopy(list,tmpref,ref,4)
+                  else
+                    begin
+                      g_concatcopy(list,tmpref,ref,sizeleft);
+                      if assigned(location^.next) then
+                        internalerror(2005010710);
+                    end;
+                end;
+              LOC_VOID:
+                begin
+                  // nothing to do
+                end;
+              else
+                internalerror(2002081103);
+            end;
+            inc(tmpref.offset,tcgsize2size[location^.size]);
+            dec(sizeleft,tcgsize2size[location^.size]);
+            location := location^.next;
+          end;
+      end;
+
+
+    procedure tcgspc32.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);
+      var
+        tmpreg: tregister;
+      begin
+        tmpreg:=getaddressregister(list);
+        a_loadaddr_ref_reg(list,r,tmpreg);
+        a_load_reg_cgpara(list,OS_ADDR,tmpreg,paraloc);
+      end;
+
+
+    procedure tcgspc32.a_call_name(list : TAsmList;const s : string; weak: boolean);
+      begin
+        list.concat(taicpu.op_const(A_GS, SS_PC));
+        list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)));
+{
+        the compiler does not properly set this flag anymore in pass 1, and
+        for now we only need it after pass 2 (I hope) (JM)
+          if not(pi_do_call in current_procinfo.flags) then
+            internalerror(2003060703);
+}
+        include(current_procinfo.flags,pi_do_call);
+      end;
+
+
+    procedure tcgspc32.a_call_reg(list : TAsmList;reg: tregister);
+      begin
+        {a_reg_alloc(list,NR_ZLO);
+        a_reg_alloc(list,NR_ZHI);
+        list.concat(taicpu.op_reg_reg(A_MOV,NR_ZLO,reg));
+        list.concat(taicpu.op_reg_reg(A_MOV,NR_ZHI,GetHigh(reg)));
+        list.concat(taicpu.op_none(A_ICALL));
+        a_reg_dealloc(list,NR_ZLO);
+        a_reg_dealloc(list,NR_ZHI);}
+
+        list.concat(taicpu.op_reg(A_CALL,reg));
+
+        include(current_procinfo.flags,pi_do_call);
+      end;
+
+
+     procedure tcgspc32.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister);
+       var
+         tmpreg: TRegister;
+       begin
+         if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then
+           internalerror(2012102403);
+
+         a_op_const_reg_reg(list,op,size,a,reg,reg);
+       end;
+
+
+     procedure tcgspc32.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister);
+       begin
+         case op of
+           OP_NEG:
+             begin
+               list.concat(taicpu.op_none(A_NUL));
+               list.concat(taicpu.op_reg(A_SUB,src));
+               list.concat(taicpu.op_reg(A_ST,dst));
+             end;
+           OP_NOT:
+             a_op_const_reg_reg(list,OP_XOR,size,-1,src,dst);
+           else
+             a_op_reg_reg_reg(list,op,size,src,dst,dst);
+         end;
+       end;
+
+
+    procedure tcgspc32.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister);
+      var
+        tmpreg: TRegister;
+        power: longint;
+      begin
+        if (op in [OP_MUL,OP_IMUL]) and (not ispowerof2(a, power)) then
+          begin
+            a_load_reg_reg(list,size,size,src,dst);
+
+            if op = OP_MUL then
+              call_rtl_mul_const_reg(list, size, a, dst,'fpc_mul_dword')
+            else
+              call_rtl_mul_const_reg(list, size, a, dst,'fpc_mul_longint');
+
+            exit;
+          end
+        else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a, power) then
+          begin
+            op:=OP_SHL;
+            a:=power;
+          end;
+
+        if ((a and $7FFF) = a) or
+           (((-a) and $7FFF) = -a) then
+          begin
+            list.concat(taicpu.op_reg(A_LD,src));
+            list.concat(taicpu.op_const(TOpCG2AsmOp[Op],a));
+            list.concat(taicpu.op_reg(A_ST,dst));
+          end
+        else
+          begin
+            tmpreg:=getintregister(list,OS_INT);
+            a_load_const_reg(list,OS_INT,a,tmpreg);
+            a_op_reg_reg_reg(list,OP,size,tmpreg,src,dst);
+          end;
+      end;
+
+
+    procedure tcgspc32.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
+      begin
+        if op in [OP_MUL,OP_IMUL] then
+          begin
+            a_load_reg_reg(list,size,size,src2,dst);
+
+            if op = OP_MUL then
+              call_rtl_mul_reg_reg(list, src1, dst,'fpc_mul_dword')
+            else
+              call_rtl_mul_reg_reg(list, src1, dst,'fpc_mul_longint');
+          end
+        else
+          begin
+            list.concat(taicpu.op_reg(A_LD,src2));
+            list.concat(taicpu.op_reg(TOpCG2AsmOp[Op],src1));
+            list.concat(taicpu.op_reg(A_ST,dst));
+          end;
+      end;
+
+
+    procedure tcgspc32.a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);
+      var
+        mask : qword;
+        shift : byte;
+        i : byte;
+        lab,
+        dst: tasmlabel;
+      begin
+        if a = 0 then
+          list.concat(taicpu.op_none(A_NUL))
+        else if (a and $7FFF) = a then
+          list.concat(taicpu.op_const(A_LD, a))
+        else if ((-a) and $7FFF) = -a then
+          list.concat(taicpu.op_const(A_LD, a))
+        else
+          begin
+            list.concat(taicpu.op_const(A_LD,a and $FFFF));
+            list.concat(taicpu.op_const(A_LDU,(a shr 16) and $FFFF));
+          end;
+        list.concat(taicpu.op_reg(A_ST,reg));
+      end;
+
+
+    function tcgspc32.normalize_ref(list:TAsmList;ref: treference) : treference;
+      var
+        tmpref : treference;
+        tmpreg : tregister;
+        l : tasmlabel;
+      begin
+        Result:=ref;
+
+        if (result.base=NR_NO) and
+           (result.index<>NR_NO) then
+          begin
+            result.base:=result.index;
+            result.index:=NR_NO;
+          end;
+
+        if (result.base<>NR_NO) and
+           (result.index<>NR_NO) then
+          begin
+            tmpreg:=getaddressregister(list);
+            a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,result.base,result.index,tmpreg);
+            result.base:=tmpreg;
+            result.index:=NR_NO;
+          end;
+
+        if assigned(result.symbol) then
+          begin
+            tmpreg:=getaddressregister(list);
+
+            result.refaddr:=addr_lo16;
+            list.concat(taicpu.op_ref(A_LD,Result));
+            result.refaddr:=addr_hi16;
+            list.concat(taicpu.op_ref(A_LDU,Result));
+
+            if result.base<>NR_NO then
+              list.concat(taicpu.op_reg(A_ADD,result.base));
+
+            list.concat(taicpu.op_reg(A_ST,tmpreg));
+
+            reference_reset_base(result,tmpreg,0,ref.alignment);
+          end;
+
+        if (result.offset<-32767) or (Result.offset>32767) then
+          begin
+            tmpreg:=getaddressregister(list);
+
+            if result.base<>NR_NO then
+              a_op_const_reg_reg(list,OP_ADD,OS_ADDR,result.offset,result.base,tmpreg)
+            else
+              a_load_const_reg(list,OS_ADDR,result.offset,tmpreg);
+
+            result.base:=tmpreg;
+            result.offset:=0;
+          end;
+      end;
+
+
+     procedure tcgspc32.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
+       var
+         href : treference;
+         conv_done: boolean;
+         tmpreg : tregister;
+         i : integer;
+         QuickRef : Boolean;
+         SizeCode: TAsmOp;
+       begin
+         case tosize of
+           OS_S8,OS_8: SizeCode:=A_STB;
+           OS_S16,OS_16: SizeCode:=A_STH;
+           OS_S32,OS_32: SizeCode:=A_STW;
+         end;
+
+         href:=normalize_ref(list,ref);
+
+         if (href.offset<>0) and
+            (href.base<>NR_NO) then
+           begin
+             tmpreg:=getaddressregister(list);
+             a_op_const_reg_reg(list,OP_ADD,OS_ADDR,href.offset,href.base,tmpreg);
+
+             href.base:=tmpreg;
+             href.offset:=0
+           end;
+
+         if assigned(href.symbol) then
+           begin
+             tmpreg:=href.base;
+             href.base:=NR_NO;
+
+             href.refaddr:=addr_lo16;
+             list.concat(taicpu.op_ref(A_LD,href));
+             href.refaddr:=addr_hi16;
+             list.concat(taicpu.op_ref(A_LDU,href));
+
+             if tmpreg<>NR_NO then
+               list.concat(taicpu.op_reg(A_ADD,tmpreg));
+           end
+         else if href.base<>NR_NO then
+           list.concat(taicpu.op_reg(A_LD,href.base))
+         else
+           internalerror(2014032001);
+
+         list.concat(taicpu.op_reg(SizeCode,reg));
+       end;
+
+
+     procedure tcgspc32.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;
+       const Ref : treference;reg : tregister);
+       var
+         href : treference;
+         conv_done: boolean;
+         tmpreg : tregister;
+         i : integer;
+         QuickRef : boolean;
+         SizeCode: TAsmOp;
+       begin
+         case fromsize of
+           OS_S8,OS_8: SizeCode:=A_LDB;
+           OS_S16,OS_16: SizeCode:=A_LDH;
+           OS_S32,OS_32: SizeCode:=A_LDW;
+         end;
+
+         href:=normalize_ref(list,ref);
+
+         if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then
+           internalerror(2011021307);
+
+         if assigned(href.symbol) then
+           begin
+             tmpreg:=href.base;
+             href.base:=NR_NO;
+
+             href.refaddr:=addr_lo16;
+             list.concat(taicpu.op_ref(A_LD,href));
+             href.refaddr:=addr_hi16;
+             list.concat(taicpu.op_ref(A_LDU,href));
+
+             if tmpreg<>NR_NO then
+               list.concat(taicpu.op_reg(SizeCode,tmpreg))
+             else
+               list.concat(taicpu.op_const(SizeCode,0));
+           end
+         else if href.offset<>0 then
+           begin
+             list.concat(taicpu.op_reg(A_LD,href.base));
+             list.concat(taicpu.op_const(SizeCode,href.offset));
+           end
+         else
+           begin
+             list.concat(taicpu.op_none(A_NUL));
+             list.concat(taicpu.op_reg(SizeCode,href.base));
+           end;
+
+         list.concat(taicpu.op_reg(A_ST,reg));
+       end;
+
+
+     procedure tcgspc32.a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
+       var
+         ai: taicpu;
+       begin
+         {ai:=taicpu.op_reg(A_LD,reg1);
+         //rg[R_INTREGISTER].add_move_instruction(ai);
+         list.concat(ai);
+         list.concat(taicpu.op_reg(A_ST,reg2));}
+
+         ai:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
+         rg[R_INTREGISTER].add_move_instruction(ai);
+         list.concat(ai);
+       end;
+
+
+     procedure tcgspc32.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister);
+       begin
+         case fromsize of
+           OS_F32: fromsize:=OS_32;
+           OS_F64: fromsize:=OS_64;
+         end;
+
+         case tosize of
+           OS_F32: tosize:=OS_32;
+           OS_F64: tosize:=OS_64;
+         end;
+
+         a_load_reg_reg(list,fromsize,tosize,reg1,reg2);
+       end;
+
+
+     procedure tcgspc32.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister);
+       begin
+         case fromsize of
+           OS_F32: fromsize:=OS_32;
+           OS_F64: fromsize:=OS_64;
+         end;
+
+         case tosize of
+           OS_F32: tosize:=OS_32;
+           OS_F64: tosize:=OS_64;
+         end;
+
+         a_load_ref_reg(list,fromsize,tosize,ref,reg);
+       end;
+
+
+     procedure tcgspc32.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
+       begin
+         case fromsize of
+           OS_F32: fromsize:=OS_32;
+           OS_F64: fromsize:=OS_64;
+         end;
+
+         case tosize of
+           OS_F32: tosize:=OS_32;
+           OS_F64: tosize:=OS_64;
+         end;
+
+         a_load_reg_ref(list,fromsize,tosize,reg,ref);
+       end;
+
+
+    {  comparison operations }
+
+    procedure tcgspc32.a_cmp_const_reg_label(list: TAsmList; size: tcgsize;
+      cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
+      var
+        swapped : boolean;
+        tmpreg : tregister;
+        i : byte;
+      begin
+        if ((a and $7FFF) <> a) and
+           ((-a and $7FFF) <> -a) then
+          begin
+            inherited a_cmp_const_reg_label(list,size,cmp_op,a,reg,l);
+          end
+        else
+          begin
+            swapped:=false;
+            { swap parameters? }
+            case cmp_op of
+              OC_GT:
+                begin
+                  swapped:=true;
+                  cmp_op:=OC_LT;
+                end;
+              OC_GTE:
+                begin
+                  swapped:=true;
+                  cmp_op:=OC_LTE;
+                end;
+              OC_AE:
+                begin
+                  swapped:=true;
+                  cmp_op:=OC_B;
+                end;
+              OC_A:
+                begin
+                  swapped:=true;
+                  cmp_op:=OC_BE;
+                end;
+            end;
+            if swapped then
+              begin
+                list.concat(taicpu.op_const(A_LD,a));
+                a_reg_alloc(list,NR_DEFAULTFLAGS);
+                list.concat(taicpu.op_reg(A_SUB,reg));
+              end
+            else
+              begin
+                list.concat(taicpu.op_reg(A_LD,reg));
+                a_reg_alloc(list,NR_DEFAULTFLAGS);
+                list.concat(taicpu.op_const(A_SUB,a));
+              end;
+
+            a_jmp_cond(list,cmp_op,l);
+            a_reg_dealloc(list,NR_DEFAULTFLAGS);
+          end;
+      end;
+
+
+    procedure tcgspc32.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;
+      cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
+      var
+        swapped : boolean;
+        tmpreg : tregister;
+        i : byte;
+      begin
+        swapped:=false;
+        { swap parameters? }
+        case cmp_op of
+          OC_GT:
+            begin
+              swapped:=true;
+              cmp_op:=OC_LT;
+            end;
+          OC_GTE:
+            begin
+              swapped:=true;
+              cmp_op:=OC_LTE;
+            end;
+          OC_AE:
+            begin
+              swapped:=true;
+              cmp_op:=OC_B;
+            end;
+          OC_A:
+            begin
+              swapped:=true;
+              cmp_op:=OC_BE;
+            end;
+        end;
+        if swapped then
+          begin
+            tmpreg:=reg1;
+            reg1:=reg2;
+            reg2:=tmpreg;
+          end;
+        list.concat(taicpu.op_reg(A_LD,reg2));
+        a_reg_alloc(list,NR_DEFAULTFLAGS);
+        list.concat(taicpu.op_reg(A_SUB,reg1));
+        a_jmp_cond(list,cmp_op,l);
+        a_reg_dealloc(list,NR_DEFAULTFLAGS);
+      end;
+
+
+    procedure tcgspc32.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
+      begin
+        Comment(V_Error,'tcgspc32.a_bit_scan_reg_reg method not implemented');
+      end;
+
+
+    procedure tcgspc32.a_jmp_name(list : TAsmList;const s : string);
+      var
+        ai : taicpu;
+      begin
+        ai:=taicpu.op_sym(A_JMP,current_asmdata.RefAsmSymbol(s));
+        ai.is_jmp:=true;
+        list.Concat(taicpu.op_const(A_GS,SS_PC));
+        list.concat(ai);
+      end;
+
+
+    procedure tcgspc32.a_jmp_always(list : TAsmList;l: tasmlabel);
+      var
+        ai : taicpu;
+      begin
+        ai:=taicpu.op_sym(A_JMP,l);
+        ai.is_jmp:=true;
+        list.Concat(taicpu.op_const(A_GS,SS_PC));
+        list.concat(ai);
+      end;
+
+
+    procedure tcgspc32.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
+      var
+        ai : taicpu;
+      begin
+        ai:=setcondition(taicpu.op_sym(A_Jxx,l),flags_to_cond(f));
+        ai.is_jmp:=true;
+        list.Concat(taicpu.op_const(A_GS,SS_PC));
+        list.concat(ai);
+      end;
+
+
+    procedure tcgspc32.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
+      var
+        l : TAsmLabel;
+        tmpflags : TResFlags;
+      begin
+        current_asmdata.getjumplabel(l);
+        {
+        if flags_to_cond(f) then
+          begin
+            tmpflags:=f;
+            inverse_flags(tmpflags);
+            list.concat(taicpu.op_reg(A_CLR,reg));
+            a_jmp_flags(list,tmpflags,l);
+            list.concat(taicpu.op_reg_const(A_LDI,reg,1));
+          end
+        else
+        }
+          begin
+            list.concat(taicpu.op_const(A_LD,1));
+            list.concat(taicpu.op_reg(A_ST,reg));
+            a_jmp_flags(list,f,l);
+            list.concat(taicpu.op_none(A_NUL));
+            list.concat(taicpu.op_reg(A_ST,reg));
+          end;
+        cg.a_label(list,l);
+      end;
+
+
+    procedure tcgspc32.a_adjust_sp(list : TAsmList; value : longint);
+      var
+        i : integer;
+      begin
+      end;
+
+
+    procedure tcgspc32.call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
+      var
+        paraloc1,paraloc2,paraloc3 : tcgpara;
+        pd : tprocdef;
+      begin
+        pd:=search_system_proc(name);
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pd,1,paraloc1);
+        paramanager.getintparaloc(pd,2,paraloc2);
+        paramanager.getintparaloc(pd,3,paraloc3);
+        a_load_const_cgpara(list,OS_8,0,paraloc3);
+        a_load_const_cgpara(list,size,a,paraloc2);
+        a_load_reg_cgpara(list,OS_32,reg,paraloc1);
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
+        alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        a_call_name(list,name,false);
+        dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+        cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg);
+        paraloc3.done;
+        paraloc2.done;
+        paraloc1.done;
+      end;
+
+
+    procedure tcgspc32.call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
+      var
+        paraloc1,paraloc2,paraloc3 : tcgpara;
+        pd : tprocdef;
+      begin
+       pd:=search_system_proc(name);
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pd,1,paraloc1);
+        paramanager.getintparaloc(pd,2,paraloc2);
+        paramanager.getintparaloc(pd,3,paraloc3);
+        a_load_const_cgpara(list,OS_8,0,paraloc3);
+        a_load_reg_cgpara(list,OS_32,reg1,paraloc2);
+        a_load_reg_cgpara(list,OS_32,reg2,paraloc1);
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
+        alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        a_call_name(list,name,false);
+        dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+        cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg2);
+        paraloc3.done;
+        paraloc2.done;
+        paraloc1.done;
+      end;
+
+
+    procedure tcgspc32.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
+      var
+         regs : tcpuregisterset;
+         reg : tsuperregister;
+         cnt : longint;
+      begin
+        if not(nostackframe) then
+          begin
+            {
+              push #regs
+              ld r6
+              add #123
+              st r5
+              sub #123+4
+              st r6
+              ...
+              pop #regs
+              gs lr
+              jmp #0
+            }
+            LocalSize:=current_procinfo.calc_stackframe_size;
+
+            regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
+            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+              include(regs, RS_FRAME_POINTER_REG);
+
+            if pi_do_call in current_procinfo.flags then
+              include(regs,RS_LR);
+
+            if regs<>[] then
+              list.concat(taicpu.op_const(A_PUSH,longword(regs)));
+
+            cnt:=0;
+            for reg:=RS_R0 to RS_LR do
+              if reg in regs then
+                inc(cnt);
+
+            if (current_procinfo.framepointer<>NR_STACK_POINTER_REG) or (LocalSize>0) then
+              begin
+                list.concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+
+                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                  begin
+                    list.concat(taicpu.op_const(A_ADD,cnt*4));
+                    list.concat(taicpu.op_reg(A_ST,NR_FRAME_POINTER_REG));
+                  end;
+
+                if LocalSize>0 then
+                  begin
+                    list.concat(taicpu.op_const(A_SUB,cnt*4+localsize));
+                    list.concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+                  end;
+              end;
+
+            { save int registers }
+            {regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
+            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+              regs:=regs+[RS_FRAME_POINTER_REG];
+
+            cnt:=0;
+
+            if pi_do_call in current_procinfo.flags then
+              include(regs,RS_R4);
+
+            if regs<>[] then
+              begin
+                list.Concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+
+                for reg:=RS_R6 downto RS_R0 do
+                  if reg in regs then
+                    begin
+                      list.Concat(taicpu.op_const(A_SUB,4));
+                      list.concat(taicpu.op_reg(A_STW,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
+                      inc(cnt,4);
+                    end;
+
+                list.Concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+
+                if pi_do_call in current_procinfo.flags then
+                  begin
+                    list.concat(taicpu.op_const(A_GS,SS_LR));
+                    list.concat(taicpu.op_reg(A_ST,NR_R4));
+
+                    list.Concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+                    list.Concat(taicpu.op_const(A_SUB,4));
+                    list.concat(taicpu.op_reg(A_STW,NR_R4));
+                    inc(cnt,4);
+
+                    list.Concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+                  end;
+              end;
+
+            if localsize>0 then
+              begin
+                list.Concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+                list.Concat(taicpu.op_const(A_SUB,localsize));
+                list.Concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+              end;
+
+            if (regs<>[]) and (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then
+              begin
+                list.concat(taicpu.op_const(A_ADD,cnt+localsize));
+                list.Concat(taicpu.op_reg(A_ST,current_procinfo.framepointer));
+              end;}
+          end;
+      end;
+
+
+    procedure tcgspc32.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean);
+      var
+        regs : tcpuregisterset;
+        reg : TSuperRegister;
+        LocalSize : longint;
+        href: treference;
+         cnt : longint;
+      begin
+        if not(nostackframe) then
+          begin
+            LocalSize:=current_procinfo.calc_stackframe_size;
+
+            if localsize>0 then
+              begin
+                list.Concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+                list.Concat(taicpu.op_const(A_ADD,localsize));
+                list.Concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+              end;
+
+            regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
+            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+              include(regs, RS_FRAME_POINTER_REG);
+
+            if pi_do_call in current_procinfo.flags then
+              include(regs,RS_LR);
+
+            if regs<>[] then
+              list.concat(taicpu.op_const(A_POP,longword(regs)));
+
+            //if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+              {begin
+                LocalSize:=current_procinfo.calc_stackframe_size;
+
+                if localsize>0 then
+                  begin
+                    list.Concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+                    list.Concat(taicpu.op_const(A_ADD,localsize));
+                    list.Concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+                  end;
+
+                regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
+                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+                  regs:=regs+[RS_FRAME_POINTER_REG];
+
+                if pi_do_call in current_procinfo.flags then
+                  include(regs,RS_R4);
+
+                if regs<>[] then
+                  begin
+                    cnt:=0;
+
+                    if pi_do_call in current_procinfo.flags then
+                      begin
+                        list.concat(taicpu.op_none(A_NUL));
+                        list.concat(taicpu.op_reg(A_LDW,NR_STACK_POINTER_REG));
+                        list.concat(taicpu.op_const(A_SS,SS_LR));
+                        inc(cnt,4);
+                      end;
+
+                    for reg:=RS_R0 to RS_R6 do
+                      if reg in regs then
+                        begin
+                          if cnt=0 then
+                            list.concat(taicpu.op_none(A_NUL))
+                          else
+                            list.concat(taicpu.op_const(A_LD,cnt));
+                          list.concat(taicpu.op_reg(A_LDW,NR_STACK_POINTER_REG));
+                          list.concat(taicpu.op_reg(A_ST,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
+                          inc(cnt,4);
+                        end;
+
+                    list.concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+                    list.concat(taicpu.op_const(A_ADD,cnt));
+                    list.concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+                  end;
+              end}
+            {else
+              begin
+                LocalSize:=current_procinfo.calc_stackframe_size;
+
+                if localsize>0 then
+                  begin
+                    list.Concat(taicpu.op_reg(A_LD,NR_STACK_POINTER_REG));
+                    list.Concat(taicpu.op_const(A_ADD,localsize));
+                    list.Concat(taicpu.op_reg(A_ST,NR_STACK_POINTER_REG));
+                  end;
+              end;}
+          end;
+        list.concat(taicpu.op_const(A_GS,SS_LR));
+        list.concat(taicpu.op_const(A_JMP,0));
+      end;
+
+
+    procedure tcgspc32.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
+      var
+        href : treference;
+        conv_done: boolean;
+        tmpreg : tregister;
+        i : integer;
+        QuickRef : boolean;
+      begin
+        href:=normalize_ref(list,ref);
+
+        if assigned(href.symbol) then
+          begin
+            href.refaddr:=addr_lo16;
+            list.concat(taicpu.op_ref(A_LD,href));
+            href.refaddr:=addr_hi16;
+            list.concat(taicpu.op_ref(A_LDU,href));
+          end
+        else
+          begin
+            list.concat(taicpu.op_reg(A_LD,href.base));
+
+            if href.offset<>0 then
+              list.concat(taicpu.op_const(A_ADD,href.offset));
+          end;
+
+        list.concat(taicpu.op_reg(A_ST,r));
+      end;
+
+
+    procedure tcgspc32.fixref(list : TAsmList;var ref : treference);
+      begin
+        internalerror(2011021320);
+      end;
+
+
+    procedure tcgspc32.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
+      var
+        paraloc1,paraloc2,paraloc3 : TCGPara;
+        pd : tprocdef;
+      begin
+        pd:=search_system_proc('MOVE');
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pd,1,paraloc1);
+        paramanager.getintparaloc(pd,2,paraloc2);
+        paramanager.getintparaloc(pd,3,paraloc3);
+        a_load_const_cgpara(list,OS_SINT,len,paraloc3);
+        a_loadaddr_ref_cgpara(list,dest,paraloc2);
+        a_loadaddr_ref_cgpara(list,source,paraloc1);
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
+        alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        a_call_name_static(list,'FPC_MOVE');
+        dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        paraloc3.done;
+        paraloc2.done;
+        paraloc1.done;
+      end;
+
+
+    procedure tcgspc32.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
+      var
+        srcreg, dstreg, cntreg, tmpreg: TRegister;
+        l: tasmlabel;
+      begin
+        if len <= 0 then
+          exit;
+
+        if (len > 8) or
+           ((len > 4) and
+            (not (source.alignment in [4,8]))) or
+           ((len = 2) and
+            (not (source.alignment in [2,4,8]))) or
+           ((len = 4) and
+            (not (source.alignment in [4,8]))) then
+          begin
+            g_concatcopy_move(list,source,dest,len);
+            exit;
+          end;
+
+        srcreg:=getaddressregister(list);
+        dstreg:=getaddressregister(list);
+        tmpreg:=getintregister(list,OS_INT);
+
+        a_loadaddr_ref_reg(list,source,srcreg);
+
+        list.concat(taicpu.op_reg(A_LD,srcreg));
+        case len of
+          1: list.Concat(taicpu.op_const(A_LDB,0));
+          2: list.Concat(taicpu.op_const(A_LDH,0));
+          4: list.Concat(taicpu.op_const(A_LDW,0));
+        end;
+        list.concat(taicpu.op_reg(A_ST,tmpreg));
+
+        a_loadaddr_ref_reg(list,dest,dstreg);
+
+        list.concat(taicpu.op_reg(A_LD,dstreg));
+        case len of
+          1: list.Concat(taicpu.op_reg(A_STB,tmpreg));
+          2: list.Concat(taicpu.op_reg(A_STH,tmpreg));
+          4: list.Concat(taicpu.op_reg(A_STW,tmpreg));
+        end;
+
+        if len > 4 then
+          begin
+            dec(len,4);
+
+            list.concat(taicpu.op_reg(A_LD,srcreg));
+            case len of
+              1: list.Concat(taicpu.op_const(A_LDB,4));
+              2: list.Concat(taicpu.op_const(A_LDH,4));
+              4: list.Concat(taicpu.op_const(A_LDW,4));
+            end;
+            list.concat(taicpu.op_reg(A_ST,tmpreg));
+
+            list.concat(taicpu.op_reg(A_LD,dstreg));
+            list.concat(taicpu.op_const(A_ADD,4));
+            case len of
+              1: list.Concat(taicpu.op_reg(A_STB,tmpreg));
+              2: list.Concat(taicpu.op_reg(A_STH,tmpreg));
+              4: list.Concat(taicpu.op_reg(A_STW,tmpreg));
+            end;
+          end;
+      end;
+
+
+        procedure tcgspc32.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
+      var
+        hl : tasmlabel;
+        ai : taicpu;
+        cond : TAsmCond;
+      begin
+        if not(cs_check_overflow in current_settings.localswitches) then
+         exit;
+        {current_asmdata.getjumplabel(hl);
+        if not ((def.typ=pointerdef) or
+               ((def.typ=orddef) and
+                (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
+                                          pasbool8,pasbool16,pasbool32,pasbool64]))) then
+          cond:=C_VC
+        else
+          cond:=C_CC;
+        ai:=Taicpu.Op_Sym(A_Jxx,hl);
+        ai.SetCondition(cond);
+        ai.is_jmp:=true;
+        list.concat(ai);
+
+        a_call_name(list,'FPC_OVERFLOW',false);
+        a_label(list,hl);}
+      end;
+
+
+    procedure tcgspc32.g_save_registers(list: TAsmList);
+      begin
+        { this is done by the entry code }
+      end;
+
+
+    procedure tcgspc32.g_restore_registers(list: TAsmList);
+      begin
+        { this is done by the exit code }
+      end;
+
+
+    procedure tcgspc32.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
+      var
+        ai1,ai2 : taicpu;
+        hl : TAsmLabel;
+      begin
+        ai1:=Taicpu.Op_sym(A_Jxx,l);
+        ai1.is_jmp:=true;
+        hl:=nil;
+        case cond of
+          OC_EQ:
+            ai1.SetCondition(C_EQ);
+          OC_LT:
+            ai1.SetCondition(C_LT);
+          OC_LTE:
+            ai1.SetCondition(C_LE);
+          OC_NE:
+            ai1.SetCondition(C_NE);
+          OC_BE:
+            ai1.SetCondition(C_BE);
+          OC_B:
+            ai1.SetCondition(C_B);
+          else
+            internalerror(2011082501);
+        end;
+        list.Concat(taicpu.op_const(A_GS,SS_PC));
+        list.concat(ai1);
+        if assigned(hl) then
+          a_label(list,hl);
+      end;
+
+
+    procedure tcgspc32.g_stackpointer_alloc(list: TAsmList; size: longint);
+      begin
+        internalerror(201201071);
+      end;
+
+
+    procedure tcgspc32.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+      var
+        make_global : boolean;
+        tmpref : treference;
+        l : TAsmLabel;
+      begin
+        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+          Internalerror(200006137);
+        if not assigned(procdef.struct) or
+           (procdef.procoptions*[po_classmethod, po_staticmethod,
+             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
+          Internalerror(200006138);
+        if procdef.owner.symtabletype<>ObjectSymtable then
+          Internalerror(200109191);
+
+        make_global:=false;
+        if (not current_module.is_unit) or
+           create_smartlink or
+           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
+          make_global:=true;
+
+        if make_global then
+          list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+        else
+          list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+
+        { the wrapper might need aktlocaldata for the additional data to
+          load the constant }
+        current_procinfo:=cprocinfo.create(nil);
+
+        { set param1 interface to self  }
+        g_adjust_self_value(list,procdef,ioffset);
+
+        { case 4 }
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
+          begin
+            list.concat(taicpu.op_none(A_NUL));
+            list.concat(taicpu.op_reg(A_LDW,NR_R0));
+            list.concat(taicpu.op_const(A_LDW,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)));
+            list.concat(taicpu.op_const(A_JMP,0));
+          end
+        else
+          begin
+            reference_reset_symbol(tmpref,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint));
+
+            tmpref.refaddr:=addr_lo16;
+            list.concat(taicpu.op_ref(A_LD,tmpref));
+            tmpref.refaddr:=addr_hi16;
+            list.concat(taicpu.op_ref(A_LDU,tmpref));
+
+            list.concat(taicpu.op_const(A_JMP,0));
+          end;
+        list.concatlist(current_procinfo.aktlocaldata);
+
+        current_procinfo.Free;
+        current_procinfo:=nil;
+
+        list.concat(Tai_symbol_end.Createname(labelname));
+      end;
+
+
+    procedure tcg64fspc32.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
+      begin
+        if not(size in [OS_S64,OS_64]) then
+          internalerror(2012102402);
+
+        case op of
+          OP_ADD:
+            begin
+              list.concat(taicpu.op_reg(A_LD,regdst.reglo));
+              list.concat(taicpu.op_reg(A_ADD,regsrc.reglo));
+              list.concat(taicpu.op_reg(A_ST,regdst.reglo));
+              list.concat(taicpu.op_reg(A_LD,regdst.reghi));
+              list.concat(taicpu.op_reg(A_ADC,regsrc.reghi));
+              list.concat(taicpu.op_reg(A_ST,regdst.reghi));
+            end;
+          OP_SUB:
+            begin
+              list.concat(taicpu.op_reg(A_LD,regdst.reglo));
+              list.concat(taicpu.op_reg(A_SUB,regsrc.reglo));
+              list.concat(taicpu.op_reg(A_ST,regdst.reglo));
+              list.concat(taicpu.op_reg(A_LD,regdst.reghi));
+              list.concat(taicpu.op_reg(A_SBC,regsrc.reghi));
+              list.concat(taicpu.op_reg(A_ST,regdst.reghi));
+            end;
+          OP_NEG:
+            begin
+              list.concat(taicpu.op_none(A_NUL));
+              list.concat(taicpu.op_reg(A_SUB,regsrc.reglo));
+              list.concat(taicpu.op_reg(A_ST,regdst.reglo));
+              list.concat(taicpu.op_none(A_NUL));
+              list.concat(taicpu.op_reg(A_SBC,regsrc.reghi));
+              list.concat(taicpu.op_reg(A_ST,regdst.reghi));
+            end;
+          OP_NOT:
+            begin
+              list.concat(taicpu.op_const(A_LD,-1));
+              list.concat(taicpu.op_reg(A_XOR,regsrc.reglo));
+              list.concat(taicpu.op_reg(A_ST,regdst.reglo));
+              list.concat(taicpu.op_const(A_LD,-1));
+              list.concat(taicpu.op_reg(A_XOR,regsrc.reghi));
+              list.concat(taicpu.op_reg(A_ST,regdst.reghi));
+            end;
+          OP_AND,
+          OP_OR,
+          OP_XOR:
+            begin
+              list.concat(taicpu.op_reg(A_LD,regdst.reglo));
+              list.concat(taicpu.op_reg(TOpCG2AsmOp[op],regsrc.reglo));
+              list.concat(taicpu.op_reg(A_ST,regdst.reglo));
+
+              list.concat(taicpu.op_reg(A_LD,regdst.reghi));
+              list.concat(taicpu.op_reg(TOpCG2AsmOp[op],regsrc.reghi));
+              list.concat(taicpu.op_reg(A_ST,regdst.reghi));
+            end;
+          else
+            begin
+              writeln(op);
+              Internalerror(2014041601);
+            end;
+        end;
+      end;
+
+
+    procedure tcg64fspc32.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);
+      var
+        tmpreg : tregister64;
+      begin
+        if not(size in [OS_S64,OS_64]) then
+          internalerror(2012102402);
+
+        if ((value and $FFFFFFFF) = SarLongint((value shl 16) and $FFFFFFFF, 16)) and
+           (((value shr 32) and $FFFFFFFF) = SarLongint((value shr 16) and $FFFF0000, 16)) then
+          begin
+            case op of
+              OP_ADD:
+                begin
+                  list.concat(taicpu.op_reg(A_LD,reg.reglo));
+                  list.concat(taicpu.op_const(A_ADD,value and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reglo));
+
+                  list.concat(taicpu.op_reg(A_LD,reg.reghi));
+                  list.concat(taicpu.op_const(A_ADC,(value shr 32) and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reghi));
+                end;
+              OP_SUB:
+                begin
+                  list.concat(taicpu.op_reg(A_LD,reg.reglo));
+                  list.concat(taicpu.op_const(A_SUB,value and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reglo));
+
+                  list.concat(taicpu.op_reg(A_LD,reg.reghi));
+                  list.concat(taicpu.op_const(A_SBC,(value shr 32) and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reghi));
+                end;
+              OP_AND:
+                begin
+                  list.concat(taicpu.op_reg(A_LD,reg.reglo));
+                  list.concat(taicpu.op_const(A_AND,value and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reglo));
+
+                  if ((value shr 32) and $FFFFFFFF) = 0 then
+                    begin
+                      list.concat(taicpu.op_none(A_NUL));
+                      list.concat(taicpu.op_reg(A_ST,reg.reghi));
+                    end
+                  else
+                    begin
+                      list.concat(taicpu.op_reg(A_LD,reg.reghi));
+                      list.concat(taicpu.op_const(A_AND,(value shr 32) and $FFFFFFFF));
+                      list.concat(taicpu.op_reg(A_ST,reg.reghi));
+                    end;
+                end;
+              OP_OR:
+                begin
+                  list.concat(taicpu.op_reg(A_LD,reg.reglo));
+                  if (value and $FFFFFFFF) <> 0 then
+                    list.concat(taicpu.op_const(A_ORR,value and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reglo));
+
+                  list.concat(taicpu.op_reg(A_LD,reg.reghi));
+                  if ((value shr 32) and $FFFFFFFF) <> 0 then
+                    list.concat(taicpu.op_const(A_ORR,(value shr 32) and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reghi));
+                end;
+              OP_XOR:
+                begin
+                  list.concat(taicpu.op_reg(A_LD,reg.reglo));
+                  if (value and $FFFFFFFF) <> 0 then
+                    list.concat(taicpu.op_const(A_XOR,value and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reglo));
+
+                  list.concat(taicpu.op_reg(A_LD,reg.reghi));
+                  if ((value shr 32) and $FFFFFFFF) <> 0 then
+                    list.concat(taicpu.op_const(A_XOR,(value shr 32) and $FFFFFFFF));
+                  list.concat(taicpu.op_reg(A_ST,reg.reghi));
+                end;
+              else
+                begin
+                  writeln(op);
+                  Internalerror(2014041602);
+                end;
+            end;
+          end
+        else
+          begin
+            tmpreg.reglo:=cg.getintregister(list,OS_INT);
+            tmpreg.reghi:=cg.getintregister(list,OS_INT);
+
+            a_load64_const_reg(list,value,tmpreg);
+
+            a_op64_reg_reg(list,op,size,tmpreg,reg);
+          end;
+      end;
+
+
+    procedure create_codegen;
+      begin
+        cg:=tcgspc32.create;
+        cg64:=tcg64fspc32.create;
+      end;
+
+end.

compiler/spc32/cpubase.pas

@@ -0,0 +1,473 @@
+{
+    Copyright (c) 2006 by Florian Klaempfl
+
+    Contains the base types for the SPC32
+
+    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,
+        A_LD,A_ST,
+        A_ADD,A_SUB,
+        A_ADC,A_SBC,
+        A_MUL,A_LSL,A_LSR,A_ASR,
+        A_AND,A_ORR,A_XOR,
+        A_LDU,
+        A_NUL,
+        A_LDW,A_LDH,A_LDB,
+        A_STW,A_STH,A_STB,
+        A_JMP,A_CALL,A_Jxx,
+        A_GS,A_SS,
+        // Extended instructions
+        A_PUSH,A_POP,A_INC,A_XCHG,A_CAS,A_IRET,
+        // Pseudo instructions
+        A_MOV,A_LOAD,A_STORE);
+
+
+      { This should define the array of instructions as string }
+      op2strtable=array[tasmop] of string[11];
+
+    const
+      { First value of opcode enumeration }
+      firstop = low(tasmop);
+      { Last value of opcode enumeration  }
+      lastop  = high(tasmop);
+
+      jmp_instructions = [A_Jxx,A_JMP,A_CALL];
+
+{*****************************************************************************
+                                  Registers
+*****************************************************************************}
+
+    type
+      { Number of registers used for indexing in tables }
+      tregisterindex=0..{$i rspc32nor.inc}-1;
+
+    const
+      { Available Superregisters }
+      {$i rspc32sup.inc}
+
+      { No Subregisters }
+      R_SUBWHOLE = R_SUBNONE;
+
+      { Available Registers }
+      {$i rspc32con.inc}
+
+      { Integer Super registers first and last }
+      first_int_supreg = RS_R0;
+      first_int_imreg = $9;
+
+      { Float Super register first and last }
+      first_fpu_supreg    = RS_INVALID;
+      first_fpu_imreg     = 1;
+
+      { MM Super register first and last }
+      first_mm_supreg    = RS_INVALID;
+      first_mm_imreg     = 1;
+
+      regnumber_count_bsstart = 32;
+
+      regnumber_table : array[tregisterindex] of tregister = (
+        {$i rspc32num.inc}
+      );
+
+      regstabs_table : array[tregisterindex] of shortint = (
+        {$i rspc32sta.inc}
+      );
+
+      regdwarf_table : array[tregisterindex] of shortint = (
+        {$i rspc32dwa.inc}
+      );
+      { registers which may be destroyed by calls }
+      VOLATILE_INTREGISTERS = [RS_R0,RS_R1,RS_R2];
+      VOLATILE_FPUREGISTERS = [];
+
+    type
+      totherregisterset = set of tregisterindex;
+
+{*****************************************************************************
+                                Conditions
+*****************************************************************************}
+
+    type
+      TAsmCond=(C_None,
+        C_EQ,C_NE,C_LT,C_LE,C_BE,C_B
+      );
+
+    const
+      cond2str : array[TAsmCond] of string[2]=('',
+        'eq','ne','lt','le','be','b'
+      );
+
+      uppercond2str : array[TAsmCond] of string[2]=('',
+        'EQ','NE','LT','LE','BE','B'
+      );
+
+{*****************************************************************************
+                                   Flags
+*****************************************************************************}
+
+    type
+      TResFlags = (F_NotPossible,
+                   F_EQ,F_NE,F_LT,F_LE,F_BE,F_B);
+
+{*****************************************************************************
+                                Operands
+*****************************************************************************}
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+    const
+      max_operands = 2;
+
+      maxintregs = 7;
+      maxfpuregs = 0;
+      maxaddrregs = 0;
+
+{*****************************************************************************
+                                Operand Sizes
+*****************************************************************************}
+
+    type
+      topsize = (S_NO);
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+    const
+      firstsaveintreg = RS_R1;
+      lastsaveintreg  = RS_R3;
+      firstsavefpureg = RS_INVALID;
+      lastsavefpureg  = RS_INVALID;
+      firstsavemmreg  = RS_INVALID;
+      lastsavemmreg   = RS_INVALID;
+
+      maxvarregs = 3;
+      varregs : Array [1..maxvarregs] of tsuperregister =
+                (RS_R0,RS_R1,RS_R2);
+
+      maxfpuvarregs = 1;
+      fpuvarregs : Array [1..maxfpuvarregs] of tsuperregister =
+                (RS_INVALID);
+
+{*****************************************************************************
+                          Default generic sizes
+*****************************************************************************}
+
+      { Defines the default address size for a processor, }
+      OS_ADDR = OS_32;
+      { the natural int size for a processor,
+        has to match osuinttype/ossinttype as initialized in psystem }
+      OS_INT = OS_32;
+      OS_SINT = OS_S32;
+      { 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_R6;
+      RS_STACK_POINTER_REG = RS_R6;
+      { Frame pointer register }
+      RS_FRAME_POINTER_REG = RS_R5;
+      NR_FRAME_POINTER_REG = NR_R5;
+      { 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_R4;
+      { Results are returned in this register (32-bit values) }
+      NR_FUNCTION_RETURN_REG = NR_R0;
+      RS_FUNCTION_RETURN_REG = RS_R0;
+      { Low part of 64bit return value }
+      NR_FUNCTION_RETURN64_LOW_REG = NR_R0;
+      RS_FUNCTION_RETURN64_LOW_REG = RS_R0;
+      { High part of 64bit return value }
+      NR_FUNCTION_RETURN64_HIGH_REG = NR_R1;
+      RS_FUNCTION_RETURN64_HIGH_REG = RS_R1;
+      { 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_SREG;
+      RS_DEFAULTFLAGS = RS_SREG;
+
+      SS_PC = 0;
+      SS_LR = 1;
+
+{*****************************************************************************
+                       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 spc32, 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 inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+
+    function dwarf_reg(r:tregister):byte;
+    function GetHigh(const r : TRegister) : TRegister;
+
+    { returns the next virtual register }
+    function GetNextReg(const r : TRegister) : TRegister;
+
+    { returns the last virtual register }
+    function GetLastReg(const r : TRegister) : TRegister;
+
+    { returns the register with the offset of ofs of a continuous set of register starting with r }
+    function GetOffsetReg(const r : TRegister;ofs : shortint) : TRegister;
+    { returns the register with the offset of ofs of a continuous set of register starting with r and being continued with rhi }
+    function GetOffsetReg64(const r,rhi: TRegister;ofs : shortint): TRegister;
+
+    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+
+  implementation
+
+    uses
+      rgBase,verbose;
+
+
+    const
+      std_regname_table : TRegNameTable = (
+        {$i rspc32std.inc}
+      );
+
+      regnumber_index : array[tregisterindex] of tregisterindex = (
+        {$i rspc32rni.inc}
+      );
+
+      std_regname_index : array[tregisterindex] of tregisterindex = (
+        {$i rspc32sri.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 :
+            reg_cgsize:=OS_8;
+          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_NE,F_EQ,F_NotPossible,F_NotPossible,F_NotPossible,F_NotPossible);
+      begin
+        f:=inv_flags[f];
+      end;
+
+
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+      const
+        flag_2_cond: array[F_EQ..F_B] of TAsmCond =
+          (C_EQ,C_NE,C_LT,C_LE,C_BE,C_B);
+      begin
+        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 inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+      const
+        inverse: array[TAsmCond] of TAsmCond=(C_None,
+          C_NE,C_EQ,C_None,C_None,C_None,C_None);
+      begin
+        result := inverse[c];
+      end;
+
+
+    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+      begin
+        result := c1 = c2;
+      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 GetHigh(const r : TRegister) : TRegister;
+      begin
+        result:=TRegister(longint(r)+1)
+      end;
+
+
+    function GetNextReg(const r: TRegister): TRegister;
+      begin
+        result:=TRegister(longint(r)+1);
+      end;
+
+
+    function GetLastReg(const r: TRegister): TRegister;
+      begin
+        result:=TRegister(longint(r)-1);
+      end;
+
+
+    function GetOffsetReg(const r: TRegister;ofs : shortint): TRegister;
+      begin
+        result:=TRegister(longint(r)+ofs);
+      end;
+
+
+    function GetOffsetReg64(const r,rhi: TRegister;ofs : shortint): TRegister;
+      begin
+        if ofs>3 then
+          result:=TRegister(longint(rhi)+ofs-4)
+        else
+          result:=TRegister(longint(r)+ofs);
+      end;
+
+
+    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+      begin
+        is_calljmp:= o in jmp_instructions;
+      end;
+
+
+end.

compiler/spc32/cpuelf.pas

@@ -0,0 +1,425 @@
+{
+    Copyright (c) 1998-2006 by Peter Vreman
+
+    Includes ELF-related code specific to SPC32
+
+    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.
+
+ ****************************************************************************
+}
+unit cpuelf;
+
+{$i fpcdefs.inc}
+
+interface
+
+implementation
+
+  uses
+    globtype,cclasses,
+    verbose,elfbase,
+    systems,aasmbase,ogbase,ogelf,assemble;
+
+  type
+    TElfExeOutputSpc32=class(TElfExeOutput)
+    private
+      procedure MaybeWriteGOTEntry(reltyp:byte;relocval:aint;objsym:TObjSymbol);
+    protected
+      procedure WriteFirstPLTEntry;override;
+      procedure WritePLTEntry(exesym:TExeSymbol);override;
+      procedure WriteIndirectPLTEntry(exesym:TExeSymbol);override;
+      procedure GOTRelocPass1(objsec:TObjSection;var idx:longint);override;
+      procedure DoRelocationFixup(objsec:TObjSection);override;
+    end;
+
+  const
+    { Relocation types }
+    R_SPC32_NONE = 0;
+    R_SPC32_32 = 1;
+    R_SPC32_PCREL = 2;
+    R_SPC32_LO16 = 3;
+    R_SPC32_HI16 = 4;
+
+
+{****************************************************************************
+                               ELF Target methods
+****************************************************************************}
+
+  function elf_spc32_encodereloc(objrel:TObjRelocation):byte;
+    begin
+      case objrel.typ of
+        RELOC_NONE :
+          result:=R_SPC32_NONE;
+        RELOC_RELATIVE :
+          result:=R_SPC32_PCREL;
+        RELOC_ABSOLUTE :
+          result:=R_SPC32_32;
+        RELOC_LO16:
+          result:=R_SPC32_LO16;
+        RELOC_HI16:
+          result:=R_SPC32_HI16;
+      else
+        result:=0;
+        InternalError(2012082301);
+      end;
+    end;
+
+
+  procedure elf_spc32_loadreloc(objrel:TObjRelocation);
+    begin
+    end;
+
+
+  function elf_spc32_relocname(reltyp:byte):string;
+    begin
+      result:='TODO';
+    end;
+
+{****************************************************************************
+                               TElfExeOutput386
+****************************************************************************}
+
+
+  procedure TElfExeOutputSpc32.WriteFirstPLTEntry;
+    begin
+      {if IsSharedLibrary then
+        // push 4(%ebx);  jmp  *8(%ebx)
+        pltobjsec.writeBytes(#$FF#$B3#$04#$00#$00#$00#$FF#$A3#$08#$00#$00#$00)
+      else
+        begin
+          pltobjsec.writeBytes(#$FF#$35);         // push got+4
+          pltobjsec.writeReloc_internal(gotpltobjsec,sizeof(pint),4,RELOC_ABSOLUTE);
+          pltobjsec.writeBytes(#$FF#$25);         // jmp  *got+8
+          pltobjsec.writeReloc_internal(gotpltobjsec,2*sizeof(pint),4,RELOC_ABSOLUTE);
+        end;
+      pltobjsec.writeBytes(#$90#$90#$90#$90);     // nop}
+    end;
+
+
+  procedure TElfExeOutputSpc32.WritePLTEntry(exesym:TExeSymbol);
+    var
+      got_offset: aword;
+      tmp:pint;
+    begin
+      {got_offset:=gotpltobjsec.size;
+      if IsSharedLibrary then
+        begin
+          pltobjsec.writeBytes(#$FF#$A3);   // jmp got+x(%ebx)
+          pltobjsec.write(got_offset,4);
+        end
+      else
+        begin
+          pltobjsec.writeBytes(#$FF#$25);   // jmp *got+x
+          pltobjsec.writeReloc_internal(gotpltobjsec,got_offset,4,RELOC_ABSOLUTE);
+        end;
+      pltobjsec.writeBytes(#$68);           // push  $index
+      tmp:=pltrelocsec.size;
+      pltobjsec.write(tmp,4);
+
+      pltobjsec.writeBytes(#$E9);           // jmp   .plt
+      tmp:=-(4+pltobjsec.Size);
+      pltobjsec.write(tmp,4);
+
+      { write a .got.plt slot pointing back to the 'push' instruction }
+      gotpltobjsec.writeReloc_internal(pltobjsec,pltobjsec.size-(16-6),sizeof(pint),RELOC_ABSOLUTE);
+
+      { write a .rel.plt entry }
+      pltrelocsec.writeReloc_internal(gotpltobjsec,got_offset,sizeof(pint),RELOC_ABSOLUTE);
+      got_offset:=(exesym.dynindex shl 8) or R_386_JUMP_SLOT;
+      pltrelocsec.write(got_offset,sizeof(pint));
+      if ElfTarget.relocs_use_addend then
+        pltrelocsec.writezeros(sizeof(pint));}
+    end;
+
+
+  procedure TElfExeOutputSpc32.WriteIndirectPLTEntry(exesym:TExeSymbol);
+    begin
+      // TODO
+      inherited WriteIndirectPLTEntry(exesym);
+    end;
+
+
+  procedure TElfExeOutputSpc32.GOTRelocPass1(objsec:TObjSection;var idx:longint);
+    var
+      objsym:TObjSymbol;
+      objreloc:TObjRelocation;
+      reltyp:byte;
+    begin
+      {objreloc:=TObjRelocation(objsec.ObjRelocations[idx]);
+      if (ObjReloc.flags and rf_raw)=0 then
+        reltyp:=ElfTarget.encodereloc(ObjReloc)
+      else
+        reltyp:=ObjReloc.ftype;
+      case reltyp of
+
+        R_386_PLT32:
+          begin
+            objsym:=objreloc.symbol.exesymbol.ObjSymbol;
+            objsym.refs:=objsym.refs or symref_plt;
+          end;
+
+        R_386_32:
+          if (oso_executable in objsec.SecOptions) or
+            not (oso_write in objsec.SecOptions) then
+            begin
+              if assigned(objreloc.symbol) and assigned(objreloc.symbol.exesymbol) then
+                begin
+                  objsym:=objreloc.symbol.exesymbol.ObjSymbol;
+                  objsym.refs:=objsym.refs or symref_from_text;
+                end;
+            end;
+      end;
+
+      case reltyp of
+
+        R_386_TLS_IE:
+          begin
+
+            AllocGOTSlot(objreloc.symbol);
+          end;
+
+        R_386_GOT32:
+          begin
+            AllocGOTSlot(objreloc.symbol);
+          end;
+
+        R_386_32:
+          begin
+            { TODO: How to handle absolute relocation to *weak* external symbol
+              from executable? See test/tweaklib2, symbol test2, ld handles it
+              differently for PIC and non-PIC code. In non-PIC code it drops
+              dynamic relocation altogether. }
+            if not IsSharedLibrary then
+              exit;
+            if (oso_executable in objsec.SecOptions) or
+               not (oso_write in objsec.SecOptions) then
+              hastextrelocs:=True;
+            dynrelocsec.alloc(dynrelocsec.shentsize);
+            objreloc.flags:=objreloc.flags or rf_dynamic;
+          end;
+
+        R_386_PC32:
+          begin
+            if not IsSharedLibrary then
+              exit;
+            { In shared library PC32 reloc to external symbol cannot be redirected
+              to PLT entry, because PIC PLT relies on ebx register set properly. }
+            if assigned(objreloc.symbol) and
+              (
+                (objreloc.symbol.objsection=nil) or
+                (oso_plt in objreloc.symbol.objsection.SecOptions)
+              ) then
+              begin
+                { Must be a dynamic symbol }
+                if not (assigned(objreloc.symbol.exesymbol) and
+                   (objreloc.symbol.exesymbol.dynindex<>0)) then
+                  InternalError(2012101201);
+                if (oso_executable in objsec.SecOptions) or
+                  not (oso_write in objsec.SecOptions) then
+                  hastextrelocs:=True;
+                dynrelocsec.alloc(dynrelocsec.shentsize);
+                objreloc.flags:=objreloc.flags or rf_dynamic;
+              end;
+          end;
+      end;}
+    end;
+
+
+  procedure TElfExeOutputSpc32.MaybeWriteGOTEntry(reltyp:byte;relocval:aint;objsym:TObjSymbol);
+    var
+      gotoff,tmp:aword;
+    begin
+      {gotoff:=objsym.exesymbol.gotoffset;
+      if gotoff=0 then
+        InternalError(2012060902);
+
+      { the GOT slot itself, and a dynamic relocation for it }
+      { TODO: only data symbols must get here }
+      if gotoff=gotobjsec.Data.size+sizeof(pint) then
+        begin
+          gotobjsec.write(relocval,sizeof(pint));
+
+          tmp:=gotobjsec.mempos+gotoff-sizeof(pint);
+          if (objsym.exesymbol.dynindex>0) then
+            begin
+              if (reltyp=R_386_TLS_IE) then
+                if IsSharedLibrary then
+                  WriteDynRelocEntry(tmp,R_386_TLS_TPOFF,objsym.exesymbol.dynindex,0)
+                else
+              else
+                WriteDynRelocEntry(tmp,R_386_GLOB_DAT,objsym.exesymbol.dynindex,0)
+            end
+          else if IsSharedLibrary then
+            WriteDynRelocEntry(tmp,R_386_RELATIVE,0,relocval);
+        end;}
+    end;
+
+
+  procedure TElfExeOutputSpc32.DoRelocationFixup(objsec:TObjSection);
+    var
+      i,zero:longint;
+      objreloc: TObjRelocation;
+      address,
+      relocval : aint;
+      relocsec : TObjSection;
+      data: TDynamicArray;
+      reltyp: byte;
+      PC: aword;
+    begin
+      data:=objsec.data;
+      for i:=0 to objsec.ObjRelocations.Count-1 do
+        begin
+          objreloc:=TObjRelocation(objsec.ObjRelocations[i]);
+          case objreloc.typ of
+            RELOC_NONE:
+              continue;
+            RELOC_ZERO:
+              begin
+                data.Seek(objreloc.dataoffset);
+                zero:=0;
+                data.Write(zero,2);
+                continue;
+              end;
+          end;
+
+          if (objreloc.flags and rf_raw)=0 then
+            reltyp:=ElfTarget.encodereloc(objreloc)
+          else
+            reltyp:=objreloc.ftype;
+
+          if ElfTarget.relocs_use_addend then
+            address:=objreloc.orgsize
+          else
+            begin
+              data.Seek(objreloc.dataoffset);
+              data.Read(address,2);
+            end;
+
+          if assigned(objreloc.symbol) then
+            begin
+              relocsec:=objreloc.symbol.objsection;
+              relocval:=objreloc.symbol.address;
+            end
+          else if assigned(objreloc.objsection) then
+            begin
+              relocsec:=objreloc.objsection;
+              relocval:=objreloc.objsection.mempos
+            end
+          else
+            internalerror(2012060702);
+
+          { Only debug sections are allowed to have relocs pointing to unused sections }
+          if assigned(relocsec) and not (relocsec.used and assigned(relocsec.exesection)) and
+             not (oso_debug in objsec.secoptions) then
+            begin
+              writeln(objsec.fullname,' references ',relocsec.fullname);
+              internalerror(2012060703);
+            end;
+
+          PC:=objsec.mempos+objreloc.dataoffset;
+          { TODO: if relocsec=nil, relocations must be copied to .rel.dyn section }
+          if (relocsec=nil) or (relocsec.used) then
+            case reltyp of
+              R_SPC32_PCREL:
+                begin
+                  if (objreloc.flags and rf_dynamic)<>0 then
+                    WriteDynRelocEntry(PC,R_SPC32_PCREL,objreloc.symbol.exesymbol.dynindex,0)
+                  else
+                    address:=address+relocval-PC;
+                end;
+
+              R_SPC32_32:
+                begin
+                  if (objreloc.flags and rf_dynamic)<>0 then
+                    begin
+                      if (objreloc.symbol=nil) or
+                         (objreloc.symbol.exesymbol=nil) or
+                         (objreloc.symbol.exesymbol.dynindex=0) then
+                        begin
+                          address:=address+relocval;
+                          WriteDynRelocEntry(PC,R_SPC32_PCREL,0,address);
+                        end
+                      else
+                        { Don't modify address in this case, as it serves as addend for RTLD }
+                        WriteDynRelocEntry(PC,R_SPC32_32,objreloc.symbol.exesymbol.dynindex,0);
+                    end
+                  else
+                    address:=address+relocval;
+                end;
+
+              R_SPC32_LO16:
+                address:=address+relocval;
+              R_SPC32_HI16:
+                address:=address+(relocval shr 16);
+
+              else
+                begin
+                  writeln(reltyp);
+                  internalerror(200604014);
+                end;
+            end
+          else           { not relocsec.Used }
+            address:=0;  { Relocation in debug section points to unused section, which is eliminated by linker }
+
+          data.Seek(objreloc.dataoffset);
+          data.Write(address,2);
+        end;
+    end;
+
+
+{*****************************************************************************
+                                    Initialize
+*****************************************************************************}
+
+  const
+    elf_target_spc32 : TElfTarget =
+      (
+        max_page_size:     $1000;
+        exe_image_base:    $00000000;
+        machine_code:      EM_SPC32;
+        relocs_use_addend: false;
+        dyn_reloc_codes: (
+          R_SPC32_PCREL,
+          R_SPC32_NONE,
+          R_SPC32_NONE,
+          R_SPC32_NONE,
+          R_SPC32_NONE
+        );
+        relocname:         @elf_spc32_relocname;
+        encodereloc:       @elf_spc32_encodeReloc;
+        loadreloc:         @elf_spc32_loadReloc;
+        loadsection:       nil;
+      );
+
+    as_spc32_elf32_info : tasminfo =
+       (
+         id     : as_spc32_elf32;
+         idtxt  : 'ELF';
+         asmbin : '';
+         asmcmd : '';
+         supported_targets : [system_spc32_embedded];
+         flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
+         labelprefix : '.L';
+         comment : '';
+         dollarsign: '$';
+       );
+
+initialization
+  RegisterAssembler(as_spc32_elf32_info,TElfAssembler);
+  ElfExeOutputClass:=TElfExeOutputSpc32;
+  ElfTarget:=elf_target_spc32;
+
+end.
+

compiler/spc32/cpuinfo.pas

@@ -0,0 +1,136 @@
+{
+    Copyright (c) 2008 by the Free Pascal development team
+
+    Basic Processor information for the SPC32
+
+    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;
+
+Interface
+
+  uses
+    globtype;
+
+Type
+   bestreal = double;
+   ts32real = single;
+   ts64real = double;
+   ts80real = type extended;
+   ts128real = type extended;
+   ts64comp = comp;
+
+   pbestreal=^bestreal;
+
+   { possible supported processors for this target }
+   tcputype =
+      (cpu_none,
+       cpu_spc32v1
+      );
+
+   tfputype =
+     (fpu_none,
+      fpu_soft,
+      fpu_libgcc
+     );
+
+   tcontrollertype =
+     (ct_none,
+
+      ct_spc32v1
+     );
+
+Const
+   {# Size of native extended floating point type }
+   extended_size = 12;
+   {# Size of a multimedia register               }
+   mmreg_size = 16;
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'spc32';
+
+   { 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[7] = ('',
+     'SPC32v1'
+   );
+
+   fputypestr : array[tfputype] of string[6] = (
+     'NONE',
+     'SOFT',
+     'LIBGCC'
+   );
+
+   embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
+   ((
+   	controllertypestr:'';
+        controllerunitstr:'';
+        flashbase:0;
+        flashsize:0;
+        srambase:0;
+        sramsize:0;
+        eeprombase:0;
+        eepromsize:0;
+        bootbase:0;
+        bootsize:0;
+   	),
+        (
+   	controllertypestr:'SPC32V1';
+        controllerunitstr:'SPC32V1';
+        flashbase:0;
+        flashsize:0;
+        srambase:0;
+        sramsize:$4000;
+        eeprombase:0;
+        eepromsize:512;
+        bootbase:0;
+        bootsize:0;
+        )
+   );
+
+   { 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 + [{,cs_opt_loopunroll}];
+   level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
+
+ type
+   tcpuflags =
+      (CPUSPC32_HAS_MUL
+      );
+
+ const
+   cpu_capabilities : array[tcputype] of set of tcpuflags =
+     ( { cpu_none }    [],
+       { cpu_spc32v1 } [CPUSPC32_HAS_MUL]
+     );
+
+Implementation
+
+end.

compiler/spc32/cpunode.pas

@@ -0,0 +1,43 @@
+{
+    Copyright (c) 2000-2008 by Florian Klaempfl
+
+    This unit includes the SPC32 code generator into the compiler
+
+    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.
+
+ ****************************************************************************
+}
+unit cpunode;
+
+{$i fpcdefs.inc}
+
+  interface
+
+  implementation
+
+    uses
+       { generic nodes }
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,ncgadd
+       { to be able to only parts of the generic code,
+         the processor specific nodes must be included
+         after the generic one (FK)
+       }
+       ,nspc32add
+       ,nspc32mat
+       ,nspc32cnv
+       ;
+
+
+end.

compiler/spc32/cpupara.pas

@@ -0,0 +1,582 @@
+{
+    Copyright (c) 2008 by Florian Klaempfl
+
+    SPC32 specific calling conventions
+
+    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.
+ ****************************************************************************
+}
+unit cpupara;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       globtype,globals,
+       aasmtai,aasmdata,
+       cpuinfo,cpubase,cgbase,cgutils,
+       symconst,symbase,symtype,symdef,symtable,
+       parabase,paramgr;
+
+    type
+       tspc32paramanager = class(tparamanager)
+          function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
+          function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
+          function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+          function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
+          function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
+         private
+          procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
+          function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+            var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+       end;
+
+  implementation
+
+    uses
+       verbose,systems,
+       rgobj,
+       defutil,symsym;
+
+
+    function tspc32paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
+      begin
+        result:=VOLATILE_INTREGISTERS;
+      end;
+
+
+    function tspc32paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
+      begin
+        result:=VOLATILE_FPUREGISTERS;
+      end;
+
+
+    function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc;
+      begin
+         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
+           if push_addr_param for the def is true
+         }
+         case p.typ of
+            orddef:
+              getparaloc:=LOC_REGISTER;
+            floatdef:
+              getparaloc:=LOC_REGISTER;
+            enumdef:
+              getparaloc:=LOC_REGISTER;
+            pointerdef:
+              getparaloc:=LOC_REGISTER;
+            formaldef:
+              getparaloc:=LOC_REGISTER;
+            classrefdef:
+              getparaloc:=LOC_REGISTER;
+            recorddef:
+              getparaloc:=LOC_REGISTER;
+            objectdef:
+              getparaloc:=LOC_REGISTER;
+            stringdef:
+              if is_shortstring(p) or is_longstring(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            procvardef:
+              getparaloc:=LOC_REGISTER;
+            filedef:
+              getparaloc:=LOC_REGISTER;
+            arraydef:
+              getparaloc:=LOC_REFERENCE;
+            setdef:
+              if is_smallset(p) then
+                getparaloc:=LOC_REGISTER
+              else
+                getparaloc:=LOC_REFERENCE;
+            variantdef:
+              getparaloc:=LOC_REGISTER;
+            { avoid problems with errornous definitions }
+            errordef:
+              getparaloc:=LOC_REGISTER;
+            else
+              internalerror(2002071001);
+         end;
+      end;
+
+
+    function tspc32paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+      begin
+        result:=false;
+        if varspez in [vs_var,vs_out,vs_constref] then
+          begin
+            result:=true;
+            exit;
+          end;
+        case def.typ of
+          objectdef:
+            result:=is_object(def) and ((varspez=vs_const) or (def.size=0));
+          recorddef:
+            result:=(varspez=vs_const) or (def.size=0);
+          variantdef,
+          formaldef:
+            result:=true;
+          arraydef:
+            result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
+                             is_open_array(def) or
+                             is_array_of_const(def) or
+                             is_array_constructor(def);
+          setdef :
+            result:=not is_smallset(def);
+          stringdef :
+            result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
+        else
+          result:=def.size>8;
+        end;
+      end;
+
+
+    function tspc32paramanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+      var
+        i: longint;
+        sym: tsym;
+        fpufield: boolean;
+      begin
+        if handle_common_ret_in_param(def,pd,result) then
+          exit;
+        case def.typ of
+          recorddef:
+            begin
+              result:=def.size>4;
+              if not result and
+                 (target_info.abi in [abi_default,abi_armeb]) then
+                begin
+                  { in case of the old ARM abi (APCS), a struct is returned in
+                    a register only if it is simple. And what is a (non-)simple
+                    struct:
+
+                    "A non-simple type is any non-floating-point type of size
+                     greater than one word (including structures containing only
+                     floating-point fields), and certain single-word structured
+                     types."
+                       (-- ARM APCS documentation)
+
+                    So only floating point types or more than one word ->
+                    definitely non-simple (more than one word is already
+                    checked above). This includes unions/variant records with
+                    overlaid floating point and integer fields.
+
+                    Smaller than one word struct types are simple if they are
+                    "integer-like", and:
+
+                    "A structure is termed integer-like if its size is less than
+                    or equal to one word, and the offset of each of its
+                    addressable subfields is zero."
+                      (-- ARM APCS documentation)
+
+                    An "addressable subfield" is a field of which you can take
+                    the address, which in practive means any non-bitfield.
+                    In Pascal, there is no way to express the difference that
+                    you can have in C between "char" and "int :8". In this
+                    context, we use the fake distinction that a type defined
+                    inside the record itself (such as "a: 0..255;") indicates
+                    a bitpacked field while a field using a different type
+                    (such as "a: byte;") is not.
+                  }
+                  for i:=0 to trecorddef(def).symtable.SymList.count-1 do
+                    begin
+                      sym:=tsym(trecorddef(def).symtable.SymList[i]);
+                      if sym.typ<>fieldvarsym then
+                        continue;
+                      { bitfield -> ignore }
+                      if (trecordsymtable(trecorddef(def).symtable).usefieldalignment=bit_alignment) and
+                         (tfieldvarsym(sym).vardef.typ in [orddef,enumdef]) and
+                         (tfieldvarsym(sym).vardef.owner.defowner=def) then
+                        continue;
+                      { all other fields must be at offset zero }
+                      if tfieldvarsym(sym).fieldoffset<>0 then
+                        begin
+                          result:=true;
+                          exit;
+                        end;
+                      { floating point field -> also by reference }
+                      if tfieldvarsym(sym).vardef.typ=floatdef then
+                        begin
+                          result:=true;
+                          exit;
+                        end;
+                    end;
+                end;
+            end;
+          procvardef:
+            if not tprocvardef(def).is_addressonly then
+              result:=true
+            else
+              result:=false
+          else
+            result:=inherited ret_in_param(def,pd);
+        end;
+      end;
+
+
+    procedure tspc32paramanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
+      begin
+        curintreg:=RS_R0;
+        curfloatreg:=RS_INVALID;
+        curmmreg:=RS_INVALID;
+        cur_stack_offset:=0;
+      end;
+
+
+    { TODO : fix tspc32paramanager.create_paraloc_info_intern }
+    function tspc32paramanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+        var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+
+      var
+        nextintreg,nextfloatreg,nextmmreg : tsuperregister;
+        paradef : tdef;
+        paraloc : pcgparalocation;
+        stack_offset : aword;
+        hp : tparavarsym;
+        loc : tcgloc;
+        paracgsize   : tcgsize;
+        paralen : longint;
+        i : integer;
+        firstparaloc: boolean;
+
+      procedure assignintreg;
+        begin
+          { In case of po_delphi_nested_cc, the parent frame pointer
+            is always passed on the stack. }
+           if (nextintreg<=RS_R2) and
+              (not(vo_is_parentfp in hp.varoptions) or
+               not(po_delphi_nested_cc in p.procoptions)) then
+             begin
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
+               inc(nextintreg);
+             end
+           else
+             begin
+               paraloc^.loc:=LOC_REFERENCE;
+               paraloc^.reference.index:=NR_STACK_POINTER_REG;
+               paraloc^.reference.offset:=stack_offset;
+               inc(stack_offset,4);
+            end;
+        end;
+
+
+      begin
+        result:=0;
+        nextintreg:=curintreg;
+        nextfloatreg:=curfloatreg;
+        nextmmreg:=curmmreg;
+        stack_offset:=cur_stack_offset;
+
+        for i:=0 to paras.count-1 do
+          begin
+            hp:=tparavarsym(paras[i]);
+            paradef:=hp.vardef;
+
+            hp.paraloc[side].reset;
+
+            { currently only support C-style array of const,
+              there should be no location assigned to the vararg array itself }
+            if (p.proccalloption in cstylearrayofconst) and
+               is_array_of_const(paradef) then
+              begin
+                paraloc:=hp.paraloc[side].add_location;
+                { hack: the paraloc must be valid, but is not actually used }
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_R0;
+                paraloc^.size:=OS_ADDR;
+                paraloc^.def:=voidpointertype;
+                break;
+              end;
+
+            if push_addr_param(hp.varspez,paradef,p.proccalloption) then
+              begin
+                paradef:=getpointerdef(paradef);
+                loc:=LOC_REGISTER;
+                paracgsize := OS_ADDR;
+                paralen := tcgsize2size[OS_ADDR];
+              end
+            else
+              begin
+                if not is_special_array(paradef) then
+                  paralen := paradef.size
+                else
+                  paralen := tcgsize2size[def_cgsize(paradef)];
+                loc := getparaloc(p.proccalloption,paradef);
+                if (paradef.typ in [objectdef,arraydef,recorddef]) and
+                  not is_special_array(paradef) and
+                  (hp.varspez in [vs_value,vs_const]) then
+                  paracgsize := int_cgsize(paralen)
+                else
+                  begin
+                    paracgsize:=def_cgsize(paradef);
+                    { for things like formaldef }
+                    if (paracgsize=OS_NO) then
+                      begin
+                        paracgsize:=OS_ADDR;
+                        paralen:=tcgsize2size[OS_ADDR];
+                        paradef:=voidpointertype;
+                      end;
+                  end
+              end;
+
+             hp.paraloc[side].size:=paracgsize;
+             hp.paraloc[side].Alignment:=std_param_align;
+             hp.paraloc[side].intsize:=paralen;
+             hp.paraloc[side].def:=paradef;
+             firstparaloc:=true;
+
+{$ifdef EXTDEBUG}
+             if paralen=0 then
+               internalerror(200410311);
+{$endif EXTDEBUG}
+             while paralen>0 do
+               begin
+                 paraloc:=hp.paraloc[side].add_location;
+
+                 if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
+                   case paracgsize of
+                     OS_F32:
+                       begin
+                         paraloc^.size:=OS_32;
+                         paraloc^.def:=u32inttype;
+                       end;
+                     OS_F64:
+                       begin
+                         paraloc^.size:=OS_32;
+                         paraloc^.def:=u32inttype;
+                       end;
+                     else
+                       internalerror(2005082901);
+                   end
+                 else if (paracgsize in [OS_NO]) then
+                   begin
+                     paraloc^.size:=OS_32;
+                     paraloc^.def:=voidpointertype;
+                   end
+                 else if (paracgsize in [OS_64,OS_S64]) then
+                   begin
+                     paraloc^.size:=OS_32;
+                     paraloc^.def:=u32inttype;
+                   end
+                 else
+                   begin
+                     paraloc^.size:=paracgsize;
+                     paraloc^.def:=get_paraloc_def(paradef,paralen,firstparaloc);
+                   end;
+                 case loc of
+                    LOC_REGISTER:
+                      begin
+                        if nextintreg<=RS_R2 then
+                          begin
+                            paraloc^.loc:=LOC_REGISTER;
+                            paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
+                            inc(nextintreg);
+                          end
+                        else
+                          begin
+                            { LOC_REFERENCE always contains everything that's left }
+                            paraloc^.loc:=LOC_REFERENCE;
+                            paraloc^.size:=int_cgsize(paralen);
+                            paraloc^.def:=getarraydef(u8inttype,paralen);
+                            if (side=callerside) then
+                              paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                            paraloc^.reference.offset:=stack_offset;
+                            inc(stack_offset,align(paralen,4));
+                            paralen:=0;
+                         end;
+                      end;
+                    LOC_REFERENCE:
+                      begin
+                        if push_addr_param(hp.varspez,paradef,p.proccalloption) then
+                          begin
+                            paraloc^.size:=OS_ADDR;
+                            paraloc^.def:=getpointerdef(paradef);
+                            assignintreg
+                          end
+                        else
+                          begin
+                             paraloc^.size:=paracgsize;
+                             paraloc^.def:=paradef;
+                             paraloc^.loc:=LOC_REFERENCE;
+                             paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                             paraloc^.reference.offset:=stack_offset;
+                             inc(stack_offset,align(paralen,4));
+                             paralen:=0
+                          end;
+                      end;
+                    else
+                      internalerror(2002071002);
+                 end;
+                 if side=calleeside then
+                   begin
+                     if paraloc^.loc=LOC_REFERENCE then
+                       begin
+                         paraloc^.reference.index:=NR_FRAME_POINTER_REG;
+                         inc(paraloc^.reference.offset,4);
+                       end;
+                   end;
+                 dec(paralen,tcgsize2size[paraloc^.size]);
+                 firstparaloc:=false
+               end;
+          end;
+        curintreg:=nextintreg;
+        curfloatreg:=nextfloatreg;
+        curmmreg:=nextmmreg;
+        cur_stack_offset:=stack_offset;
+        result:=cur_stack_offset;
+      end;
+
+
+    function tspc32paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+      var
+        cur_stack_offset: aword;
+        curintreg, curfloatreg, curmmreg: tsuperregister;
+        retcgsize  : tcgsize;
+      begin
+        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        create_funcretloc_info(p,side);
+     end;
+
+
+    { TODO : fix tspc32paramanager.get_funcretloc }
+    function  tspc32paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+      var
+        paraloc : pcgparalocation;
+        retcgsize  : tcgsize;
+      begin
+         if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
+           exit;
+
+        paraloc:=result.add_location;
+        { Return in FPU register? }
+        if result.def.typ=floatdef then
+          begin
+            //if (p.proccalloption in [pocall_softfloat]) or
+            //   (cs_fp_emulation in current_settings.moduleswitches) then
+              begin
+                case retcgsize of
+                  OS_64,
+                  OS_F64:
+                    begin
+                      paraloc^.loc:=LOC_REGISTER;
+                      if target_info.endian = endian_big then
+                        paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
+                      else
+                        paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
+                      paraloc^.size:=OS_32;
+                      paraloc^.def:=u32inttype;
+                      paraloc:=result.add_location;
+                      paraloc^.loc:=LOC_REGISTER;
+                      if target_info.endian = endian_big then
+                        paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
+                      else
+                        paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
+                      paraloc^.size:=OS_32;
+                      paraloc^.def:=u32inttype;
+                    end;
+                  OS_32,
+                  OS_F32:
+                    begin
+                      paraloc^.loc:=LOC_REGISTER;
+                      paraloc^.register:=NR_FUNCTION_RETURN_REG;
+                      paraloc^.size:=OS_32;
+                      paraloc^.def:=u32inttype;
+                    end;
+                  else
+                    internalerror(2005082603);
+                end;
+              end
+            {else
+              begin
+                paraloc^.loc:=LOC_FPUREGISTER;
+                paraloc^.register:=NR_FPU_RESULT_REG;
+                paraloc^.size:=retcgsize;
+                paraloc^.def:=result.def;
+              end; }
+          end
+          { Return in register }
+        else
+          begin
+            if retcgsize in [OS_64,OS_S64] then
+              begin
+                paraloc^.loc:=LOC_REGISTER;
+                if target_info.endian = endian_big then
+                  paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
+                else
+                  paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
+                paraloc^.size:=OS_32;
+                paraloc^.def:=u32inttype;
+                paraloc:=result.add_location;
+                paraloc^.loc:=LOC_REGISTER;
+                if target_info.endian = endian_big then
+                  paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
+                else
+                  paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
+                paraloc^.size:=OS_32;
+                paraloc^.def:=u32inttype;
+              end
+            else
+              begin
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=NR_FUNCTION_RETURN_REG;
+                case result.IntSize of
+                  0:
+                    begin
+                      paraloc^.loc:=LOC_VOID;
+                      paraloc^.register:=NR_NO;
+                      paraloc^.size:=OS_NO;
+                      paraloc^.def:=voidpointertype;
+                    end;
+                  3:
+                    begin
+                      paraloc^.size:=OS_32;
+                      paraloc^.def:=u32inttype;
+                    end;
+                  else
+                    begin
+                      paraloc^.size:=retcgsize;
+                      paraloc^.def:=result.def;
+                    end;
+                end;
+              end;
+          end;
+      end;
+
+
+    function tspc32paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+      var
+        cur_stack_offset: aword;
+        curintreg, curfloatreg, curmmreg: tsuperregister;
+      begin
+        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        if (p.proccalloption in cstylearrayofconst) then
+          { just continue loading the parameters in the registers }
+          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
+        else
+          internalerror(200410231);
+      end;
+
+begin
+   paramanager:=tspc32paramanager.create;
+end.

compiler/spc32/cpupi.pas

@@ -0,0 +1,83 @@
+{
+    Copyright (c) 2008 by Florian Klaempfl
+
+    This unit contains the CPU specific part of tprocinfo
+
+    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.
+
+ ****************************************************************************
+}
+
+{ This unit contains the CPU specific part of tprocinfo. }
+unit cpupi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       globtype,cutils,
+       procinfo,cpuinfo,psub;
+
+    type
+
+       { tspc32procinfo }
+
+       tspc32procinfo = class(tcgprocinfo)
+          // procedure handle_body_start;override;
+          // procedure after_pass1;override;
+          procedure set_first_temp_offset;override;
+          function calc_stackframe_size:longint;override;
+          procedure postprocess_code;override;
+       end;
+
+
+  implementation
+
+    uses
+       globals,systems,
+       cpubase,
+       aasmtai,aasmdata,aasmcpu,
+       tgobj,
+       symconst,symsym,paramgr,
+       cgbase,
+       cgobj;
+
+    procedure tspc32procinfo.set_first_temp_offset;
+      begin
+        if tg.direction = -1 then
+          tg.setfirsttemp(0)
+        else
+          tg.setfirsttemp(maxpushedparasize);
+      end;
+
+
+    function tspc32procinfo.calc_stackframe_size:longint;
+      begin
+        maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4));
+        result:=Align(tg.direction*tg.lasttemp,max(current_settings.alignment.localalignmin,4))+maxpushedparasize;
+      end;
+
+
+    procedure tspc32procinfo.postprocess_code;
+      begin
+        finalizespc32code(aktproccode);
+      end;
+
+
+begin
+   cprocinfo:=tspc32procinfo;
+end.
+

compiler/spc32/cputarg.pas

@@ -0,0 +1,73 @@
+{
+    Copyright (c) 2001-2008 by Peter Vreman
+
+    Includes the SPC32 dependent target units
+
+    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.
+
+ ****************************************************************************
+}
+unit cputarg;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+    uses
+      systems { prevent a syntax error when nothing is included }
+
+{**************************************
+             Targets
+**************************************}
+
+    {$ifndef NOTARGETEMBEDDED}
+      ,t_embed
+    {$endif}
+
+{**************************************
+             Assemblers
+**************************************}
+
+    {$ifndef NOAGSPC32GAS}
+      ,agspc32gas
+    {$endif}
+
+      ,ogelf
+      ,cpuelf
+
+{**************************************
+        Assembler Readers
+**************************************}
+
+  {$ifndef NoRaSPC32gas}
+       ,raspc32gas
+  {$endif NoRaSPC32gas}
+
+{**************************************
+             Debuginfo
+**************************************}
+
+  {$ifndef NoDbgStabs}
+      ,dbgstabs
+  {$endif NoDbgStabs}
+  {$ifndef NoDbgDwarf}
+      ,dbgdwarf
+  {$endif NoDbgDwarf}
+      ;
+
+end.

compiler/spc32/hlcgcpu.pas

@@ -0,0 +1,45 @@
+{
+    Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
+    Member of the Free Pascal development team
+
+    This unit contains routines to create a pass-through high-level code
+    generator. This is used by most regular code generators.
+
+    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.
+
+ ****************************************************************************
+}
+
+unit hlcgcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+  procedure create_hlcodegen;
+
+implementation
+
+  uses
+    hlcgobj, hlcg2ll,
+    cgcpu;
+
+  procedure create_hlcodegen;
+    begin
+      hlcg:=thlcg2ll.create;
+      create_codegen;
+    end;
+
+end.

compiler/spc32/itcpugas.pas

@@ -0,0 +1,106 @@
+{
+    Copyright (c) 2008 by Florian Klaempfl
+
+    This unit contains the SPC32 GAS instruction tables
+
+    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.
+
+ ****************************************************************************
+}
+unit itcpugas;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    cpubase,cgbase;
+
+
+  const
+    { Standard opcode string table (for each tasmop enumeration). The
+      opcode strings should conform to the names as defined by the
+      processor manufacturer.
+    }
+    gas_op2str : op2strtable = ('',
+        'ld','st',
+        'add','sub',
+        'adc','sbc',
+        'mul','lsl','lsr','asr',
+        'and','orr','xor',
+        'ldu',
+        'nul',
+        'ldw','ldh','ldb',
+        'stw','sth','stb',
+        'jmp','call','j',
+        'gs','ss',
+        'push','pop','inc','xchg','cas','iret',
+        'mov','load','store');
+
+    function gas_regnum_search(const s:string):Tregister;
+    function gas_regname(r:Tregister):string;
+
+
+implementation
+
+    uses
+      cutils,verbose;
+
+    const
+      gas_regname_table : array[tregisterindex] of string[7] = (
+        {$i rspc32std.inc}
+      );
+
+      gas_regname_index : array[tregisterindex] of tregisterindex = (
+        {$i rspc32sri.inc}
+      );
+
+    function findreg_by_gasname(const s:string):tregisterindex;
+      var
+        i,p : tregisterindex;
+      begin
+        {Binary search.}
+        p:=0;
+        i:=regnumber_count_bsstart;
+        repeat
+          if (p+i<=high(tregisterindex)) and (gas_regname_table[gas_regname_index[p+i]]<=s) then
+            p:=p+i;
+          i:=i shr 1;
+        until i=0;
+        if gas_regname_table[gas_regname_index[p]]=s then
+          findreg_by_gasname:=gas_regname_index[p]
+        else
+          findreg_by_gasname:=0;
+      end;
+
+
+    function gas_regnum_search(const s:string):Tregister;
+      begin
+        result:=regnumber_table[findreg_by_gasname(s)];
+      end;
+
+
+    function gas_regname(r:Tregister):string;
+      var
+        p : tregisterindex;
+      begin
+        p:=findreg_by_number(r);
+        if p<>0 then
+          result:=gas_regname_table[p]
+        else
+          result:=generic_regname(r);
+      end;
+
+end.

compiler/spc32/nspc32add.pas

@@ -0,0 +1,260 @@
+{
+    Copyright (c) 2008 by Florian Klaempfl
+
+    Code generation for add nodes on the spc32
+
+    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.
+
+ ****************************************************************************
+}
+unit nspc32add;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       node,ncgadd,cpubase;
+
+    type
+
+       { Tspc32AddNode }
+
+       Tspc32AddNode = class(tcgaddnode)
+       private
+         function  GetResFlags(unsigned:Boolean):TResFlags;
+       protected
+         function pass_1 : tnode;override;
+         procedure second_cmpordinal;override;
+         procedure second_cmpsmallset;override;
+         procedure second_cmp64bit;override;
+         procedure second_cmp;
+       end;
+
+  implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,
+      symconst,symdef,paramgr,
+      aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
+      cgbase,cgutils,cgcpu,
+      cpuinfo,pass_1,pass_2,regvars,procinfo,
+      cpupara,
+      ncon,nset,nadd,
+      ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32,
+      hlcgobj;
+
+{*****************************************************************************
+                               Tspc32AddNode
+*****************************************************************************}
+
+    function Tspc32AddNode.GetResFlags(unsigned: Boolean): TResFlags;
+      begin
+        case NodeType of
+          equaln:
+            GetResFlags:=F_EQ;
+          unequaln:
+            GetResFlags:=F_NE;
+          else
+            if not(unsigned) then
+              begin
+                if nf_swapped in flags then
+                  case NodeType of
+                    ltn:
+                      GetResFlags:=F_NotPossible;
+                    lten:
+                      GetResFlags:=F_NotPossible;
+                    gtn:
+                      GetResFlags:=F_LT;
+                    gten:
+                      GetResFlags:=F_LE;
+                  end
+                else
+                  case NodeType of
+                    ltn:
+                      GetResFlags:=F_LT;
+                    lten:
+                      GetResFlags:=F_LE;
+                    gtn:
+                      GetResFlags:=F_NotPossible;
+                    gten:
+                      GetResFlags:=F_NotPossible;
+                  end;
+              end
+            else
+              begin
+                if nf_swapped in Flags then
+                  case NodeType of
+                    ltn:
+                      GetResFlags:=F_NotPossible;
+                    lten:
+                      GetResFlags:=F_NotPossible;
+                    gtn:
+                      GetResFlags:=F_B;
+                    gten:
+                      GetResFlags:=F_BE;
+                  end
+                else
+                  case NodeType of
+                    ltn:
+                      GetResFlags:=F_B;
+                    lten:
+                      GetResFlags:=F_BE;
+                    gtn:
+                      GetResFlags:=F_NotPossible;
+                    gten:
+                      GetResFlags:=F_NotPossible;
+                  end;
+              end;
+        end;
+      end;
+
+
+    procedure Tspc32AddNode.second_cmpsmallset;
+      var
+        tmpreg : tregister;
+        b: byte;
+      begin
+        pass_left_right;
+
+        location_reset(location,LOC_FLAGS,OS_NO);
+
+        if (not(nf_swapped in flags) and
+            (nodetype = lten)) or
+           ((nf_swapped in flags) and
+            (nodetype = gten)) then
+          swapleftright;
+
+        (* Try to keep right as a constant *)
+        //if (right.location.loc <> LOC_CONSTANT) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
+        case nodetype of
+          equaln,
+          unequaln:
+            begin
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_LD,left.location.register));
+              cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+              if right.location.loc = LOC_CONSTANT then
+                current_asmdata.CurrAsmList.concat(taicpu.op_const(A_SUB,right.location.value))
+              else
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_SUB,right.location.register));
+              if nodetype = equaln then
+                location.resflags:=F_EQ
+              else
+                location.resflags:=F_NE;
+            end;
+          lten,
+          gten:
+            begin
+              tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+              if right.location.loc = LOC_CONSTANT then
+                begin
+                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_INT,right.location.value,left.location.register,tmpreg);
+                  current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_LD,tmpreg));
+                  cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+                  current_asmdata.CurrAsmList.concat(taicpu.op_const(A_SUB,right.location.value))
+                  //current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,tmpreg,right.location.value));
+                end
+              else
+                begin
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_INT,right.location.register,left.location.register,tmpreg);
+                  current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_LD,tmpreg));
+                  cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+                  current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_SUB,right.location.register))
+                  //current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,tmpreg,right.location.register));
+                end;
+              location.resflags:=F_EQ;
+            end;
+          else
+            internalerror(2004012401);
+        end;
+      end;
+
+
+    procedure Tspc32AddNode.second_cmp;
+      var
+        unsigned : boolean;
+        tmpreg1,tmpreg2 : tregister;
+        i : longint;
+      begin
+        pass_left_right;
+        force_reg_left_right(true,false);
+
+        unsigned:=not(is_signed(left.resultdef)) or
+                  not(is_signed(right.resultdef));
+
+        if getresflags(unsigned)=F_NotPossible then
+          swapleftright;
+
+        current_asmdata.CurrAsmList.Concat(taicpu.op_reg(A_LD,left.location.register));
+        cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+        current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_SUB,right.location.register));
+
+        if left.location.size in [OS_S64,OS_64] then
+          begin
+            current_asmdata.CurrAsmList.Concat(taicpu.op_reg(A_LD,left.location.registerhi));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_SBC,right.location.registerhi));
+          end;
+
+        location_reset(location,LOC_FLAGS,OS_NO);
+        location.resflags:=getresflags(unsigned);
+      end;
+
+
+    procedure Tspc32AddNode.second_cmp64bit;
+      begin
+        second_cmp;
+      end;
+
+
+    function Tspc32AddNode.pass_1: tnode;
+      var
+        unsigned: Boolean;
+      begin
+        result:=inherited pass_1;
+
+        if not(assigned(result)) then
+          begin
+            unsigned:=not(is_signed(left.resultdef)) or
+              not(is_signed(right.resultdef));
+
+            if is_64bit(left.resultdef) and
+              ((nodetype in [equaln,unequaln]) or
+               (unsigned and (nodetype in [ltn,lten,gtn,gten]))
+              ) then
+              expectloc:=LOC_FLAGS;
+          end;
+        { handling boolean expressions }
+        if not(assigned(result)) and
+           (
+             not(is_boolean(left.resultdef)) or
+             not(is_boolean(right.resultdef)) or
+             is_dynamic_array(left.resultdef)
+           ) then
+          expectloc:=LOC_FLAGS;
+      end;
+
+
+    procedure Tspc32AddNode.second_cmpordinal;
+      begin
+        second_cmp;
+      end;
+
+begin
+  caddnode:=tspc32addnode;
+end.

compiler/spc32/nspc32cnv.pas

@@ -0,0 +1,59 @@
+{
+    Copyright (c) 1998-2009 by Florian Klaempfl
+
+    Generate SPC32 assembler for type converting nodes
+
+    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.
+
+ ****************************************************************************
+}
+unit nspc32cnv;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,ncnv,ncgcnv,defcmp;
+
+    type
+       tspc32typeconvnode = class(tcgtypeconvnode)
+         protected
+         { procedure second_int_to_int;override; }
+         { procedure second_string_to_string;override; }
+         { procedure second_cstring_to_pchar;override; }
+         { procedure second_string_to_chararray;override; }
+         { procedure second_array_to_pointer;override; }
+         { procedure second_pointer_to_array;override; }
+         { procedure second_chararray_to_string;override; }
+         { procedure second_char_to_string;override; }
+         { procedure second_int_to_real;override; }
+         { procedure second_real_to_real;override; }
+         { procedure second_cord_to_pointer;override; }
+         { procedure second_proc_to_procvar;override; }
+         { procedure second_bool_to_int;override; }
+         {  procedure second_int_to_bool;override; }
+         { procedure second_load_smallset;override;  }
+         { procedure second_ansistring_to_pchar;override; }
+         { procedure second_pchar_to_string;override; }
+         { procedure second_class_to_intf;override; }
+         { procedure second_char_to_char;override; }
+       end;
+
+implementation
+
+begin
+  ctypeconvnode:=tspc32typeconvnode;
+end.

compiler/spc32/nspc32mat.pas

@@ -0,0 +1,271 @@
+{
+    Copyright (c) 1998-2008 by Florian Klaempfl
+
+    Generates spc32 assembler for math nodes
+
+    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.
+
+ ****************************************************************************
+}
+unit nspc32mat;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,nmat,ncgmat;
+
+    type
+      tspc32moddivnode = class(tmoddivnode)
+        function first_moddivint: tnode;override;
+        procedure pass_generate_code;override;
+      end;
+
+      tspc32notnode = class(tcgnotnode)
+        procedure second_boolean;override;
+      end;
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,constexp,
+      aasmbase,aasmcpu,aasmtai,aasmdata,
+      defutil,
+      cgbase,cgobj,hlcgobj,cgutils,
+      pass_2,procinfo,
+      ncon,
+      cpubase,
+      ncgutil,cgcpu;
+
+{*****************************************************************************
+                             Tspc32MODDIVNODE
+*****************************************************************************}
+
+    function tspc32moddivnode.first_moddivint: tnode;
+      var
+        power  : longint;
+      begin
+        if (right.nodetype=ordconstn) and
+          (nodetype=divn) and
+          (ispowerof2(tordconstnode(right).value,power) or
+           (tordconstnode(right).value=1) or
+           (tordconstnode(right).value=int64(-1))
+          ) and
+          not(is_64bitint(resultdef)) then
+          result:=nil
+        else
+          result:=inherited first_moddivint;
+      end;
+
+
+    procedure tspc32moddivnode.pass_generate_code;
+      var
+        power  : longint;
+        numerator,
+        helper1,
+        helper2,
+        resultreg  : tregister;
+        size       : Tcgsize;
+       procedure genOrdConstNodeDiv;
+         begin
+{
+           if tordconstnode(right).value=0 then
+             internalerror(2005061701)
+           else if tordconstnode(right).value=1 then
+             cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, numerator, resultreg)
+           else if (tordconstnode(right).value = int64(-1)) then
+             begin
+               // note: only in the signed case possible..., may overflow
+               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVN,
+                 resultreg,numerator),toppostfix(ord(cs_check_overflow in current_settings.localswitches)*ord(PF_S))));
+             end
+           else if ispowerof2(tordconstnode(right).value,power) then
+             begin
+               if (is_signed(right.resultdef)) then
+                 begin
+                    helper1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+                    helper2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+                    shifterop_reset(so);
+                    so.shiftmode:=SM_ASR;
+                    so.shiftimm:=31;
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,helper1,numerator,so));
+                    shifterop_reset(so);
+                    so.shiftmode:=SM_LSR;
+                    so.shiftimm:=32-power;
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,helper2,numerator,helper1,so));
+                    shifterop_reset(so);
+                    so.shiftmode:=SM_ASR;
+                    so.shiftimm:=power;
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,resultreg,helper2,so));
+                  end
+               else
+                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg)
+             end;
+}
+         end;
+
+
+       procedure genOrdConstNodeMod;
+         var
+             modreg, maskreg, tempreg : tregister;
+         begin
+{
+             if (tordconstnode(right).value = 0) then begin
+                 internalerror(2005061702);
+             end
+             else if (abs(tordconstnode(right).value.svalue) = 1) then
+             begin
+                // x mod +/-1 is always zero
+                cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, resultreg);
+             end
+             else if (ispowerof2(tordconstnode(right).value, power)) then
+             begin
+                 if (is_signed(right.resultdef)) then begin
+
+                     tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
+                     maskreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
+                     modreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
+
+                     cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, abs(tordconstnode(right).value.svalue)-1, modreg);
+                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 31, numerator, maskreg);
+                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, numerator, modreg, tempreg);
+
+                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg));
+                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0));
+                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg));
+                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, modreg, maskreg, maskreg);
+                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_INT, maskreg, tempreg, resultreg);
+                 end else begin
+                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).value.svalue-1, numerator, resultreg);
+                 end;
+             end else begin
+                 genOrdConstNodeDiv();
+                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, resultreg);
+                 cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg);
+             end;
+}
+         end;
+
+      begin
+        secondpass(left);
+        secondpass(right);
+        location_copy(location,left.location);
+
+{
+        { put numerator in register }
+        size:=def_cgsize(left.resultdef);
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,
+          left.resultdef,left.resultdef,true);
+        location_copy(location,left.location);
+        numerator:=location.register;
+        resultreg:=location.register;
+        if location.loc=LOC_CREGISTER then
+          begin
+            location.loc := LOC_REGISTER;
+            location.register := cg.getintregister(current_asmdata.CurrAsmList,size);
+            resultreg:=location.register;
+          end
+        else if (nodetype=modn) or (right.nodetype=ordconstn) then
+          begin
+            // for a modulus op, and for const nodes we need the result register
+            // to be an extra register
+            resultreg:=cg.getintregister(current_asmdata.CurrAsmList,size);
+          end;
+
+        if right.nodetype=ordconstn then
+          begin
+            if nodetype=divn then
+              genOrdConstNodeDiv
+            else
+              genOrdConstNodeMod;
+          end;
+
+        location.register:=resultreg;
+
+        { unsigned division/module can only overflow in case of division by zero }
+        { (but checking this overflow flag is more convoluted than performing a  }
+        {  simple comparison with 0)                                             }
+        if is_signed(right.resultdef) then
+          cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
+}
+      end;
+
+{*****************************************************************************
+                               Tspc32NOTNODE
+*****************************************************************************}
+
+    procedure tspc32notnode.second_boolean;
+      var
+        hl : tasmlabel;
+        tmpreg : tregister;
+        i : longint;
+      begin
+        { if the location is LOC_JUMP, we do the secondpass after the
+          labels are allocated
+        }
+        if left.expectloc=LOC_JUMP then
+          begin
+            hl:=current_procinfo.CurrTrueLabel;
+            current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel;
+            current_procinfo.CurrFalseLabel:=hl;
+            secondpass(left);
+
+            if left.location.loc<>LOC_JUMP then
+              internalerror(2012081304);
+
+            maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars);
+            hl:=current_procinfo.CurrTrueLabel;
+            current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel;
+            current_procinfo.CurrFalseLabel:=hl;
+            location.loc:=LOC_JUMP;
+          end
+        else
+          begin
+            secondpass(left);
+            case left.location.loc of
+              LOC_FLAGS :
+                begin
+                  location_copy(location,left.location);
+                  inverse_flags(location.resflags);
+                end;
+              LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE,
+              LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF :
+                begin
+                  hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+                  current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_LD,left.location.register));
+                  current_asmdata.CurrAsmList.concat(taicpu.op_const(A_SUB,0));
+                  tmpreg:=left.location.register;
+
+                  { spc32 has no cpci, so we use the first register as "zero" register }
+                  if tcgsize2size[left.location.size] > 4 then
+                    begin
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_LD,left.location.registerhi));
+                      current_asmdata.CurrAsmList.concat(taicpu.op_const(A_SBC,0));
+                    end;
+                  location_reset(location,LOC_FLAGS,OS_NO);
+                  location.resflags:=F_EQ;
+               end;
+              else
+                internalerror(2003042401);
+            end;
+          end;
+      end;
+
+begin
+  cmoddivnode:=tspc32moddivnode;
+  cnotnode:=tspc32notnode;
+end.

compiler/spc32/raspc32.pas

@@ -0,0 +1,52 @@
+{
+    Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman
+
+    Handles the common arm assembler reader routines
+
+    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.
+
+ ****************************************************************************
+}
+unit raspc32;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cpubase,
+      aasmtai,aasmdata,
+      rautils;
+
+    type
+      Tspc32Operand=class(TOperand)
+      end;
+
+      Tspc32Instruction=class(TInstruction)
+        function ConcatInstruction(p:TAsmList) : tai;override;
+      end;
+
+  implementation
+
+    uses
+      aasmcpu;
+
+    function Tspc32Instruction.ConcatInstruction(p:TAsmList) : tai;
+      begin
+        result:=inherited ConcatInstruction(p);
+      end;
+
+
+end.

compiler/spc32/raspc32gas.pas

@@ -0,0 +1,647 @@
+{
+    Copyright (c) 1998-2008 by Carl Eric Codere and Peter Vreman
+
+    Does the parsing for the ARM GNU AS styled inline assembler.
+
+    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.
+
+ ****************************************************************************
+}
+Unit raspc32gas;
+
+{$i fpcdefs.inc}
+
+  Interface
+
+    uses
+      raatt,raspc32,
+      cpubase;
+
+    type
+      tspc32attreader = class(tattreader)
+        function is_asmopcode(const s: string):boolean;override;
+        function is_register(const s:string):boolean;override;
+        procedure handleopcode;override;
+        procedure BuildReference(oper : tspc32operand);
+        procedure BuildOperand(oper : tspc32operand);
+        procedure BuildOpCode(instr : tspc32instruction);
+        procedure ReadSym(oper : tspc32operand);
+        procedure ConvertCalljmp(instr : tspc32instruction);
+      end;
+
+
+  Implementation
+
+    uses
+      { helpers }
+      cutils,
+      { global }
+      globtype,globals,verbose,
+      systems,
+      { aasm }
+      cpuinfo,aasmbase,aasmtai,aasmdata,aasmcpu,
+      { symtable }
+      symconst,symbase,symtype,symsym,symtable,
+      { parser }
+      scanner,
+      procinfo,
+      itcpugas,
+      rabase,rautils,
+      cgbase,cgutils,cgobj
+      ;
+
+
+    function tspc32attreader.is_register(const s:string):boolean;
+      begin
+        result:=inherited is_register(s);
+      end;
+
+
+    procedure tspc32attreader.ReadSym(oper : tspc32operand);
+      var
+        tempstr, mangledname : string;
+        typesize,l,k : aint;
+      begin
+        tempstr:=actasmpattern;
+        Consume(AS_ID);
+        { typecasting? }
+        if (actasmtoken=AS_LPAREN) and
+           SearchType(tempstr,typesize) then
+         begin
+           oper.hastype:=true;
+           Consume(AS_LPAREN);
+           BuildOperand(oper);
+           Consume(AS_RPAREN);
+           if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+             oper.SetSize(typesize,true);
+         end
+        else
+         if not oper.SetupVar(tempstr,false) then
+          Message1(sym_e_unknown_id,tempstr);
+        { record.field ? }
+        if actasmtoken=AS_DOT then
+         begin
+           BuildRecordOffsetSize(tempstr,l,k,mangledname,false);
+           if (mangledname<>'') then
+             Message(asmr_e_invalid_reference_syntax);
+           inc(oper.opr.ref.offset,l);
+         end;
+      end;
+
+
+    Procedure tspc32attreader.BuildReference(oper : tspc32operand);
+
+      procedure Consume_RParen;
+        begin
+          if actasmtoken<>AS_RPAREN then
+           Begin
+             Message(asmr_e_invalid_reference_syntax);
+             RecoverConsume(true);
+           end
+          else
+           begin
+             Consume(AS_RPAREN);
+             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
+              Begin
+                Message(asmr_e_invalid_reference_syntax);
+                RecoverConsume(true);
+              end;
+           end;
+        end;
+
+
+      procedure read_index;
+        begin
+          Consume(AS_COMMA);
+          if actasmtoken=AS_REGISTER then
+            Begin
+              oper.opr.ref.index:=actasmregister;
+              Consume(AS_REGISTER);
+            end
+          else if actasmtoken=AS_HASH then
+            begin
+              Consume(AS_HASH);
+              inc(oper.opr.ref.offset,BuildConstExpression(false,true));
+            end;
+        end;
+
+
+      begin
+        Consume(AS_LPAREN);
+        if actasmtoken=AS_REGISTER then
+          begin
+            oper.opr.ref.base:=actasmregister;
+            Consume(AS_REGISTER);
+            { can either be a register or a right parenthesis }
+            { (reg)        }
+            if actasmtoken=AS_LPAREN then
+             Begin
+               Consume_RParen;
+               exit;
+             end;
+          end {end case }
+        else
+          Begin
+            Message(asmr_e_invalid_reference_syntax);
+            RecoverConsume(false);
+          end;
+      end;
+
+
+    Procedure tspc32attreader.BuildOperand(oper : tspc32operand);
+      var
+        expr : string;
+        typesize,l : aint;
+
+
+        procedure AddLabelOperand(hl:tasmlabel);
+          begin
+            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) { and
+               is_calljmp(actopcode) } then
+             begin
+               oper.opr.typ:=OPR_SYMBOL;
+               oper.opr.symbol:=hl;
+             end
+            else
+             begin
+               oper.InitRef;
+               oper.opr.ref.symbol:=hl;
+             end;
+          end;
+
+
+        procedure MaybeRecordOffset;
+          var
+            mangledname: string;
+            hasdot  : boolean;
+            l,
+            toffset,
+            tsize   : aint;
+          begin
+            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
+             exit;
+            l:=0;
+            hasdot:=(actasmtoken=AS_DOT);
+            if hasdot then
+              begin
+                if expr<>'' then
+                  begin
+                    BuildRecordOffsetSize(expr,toffset,tsize,mangledname,false);
+                    if (oper.opr.typ<>OPR_CONSTANT) and
+                       (mangledname<>'') then
+                      Message(asmr_e_wrong_sym_type);
+                    inc(l,toffset);
+                    oper.SetSize(tsize,true);
+                  end;
+              end;
+            if actasmtoken in [AS_PLUS,AS_MINUS] then
+              inc(l,BuildConstExpression(true,false));
+            case oper.opr.typ of
+              OPR_LOCAL :
+                begin
+                  { don't allow direct access to fields of parameters, because that
+                    will generate buggy code. Allow it only for explicit typecasting }
+                  if hasdot and
+                     (not oper.hastype) and
+                     (tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
+                     (current_procinfo.procdef.proccalloption<>pocall_register) then
+                    Message(asmr_e_cannot_access_field_directly_for_parameters);
+                  inc(oper.opr.localsymofs,l)
+                end;
+              OPR_CONSTANT :
+                inc(oper.opr.val,l);
+              OPR_REFERENCE :
+                if (mangledname<>'') then
+                  begin
+                    if (oper.opr.val<>0) then
+                      Message(asmr_e_wrong_sym_type);
+                    oper.opr.typ:=OPR_SYMBOL;
+                    oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname);
+                  end
+                else
+                  inc(oper.opr.val,l);
+              OPR_SYMBOL:
+                Message(asmr_e_invalid_symbol_ref);
+              else
+                internalerror(200309221);
+            end;
+          end;
+
+
+        function MaybeBuildReference:boolean;
+          { Try to create a reference, if not a reference is found then false
+            is returned }
+          begin
+            MaybeBuildReference:=true;
+            case actasmtoken of
+              AS_INTNUM,
+              AS_MINUS,
+              AS_PLUS:
+                Begin
+                  oper.opr.ref.offset:=BuildConstExpression(True,False);
+                  if actasmtoken<>AS_LPAREN then
+                    Message(asmr_e_invalid_reference_syntax)
+                  else
+                    BuildReference(oper);
+                end;
+              AS_LPAREN:
+                BuildReference(oper);
+              AS_ID: { only a variable is allowed ... }
+                Begin
+                  ReadSym(oper);
+                  case actasmtoken of
+                    AS_END,
+                    AS_SEPARATOR,
+                    AS_COMMA: ;
+                    AS_LPAREN:
+                      BuildReference(oper);
+                  else
+                    Begin
+                      Message(asmr_e_invalid_reference_syntax);
+                      Consume(actasmtoken);
+                    end;
+                  end; {end case }
+                end;
+              else
+               MaybeBuildReference:=false;
+            end; { end case }
+          end;
+
+
+      var
+        tempreg : tregister;
+        ireg : tsuperregister;
+        hl : tasmlabel;
+        ofs : longint;
+        registerset : tcpuregisterset;
+        tempstr : string;
+        tempsymtyp : tasmsymtype;
+      Begin
+        expr:='';
+        case actasmtoken of
+          AS_LBRACKET: { Memory reference or constant expression }
+            Begin
+              oper.InitRef;
+              BuildReference(oper);
+            end;
+
+          AS_INTNUM,
+          AS_MINUS,
+          AS_PLUS:
+            Begin
+              { Constant memory offset }
+              { This must absolutely be followed by (  }
+              oper.InitRef;
+              oper.opr.ref.offset:=BuildConstExpression(True,False);
+
+              { absolute memory addresss? }
+              {if actopcode in [A_LDS,A_STS] then
+                BuildReference(oper)
+              else}
+                begin
+                  ofs:=oper.opr.ref.offset;
+                  BuildConstantOperand(oper);
+                  inc(oper.opr.val,ofs);
+                end;
+            end;
+
+          AS_ID: { A constant expression, or a Variable ref.  }
+            Begin
+              if (actasmpattern='LO16') or (actasmpattern='HI16') then
+                begin
+                  { Low or High part of a constant (or constant
+                    memory location) }
+                  oper.InitRef;
+                  if actasmpattern='LO16' then
+                    oper.opr.ref.refaddr:=addr_lo16
+                  else
+                    oper.opr.ref.refaddr:=addr_hi16;
+                  Consume(actasmtoken);
+                  Consume(AS_LPAREN);
+                  BuildConstSymbolExpression(false, true,false,l,tempstr,tempsymtyp);
+                  if not assigned(oper.opr.ref.symbol) then
+                    oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr)
+                  else
+                    Message(asmr_e_cant_have_multiple_relocatable_symbols);
+                  case oper.opr.typ of
+                    OPR_CONSTANT :
+                      inc(oper.opr.val,l);
+                    OPR_LOCAL :
+                      inc(oper.opr.localsymofs,l);
+                    OPR_REFERENCE :
+                      inc(oper.opr.ref.offset,l);
+                    else
+                      internalerror(200309202);
+                  end;
+                  Consume(AS_RPAREN);
+                end
+              { Local Label ? }
+              else if is_locallabel(actasmpattern) then
+               begin
+                 CreateLocalLabel(actasmpattern,hl,false);
+                 Consume(AS_ID);
+                 AddLabelOperand(hl);
+               end
+              { Check for label }
+              else if SearchLabel(actasmpattern,hl,false) then
+                begin
+                  Consume(AS_ID);
+                  AddLabelOperand(hl);
+                end
+              else
+               { probably a variable or normal expression }
+               { or a procedure (such as in CALL ID)      }
+               Begin
+                 { is it a constant ? }
+                 if SearchIConstant(actasmpattern,l) then
+                  Begin
+                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
+                     Message(asmr_e_invalid_operand_type);
+                    BuildConstantOperand(oper);
+                  end
+                 else
+                  begin
+                    expr:=actasmpattern;
+                    Consume(AS_ID);
+                    { typecasting? }
+                    if (actasmtoken=AS_LPAREN) and
+                       SearchType(expr,typesize) then
+                     begin
+                       oper.hastype:=true;
+                       Consume(AS_LPAREN);
+                       BuildOperand(oper);
+                       Consume(AS_RPAREN);
+                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+                         oper.SetSize(typesize,true);
+                     end
+                    else
+                     begin
+                       if not(oper.SetupVar(expr,false)) then
+                        Begin
+                          { look for special symbols ... }
+                          if expr= '__HIGH' then
+                            begin
+                              consume(AS_LPAREN);
+                              if not oper.setupvar('high'+actasmpattern,false) then
+                                Message1(sym_e_unknown_id,'high'+actasmpattern);
+                              consume(AS_ID);
+                              consume(AS_RPAREN);
+                            end
+                          else
+                           if expr = '__RESULT' then
+                            oper.SetUpResult
+                          else
+                           if expr = '__SELF' then
+                            oper.SetupSelf
+                          else
+                           if expr = '__OLDEBP' then
+                            oper.SetupOldEBP
+                          else
+                            Message1(sym_e_unknown_id,expr);
+                        end;
+                     end;
+                  end;
+                  if actasmtoken=AS_DOT then
+                    MaybeRecordOffset;
+                  { add a constant expression? }
+                  if (actasmtoken=AS_PLUS) then
+                   begin
+                     l:=BuildConstExpression(true,false);
+                     case oper.opr.typ of
+                       OPR_CONSTANT :
+                         inc(oper.opr.val,l);
+                       OPR_LOCAL :
+                         inc(oper.opr.localsymofs,l);
+                       OPR_REFERENCE :
+                         inc(oper.opr.ref.offset,l);
+                       else
+                         internalerror(200309202);
+                     end;
+                   end
+               end;
+              { Do we have a indexing reference, then parse it also }
+              if actasmtoken=AS_LPAREN then
+                BuildReference(oper);
+            end;
+
+          { Register, a variable reference or a constant reference  }
+          AS_REGISTER:
+            Begin
+              { save the type of register used. }
+              tempreg:=actasmregister;
+              Consume(AS_REGISTER);
+              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+                Begin
+                  if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
+                    Message(asmr_e_invalid_operand_type);
+                  oper.opr.typ:=OPR_REGISTER;
+                  oper.opr.reg:=tempreg;
+                end
+              else
+                Message(asmr_e_syn_operand);
+            end;
+
+          AS_END,
+          AS_SEPARATOR,
+          AS_COMMA: ;
+        else
+          Begin
+            Message(asmr_e_syn_operand);
+            Consume(actasmtoken);
+          end;
+        end; { end case }
+      end;
+
+
+{*****************************************************************************
+                                tspc32attreader
+*****************************************************************************}
+
+    procedure tspc32attreader.BuildOpCode(instr : tspc32instruction);
+      var
+        operandnum : longint;
+      Begin
+        { opcode }
+        if (actasmtoken<>AS_OPCODE) then
+         Begin
+           Message(asmr_e_invalid_or_missing_opcode);
+           RecoverConsume(true);
+           exit;
+         end;
+        { Fill the instr object with the current state }
+        with instr do
+          begin
+            Opcode:=ActOpcode;
+            condition:=ActCondition;
+          end;
+
+        { We are reading operands, so opcode will be an AS_ID }
+        operandnum:=1;
+        Consume(AS_OPCODE);
+        { Zero operand opcode ?  }
+        if actasmtoken in [AS_SEPARATOR,AS_END] then
+         begin
+           operandnum:=0;
+           exit;
+         end;
+        { Read the operands }
+        repeat
+          case actasmtoken of
+            AS_COMMA: { Operand delimiter }
+              Begin
+                if operandnum>Max_Operands then
+                  Message(asmr_e_too_many_operands)
+                else
+                  Inc(operandnum);
+                Consume(AS_COMMA);
+              end;
+            AS_SEPARATOR,
+            AS_END : { End of asm operands for this opcode  }
+              begin
+                break;
+              end;
+          else
+            BuildOperand(instr.Operands[operandnum] as tspc32operand);
+          end; { end case }
+        until false;
+        instr.Ops:=operandnum;
+      end;
+
+
+    function tspc32attreader.is_asmopcode(const s: string):boolean;
+
+      const
+        { sorted by length so longer postfixes will match first }
+        postfix2strsorted : array[1..19] of string[2] = (
+          'EP','SB','BT','SH',
+          'IA','IB','DA','DB','FD','FA','ED','EA',
+          'B','D','E','P','T','H','S');
+
+      var
+        len,
+        j,
+        sufidx : longint;
+        hs : string;
+        maxlen : longint;
+        icond : tasmcond;
+      Begin
+        { making s a value parameter would break other assembler readers }
+        hs:=s;
+        is_asmopcode:=false;
+
+        { clear op code }
+        actopcode:=A_None;
+
+        actcondition:=C_None;
+
+        { first, handle B else BLS is read wrong }
+        if ((copy(hs,1,1)='J') and (length(hs)=3)) then
+          begin
+            for icond:=low(tasmcond) to high(tasmcond) do
+              begin
+                if copy(hs,2,2)=uppercond2str[icond] then
+                  begin
+                    actopcode:=A_Jxx;
+                    actasmtoken:=AS_OPCODE;
+                    actcondition:=icond;
+                    is_asmopcode:=true;
+                    exit;
+                  end;
+              end;
+          end;
+        maxlen:=max(length(hs),5);
+        actopcode:=A_NONE;
+        for j:=maxlen downto 1 do
+          begin
+            actopcode:=tasmop(PtrInt(iasmops.Find(copy(hs,1,j))));
+            if actopcode<>A_NONE then
+              begin
+                actasmtoken:=AS_OPCODE;
+                { strip op code }
+                delete(hs,1,j);
+                break;
+              end;
+          end;
+        if actopcode=A_NONE then
+          exit;
+        { search for condition, conditions are always 2 chars }
+        if length(hs)>1 then
+          begin
+            for icond:=low(tasmcond) to high(tasmcond) do
+              begin
+                if copy(hs,1,2)=uppercond2str[icond] then
+                  begin
+                    actcondition:=icond;
+                    { strip condition }
+                    delete(hs,1,2);
+                    break;
+                  end;
+              end;
+          end;
+        { if we stripped all postfixes, it's a valid opcode }
+        is_asmopcode:=length(hs)=0;
+      end;
+
+
+    procedure tspc32attreader.ConvertCalljmp(instr : tspc32instruction);
+      var
+        newopr : toprrec;
+      begin
+        if instr.Operands[1].opr.typ=OPR_REFERENCE then
+          begin
+            newopr.typ:=OPR_SYMBOL;
+            newopr.symbol:=instr.Operands[1].opr.ref.symbol;
+            newopr.symofs:=instr.Operands[1].opr.ref.offset;
+            if (instr.Operands[1].opr.ref.base<>NR_NO) or
+              (instr.Operands[1].opr.ref.index<>NR_NO) then
+              Message(asmr_e_syn_operand);
+            instr.Operands[1].opr:=newopr;
+          end;
+      end;
+
+
+    procedure tspc32attreader.handleopcode;
+      var
+        instr : tspc32instruction;
+      begin
+        instr:=tspc32instruction.Create(tspc32operand);
+        BuildOpcode(instr);
+{        if is_calljmp(instr.opcode) then
+          ConvertCalljmp(instr); }
+        {
+        instr.AddReferenceSizes;
+        instr.SetInstructionOpsize;
+        instr.CheckOperandSizes;
+        }
+        instr.ConcatInstruction(curlist);
+        instr.Free;
+      end;
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_spc32_standard_info : tasmmodeinfo =
+          (
+            id    : asmmode_standard;
+            idtxt : 'STANDARD';
+            casmreader : tspc32attreader;
+          );
+
+initialization
+  RegisterAsmMode(asmmode_spc32_standard_info);
+end.

compiler/spc32/rgcpu.pas

@@ -0,0 +1,191 @@
+{
+    Copyright (c) 1998-2008 by Florian Klaempfl
+
+    This unit implements the SPC32 specific class for the register
+    allocator
+
+    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.
+
+ ****************************************************************************
+}
+
+unit rgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+     uses
+       aasmbase,aasmtai,aasmdata,aasmcpu,
+       cgbase,cgutils,
+       cpubase,
+       rgobj;
+
+     type
+       trgcpu = class(trgobj)
+         procedure add_constraints(reg:tregister);override;
+         function do_spill_replace(list : TAsmList;instr : taicpu;
+           orgreg : tsuperregister;const spilltemp : treference) : boolean;override;
+         procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+         procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+       end;
+
+       trgintcpu = class(trgcpu)
+         procedure add_cpu_interferences(p : tai);override;
+       end;
+
+  implementation
+
+    uses
+      verbose, cutils,
+      cgobj,
+      procinfo;
+
+
+    procedure trgcpu.add_constraints(reg:tregister);
+      var
+        supreg,i : Tsuperregister;
+      begin
+        case getsubreg(reg) of
+          { Let 64bit floats conflict with all odd float regs }
+          R_SUBFD:
+            begin
+            {
+              supreg:=getsupreg(reg);
+              i:=RS_F1;
+              while (i<=RS_F31) do
+                begin
+                  add_edge(supreg,i);
+                  inc(i,2);
+                end;
+            }
+            end;
+          { Let 64bit ints conflict with all odd int regs }
+          R_SUBQ:
+            begin
+              supreg:=getsupreg(reg);
+              {
+              i:=RS_G1;
+              while (i<=RS_I7) do
+                begin
+                  add_edge(supreg,i);
+                  inc(i,2);
+                end;
+              }
+            end;
+        end;
+      end;
+
+
+    function trgcpu.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;
+      var
+        b : byte;
+      begin
+        result:=false;
+        //if abs(spilltemp.offset)>127 then
+          exit;
+
+        { Replace 'mov  dst,orgreg' with 'ldr  dst,spilltemp'
+          and     'mov  orgreg,src' with 'str  dst,spilltemp' }
+        with instr do
+          begin
+            if (opcode=A_MOV) and (ops=2) and (oper[1]^.typ=top_reg) and (oper[0]^.typ=top_reg) then
+              begin
+                if (getregtype(oper[0]^.reg)=regtype) and
+                   (get_alias(getsupreg(oper[0]^.reg))=orgreg) and
+                   (get_alias(getsupreg(oper[1]^.reg))<>orgreg) then
+                  begin
+                    { str expects the register in oper[0] }
+                    instr.loadreg(0,oper[1]^.reg);
+                    instr.loadref(1,spilltemp);
+                    opcode:=A_STORE;
+                    result:=true;
+                  end
+                else if (getregtype(oper[1]^.reg)=regtype) and
+                   (get_alias(getsupreg(oper[1]^.reg))=orgreg) and
+                   (get_alias(getsupreg(oper[0]^.reg))<>orgreg) then
+                  begin
+                    instr.loadref(1,spilltemp);
+                    opcode:=A_LOAD;
+                    result:=true;
+                  end;
+              end;
+          end;
+      end;
+
+
+    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+      var
+        helpins  : tai;
+        tmpref   : treference;
+        helplist : TAsmList;
+        hreg     : tregister;
+      begin
+        {if abs(spilltemp.offset)>63 then
+          begin
+            helplist:=TAsmList.create;
+
+            helplist.concat(taicpu.op_reg_const(A_LDI,NR_R26,lo(word(spilltemp.offset))));
+            helplist.concat(taicpu.op_reg_const(A_LDI,NR_R27,hi(word(spilltemp.offset))));
+            helplist.concat(taicpu.op_reg_reg(A_ADD,NR_R26,spilltemp.base));
+            helplist.concat(taicpu.op_reg_reg(A_ADC,NR_R27,GetNextReg(spilltemp.base)));
+
+            reference_reset_base(tmpref,NR_R26,0,1);
+            helpins:=spilling_create_load(tmpref,tempreg);
+            helplist.concat(helpins);
+            list.insertlistafter(pos,helplist);
+            helplist.free;
+          end
+        else}
+          inherited do_spill_read(list,pos,spilltemp,tempreg);
+      end;
+
+
+    procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+      var
+        tmpref   : treference;
+        helplist : TAsmList;
+        hreg     : tregister;
+      begin
+        {if abs(spilltemp.offset)>63 then
+          begin
+            helplist:=TAsmList.create;
+
+            helplist.concat(taicpu.op_reg_const(A_LDI,NR_R26,lo(word(spilltemp.offset))));
+            helplist.concat(taicpu.op_reg_const(A_LDI,NR_R27,hi(word(spilltemp.offset))));
+            helplist.concat(taicpu.op_reg_reg(A_ADD,NR_R26,spilltemp.base));
+            helplist.concat(taicpu.op_reg_reg(A_ADC,NR_R27,GetNextReg(spilltemp.base)));
+
+            reference_reset_base(tmpref,NR_R26,0,1);
+            helplist.concat(spilling_create_store(tempreg,tmpref));
+            list.insertlistafter(pos,helplist);
+            helplist.free;
+          end
+        else}
+          inherited do_spill_written(list,pos,spilltemp,tempreg);
+    end;
+
+
+    procedure trgintcpu.add_cpu_interferences(p : tai);
+      var
+        r : tsuperregister;
+      begin
+        if p.typ=ait_instruction then
+          begin
+          end;
+      end;
+
+
+end.

compiler/spc32/rspc32con.inc

@@ -0,0 +1,11 @@
+{ don't edit, this file is generated from spc32reg.dat }
+NR_NO = tregister($00000000);
+NR_R0 = tregister($01000000);
+NR_R1 = tregister($01000001);
+NR_R2 = tregister($01000002);
+NR_R3 = tregister($01000003);
+NR_R4 = tregister($01000004);
+NR_R5 = tregister($01000005);
+NR_R6 = tregister($01000006);
+NR_LR = tregister($05000007);
+NR_SREG = tregister($05000008);

compiler/spc32/rspc32dwa.inc

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

compiler/spc32/rspc32nor.inc

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

compiler/spc32/rspc32num.inc

@@ -0,0 +1,11 @@
+{ don't edit, this file is generated from spc32reg.dat }
+tregister($00000000),
+tregister($01000000),
+tregister($01000001),
+tregister($01000002),
+tregister($01000003),
+tregister($01000004),
+tregister($01000005),
+tregister($01000006),
+tregister($05000007),
+tregister($05000008)

compiler/spc32/rspc32rni.inc

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

compiler/spc32/rspc32sri.inc

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

compiler/spc32/rspc32sta.inc

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

compiler/spc32/rspc32std.inc

@@ -0,0 +1,11 @@
+{ don't edit, this file is generated from spc32reg.dat }
+'INVALID',
+'r0',
+'r1',
+'r2',
+'r3',
+'r4',
+'r5',
+'r6',
+'lr',
+'sreg'

compiler/spc32/rspc32sup.inc

@@ -0,0 +1,11 @@
+{ don't edit, this file is generated from spc32reg.dat }
+RS_NO = $00;
+RS_R0 = $00;
+RS_R1 = $01;
+RS_R2 = $02;
+RS_R3 = $03;
+RS_R4 = $04;
+RS_R5 = $05;
+RS_R6 = $06;
+RS_LR = $07;
+RS_SREG = $08;

compiler/spc32/spc32reg.dat

@@ -0,0 +1,18 @@
+;
+; SPA registers
+;
+; layout
+; <name>,<type>,<value>,<stdname>,<stab idx>,<dwarf idx>
+;
+NO,$00,$00,INVALID,-1,-1
+
+R0,$01,$00,r0,0,0
+R1,$01,$01,r1,1,1
+R2,$01,$02,r2,2,2
+R3,$01,$03,r3,3,3
+R4,$01,$04,r4,4,4
+R5,$01,$05,r5,5,5
+R6,$01,$06,r6,6,6
+
+LR,$05,$07,lr,7,7
+SREG,$05,$08,sreg,8,8

compiler/spc32/symcpu.pas

@@ -0,0 +1,211 @@
+{
+    Copyright (c) 2014 by Florian Klaempfl
+
+    Symbol table overrides for SPC32
+
+    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.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym,globtype;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+  tcpufiledefclass = class of tcpufiledef;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+  tcpuvariantdefclass = class of tcpuvariantdef;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+  tcpuformaldefclass = class of tcpuformaldef;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+  tcpuforwarddefclass = class of tcpuforwarddef;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+  tcpuundefineddefclass = class of tcpuundefineddef;
+
+  tcpuerrordef = class(terrordef)
+  end;
+  tcpuerrordefclass = class of tcpuerrordef;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+  tcpupointerdefclass = class of tcpupointerdef;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+  tcpurecorddefclass = class of tcpurecorddef;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+  tcpuobjectdefclass = class of tcpuobjectdef;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+  tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+  tcpuarraydefclass = class of tcpuarraydef;
+
+  tcpuorddef = class(torddef)
+  end;
+  tcpuorddefclass = class of tcpuorddef;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+  tcpufloatdefclass = class of tcpufloatdef;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+  tcpuprocvardefclass = class of tcpuprocvardef;
+
+  tcpuprocdef = class(tprocdef)
+  end;
+  tcpuprocdefclass = class of tcpuprocdef;
+
+  tcpustringdef = class(tstringdef)
+  end;
+  tcpustringdefclass = class of tcpustringdef;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+  tcpuenumdefclass = class of tcpuenumdef;
+
+  tcpusetdef = class(tsetdef)
+  end;
+  tcpusetdefclass = class of tcpusetdef;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+  tcpulabelsymclass = class of tcpulabelsym;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+  tcpuunitsymclass = class of tcpuunitsym;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+  tcpunamespacesymclass = class of tcpunamespacesym;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+  tcpuprocsymclass = class of tcpuprocsym;
+
+  tcputypesym = class(ttypesym)
+  end;
+  tcpuypesymclass = class of tcputypesym;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+  tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+  tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+  tcpuparavarsymclass = class of tcpuparavarsym;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+  tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+  tcpupropertysymclass = class of tcpupropertysym;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+  tcpuconstsymclass = class of tcpuconstsym;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+  tcpuenumsymclass = class of tcpuenumsym;
+
+  tcpusyssym = class(tsyssym)
+  end;
+  tcpusyssymclass = class of tcpusyssym;
+
+
+const
+  pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcputypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/symdef.pas

@@ -1052,6 +1052,9 @@ interface
        { FPC java procvar base class }
        java_procvarbase          : tobjectdef;
 
+{$ifdef SPC32}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif SPC32}
 
     function make_mangledname(const typeprefix:TSymStr;st:TSymtable;const suffix:TSymStr):TSymStr;
     function make_dllmangledname(const dllname,importname:TSymStr;

compiler/systems.inc

@@ -49,7 +49,8 @@
              cpu_avr,                      { 12 }
              cpu_mipsel,                   { 13 }
              cpu_jvm,                      { 14 }
-             cpu_i8086                     { 15 }
+             cpu_i8086,                    { 15 }
+             cpu_spc32                     { 16 }
        );
 
        tasmmode= (asmmode_none
@@ -162,7 +163,8 @@
              system_i8086_msdos,        { 79 }
              system_mipsel_android,     { 80 }
              system_mipseb_embedded,    { 81 }
-             system_mipsel_embedded     { 82 }
+             system_mipsel_embedded,    { 82 }
+             system_spc32_embedded      { 83 }
        );
 
      type
@@ -208,6 +210,7 @@
              ,as_i8086_nasm
              ,as_i8086_nasmobj
              ,as_gas_powerpc_xcoff
+             ,as_spc32_elf32
        );
 
        tlink = (ld_none,
@@ -241,7 +244,8 @@
              ld_int_linux,
              ld_int_nativent,
              ld_int_netware,
-             ld_int_windows
+             ld_int_windows,
+             ld_int_embedded
        );
 
        tar = (ar_none

compiler/systems.pas

@@ -347,7 +347,7 @@ interface
 
        cpu2str : array[TSystemCpu] of string[10] =
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
-             'mips','arm', 'powerpc64', 'avr', 'mipsel','jvm', 'i8086');
+             'mips','arm', 'powerpc64', 'avr', 'mipsel','jvm', 'i8086', 'spc32');
 
        abiinfo : array[tabi] of tabiinfo = (
          (name: 'DEFAULT'; supported: true),
@@ -918,6 +918,10 @@ begin
 {$ifdef i8086}
   default_target(system_i8086_msdos);
 {$endif i8086}
+
+{$ifdef spc32}
+  default_target(system_spc32_embedded);
+{$endif spc32}
 end;
 
 

compiler/systems/i_embed.pas

@@ -280,6 +280,69 @@ unit i_embed;
             abi : abi_default
           );
 
+       system_spc32_embedded_info : tsysteminfo =
+          (
+            system       : system_spc32_embedded;
+            name         : 'Embedded';
+            shortname    : 'embedded';
+            flags        : [tf_needs_symbol_size,tf_files_case_sensitive
+	                          ,tf_smartlink_sections];
+            cpu          : cpu_spc32;
+            unit_env     : '';
+            extradefines : '';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            importlibprefix : 'libimp';
+            importlibext : '.a';
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_spc32_elf32;
+            assemextern  : as_gas;
+            link         : ld_int_embedded;
+            linkextern   : ld_embedded;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            dbg          : dbg_stabs;
+            script       : script_unix;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 1;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 0;
+                varalignmax     : 4;
+                localalignmin   : 4;
+                localalignmax   : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 4;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 8;
+            stacksize    : 4096;
+            stackalign   : 4;
+            abi : abi_default
+          );
+
   implementation
 
 initialization
@@ -303,4 +366,9 @@ initialization
     set_source_info(system_i386_embedded_info);
   {$endif embedded}
 {$endif CPUI386}
+{$ifdef CPUSPC32}
+  {$ifdef embedded}
+    set_source_info(system_spc32_embedded_info);
+  {$endif embedded}
+{$endif CPUSPC32}
 end.

compiler/systems/t_embed.pas

@@ -33,7 +33,9 @@ implementation
        SysUtils,
        cutils,cfileutl,cclasses,
        globtype,globals,systems,verbose,comphook,script,fmodule,i_embed,link,
-       cpuinfo;
+       cpuinfo,
+       import,export,expunix,
+       ogelf;
 
     type
        TlinkerEmbedded=class(texternallinker)
@@ -46,6 +48,186 @@ implementation
           function postprocessexecutable(const fn : string;isdll:boolean):boolean;
        end;
 
+       TInternalLinkerEmbedded=class(TInternalLinker)
+       public
+         constructor Create;override;
+         procedure DefaultLinkScript;override;
+       end;
+
+       timportlibembedded=class(timportlib)
+       end;
+
+       texportlibembedded=class(texportlibunix)
+       end;
+
+
+{*****************************************************************************
+                                  TlinkerEmbedded
+*****************************************************************************}
+
+
+constructor TInternalLinkerEmbedded.Create;
+begin
+  inherited Create;
+  CExeOutput:=ElfExeOutputClass;
+  CObjInput:=TElfObjInput;
+end;
+
+
+procedure TInternalLinkerEmbedded.DefaultLinkScript;
+begin
+  LinkScript.Concat('ENTRYNAME _START');
+
+  ScriptAddSourceStatements(true);
+
+  with LinkScript do
+    begin
+      Concat('HEADER');
+      Concat('EXESECTION .interp');
+      Concat('  OBJSECTION .interp');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .note.ABI-tag');
+      Concat('  OBJSECTION .note.ABI-tag');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .note.gnu.build-id');
+      Concat('  OBJSECTION .note.gnu.build-id');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .hash');
+      Concat('  OBJSECTION .hash');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .dynsym');
+      Concat('  OBJSECTION .dynsym');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .dynstr');
+      Concat('  OBJSECTION .dynstr');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .gnu.version');
+      Concat('  OBJSECTION .gnu.version');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .gnu.version_d');
+      Concat('  OBJSECTION .gnu.version_d');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .gnu.version_r');
+      Concat('  OBJSECTION .gnu.version_r');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .plt');
+      Concat('  OBJSECTION .plt');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .text');
+      Concat('  OBJSECTION .init*');
+      Concat('  OBJSECTION .text*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .fini');
+      Concat('  OBJSECTION .fini');
+      Concat('  PROVIDE __etext');
+      Concat('  PROVIDE _etext');
+      Concat('  PROVIDE etext');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .rodata');
+      Concat('  OBJSECTION .rodata*');
+      Concat('ENDEXESECTION');
+{$ifdef arm}
+      Concat('EXESECTION .ARM.extab');
+      Concat('  OBJSECTION .ARM.extab*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .ARM.exidx');
+      Concat('  SYMBOL __exidx_start');
+      Concat('  OBJSECTION .ARM.exidx*');
+      Concat('  SYMBOL __exidx_end');
+      Concat('ENDEXESECTION');
+{$endif}
+      Concat('EXESECTION .eh_frame');
+      Concat('  OBJSECTION .eh_frame');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .gcc_except_table');
+      Concat('  OBJSECTION .gcc_except_table');
+      Concat('  OBJSECTION .gcc_except_table.*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .tdata');
+      Concat('  OBJSECTION .tdata');
+      Concat('  OBJSECTION .tdata.*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .tbss');
+      Concat('  OBJSECTION .tbss');
+      Concat('  OBJSECTION .tbss.*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .preinit_array');
+      Concat('  PROVIDE __preinit_array_start');
+      Concat('  OBJSECTION .preinit_array');
+      Concat('  PROVIDE __preinit_array_end');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .init_array');
+      Concat('  PROVIDE __init_array_start');
+      { why the hell .ctors are both here and exesection .ctors below?? }
+      //  KEEP ( *(SORT_BY_INIT_PRIORITY(.init_array.*) SORT_BY_INIT_PRIORITY(.ctors.*)))
+      Concat('  OBJSECTION .init_array');
+      //  KEEP ( *(EXCLUDE_FILE (*crtbegin.o *crtbegin?.o *crtend.o *crtend?.o ) .ctors))
+      Concat('PROVIDE __init_array_end');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .fini_array');
+      Concat('  PROVIDE __fini_array_start');
+      //  KEEP ( *(SORT_BY_INIT_PRIORITY(.fini_array.*) SORT_BY_INIT_PRIORITY(.dtors.*)))
+      Concat('  OBJSECTION .fini_array');
+      //  KEEP ( *(EXCLUDE_FILE (*crtbegin.o *crtbegin?.o *crtend.o *crtend?.o ) .dtors))
+      Concat('  PROVIDE __fini_array_end');
+      Concat('ENDEXESECTION');
+
+      Concat('EXESECTION .ctors');
+      Concat('  OBJSECTION .ctors*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .dtors');
+      Concat('  OBJSECTION .dtors*');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .jcr');
+      Concat('  OBJSECTION .jcr');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .dynamic');
+      Concat('  OBJSECTION .dynamic');
+      Concat('ENDEXESECTION');
+{$ifndef mips}
+      Concat('EXESECTION .got');
+{$ifdef arm}
+      Concat('  OBJSECTION .got.plt');
+{$endif arm}
+      Concat('  OBJSECTION .got');
+      Concat('ENDEXESECTION');
+{$endif mips}
+{$ifndef arm}
+      Concat('EXESECTION .got.plt');
+      Concat('  OBJSECTION .got.plt');
+      Concat('ENDEXESECTION');
+{$endif arm}
+      Concat('EXESECTION .data');
+      Concat('  OBJSECTION .data*');
+      Concat('  OBJSECTION .fpc*');
+      Concat('  OBJSECTION fpc.resources');
+      Concat('  PROVIDE _edata');
+      Concat('  PROVIDE edata');
+      Concat('ENDEXESECTION');
+{$ifdef mips}
+      Concat('EXESECTION .got');
+      Concat('  OBJSECTION .got');
+      Concat('ENDEXESECTION');
+{$endif mips}
+      Concat('EXESECTION .bss');
+      Concat('  OBJSECTION .dynbss');
+      Concat('  OBJSECTION .bss*');
+      Concat('  OBJSECTION fpc.reshandles');
+      Concat('  PROVIDE end');
+      Concat('  SYMBOL _end');
+      Concat('ENDEXESECTION');
+
+      ScriptAddGenericSections('.debug_aranges,.debug_pubnames,.debug_info,'+
+         '.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+
+         '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges');
+      Concat('EXESECTION .stab');
+      Concat('  OBJSECTION .stab');
+      Concat('ENDEXESECTION');
+      Concat('EXESECTION .stabstr');
+      Concat('  OBJSECTION .stabstr');
+      Concat('ENDEXESECTION');
+    end;
+end;
 
 
 {*****************************************************************************
@@ -1254,5 +1436,13 @@ initialization
   RegisterLinker(ld_embedded,TLinkerEmbedded);
   RegisterTarget(system_mipsel_embedded_info);
 {$endif mipsel}
+{$ifdef spc32}
+  RegisterLinker(ld_int_embedded,TInternalLinkerEmbedded);
+
+  RegisterImport(system_spc32_embedded,timportlibembedded);
+  RegisterExport(system_spc32_embedded,texportlibembedded);
 
+  RegisterLinker(ld_embedded,TLinkerEmbedded);
+  RegisterTarget(system_spc32_embedded_info);
+{$endif spc32}
 end.

compiler/utils/fpc.pp

@@ -155,6 +155,10 @@ program fpc;
      ppcbin:='ppcx64';
      processorname:='x86_64';
 {$endif x86_64}
+{$ifdef spc32}
+     ppcbin:='ppcspc32';
+     processorname:='spc32';
+{$endif spc32}
 {$ifdef mipsel}
      ppcbin:='ppcmipsel';
      processorname:='mipsel';
@@ -230,6 +234,8 @@ program fpc;
                              cpusuffix:='8086'
                            else if processorstr='avr' then
                              cpusuffix:='avr'
+                           else if processorstr='spc32' then
+                             cpusuffix:='spc32'
                            else
                              error('Illegal processor type "'+processorstr+'"');
 

compiler/utils/mkspc32reg.pp

@@ -0,0 +1,272 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl
+
+    Convert spreg.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 mkspc32reg;
+
+const Version = '1.00';
+      max_regcount = 200;
+
+var s : string;
+    i : longint;
+    line : longint;
+    regcount:byte;
+    regcount_bsstart:byte;
+    names,
+    regtypes,
+    supregs,
+    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 spc32reg.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,'spc32reg.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;
+        regtypes[regcount]:=readstr;
+        readcomma;
+        supregs[regcount]:=readstr;
+        readcomma;
+        stdnames[regcount]:=readstr;
+        readcomma;
+        stabs[regcount]:=readstr;
+        readcomma;
+        dwarf[regcount]:=readstr;
+        { Create register number }
+        if supregs[regcount][1]<>'$' then
+          begin
+            writeln('Missing $ before number, at line ',line);
+            writeln('Line: "',s,'"');
+            halt(1);
+          end;
+        numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255);
+        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,'rspc32con.inc');
+  openinc(supfile,'rspc32sup.inc');
+  openinc(numfile,'rspc32num.inc');
+  openinc(stdfile,'rspc32std.inc');
+  openinc(stabfile,'rspc32sta.inc');
+  openinc(dwarffile,'rspc32dwa.inc');
+  openinc(norfile,'rspc32nor.inc');
+  openinc(rnifile,'rspc32rni.inc');
+  openinc(srifile,'rspc32sri.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],' = ',supregs[i],';');
+      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.

compiler/utils/ppuutils/ppudump.pp

@@ -76,7 +76,8 @@ const
     { 12 } 'avr',
     { 13 } 'mipsel',
     { 14 } 'jvm',
-    { 15 } 'i8086'
+    { 15 } 'i8086',
+    { 16 } 'spc32'
     );
 
 { List of all supported system-cpu couples }
@@ -164,7 +165,8 @@ const
   { 79 }  'MSDOS-i8086',
   { 80 }  'Android-MIPSel',
   { 81 }  'Embedded-mipseb',
-  { 82 }  'Embedded-mipsel'
+  { 82 }  'Embedded-mipsel',
+  { 83 }  'Embedded-spc32'
   );
 
 const

rtl/embedded/Makefile.fpc

@@ -80,6 +80,11 @@ CPU_UNITS=lpc8xx lpc11xx lpc122x cortexm0
 endif
 endif
 
+ifeq ($(ARCH),spc32)
+CPU_SPECIFIC_COMMON_UNITS=sysutils sysconst
+CPU_UNITS=spc32v1
+endif
+
 ifeq ($(ARCH),avr)
 CPU_UNITS=atmega128
 endif

rtl/embedded/rtl.cfg

@@ -64,3 +64,15 @@
 -SfRANDOM
 #endif CPUMIPSEL
 
+#ifdef CPUSPC32
+-SfSOFTFPU
+-SfCLASSES
+-SfEXCEPTIONS
+-SfANSISTRINGS
+-SfRTTI
+-SfWIDESTRINGS
+-SfDYNARRAYS
+-SfVARIANTS
+-SfCOMMANDARGS
+-SfRANDOM
+#endif CPUSPC32

rtl/embedded/spc32/spc32v1.pp

@@ -0,0 +1,44 @@
+unit spc32v1;
+
+{$goto on}
+{$macro on}
+
+interface
+
+implementation
+
+var
+ _stack_top: record end; external name '_stack_top';
+ _data: record end; external name '_data';
+ _edata: record end; external name '_edata';
+ _text_start: record end; external name '_text_start';
+ _etext: record end; external name '_etext';
+ _bss_start: record end; external name '_bss_start';
+ _bss_end: record end; external name '_bss_end';
+
+procedure Pascalmain; external name 'PASCALMAIN';
+
+procedure HaltProc; assembler; nostackframe; public name'_haltproc';
+asm
+.Lloop:
+   gs 0
+   jmp .Lloop
+end;
+
+procedure Startup; assembler; nostackframe;
+label _start;
+asm
+  .init
+  .globl _start
+_start:
+  ld 0x1000
+  //ldu hi16(0x1000)
+  st r6
+  
+  nul
+  ldu hi16(Pascalmain)
+  jmp lo16(Pascalmain)
+  .text
+end;
+
+end.

rtl/inc/system.inc

@@ -247,6 +247,14 @@ function do_isdevice(handle:thandle):boolean;forward;
   {$define SYSPROCDEFINED}
 {$endif cpuavr}
 
+{$ifdef cpuspc32}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i spc32.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpuspc32}
+
 {$ifdef cpumipsel}
   {$ifdef SYSPROCDEFINED}
     {$Error Can't determine processor type !}

rtl/inc/systemh.inc

@@ -331,6 +331,29 @@ Type
   FarPointer = Pointer;
 {$endif CPUAVR}
 
+{$ifdef CPUSPC32}
+  {$define DEFAULT_DOUBLE}
+
+  {$define FPC_INCLUDE_SOFTWARE_MUL}
+  {$define FPC_INCLUDE_SOFTWARE_MOD_DIV}
+  {$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+
+  {$ifndef FPUNONE}
+    {$define SUPPORT_SINGLE}
+    {$define SUPPORT_DOUBLE}
+    
+    {$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+    
+    ValReal = Real;
+  {$endif}
+
+  { map comp to int64, but this doesn't mean we compile the comp support in! }
+  Comp = Int64;
+  PComp = ^Comp;
+
+  FarPointer = Pointer;
+{$endif CPUSPC32}
+
 {$ifdef CPU64}
   SizeInt = Int64;
   SizeUInt = QWord;

rtl/spc32/int64p.inc

@@ -0,0 +1,14 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    This file contains some helper routines for int64 and qword
+
+    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.
+
+ **********************************************************************}

rtl/spc32/makefile.cpu

@@ -0,0 +1,6 @@
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=spc32 math set
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))

rtl/spc32/math.inc

@@ -0,0 +1,15 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    Implementation of mathematical Routines (only for real)
+
+    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.
+
+ **********************************************************************}

rtl/spc32/set.inc

@@ -0,0 +1,15 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    Include file with set operations called by the 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.
+
+ **********************************************************************}

rtl/spc32/setjump.inc

@@ -0,0 +1,26 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    SetJmp and LongJmp implementation for exception handling
+
+    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.
+
+ **********************************************************************}
+
+function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;compilerproc;
+  asm
+  end;
+
+
+procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];compilerproc;
+  asm
+  end;
+
+

rtl/spc32/setjumph.inc

@@ -0,0 +1,25 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    SetJmp/Longjmp declarations
+
+    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.
+
+ **********************************************************************}
+
+type
+   jmp_buf = packed record
+   end;
+   pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : longint;[external name 'FPC_SETJMP'];
+procedure longjmp(var S : jmp_buf;value : longint);[external name 'FPC_LONGJMP'];
+
+

rtl/spc32/spc32.inc

@@ -0,0 +1,103 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    Processor dependent implementation for the system unit for
+    AVR
+
+    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.
+
+ **********************************************************************}
+
+{$if not(defined(FPUSOFT))}
+Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+  end;
+{$endif}
+
+
+procedure fpc_cpuinit;
+  begin
+    SysInitFPU;
+  end;
+
+
+
+{$IFNDEF INTERNAL_BACKTRACE}
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;nostackframe;
+  asm
+    ld r5
+    st r0
+  end;
+{$ENDIF not INTERNAL_BACKTRACE}
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;
+  asm
+  end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;
+  asm
+  end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : pointer;assembler;
+  asm
+  end;
+
+
+function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
+  asm
+    ld -1
+    st r1
+    ld r0
+    inc r1
+    st r0
+  end;
+
+
+function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
+  asm
+    ld 1
+    st r1
+    ld r0
+    inc r1
+    st r0
+  end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+  asm
+    ld r0
+    xchg r1
+    st r0
+  end;
+
+
+function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
+  asm
+    ld r0
+    cas r2, r1
+    st r0
+  end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+  asm
+    ld r0
+    inc r1
+    sub r1
+    st r0
+  end;
+

rtl/spc32/strings.inc

@@ -0,0 +1,16 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Jonas Maebe, member of the
+    Free Pascal development team
+
+    Processor dependent part of strings.pp, that can be shared with
+    sysutils unit.
+
+    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.
+
+ **********************************************************************}

rtl/spc32/stringss.inc

@@ -0,0 +1,17 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe, member of the
+    Free Pascal development team
+
+    Processor dependent part of strings.pp, not shared with
+    sysutils unit.
+
+    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.
+
+ **********************************************************************}
+

utils/fpcm/fpcmmain.pp

@@ -67,7 +67,7 @@ interface
 
     type
       TCpu=(
-        c_i386,c_m68k,c_powerpc,c_sparc,c_x86_64,c_arm,c_powerpc64,c_avr,c_armeb,c_armel,c_mips,c_mipsel,c_mips64,c_mips64el,c_jvm,c_i8086
+        c_i386,c_m68k,c_powerpc,c_sparc,c_x86_64,c_arm,c_powerpc64,c_avr,c_armeb,c_armel,c_mips,c_mipsel,c_mips64,c_mips64el,c_jvm,c_i8086,c_spc32
       );
 
       TOS=(
@@ -82,15 +82,15 @@ interface
 
     const
       CpuStr : array[TCpu] of string=(
-        'i386','m68k','powerpc','sparc','x86_64','arm','powerpc64','avr','armeb', 'armel', 'mips', 'mipsel', 'mips64', 'mips64el', 'jvm','i8086'
+        'i386','m68k','powerpc','sparc','x86_64','arm','powerpc64','avr','armeb', 'armel', 'mips', 'mipsel', 'mips64', 'mips64el', 'jvm','i8086','spc32'
       );
 
       CpuSuffix : array[TCpu] of string=(
-        '_i386','_m68k','_powerpc','_sparc','_x86_64','_arm','_powerpc64','avr','_armeb', '_armel', '_mips', '_mipsel', '_mips64', '_mips64el', '_jvm','_i8086'
+        '_i386','_m68k','_powerpc','_sparc','_x86_64','_arm','_powerpc64','avr','_armeb', '_armel', '_mips', '_mipsel', '_mips64', '_mips64el', '_jvm','_i8086','_spc32'
       );
 
       ppcSuffix : array[TCpu] of string=(
-        '386','m68k','ppc','sparc','x86_64','arm','ppc64','avr','armeb', 'armel', 'mips', 'mipsel', 'mips64', 'mips64el', 'jvm','8086'
+        '386','m68k','ppc','sparc','x86_64','arm','ppc64','avr','armeb', 'armel', 'mips', 'mipsel', 'mips64', 'mips64el', 'jvm','8086','spc32'
       );
 
       OSStr : array[TOS] of string=(
@@ -111,42 +111,42 @@ interface
 
       { This table is kept OS,Cpu because it is easier to maintain (PFV) }
       OSCpuPossible : array[TOS,TCpu] of boolean = (
-        { os          i386    m68k  ppc    sparc  x86_64 arm    ppc64  avr    armeb  armel  mips   mipsel mips64 misp64el jvm    i8086 }
-        { linux }   ( true,  true,  true,  true,  true,  true,  true,  false, true,  false, true,  true,  false, false,   false, false),
-        { go32v2 }  ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { win32 }   ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { os2 }     ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { freebsd } ( true,  true,  false, false, true,  false, false, false, false, false, false, false, false, false,   false, false),
-        { beos }    ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { haiku }   ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { netbsd }  ( true,  true,  true,  true,  true,  false, false, false, false, false, false, false, false, false,   false, false),
-        { amiga }   ( false, true,  true,  false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { atari }   ( false, true,  false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { solaris } ( true,  false, false, true,  true,  false, false, false, false, false, false, false, false, false,   false, false),
-        { qnx }     ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { netware } ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { openbsd } ( true,  true,  false, false, true,  false, false, false, false, false, false, false, false, false,   false, false),
-        { wdosx }   ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { palmos }  ( false, true,  false, false, false, true,  false, false, false, false, false, false, false, false,   false, false),
-        { macos }   ( false, false, true,  false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { darwin }  ( true,  false, true,  false, true,  true,  true,  false, false, false, false, false, false, false,   false, false),
-        { emx }     ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { watcom }  ( true,  false, false, false ,false, false, false, false, false, false, false, false, false, false,   false, false),
-        { morphos } ( false, false, true,  false ,false, false, false, false, false, false, false, false, false, false,   false, false),
-        { netwlibc }( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { win64   } ( false, false, false, false, true,  false, false, false, false, false, false, false, false, false,   false, false),
-        { wince    }( true,  false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false),
-        { gba    }  ( false, false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false),
-        { nds    }  ( false, false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false),
-        { embedded }( true,  true,  true,  true,  true,  true,  true,  true,  true , false, false, true , false, false,   false, false),
-        { symbian } ( true,  false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false),
-        { nativent }( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { iphonesim }( true, false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { wii }     ( false, false, true,  false, false, false, false, false, false, false, false, false, false, false,   false, false),
-        { aix }     ( false, false, true,  false, false, false, true,  false, false, false, false, false, false, false,   false, false),
-        { java }    ( false, false, false, false, false, false, false, false, false, false, false, false, false, false,   true,  false),
-        { android } ( true,  false, false, false, false, true,  false, false, false, false, false, true,  false, false,   true,  false),
-        { msdos }   ( false, false, false, false, false, false, false, false, false, false, false, false, false, false,   false, true)
+        { os          i386    m68k  ppc    sparc  x86_64 arm    ppc64  avr    armeb  armel  mips   mipsel mips64 misp64el jvm    i8086  spc32}
+        { linux }   ( true,  true,  true,  true,  true,  true,  true,  false, true,  false, true,  true,  false, false,   false, false, false),
+        { go32v2 }  ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { win32 }   ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { os2 }     ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { freebsd } ( true,  true,  false, false, true,  false, false, false, false, false, false, false, false, false,   false, false, false),
+        { beos }    ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { haiku }   ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { netbsd }  ( true,  true,  true,  true,  true,  false, false, false, false, false, false, false, false, false,   false, false, false),
+        { amiga }   ( false, true,  true,  false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { atari }   ( false, true,  false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { solaris } ( true,  false, false, true,  true,  false, false, false, false, false, false, false, false, false,   false, false, false),
+        { qnx }     ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { netware } ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { openbsd } ( true,  true,  false, false, true,  false, false, false, false, false, false, false, false, false,   false, false, false),
+        { wdosx }   ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { palmos }  ( false, true,  false, false, false, true,  false, false, false, false, false, false, false, false,   false, false, false),
+        { macos }   ( false, false, true,  false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { darwin }  ( true,  false, true,  false, true,  true,  true,  false, false, false, false, false, false, false,   false, false, false),
+        { emx }     ( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { watcom }  ( true,  false, false, false ,false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { morphos } ( false, false, true,  false ,false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { netwlibc }( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { win64   } ( false, false, false, false, true,  false, false, false, false, false, false, false, false, false,   false, false, false),
+        { wince    }( true,  false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false, false),
+        { gba    }  ( false, false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false, false),
+        { nds    }  ( false, false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false, false),
+        { embedded }( true,  true,  true,  true,  true,  true,  true,  true,  true , false, false, true , false, false,   false, false, true),
+        { symbian } ( true,  false, false, false, false, true,  false, false, false, false, false, false, false, false,   false, false, false),
+        { nativent }( true,  false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { iphonesim }( true, false, false, false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { wii }     ( false, false, true,  false, false, false, false, false, false, false, false, false, false, false,   false, false, false),
+        { aix }     ( false, false, true,  false, false, false, true,  false, false, false, false, false, false, false,   false, false, false),
+        { java }    ( false, false, false, false, false, false, false, false, false, false, false, false, false, false,   true,  false, false),
+        { android } ( true,  false, false, false, false, true,  false, false, false, false, false, true,  false, false,   true,  false, false),
+        { msdos }   ( false, false, false, false, false, false, false, false, false, false, false, false, false, false,   false, true,  false)
       );
 
     type