* alpha compiles again, changes to common code not yet commited

compiler/alpha/aasmcpu.pas

@@ -27,63 +27,66 @@ unit aasmcpu;
 
 {$i fpcdefs.inc}
 
-interface
-
-uses
-  aasmbase,globals,verbose,
-  cpubase,aasmtai;
-
-type
-  tai_frame = class(tai)
-     G,R : TRegister;
-     LS,LU : longint;
-    Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
-    end;
-
-  tai_ent = class(tai)
-    Name : string;
-    Constructor Create (const ProcName : String);
-    end;
-
-
-  taicpu = class(taicpu_abstract)
-     constructor op_none(op : tasmop);
-
-     constructor op_reg(op : tasmop;_op1 : tregister);
-     constructor op_const(op : tasmop;_op1 : longint);
-     constructor op_ref(op : tasmop;_op1 : preference);
-
-     constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-     constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
-     constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
-
-     constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
-     constructor op_const_const(op : tasmop;_op1,_op2 : longint);
-     constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
-
-     constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
-     { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
-     constructor op_ref_ref(op : tasmop;_op1,_op2 : preference);
-
-     constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-     constructor op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
-     constructor op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
-     constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3 : preference);
-     constructor op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
-     constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
-
-     { this is for Jmp instructions }
-     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+  interface
+
+    uses
+       aasmbase,globals,verbose,
+       cpubase,aasmtai;
+
+    type
+      tai_frame = class(tai)
+         G,R : TRegister;
+         LS,LU : longint;
+        Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
+        end;
+
+      tai_ent = class(tai)
+        Name : string;
+        Constructor Create (const ProcName : String);
+        end;
+
+
+      taicpu = class(taicpu_abstract)
+         constructor op_none(op : tasmop);
+
+         constructor op_reg(op : tasmop;_op1 : tregister);
+         constructor op_const(op : tasmop;_op1 : longint);
+         constructor op_ref(op : tasmop;_op1 : preference);
+
+         constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+         constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
+         constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
+
+         constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
+         constructor op_const_const(op : tasmop;_op1,_op2 : longint);
+         constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
+
+         constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
+         { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
+         constructor op_ref_ref(op : tasmop;_op1,_op2 : preference);
+
+         constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
+         constructor op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
+         constructor op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
+         constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3 : preference);
+         constructor op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
+         constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
+
+         { this is for Jmp instructions }
+         constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+
+         constructor op_sym(op : tasmop;_op1 : tasmsymbol);
+         constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+         constructor op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+         constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
+      end;
 
-     constructor op_sym(op : tasmop;_op1 : tasmsymbol);
-     constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
-     constructor op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
-     constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
-  end;
+      tai_align = class(tai_align_abstract)
+        { nothing to add }
+      end;
 
-  tai_align = class(tai_align_abstract)
-    { nothing to add }
-  end;
+    procedure InitAsm;
+    procedure DoneAsm;
 
 implementation
 
@@ -266,10 +269,23 @@ implementation
       Name:=ProcName;
     end;
 
