* very basic stuff for the arm

compiler/arm/cgcpu.pas

@@ -0,0 +1,161 @@
+{
+    $Id$
+
+    Copyright (c) 2003 by Florian Klaempfl
+    Member of the Free Pascal development team
+
+    This unit implements the code generator for the ARM
+
+    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
+       symtype,
+       cgbase,cgobj,
+       aasmbase,aasmcpu,aasmtai,
+       cpubase,cpuinfo,node,cg64f32,cginfo;
+       ;
+
+    type
+      tcgarm = class(tcg)
+        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);override;
+        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);override;
+        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
+
+        procedure a_call_name(list : taasmoutput;const s : string);override;
+        procedure a_call_reg(list : taasmoutput;reg: tregister); override;
+        procedure a_call_ref(list : taasmoutput;const ref : treference);override;
+
+        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); override;
+        procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
+
+        procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+          size: tcgsize; a: aword; src, dst: tregister); override;
+        procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+          size: tcgsize; src1, src2, dst: tregister); override;
+
+        { move instructions }
+        procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
+        procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
+        procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
+        procedure a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
+
+        { fpu move instructions }
+        procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
+        procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
+        procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
+
+        {  comparison operations }
+        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+          l : tasmlabel);override;
+        procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
+
+        procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
+        procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
+
+        procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
+
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);override;
+        procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
+        procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
+        procedure g_restore_frame_pointer(list : taasmoutput);override;
+
+        procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
+
+        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
+
+        procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); override;
+        { find out whether a is of the form 11..00..11b or 00..11...00. If }
+        { that's the case, we can use rlwinm to do an AND operation        }
+        function get_rlwi_const(a: aword; var l1, l2: longint): boolean;
+
+        procedure g_save_standard_registers(list : taasmoutput; usedinproc : Tsupregset);override;
+        procedure g_restore_standard_registers(list : taasmoutput; usedinproc : Tsupregset);override;
+        procedure g_save_all_registers(list : taasmoutput);override;
+        procedure g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);override;
+
+        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
+
+      private
+
+        procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
+        procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
+        procedure g_stackframe_entry_aix(list : taasmoutput;localsize : longint);
+        procedure g_return_from_proc_aix(list : taasmoutput;parasize : aword);
+        procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
+        procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword);
+
+
+        { Make sure ref is a valid reference for the PowerPC and sets the }
+        { base to the value of the index if (base = R_NO).                }
+        { Returns true if the reference contained a base, index and an    }
+        { offset or symbol, in which case the base will have been changed }
+        { to a tempreg (which has to be freed by the caller) containing   }
+        { the sum of part of the original reference                       }
+        function fixref(list: taasmoutput; var ref: treference): boolean;
+
+        { returns whether a reference can be used immediately in a powerpc }
+        { instruction                                                      }
+        function issimpleref(const ref: treference): boolean;
+
+        { contains the common code of a_load_reg_ref and a_load_ref_reg }
+        procedure a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
+                    ref: treference);
+
+        { creates the correct branch instruction for a given combination }
+        { of asmcondflags and destination addressing mode                }
+        procedure a_jmp(list: taasmoutput; op: tasmop;
+                        c: tasmcondflag; crval: longint; l: tasmlabel);
+
+     end;
+
+     tcg64farm = class(tcg64f32)
+       procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
+       procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
+       procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);override;
+       procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);override;
+     end;
+
+    {!!!!
+    const
+      TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_NONE,A_ADDI,A_ANDI_,A_DIVWU,
+                            A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
+                            A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
+      TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_NONE,A_ADDIS,A_ANDIS_,
+                            A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
+                            A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
+
+      TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
+                           C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
+    }
+
+  implementation
+
+begin
+  cg := tcgarm.create;
+  cg64 :=tcg64farm.create;
+end.
+{
+  $Log$
+  Revision 1.1  2003-07-21 16:35:30  florian
+    * very basic stuff for the arm
+}

compiler/arm/cpubase.pas

