*** empty log message ***

compiler/sparc/aasmcpu.pas

@@ -0,0 +1,1195 @@
+{*****************************************************************************}
+{ File                   : aasmcpu.pas                                        }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\05\01                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman
+
+    Contains the assembler object for the i386
+
+    * This code was inspired by the NASM sources
+      The Netwide Assembler is copyright (C) 1996 Simon Tatham and
+      Julian Hall. All rights reserved.
+
+    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;
+{$INCLUDE fpcdefs.inc}
+INTERFACE
+USES
+  cclasses,globals,verbose,
+  cpuinfo,cpubase,
+  symppu,
+  aasmbase,aasmtai;
+CONST
+  MaxPrefixes=4;
+type
+  TOperandOrder = (op_intel,op_att);
+
+  { alignment for operator }
+  tai_align = class(tai_align_abstract)
+     reg       : tregister;
+     constructor create(b:byte);
+     constructor create_op(b: byte; _op: byte);
+     function getfillbuf:pchar;override;
+  end;
+
+  taicpu = class(taicpu_abstract)
+     opsize    : topsize;
+     constructor op_none(op : tasmop;_size : topsize);
+
+     constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
+     constructor op_const(op : tasmop;_size : topsize;_op1 : aword);
+     constructor op_ref(op : tasmop;_size : topsize;const _op1 : treference);
+
+     constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
+     constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference);
+     constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword);
+
+     constructor op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister);
+     constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword);
+     constructor op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference);
+
+     constructor op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister);
+     { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
+     constructor op_ref_ref(op : tasmop;_size : topsize;const _op1,_op2 : treference);
+
+     constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
+     constructor op_reg_const_reg(op:tasmop;_size:topsize;_op1:TRegister;_op2:aWord;_op3:tregister);
+     constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister);
+     constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; const _op3 : treference);
+     constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference);
+
+     { this is for Jmp instructions }
+     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
+
+     constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+     constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+     constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+     constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
+
+     procedure changeopsize(siz:topsize);
+
+     function  GetString:string;
+     procedure CheckNonCommutativeOpcodes;
+  private
+     FOperandOrder : TOperandOrder;
+     procedure init(_size : topsize); { this need to be called by all constructor }
+{$ifndef NOAG386BIN}
+  public
+     { the next will reset all instructions that can change in pass 2 }
+     procedure ResetPass1;
+     procedure ResetPass2;
+     function  CheckIfValid:boolean;
+     function  Pass1(offset:longint):longint;virtual;
+     procedure SetOperandOrder(order:TOperandOrder);
+  private
+     { next fields are filled in pass1, so pass2 is faster }
+     insentry  : PInsEntry;
+     insoffset,
+     inssize   : longint;
+     LastInsOffset : longint; { need to be public to be reset }
+     function  InsEnd:longint;
+     procedure create_ot;
+     function  Matches(p:PInsEntry):longint;
+     function  calcsize(p:PInsEntry):longint;
+     function  NeedAddrPrefix(opidx:byte):boolean;
+     procedure Swatoperands;
+{$endif NOAG386BIN}
+  end;
+PROCEDURE DoneAsm;
+PROCEDURE InitAsm;
+implementation
+
+uses
+  cutils,
+  CpuGas;
+{****************************************************************************
+                              TAI_ALIGN
+ ****************************************************************************}
+
+    constructor tai_align.create(b: byte);
+      begin
+        inherited create(b);
+        reg := R_NO;
+      end;
+
+
+    constructor tai_align.create_op(b: byte; _op: byte);
+      begin
+        inherited create_op(b,_op);
+        reg := R_NO;
+      end;
+
+
+    function tai_align.getfillbuf:pchar;
+      const
+        alignarray:array[0..5] of string[8]=(
+          #$8D#$B4#$26#$00#$00#$00#$00,
+          #$8D#$B6#$00#$00#$00#$00,
+          #$8D#$74#$26#$00,
+          #$8D#$76#$00,
+          #$89#$F6,
+          #$90
+        );
+      var
+        bufptr : pchar;
+        j : longint;
+      begin
+        if not use_op then
+         begin
+           bufptr:=@buf;
+           while (fillsize>0) do
+            begin
+              for j:=0 to 5 do
+               if (fillsize>=length(alignarray[j])) then
+                break;
+              move(alignarray[j][1],bufptr^,length(alignarray[j]));
+              inc(bufptr,length(alignarray[j]));
+              dec(fillsize,length(alignarray[j]));
+            end;
+         end;
+        getfillbuf:=pchar(@buf);
+      end;
+
+
+{*****************************************************************************
+                                 Taicpu Constructors
+*****************************************************************************}
+
+    procedure taicpu.changeopsize(siz:topsize);
+      begin
+        opsize:=siz;
+      end;
+
+
+    procedure taicpu.init(_size : topsize);
+      begin
+         { default order is att }
+         FOperandOrder:=op_att;
+         {segprefix:=R_NO;}{This may be only for I386 architecture!}
+         opsize:=_size;
+{$ifndef NOAG386BIN}
+         insentry:=nil;
+         LastInsOffset:=-1;
+         InsOffset:=0;
+         InsSize:=0;
+{$endif}
+      end;
+
+
+    constructor taicpu.op_none(op : tasmop;_size : topsize);
+      begin
+         inherited create(op);
+         init(_size);
+      end;
+
+
+    constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadreg(0,_op1);
+      end;
+
+
+    constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : aword);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadconst(0,_op1);
+      end;
+
+
+    constructor taicpu.op_ref(op : tasmop;_size : topsize;const _op1 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadref(0,_op1);
+      end;
+
+
+    constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadconst(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadconst(0,_op1);
+         loadconst(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadconst(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadref(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;const _op1,_op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadref(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadreg(2,_op3);
+      end;
+CONSTRUCTOR taicpu.op_reg_const_reg(op:tasmop;_size:topsize;_op1:TRegister;_op2:aWord;_op3:TRegister);
+  BEGIN
+    INHERITED create(op);
+    init(_size);
+    ops:=3;
+    LoadReg(0,_op1);
+    LoadConst(1,_op2);
+    LoadReg(2,_op3);
+  END;
+
+    constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;const _op3 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadref(2,_op3);
+      end;
+
+
+    constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadconst(0,_op1);
+         loadref(1,_op2);
+         loadreg(2,_op3);
+      end;
+
+
+    constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+         loadref(2,_op3);
+      end;
+
+
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         init(_size);
+         condition:=cond;
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadsymbol(0,_op1,_op1ofs);
+      end;
+
+
+    constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadsymbol(0,_op1,_op1ofs);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadsymbol(0,_op1,_op1ofs);
+         loadref(1,_op2);
+      end;
+
+    function taicpu.GetString:string;
+      var
+        i : longint;
+        s : string;
+        addsize : boolean;
+      begin
+        s:='['+std_op2str[opcode];
+        for i:=1to ops do
+         begin
+           if i=1 then
+            s:=s+' '
+           else
+            s:=s+',';
+           { type }
+           addsize:=false;
+           if (oper[i-1].ot and OT_XMMREG)=OT_XMMREG then
+            s:=s+'xmmreg'
+           else
+             if (oper[i-1].ot and OT_MMXREG)=OT_MMXREG then
+              s:=s+'mmxreg'
+           else
+             if (oper[i-1].ot and OT_FPUREG)=OT_FPUREG then
+              s:=s+'fpureg'
+           else
+            if (oper[i-1].ot and OT_REGISTER)=OT_REGISTER then
+             begin
+               s:=s+'reg';
+               addsize:=true;
+             end
+           else
+            if (oper[i-1].ot and OT_IMMEDIATE)=OT_IMMEDIATE then
+             begin
+               s:=s+'imm';
+               addsize:=true;
+             end
+           else
+            if (oper[i-1].ot and OT_MEMORY)=OT_MEMORY then
+             begin
+               s:=s+'mem';
+               addsize:=true;
+             end
+           else
+             s:=s+'???';
+           { size }
+           if addsize then
+            begin
+              if (oper[i-1].ot and OT_BITS8)<>0 then
+                s:=s+'8'
+              else
+               if (oper[i-1].ot and OT_BITS16)<>0 then
+                s:=s+'16'
+              else
+               if (oper[i-1].ot and OT_BITS32)<>0 then
+                s:=s+'32'
+              else
+                s:=s+'??';
+              { signed }
+              if (oper[i-1].ot and OT_SIGNED)<>0 then
+               s:=s+'s';
+            end;
+         end;
+        GetString:=s+']';
+      end;
+
+
+    procedure taicpu.Swatoperands;
+      var
+        p : TOper;
+      begin
+        { Fix the operands which are in AT&T style and we need them in Intel style }
+        case ops of
+          2 : begin
+                { 0,1 -> 1,0 }
+                p:=oper[0];
+                oper[0]:=oper[1];
+                oper[1]:=p;
+              end;
+          3 : begin
+                { 0,1,2 -> 2,1,0 }
+                p:=oper[0];
+                oper[0]:=oper[2];
+                oper[2]:=p;
+              end;
+        end;
+      end;
+
+
+    procedure taicpu.SetOperandOrder(order:TOperandOrder);
+      begin
+        if FOperandOrder<>order then
+         begin
+           Swatoperands;
+           FOperandOrder:=order;
+         end;
+      end;
+
+
+{ This check must be done with the operand in ATT order
+  i.e.after swapping in the intel reader
+  but before swapping in the NASM and TASM writers PM }
+procedure taicpu.CheckNonCommutativeOpcodes;
+begin
+{  if ((ops=2) and
+     (oper[0].typ=top_reg) and
+     (oper[1].typ=top_reg) and
+     (oper[0].reg IN [R_F0..RF31])) or
+     (ops=0) then
+      if opcode=A_FSUBR then
+        opcode:=A_FSUB
+      else if opcode=A_FSUB then
+        opcode:=A_FSUBR
+      else if opcode=A_FDIVR then
+        opcode:=A_FDIV
+      else if opcode=A_FDIV then
+        opcode:=A_FDIVR
+      else if opcode=A_FSUBRP then
+        opcode:=A_FSUBP
+      else if opcode=A_FSUBP then
+        opcode:=A_FSUBRP
+      else if opcode=A_FDIVRP then
+        opcode:=A_FDIVP
+      else if opcode=A_FDIVP then
+        opcode:=A_FDIVRP;
+   if  ((ops=1) and
+      (oper[0].typ=top_reg) and
+      (oper[0].reg in [R_ST1..R_ST7])) then
+      if opcode=A_FSUBRP then
+        opcode:=A_FSUBP
+      else if opcode=A_FSUBP then
+        opcode:=A_FSUBRP
+      else if opcode=A_FDIVRP then
+        opcode:=A_FDIVP
+      else if opcode=A_FDIVP then
+        opcode:=A_FDIVRP;}
+end;
+
+
+{*****************************************************************************
+                                Assembler
+*****************************************************************************}
+
+{$ifndef NOAG386BIN}
+
+type
+  ea=packed record
+    sib_present : boolean;
+    bytes : byte;
+    size  : byte;
+    modrm : byte;
+    sib   : byte;
+  end;
+
+procedure taicpu.create_ot;
+{
+  this function will also fix some other fields which only needs to be once
+}
+var
+  i,l,relsize : longint;
+begin
+  if ops=0 then
+   exit;
+  { update oper[].ot field }
+  for i:=0 to ops-1 do
+   with oper[i] do
+    begin
+      case typ of
+        top_reg :
+          {ot:=reg2type[reg]};
+        top_ref :
+          begin
+          { create ot field }
+            if (ot and OT_SIZE_MASK)=0 then
+              ot:=OT_MEMORY or opsize_2_type[i,opsize]
+            else
+              ot:=OT_MEMORY or (ot and OT_SIZE_MASK);
+            if (ref^.base=R_NO) and (ref^.index=R_NO) then
+              ot:=ot or OT_MEM_OFFS;
+          { fix scalefactor }
+            if (ref^.index=R_NO) then
+             ref^.scalefactor:=0
+            else
+             if (ref^.scalefactor=0) then
+              ref^.scalefactor:=1;
+          end;
+        top_const :
+          begin
+            if (opsize<>S_W) and (longint(val)>=-128) and (val<=127) then
+              ot:=OT_IMM8 or OT_SIGNED
+            else
+              ot:=OT_IMMEDIATE or opsize_2_type[i,opsize];
+          end;
+        top_symbol :
+          begin
+            if LastInsOffset=-1 then
+             l:=0
+            else
+             l:=InsOffset-LastInsOffset;
+            inc(l,symofs);
+            if assigned(sym) then
+             inc(l,sym.address);
+            { instruction size will then always become 2 (PFV) }
+            relsize:=(InsOffset+2)-l;
+            if (not assigned(sym) or
+                ((sym.currbind<>AB_EXTERNAL) and (sym.address<>0))) and
+               (relsize>=-128) and (relsize<=127) then
+             ot:=OT_IMM32 or OT_SHORT
+            else
+             ot:=OT_IMM32 or OT_NEAR;
+          end;
+      end;
+    end;
+end;
+
+
+function taicpu.InsEnd:longint;
+begin
+  InsEnd:=InsOffset+InsSize;
+end;
+
+
+function taicpu.Matches(p:PInsEntry):longint;
+{ * IF_SM stands for Size Match: any operand whose size is not
+ * explicitly specified by the template is `really' intended to be
+ * the same size as the first size-specified operand.
+ * Non-specification is tolerated in the input instruction, but
+ * _wrong_ specification is not.
+ *
+ * IF_SM2 invokes Size Match on only the first _two_ operands, for
+ * three-operand instructions such as SHLD: it implies that the
+ * first two operands must match in size, but that the third is
+ * required to be _unspecified_.
+ *
+ * IF_SB invokes Size Byte: operands with unspecified size in the
+ * template are really bytes, and so no non-byte specification in
+ * the input instruction will be tolerated. IF_SW similarly invokes
+ * Size Word, and IF_SD invokes Size Doubleword.
+ *
+ * (The default state if neither IF_SM nor IF_SM2 is specified is
+ * that any operand with unspecified size in the template is
+ * required to have unspecified size in the instruction too...)
+}
+var
+  i,j,asize,oprs : longint;
+  siz : array[0..2] of longint;
+begin
+  Matches:=100;
+
+  { Check the opcode and operands }
+  if (p^.opcode<>opcode) or (p^.ops<>ops) then
+   begin
+     Matches:=0;
+     exit;
+   end;
+
+  { Check that no spurious colons or TOs are present }
+  for i:=0 to p^.ops-1 do
+   if (oper[i].ot and (not p^.optypes[i]) and (OT_COLON or OT_TO))<>0 then
+    begin
+      Matches:=0;
+      exit;
+    end;
+
+  { Check that the operand flags all match up }
+  for i:=0 to p^.ops-1 do
+   begin
+     if ((p^.optypes[i] and (not oper[i].ot)) or
+         ((p^.optypes[i] and OT_SIZE_MASK) and
+          ((p^.optypes[i] xor oper[i].ot) and OT_SIZE_MASK)))<>0 then
+      begin
+        if ((p^.optypes[i] and (not oper[i].ot) and OT_NON_SIZE) or
+            (oper[i].ot and OT_SIZE_MASK))<>0 then
+         begin
+           Matches:=0;
+           exit;
+         end
+        else
+         Matches:=1;
+      end;
+   end;
+
+{ Check operand sizes }
+  { as default an untyped size can get all the sizes, this is different
+    from nasm, but else we need to do a lot checking which opcodes want
+    size or not with the automatic size generation }
+  asize:=longint($ffffffff);
+  if (p^.flags and IF_SB)<>0 then
+    asize:=OT_BITS8
+  else if (p^.flags and IF_SW)<>0 then
+    asize:=OT_BITS16
+  else if (p^.flags and IF_SD)<>0 then
+    asize:=OT_BITS32;
+  if (p^.flags and IF_ARMASK)<>0 then
+   begin
+     siz[0]:=0;
+     siz[1]:=0;
+     siz[2]:=0;
+     if (p^.flags and IF_AR0)<>0 then
+      siz[0]:=asize
+     else if (p^.flags and IF_AR1)<>0 then
+      siz[1]:=asize
+     else if (p^.flags and IF_AR2)<>0 then
+      siz[2]:=asize;
+   end
+  else
+   begin
+   { we can leave because the size for all operands is forced to be
+     the same
+     but not if IF_SB IF_SW or IF_SD is set PM }
+     if asize=-1 then
+       exit;
+     siz[0]:=asize;
+     siz[1]:=asize;
+     siz[2]:=asize;
+   end;
+
+  if (p^.flags and (IF_SM or IF_SM2))<>0 then
+   begin
+     if (p^.flags and IF_SM2)<>0 then
+      oprs:=2
+     else
+      oprs:=p^.ops;
+     for i:=0 to oprs-1 do
+      if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then
+       begin
+         for j:=0 to oprs-1 do
+          siz[j]:=p^.optypes[i] and OT_SIZE_MASK;
+         break;
+       end;
+    end
+   else
+    oprs:=2;
+
+  { Check operand sizes }
+  for i:=0 to p^.ops-1 do
+   begin
+     if ((p^.optypes[i] and OT_SIZE_MASK)=0) and
+        ((oper[i].ot and OT_SIZE_MASK and (not siz[i]))<>0) and
+        { Immediates can always include smaller size }
+        ((oper[i].ot and OT_IMMEDIATE)=0) and
+         (((p^.optypes[i] and OT_SIZE_MASK) or siz[i])<(oper[i].ot and OT_SIZE_MASK)) then
+      Matches:=2;
+   end;
+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.CheckIfValid:boolean;
+var
+  m,i : longint;
+begin
+  CheckIfValid:=false;
+{ Things which may only be done once, not when a second pass is done to
+  optimize }
+  if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then
+   begin
+     { We need intel style operands }
+     SetOperandOrder(op_intel);
+     { create the .ot fields }
+     create_ot;
+     { set the file postion }
+     aktfilepos:=fileinfo;
+   end
+  else
+   begin
+     { we've already an insentry so it's valid }
+     CheckIfValid:=true;
+     exit;
+   end;
+{ Lookup opcode in the table }
+  InsSize:=-1;
+  i:=instabcache^[opcode];
+  if i=-1 then
+   begin
+{$ifdef TP}
+     Message1(asmw_e_opcode_not_in_table,'');
+{$else}
+     Message1(asmw_e_opcode_not_in_table,std_op2str[opcode]);
+{$endif}
+     exit;
+   end;
+//  insentry:=@instab[i];
+  while (insentry^.opcode=opcode) do
+   begin
+     m:=matches(insentry);
+     if m=100 then
+      begin
+        InsSize:=calcsize(insentry);
+        {if (segprefix<>R_NO) then
+         inc(InsSize);}{No segprefix!}
+        { For opsize if size if forced }
+        if (insentry^.flags and (IF_SB or IF_SW or IF_SD))<>0 then
+           begin
+             if (insentry^.flags and IF_ARMASK)=0 then
+               begin
+                 if (insentry^.flags and IF_SB)<>0 then
+                   begin
+                     if opsize=S_NO then
+                       opsize:=S_B;
+                   end
+                 else if (insentry^.flags and IF_SW)<>0 then
+                   begin
+                     if opsize=S_NO then
+                       opsize:=S_W;
+                   end
+                 else if (insentry^.flags and IF_SD)<>0 then
+                   begin
+                     if opsize=S_NO then
+                       opsize:=S_L;
+                   end;
+               end;
+           end;
+        CheckIfValid:=true;
+        exit;
+      end;
+     inc(i);
+//     insentry:=@instab[i];
+   end;
+  if insentry^.opcode<>opcode then
+   Message1(asmw_e_invalid_opcode_and_operands,GetString);
+{ No instruction found, set insentry to nil and inssize to -1 }
+  insentry:=nil;
+  inssize:=-1;
+end;
+
+
+
+function taicpu.Pass1(offset:longint):longint;
+begin
+  Pass1:=0;
+{ Save the old offset and set the new offset }
+  InsOffset:=Offset;
+{ Things which may only be done once, not when a second pass is done to
+  optimize }
+  if Insentry=nil then
+   begin
+     { Check if error last time then InsSize=-1 }
+     if InsSize=-1 then
+      exit;
+     { set the file postion }
+     aktfilepos:=fileinfo;
+   end
+  else
+   begin
+{$ifdef PASS2FLAG}
+     { we are here in a second pass, check if the instruction can be optimized }
+     if (InsEntry^.flags and IF_PASS2)=0 then
+      begin
+        Pass1:=InsSize;
+        exit;
+      end;
+     { update the .ot fields, some top_const can be updated }
+     create_ot;
+{$endif}
+   end;
+{ Check if it's a valid instruction }
+  if CheckIfValid then
+   begin
+     LastInsOffset:=InsOffset;
+     Pass1:=InsSize;
+     exit;
+   end;
+  LastInsOffset:=-1;
+end;
+function taicpu.NeedAddrPrefix(opidx:byte):boolean;
+var
+  i,b : tregister;
+begin
+{  if (OT_MEMORY and (not oper[opidx].ot))=0 then
+   begin
+     i:=oper[opidx].ref^.index;
+     b:=oper[opidx].ref^.base;
+     if not(i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) or
+        not(b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) then
+      begin
+        NeedAddrPrefix:=true;
+        exit;
+      end;
+   end;}
+  NeedAddrPrefix:=false;
+end;
+
+
+function regval(r:tregister):byte;
+begin
+  {case r of
+    R_EAX,R_AX,R_AL,R_ES,R_CR0,R_DR0,R_ST,R_ST0,R_MM0,R_XMM0 :
+      regval:=0;
+    R_ECX,R_CX,R_CL,R_CS,R_DR1,R_ST1,R_MM1,R_XMM1 :
+      regval:=1;
+    R_EDX,R_DX,R_DL,R_SS,R_CR2,R_DR2,R_ST2,R_MM2,R_XMM2 :
+      regval:=2;
+    R_EBX,R_BX,R_BL,R_DS,R_CR3,R_DR3,R_TR3,R_ST3,R_MM3,R_XMM3 :
+      regval:=3;
+    R_ESP,R_SP,R_AH,R_FS,R_CR4,R_TR4,R_ST4,R_MM4,R_XMM4 :
+      regval:=4;
+    R_EBP,R_BP,R_CH,R_GS,R_TR5,R_ST5,R_MM5,R_XMM5 :
+      regval:=5;
+    R_ESI,R_SI,R_DH,R_DR6,R_TR6,R_ST6,R_MM6,R_XMM6 :
+      regval:=6;
+    R_EDI,R_DI,R_BH,R_DR7,R_TR7,R_ST7,R_MM7,R_XMM7 :
+      regval:=7;
+    else}
+      begin
+        internalerror(777001);
+        regval:=0;
+      end;
+{  end;}
+end;
+
+
+function process_ea(const input:toper;var output:ea;rfield:longint):boolean;
+{const
+  regs : array[0..63] of tregister=(
+    R_MM0, R_EAX, R_AX, R_AL, R_XMM0, R_NO, R_NO, R_NO,
+    R_MM1, R_ECX, R_CX, R_CL, R_XMM1, R_NO, R_NO, R_NO,
+    R_MM2, R_EDX, R_DX, R_DL, R_XMM2, R_NO, R_NO, R_NO,
+    R_MM3, R_EBX, R_BX, R_BL, R_XMM3, R_NO, R_NO, R_NO,
+    R_MM4, R_ESP, R_SP, R_AH, R_XMM4, R_NO, R_NO, R_NO,
+    R_MM5, R_EBP, R_BP, R_CH, R_XMM5, R_NO, R_NO, R_NO,
+    R_MM6, R_ESI, R_SI, R_DH, R_XMM6, R_NO, R_NO, R_NO,
+    R_MM7, R_EDI, R_DI, R_BH, R_XMM7, R_NO, R_NO, R_NO
+  );}
+var
+  j     : longint;
+  i,b   : tregister;
+  sym   : tasmsymbol;
+  md,s  : byte;
+  base,index,scalefactor,
+  o     : longint;
+begin
+  process_ea:=false;
+{ register ? }
+{  if (input.typ=top_reg) then
+   begin
+     j:=0;
+     while (j<=high(regs)) do
+      begin
+        if input.reg=regs[j] then
+         break;
+        inc(j);
+      end;
+     if j<=high(regs) then
+      begin
+        output.sib_present:=false;
+        output.bytes:=0;
+        output.modrm:=$c0 or (rfield shl 3) or (j shr 3);
+        output.size:=1;
+        process_ea:=true;
+      end;
+     exit;
+   end;}
+{ memory reference }
+  i:=input.ref^.index;
+  b:=input.ref^.base;
+  s:=input.ref^.scalefactor;
+  o:=input.ref^.offset+input.ref^.offsetfixup;
+  sym:=input.ref^.symbol;
+{ it's direct address }
+  if (b=R_NO) and (i=R_NO) then
+   begin
+     { it's a pure offset }
+     output.sib_present:=false;
+     output.bytes:=4;
+     output.modrm:=5 or (rfield shl 3);
+   end
+  else
+  { it's an indirection }
+   begin
+     { 16 bit address? }
+{     if not((i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) and
+            (b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI])) then
+      Message(asmw_e_16bit_not_supported);}
+{$ifdef OPTEA}
+     { make single reg base }
+     if (b=R_NO) and (s=1) then
+      begin
+        b:=i;
+        i:=R_NO;
+      end;
+     { convert [3,5,9]*EAX to EAX+[2,4,8]*EAX }
+{     if (b=R_NO) and
+        (((s=2) and (i<>R_ESP)) or
+          (s=3) or (s=5) or (s=9)) then
+      begin
+        b:=i;
+        dec(s);
+      end;}
+     { swap ESP into base if scalefactor is 1 }
+{     if (s=1) and (i=R_ESP) then
+      begin
+        i:=b;
+        b:=R_ESP;
+      end;}
+{$endif}
+     { wrong, for various reasons }
+{     if (i=R_ESP) or ((s<>1) and (s<>2) and (s<>4) and (s<>8) and (i<>R_NO)) then
+      exit;}
+     { base }
+{     case b of
+       R_EAX : base:=0;
+       R_ECX : base:=1;
+       R_EDX : base:=2;
+       R_EBX : base:=3;
+       R_ESP : base:=4;
+       R_NO,
+       R_EBP : base:=5;
+       R_ESI : base:=6;
+       R_EDI : base:=7;
+     else
+       exit;
+     end;}
+     { index }
+{     case i of
+       R_EAX : index:=0;
+       R_ECX : index:=1;
+       R_EDX : index:=2;
+       R_EBX : index:=3;
+       R_NO  : index:=4;
+       R_EBP : index:=5;
+       R_ESI : index:=6;
+       R_EDI : index:=7;
+     else
+       exit;
+     end;
+     case s of
+      0,
+      1 : scalefactor:=0;
+      2 : scalefactor:=1;
+      4 : scalefactor:=2;
+      8 : scalefactor:=3;
+     else
+      exit;
+     end;
+     if (b=R_NO) or
+        ((b<>R_EBP) and (o=0) and (sym=nil)) then
+      md:=0
+     else
+      if ((o>=-128) and (o<=127) and (sym=nil)) then
+       md:=1
+      else
+       md:=2;
+     if (b=R_NO) or (md=2) then
+      output.bytes:=4
+     else
+      output.bytes:=md;}
+     { SIB needed ? }
+{     if (i=R_NO) and (b<>R_ESP) then
+      begin
+        output.sib_present:=false;
+        output.modrm:=(md shl 6) or (rfield shl 3) or base;
+      end
+     else
+      begin
+        output.sib_present:=true;
+        output.modrm:=(md shl 6) or (rfield shl 3) or 4;
+        output.sib:=(scalefactor shl 6) or (index shl 3) or base;
+      end;}
+   end;
+  if output.sib_present then
+   output.size:=2+output.bytes
+  else
+   output.size:=1+output.bytes;
+  process_ea:=true;
+end;
+
+
+function taicpu.calcsize(p:PInsEntry):longint;
+var
+  codes : pchar;
+  c     : byte;
+  len     : longint;
+  ea_data : ea;
+begin
+  len:=0;
+  codes:=@p^.code;
+  repeat
+    c:=ord(codes^);
+    inc(codes);
+    case c of
+      0 :
+        break;
+      1,2,3 :
+        begin
+          inc(codes,c);
+          inc(len,c);
+        end;
+      8,9,10 :
+        begin
+          inc(codes);
+          inc(len);
+        end;
+      4,5,6,7 :
+        begin
+          if opsize=S_W then
+            inc(len,2)
+          else
+            inc(len);
+        end;
+      15,
+      12,13,14,
+      16,17,18,
+      20,21,22,
+      40,41,42 :
+        inc(len);
+      24,25,26,
+      31,
+      48,49,50 :
+        inc(len,2);
+      28,29,30, { we don't have 16 bit immediates code }
+      32,33,34,
+      52,53,54,
+      56,57,58 :
+        inc(len,4);
+      192,193,194 :
+        if NeedAddrPrefix(c-192) then
+         inc(len);
+      208 :
+        inc(len);
+      200,
+      201,
+      202,
+      209,
+      210,
+      217,218,219 : ;
+      216 :
+        begin
+          inc(codes);
+          inc(len);
+        end;
+      224,225,226 :
+        begin
+          InternalError(777002);
+        end;
+      else
+        begin
+          if (c>=64) and (c<=191) then
+           begin
+             if not process_ea(oper[(c shr 3) and 7], ea_data, 0) then
+              Message(asmw_e_invalid_effective_address)
+             else
+              inc(len,ea_data.size);
+           end
+          else
+           InternalError(777003);
+        end;
+    end;
+  until false;
+  calcsize:=len;
+end;
+
+
+{$endif NOAG386BIN}
+PROCEDURE DoneAsm;
+  BEGIN
+  END;
+PROCEDURE InitAsm;
+  BEGIN
+  END;
+end.

compiler/sparc/cgcpu.pas

@@ -0,0 +1,1066 @@
+{*****************************************************************************}
+{ File                   : cgcpu.pas                                          }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\04\26                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{   Copyright (c) 1998-2000 by Florian Klaempfl
+
+    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;
+{This unit implements the code generator for the SPARC architecture}
+{$INCLUDE fpcdefs.inc}
+INTERFACE
+USES
+  cginfo,cgbase,cgobj,cg64f32,
+  aasmbase,aasmtai,aasmcpu,
+  cpubase,cpuinfo,cpupara,
+  node,symconst;
+TYPE
+  tcgSPARC=CLASS(tcg)
+    PROCEDURE a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST LocPara:TParaLocation);OVERRIDE;
+{This method is used to pass a parameter, which is located in a register, to a
+routine. It should push/send the parameter to the routine, as required by the
+specific processor ABI. It is overriden for each CPU target.
+  Size : is the size of the operand in the register
+  r    : is the register source of the operand
+  nr   : is number of that parameter in the routine parameters list starting
+         from one from left to right}
+    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_ref(list:TAasmOutput;CONST ref:TReference);OVERRIDE;
+    PROCEDURE a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);OVERRIDE;
+    PROCEDURE a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);OVERRIDE;
+    PROCEDURE a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);OVERRIDE;
+    PROCEDURE a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);OVERRIDE;
+    PROCEDURE a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);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_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);OVERRIDE;
+    PROCEDURE a_load_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);OVERRIDE;
+    PROCEDURE a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);OVERRIDE;
+    PROCEDURE a_load_reg_reg(list:TAasmOutput;size:tcgsize;reg1,reg2:tregister);OVERRIDE;
+    PROCEDURE a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);OVERRIDE;
+        { fpu move instructions }
+    PROCEDURE a_loadfpu_reg_reg(list:TAasmOutput;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;
+        { vector register move instructions }
+    PROCEDURE a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);OVERRIDE;
+    PROCEDURE a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);OVERRIDE;
+    PROCEDURE a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);OVERRIDE;
+    PROCEDURE a_parammm_reg(list:TAasmOutput;reg:tregister);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_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;CONST ref:TReference;l:tasmlabel);OVERRIDE;
+    PROCEDURE a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel);OVERRIDE;
+    PROCEDURE a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);OVERRIDE;
+    PROCEDURE a_jmp_cond(list:TAasmOutput;cond:TOpCmp;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_stackframe_entry(list:TAasmOutput;localsize:LongInt);OVERRIDE;
+    PROCEDURE g_restore_frame_pointer(list:TAasmOutput);OVERRIDE;
+    PROCEDURE g_return_from_proc(list:TAasmOutput;parasize:aword);OVERRIDE;
+    PROCEDURE g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean);OVERRIDE;
+    class function reg_cgsize(CONST reg:tregister):tcgsize;OVERRIDE;
+  PRIVATE
+    PROCEDURE sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
+    PROCEDURE floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
+    PROCEDURE floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
+    PROCEDURE floatloadops(t:tcgsize;var op:tasmop;var s:topsize);
+    PROCEDURE floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
+  END;
+  TCg64fSPARC=class(tcg64f32)
+    PROCEDURE a_op64_ref_reg(list:TAasmOutput;op:TOpCG;CONST ref:TReference;reg:TRegister64);OVERRIDE;
+    PROCEDURE a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);OVERRIDE;
+    PROCEDURE a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);OVERRIDE;
+    PROCEDURE a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;CONST ref:TReference);OVERRIDE;
+    PROCEDURE get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
+  END;
+CONST
+  TOpCG2AsmOp:ARRAY[topcg]OF TAsmOp=(A_NONE,A_ADD,A_AND,A_UDIV,A_SDIV,A_UMUL, A_SMUL, A_NEG,A_NOT,A_OR,A_not,A_not,A_not,A_SUB,A_XOR);
+  TOpCmp2AsmCond:ARRAY[topcmp]OF TAsmCond=(C_NONE,C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A);
+  TCGSize2OpSize:ARRAY[tcgsize]OF TOpSize=(S_NO,S_B,S_W,S_L,S_L,S_B,S_W,S_L,S_L,S_FS,S_FL,S_FX,S_IQ,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
+IMPLEMENTATION
+USES
+  globtype,globals,verbose,systems,cutils,
+  symdef,symsym,defbase,paramgr,
+  rgobj,tgobj,rgcpu;
+    { we implement the following routines because otherwise we can't }
+    { instantiate the class since it's abstract                      }
+PROCEDURE tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST LocPara:TParaLocation);
+  BEGIN
+    IF(Size<>OS_32)AND(Size<>OS_S32)
+    THEN
+      InternalError(2002032212);
+    List.Concat(taicpu.op_reg(A_SAVE,S_L,r));
+  END;
+PROCEDURE tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);
+  BEGIN
+    IF(Size<>OS_32)AND(Size<>OS_S32)
+    THEN
+      InternalError(2002032213);
+    List.Concat(taicpu.op_const(A_SAVE,S_L,a));
+  END;
+PROCEDURE tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);
+  VAR
+    tmpreg:TRegister;
+  BEGIN
+    IF((Size=OS_32)AND(Size=OS_S32))
+    THEN
+      InternalError(2002032214);
+    list.concat(taicpu.op_ref(A_SAVE,S_L,r));
+  END;
+PROCEDURE tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
+  VAR
+    tmpreg:TRegister;
+  BEGIN
+    IF r.segment<>R_NO
+    THEN
+      CGMessage(cg_e_cant_use_far_pointer_there);
+    IF(r.base=R_NO)AND(r.index=R_NO)
+    THEN
+      list.concat(Taicpu.Op_sym_ofs(A_SAVE,S_L,r.symbol,r.offset))
+    ELSE IF(r.base=R_NO)AND(r.index<>R_NO)AND
+           (r.offset=0)AND(r.scalefactor=0)AND(r.symbol=nil)
+    THEN
+      list.concat(Taicpu.Op_reg(A_SAVE,S_L,r.index))
+    ELSE IF(r.base<>R_NO)AND(r.index=R_NO)AND
+           (r.offset=0)AND(r.symbol=nil)
+    THEN
+      list.concat(Taicpu.Op_reg(A_SAVE,S_L,r.base))
+    ELSE
+      BEGIN
+        tmpreg:=get_scratch_reg_address(list);
+        a_loadaddr_ref_reg(list,r,tmpreg);
+        list.concat(taicpu.op_reg(A_SAVE,S_L,tmpreg));
+        free_scratch_reg(list,tmpreg);
+      END;
+  END;
+PROCEDURE tcgSPARC.a_call_name(list:TAasmOutput;CONST s:string);
+  BEGIN
+    WITH List,objectlibrary DO
+      BEGIN
+        concat(taicpu.op_sym(A_CALL,S_NO,newasmsymbol(s)));
+        concat(taicpu.op_none(A_NOP,S_NO));
+      END;
+  END;
+PROCEDURE tcgSPARC.a_call_ref(list:TAasmOutput;CONST ref:TReference);
+  BEGIN
+    list.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+    list.concat(taicpu.op_none(A_NOP,S_NO));
+  END;
+{********************** load instructions ********************}
+PROCEDURE tcgSPARC.a_load_const_reg(list:TAasmOutput;size:TCGSize;a:aword;reg:TRegister);
+  BEGIN
+    WITH List DO
+      IF a<>0
+      THEN{R_G0 is usually set to zero, so we use it}
+        Concat(taicpu.op_reg_const_reg(A_OR,TCGSize2OpSize[size],R_G0,a,reg))
+      ELSE{The is no A_MOV in sparc, that's why we use A_OR with help of R_G0}
+        Concat(taicpu.op_reg_reg_reg(A_OR,TCGSize2OpSize[size],R_G0,R_G0,reg));
+  END;
+PROCEDURE tcgSPARC.a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);
+  BEGIN
+    WITH List DO
+      IF a=0
+      THEN
+        Concat(taicpu.op_reg_ref(A_ST,TCGSize2OpSize[size],R_G0,ref))
+      ELSE
+        BEGIN
+          a_load_const_reg(list,size,a,R_G1);
+          list.concat(taicpu.op_reg_ref(A_ST,TCGSize2OpSize[size],R_G1,ref));
+        END;
+  END;
+PROCEDURE tcgSPARC.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CONST ref:TReference);
+  BEGIN
+    list.concat(taicpu.op_reg_ref(A_NONE,TCGSize2OpSize[size],reg,ref));
+  END;
+PROCEDURE tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
+  VAR
+    op:tasmop;
+    s:topsize;
+  begin
+        sizes2load(size,S_L,op,s);
+        list.concat(taicpu.op_ref_reg(op,s,ref,reg));
+      end;
+
+
+    PROCEDURE tcgSPARC.a_load_reg_reg(list:TAasmOutput;size:tcgsize;reg1,reg2:tregister);
+
+      var
+        op:tasmop;
+        s:topsize;
+
+      begin
+        sizes2load(size,S_L,op,s);
+        if ((reg1) = (reg2)) then
+         begin
+           { "mov reg1, reg1" doesn't make sense }
+           if op = A_NONE then
+             exit;
+           { optimize movzx with "and ffff,<reg>" operation }
+           //if (op = A_NONEZX) then
+            begin
+              case size of
+                OS_8:
+                  begin
+                    list.concat(taicpu.op_const_reg(A_AND,S_L,255,reg2));
+                    exit;
+                  end;
+                OS_16:
+                  begin
+                    list.concat(taicpu.op_const_reg(A_AND,S_L,65535,reg2));
+                    exit;
+                  end;
+              end;
+            end;
+         end;
+        list.concat(taicpu.op_reg_reg(op,s,reg1,reg2));
+      end;
+    { all fpu load routines expect that R_ST[0-7] means an fpu regvar and }
+    { R_ST means "the current value at the top of the fpu stack" (JM)     }
+    PROCEDURE tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
+
+       begin
+         if NOT (reg1 IN [R_F0..R_F31]) then
+           begin
+             list.concat(taicpu.op_reg(A_NONE,S_NO,
+               trgcpu(rg).correct_fpuregister(reg1,trgcpu(rg).fpuvaroffset)));
+             inc(trgcpu(rg).fpuvaroffset);
+           end;
+         if NOT (reg2 IN [R_F0..R_F31]) then
+           begin
+             list.concat(taicpu.op_reg(A_JMPL,S_NO,
+                 trgcpu(rg).correct_fpuregister(reg2,trgcpu(rg).fpuvaroffset)));
+             dec(trgcpu(rg).fpuvaroffset);
+           end;
+       end;
+
+
+    PROCEDURE tcgSPARC.a_loadfpu_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
+
+       begin
+         floatload(list,size,ref);
+{         if (reg <> R_ST) then
+           a_loadfpu_reg_reg(list,R_ST,reg);}
+       end;
+
+
+    PROCEDURE tcgSPARC.a_loadfpu_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);
+
+       begin
+{         if reg <> R_ST then
+           a_loadfpu_reg_reg(list,reg,R_ST);}
+         floatstore(list,size,ref);
+       end;
+
+
+    PROCEDURE tcgSPARC.a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
+
+       begin
+//         list.concat(taicpu.op_reg_reg(A_NONEQ,S_NO,reg1,reg2));
+       end;
+
+
+    PROCEDURE tcgSPARC.a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);
+
+       begin
+//         list.concat(taicpu.op_ref_reg(A_NONEQ,S_NO,ref,reg));
+       end;
+
+
+    PROCEDURE tcgSPARC.a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);
+
+       begin
+//         list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,ref));
+       end;
+PROCEDURE tcgSPARC.a_parammm_reg(list:TAasmOutput;reg:tregister);
+  VAR
+    href:TReference;
+  BEGIN
+//    list.concat(taicpu.op_const_reg(A_SUB,S_L,8,R_RSP));
+//    reference_reset_base(href,R_ESP,0);
+//    list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,href));
+  END;
+PROCEDURE tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);
+
+      var
+        opcode:tasmop;
+        power:LongInt;
+
+      begin
+(*       Case Op of
+          OP_DIV, OP_IDIV:
+            Begin
+              if ispowerof2(a,power) then
+                begin
+                  case op of
+                    OP_DIV:
+                      opcode := A_SHR;
+                    OP_IDIV:
+                      opcode := A_SAR;
+                  end;
+                  list.concat(taicpu.op_const_reg(opcode,S_L,power,
+                    reg));
+                  exit;
+                end;
+              { the rest should be handled specifically in the code      }
+              { generator because of the silly register usage restraints }
+              internalerror(200109224);
+            End;
+          OP_MUL,OP_IMUL:
+            begin
+              if not(cs_check_overflow in aktlocalswitches) and
+                 ispowerof2(a,power) then
+                begin
+                  list.concat(taicpu.op_const_reg(A_SHL,S_L,power,
+                    reg));
+                  exit;
+                end;
+              if op = OP_IMUL then
+                list.concat(taicpu.op_const_reg(A_IMUL,S_L,
+                  a,reg))
+              else
+                { OP_MUL should be handled specifically in the code        }
+                { generator because of the silly register usage restraints }
+                internalerror(200109225);
+            end;
+          OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
+            if not(cs_check_overflow in aktlocalswitches) and
+               (a = 1) and
+               (op in [OP_ADD,OP_SUB]) then
+              if op = OP_ADD then
+                list.concat(taicpu.op_reg(A_INC,S_L,reg))
+              else
+                list.concat(taicpu.op_reg(A_DEC,S_L,reg))
+            else if (a = 0) then
+              if (op <> OP_AND) then
+                exit
+              else
+                list.concat(taicpu.op_const_reg(A_NONE,S_L,0,reg))
+            else if (a = high(aword)) and
+                    (op in [OP_AND,OP_OR,OP_XOR]) then
+                   begin
+                     case op of
+                       OP_AND:
+                         exit;
+                       OP_OR:
+                         list.concat(taicpu.op_const_reg(A_NONE,S_L,high(aword),reg));
+                       OP_XOR:
+                         list.concat(taicpu.op_reg(A_NOT,S_L,reg));
+                     end
+                   end
+            else
+              list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],S_L,
+                a,reg));
+          OP_SHL,OP_SHR,OP_SAR:
+            begin
+              if (a and 31) <> 0 Then
+                list.concat(taicpu.op_const_reg(
+                  TOpCG2AsmOp[op],S_L,a and 31,reg));
+              if (a shr 5) <> 0 Then
+                internalerror(68991);
+            end
+          else internalerror(68992);
+        end;*)
+      end;
+
+
+     PROCEDURE tcgSPARC.a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);
+
+      var
+        opcode:tasmop;
+        power:LongInt;
+
+      begin
+(*        Case Op of
+          OP_DIV, OP_IDIV:
+            Begin
+              if ispowerof2(a,power) then
+                begin
+                  case op of
+                    OP_DIV:
+                      opcode := A_SHR;
+                    OP_IDIV:
+                      opcode := A_SAR;
+                  end;
+                  list.concat(taicpu.op_const_ref(opcode,
+                    TCgSize2OpSize[size],power,ref));
+                  exit;
+                end;
+              { the rest should be handled specifically in the code      }
+              { generator because of the silly register usage restraints }
+              internalerror(200109231);
+            End;
+          OP_MUL,OP_IMUL:
+            begin
+              if not(cs_check_overflow in aktlocalswitches) and
+                 ispowerof2(a,power) then
+                begin
+                  list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size],
+                    power,ref));
+                  exit;
+                end;
+              { can't multiply a memory location directly with a CONSTant }
+              if op = OP_IMUL then
+                inherited a_op_const_ref(list,op,size,a,ref)
+              else
+                { OP_MUL should be handled specifically in the code        }
+                { generator because of the silly register usage restraints }
+                internalerror(200109232);
+            end;
+          OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
+            if not(cs_check_overflow in aktlocalswitches) and
+               (a = 1) and
+               (op in [OP_ADD,OP_SUB]) then
+              if op = OP_ADD then
+                list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],ref))
+              else
+                list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],ref))
+            else if (a = 0) then
+              if (op <> OP_AND) then
+                exit
+              else
+                a_load_const_ref(list,size,0,ref)
+            else if (a = high(aword)) and
+                    (op in [OP_AND,OP_OR,OP_XOR]) then
+                   begin
+                     case op of
+                       OP_AND:
+                         exit;
+                       OP_OR:
+                         list.concat(taicpu.op_const_ref(A_NONE,TCgSize2OpSize[size],high(aword),ref));
+                       OP_XOR:
+                         list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],ref));
+                     end
+                   end
+            else
+              list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
+                TCgSize2OpSize[size],a,ref));
+          OP_SHL,OP_SHR,OP_SAR:
+            begin
+              if (a and 31) <> 0 Then
+                list.concat(taicpu.op_const_ref(
+                  TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,ref));
+              if (a shr 5) <> 0 Then
+                internalerror(68991);
+            end
+          else internalerror(68992);
+        end;*)
+      end;
+
+
+     PROCEDURE tcgSPARC.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);
+
+        var
+          regloadsize:tcgsize;
+          dstsize:topsize;
+          tmpreg:tregister;
+          popecx:boolean;
+
+        begin
+(*          dstsize := S_Q{makeregsize(dst,size)};
+          case op of
+            OP_NEG,OP_NOT:
+              begin
+                if src <> R_NO then
+                  internalerror(200112291);
+                list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst));
+              end;
+            OP_MUL,OP_DIV,OP_IDIV:
+              { special stuff, needs separate handling inside code }
+              { generator                                          }
+              internalerror(200109233);
+            OP_SHR,OP_SHL,OP_SAR:
+              begin
+                tmpreg := R_NO;
+                { we need cl to hold the shift count, so if the destination }
+                { is ecx, save it to a temp for now                         }
+                if dst in [R_ECX,R_CX,R_CL] then
+                  begin
+                    case S_L of
+                      S_B:regloadsize := OS_8;
+                      S_W:regloadsize := OS_16;
+                      else regloadsize := OS_32;
+                    end;
+                    tmpreg := get_scratch_reg(list);
+                    a_load_reg_reg(list,reg.regloadsize,src,tmpreg);
+                  end;
+                if not(src in [R_ECX,R_CX,R_CL]) then
+                  begin
+                    { is ecx still free (it's also free if it was allocated }
+                    { to dst, since we've moved dst somewhere else already) }
+                    if not((dst = R_ECX) or
+                           ((R_ECX in rg.unusedregsint) and
+                            { this will always be true, it's just here to }
+                            { allocate ecx                                }
+                            (rg.getexplicitregisterint(list,R_ECX) = R_ECX))) then
+                      begin
+                        list.concat(taicpu.op_reg(A_SAVE,S_L,R_ECX));
+                        popecx := true;
+                      end;
+                    a_load_reg_reg(list,OS_8,(src),R_CL);
+                  end
+                else
+                  src := R_CL;
+                { do the shift }
+                if tmpreg = R_NO then
+                  list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
+                    R_CL,dst))
+                else
+                  begin
+                    list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],S_L,
+                      R_CL,tmpreg));
+                    { move result back to the destination }
+                    a_load_reg_reg(list,OS_32,tmpreg,R_ECX);
+                    free_scratch_reg(list,tmpreg);
+                  end;
+                if popecx then
+                  list.concat(taicpu.op_reg(A_POP,S_L,R_ECX))
+                else if not (dst in [R_ECX,R_CX,R_CL]) then
+                  rg.ungetregisterint(list,R_ECX);
+              end;
+            else
+              begin
+                if S_L <> dstsize then
+                  internalerror(200109226);
+                list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
+                  src,dst));
+              end;
+          end;*)
+        end;
+
+
+     PROCEDURE tcgSPARC.a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);
+
+       var
+         opsize:topsize;
+
+       begin
+(*          case op of
+            OP_NEG,OP_NOT,OP_IMUL:
+              begin
+                inherited a_op_ref_reg(list,op,size,ref,reg);
+              end;
+            OP_MUL,OP_DIV,OP_IDIV:
+              { special stuff, needs separate handling inside code }
+              { generator                                          }
+              internalerror(200109239);
+            else
+              begin
+                opsize := S_Q{makeregsize(reg,size)};
+                list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],opsize,ref,reg));
+              end;
+          end;*)
+       end;
+
+
+     PROCEDURE tcgSPARC.a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);
+
+       var
+         opsize:topsize;
+
+       begin
+(*         case op of
+           OP_NEG,OP_NOT:
+             begin
+               if reg <> R_NO then
+                 internalerror(200109237);
+               list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],ref));
+             end;
+           OP_IMUL:
+             begin
+               { this one needs a load/imul/store, which is the default }
+               inherited a_op_ref_reg(list,op,size,ref,reg);
+             end;
+           OP_MUL,OP_DIV,OP_IDIV:
+             { special stuff, needs separate handling inside code }
+             { generator                                          }
+             internalerror(200109238);
+           else
+             begin
+               opsize := tcgsize2opsize[size];
+               list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg,ref));
+             end;
+         end;*)
+       end;
+
+
+    PROCEDURE tcgSPARC.a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;
+        size:tcgsize;a:aword;src, dst:tregister);
+      var
+        tmpref:TReference;
+        power:LongInt;
+        opsize:topsize;
+      begin
+        opsize := S_L;
+        if (opsize <> S_L) or
+           not (size in [OS_32,OS_S32]) then
+          begin
+            inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+            exit;
+          end;
+        { if we get here, we have to do a 32 bit calculation, guaranteed }
+        Case Op of
+          OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
+          OP_SAR:
+            { can't do anything special for these }
+            inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+          OP_IMUL:
+            begin
+              if not(cs_check_overflow in aktlocalswitches) and
+                 ispowerof2(a,power) then
+                { can be done with a shift }
+                inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+              list.concat(taicpu.op_reg_const_reg(A_SMUL,S_L,src,a,dst));
+            end;
+          OP_ADD, OP_SUB:
+            if (a = 0) then
+              a_load_reg_reg(list,size,src,dst)
+            else
+              begin
+                reference_reset(tmpref);
+                tmpref.base := src;
+                tmpref.offset := LongInt(a);
+                if op = OP_SUB then
+                  tmpref.offset := -tmpref.offset;
+                list.concat(taicpu.op_ref_reg(A_NONE,S_L,tmpref,dst));
+              end
+          else internalerror(200112302);
+        end;
+      end;
+
+    PROCEDURE tcgSPARC.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;
+        size:tcgsize;src1, src2, dst:tregister);
+      var
+        tmpref:TReference;
+        opsize:topsize;
+      begin
+        opsize := S_L;
+        if (opsize <> S_L) or
+           (S_L <> S_L) or
+           not (size in [OS_32,OS_S32]) then
+          begin
+            inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+            exit;
+          end;
+        { if we get here, we have to do a 32 bit calculation, guaranteed }
+        Case Op of
+          OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
+          OP_SAR,OP_SUB,OP_NOT,OP_NEG:
+            { can't do anything special for these }
+            inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+          OP_IMUL:
+            list.concat(taicpu.op_reg_reg_reg(A_SMUL,S_L,src1,src2,dst));
+          OP_ADD:
+            begin
+              reference_reset(tmpref);
+              tmpref.base := src1;
+              tmpref.index := src2;
+              tmpref.scalefactor := 1;
+              list.concat(taicpu.op_ref_reg(A_NONE,S_L,tmpref,dst));
+            end
+          else internalerror(200112303);
+        end;
+      end;
+
+{*************** compare instructructions ****************}
+
+      PROCEDURE tcgSPARC.a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;
+        l:tasmlabel);
+
+        begin
+          if (a = 0) then
+            list.concat(taicpu.op_reg_reg(A_CMP,S_L,reg,reg))
+          else
+            list.concat(taicpu.op_const_reg(A_CMP,S_L,a,reg));
+          a_jmp_cond(list,cmp_op,l);
+        end;
+
+      PROCEDURE tcgSPARC.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;CONST ref:TReference;
+        l:tasmlabel);
+
+        begin
+          list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,ref));
+          a_jmp_cond(list,cmp_op,l);
+        end;
+
+      PROCEDURE tcgSPARC.a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;
+        reg1,reg2:tregister;l:tasmlabel);
+
+        begin
+ {         if regsize(reg1) <> S_L then
+            internalerror(200109226);
+          list.concat(taicpu.op_reg_reg(A_CMP,regsize(reg1),reg1,reg2));
+          a_jmp_cond(list,cmp_op,l);}
+        end;
+
+     PROCEDURE tcgSPARC.a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);
+
+        var
+          opsize:topsize;
+
+        begin
+          opsize := S_Q{makeregsize(reg,size)};
+          list.concat(taicpu.op_ref_reg(A_CMP,opsize,ref,reg));
+          a_jmp_cond(list,cmp_op,l);
+        end;
+
+     PROCEDURE tcgSPARC.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);
+
+       var
+         ai:taicpu;
+
+       begin
+         if cond=OC_None then
+           ai := Taicpu.Op_sym(A_JMPL,S_NO,l)
+         else
+           begin
+             ai:=Taicpu.Op_sym(A_JMPL,S_NO,l);
+             ai.SetCondition(TOpCmp2AsmCond[cond]);
+           end;
+         ai.is_jmp:=true;
+         list.concat(ai);
+       end;
+
+     PROCEDURE tcgSPARC.a_jmp_flags(list:TAasmOutput;CONST f:TResFlags;l:tasmlabel);
+       var
+         ai:taicpu;
+       begin
+         ai := Taicpu.op_sym(A_JMPL,S_NO,l);
+         ai.SetCondition(flags_to_cond(f));
+         ai.is_jmp := true;
+         list.concat(ai);
+       end;
+
+PROCEDURE tcgSPARC.g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;reg:TRegister);
+  VAR
+    ai:taicpu;
+    hreg:tregister;
+  BEGIN
+    hreg := rg.makeregsize(reg,OS_8);
+//    ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
+    ai.SetCondition(flags_to_cond(f));
+    list.concat(ai);
+    IF hreg<>reg
+    THEN
+      a_load_reg_reg(list,OS_8,hreg,reg);
+  END;
+
+{ *********** entry/exit code and address loading ************ }
+
+PROCEDURE tcgSPARC.g_stackframe_entry(list:TAasmOutput;localsize:LongInt);
+  VAR
+    href:TReference;
+    i:integer;
+    again:tasmlabel;
+  BEGIN
+    WITH list DO
+      BEGIN
+        concat(Taicpu.Op_reg(A_SAVE,S_L,Frame_Pointer_Reg));
+        concat(Taicpu.Op_reg_reg(A_NONE,S_L,Stack_Pointer_Reg,Frame_Pointer_Reg));
+        IF localsize>0
+        THEN
+          concat(Taicpu.Op_const_reg(A_SUB,S_L,localsize,Stack_Pointer_Reg));
+      END;
+  END;
+PROCEDURE tcgSPARC.g_restore_frame_pointer(list:TAasmOutput);
+  BEGIN
+    list.concat(Taicpu.Op_none(A_RESTORE,S_NO));
+  END;
+PROCEDURE tcgSPARC.g_return_from_proc(list:TAasmOutput;parasize:aword);
+  BEGIN
+    { Routines with the poclearstack flag set use only a ret }
+    { also routines with parasize=0     }
+    WITH List DO
+      (*IF(po_clearstack IN aktprocdef.procoptions)
+      THEN
+          { complex return values are removed from stack in C code PM }
+        IF ret_in_param(aktprocdef.rettype.def)
+        THEN
+          Concat(Taicpu.Op_const(A_RET,S_NO,4))
+        ELSE
+          Concat(Taicpu.Op_none(A_RET,S_NO))
+      ELSE*)
+        IF(parasize=0)
+        THEN
+          Concat(Taicpu.Op_none(A_RET,S_NO))
+        ELSE
+          BEGIN
+           { parameters are limited to 65535 bytes because }
+           { ret allows only imm16                    }
+            IF(parasize>65535)
+            THEN
+              CGMessage(cg_e_parasize_too_big);
+            Concat(Taicpu.Op_const(A_RET,S_NO,parasize));
+          END;
+  END;
+
+     PROCEDURE tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);
+
+       begin
+//         list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r));
+       end;
+{ ************* 64bit operations ************ }
+    PROCEDURE TCg64fSPARC.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
+      begin
+        case op of
+          OP_ADD :
+            begin
+              op1:=A_ADD;
+              op2:=A_ADD;
+            end;
+          OP_SUB :
+            begin
+              op1:=A_SUB;
+              op2:=A_SUB;
+            end;
+          OP_XOR :
+            begin
+              op1:=A_XOR;
+              op2:=A_XOR;
+            end;
+          OP_OR :
+            begin
+              op1:=A_OR;
+              op2:=A_OR;
+            end;
+          OP_AND :
+            begin
+              op1:=A_AND;
+              op2:=A_AND;
+            end;
+          else
+            internalerror(200203241);
+        end;
+      end;
+
+
+    PROCEDURE TCg64fSPARC.a_op64_ref_reg(list:TAasmOutput;op:TOpCG;CONST ref:TReference;reg:TRegister64);
+      var
+        op1,op2:TAsmOp;
+        tempref:TReference;
+      begin
+        get_64bit_ops(op,op1,op2);
+        list.concat(taicpu.op_ref_reg(op1,S_L,ref,reg.reglo));
+        tempref:=ref;
+        inc(tempref.offset,4);
+        list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
+      end;
+
+
+    PROCEDURE TCg64fSPARC.a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);
+      var
+        op1,op2:TAsmOp;
+      begin
+        get_64bit_ops(op,op1,op2);
+        list.concat(taicpu.op_reg_reg(op1,S_L,regsrc.reglo,regdst.reglo));
+        list.concat(taicpu.op_reg_reg(op2,S_L,regsrc.reghi,regdst.reghi));
+      end;
+
+
+    PROCEDURE TCg64fSPARC.a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);
+      var
+        op1,op2:TAsmOp;
+      begin
+        case op of
+          OP_AND,OP_OR,OP_XOR:
+            WITH cg DO
+              begin
+                a_op_const_reg(list,op,Lo(Value),regdst.reglo);
+                a_op_const_reg(list,op,Hi(Value),regdst.reghi);
+              end;
+          OP_ADD, OP_SUB:
+            begin
+              // can't use a_op_const_ref because this may use dec/inc
+              get_64bit_ops(op,op1,op2);
+              list.concat(taicpu.op_const_reg(op1,S_L,Lo(Value),regdst.reglo));
+              list.concat(taicpu.op_const_reg(op2,S_L,Hi(Value),regdst.reghi));
+            end;
+          else
+            internalerror(200204021);
+        end;
+      end;
+
+
+    PROCEDURE TCg64fSPARC.a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;CONST ref:TReference);
+      var
+        op1,op2:TAsmOp;
+        tempref:TReference;
+      begin
+        case op of
+          OP_AND,OP_OR,OP_XOR:
+            WITH cg DO
+            begin
+              a_op_const_ref(list,op,OS_32,Lo(Value),ref);
+              tempref:=ref;
+              inc(tempref.offset,4);
+              a_op_const_ref(list,op,OS_32,Hi(Value),tempref);
+            end;
+          OP_ADD, OP_SUB:
+            begin
+              get_64bit_ops(op,op1,op2);
+              // can't use a_op_const_ref because this may use dec/inc
+              list.concat(taicpu.op_const_ref(op1,S_L,Lo(Value),ref));
+              tempref:=ref;
+              inc(tempref.offset,4);
+              list.concat(taicpu.op_const_ref(op2,S_L,Hi(Value),tempref));
+            end;
+          else
+            internalerror(200204022);
+        end;
+      end;
+
+
+{ ************* concatcopy ************ }
+
+    PROCEDURE tcgSPARC.g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean);
+
+      { temp implementation, until it's permanenty moved here from cga.pas }
+
+      var
+        oldlist:TAasmOutput;
+
+      begin
+        if list <> exprasmlist then
+          begin
+            oldlist := exprasmlist;
+            exprasmlist := list;
+          end;
+//        cga.concatcopy(source,dest,len,delsource,loadref);
+        if list <> exprasmlist then
+          list := oldlist;
+      end;
+
+
+    function tcgSPARC.reg_cgsize(CONST reg:tregister):tcgsize;
+//      CONST
+//        regsize_2_cgsize:array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
+      begin
+        //result := regsize_2_cgsize[S_L];
+      end;
+
+
+{***************** This is private property, keep out! :) *****************}
+PROCEDURE tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;VAR op:tasmop;VAR s3:topsize);
+  BEGIN
+{         case s2 of
+           S_B:
+             if S1 in [OS_8,OS_S8] then
+               s3 := S_B
+             else internalerror(200109221);
+           S_W:
+             case s1 of
+               OS_8,OS_S8:
+                 s3 := S_BW;
+               OS_16,OS_S16:
+                 s3 := S_W;
+               else internalerror(200109222);
+             end;
+           S_L:
+             case s1 of
+               OS_8,OS_S8:
+                 s3 := S_BL;
+               OS_16,OS_S16:
+                 s3 := S_WL;
+               OS_32,OS_S32:
+                 s3 := S_L;
+               else internalerror(200109223);
+             end;
+           else internalerror(200109227);
+         end;
+         if s3 in [S_B,S_W,S_L] then
+           op := A_NONE
+         else if s1 in [OS_8,OS_16,OS_32] then
+           op := A_NONEZX
+         else
+           op := A_NONESX;}
+  END;
+PROCEDURE tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
+  BEGIN
+(*         case t of
+            OS_F32:begin
+                        op:=A_FLD;
+                        s:=S_FS;
+                     end;
+            OS_F64:begin
+                        op:=A_FLD;
+                        { ???? }
+                        s:=S_FL;
+                     end;
+            OS_F80:begin
+                        op:=A_FLD;
+                        s:=S_FX;
+                     end;
+            OS_C64:begin
+                        op:=A_FILD;
+                        s:=S_IQ;
+                     end;
+            else internalerror(17);
+         end;*)
+  END;
+PROCEDURE tcgSPARC.floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
+  VAR
+    op:tasmop;
+    s:topsize;
+  BEGIN
+    floatloadops(t,op,s);
+    list.concat(Taicpu.Op_ref(op,s,ref));
+    inc(trgcpu(rg).fpuvaroffset);
+  END;
+PROCEDURE tcgSPARC.floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
+  BEGIN
+{         case t of
+            OS_F32:begin
+                        op:=A_FSTP;
+                        s:=S_FS;
+                     end;
+            OS_F64:begin
+                        op:=A_FSTP;
+                        s:=S_FL;
+                     end;
+            OS_F80:begin
+                        op:=A_FSTP;
+                        s:=S_FX;
+                     end;
+            OS_C64:begin
+                        op:=A_FISTP;
+                        s:=S_IQ;
+                     end;
+         else
+           internalerror(17);
+         end;}
+      end;
+PROCEDURE tcgSPARC.floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
+  VAR
+    op:tasmop;
+    s:topsize;
+  BEGIN
+    floatstoreops(t,op,s);
+    list.concat(Taicpu.Op_ref(op,s,ref));
+    dec(trgcpu(rg).fpuvaroffset);
+  END;
+BEGIN
+  cg:=tcgSPARC.create;
+END.

compiler/sparc/cpubase.pas

@@ -0,0 +1,598 @@
+{*****************************************************************************}
+{ File                   : cpubase.pas                                        }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\04\26                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman
+
+    Contains the base types for the i386
+
+    * This code was inspired by the NASM sources
+      The Netwide Assembler is copyright (C) 1996 Simon Tatham and
+      Julian Hall. All rights reserved.
+
+    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 cpuBase;
+{$INCLUDE fpcdefs.inc}
+INTERFACE
+USES globals,cutils,cclasses,aasmbase,cpuinfo,cginfo;
+CONST
+{Size of the instruction table converted by nasmconv.pas}
+  maxinfolen    = 8;
+{Defines the default address size for a processor}  
+  OS_ADDR=OS_32;{$WARNING "OS_ADDR" was set to "OS_32" but not verified!}
+{the natural int size for a processor}
+  OS_INT=OS_32;{$WARNING "OS_INT" was set to "OS_32" but not verified!}
+{the maximum float size for a processor}
+  OS_FLOAT=OS_F80;{$WARNING "OS_FLOAT" was set to "OS_F80" but not verified!}
+{the size of a vector register for a processor}
+  OS_VECTOR=OS_M64;{$WARNING "OS_VECTOR" was set to "OS_M64" but not verified!}
+{By default we want everything}
+{$DEFINE ATTOP}
+{$DEFINE ATTREG}
+{$DEFINE ATTSUF}
+{We Don't need the intel style opcodes as we are coding for SPARC architecture}
+{$DEFINE NORA386INT}
+{$DEFINE NOAG386NSM}
+{$DEFINE NOAG386INT}
+CONST
+{Operand types}
+  OT_NONE      = $00000000;
+  OT_BITS8     = $00000001;  { size, and other attributes, of the operand  }
+  OT_BITS16    = $00000002;
+  OT_BITS32    = $00000004;
+  OT_BITS64    = $00000008;  { FPU only  }
+  OT_BITS80    = $00000010;
+  OT_FAR       = $00000020;  { this means 16:16 or 16:32, like in CALL/JMP }
+  OT_NEAR      = $00000040;
+  OT_SHORT     = $00000080;
+  OT_SIZE_MASK = $000000FF;  { all the size attributes  }
+  OT_NON_SIZE  = LongInt(not OT_SIZE_MASK);
+  OT_SIGNED    = $00000100;  { the operand need to be signed -128-127 }
+  OT_TO        = $00000200;  { operand is followed by a colon  }
+                             { reverse effect in FADD, FSUB &c  }
+  OT_COLON     = $00000400;
+  OT_REGISTER  = $00001000;
+  OT_IMMEDIATE = $00002000;
+  OT_IMM8      = $00002001;
+  OT_IMM16     = $00002002;
+  OT_IMM32     = $00002004;
+  OT_IMM64     = $00002008;
+  OT_IMM80     = $00002010;
+  OT_REGMEM    = $00200000;  { for r/m, ie EA, operands  }
+  OT_REGNORM   = $00201000;  { 'normal' reg, qualifies as EA  }
+  OT_REG8      = $00201001;
+  OT_REG16     = $00201002;
+  OT_REG32     = $00201004;
+  OT_MMXREG    = $00201008;  { MMX registers  }
+  OT_XMMREG    = $00201010;  { Katmai registers  }
+  OT_MEMORY    = $00204000;  { register number in 'basereg'  }
+  OT_MEM8      = $00204001;
+  OT_MEM16     = $00204002;
+  OT_MEM32     = $00204004;
+  OT_MEM64     = $00204008;
+  OT_MEM80     = $00204010;
+  OT_FPUREG    = $01000000;  { floating point stack registers  }
+  OT_FPU0      = $01000800;  { FPU stack register zero  }
+  OT_REG_SMASK = $00070000;  { special register operands: these may be treated differently  }
+                             { a mask for the following  }
+  OT_REG_ACCUM = $00211000;  { accumulator: AL, AX or EAX  }
+  OT_REG_AL    = $00211001;    { REG_ACCUM | BITSxx  }
+  OT_REG_AX    = $00211002;    { ditto  }
+  OT_REG_EAX   = $00211004;    { and again  }
+  OT_REG_COUNT = $00221000;  { counter: CL, CX or ECX  }
+  OT_REG_CL    = $00221001;    { REG_COUNT | BITSxx  }
+  OT_REG_CX    = $00221002;    { ditto  }
+  OT_REG_ECX   = $00221004;    { another one  }
+  OT_REG_DX    = $00241002;
+
+  OT_REG_SREG  = $00081002;  { any segment register  }
+  OT_REG_CS    = $01081002;  { CS  }
+  OT_REG_DESS  = $02081002;  { DS, ES, SS (non-CS 86 registers)  }
+  OT_REG_FSGS  = $04081002;  { FS, GS (386 extENDed registers)  }
+
+  OT_REG_CDT   = $00101004;  { CRn, DRn and TRn  }
+  OT_REG_CREG  = $08101004;  { CRn  }
+  OT_REG_CR4   = $08101404;  { CR4 (Pentium only)  }
+  OT_REG_DREG  = $10101004;  { DRn  }
+  OT_REG_TREG  = $20101004;  { TRn  }
+
+  OT_MEM_OFFS  = $00604000;  { special type of EA  }
+                             { simple [address] offset  }
+  OT_ONENESS   = $00800000;  { special type of immediate operand  }
+                             { so UNITY == IMMEDIATE | ONENESS  }
+  OT_UNITY     = $00802000;  { for shift/rotate instructions  }
+
+{Instruction flags }
+  IF_NONE   = $00000000;
+  IF_SM     = $00000001;        { size match first two operands  }
+  IF_SM2    = $00000002;
+  IF_SB     = $00000004;  { unsized operands can't be non-byte  }
+  IF_SW     = $00000008;  { unsized operands can't be non-word  }
+  IF_SD     = $00000010;  { unsized operands can't be nondword  }
+  IF_AR0    = $00000020;  { SB, SW, SD applies to argument 0  }
+  IF_AR1    = $00000040;  { SB, SW, SD applies to argument 1  }
+  IF_AR2    = $00000060;  { SB, SW, SD applies to argument 2  }
+  IF_ARMASK = $00000060;  { mask for unsized argument spec  }
+  IF_PRIV   = $00000100;  { it's a privileged instruction  }
+  IF_SMM    = $00000200;  { it's only valid in SMM  }
+  IF_PROT   = $00000400;  { it's protected mode only  }
+  IF_UNDOC  = $00001000;  { it's an undocumented instruction  }
+  IF_FPU    = $00002000;  { it's an FPU instruction  }
+  IF_MMX    = $00004000;  { it's an MMX instruction  }
+  IF_3DNOW  = $00008000;  { it's a 3DNow! instruction  }
+  IF_SSE    = $00010000;  { it's a SSE (KNI, MMX2) instruction  }
+  IF_PMASK  =
+     LongInt($FF000000);  { the mask for processor types  }
+  IF_PFMASK =
+     LongInt($F001FF00);  { the mask for disassembly "prefer"  }
+  IF_8086   = $00000000;  { 8086 instruction  }
+  IF_186    = $01000000;  { 186+ instruction  }
+  IF_286    = $02000000;  { 286+ instruction  }
+  IF_386    = $03000000;  { 386+ instruction  }
+  IF_486    = $04000000;  { 486+ instruction  }
+  IF_PENT   = $05000000;  { Pentium instruction  }
+  IF_P6     = $06000000;  { P6 instruction  }
+  IF_KATMAI = $07000000;  { Katmai instructions  }
+  IF_CYRIX  = $10000000;  { Cyrix-specific instruction  }
+  IF_AMD    = $20000000;  { AMD-specific instruction  }
+  { added flags }
+  IF_PRE    = $40000000;  { it's a prefix instruction }
+  IF_PASS2 =LongInt($80000000);{if the instruction can change in a second pass}
+TYPE
+  TAttSuffix=(
+    AttSufNONE, {No suffix is needed}
+    AttSufINT,  {Integer operation suffix is needed}
+    AttSufFPU,  {}
+    AttSufFPUint{}
+  );
+{$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.}
+  TAsmOp=({$INCLUDE opcode.inc});
+  op2strtable=ARRAY[TAsmOp]OF STRING[11];
+CONST
+  FirstOp=Low(TAsmOp);
+  LastOp=High(TAsmOp);
+{$IFDEF ATTSUF}
+  att_needsuffix:ARRAY[tasmop]OF TAttSuffix=({$INCLUDE sparcatts.inc});
+{$ENDIF ATTSUF}
+  std_op2str:op2strtable=({$INCLUDE attinstr.inc});
+{*****************************************************************************
+                                Operand Sizes
+*****************************************************************************}
+TYPE
+       { S_NO = No Size of operand }
+       { S_B  = Byte size operand  }
+       { S_W  = Word size operand  }
+       { S_L  = DWord size operand }
+       { USED FOR conversions in x86}
+       { S_BW = Byte to word       }
+       { S_BL = Byte to long       }
+       { S_WL = Word to long       }
+       { Floating point types      }
+       { S_FS  = single type (32 bit) }
+       { S_FL  = double/64bit integer }
+       { S_FX  = ExtENDed type      }
+       { S_IS  = integer on 16 bits   }
+       { S_IL  = integer on 32 bits   }
+       { S_IQ  = integer on 64 bits   }
+  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);
+CONST
+  { Intel style operands ! }
+  opsize_2_type:ARRAY[0..2,topsize] of LongInt=(
+    (OT_NONE,
+     OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS16,OT_BITS32,OT_BITS32,
+     OT_BITS16,OT_BITS32,OT_BITS64,
+     OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
+     OT_NEAR,OT_FAR,OT_SHORT
+    ),
+    (OT_NONE,
+     OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS8,OT_BITS8,OT_BITS16,
+     OT_BITS16,OT_BITS32,OT_BITS64,
+     OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
+     OT_NEAR,OT_FAR,OT_SHORT
+    ),
+    (OT_NONE,
+     OT_BITS8,OT_BITS16,OT_BITS32,OT_NONE,OT_NONE,OT_NONE,
+     OT_BITS16,OT_BITS32,OT_BITS64,
+     OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
+     OT_NEAR,OT_FAR,OT_SHORT
+    )
+  );
+
+{$IFDEF ATTOP}
+  att_opsize2str : ARRAY[topsize] of string[2] = ('',
+    'b','w','l','bw','bl','wl',
+    's','l','q',
+    's','l','t','d','q','v',
+    '','',''
+  );
+{$ENDIF}
+{*****************************************************************************
+                                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
+  );
+CONST
+  CondAsmOps=3;
+  CondAsmOp:ARRAY[0..CondAsmOps-1] of TAsmOp=(A_FCMPd, A_JMPL, A_FCMPs);
+  CondAsmOpStr:ARRAY[0..CondAsmOps-1] of string[4]=('FCMPd','JMPL','FCMPs');
+{*****************************************************************************
+                                  Registers
+*****************************************************************************}
+TYPE
+  { enumeration for registers, don't change the order }
+  { it's used by the register size conversions        }
+  TRegister=({$INCLUDE registers.inc}); 
+  TRegister64=PACKED RECORD
+  {A type to store register locations for 64 Bit values.}
+     RegLo,RegHi:TRegister;
+  END;
+  treg64=tregister64;{alias for compact code}
+  TRegisterSet=SET OF TRegister;
+  reg2strtable=ARRAY[tregister] OF STRING[6];
+CONST
+  firstreg = low(tregister);
+  lastreg  = high(tregister);
+{$ifdef ATTREG}
+  std_reg2str:reg2strtable=({$INCLUDE strregs.inc});
+{$ENDif ATTREG}
+{*****************************************************************************
+                                   Flags
+*****************************************************************************}
+TYPE
+  TResFlags=(
+    F_E,  {Equal}
+    F_NE, {Not Equal}
+    F_G,  {Greater}
+    F_L,  {Less}
+    F_GE, {Greater or Equal}
+    F_LE, {Less or Equal}
+    F_C,  {Carry}
+    F_NC, {Not Carry}
+    F_A,  {Above}
+    F_AE, {Above or Equal}
+    F_B,  {Below}
+    F_BE  {Below or Equal}
+  );
+{*****************************************************************************
+                                Reference
+*****************************************************************************}
+TYPE
+  trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
+
+  { immediate/reference record }
+  poperreference = ^treference;
+  treference = packed record
+     segment,
+     base,
+     index       : tregister;
+     scalefactor : byte;
+     offset      : LongInt;
+     symbol      : tasmsymbol;
+     offsetfixup : LongInt;
+     options     : trefoptions;
+{$ifdef newcg}
+     alignment   : byte;
+{$ENDif newcg}
+  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:poperreference);
+           top_CONST  : (val:aword);
+           top_symbol : (sym:tasmsymbol;symofs:LongInt);
+        END;
+
+
+
+{*****************************************************************************
+                             Argument Classification
+*****************************************************************************}
+
+TYPE
+  TArgClass = (
+     { the following classes should be defined by all processor implemnations }
+     AC_NOCLASS,
+     AC_MEMORY,
+     AC_INTEGER,
+     AC_FPU,
+     { the following argument classes are i386 specific }
+     AC_FPUUP,
+     AC_SSE,
+     AC_SSEUP);
+
+{*****************************************************************************
+                               Generic Location
+*****************************************************************************}
+TYPE
+  TLoc=(              {information about the location of an operand}
+    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 }
+    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_MMREGISTER,
+    LOC_CMMREGISTER
+  );
+{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);
+                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
+  general_registers = [R_G0..R_I7];
+
+  { 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    }
+
+  intregs = [R_G0..R_I7];
+  usableregsint = general_registers;
+  c_countusableregsint = 4;
+
+  fpuregs = [R_F0..R_F31];
+  usableregsfpu = [];
+  c_countusableregsfpu = 0;
+
+  mmregs = [R_G0..R_G7];
+  usableregsmm = [R_G0..R_G7];
+  c_countusableregsmm  = 8;
+
+  firstsaveintreg = R_G0;
+  lastsaveintreg = R_I7;
+  firstsavefpureg = R_F0;
+  lastsavefpureg = R_F31;
+  firstsavemmreg = R_G0;
+  lastsavemmreg = R_I7;
+  lowsavereg = R_G0;
+  highsavereg = R_I7;
+
+  ALL_REGISTERS = [lowsavereg..highsavereg];
+
+  lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER,
+    LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER];
+{
+  registers_saved_on_cdecl = [R_ESI,R_EDI,R_EBX];}
+
+  { generic register names }
+  stack_pointer_reg=R_O6;
+  frame_pointer_reg=R_I6;
+  self_pointer_reg=R_G5;
+  accumulator   = R_G0;
+  accumulatorhigh = R_I7;
+  { WARNING: don't change to R_ST0!! See comments above implementation of }
+  { a_loadfpu* methods in rgcpu (JM)                                      }
+  fpu_result_reg=R_F0;
+  mmresultreg=R_G0;
+{*****************************************************************************}
+{                        GCC /ABI linking information                         }
+{*****************************************************************************}
+{# 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_O6];
+{# 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;
+{# Registers which are defined as scratch and no need to save across routine
+calls or in assembler blocks.}
+  ScratchRegsCount=3;
+  scratch_regs:ARRAY[1..ScratchRegsCount]OF TRegister=(R_O4,R_O5,R_I7);
+  {$WARNING FIXME : Scratch registers list has to be verified}
+{ low and high of the available maximum width integer general purpose }
+{ registers                                                           }
+  LoGPReg = R_G0;
+  HiGPReg = R_I7;
+
+{ low and high of every possible width general purpose register (same as }
+{ above on most architctures apart from the 80x86)                       }
+  LoReg = R_G0;
+  HiReg = R_I7;
+
+  cpuflags = [];
+
+  { sizes }
+  pointersize   = 4;
+  extENDed_size = 8;{SPARC architecture uses IEEE floating point numbers}
+  mmreg_size = 8;
+  sizepostfix_pointer = S_L;
+
+
+{*****************************************************************************
+                              Instruction table
+*****************************************************************************}
+
+{$ifndef NOAG386BIN}
+TYPE
+  tinsentry=packed record
+    opcode  : tasmop;
+    ops     : byte;
+    optypes : ARRAY[0..2] of LongInt;
+    code    : ARRAY[0..maxinfolen] of char;
+    flags   : LongInt;
+  END;
+  pinsentry=^tinsentry;
+
+  TInsTabCache=ARRAY[TasmOp] of LongInt;
+  PInsTabCache=^TInsTabCache;
+VAR
+  InsTabCache : PInsTabCache;
+{$ENDif NOAG386BIN}
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    CONST
+       maxvarregs=30;
+       VarRegs:ARRAY[1..maxvarregs]OF TRegister=(
+             R_G0,R_G1,R_G2,R_G3,R_G4,R_G5,R_G6,R_G7,
+             R_O0,R_O1,R_O2,R_O3,R_O4,R_O5,{R_R14=R_SP}R_O7,
+             R_L0,R_L1,R_L2,R_L3,R_L4,R_L5,R_L6,R_L7,
+             R_I0,R_I1,R_I2,R_I3,R_I4,R_I5,{R_R30=R_FP}R_I7
+        );
+       maxfpuvarregs = 8;
+       max_operands = 3;
+
+       maxintregs = maxvarregs;
+       maxfpuregs = maxfpuvarregs;
+
+FUNCTION reg2str(r:tregister):string;
+FUNCTION is_calljmp(o:tasmop):boolean;
+FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
+IMPLEMENTATION
+FUNCTION reg2str(r:tregister):string;
+  TYPE
+    TStrReg=ARRAY[TRegister]OF STRING[5];
+  CONST
+    StrReg:TStrReg=({$INCLUDE strregs.inc});
+  BEGIN
+    reg2str:=StrReg[r];
+  END;
+FUNCTION is_calljmp(o:tasmop):boolean;
+  BEGIN
+    CASE o OF
+    A_CALL,A_JMPL:
+      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.

compiler/sparc/cpugas.pas

@@ -0,0 +1,318 @@
+{*****************************************************************************}
+{ File                   : cpugas.pas                                         }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\05\01                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{   $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This unit implements an asmoutput class for SPARC AT&T syntax
+
+    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 CpuGas;
+{$INCLUDE fpcdefs.inc}
+INTERFACE
+USES
+  cclasses,cpubase,
+  globals,
+  aasmbase,aasmtai,aasmcpu,assemble,aggas;
+TYPE
+  TGasSPARC=class(TGnuAssembler)
+    PROCEDURE WriteInstruction(hp:Tai);OVERRIDE;
+  END;
+IMPLEMENTATION
+USES
+  strings,
+  dos,
+  globtype,
+  fmodule,finput,
+  cutils,systems,
+  verbose;
+CONST
+  line_length = 70;
+VAR
+{$ifdef GDB}
+      n_line       : byte;     { different types of source lines }
+      linecount,
+      includecount : longint;
+      funcname     : pchar;
+      stabslastfileinfo : tfileposinfo;
+{$endif}
+      lastsec      : tsection; { last section type written }
+      lastfileinfo : tfileposinfo;
+      infile,
+      lastinfile   : tinputfile;
+      symendcount  : longint;
+
+   function fixline(s:string):string;
+   {
+     return s with all leading and ending spaces and tabs removed
+   }
+     var
+       i,j,k : longint;
+     begin
+       i:=length(s);
+       while (i>0) and (s[i] in [#9,' ']) do
+        dec(i);
+       j:=1;
+       while (j<i) and (s[j] in [#9,' ']) do
+        inc(j);
+       for k:=j to i do
+        if s[k] in [#0..#31,#127..#255] then
+         s[k]:='.';
+       fixline:=Copy(s,j,i-j+1);
+     end;
+
+    function single2str(d : single) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         single2str:='0d'+hs
+      end;
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         double2str:='0d'+hs
+      end;
+
+    function extended2str(e : extended) : string;
+      var
+         hs : string;
+      begin
+         str(e,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         extended2str:='0d'+hs
+      end;
+
+
+    function getreferencestring(var ref : treference) : string;
+    var
+      s : string;
+    begin
+      with ref do
+       begin
+         inc(offset,offsetfixup);
+         offsetfixup:=0;
+       { have we a segment prefix ? }
+       { These are probably not correctly handled under GAS }
+       { should be replaced by coding the segment override  }
+       { directly! - DJGPP FAQ                              }
+         if segment<>R_NO then
+          s:=std_reg2str[segment]+':'
+         else
+          s:='';
+         if assigned(symbol) then
+          s:=s+symbol.name;
+         if offset<0 then
+          s:=s+tostr(offset)
+         else
+          if (offset>0) then
+           begin
+             if assigned(symbol) then
+              s:=s+'+'+tostr(offset)
+             else
+              s:=s+tostr(offset);
+           end
+         else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
+           s:=s+'0';
+         if (index<>R_NO) and (base=R_NO) then
+          begin
+            s:=s+'(,'+std_reg2str[index];
+            if scalefactor<>0 then
+             s:=s+','+tostr(scalefactor)+')'
+            else
+             s:=s+')';
+          end
+         else
+          if (index=R_NO) and (base<>R_NO) then
+           s:=s+'('+std_reg2str[base]+')'
+          else
+           if (index<>R_NO) and (base<>R_NO) then
+            begin
+              s:=s+'('+std_reg2str[base]+','+std_reg2str[index];
+              if scalefactor<>0 then
+               s:=s+','+tostr(scalefactor)+')'
+              else
+               s := s+')';
+            end;
+       end;
+      getreferencestring:=s;
+    end;
+
+    function getopstr(const o:toper) : string;
+    var
+      hs : string;
+    begin
+      case o.typ of
+        top_reg :
+          getopstr:=std_reg2str[o.reg];
+        top_ref :
+          getopstr:=getreferencestring(o.ref^);
+        top_const :
+          getopstr:='$'+tostr(longint(o.val));
+        top_symbol :
+          begin
+            if assigned(o.sym) then
+              hs:='$'+o.sym.name
+            else
+              hs:='$';
+            if o.symofs>0 then
+             hs:=hs+'+'+tostr(o.symofs)
+            else
+             if o.symofs<0 then
+              hs:=hs+tostr(o.symofs)
+            else
+             if not(assigned(o.sym)) then
+               hs:=hs+'0';
+            getopstr:=hs;
+          end;
+        else
+          internalerror(10001);
+      end;
+    end;
+
+    function getopstr_jmp(const o:toper) : string;
+    var
+      hs : string;
+    begin
+      case o.typ of
+        top_reg :
+          getopstr_jmp:='*'+std_reg2str[o.reg];
+        top_ref :
+          getopstr_jmp:='*'+getreferencestring(o.ref^);
+        top_const :
+          getopstr_jmp:=tostr(longint(o.val));
+        top_symbol :
+          begin
+            hs:=o.sym.name;
+            if o.symofs>0 then
+             hs:=hs+'+'+tostr(o.symofs)
+            else
+             if o.symofs<0 then
+              hs:=hs+tostr(o.symofs);
+            getopstr_jmp:=hs;
+          end;
+        else
+          internalerror(10001);
+      end;
+    end;
+
+
+{****************************************************************************
+                            TISPARCATTASMOUTPUT
+ ****************************************************************************}
+
+    const
+      ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]=
+       (#9'.long'#9,#9'.short'#9,#9'.byte'#9);
+PROCEDURE TGasSPARC.WriteInstruction(hp:Tai);
+  VAR
+    Op:TAsmOp;
+    s:STRING;
+    i:Integer;
+    sep:STRING[3];
+  BEGIN
+    IF hp.typ<>ait_instruction
+    THEN
+      Exit;
+       taicpu(hp).SetOperandOrder(op_att);
+       op:=taicpu(hp).opcode;
+       { call maybe not translated to call }
+       s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition];
+    IF is_CallJmp(op)
+    THEN
+           { call and jmp need an extra handling                          }
+           { this code is only called if jmp isn't a labeled instruction  }
+           { quick hack to overcome a problem with manglednames=255 chars }
+      BEGIN
+{        IF op<>A_JMPl
+        THEN
+          s:=cond2str(op,taicpu(hp).condition)+','
+        ELSE}
+          s:=#9'b'#9;
+        s:=s+getopstr_jmp(taicpu(hp).oper[0]);
+      END
+    ELSE
+      BEGIN {process operands}
+        s:=#9+std_op2str[op];
+        IF taicpu(hp).ops<>0
+        THEN
+          BEGIN
+            {
+              if not is_calljmp(op) then
+                sep:=','
+              else
+            }
+            sep:=#9;
+            FOR i:=0 TO taicpu(hp).ops-1 DO
+              BEGIN
+                s:=s+sep+getopstr(taicpu(hp).oper[i]);
+                sep:=',';
+              END;
+          END;
+      END;
+    AsmWriteLn(s);
+  END;
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+CONST
+  as_SPARC_as_info:TAsmInfo=(
+    id           : as_gas;
+    idtxt  : 'AS';
+    asmbin : 'as';
+    asmcmd : '-o $OBJ $ASM';
+    supported_target : system_any;
+    outputbinary: false;
+    allowdirect : true;
+    needar : true;
+    labelprefix_only_inside_procedure : false;
+    labelprefix : '.L';
+    comment : '# ';
+    secnames : ({sec_none}'',           {no section}
+                {sec_code}'.text',      {executable code}
+                {sec_data}'.data',      {initialized R/W data}
+                {sec_bss}'.bss',        {uninitialized R/W data}
+                {sec_idata2}'.comment', {comments}
+                {sec_idata4}'.debug',   {debugging information}
+                {sec_idata5}'.rodata',  {RO data}
+                {sec_idata6}'.line',    {line numbers info for symbolic debug}
+                {sec_idata7}'.init',    {runtime intialization code}
+                {sec_edata}'.fini',     {runtime finalization code}
+                {sec_stab}'.stab',
+                {sec_stabstr} '.stabstr',
+                {sec_common}'.note')    {note info}
+  );
+INITIALIZATION
+  RegisterAssembler(as_SPARC_as_info,TGasSPARC);
+END.

compiler/sparc/cpuinfo.pas

@@ -0,0 +1,68 @@
+{*****************************************************************************}
+{ File                   : cpuinfo.pas                                        }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\26\26                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Basic Processor information
+
+    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 cpuinfo;
+{$INCLUDE fpcdefs.inc}
+INTERFACE
+TYPE
+{# Natural integer register type and size for the target machine }
+  AWord=Cardinal;
+  PAWord=^AWord;
+{ the ordinal type used when evaluating constant integer expressions }
+  TConstExprInt=int64;
+{ this must be an ordinal type with the same size as a pointer }
+{ 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=cardinal;
+  bestreal = extended;
+  ts32real = single;
+  ts64real = double;
+  ts80real = extended;
+  ts64comp = extended;
+  pbestreal=^bestreal;
+{ possible supported processors for this target }
+  tprocessors=(no_processor,SPARC_V8,SPARC_V9); 
+CONST
+{# Size of native extended floating point type }
+  extended_size = 10;
+{# Size of a pointer                           }
+  pointer_size  = 4;
+{# Size of a multimedia register               }
+  mmreg_size = 8;
+{ target cpu string (used by compiler options) }
+  target_cpu_string = 'SPARC';
+{ size of the buffer used for setjump/longjmp  
+  the size of this buffer is deduced from the
+  jmp_buf structure in setjumph.inc file }
+  jmp_buf_size = 24;
+IMPLEMENTATION
+END.

compiler/sparc/cpupara.pas

@@ -0,0 +1,151 @@
+{*****************************************************************************}
+{ File                   : cpupara.pas                                        }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\07\13                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    PowerPC 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;
+{SPARC specific calling conventions are handled by this unit}
+{$INCLUDE fpcdefs.inc}
+INTERFACE
+USES
+  cpubase,
+  symconst,symbase,symdef,paramgr;
+TYPE
+  TSparcParaManager=CLASS(TParaManager)
+    FUNCTION getintparaloc(nr:longint):tparalocation;OVERRIDE;
+    PROCEDURE create_param_loc_info(p:tabstractprocdef);OVERRIDE;
+    FUNCTION GetSelfLocation(p:tabstractprocdef):tparalocation;OVERRIDE;
+  end;
+IMPLEMENTATION
+USES
+  verbose,
+  cpuinfo,
+  symtype;
+FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
+  BEGIN
+    fillchar(result,sizeof(tparalocation),0);
+    if nr<1
+    then
+      internalerror(2002070801)
+    else if nr<=8
+    then
+      BEGIN
+        result.loc:=LOC_REGISTER;
+        result.register:=tregister(longint(R_O0)+nr);
+      end
+    else
+           BEGIN
+              result.loc:=LOC_REFERENCE;
+              result.reference.index:=stack_pointer_reg;
+              result.reference.offset:=(nr-8)*4;
+           end;
+      end;
+
+    FUNCTION getparaloc(p : tdef) : tloc;
+
+      BEGIN
+         case p.deftype of
+            orddef:
+              getparaloc:=LOC_REGISTER;
+            floatdef:
+              getparaloc:=LOC_FPUREGISTER;
+            enumdef:
+              getparaloc:=LOC_REGISTER;
+            pointerdef:
+              getparaloc:=LOC_REGISTER;
+            else
+              internalerror(2002071001);
+         end;
+      end;
+
+    PROCEDURE TSparcParaManager.create_param_loc_info(p : tabstractprocdef);
+
+      var
+         nextintreg,nextfloatreg,nextmmreg : tregister;
+         stack_offset : aword;
+         hp : tparaitem;
+         loc : tloc;
+
+      BEGIN
+         nextintreg:=R_G3;
+         nextfloatreg:=R_F1;
+         nextmmreg:=R_L1;
+         stack_offset:=0;
+         { pointer for structured results ? }
+         { !!!nextintreg:=R_4;              }
+
+         { frame pointer for nested procedures? }
+         { inc(nextintreg);                     }
+         { constructor? }
+         { destructor? }
+         hp:=tparaitem(p.para.last);
+         while assigned(hp) do
+           BEGIN
+              loc:=getparaloc(hp.paratype.def);
+              case loc of
+                 LOC_REGISTER:
+                   BEGIN
+                      if nextintreg<=R_I7 then
+                        BEGIN
+                           hp.paraloc.loc:=LOC_REGISTER;
+                           hp.paraloc.register:=nextintreg;
+                           inc(nextintreg);
+                        end
+                      else
+                         BEGIN
+                            {!!!!!!!}
+                            internalerror(2002071003);
+                        end;
+                   end;
+                 else
+                   internalerror(2002071002);
+              end;
+              hp:=tparaitem(hp.previous);
+           end;
+      end;
+
+FUNCTION TSparcParaManager.GetSelfLocation(p:tabstractprocdef):tparalocation;
+  BEGIN
+    getselflocation.loc:=LOC_REFERENCE;
+    getselflocation.reference.index:=R_G3{R_ESP};
+    getselflocation.reference.offset:=4;
+  END;
+
+BEGIN
+   paramanager:=TSparcParaManager.create;
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-21 13:30:07  mazen
+  *** empty log message ***
+
+  Revision 1.2  2002/07/11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.1  2002/07/07 09:44:32  florian
+    * powerpc target fixed, very simple units can be compiled
+}

compiler/sparc/psystem.pas

@@ -0,0 +1,557 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Load the system unit, create required defs for systemunit
+
+    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 psystem;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      symbase;
+
+    procedure insertinternsyms(p : tsymtable);
+    procedure insert_intern_types(p : tsymtable);
+
+    procedure readconstdefs;
+    procedure createconstdefs;
+
+    procedure registernodes;
+    procedure registertais;
+
+
+implementation
+
+    uses
+      globals,globtype,
+      symconst,symtype,symsym,symdef,symtable,
+      aasmtai,aasmcpu,
+{$ifdef GDB}
+      gdb,
+{$endif GDB}
+      node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt;
+
+
+    procedure insertinternsyms(p : tsymtable);
+      {
+        all intern procedures for the system unit
+      }
+      begin
+        p.insert(tsyssym.create('Concat',in_concat_x));
+        p.insert(tsyssym.create('Write',in_write_x));
+        p.insert(tsyssym.create('WriteLn',in_writeln_x));
+        p.insert(tsyssym.create('Assigned',in_assigned_x));
+        p.insert(tsyssym.create('Read',in_read_x));
+        p.insert(tsyssym.create('ReadLn',in_readln_x));
+        p.insert(tsyssym.create('Ofs',in_ofs_x));
+        p.insert(tsyssym.create('SizeOf',in_sizeof_x));
+        p.insert(tsyssym.create('TypeOf',in_typeof_x));
+        p.insert(tsyssym.create('Low',in_low_x));
+        p.insert(tsyssym.create('High',in_high_x));
+        p.insert(tsyssym.create('Seg',in_seg_x));
+        p.insert(tsyssym.create('Ord',in_ord_x));
+        p.insert(tsyssym.create('Pred',in_pred_x));
+        p.insert(tsyssym.create('Succ',in_succ_x));
+        p.insert(tsyssym.create('Exclude',in_exclude_x_y));
+        p.insert(tsyssym.create('Include',in_include_x_y));
+        p.insert(tsyssym.create('Break',in_break));
+        p.insert(tsyssym.create('Exit',in_exit));
+        p.insert(tsyssym.create('Continue',in_continue));
+        p.insert(tsyssym.create('Dec',in_dec_x));
+        p.insert(tsyssym.create('Inc',in_inc_x));
+        p.insert(tsyssym.create('Str',in_str_x_string));
+        p.insert(tsyssym.create('Assert',in_assert_x_y));
+        p.insert(tsyssym.create('Val',in_val_x));
+        p.insert(tsyssym.create('Addr',in_addr_x));
+        p.insert(tsyssym.create('TypeInfo',in_typeinfo_x));
+        p.insert(tsyssym.create('SetLength',in_setlength_x));
+        p.insert(tsyssym.create('Finalize',in_finalize_x));
+        p.insert(tsyssym.create('Length',in_length_x));
+        p.insert(tsyssym.create('New',in_new_x));
+        p.insert(tsyssym.create('Dispose',in_dispose_x));
+      end;
+
+
+    procedure insert_intern_types(p : tsymtable);
+      {
+        all the types inserted into the system unit
+      }
+
+        function addtype(const s:string;const t:ttype):ttypesym;
+        begin
+          result:=ttypesym.create(s,t);
+          p.insert(result);
+          { add init/final table if required }
+          if t.def.needs_inittable then
+           generate_inittable(result);
+        end;
+
+        procedure adddef(const s:string;def:tdef);
+        var
+          t : ttype;
+        begin
+          t.setdef(def);
+          p.insert(ttypesym.create(s,t));
+        end;
+
+      var
+        { several defs to simulate more or less C++ objects for GDB }
+        vmttype,
+        vmtarraytype : ttype;
+        vmtsymtable  : tsymtable;
+      begin
+        { Normal types }
+        if (cs_fp_emulation in aktmoduleswitches) then
+          begin
+            addtype('Single',s32floattype);
+            { extended size is the best real type for the target }
+            addtype('Real',s32floattype);
+            pbestrealtype:=@s32floattype;
+          end
+        else
+          begin
+            addtype('Single',s32floattype);
+            addtype('Double',s64floattype);
+            { extended size is the best real type for the target }
+            addtype('Extended',pbestrealtype^);
+            addtype('Real',s64floattype);
+          end;
+{$ifdef x86}
+        adddef('Comp',tfloatdef.create(s64comp));
+{$endif x86}
+        addtype('Currency',s64currencytype);
+        addtype('Pointer',voidpointertype);
+        addtype('FarPointer',voidfarpointertype);
+        addtype('ShortString',cshortstringtype);
+        addtype('LongString',clongstringtype);
+        addtype('AnsiString',cansistringtype);
+        addtype('WideString',cwidestringtype);
+        addtype('Boolean',booltype);
+        addtype('ByteBool',booltype);
+        adddef('WordBool',torddef.create(bool16bit,0,1));
+        adddef('LongBool',torddef.create(bool32bit,0,1));
+        addtype('Char',cchartype);
+        addtype('WideChar',cwidechartype);
+        adddef('Text',tfiledef.createtext);
+        addtype('Cardinal',u32bittype);
+        addtype('QWord',cu64bittype);
+        addtype('Int64',cs64bittype);
+        adddef('TypedFile',tfiledef.createtyped(voidtype));
+        addtype('Variant',cvarianttype);
+        { Internal types }
+        addtype('$formal',cformaltype);
+        addtype('$void',voidtype);
+        addtype('$byte',u8bittype);
+        addtype('$word',u16bittype);
+        addtype('$ulong',u32bittype);
+        addtype('$longint',s32bittype);
+        addtype('$qword',cu64bittype);
+        addtype('$int64',cs64bittype);
+        addtype('$char',cchartype);
+        addtype('$widechar',cwidechartype);
+        addtype('$shortstring',cshortstringtype);
+        addtype('$longstring',clongstringtype);
+        addtype('$ansistring',cansistringtype);
+        addtype('$widestring',cwidestringtype);
+        addtype('$openshortstring',openshortstringtype);
+        addtype('$boolean',booltype);
+        addtype('$void_pointer',voidpointertype);
+        addtype('$char_pointer',charpointertype);
+        addtype('$void_farpointer',voidfarpointertype);
+        addtype('$openchararray',openchararraytype);
+        addtype('$file',cfiletype);
+        addtype('$variant',cvarianttype);
+        addtype('$s32real',s32floattype);
+        addtype('$s64real',s64floattype);
+        addtype('$s80real',s80floattype);
+        addtype('$s64currency',s64currencytype);
+        { Add a type for virtual method tables }
+        vmtsymtable:=trecordsymtable.create;
+        vmttype.setdef(trecorddef.create(vmtsymtable));
+        pvmttype.setdef(tpointerdef.create(vmttype));
+        vmtsymtable.insert(tvarsym.create('$parent',pvmttype));
+        vmtsymtable.insert(tvarsym.create('$length',s32bittype));
+        vmtsymtable.insert(tvarsym.create('$mlength',s32bittype));
+        vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
+        tarraydef(vmtarraytype.def).elementtype:=voidpointertype;
+        vmtsymtable.insert(tvarsym.create('$__pfn',vmtarraytype));
+        addtype('$__vtbl_ptr_type',vmttype);
+        addtype('$pvmt',pvmttype);
+        vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
+        tarraydef(vmtarraytype.def).elementtype:=pvmttype;
+        addtype('$vtblarray',vmtarraytype);
+      { Add functions that require compiler magic }
+        insertinternsyms(p);
+      end;
+
+
+    procedure readconstdefs;
+      {
+        Load all default definitions for consts from the system unit
+      }
+      begin
+        globaldef('byte',u8bittype);
+        globaldef('word',u16bittype);
+        globaldef('ulong',u32bittype);
+        globaldef('longint',s32bittype);
+        globaldef('qword',cu64bittype);
+        globaldef('int64',cs64bittype);
+        globaldef('formal',cformaltype);
+        globaldef('void',voidtype);
+        globaldef('char',cchartype);
+        globaldef('widechar',cwidechartype);
+        globaldef('shortstring',cshortstringtype);
+        globaldef('longstring',clongstringtype);
+        globaldef('ansistring',cansistringtype);
+        globaldef('widestring',cwidestringtype);
+        globaldef('openshortstring',openshortstringtype);
+        globaldef('openchararray',openchararraytype);
+        globaldef('s32real',s32floattype);
+        globaldef('s64real',s64floattype);
+        globaldef('s80real',s80floattype);
+        globaldef('s64currency',s64currencytype);
+        globaldef('boolean',booltype);
+        globaldef('void_pointer',voidpointertype);
+        globaldef('char_pointer',charpointertype);
+        globaldef('void_farpointer',voidfarpointertype);
+        globaldef('file',cfiletype);
+        globaldef('pvmt',pvmttype);
+        globaldef('variant',cvarianttype);
+{$ifdef i386}
+        ordpointertype:=u32bittype;
+{$endif i386}
+{$ifdef x86_64}
+        ordpointertype:=cu64bittype;
+{$endif x86_64}
+{$ifdef powerpc}
+        ordpointertype:=u32bittype;
+{$endif powerpc}
+{$ifdef sparc}
+        ordpointertype:=u32bittype;
+{$endif sparc}
+{$ifdef m68k}
+        ordpointertype:=u32bittype;
+{$endif}
+      end;
+
+
+    procedure createconstdefs;
+      {
+        Create all default definitions for consts for the system unit
+      }
+      var
+        oldregisterdef : boolean;
+      begin
+        { create definitions for constants }
+        oldregisterdef:=registerdef;
+        registerdef:=false;
+        cformaltype.setdef(tformaldef.create);
+        voidtype.setdef(torddef.create(uvoid,0,0));
+        u8bittype.setdef(torddef.create(u8bit,0,255));
+        u16bittype.setdef(torddef.create(u16bit,0,65535));
+        u32bittype.setdef(torddef.create(u32bit,0,high(cardinal)));
+        s32bittype.setdef(torddef.create(s32bit,low(longint),high(longint)));
+        cu64bittype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
+        cs64bittype.setdef(torddef.create(s64bit,low(int64),high(int64)));
+        booltype.setdef(torddef.create(bool8bit,0,1));
+        cchartype.setdef(torddef.create(uchar,0,255));
+        cwidechartype.setdef(torddef.create(uwidechar,0,65535));
+        cshortstringtype.setdef(tstringdef.createshort(255));
+        { should we give a length to the default long and ansi string definition ?? }
+        clongstringtype.setdef(tstringdef.createlong(-1));
+        cansistringtype.setdef(tstringdef.createansi(-1));
+        cwidestringtype.setdef(tstringdef.createwide(-1));
+        { length=0 for shortstring is open string (needed for readln(string) }
+        openshortstringtype.setdef(tstringdef.createshort(0));
+        openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
+        tarraydef(openchararraytype.def).elementtype:=cchartype;
+{$ifdef x86}
+  {$ifdef i386}
+        ordpointertype:=u32bittype;
+  {$endif i386}
+  {$ifdef x86_64}
+        ordpointertype:=cu64bittype;
+  {$endif x86_64}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+{$endif x86}
+{$ifdef powerpc}
+        ordpointertype:=u32bittype;
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+{$endif powerpc}
+{$ifdef sparc}
+        ordpointertype:=u32bittype;
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+{$endif sparc}
+{$ifdef m68k}
+        ordpointertype:=u32bittype;
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+{$endif}
+        s64currencytype.setdef(tfloatdef.create(s64currency));
+        { some other definitions }
+        voidpointertype.setdef(tpointerdef.create(voidtype));
+        charpointertype.setdef(tpointerdef.create(cchartype));
+        voidfarpointertype.setdef(tpointerdef.createfar(voidtype));
+        cfiletype.setdef(tfiledef.createuntyped);
+        cvarianttype.setdef(tvariantdef.create);
+        registerdef:=oldregisterdef;
+      end;
+
+
+    procedure registernodes;
+      {
+        Register all possible nodes in the nodeclass array that
+        will be used for loading the nodes from a ppu
+      }
+      begin
+        nodeclass[addn]:=caddnode;
+        nodeclass[muln]:=caddnode;
+        nodeclass[subn]:=caddnode;
+        nodeclass[divn]:=cmoddivnode;
+        nodeclass[symdifn]:=caddnode;
+        nodeclass[modn]:=cmoddivnode;
+        nodeclass[assignn]:=cassignmentnode;
+        nodeclass[loadn]:=cloadnode;
+        nodeclass[rangen]:=crangenode;
+        nodeclass[ltn]:=caddnode;
+        nodeclass[lten]:=caddnode;
+        nodeclass[gtn]:=caddnode;
+        nodeclass[gten]:=caddnode;
+        nodeclass[equaln]:=caddnode;
+        nodeclass[unequaln]:=caddnode;
+        nodeclass[inn]:=cinnode;
+        nodeclass[orn]:=caddnode;
+        nodeclass[xorn]:=caddnode;
+        nodeclass[shrn]:=cshlshrnode;
+        nodeclass[shln]:=cshlshrnode;
+        nodeclass[slashn]:=caddnode;
+        nodeclass[andn]:=caddnode;
+        nodeclass[subscriptn]:=csubscriptnode;
+        nodeclass[derefn]:=cderefnode;
+        nodeclass[addrn]:=caddrnode;
+        nodeclass[doubleaddrn]:=cdoubleaddrnode;
+        nodeclass[ordconstn]:=cordconstnode;
+        nodeclass[typeconvn]:=ctypeconvnode;
+        nodeclass[calln]:=ccallnode;
+        nodeclass[callparan]:=ccallparanode;
+        nodeclass[realconstn]:=crealconstnode;
+        nodeclass[unaryminusn]:=cunaryminusnode;
+        nodeclass[asmn]:=casmnode;
+        nodeclass[vecn]:=cvecnode;
+        nodeclass[pointerconstn]:=cpointerconstnode;
+        nodeclass[stringconstn]:=cstringconstnode;
+        nodeclass[funcretn]:=cfuncretnode;
+        nodeclass[selfn]:=cselfnode;
+        nodeclass[notn]:=cnotnode;
+        nodeclass[inlinen]:=cinlinenode;
+        nodeclass[niln]:=cnilnode;
+        nodeclass[errorn]:=cerrornode;
+        nodeclass[typen]:=ctypenode;
+        nodeclass[hnewn]:=chnewnode;
+        nodeclass[hdisposen]:=chdisposenode;
+        nodeclass[setelementn]:=csetelementnode;
+        nodeclass[setconstn]:=csetconstnode;
+        nodeclass[blockn]:=cblocknode;
+        nodeclass[statementn]:=cstatementnode;
+        nodeclass[ifn]:=cifnode;
+        nodeclass[breakn]:=cbreaknode;
+        nodeclass[continuen]:=ccontinuenode;
+        nodeclass[whilerepeatn]:=cwhilerepeatnode;
+        nodeclass[forn]:=cfornode;
+        nodeclass[exitn]:=cexitnode;
+        nodeclass[withn]:=cwithnode;
+        nodeclass[casen]:=ccasenode;
+        nodeclass[labeln]:=clabelnode;
+        nodeclass[goton]:=cgotonode;
+        nodeclass[tryexceptn]:=ctryexceptnode;
+        nodeclass[raisen]:=craisenode;
+        nodeclass[tryfinallyn]:=ctryfinallynode;
+        nodeclass[onn]:=connode;
+        nodeclass[isn]:=cisnode;
+        nodeclass[asn]:=casnode;
+        nodeclass[caretn]:=caddnode;
+        nodeclass[failn]:=cfailnode;
+        nodeclass[starstarn]:=caddnode;
+        nodeclass[procinlinen]:=cprocinlinenode;
+        nodeclass[arrayconstructorn]:=carrayconstructornode;
+        nodeclass[arrayconstructorrangen]:=carrayconstructorrangenode;
+        nodeclass[tempcreaten]:=ctempcreatenode;
+        nodeclass[temprefn]:=ctemprefnode;
+        nodeclass[tempdeleten]:=ctempdeletenode;
+        nodeclass[addoptn]:=caddnode;
+        nodeclass[nothingn]:=cnothingnode;
+        nodeclass[loadvmtn]:=cloadvmtnode;
+        nodeclass[guidconstn]:=cguidconstnode;
+        nodeclass[rttin]:=crttinode;
+      end;
+
+
+    procedure registertais;
+      {
+        Register all possible tais in the taiclass array that
+        will be used for loading the tais from a ppu
+      }
+      begin
+        aiclass[ait_none]:=nil;
+        aiclass[ait_align]:=tai_align;
+        aiclass[ait_section]:=tai_section;
+        aiclass[ait_comment]:=tai_comment;
+        aiclass[ait_direct]:=tai_direct;
+        aiclass[ait_string]:=tai_string;
+        aiclass[ait_instruction]:=taicpu;
+        aiclass[ait_datablock]:=tai_datablock;
+        aiclass[ait_symbol]:=tai_symbol;
+        aiclass[ait_symbol_end]:=tai_symbol_end;
+        aiclass[ait_label]:=tai_label;
+        aiclass[ait_const_32bit]:=tai_const;
+        aiclass[ait_const_16bit]:=tai_const;
+        aiclass[ait_const_8bit]:=tai_const;
+        aiclass[ait_const_symbol]:=tai_const_symbol;
+        aiclass[ait_const_rva]:=tai_const_symbol;
+        aiclass[ait_real_32bit]:=tai_real_32bit;
+        aiclass[ait_real_64bit]:=tai_real_64bit;
+        aiclass[ait_real_80bit]:=tai_real_80bit;
+        aiclass[ait_comp_64bit]:=tai_comp_64bit;
+{$ifdef GDB}
+        aiclass[ait_stabn]:=tai_stabn;
+        aiclass[ait_stabs]:=tai_stabs;
+        aiclass[ait_force_line]:=tai_force_line;
+        aiclass[ait_stab_function_name]:=tai_stab_function_name;
+{$endif GDB}
+{$ifdef alpha}
+          { the follow is for the DEC Alpha }
+        aiclass[ait_frame]:=tai_frame;
+        aiclass[ait_ent]:=tai_ent;
+{$endif alpha}
+{$ifdef m68k}
+{$warning FIXME: tai_labeled_instruction doesn't exists}
+//        aiclass[ait_labeled_instruction]:=tai_labeled_instruction;
+{$endif m68k}
+{$ifdef ia64}
+        aiclass[ait_bundle]:=tai_bundle;
+        aiclass[ait_stop]:=tai_stop;
+{$endif ia64}
+{$ifdef SPARC}
+{$WARNING FIXME: tai_labeled_instruction doesn't exists}
+//        aiclass[ait_labeled_instruction]:=tai_labeled_instruction;
+{$endif SPARC}
+        aiclass[ait_cut]:=tai_cut;
+        aiclass[ait_regalloc]:=tai_regalloc;
+        aiclass[ait_tempalloc]:=tai_tempalloc;
+        aiclass[ait_marker]:=tai_marker;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-21 13:30:07  mazen
+  *** empty log message ***
+
+  Revision 1.37  2002/08/18 20:06:25  peter
+    * inlining is now also allowed in interface
+    * renamed write/load to ppuwrite/ppuload
+    * tnode storing in ppu
+    * nld,ncon,nbas are already updated for storing in ppu
+
+  Revision 1.36  2002/08/15 19:10:35  peter
+    * first things tai,tnode storing in ppu
+
+  Revision 1.35  2002/08/14 19:14:39  carl
+    + fpu emulation support (generic and untested)
+
+  Revision 1.34  2002/08/13 18:01:52  carl
+    * rename swatoperands to swapoperands
+    + m68k first compilable version (still needs a lot of testing):
+        assembler generator, system information , inline
+        assembler reader.
+
+  Revision 1.33  2002/08/11 15:28:00  florian
+    + support of explicit type case <any ordinal type>->pointer
+      (delphi mode only)
+
+  Revision 1.32  2002/07/25 17:54:24  carl
+   + Extended is now CPU dependant (equal to bestrealtype)
+
+  Revision 1.30  2002/07/07 09:52:32  florian
+    * powerpc target fixed, very simple units can be compiled
+    * some basic stuff for better callparanode handling, far from being finished
+
+  Revision 1.29  2002/07/06 20:18:47  carl
+  + more SPARC patches from Mazen
+
+  Revision 1.28  2002/07/04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.27  2002/07/01 16:23:54  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.26  2002/05/18 13:34:16  peter
+    * readded missing revisions
+
+  Revision 1.25  2002/05/16 19:46:44  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.23  2002/05/12 16:53:09  peter
+    * moved entry and exitcode to ncgutil and cgobj
+    * foreach gets extra argument for passing local data to the
+      iterator function
+    * -CR checks also class typecasts at runtime by changing them
+      into as
+    * fixed compiler to cycle with the -CR option
+    * fixed stabs with elf writer, finally the global variables can
+      be watched
+    * removed a lot of routines from cga unit and replaced them by
+      calls to cgobj
+    * u32bit-s32bit updates for and,or,xor nodes. When one element is
+      u32bit then the other is typecasted also to u32bit without giving
+      a rangecheck warning/error.
+    * fixed pascal calling method with reversing also the high tree in
+      the parast, detected by tcalcst3 test
+
+  Revision 1.22  2002/01/24 12:33:53  jonas
+    * adapted ranges of native types to int64 (e.g. high cardinal is no
+      longer longint($ffffffff), but just $fffffff in psystem)
+    * small additional fix in 64bit rangecheck code generation for 32 bit
+      processors
+    * adaption of ranges required the matching talgorithm used for selecting
+      which overloaded procedure to call to be adapted. It should now always
+      select the closest match for ordinal parameters.
+    + inttostr(qword) in sysstr.inc/sysstrh.inc
+    + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
+      fixes were required to be able to add them)
+    * is_in_limit() moved from ncal to types unit, should always be used
+      instead of direct comparisons of low/high values of orddefs because
+      qword is a special case
+
+}

compiler/sparc/rgcpu.pas

@@ -0,0 +1,338 @@
+{*****************************************************************************}
+{ File                   : rgcpu.pas                                          }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\26\26                                         }
+{ Last modification date : 2002\08\20                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements the i386 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;
+
+{$INCLUDE fpcdefs.inc}
+
+  interface
+
+    uses
+      cpubase,
+      cpuinfo,
+      aasmcpu,
+      aasmtai,
+      cclasses,globtype,cgbase,aasmbase,rgobj;
+
+    type
+       trgcpu = class(trgobj)
+
+          { to keep the same allocation order as with the old routines }
+          function getregisterint(list: taasmoutput): tregister; override;
+          procedure ungetregisterint(list: taasmoutput; r : tregister); override;
+          function getexplicitregisterint(list: taasmoutput; r : tregister) : tregister; override;
+
+          function getregisterfpu(list: taasmoutput) : tregister; override;
+          procedure ungetregisterfpu(list: taasmoutput; r : tregister); override;
+
+          procedure ungetreference(list: taasmoutput; const ref : treference); override;
+
+          { pushes and restores registers }
+          procedure pushusedregisters(list: taasmoutput;
+            var pushed : tpushedsaved;const s: tregisterset);
+          procedure popusedregisters(list: taasmoutput;
+            const pushed : tpushedsaved);
+
+          procedure resetusableregisters;override;
+
+         { corrects the fpu stack register by ofs }
+         function correct_fpuregister(r : tregister;ofs : byte) : tregister;
+
+         fpuvaroffset : byte;
+       end;
+
+
+  implementation
+
+    uses
+       systems,
+       globals,verbose,node,
+       cgobj,tgobj,cga;
+
+
+    function trgcpu.getregisterint(list: taasmoutput): tregister;
+      begin
+         if countunusedregsint=0 then
+           internalerror(10);(*
+{$ifdef TEMPREGDEBUG}
+         if curptree^.usableregsint-countunusedregsint>curptree^.registers32 then
+           internalerror(10);
+{$endif TEMPREGDEBUG}
+{$ifdef EXTTEMPREGDEBUG}
+         if curptree^.usableregs-countunusedregistersint>curptree^^.reallyusedregs then
+           curptree^.reallyusedregs:=curptree^^.usableregs-countunusedregistersint;
+{$endif EXTTEMPREGDEBUG}
+         dec(countunusedregsint);
+         if R_EAX in unusedregsint then
+           begin
+              exclude(unusedregsint,R_EAX);
+              include(usedinproc,R_EAX);
+              getregisterint:=R_EAX;
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_EAX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmlist.concat(tairegalloc.alloc(R_EAX));
+           end
+         else if R_EDX in unusedregsint then
+           begin
+              exclude(unusedregsint,R_EDX);
+              include(usedinproc,R_EDX);
+              getregisterint:=R_EDX;
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_EDX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmlist.concat(tairegalloc.alloc(R_EDX));
+           end
+         else if R_EBX in unusedregsint then
+           begin
+              exclude(unusedregsint,R_EBX);
+              include(usedinproc,R_EBX);
+              getregisterint:=R_EBX;
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_EBX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmlist.concat(tairegalloc.alloc(R_EBX));
+           end
+         else if R_ECX in unusedregsint then
+           begin
+              exclude(unusedregsint,R_ECX);
+              include(usedinproc,R_ECX);
+              getregisterint:=R_ECX;
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_ECX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmlist.concat(tairegalloc.alloc(R_ECX));
+           end
+         else internalerror(10);
+{$ifdef TEMPREGDEBUG}
+         testregisters;
+{$endif TEMPREGDEBUG}*)
+      end;
+
+    procedure trgcpu.ungetregisterint(list: taasmoutput; r : tregister);
+      begin
+{         if (r = R_EDI) or
+            ((not assigned(procinfo^._class)) and (r = R_ESI)) then
+           begin
+             list.concat(Tairegalloc.DeAlloc(r));
+             exit;
+           end;
+         if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
+           exit;
+         inherited ungetregisterint(list,r);}
+      end;
+
+
+   function trgcpu.getexplicitregisterint(list: taasmoutput; r : tregister) : tregister;
+     begin
+{       if r in [R_ESI,R_EDI] then
+         begin
+           list.concat(Tairegalloc.Alloc(r));
+           getexplicitregisterint := r;
+           exit;
+         end;}
+       result := inherited getexplicitregisterint(list,r);
+    end;
+
+
+    function trgcpu.getregisterfpu(list: taasmoutput) : tregister;
+
+      begin
+        { note: don't return R_ST0, see comments above implementation of }
+        { a_loadfpu_* methods in cgcpu (JM)                              }
+//        result := R_ST;
+      end;
+
+
+    procedure trgcpu.ungetregisterfpu(list : taasmoutput; r : tregister);
+
+      begin
+        { nothing to do, fpu stack management is handled by the load/ }
+        { store operations in cgcpu (JM)                              }
+      end;
+
+
+    procedure trgcpu.ungetreference(list: taasmoutput; const ref : treference);
+
+      begin
+         ungetregisterint(list,ref.base);
+         ungetregisterint(list,ref.index);
+      end;
+
+
+    procedure trgcpu.pushusedregisters(list: taasmoutput;
+        var pushed : tpushedsaved; const s: tregisterset);
+
+      var
+        r: tregister;
+        hr: treference;
+      begin
+        usedinproc:=usedinproc + s;
+(*        for r:=R_EAX to R_EBX do
+          begin
+            pushed[r].pushed:=false;
+            { if the register is used by the calling subroutine    }
+            if not is_reg_var[r] and
+               (r in s) and
+               { and is present in use }
+               not(r in unusedregsint) then
+              begin
+                { then save it }
+                list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
+                include(unusedregsint,r);
+                inc(countunusedregsint);
+                pushed[r].pushed:=true;
+              end;
+          end;*)
+{$ifdef SUPPORT_MMX}
+        (*for r:=R_MM0 to R_MM6 do
+          begin
+            pushed[r].pushed:=false;
+            { if the register is used by the calling subroutine    }
+            if not is_reg_var[r] and
+               (r in s) and
+               { and is present in use }
+               not(r in unusedregsmm) then
+              begin
+                list.concat(Taicpu.Op_const_reg(A_SUB,S_L,8,R_ESP));
+                reference_reset_base(hr,R_ESP,0);
+                list.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,hr));
+                include(unusedregsmm,r);
+                inc(countunusedregsmm);
+                pushed[r].pushed:=true;
+              end;
+          end;*)
+{$endif SUPPORT_MMX}
+{$ifdef TEMPREGDEBUG}
+        testregisters;
+{$endif TEMPREGDEBUG}
+      end;
+
+
+    procedure trgcpu.popusedregisters(list: taasmoutput;
+        const pushed : tpushedsaved);
+
+      var
+        r : tregister;
+{$ifdef SUPPORT_MMX}
+        hr : treference;
+{$endif SUPPORT_MMX}
+      begin
+        { restore in reverse order: }
+{$ifdef SUPPORT_MMX}
+        for r:=R_MM6 downto R_MM0 do
+          if pushed[r].pushed then
+            begin
+              reference_reset_base(hr,R_ESP,0);
+              list.concat(Taicpu.Op_ref_reg(
+                A_MOVQ,S_NO,hr,r));
+              list.concat(Taicpu.Op_const_reg(
+                A_ADD,S_L,8,R_ESP));
+              if not (r in unusedregsmm) then
+                { internalerror(10)
+                  in cg386cal we always restore regs
+                  that appear as used
+                  due to a unused tmep storage PM }
+              else
+                dec(countunusedregsmm);
+              exclude(unusedregsmm,r);
+            end;
+{$endif SUPPORT_MMX}
+(*        for r:=R_EBX downto R_EAX do
+          if pushed[r].pushed then
+            begin
+              list.concat(Taicpu.Op_reg(A_POP,S_L,r));
+              if not (r in unusedregsint) then
+                { internalerror(10)
+                  in cg386cal we always restore regs
+                  that appear as used
+                  due to a unused tmep storage PM }
+              else
+                dec(countunusedregsint);
+              exclude(unusedregsint,r);
+            end;*)
+{$ifdef TEMPREGDEBUG}
+        testregisters;
+{$endif TEMPREGDEBUG}
+      end;
+
+   procedure trgcpu.resetusableregisters;
+
+     begin
+       inherited resetusableregisters;
+       fpuvaroffset := 0;
+     end;
+
+
+   function trgcpu.correct_fpuregister(r : tregister;ofs : byte) : tregister;
+
+     begin
+        correct_fpuregister:=tregister(longint(r)+ofs);
+     end;
+
+
+initialization
+  rg := trgcpu.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-21 13:30:07  mazen
+  *** empty log message ***
+
+  Revision 1.2  2002/04/02 17:11:39  peter
+    * tlocation,treference update
+    * LOC_CONSTANT added for better constant handling
+    * secondadd splitted in multiple routines
+    * location_force_reg added for loading a location to a register
+      of a specified size
+    * secondassignment parses now first the right and then the left node
+      (this is compatible with Kylix). This saves a lot of push/pop especially
+      with string operations
+    * adapted some routines to use the new cg methods
+
+  Revision 1.1  2002/03/31 20:26:40  jonas
+    + a_loadfpu_* and a_loadmm_* methods in tcg
+    * register allocation is now handled by a class and is mostly processor
+      independent (+rgobj.pas and i386/rgcpu.pas)
+    * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
+    * some small improvements and fixes to the optimizer
+    * some register allocation fixes
+    * some fpuvaroffset fixes in the unary minus node
+    * fixed and optimized register saving/restoring for new/dispose nodes
+    * LOC_FPU locations now also require their "register" field to be set to
+      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
+    - list field removed of the tnode class because it's not used currently
+      and can cause hard-to-find bugs
+
+}