-end.
+    procedure InitAsm;
+      begin
+      end;
+
+
+    procedure DoneAsm;
+      begin
+      end;
+
+
+    end.
 {
   $Log$
-  Revision 1.2  2002-09-29 23:42:45  florian
+  Revision 1.3  2002-09-29 23:54:12  florian
+    * alpha compiles again, changes to common code not yet commited
+
+  Revision 1.2  2002/09/29 23:42:45  florian
     * several fixes to get forward with alpha compilation
 
   Revision 1.1  2002/09/29 22:34:17  florian

compiler/alpha/cpubase.pas

@@ -193,11 +193,29 @@ unit cpubase;
        max_scratch_regs = 2;
        scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
 
-    type
+{*****************************************************************************
+                               GDB Information
+*****************************************************************************}
+
+       {  Register indexes for stabs information, when some
+         parameters or variables are stored in registers.
+       }
+       stab_regindex : array[tregister] of shortint =
+          (0,
+           0,0,0,0,0,0,0,0,0,0,
+           0,0,0,0,0,0,0,0,0,0,
+           0,0,0,0,0,0,0,0,0,0,
+           0,0,
+           0,0,0,0,0,0,0,0,0,0,
+           0,0,0,0,0,0,0,0,0,0,
+           0,0,0,0,0,0,0,0,0,0,
+           0,0
+          );
 
 {*****************************************************************************
                                    Flags
 *****************************************************************************}
+       type
        { The Alpha doesn't have flags but some generic code depends on this type. }
        TResFlags = (F_NO);
 
@@ -432,7 +450,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2002-09-29 23:42:45  florian
+  Revision 1.4  2002-09-29 23:54:12  florian
+    * alpha compiles again, changes to common code not yet commited
+
+  Revision 1.3  2002/09/29 23:42:45  florian
     * several fixes to get forward with alpha compilation
 
   Revision 1.2  2002/09/07 15:25:10  peter

compiler/alpha/cpunode.pas

@@ -33,7 +33,7 @@ unit cpunode;
 
     uses
        { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)
@@ -55,6 +55,9 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.1  2002-08-18 09:13:02  florian
+  Revision 1.2  2002-09-29 23:54:12  florian
+    * alpha compiles again, changes to common code not yet commited
+
+  Revision 1.1  2002/08/18 09:13:02  florian
     * small fixes to the alpha stuff
 }

compiler/alpha/cpupara.pas

@@ -0,0 +1,345 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    Alpha 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.
+ ****************************************************************************
+}
+{ Alpha specific calling conventions are handled by this unit
+}
+unit cpupara;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cpubase,
+       symconst,symbase,symtype,symdef,paramgr;
+
+    type
+       talphaparamanager = class(tparamanager)
+          function getintparaloc(nr : longint) : tparalocation;override;
+          procedure create_param_loc_info(p : tabstractprocdef);override;
+          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
+       end;
+
+  implementation
+
+    uses
+       verbose,
+       globtype,
+       cpuinfo,cginfo,cgbase,
+       defbase;
+
+    function talphaparamanager.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_2)+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
+         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
+           if push_addr_param for the def is true
+         }
+         case p.deftype of
+            orddef:
+              getparaloc:=LOC_REGISTER;
+            floatdef:
+              getparaloc:=LOC_FPUREGISTER;
+            enumdef:
+              getparaloc:=LOC_REGISTER;
+            pointerdef:
+              getparaloc:=LOC_REGISTER;
+            formaldef:
+              getparaloc:=LOC_REGISTER;
+            classrefdef:
+              getparaloc:=LOC_REGISTER;
+            recorddef:
+              getparaloc:=LOC_REFERENCE;
+            objectdef:
+              if is_object(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            stringdef:
+              if is_shortstring(p) or is_longstring(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            procvardef:
+              if (po_methodpointer in tprocvardef(p).procoptions) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            filedef:
+              getparaloc:=LOC_REGISTER;
+            arraydef:
+              getparaloc:=LOC_REFERENCE;
+            setdef:
+              if is_smallset(p) then
+                getparaloc:=LOC_REGISTER
+              else
+                getparaloc:=LOC_REFERENCE;
+            variantdef:
+              getparaloc:=LOC_REFERENCE;
+            { avoid problems with errornous definitions }
+            errordef:
+              getparaloc:=LOC_REGISTER;
+            else
+              internalerror(2002071001);
+         end;
+      end;
+
+    procedure talphaparamanager.create_param_loc_info(p : tabstractprocdef);
+
+      var
+         nextintreg,nextfloatreg,nextmmreg : tregister;
+         stack_offset : aword;
+         hp : tparaitem;
+         loc : tloc;
+         is_64bit: boolean;
+
+      begin
+         nextintreg:=R_3;
+         nextfloatreg:=R_F1;
+         // nextmmreg:=R_M1;
+         stack_offset:=0;
+         { pointer for structured results ? }
+         if not is_void(p.rettype.def) then
+           begin
+              if not(ret_in_reg(p.rettype.def)) then
+                inc(nextintreg);
+           end;
+
+         { frame pointer for nested procedures? }
+         { inc(nextintreg);                     }
+         { constructor? }
+         { destructor? }
+         hp:=tparaitem(p.para.last);
+         while assigned(hp) do
+           begin
+              loc:=getparaloc(hp.paratype.def);
+              hp.paraloc.sp_fixup:=0;
+              case loc of
+                 LOC_REGISTER:
+                   begin
+                      hp.paraloc.size := def_cgsize(hp.paratype.def);
+                      { for things like formaldef }
+                      if hp.paraloc.size = OS_NO then
+                        hp.paraloc.size := OS_ADDR;
+                      is_64bit := hp.paraloc.size in [OS_64,OS_S64];
+                      if nextintreg<=tregister(ord(R_10)-ord(is_64bit))  then
+                        begin
+                           hp.paraloc.loc:=LOC_REGISTER;
+                           hp.paraloc.registerlow:=nextintreg;
+                           inc(nextintreg);
+                           if is_64bit then
+                             begin
+                               hp.paraloc.registerhigh:=nextintreg;
+                               inc(nextintreg);
+                             end;
+                        end
+                      else
+                         begin
+                            nextintreg := R_11;
+                            hp.paraloc.loc:=LOC_REFERENCE;
+                            hp.paraloc.reference.index:=stack_pointer_reg;
+                            hp.paraloc.reference.offset:=stack_offset;
+                            if not is_64bit then
+                              inc(stack_offset,4)
+                            else
+                              inc(stack_offset,8);
+                        end;
+                   end;
+                 LOC_FPUREGISTER:
+                   begin
+                      if hp.paratyp in [vs_var,vs_out] then
+                        begin
+                            if nextintreg<=R_10 then
+                             begin
+                                hp.paraloc.size:=OS_ADDR;
+                                hp.paraloc.loc:=LOC_REGISTER;
+                                hp.paraloc.register:=nextintreg;
+                                inc(nextintreg);
+                             end
+                           else
+                              begin
+                                 {!!!!!!!}
+                                 hp.paraloc.size:=def_cgsize(hp.paratype.def);
+                                 internalerror(2002071006);
+                             end;
+                        end
+                      else if nextfloatreg<=R_F10 then
+                        begin
+                           hp.paraloc.size:=def_cgsize(hp.paratype.def);
+                           hp.paraloc.loc:=LOC_FPUREGISTER;
+                           hp.paraloc.register:=nextfloatreg;
+                           inc(nextfloatreg);
+                        end
+                      else
+                         begin
+                            {!!!!!!!}
+                             hp.paraloc.size:=def_cgsize(hp.paratype.def);
+                            internalerror(2002071004);
+                        end;
+                   end;
+                 LOC_REFERENCE:
+                   begin
+                      hp.paraloc.size:=OS_ADDR;
+                      if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
+                        begin
+                           if nextintreg<=R_10 then
+                             begin
+                                hp.paraloc.loc:=LOC_REGISTER;
+                                hp.paraloc.register:=nextintreg;
+                                inc(nextintreg);
+                             end
+                           else
+                              begin
+                                 hp.paraloc.loc:=LOC_REFERENCE;
+                                 hp.paraloc.reference.index:=stack_pointer_reg;
+                                 hp.paraloc.reference.offset:=stack_offset;
+                                 inc(stack_offset,4);
+                             end;
+                        end
+                      else
+                        begin
+                           hp.paraloc.loc:=LOC_REFERENCE;
+                           hp.paraloc.reference.index:=stack_pointer_reg;
+                           hp.paraloc.reference.offset:=stack_offset;
+                           inc(stack_offset,hp.paratype.def.size);
+                        end;
+                   end;
+                 else
+                   internalerror(2002071002);
+              end;
+              hp:=tparaitem(hp.previous);
+           end;
+      end;
+
+    function talphaparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
+      begin
+         case p.rettype.def.deftype of
+            orddef,
+            enumdef:
+              begin
+                getfuncretparaloc.loc:=LOC_REGISTER;
+                getfuncretparaloc.register:=R_3;
+                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
+                if getfuncretparaloc.size in [OS_S64,OS_64] then
+                  getfuncretparaloc.registerhigh:=R_4;
+              end;
+            floatdef:
+              begin
+                getfuncretparaloc.loc:=LOC_FPUREGISTER;
+                getfuncretparaloc.register:=R_F1;
+                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
+              end;
+            pointerdef,
+            formaldef,
+            classrefdef,
+            recorddef,
+            objectdef,
+            stringdef,
+            procvardef,
+            filedef,
+            arraydef,
+            errordef:
+              begin
+                getfuncretparaloc.loc:=LOC_REGISTER;
+                getfuncretparaloc.register:=R_3;
+                getfuncretparaloc.size:=OS_ADDR;
+              end;
+            else
+              internalerror(2002090903);
+        end;
+      end;
+
+
+begin
+   paramanager:=talphaparamanager.create;
+end.
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:54:12  florian
+    * alpha compiles again, changes to common code not yet commited
+
+  Revision 1.14  2002/09/28 21:27:16  florian
+    + getparaloc supports now sets and variants
+
+  Revision 1.13  2002/09/10 21:28:05  jonas
+    * int64 paras are now handled correctly (until the registers are used up
+      anyway :)
+    * the return location is now initialized correctly
+    * fixed bug where ret_in_reg() was called for the procdefinition instead
+      of for the result of the procedure
+
+  Revision 1.12  2002/09/09 09:11:37  florian
+    - removed passes_parameters_in_reg
+
+  Revision 1.11  2002/09/07 17:54:59  florian
+    * first part of PowerPC fixes
+
+  Revision 1.10  2002/09/01 21:04:49  florian
+    * several powerpc related stuff fixed
+
+  Revision 1.9  2002/08/31 12:43:31  florian
+    * ppc compilation fixed
+
+  Revision 1.8  2002/08/18 10:42:38  florian
+    * remaining assembler writer bugs fixed, the errors in the
+      system unit are inline assembler problems
+
+  Revision 1.7  2002/08/17 22:09:47  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.6  2002/08/13 21:40:58  florian
+    * more fixes for ppc calling conventions
+
+  Revision 1.5  2002/07/30 20:50:44  florian
+    * the code generator knows now if parameters are in registers
+
+  Revision 1.4  2002/07/28 20:45:22  florian
+    + added direct assembler reader for PowerPC
+
+  Revision 1.3  2002/07/26 22:22:10  florian
+    * several PowerPC related fixes to get forward with system unit compilation
+
+  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/alpha/cpupi.pas

@@ -0,0 +1,51 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    This unit contains the CPU specific part of tprocinfo
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+  This unit contains the CPU specific part of tprocinfo.
+}
+unit cpupi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cgbase;
+
+    type
+       talphaprocinfo = class(tprocinfo)
+       end;
+
+
+  implementation
+
+begin
+   cprocinfo:=talphaprocinfo;
+end.
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:54:12  florian
+    * alpha compiles again, changes to common code not yet commited
+}
+
+

compiler/alpha/cputarg.pas

@@ -0,0 +1,57 @@
+{
+    $Id$
+    Copyright (c) 2001-2002 by Peter Vreman
+
+    Includes the powerpc dependent target units
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cputarg;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+    uses
+      systems { prevent a syntax error when nothing is included }
+
+{**************************************
+             Targets
+**************************************}
+
+    {$ifndef NOTARGETLINUX}
+      ,t_linux
+    {$endif}
+
+{**************************************
+             Assemblers
+**************************************}
+
+    {$ifndef NOAGAXPGAS}
+      ,agaxpgas
+    {$endif}
+      ;
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:54:13  florian
+    * alpha compiles again, changes to common code not yet commited
+}