@@ -0,0 +1,531 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
+
+    Contains the base types for the ARM
+
+    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,
+  globals,
+  cpuinfo,
+  aasmbase,
+  cginfo;
+
+
+{*****************************************************************************
+                                Assembler Opcodes
+*****************************************************************************}
+
+    type
+      TAsmOp=(A_ADC,A_ADD,A_AND,A_N,A_BIC,A_BKPT,A_BL,A_BLX,A_BX,
+              A_CDP,A_CDP2,A_CLZ,A_CMN,A_CMP,A_EOR,A_LDC,_A_LDC2,
+              A_LDM,A_LDR,A_LDRB,A_LDRD,A_LDRBT,A_LDRH,A_LDRSB,
+              A_LDRSH,A_LDRT,A_MCR,A_MCR2,A_MCRR,A_MLA,A_MOV,
+              A_MRC,A_MRC2,A_MRRC,A_RS,A_MSR,A_MUL,A_MVN,
+              A_ORR,A_PLD,A_QADD,A_QDADD,A_QDSUB,A_QSUB,A_RSB,A_RSC,
+              A_SBC,A_SMLAL.A_SMLA,A_SMLAL,A_SMLAW,A_SMULL,A_SMUL,
+              A_SMULW,A_STC,A_STC2,A_STM,A_STR,A_STRB,A_STRBT,A_STRD,
+              A_STRH,A_STRT,A_SUB,A_SWI,A_SWP,A_SWPB,A_TEQ,A_TST.
+              A_UMLAL,A_UMULL);
+
+      {# 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);
+
+{*****************************************************************************
+                                Operand Sizes
+*****************************************************************************}
+
+    type
+      topsize = (S_NO,
+        S_B,S_W,S_L,S_BW,S_BL,S_WL,
+        S_IS,S_IL,S_IQ,
+        S_FS,S_FL,S_FX,S_D,S_Q,S_FV,
+        S_NEAR,S_FAR,S_SHORT
+      );
+
+{*****************************************************************************
+                                  Registers
+*****************************************************************************}
+
+    type
+      {# Enumeration for all possible registers for cpu. It
+        is to note that all registers of the same type
+        (for example all FPU registers), should be grouped
+        together.
+      }
+      { don't change the order }
+      { it's used by the register size conversions        }
+      tregister = (R_NO,
+        R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
+        R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
+        R_AL,R_CL,R_DL,R_BL,R_AH,R_CH,R_BH,R_DH,
+        R_CS,R_DS,R_ES,R_SS,R_FS,R_GS,
+        R_ST,R_ST0,R_ST1,R_ST2,R_ST3,R_ST4,R_ST5,R_ST6,R_ST7,
+        R_DR0,R_DR1,R_DR2,R_DR3,R_DR6,R_DR7,
+        R_CR0,R_CR2,R_CR3,R_CR4,
+        R_TR3,R_TR4,R_TR5,R_TR6,R_TR7,
+        R_MM0,R_MM1,R_MM2,R_MM3,R_MM4,R_MM5,R_MM6,R_MM7,
+        R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7
+      );
+
+      { A type to store register locations for 64 Bit values. }
+      tregister64 = packed record
+        reglo,reghi : tregister;
+      end;
+
+      { alias for compact code }
+      treg64 = tregister64;
+
+      {# Set type definition for registers }
+      tregisterset = set of tregister;
+
+      {# Type definition for the array of string of register names }
+      reg2strtable = array[tregister] of string[6];
+
+    const
+      {# First register in the tregister enumeration }
+      firstreg = low(tregister);
+      {# Last register in the tregister enumeration }
+      lastreg  = high(tregister);
+
+      firstsreg = R_CS;
+      lastsreg  = R_GS;
+
+      regset8bit  : tregisterset = [R_AL..R_DH];
+      regset16bit : tregisterset = [R_AX..R_DI,R_CS..R_SS];
+      regset32bit : tregisterset = [R_EAX..R_EDI];
+
+      { Convert reg to opsize }
+      reg2opsize : array[firstreg..lastreg] of topsize = (S_NO,
+        S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
+        S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
+        S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
+        S_W,S_W,S_W,S_W,S_W,S_W,
+        S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,
+        S_L,S_L,S_L,S_L,S_L,S_L,
+        S_L,S_L,S_L,S_L,
+        S_L,S_L,S_L,S_L,S_L,
+        S_D,S_D,S_D,S_D,S_D,S_D,S_D,S_D,
+        S_D,S_D,S_D,S_D,S_D,S_D,S_D,S_D
+      );
+
+      {# Standard opcode string table (for each tasmop enumeration). The
+         opcode strings should conform to the names as defined by the
+         processor manufacturer.
+      }
+      std_op2str:op2strtable={$i i386int.inc}
+
+      {# Standard register table (for each tregister enumeration). The
+         register strings should conform to the the names as defined
+         by the processor manufacturer
+      }
+      std_reg2str : reg2strtable = ('',
+        'eax','ecx','edx','ebx','esp','ebp','esi','edi',
+        'ax','cx','dx','bx','sp','bp','si','di',
+        'al','cl','dl','bl','ah','ch','bh','dh',
+        'cs','ds','es','ss','fs','gs',
+        'st','st(0)','st(1)','st(2)','st(3)','st(4)','st(5)','st(6)','st(7)',
+        'dr0','dr1','dr2','dr3','dr6','dr7',
+        'cr0','cr2','cr3','cr4',
+        'tr3','tr4','tr5','tr6','tr7',
+        'mm0','mm1','mm2','mm3','mm4','mm5','mm6','mm7',
+        'xmm0','xmm1','xmm2','xmm3','xmm4','xmm5','xmm6','xmm7'
+      );
+
+{*****************************************************************************
+                                Conditions
+*****************************************************************************}
+
+    type
+      TAsmCond=(C_None,
+        C_A,C_AE,C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_NA,C_NAE,
+        C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_NO,C_NP,
+        C_NS,C_NZ,C_O,C_P,C_PE,C_PO,C_S,C_Z
+      );
+
+    const
+      cond2str:array[TAsmCond] of string[3]=('',
+        'a','ae','b','be','c','e','g','ge','l','le','na','nae',
+        'nb','nbe','nc','ne','ng','nge','nl','nle','no','np',
+        'ns','nz','o','p','pe','po','s','z'
+      );
+
+      inverse_cond:array[TAsmCond] of TAsmCond=(C_None,
+        C_NA,C_NAE,C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_A,C_AE,
+        C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_O,C_P,
+        C_S,C_Z,C_NO,C_NP,C_NP,C_P,C_NS,C_NZ
+      );
+
+{*****************************************************************************
+                                   Flags
+*****************************************************************************}
+
+    type
+      TResFlags = (F_E,F_NE,F_G,F_L,F_GE,F_LE,F_C,F_NC,F_A,F_AE,F_B,F_BE);
+
+{*****************************************************************************
+                                Reference
+*****************************************************************************}
+
+    type
+      trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
+
+      { reference record }
+      preference = ^treference;
+      treference = packed record
+         segment,
+         base,
+         index       : tregister;
+         scalefactor : byte;
+         offset      : longint;
+         symbol      : tasmsymbol;
+         offsetfixup : longint;
+         options     : trefoptions;
+      end;
+
+      { reference record }
+      pparareference = ^tparareference;
+      tparareference = packed record
+         index       : tregister;
+         offset      : longint;
+      end;
+
+{*****************************************************************************
+                                Operands
+*****************************************************************************}
+
+      { Types of operand }
+      toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
+
+      toper=record
+        ot  : longint;
+        case typ : toptype of
+         top_none   : ();
+         top_reg    : (reg:tregister);
+         top_ref    : (ref:preference);
+         top_const  : (val:aword);
+         top_symbol : (sym:tasmsymbol;symofs:longint);
+      end;
+
+{*****************************************************************************
+                               Generic Location
+*****************************************************************************}
+
+    type
+      TLoc=(
+        LOC_INVALID,      { added for tracking problems}
+        LOC_CONSTANT,     { constant value }
+        LOC_JUMP,         { boolean results only, jump to false or true label }
+        LOC_FLAGS,        { boolean results only, flags are set }
+        LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
+        LOC_REFERENCE,    { in memory value }
+        LOC_REGISTER,     { in a processor register }
+        LOC_CREGISTER,    { Constant register which shouldn't be modified }
+        LOC_FPUREGISTER,  { FPU stack }
+        LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
+        LOC_MMXREGISTER,  { MMX register }
+        LOC_CMMXREGISTER, { MMX register variable }
+        LOC_SSEREGISTER,
+        LOC_CSSEREGISTER
+      );
+
+      { tparamlocation describes where a parameter for a procedure is stored.
+        References are given from the caller's point of view. The usual
+        TLocation isn't used, because contains a lot of unnessary fields.
+      }
+      tparalocation = packed record
+         size : TCGSize;
+         loc  : TLoc;
+         sp_fixup : longint;
+         case TLoc of
+            LOC_REFERENCE : (reference : tparareference);
+            { segment in reference at the same place as in loc_register }
+            LOC_REGISTER,LOC_CREGISTER : (
+              case longint of
+                1 : (register,registerhigh : tregister);
+                { overlay a registerlow }
+                2 : (registerlow : tregister);
+                { overlay a 64 Bit register type }
+                3 : (reg64 : tregister64);
+                4 : (register64 : tregister64);
+              );
+            { it's only for better handling }
+            LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
+      end;
+
+      tlocation = packed record
+         loc  : TLoc;
+         size : TCGSize;
+         case TLoc of
+            LOC_FLAGS : (resflags : tresflags);
+            LOC_CONSTANT : (
+              case longint of
+                1 : (value : AWord);
+                { can't do this, this layout depends on the host cpu. Use }
+                { lo(valueqword)/hi(valueqword) instead (JM)              }
+                { 2 : (valuelow, valuehigh:AWord);                        }
+                { overlay a complete 64 Bit value }
+                3 : (valueqword : qword);
+              );
+            LOC_CREFERENCE,
+            LOC_REFERENCE : (reference : treference);
+            { segment in reference at the same place as in loc_register }
+            LOC_REGISTER,LOC_CREGISTER : (
+              case longint of
+                1 : (register,registerhigh,segment : tregister);
+                { overlay a registerlow }
+                2 : (registerlow : tregister);
+                { overlay a 64 Bit register type }
+                3 : (reg64 : tregister64);
+                4 : (register64 : tregister64);
+              );
+            { it's only for better handling }
+            LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
+      end;
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+    const
+      { declare aliases }
+      LOC_MMREGISTER = LOC_SSEREGISTER;
+      LOC_CMMREGISTER = LOC_CSSEREGISTER;
+
+      max_operands = 3;
+
+      lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER,
+        LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER];
+
+      {# Constant defining possibly all registers which might require saving }
+      ALL_REGISTERS = [firstreg..lastreg];
+
+      general_registers = [R_EAX,R_EBX,R_ECX,R_EDX];
+
+      {# low and high of the available maximum width integer general purpose }
+      { registers                                                            }
+      LoGPReg = R_EAX;
+      HiGPReg = R_EDX;
+
+      {# low and high of every possible width general purpose register (same as }
+      { above on most architctures apart from the 80x86)                        }
+      LoReg = R_EAX;
+      HiReg = R_DH;
+
+      {# Table of registers which can be allocated by the code generator
+         internally, when generating the code.
+      }
+      { legend:                                                                }
+      { xxxregs = set of all possibly used registers of that type in the code  }
+      {           generator                                                    }
+      { usableregsxxx = set of all 32bit components of registers that can be   }
+      {           possible allocated to a regvar or using getregisterxxx (this }
+      {           excludes registers which can be only used for parameter      }
+      {           passing on ABI's that define this)                           }
+      { c_countusableregsxxx = amount of registers in the usableregsxxx set    }
+
+      maxintregs = 4;
+      intregs = [R_EAX..R_BL];
+      usableregsint = [R_EAX,R_EBX,R_ECX,R_EDX];
+      c_countusableregsint = 4;
+
+      maxfpuregs = 8;
+      fpuregs = [R_ST0..R_ST7];
+      usableregsfpu = [];
+      c_countusableregsfpu = 0;
+
+      mmregs = [R_MM0..R_MM7];
+      usableregsmm = [R_MM0..R_MM7];
+      c_countusableregsmm  = 8;
+
+      firstsaveintreg = R_EAX;
+      lastsaveintreg  = R_EBX;
+      firstsavefpureg = R_NO;
+      lastsavefpureg  = R_NO;
+      firstsavemmreg  = R_MM0;
+      lastsavemmreg   = R_MM7;
+
+      maxvarregs = 4;
+      varregs : array[1..maxvarregs] of tregister =
+         (R_EBX,R_EDX,R_ECX,R_EAX);
+
+      maxfpuvarregs = 8;
+
+      {# Registers which are defined as scratch and no need to save across
+         routine calls or in assembler blocks.
+      }
+      max_scratch_regs = 1;
+      scratch_regs : array[1..max_scratch_regs] of tregister = (R_EDI);
+
+
+{*****************************************************************************
+                               GDB Information
+*****************************************************************************}
+
+      {# Register indexes for stabs information, when some
+         parameters or variables are stored in registers.
+
+         Taken from i386.c (dbx_register_map) and i386.h
+          (FIXED_REGISTERS) from GCC 3.x source code
+
+      }
+          stab_regindex : array[tregister] of shortint =
+          (-1,
+          0,1,2,3,4,5,6,7,
+          0,1,2,3,4,5,6,7,
+          0,1,2,3,0,1,2,3,
+          -1,-1,-1,-1,-1,-1,
+          12,12,13,14,15,16,17,18,19,
+          -1,-1,-1,-1,-1,-1,
+          -1,-1,-1,-1,
+          -1,-1,-1,-1,-1,
+          29,30,31,32,33,34,35,36,
+          21,22,23,24,25,26,27,28
+        );
+
+{*****************************************************************************
+                          Default generic sizes
+*****************************************************************************}
+
+      {# Defines the default address size for a processor, }
+      OS_ADDR = OS_32;
+      {# the natural int size for a processor,             }
+      OS_INT = OS_32;
+      {# the maximum float size for a processor,           }
+      OS_FLOAT = OS_F80;
+      {# the size of a vector register for a processor     }
+      OS_VECTOR = OS_M64;
+
+{*****************************************************************************
+                          Generic Register names
+*****************************************************************************}
+
+      {# Stack pointer register }
+      stack_pointer_reg = R_ESP;
+      {# Frame pointer register }
+      frame_pointer_reg = R_EBP;
+      {# Self pointer register : contains the instance address of an
+         object or class. }
+      self_pointer_reg  = R_ESI;
+      {# 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
+      }
+      pic_offset_reg = R_EBX;
+      {# Results are returned in this register (32-bit values) }
+      accumulator   = R_EAX;
+      {# Hi-Results are returned in this register (64-bit value high register) }
+      accumulatorhigh = R_EDX;
+      { WARNING: don't change to R_ST0!! See comments above implementation of }
+      { a_loadfpu* methods in rgcpu (JM)                                      }
+      fpu_result_reg = R_ST;
+      mmresultreg = R_MM0;
+
+{*****************************************************************************
+                       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.
+      }
+      std_saved_registers = [R_ESI,R_EDI,R_EBX];
+      {# 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;
+
+{*****************************************************************************
+                            CPU Dependent Constants
+*****************************************************************************}
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    function is_calljmp(o:tasmop):boolean;
+
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+
+
+implementation
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    function is_calljmp(o:tasmop):boolean;
+      begin
+        case o of
+          A_CALL,
+          A_JCXZ,
+          A_JECXZ,
+          A_JMP,
+          A_LOOP,
+          A_LOOPE,
+          A_LOOPNE,
+          A_LOOPNZ,
+          A_LOOPZ,
+          A_Jcc :
+            is_calljmp:=true;
+          else
+            is_calljmp:=false;
+        end;
+      end;
+
+
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+      const
+        flags_2_cond : array[TResFlags] of TAsmCond =
+          (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
+      begin
+        result := flags_2_cond[f];
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2003-07-21 16:35:30  florian
+    * very basic stuff for the arm
+}

compiler/arm/cpuinfo.pas

@@ -0,0 +1,71 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by the Free Pascal development team
+
+    Basic Processor information for the ARM
+
+    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
+
+Type
+   { Architecture word - Native unsigned type }
+   AWord  = Longword;
+   PAWord = ^AWord;
+
+   { this must be an ordinal type with the same size as a pointer }
+   { to allow some dirty type casts for example when using        }
+   { tconstsym.value                                              }
+   { Note: must be unsigned!! Otherwise, ugly code like           }
+   { pointer(-1) will result in a pointer with the value          }
+   { $fffffffffffffff on a 32bit machine if the compiler uses     }
+   { int64 constants internally (JM)                              }
+   TConstPtrUInt = Longword;
+
+   bestreal = double;
+   ts32real = single;
+   ts64real = double;
+   ts80real = extended;
+   ts64comp = comp;
+
+   pbestreal=^bestreal;
+
+   { possible supported processors for this target }
+   tprocessors =
+      (no_processor,
+       armv4
+      );
+
+Const
+   {# Size of native extended floating point type }
+   extended_size = 8;
+   {# Size of a pointer                           }
+   pointer_size  = 4;
+   {# Size of a multimedia register               }
+   mmreg_size = 16;
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'arm';
+   { size of the buffer used for setjump/longjmp
+     the size of this buffer is deduced from the
+     jmp_buf structure in setjumph.inc file
+   }
+   { for linux: }
+   jmp_buf_size = 220; { according to sizeof(jmp_buf) on my Zaurus (FK) }
+
+Implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2003-07-21 16:35:30  florian
+    * very basic stuff for the arm
+}

compiler/arm/cpunode.pas

@@ -0,0 +1,51 @@
+{
+    $Id$
+    Copyright (c) 2000-2003 by Florian Klaempfl
+
+    This unit includes the ARM 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,
+       { to be able to only parts of the generic code,
+         the processor specific nodes must be included
+         after the generic one (FK)
+       }
+       narmadd,
+       narmcal,
+       narminl,
+       { this not really a node }
+       narmmat,
+       narmcnv
+       ;
+
+end.
+{
+  $Log$
+  Revision 1.1  2003-07-21 16:35:30  florian
+    * very basic stuff for the arm
+}

compiler/arm/cpupara.pas

@@ -0,0 +1,382 @@
+{
+    $Id$
+    Copyright (c) 2003 by Florian Klaempfl
+
+    ARM 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.
+ ****************************************************************************
+}
+{ ARM specific calling conventions are handled by this unit
+}
+unit cpupara;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       globtype,
+       aasmtai,
+       cpubase,
+       symconst,symbase,symtype,symdef,paramgr;
+
+    type
+       tarmparamanager = class(tparamanager)
+          function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
+          function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
+          procedure freeintparaloc(list: taasmoutput; nr : longint); override;
+          procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
+          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
+       end;
+
+  implementation
+
+    uses
+       verbose,systems,
+       cpuinfo,cginfo,cgbase,
+       rgobj,
+       defutil,symsym;
+
+    function tarmparamanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
+
+      begin
+         fillchar(result,sizeof(tparalocation),0);
+         if nr<1 then
+           internalerror(2002070801)
+         else if nr<=4 then
+           begin
+              result.loc:=LOC_REGISTER;
+              result.register.enum:=R_INTREGISTER;
+              result.register.number:=NR_R0+(nr-1)*(NR_R1-NR_R0);
+              rg.getexplicitregisterint(list,result.register.number);
+           end
+         else
+           begin
+              result.loc:=LOC_REFERENCE;
+              result.reference.index.enum:=R_INTREGISTER;
+              result.reference.index.number:=NR_STACK_POINTER_REG;
+              result.reference.offset:=(nr-4)*4;
+           end;
+         result.size := OS_INT;
+      end;
+
+
+    procedure tarmparamanager.freeintparaloc(list: taasmoutput; nr : longint);
+
+      var
+        r: tregister;
+
+      begin
+         if nr<1 then
+           internalerror(2003060401)
+         else if nr<=4 then
+           begin
+             r.enum := R_INTREGISTER;
+             r.number := NR_R0+(nr-1)*(NR_R1-NR_R0);
+             rg.ungetregisterint(list,r);
+           end;
+      end;
+
+
+    function getparaloc(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.deftype of
+            orddef:
+              getparaloc:=LOC_REGISTER;
+            floatdef:
+              getparaloc:=LOC_FPUREGISTER;
+            enumdef:
+              getparaloc:=LOC_REGISTER;
+            pointerdef:
+              getparaloc:=LOC_REGISTER;
+            formaldef:
+              getparaloc:=LOC_REGISTER;
+            classrefdef:
+              getparaloc:=LOC_REGISTER;
+            recorddef:
+              getparaloc:=LOC_REFERENCE;
+            objectdef:
+              if is_object(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            stringdef:
+              if is_shortstring(p) or is_longstring(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            procvardef:
+              if (po_methodpointer in tprocvardef(p).procoptions) then
+                getparaloc:=LOC_REFERENCE
+              else
+                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_REFERENCE;
+            { avoid problems with errornous definitions }
+            errordef:
+              getparaloc:=LOC_REGISTER;
+            else
+              internalerror(2002071001);
+         end;
+      end;
+
+    function tarmparamanager.push_addr_param(def : tdef;calloption : tproccalloption) : boolean;
+      begin
+        case def.deftype of
+          recorddef:
+            push_addr_param:=true;
+          arraydef:
+            push_addr_param:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
+                             is_open_array(def) or
+                             is_array_of_const(def) or
+                             is_array_constructor(def);
+          setdef :
+            push_addr_param:=(tsetdef(def).settype<>smallset);
+          stringdef :
+            push_addr_param:=tstringdef(def).string_typ in [st_shortstring,st_longstring];
+          procvardef :
+            push_addr_param:=po_methodpointer in tprocvardef(def).procoptions;
+          else
+            push_addr_param:=inherited push_addr_param(def,calloption);
+        end;
+      end;
+
+    procedure tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+
+      var
+         nextintreg,nextfloatreg,nextmmreg : tregister;
+         paradef : tdef;
+         paraloc : tparalocation;
+         stack_offset : aword;
+         hp : tparaitem;
+         loc : tcgloc;
+         is_64bit: boolean;
+
+      procedure assignintreg;
+
+        begin
+           if nextintreg.number<=NR_R10 then
+             begin
+                paraloc.loc:=LOC_REGISTER;
+                paraloc.register:=nextintreg;
+                inc(nextintreg.number,NR_R1-NR_R0);
+                if target_info.abi=abi_powerpc_aix then
+                  inc(stack_offset,4);
+             end
+           else
+              begin
+                 paraloc.loc:=LOC_REFERENCE;
+                 paraloc.reference.index.enum:=R_INTREGISTER;
+                 paraloc.reference.index.number:=NR_STACK_POINTER_REG;
+                 paraloc.reference.offset:=stack_offset;
+                 inc(stack_offset,4);
+             end;
+        end;
+
+      begin
+         { zero alignment bytes }
+         fillchar(nextintreg,sizeof(nextintreg),0);
+         fillchar(nextfloatreg,sizeof(nextfloatreg),0);
+         fillchar(nextmmreg,sizeof(nextmmreg),0);
+         nextintreg.enum:=R_INTREGISTER;
+         nextintreg.number:=NR_R0;
+         nextfloatreg.enum:=R_F0;
+         // nextmmreg:=0;
+         stack_offset:=0;
+
+         { frame pointer for nested procedures? }
+         { inc(nextintreg);                     }
+         { constructor? }
+         { destructor? }
+         hp:=tparaitem(p.para.first);
+         while assigned(hp) do
+           begin
+              if (hp.paratyp in [vs_var,vs_out]) then
+                begin
+                  paradef := voidpointertype.def;
+                  loc := LOC_REGISTER;
+                end
+              else
+                begin
+                  paradef := hp.paratype.def;
+                  loc:=getparaloc(paradef);
+                end;
+              { make sure all alignment bytes are 0 as well }
+              fillchar(paraloc,sizeof(paraloc),0);
+              case loc of
+                 LOC_REGISTER:
+                   begin
+                      paraloc.size := def_cgsize(paradef);
+                      { for things like formaldef }
+                      if paraloc.size = OS_NO then
+                        paraloc.size := OS_ADDR;
+                      is_64bit := paraloc.size in [OS_64,OS_S64];
+                      if nextintreg.number<=(NR_R10-ord(is_64bit)*(NR_R1-NR_R0))  then
+                        begin
+                           paraloc.loc:=LOC_REGISTER;
+		           if is_64bit then
+                             begin
+			       if odd((nextintreg.number-NR_R3) shr 8) and (target_info.abi=abi_powerpc_sysv) Then
+                                inc(nextintreg.number,NR_R1-NR_R0);
+                               paraloc.registerhigh:=nextintreg;
+                               inc(nextintreg.number,NR_R1-NR_R0);
+                               if target_info.abi=abi_powerpc_aix then
+                                 inc(stack_offset,4);
+                             end;
+                           paraloc.registerlow:=nextintreg;
+                           inc(nextintreg.number,NR_R1-NR_R0);
+                           if target_info.abi=abi_powerpc_aix then
+                             inc(stack_offset,4);
+
+                        end
+                      else
+                         begin
+                            nextintreg.number := NR_R11;
+                            paraloc.loc:=LOC_REFERENCE;
+                            paraloc.reference.index.enum:=R_INTREGISTER;
+                            paraloc.reference.index.number:=NR_STACK_POINTER_REG;
+                            paraloc.reference.offset:=stack_offset;
+                            if not is_64bit then
+                              inc(stack_offset,4)
+                            else
+                              inc(stack_offset,8);
+                        end;
+                   end;
+                 LOC_FPUREGISTER:
+                   begin
+                      paraloc.size:=def_cgsize(paradef);
+                      if nextfloatreg.enum<=R_F10 then
+                        begin
+                           paraloc.loc:=LOC_FPUREGISTER;
+                           paraloc.register:=nextfloatreg;
+                           inc(nextfloatreg.enum);
+                        end
+                      else
+                         begin
+                            {!!!!!!!}
+                            paraloc.size:=def_cgsize(paradef);
+                            internalerror(2002071004);
+                        end;
+                   end;
+                 LOC_REFERENCE:
+                   begin
+                      paraloc.size:=OS_ADDR;
+                      if push_addr_param(paradef,p.proccalloption) or
+                        is_open_array(paradef) or
+                        is_array_of_const(paradef) then
+                        assignintreg
+                      else
+                        begin
+                           paraloc.loc:=LOC_REFERENCE;
+                           paraloc.reference.index.enum:=R_INTREGISTER;
+                           paraloc.reference.index.number:=NR_STACK_POINTER_REG;
+                           paraloc.reference.offset:=stack_offset;
+                           inc(stack_offset,hp.paratype.def.size);
+                        end;
+                   end;
+                 else
+                   internalerror(2002071002);
+              end;
+              if side = callerside then
+                hp.callerparaloc:=paraloc
+              else
+                begin
+                  if (paraloc.loc = LOC_REFERENCE) then
+                    paraloc.reference.offset := tvarsym(hp.parasym).adjusted_address;
+                  hp.calleeparaloc:=paraloc;
+                end;
+              hp:=tparaitem(hp.next);
+           end;
+      end;
+
+
+    function tarmparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
+      begin
+         fillchar(result,sizeof(result),0);
+         case p.rettype.def.deftype of
+            orddef,
+            enumdef:
+              begin
+                getfuncretparaloc.loc:=LOC_REGISTER;
+                getfuncretparaloc.register.enum:=R_INTREGISTER;
+                getfuncretparaloc.register.number:=NR_R0;
+                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
+                if getfuncretparaloc.size in [OS_S64,OS_64] then
+                  begin
+                    getfuncretparaloc.registerhigh.enum:=R_INTREGISTER;
+                    getfuncretparaloc.registerhigh.number:=NR_R0;
+		    getfuncretparaloc.register.number:=NR_R1;
+                  end;
+              end;
+            floatdef:
+              begin
+                getfuncretparaloc.loc:=LOC_FPUREGISTER;
+                getfuncretparaloc.register.enum:=R_F0;
+                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
+              end;
+            { smallsets are OS_INT in R0, others are OS_ADDR in R0 -> the same }
+            { ugly, I know :) (JM)                                             }
+            setdef,
+            variantdef,
+            pointerdef,
+            formaldef,
+            classrefdef,
+            recorddef,
+            objectdef,
+            procvardef,
+            filedef,
+            arraydef,
+            stringdef:
+              begin
+                if (p.rettype.def.deftype <> stringdef) or
+                   (is_ansistring(p.rettype.def) or
+                    is_widestring(p.rettype.def)) then
+                  begin
+                    getfuncretparaloc.loc:=LOC_REGISTER;
+                    getfuncretparaloc.register.enum:=R_INTREGISTER;
+                    getfuncretparaloc.register.number:=NR_R0;
+                    getfuncretparaloc.size:=OS_ADDR;
+                  end
+                else
+                  internalerror(2003061601);
+              end;
+            else
+              internalerror(2002090903);
+        end;
+      end;
+
+
+begin
+   paramanager:=tarmparamanager.create;
+end.
+{
+  $Log$
+  Revision 1.1  2003-07-21 16:35:30  florian
+    * very basic stuff for the arm
+}

compiler/arm/radirect.pas

@@ -0,0 +1,355 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Reads inline Powerpc assembler and writes the lines direct to the output
+
+    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 reads ARM inline assembler and writes the lines direct to the output file.
+}
+unit radirect;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node;
+
+     function assemble : tnode;
+
+  implementation
+
+    uses
+       { common }
+       cutils,
+       { global }
+       globals,verbose,
+       systems,
+       { aasm }
+       aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,defutil,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       { codegen }
+       cgbase,
+       { constants }
+       agppcgas,
+       cpubase
+       ;
+
+    { checks if a string identifies a register }
+    { it should be optimized                   }
+    function is_register(const s : string) : boolean;
+      var
+         r : toldregister;
+      begin
+         is_register:=false;
+         if length(s)>5 then
+           exit;
+         for r:=low(gas_reg2str) to high(gas_reg2str) do
+           if gas_reg2str[r]=s then
+              begin
+                 is_register:=true;
+                 exit;
+              end;
+      end;
+
+    function assemble : tnode;
+
+      var
+         retstr,s,hs : string;
+         c : char;
+         ende : boolean;
+         srsym,sym : tsym;
+         srsymtable : tsymtable;
+         code : TAAsmoutput;
+         framereg : tregister;
+         i,l : longint;
+
+       procedure writeasmline;
+         var
+           i : longint;
+         begin
+           i:=length(s);
+           while (i>0) and (s[i] in [' ',#9]) do
+            dec(i);
+           s[0]:=chr(i);
+           if s<>'' then
+            code.concat(Tai_direct.Create(strpnew(s)));
+            { consider it set function set if the offset was loaded }
+           if assigned(current_procinfo.procdef.funcretsym) and
+              (pos(retstr,upper(s))>0) then
+             tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+           s:='';
+         end;
+
+     begin
+       ende:=false;
+       framereg.enum:=R_INTREGISTER;
+       framereg.number:=NR_FRAME_POINTER_REG;
+       convert_register_to_enum(framereg);
+       s:='';
+       if assigned(current_procinfo.procdef.funcretsym) and
+          is_fpu(current_procinfo.procdef.rettype.def) then
+         tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+       { !!!!!
+       if (not is_void(current_procinfo.procdef.rettype.def)) then
+         retstr:=upper(tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address)+'('+gas_reg2str[procinfo^.framepointer]+')')
+       else
+       }
+         retstr:='';
+
+       c:=current_scanner.asmgetchar;
+       code:=TAAsmoutput.Create;
+       while not(ende) do
+         begin
+            { wrong placement
+            current_scanner.gettokenpos; }
+            case c of
+              'A'..'Z','a'..'z','_':
+                begin
+                   current_scanner.gettokenpos;
+                   i:=0;
+                   hs:='';
+                   while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
+                      or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
+                      or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
+                      or (c='_') do
+                     begin
+                        inc(i);
+                        hs[i]:=c;
+                        c:=current_scanner.asmgetchar;
+                     end;
+                   hs[0]:=chr(i);
+                   if upper(hs)='END' then
+                      ende:=true
+                   else
+                      begin
+                         if c=':' then
+                           begin
+                             searchsym(upper(hs),srsym,srsymtable);
+                             if srsym<>nil then
+                               if (srsym.typ = labelsym) then
+                                 Begin
+                                    hs:=tlabelsym(srsym).lab.name;
+                                    tlabelsym(srsym).lab.is_set:=true;
+                                 end
+                               else
+                                 Message(asmr_w_using_defined_as_local);
+                           end
+                         else
+                           { access to local variables }
+                           if assigned(current_procinfo.procdef) then
+                             begin
+                                { I don't know yet, what the ppc port requires }
+                                { we'll see how things settle down             }
+
+                                { is the last written character an special }
+                                { char ?                                   }
+                                { !!!
+                                if (s[length(s)]='%') and
+                                   ret_in_acc(current_procinfo.procdef.rettype.def) and
+                                   ((pos('AX',upper(hs))>0) or
+                                   (pos('AL',upper(hs))>0)) then
+                                  tfuncretsym(current_procinfo.procdef.funcretsym).funcretstate:=vs_assigned;
+                                }
+                                if ((s[length(s)]<>'0') or (hs[1]<>'x')) and not(is_register(hs)) then
+                                  begin
+                                     if assigned(current_procinfo.procdef.localst) and
+                                        (current_procinfo.procdef.localst.symtablelevel >= normal_function_level) then
+                                       sym:=tsym(current_procinfo.procdef.localst.search(upper(hs)))
+                                     else
+                                       sym:=nil;
+                                     if assigned(sym) then
+                                       begin
+                                          if (sym.typ=labelsym) then
+                                            Begin
+                                               hs:=tlabelsym(sym).lab.name;
+                                            end
+                                          else if sym.typ=varsym then
+                                            begin
+                                               if (vo_is_external in tvarsym(sym).varoptions) then
+                                                 hs:=tvarsym(sym).mangledname
+                                               else
+                                                 begin
+                                                    if (tvarsym(sym).reg.enum<>R_NO) then
+// until new regallocator stuff settles down
+//                                                      hs:=gas_reg2str[procinfo.framepointer.enum]
+                                                      hs:=gas_reg2str[framereg.enum]
+                                                    else
+                                                      hs:=tostr(tvarsym(sym).address)+
+//                                                        '('+gas_reg2str[procinfo.framepointer.enum]+')';
+                                                        '('+gas_reg2str[framereg.enum]+')';
+                                                 end;
+                                            end
+                                          else
+                                          { call to local function }
+                                          if (sym.typ=procsym) and (pos('BL',upper(s))>0) then
+                                            hs:=tprocsym(sym).first_procdef.mangledname;
+                                       end
+                                     else
+                                       begin
+                                          if assigned(current_procinfo.procdef.parast) then
+                                            sym:=tsym(current_procinfo.procdef.parast.search(upper(hs)))
+                                          else
+                                            sym:=nil;
+                                          if assigned(sym) then
+                                            begin
+                                               if sym.typ=varsym then
+                                                 begin
+                                                    l:=tvarsym(sym).address;
+                                                    { set offset }
+                                                    inc(l,current_procinfo.procdef.parast.address_fixup);
+//                                                    hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer.enum]+')';
+                                                    hs:=tostr(l)+'('+gas_reg2str[framereg.enum]+')';
+                                                    if pos(',',s) > 0 then
+                                                      tvarsym(sym).varstate:=vs_used;
+                                                 end;
+                                            end
+                                          { I added that but it creates a problem in line.ppi
+                                          because there is a local label wbuffer and
+                                          a static variable WBUFFER ...
+                                          what would you decide, florian ?}
+                                          else
+                                            begin
+                                               searchsym(upper(hs),sym,srsymtable);
+                                               if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
+                                                 begin
+                                                   case sym.typ of
+                                                     constsym :
+                                                       begin
+                                                         inc(tconstsym(sym).refs);
+                                                         case tconstsym(sym).consttyp of
+                                                           constint,constchar,constbool :
+                                                             hs:=tostr(tconstsym(sym).value.valueord);
+                                                           constpointer :
+                                                             hs:=tostr(tconstsym(sym).value.valueordptr);
+                                                           else
+                                                             Message(asmr_e_wrong_sym_type);
+                                                         end;
+                                                       end;
+                                                     varsym :
+                                                       begin
+                                                         Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+                                                         hs:=tvarsym(sym).mangledname;
+                                                         inc(tvarsym(sym).refs);
+                                                       end;
+                                                     typedconstsym :
+                                                       begin
+                                                         Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+                                                         hs:=ttypedconstsym(sym).mangledname;
+                                                       end;
+                                                     procsym :
+                                                       begin
+                                                         { procs can be called or the address can be loaded }
+                                                         if (pos('BL',upper(s))>0) {or (pos('LEA',upper(s))>0))}  then
+                                                          begin
+                                                            if Tprocsym(sym).procdef_count>1 then
+                                                              Message1(asmr_w_direct_global_is_overloaded_func,hs);
+                                                            Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
+                                                            hs:=tprocsym(sym).first_procdef.mangledname;
+                                                          end;
+                                                       end;
+                                                     else
+                                                       Message(asmr_e_wrong_sym_type);
+                                                   end;
+                                                 end
+{$ifdef dummy}
+                                               else if upper(hs)='__SELF' then
+                                                 begin
+                                                    if assigned(procinfo^._class) then
+                                                      hs:=tostr(procinfo^.selfpointer_offset)+
+                                                          '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                    else
+                                                     Message(asmr_e_cannot_use_SELF_outside_a_method);
+                                                 end
+                                               else if upper(hs)='__RESULT' then
+                                                 begin
+                                                    if (not is_void(current_procinfo.procdef.rettype.def)) then
+                                                      hs:=retstr
+                                                    else
+                                                      Message(asmr_e_void_function);
+                                                 end
+                                               { implement old stack/frame pointer access for nested procedures }
+                                               {!!!!
+                                               else if upper(hs)='__OLDSP' then
+                                                 begin
+                                                    { complicate to check there }
+                                                    { we do it: }
+                                                    if lexlevel>normal_function_level then
+                                                      hs:=tostr(procinfo^.framepointer_offset)+
+                                                        '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                    else
+                                                      Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+                                                 end;
+                                               }
+                                               end;
+{$endif dummy}
+                                            end;
+                                       end;
+                                  end;
+                             end;
+                         s:=s+hs;
+                      end;
+                end;
+              '{',';',#10,#13:
+                begin
+                   if pos(retstr,s) > 0 then
+                     tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+                   writeasmline;
+                   c:=current_scanner.asmgetchar;
+                end;
+              #26:
+                Message(scan_f_end_of_file);
+              else
+                begin
+                  current_scanner.gettokenpos;
+                  inc(byte(s[0]));
+                  s[length(s)]:=c;
+                  c:=current_scanner.asmgetchar;
+                end;
+            end;
+         end;
+       writeasmline;
+       assemble:=casmnode.create(code);
+     end;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_arm_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_direct;
+            idtxt : 'DIRECT'
+          );
+
+initialization
+  RegisterAsmMode(asmmode_arm_direct_info);
+end.
+{
+  $Log$
+  Revision 1.1  2003-07-21 16:35:30  florian
+    * very basic stuff for the arm
+}