* several fixes to get forward with alpha compilation

compiler/alpha/aasmcpu.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1998-2000 by Florian Klaempfl
 
-    Contains the assembler object for the Alpha
+    Implements the assembler classes specific for the Alpha
 
     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
@@ -20,32 +20,33 @@
 
  ****************************************************************************
 }
-unit cpuasm;
+{
+  Implements the assembler classes specific for the Alpha.
+}
+unit aasmcpu;
+
+{$i fpcdefs.inc}
 
 interface
 
 uses
-  cobjects,
-  aasm,globals,verbose,
-  cpubase,tainst;
+  aasmbase,globals,verbose,
+  cpubase,aasmtai;
 
 type
-  paiframe = ^taiframe;
-  taiframe = object(tai)
+  tai_frame = class(tai)
      G,R : TRegister;
      LS,LU : longint;
-    Constructor init (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
+    Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
     end;
 
-  paient = ^taient;
-  taient = object(tai)
+  tai_ent = class(tai)
     Name : string;
-    Constructor Init (ProcName : String);
+    Constructor Create (const ProcName : String);
     end;
 
 
-  paicpu = ^taicpu;
-  taicpu = object(tainstruction)
+  taicpu = class(taicpu_abstract)
      constructor op_none(op : tasmop);
 
      constructor op_reg(op : tasmop;_op1 : tregister);
@@ -72,18 +73,17 @@ type
      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 : pasmsymbol);
+     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
 
-     constructor op_sym(op : tasmop;_op1 : pasmsymbol);
-     constructor op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
-     constructor op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
-     constructor op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
-
-     function  getcopy:plinkedlist_item;virtual;
-  private
-     segprefix : tregister;
+     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;
 
 implementation
 
@@ -95,178 +95,162 @@ implementation
 
     constructor taicpu.op_none(op : tasmop);
       begin
-         inherited init(op);
+         inherited create(op);
       end;
 
 
     constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
       end;
 
 
     constructor taicpu.op_const(op : tasmop;_op1 : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
       end;
 
 
     constructor taicpu.op_ref(op : tasmop;_op1 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
       end;
 
 
     constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
     constructor taicpu.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_ref_ref(op : tasmop;_op1,_op2 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
     constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
       end;
 
     constructor taicpu.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
       end;
 
      constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
       end;
 
      constructor taicpu.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
       end;
 
      constructor taicpu.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
       end;
 
      constructor taicpu.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
       end;
 
 
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
       begin
-         inherited init(op);
+         inherited create(op);
          condition:=cond;
          ops:=1;
       end;
 
 
-    constructor taicpu.op_sym(op : tasmop;_op1 : pasmsymbol);
+    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
       end;
 
 
-    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
+    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
       end;
 
 
-    constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
+    constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
 
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
       end;
 
-    function taicpu.getcopy:plinkedlist_item;
-      var
-        i : longint;
-        p : plinkedlist_item;
-      begin
-        p:=inherited getcopy;
-        { make a copy of the references }
-        for i:=1 to ops do
-         if (paicpu(p)^.oper[i-1].typ=top_ref) then
-          begin
-            new(paicpu(p)^.oper[i-1].ref);
-            paicpu(p)^.oper[i-1].ref^:=oper[i-1].ref^;
-          end;
-        getcopy:=p;
-      end;
-
-    Constructor taiframe.init (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
+    Constructor tai_frame.create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
 
     begin
-      Inherited Init;
+      Inherited Create;
       typ:=ait_frame;
       G:=GP;
       R:=RA;
@@ -274,10 +258,10 @@ implementation
       LU:=L;
     end;
 
-    Constructor taient.Init (ProcName : String);
+    Constructor tai_ent.Create (const ProcName : String);
 
     begin
-      Inherited init;
+      Inherited Create;
       typ:=ait_ent;
       Name:=ProcName;
     end;
@@ -285,7 +269,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2002-09-29 22:34:17  florian
+  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
     * cpuasm renamed to aasmcpu
 
   Revision 1.2  2002/09/07 15:25:10  peter

compiler/alpha/agas.pas → compiler/alpha/agaxpgas.pas

@@ -20,20 +20,34 @@
 
  ****************************************************************************
 }
-unit agas;
+unit agaxpgas;
+
+  {$i fpcdefs.inc}
 
   interface
 
     uses
-       globals,systems,cobjects,aasm,strings,files
-       agatt,cpubase;
+       globals,systems,aasmbase,aasmtai,
+       aggas,cpubase;
 
     type
-      palphaattasmlist=^talphaattasmlist;
-      talphaattasmlist=object(tattasmlist)
-        procedure WriteInstruction(P : PAI);virtual;
+      TAXPGNUAssembler=class(TGNUAssembler)
+        procedure WriteInstruction(hp : tai);override;
       end;
 
+    const
+       gas_reg2str : array[tregister] of string[4] = (
+         '',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '','',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '',''
+       );
+
   implementation
 
     const
@@ -70,9 +84,10 @@ unit agas;
           'sts','stl','stl_c','stq','stq_c','stq_u',
           'stt','stw','subf','subg','subl',
           'subq','subs','subt','trapb','umulh','unpkbl',
-          'unpkbw','wh64','wmb','xor','zap','zapnot');
+          'unpkbw','wh64','wmb','xor','zap','zapnot',
+          'ldgp');
 
-      procedure tAlphaattasmlist.WriteInstruction (P : PAi);
+      procedure TAXPGNUAssembler.WriteInstruction (hp : tai);
         begin
 (*
                op:=paicpu(hp)^.opcode;
@@ -113,7 +128,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2002-09-07 15:25:10  peter
+  Revision 1.1  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
     * old logs removed and tabs fixed
 
   Revision 1.1  2002/08/18 09:06:54  florian

compiler/alpha/cgcpu.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1998-2000 by Florian Klaempfl
 
-    This unit implements the code generator for the DEC Alpha
+    This unit implements the code generator for the Alpha
 
     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
@@ -20,37 +20,36 @@
 
  ****************************************************************************
 }
+{
+  This unit implements the code generator for the Alpha.
+}
 unit cgcpu;
 
+{$i fpcdefs.inc}
+
 interface
 
 uses
-   cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
+   cgbase,cgobj,aasmbase,aasmtai,aasmcpu,cginfo,cpubase,cpuinfo;
 
 type
 pcgalpha = ^tcgalpha;
-tcgalpha = object(tcg)
-  procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
-  procedure a_call_name(list : paasmoutput;const s : string;
-    offset : longint);virtual;
-  procedure a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);virtual;
-  procedure a_load_reg_ref(list : paasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual;
-  procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual;
-  procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
-  procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
-    reg : tregister;  l : pasmlabel);virtual;
-  procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
-  procedure a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel);
-  procedure a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
-    reg : tregister; l : pasmlabel);
-  procedure a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);virtual;
-  procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
-  procedure g_maybe_loadself(list : paasmoutput);virtual;
-  procedure g_restore_frame_pointer(list : paasmoutput);virtual;
-  procedure g_push_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
-  procedure g_push_exception_value_const(list : paasmoutput;reg : tregister);virtual;
-  procedure g_pop_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
-  constructor init;
+tcgalpha = class(tcg)
+  procedure a_call_name(list : taasmoutput;const s : string);override;
+  procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override;
+  procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);override;
+  procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);override;
+  procedure a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
+  procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
+    reg : tregister;  l : tasmlabel);override;
+  procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
+  procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
+  procedure a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
+    reg : tregister; l : tasmlabel);
+  procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
+  procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
+  procedure g_maybe_loadself(list : taasmoutput);override;
+  procedure g_restore_frame_pointer(list : taasmoutput);override;
 end;
 
 implementation
@@ -58,140 +57,102 @@ implementation
 uses
    globtype,globals;
 
-constructor tcgalpha.init;
-
-  begin
-     inherited init;
-  end;
-
-procedure tcgalpha.g_stackframe_entry(list : paasmoutput;localsize : longint);
+procedure tcgalpha.g_stackframe_entry(list : taasmoutput;localsize : longint);
 
 begin
-  With List^ do
-    begin
-    concat(new(paicpu,op_reg_ref(A_LDGP,Global_pointer,new_reference(R_27,0))));
-    concat(new(paicpu,op_reg_ref(A_LDA,Stack_Pointer,new_reference(Stack_pointer,-LocalSize))));
-    If LocalSize<>0 then
-      concat(new(paiframe,Init(Global_pointer,LocalSize,R_27,0)));
-    { Always generate a frame pointer. }
-    concat(new(paicpu,op_reg_reg_reg(A_BIS,Stack_pointer,Stack_pointer,Frame_pointer)))
-    end;
+   list.concat(taicpu.op_reg_ref(A_LDGP,Global_pointer,new_reference(R_27,0)));
+   list.concat(taicpu.op_reg_ref(A_LDA,stack_pointer_reg,new_reference(stack_pointer_reg,-LocalSize)));
+   If LocalSize<>0 then
+     list.concat(tai_frame.create(Global_pointer,LocalSize,R_27,0));
+   { Always generate a frame pointer. }
+   list.concat(taicpu.op_reg_reg_reg(A_BIS,stack_pointer_reg,stack_pointer_reg,frame_pointer_reg));
 end;
 
-procedure g_exitcode(list : paasmoutput;parasize : longint; nostackframe,inlined : boolean);
+procedure g_exitcode(list : taasmoutput;parasize : longint; nostackframe,inlined : boolean);
 
 begin
-  With List^ do
-    begin
-    { Restore stack pointer from frame pointer }
-    Concat (new(paicpu,op_reg_reg_reg(A_BIS,Frame_Pointer,Frame_Pointer,Stack_Pointer)));
-    { Restore previous stack position}
-    Concat (new(paicpu,op_reg_const_reg(A_ADDQ,Stack_Pointer,Parasize,Stack_pointer)));
-    { return... }
-    Concat (new(paicpu,op_reg_ref_const(A_RET,Stack_pointer,new_reference(Return_pointer,0),1)));
+   { Restore stack pointer from frame pointer }
+   list.Concat (taicpu.op_reg_reg_reg(A_BIS,frame_pointer_reg,frame_pointer_reg,stack_pointer_reg));
+   { Restore previous stack position}
+   list.Concat (taicpu.op_reg_const_reg(A_ADDQ,stack_pointer_reg,Parasize,stack_pointer_reg));
+   { return... }
+   list.Concat(taicpu.op_reg_ref_const(A_RET,stack_pointer_reg,new_reference(Return_pointer,0),1));
     { end directive
-    Concat (new(paiend,init(''));
+    Concat (paiend,init(''));
     }
-    end;
 end;
 
-procedure tcgalpha.a_call_name(list : paasmoutput;const s : string;  offset : longint);
+procedure tcgalpha.a_call_name(list : taasmoutput;const s : string);
 
   begin
-     { list^.concat(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(s)))); }
+     { list^.concat(taicpu,op_sym(A_CALL,S_NO,newasmsymbol(s)))); }
      {!!!!!!!!!1 offset is ignored }
      abstract;
   end;
 
-procedure tcgalpha.a_push_reg(list : paasmoutput;r : tregister);
-
-  begin
-     { list^.concat(new(paicpu,op_reg(A_PUSH,regsize(r),r))); }
-     abstract;
-  end;
-
-
-procedure tcgalpha.a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);
+procedure tcgalpha.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
 
 begin
 end;
 
 
-procedure tcgalpha.a_load_reg_ref(list : paasmoutput;size : tcgsize;register : tregister;const ref : treference);
+procedure tcgalpha.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
 
 begin
 end;
 
 
-procedure tcgalpha.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);
+procedure tcgalpha.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
 
 begin
 end;
 
 
-procedure tcgalpha.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);
+procedure tcgalpha.a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);
 
 begin
 end;
 
 
-procedure tcgalpha.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
-  l : pasmlabel);
+procedure tcgalpha.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+  l : tasmlabel);
 
 begin
 end;
 
 
-procedure tcgalpha.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
+procedure tcgalpha.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
 
 begin
 end;
 
 
-procedure tcgalpha.a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel);
+procedure tcgalpha.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
 
 begin
 end;
 
 
-procedure tcgalpha.a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
-  reg : tregister; l : pasmlabel);
+procedure tcgalpha.a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
+  reg : tregister; l : tasmlabel);
 
 begin
 end;
 
 
-procedure tcgalpha.a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);
+procedure tcgalpha.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
 
 begin
 end;
 
 
-procedure tcgalpha.g_maybe_loadself(list : paasmoutput);
+procedure tcgalpha.g_maybe_loadself(list : taasmoutput);
 
 begin
 end;
 
 
-procedure tcgalpha.g_restore_frame_pointer(list : paasmoutput);
-
-begin
-end;
-
-
-procedure tcgalpha.g_push_exception_value_reg(list : paasmoutput;reg : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.g_push_exception_value_const(list : paasmoutput;reg : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.g_pop_exception_value_reg(list : paasmoutput;reg : tregister);
+procedure tcgalpha.g_restore_frame_pointer(list : taasmoutput);
 
 begin
 end;
@@ -200,7 +161,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2002-09-07 15:25:10  peter
+  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
     * old logs removed and tabs fixed
 
   Revision 1.1  2002/08/18 09:06:54  florian

compiler/alpha/cpubase.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (C) 1998-2000 by Florian Klaempfl
 
-    this unit implements an asmlistitem class for the DEC Alpha
+    This unit implements an asmlistitem class for the Alpha architecture.
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -20,196 +20,325 @@
 
  ****************************************************************************
 }
+{
+  This unit implements an asmlistitem class for the Alpha architecture.
+}
 unit cpubase;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses
-       strings,systems,cobjects,globals,aasm,cpuinfo;
-
-type
-  tasmop = (A_ADDF,A_ADDG,A_ADDL,A_ADDQ,
-            A_ADDS,A_ADDT,A_AMASK,A_AND,A_BEQ,A_BGE,
-            A_BGT,A_BIC,A_BIS,A_BLBC,A_BLBS,A_BLE,
-            A_BLT,A_BNE,A_BR,A_BSR,A_CALL_PAL,A_CMOVEQ,
-            A_CMOVGE,A_CMOVGT,A_CMOVLBC,A_CMOVLBS,A_CMOVLE,A_CMOVLT,
-            A_CMOVNE,A_CMPBGE,A_CMPEQ,A_CMPGEQ,A_CMPGLE,A_CMPGLT,
-            A_CMPLE,A_CMPLT,A_CMPTEQ,A_CMPTLE,A_CMPTLT,A_CMPTUN,
-            A_CMPULE,A_CMPULT,A_CPYS,A_CPYSE,A_CPYSN,A_CTLZ,
-            A_CTPOP,A_CTTZ,A_CVTDG,A_CVTGD,A_CVTGF,A_CVTGQ,
-            A_CVTLQ,A_CVTQF,A_CVTQG,A_CVTQL,A_CVTQS,A_CVTQT,
-            A_CVTST,A_CVTTQ,A_CVTTS,A_DIVF,A_DIVG,A_DIVS,
-            A_DIVT,A_ECB,A_EQV,A_EXCB,A_EXTBL,A_EXTLH,
-            A_EXTLL,A_EXTQH,A_EXTQL,A_EXTWH,A_EXTWL,A_FBEQ,
-            A_FBGE,A_FBGT,A_FBLE,A_FBLT,A_FBNE,A_FCMOVEQ,
-            A_FCMOVGE,A_FCMOVGT,A_FCMOVLE,A_FCMOVLT,A_FCMOVNE,A_FETCH,
-            A_FETCH_M,A_FTOIS,A_FTOIT,A_IMPLVER,A_INSBL,A_INSLH,
-            A_INSLL,A_INSQH,A_INSQL,A_INSWH,A_INSWL,A_ITOFF,
-            A_ITOFS,A_ITOFT,A_JMP,A_JSR,A_JSR_COROUTINE,A_LDA,
-            A_LDAH,A_LDBU,A_LDWU,A_LDF,A_LDG,A_LDL,
-            A_LDL_L,A_LDQ,A_LDQ_L,A_LDQ_U,A_LDS,A_LDT,
-            A_MAXSB8,A_MAXSW4,A_MAXUB8,A_MAXUW4,A_MB,A_MF_FPCR,
-            A_MINSB8,A_MINSW4,A_MINUB8,A_MINUW4,A_MSKBL,A_MSKLH,
-            A_MSKLL,A_MSKQH,A_MSKQL,A_MSKWH,A_MSKWL,A_MT_FPCR,
-            A_MULF,A_MULG,A_MULL,A_MULQ,
-            A_MULS,A_MULT,A_ORNOT,A_PERR,A_PKLB,A_PKWB,
-            A_RC,A_RET,A_RPCC,A_RS,A_S4ADDL,A_S4ADDQ,
-            A_S4SUBL,A_S4SUBQ,A_S8ADDL,A_S8ADDQ,A_S8SUBL,A_S8SUBQ,
-            A_SEXTB,A_SEXTW,A_SLL,A_SQRTF,A_SQRTG,A_SQRTS,
-            A_SQRTT,A_SRA,A_SRL,A_STB,A_STF,A_STG,
-            A_STS,A_STL,A_STL_C,A_STQ,A_STQ_C,A_STQ_U,
-            A_STT,A_STW,A_SUBF,A_SUBG,A_SUBL,
-            A_SUBQ,A_SUBS,A_SUBT,A_TRAPB,A_UMULH,
-            A_UNPKBL,A_UNPKBW,A_WH64,A_WMB,A_XOR,A_ZAP,
-            A_ZAPNOT
-            { Psuedo code understood by the gnu assembler }
-            ,A_LDGP);
-
-Const
-  firstop = low(tasmop);
-  lastop  = high(tasmop);
-
-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
-   );
-
-
-Type
-
- { ALL registers }
- TRegister = (R_NO,  { R_NO is Mandatory, signifies no register }
-              R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,
-              R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19,
-              R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,
-              R_30,R_31,
-              R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,
-              R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,
-              R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,
-              R_F30,R_F31);
-
-  TRegisterset = Set of TRegister;
-
-{ Constants describing the registers }
-
-Const
-  Firstreg = R_0;
-  LastReg = R_F31;
-
-  stack_pointer = R_30;
-  frame_pointer = R_15;
-  self_pointer  = R_16;
-  accumulator   = R_0;
-  global_pointer = R_29;
-  return_pointer = R_26;
-  { it is used to pass the offset to the destructor helper routine }
-  vmt_offset_reg = R_1;
-
-  max_scratch_regs = 2;
-  scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
-
-{ low and high of the available maximum width integer general purpose }
-{ registers                                                           }
-  LoGPReg = R_0;
-  HiGPReg = R_31;
-
-{ low and high of every possible width general purpose register (same as }
-{ above on most architctures apart from the 80x86)                       }
-  LoReg = R_0;
-  HiReg = R_31;
-
-  cpuflags = [cf_64bitaddr];
+       cutils,cclasses,globals,aasmbase,cpuinfo,cginfo;
+
+    type
+       { all registers }
+       TRegister = (R_NO,  { R_NO is Mandatory, signifies no register }
+                    R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,
+                    R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19,
+                    R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,
+                    R_30,R_31,
+                    R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,
+                    R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,
+                    R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,
+                    R_F30,R_F31);
+
+       tasmop = (A_ADDF,A_ADDG,A_ADDL,A_ADDQ,
+                 A_ADDS,A_ADDT,A_AMASK,A_AND,A_BEQ,A_BGE,
+                 A_BGT,A_BIC,A_BIS,A_BLBC,A_BLBS,A_BLE,
+                 A_BLT,A_BNE,A_BR,A_BSR,A_CALL_PAL,A_CMOVEQ,
+                 A_CMOVGE,A_CMOVGT,A_CMOVLBC,A_CMOVLBS,A_CMOVLE,A_CMOVLT,
+                 A_CMOVNE,A_CMPBGE,A_CMPEQ,A_CMPGEQ,A_CMPGLE,A_CMPGLT,
+                 A_CMPLE,A_CMPLT,A_CMPTEQ,A_CMPTLE,A_CMPTLT,A_CMPTUN,
+                 A_CMPULE,A_CMPULT,A_CPYS,A_CPYSE,A_CPYSN,A_CTLZ,
+                 A_CTPOP,A_CTTZ,A_CVTDG,A_CVTGD,A_CVTGF,A_CVTGQ,
+                 A_CVTLQ,A_CVTQF,A_CVTQG,A_CVTQL,A_CVTQS,A_CVTQT,
+                 A_CVTST,A_CVTTQ,A_CVTTS,A_DIVF,A_DIVG,A_DIVS,
+                 A_DIVT,A_ECB,A_EQV,A_EXCB,A_EXTBL,A_EXTLH,
+                 A_EXTLL,A_EXTQH,A_EXTQL,A_EXTWH,A_EXTWL,A_FBEQ,
+                 A_FBGE,A_FBGT,A_FBLE,A_FBLT,A_FBNE,A_FCMOVEQ,
+                 A_FCMOVGE,A_FCMOVGT,A_FCMOVLE,A_FCMOVLT,A_FCMOVNE,A_FETCH,
+                 A_FETCH_M,A_FTOIS,A_FTOIT,A_IMPLVER,A_INSBL,A_INSLH,
+                 A_INSLL,A_INSQH,A_INSQL,A_INSWH,A_INSWL,A_ITOFF,
+                 A_ITOFS,A_ITOFT,A_JMP,A_JSR,A_JSR_COROUTINE,A_LDA,
+                 A_LDAH,A_LDBU,A_LDWU,A_LDF,A_LDG,A_LDL,
+                 A_LDL_L,A_LDQ,A_LDQ_L,A_LDQ_U,A_LDS,A_LDT,
+                 A_MAXSB8,A_MAXSW4,A_MAXUB8,A_MAXUW4,A_MB,A_MF_FPCR,
+                 A_MINSB8,A_MINSW4,A_MINUB8,A_MINUW4,A_MSKBL,A_MSKLH,
+                 A_MSKLL,A_MSKQH,A_MSKQL,A_MSKWH,A_MSKWL,A_MT_FPCR,
+                 A_MULF,A_MULG,A_MULL,A_MULQ,
+                 A_MULS,A_MULT,A_ORNOT,A_PERR,A_PKLB,A_PKWB,
+                 A_RC,A_RET,A_RPCC,A_RS,A_S4ADDL,A_S4ADDQ,
+                 A_S4SUBL,A_S4SUBQ,A_S8ADDL,A_S8ADDQ,A_S8SUBL,A_S8SUBQ,
+                 A_SEXTB,A_SEXTW,A_SLL,A_SQRTF,A_SQRTG,A_SQRTS,
+                 A_SQRTT,A_SRA,A_SRL,A_STB,A_STF,A_STG,
+                 A_STS,A_STL,A_STL_C,A_STQ,A_STQ_C,A_STQ_U,
+                 A_STT,A_STW,A_SUBF,A_SUBG,A_SUBL,
+                 A_SUBQ,A_SUBS,A_SUBT,A_TRAPB,A_UMULH,
+                 A_UNPKBL,A_UNPKBW,A_WH64,A_WMB,A_XOR,A_ZAP,
+                 A_ZAPNOT
+                 { Psuedo code understood by the gnu assembler }
+                 ,A_LDGP);
+
+    const
+       firstop = low(tasmop);
+       lastop  = high(tasmop);
+
+       std_reg2str : array[tregister] of string[4] = (
+         '',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '','',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '','','','','','','','','','',
+         '',''
+       );
+
+
+    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
+        );
+
+        TRegisterset = Set of TRegister;
+
+        tregister64 = tregister;
+
+    Const
+       Firstreg = R_0;
+       LastReg = R_F31;
 
-  { sizes }
-  pointersize   = 8;
-  extended_size = 16;
 
-  general_registers = [R_0..R_31];
-
-  intregs = [R_0..R_31];
-  fpuregs = [R_F0..R_F31];
-  mmregs = [];
-
-  availabletempregsint = [R_0..R_14,R_16..R_25,R_28];
-  availabletempregsfpu = [R_F0..R_F30];
-  availabletempregsmm  = [];
-
-  c_countusableregsint = 26;
-  c_countusableregsfpu = 31;
-  c_countusableregsmm  = 0;
-
-  max_operands = 4;
-
-  registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
-  maxvarregs = 6;
+{*****************************************************************************
+                          Default generic sizes
+*****************************************************************************}
 
-  varregs : Array [1..maxvarregs] of Tregister =
-            (R_9,R_10,R_11,R_12,R_13,R_14);
+       { Defines the default address size for a processor, }
+       OS_ADDR = OS_64;
+       { the natural int size for a processor,             }
+       OS_INT = OS_64;
+       { the maximum float size for a processor,           }
+       OS_FLOAT = OS_F80;
+       { the size of a vector register for a processor     }
+       OS_VECTOR = OS_M64;
+
+       stack_pointer_reg = R_30;
+       frame_pointer_reg = R_15;
+       self_pointer_reg = R_16;
+       accumulator   = R_0;
+       fpu_result_reg = R_F0;
+       global_pointer = R_29;
+       return_pointer = R_26;
+       { it is used to pass the offset to the destructor helper routine }
+       vmt_offset_reg = R_1;
+
+     { low and high of the available maximum width integer general purpose }
+     { registers                                                           }
+       LoGPReg = R_0;
+       HiGPReg = R_31;
+
+       { low and high of every possible width general purpose register (same as
+         above on most architctures apart from the 80x86)                       }
+       LoReg = R_0;
+       HiReg = R_31;
+
+       { Constant defining possibly all registers which might require saving }
+       ALL_REGISTERS = [firstreg..lastreg];
+
+       general_registers = [R_0..R_31];
+
+       availabletempregsint = [R_0..R_14,R_16..R_25,R_28];
+       availabletempregsfpu = [R_F0..R_F30];
+       availabletempregsmm  = [];
+
+       intregs = [R_0..R_31];
+       usableregsint = [];
+       c_countusableregsint = 26;
+
+       maxfpuregs = 32;
+       fpuregs = [R_F0..R_F31];
+       usableregsfpu = [];
+       c_countusableregsfpu = 31;
+
+       mmregs = [];
+       usableregsmm = [];
+       c_countusableregsmm  = 0;
+
+       max_operands = 4;
+
+       registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
+
+       firstsaveintreg = R_NO;
+       lastsaveintreg  = R_NO;
+       firstsavefpureg = R_NO;
+       lastsavefpureg  = R_NO;
+       firstsavemmreg  = R_NO;
+       lastsavemmreg   = R_NO;
+       maxvarregs = 6;
+
+       varregs : Array [1..maxvarregs] of Tregister =
+                 (R_9,R_10,R_11,R_12,R_13,R_14);
+
+       maxfpuvarregs = 8;
+
+       { Registers which are defined as scratch and no need to save across
+         routine calls or in assembler blocks.
+       }
+       max_scratch_regs = 2;
+       scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
+
+    type
 
-Type
- TReference = record
-   offset : aword;
-   symbol : pasmsymbol;
-   base : tregister;
-   is_immediate : boolean;
-   offsetfixup : word; {needed for inline}
-   { the boundary to which the reference is surely aligned }
-   alignment : byte;
-   end;
- PReference = ^TReference;
-
- tloc = (LOC_INVALID,
-         LOC_REGISTER,
-         LOC_MEM,
-         LOC_REFERENCE,
-         LOC_JUMP,
-         { the alpha doesn't have flags, but this }
-         { avoid some conditional compiling       }
-         { DON'T USE for the alpha                }
-         LOC_FLAGS,
-         LOC_CREGISTER,
-         LOC_CONST);
-
- tlocation = record
-   case loc : tloc of
-     LOC_REFERENCE,LOC_MEM : (reference : treference);
-     LOC_REGISTER : (register : tregister);
-   end;
+{*****************************************************************************
+                                   Flags
+*****************************************************************************}
+       { The Alpha doesn't have flags but some generic code depends on this type. }
+       TResFlags = (F_NO);
+
+
+       { reference record }
+       pparareference = ^tparareference;
+       tparareference = packed record
+          index       : tregister;
+          offset      : longint;
+       end;
+
+       trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
+
+       TReference = record
+         offset : aword;
+         symbol : tasmsymbol;
+         base : tregister;
+         { The index isn't used by the alpha port, but some generic code depends on it }
+         index : tregister;
+         is_immediate : boolean;
+         offsetfixup : word; {needed for inline}
+         options     : trefoptions;
+         { the boundary to which the reference is surely aligned }
+         alignment : byte;
+       end;
+       PReference = ^TReference;
+
+       TLoc=(
+              LOC_INVALID,      { added for tracking problems}
+              LOC_CONSTANT,     { constant value }
+              LOC_JUMP,         { boolean results only, jump to false or true label }
+              LOC_FLAGS,        { boolean results only, flags are set }
+              LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
+              LOC_REFERENCE,    { in memory value }
+              LOC_REGISTER,     { in a processor register }
+              LOC_CREGISTER,    { Constant register which shouldn't be modified }
+              LOC_FPUREGISTER,  { FPU stack }
+              LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
+              LOC_SSEREGISTER,
+              LOC_CSSEREGISTER,
+              LOC_CMMREGISTER,
+              LOC_MMREGISTER
+            );
+
+      { 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);
+              );
+      end;
+
+      tlocation = packed record
+         loc  : TLoc;
+         size : TCGSize;
+         case TLoc of
+            LOC_CONSTANT : (
+              case longint of
+                1 : (value : AWord);
+                { can't do this, this layout depends on the host cpu. Use }
+                { lo(valueqword)/hi(valueqword) instead (JM)              }
+                { 2 : (valuelow, valuehigh:AWord);                        }
+                { overlay a complete 64 Bit value }
+                3 : (valueqword : qword);
+              );
+            LOC_CREFERENCE,
+            LOC_REFERENCE : (reference : treference);
+            { segment in reference at the same place as in loc_register }
+            LOC_REGISTER,LOC_CREGISTER : (
+              case longint of
+                1 : (register,registerhigh,segment : tregister);
+                { overlay a registerlow }
+                2 : (registerlow : tregister);
+                { overlay a 64 Bit register type }
+                3 : (reg64 : tregister64);
+                4 : (register64 : tregister64);
+              );
+      end;
 
 {*****************************************************************************
                                 Operands
 *****************************************************************************}
 
 
-{ Types of operand }
- toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
-
- toper=record
-   ot  : longint;
-   case typ : toptype of
-    top_none   : ();
-    top_reg    : (reg:tregister);
-    top_ref    : (ref:preference);
-    top_const  : (val:longint);
-    top_symbol : (sym:pasmsymbol;symofs:longint);
- end;
-
-Const
-  { offsets for the integer and floating point registers }
-  INT_REG = 0;
-  FLOAT_REG = 32;
-
-  { operator qualifiers }
-  OQ_CHOPPED_ROUNDING            = $01;  { /C }
-  OQ_ROUNDING_MODE_DYNAMIC       = $02;  { /D }
-  OQ_ROUND_TOWARD_MINUS_INFINITY = $04;  { /M }
-  OQ_INEXACT_RESULT_ENABLE        = $08; { /I }
-  OQ_SOFTWARE_COMPLETION_ENABLE  = $10;  { /S }
-  OQ_FLOATING_UNDERFLOW_ENABLE   = $20;  { /U }
-  OQ_INTEGER_OVERFLOW_ENABLE     = $40;  { /V }
+        { Types of operand }
+        toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
+
+        toper=record
+          ot  : longint;
+          case typ : toptype of
+           top_none   : ();
+           top_reg    : (reg:tregister);
+           top_ref    : (ref:preference);
+           top_const  : (val:longint);
+           top_symbol : (sym:tasmsymbol;symofs:longint);
+        end;
+
+   const
+      { Registers which must be saved when calling a routine declared as
+        cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
+        saved should be the ones as defined in the target ABI and / or GCC.
+
+        This value can be deduced from the CALLED_USED_REGISTERS array in the
+        GCC source.
+      }
+      std_saved_registers = [];
+      { 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 = 8;
+
+      { offsets for the integer and floating point registers }
+      INT_REG = 0;
+      FLOAT_REG = 32;
+
+      { operator qualifiers }
+      OQ_CHOPPED_ROUNDING            = $01;  { /C }
+      OQ_ROUNDING_MODE_DYNAMIC       = $02;  { /D }
+      OQ_ROUND_TOWARD_MINUS_INFINITY = $04;  { /M }
+      OQ_INEXACT_RESULT_ENABLE        = $08; { /I }
+      OQ_SOFTWARE_COMPLETION_ENABLE  = $10;  { /S }
+      OQ_FLOATING_UNDERFLOW_ENABLE   = $20;  { /U }
+      OQ_INTEGER_OVERFLOW_ENABLE     = $40;  { /V }
 
 
 {*****************************************************************************
@@ -303,7 +432,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2002-09-07 15:25:10  peter
+  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
     * old logs removed and tabs fixed
 
   Revision 1.1  2002/08/18 09:06:54  florian

compiler/alpha/cpuinfo.pas

@@ -3,7 +3,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 1998-2000 by the Free Pascal development team
 
-    Basic Processor information
+    Basic Processor information about the Alpha
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,22 +13,61 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
+{
+  Basic Processor information about the Alpha
+}
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
 Type
-   { Architecture word - Native unsigned type }
+   { Natural integer register type and size for the target machine }
 {$ifdef FPC}
    AWord = Qword;
 {$else FPC}
    AWord = Longint;
 {$endif FPC}
+   PAWord = ^AWord;
+
+   { 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 = qword;
+
+   bestreal = extended;
+   ts32real = single;
+   ts64real = double;
+   ts80real = extended;
+   ts64comp = extended;
+
+   pbestreal=^bestreal;
+
+   { possible supported processors for this target }
+   tprocessors =
+      (no_processor,
+       ClassEV7,
+       ClassEV8
+      );
 
 Const
    { Size of native extended type }
    extended_size = 16;
+   {# Size of a pointer                           }
+   pointer_size  = 8;
+   {# Size of a multimedia register               }
+   mmreg_size = 8;
+
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'alpha';
+   { 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
 

compiler/alpha/cpuswtch.pas

@@ -0,0 +1,127 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
+
+    This units interprets the commandline options which are Alpha specific.
+
+    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 units interprets the commandline options which are Alpha specific.
+}
+unit cpuswtch;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  options;
+
+type
+  toptionalpha = class(toption)
+    procedure interpret_proc_specific_options(const opt:string);override;
+  end;
+
+implementation
+
+uses
+  cutils,globtype,systems,globals;
+
+procedure toptionalpha.interpret_proc_specific_options(const opt:string);
+var
+  more: string;
+  j: longint;
+begin
+  More:=Upper(copy(opt,3,length(opt)-2));
+  case opt[2] of
+   'O' : Begin
+           j := 3;
+           While (j <= Length(Opt)) Do
+             Begin
+               case opt[j] of
+                 '-' :
+                   begin
+                     initglobalswitches:=initglobalswitches-[cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_littlesize,
+                       cs_regalloc,cs_uncertainopts];
+                     FillChar(ParaAlignment,sizeof(ParaAlignment),0);
+                   end;
+                 'a' :
+                   begin
+                     UpdateAlignmentStr(Copy(Opt,j+1,255),ParaAlignment);
+                     j:=length(Opt);
+                   end;
+                 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize];
+                 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize];
+                 'r' :
+                   begin
+                     initglobalswitches:=initglobalswitches+[cs_regalloc];
+                     Simplify_ppu:=false;
+                   end;
+                 'u' : initglobalswitches:=initglobalswitches+[cs_uncertainopts];
+                 '1' : initglobalswitches:=initglobalswitches-[cs_fastoptimize,cs_slowoptimize]+[cs_optimize];
+                 '2' : initglobalswitches:=initglobalswitches-[cs_slowoptimize]+[cs_optimize,cs_fastoptimize];
+                 '3' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_fastoptimize,cs_slowoptimize];
+{$ifdef dummy}
+                 'p' :
+                   Begin
+                     If j < Length(Opt) Then
+                       Begin
+                         Case opt[j+1] Of
+                           '1': initoptprocessor := Class386;
+                           '2': initoptprocessor := ClassP5;
+                           '3': initoptprocessor := ClassP6
+                           Else IllegalPara(Opt)
+                         End;
+                         Inc(j);
+                       End
+                     Else IllegalPara(opt)
+                   End;
+{$endif dummy}
+                 else IllegalPara(opt);
+               End;
+               Inc(j)
+             end;
+         end;
+{$ifdef dummy}
+   'R' : begin
+           if More='GAS' then
+            initasmmode:=asmmode_ppc_gas
+           else
+            if More='MOTOROLA' then
+             initasmmode:=asmmode_ppc_motorola
+           else
+            if More='DIRECT' then
+             initasmmode:=asmmode_direct
+           else
+            IllegalPara(opt);
+         end;
+{$endif dummy}
+  else
+   IllegalPara(opt);
+  end;
+end;
+
+
+initialization
+  coption:=toptionalpha;
+end.
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:42:45  florian
+    * several fixes to get forward with alpha compilation
+}

compiler/alpha/radirect.pas

@@ -0,0 +1,344 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Reads inline Alpha assembler and writes the lines direct to the output
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+  This unit reads Alpha inline assembler and writes the lines direct to the output file.
+}
+unit radirect;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node;
+
+     function assemble : tnode;
+
+  implementation
+
+    uses
+       { common }
+       cutils,
+       { global }
+       globals,verbose,
+       systems,
+       { aasm }
+       aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,defbase,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       { codegen }
+       cgbase,
+       { constants }
+       agaxpgas,
+       cpubase
+       ;
+
+    function assemble : tnode;
+
+      var
+         retstr,s,hs : string;
+         c : char;
+         ende : boolean;
+         srsym,sym : tsym;
+         srsymtable : tsymtable;
+         code : TAAsmoutput;
+         i,l : longint;
+
+       procedure writeasmline;
+         var
+           i : longint;
+         begin
+           i:=length(s);
+           while (i>0) and (s[i] in [' ',#9]) do
+            dec(i);
+           s[0]:=chr(i);
+           if s<>'' then
+            code.concat(Tai_direct.Create(strpnew(s)));
+            { consider it set function set if the offset was loaded }
+           if assigned(aktprocdef.funcretsym) and
+              (pos(retstr,upper(s))>0) then
+             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+           s:='';
+         end;
+
+     begin
+       ende:=false;
+       s:='';
+       if assigned(aktprocdef.funcretsym) and
+          is_fpu(aktprocdef.rettype.def) then
+         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+       { !!!!!
+       if (not is_void(aktprocdef.rettype.def)) then
+         retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
+       else
+       }
+         retstr:='';
+
+       c:=current_scanner.asmgetchar;
+       code:=TAAsmoutput.Create;
+       while not(ende) do
+         begin
+            { wrong placement
+            current_scanner.gettokenpos; }
+            case c of
+              'A'..'Z','a'..'z','_':
+                begin
+                   current_scanner.gettokenpos;
+                   i:=0;
+                   hs:='';
+                   while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
+                      or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
+                      or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
+                      or (c='_') do
+                     begin
+                        inc(i);
+                        hs[i]:=c;
+                        c:=current_scanner.asmgetchar;
+                     end;
+                   hs[0]:=chr(i);
+                   if upper(hs)='END' then
+                      ende:=true
+                   else
+                      begin
+                         if c=':' then
+                           begin
+                             searchsym(upper(hs),srsym,srsymtable);
+                             if srsym<>nil then
+                               if (srsym.typ = labelsym) then
+                                 Begin
+                                    hs:=tlabelsym(srsym).lab.name;
+                                    tlabelsym(srsym).lab.is_set:=true;
+                                 end
+                               else
+                                 Message(asmr_w_using_defined_as_local);
+                           end
+                         else
+                           { access to local variables }
+                           if assigned(aktprocdef) then
+                             begin
+                                { I don't know yet, what the ppc port requires }
+                                { we'll see how things settle down             }
+
+                                { is the last written character an special }
+                                { char ?                                   }
+                                { !!!
+                                if (s[length(s)]='%') and
+                                   ret_in_acc(aktprocdef.rettype.def) and
+                                   ((pos('AX',upper(hs))>0) or
+                                   (pos('AL',upper(hs))>0)) then
+                                  tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                                }
+                                if ((s[length(s)]<>'0') or (hs[1]<>'x')) then
+                                  begin
+                                     if assigned(aktprocdef.localst) and
+                                        (lexlevel >= normal_function_level) then
+                                       sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                     else
+                                       sym:=nil;
+                                     if assigned(sym) then
+                                       begin
+                                          if (sym.typ=labelsym) then
+                                            Begin
+                                               hs:=tlabelsym(sym).lab.name;
+                                            end
+                                          else if sym.typ=varsym then
+                                            begin
+                                               if (vo_is_external in tvarsym(sym).varoptions) then
+                                                 hs:=tvarsym(sym).mangledname
+                                               else
+                                                 begin
+                                                    if (tvarsym(sym).reg<>R_NO) then
+                                                      hs:=gas_reg2str[procinfo.framepointer]
+                                                    else
+                                                      hs:=tostr(tvarsym(sym).address)+
+                                                        '('+gas_reg2str[procinfo.framepointer]+')';
+                                                 end;
+                                            end
+                                          else
+                                          { call to local function }
+                                          if (sym.typ=procsym) and (pos('BL',upper(s))>0) then
+                                            hs:=tprocsym(sym).first_procdef.mangledname;
+                                       end
+                                     else
+                                       begin
+                                          if assigned(aktprocdef.parast) then
+                                            sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                          else
+                                            sym:=nil;
+                                          if assigned(sym) then
+                                            begin
+                                               if sym.typ=varsym then
+                                                 begin
+                                                    l:=tvarsym(sym).address;
+                                                    { set offset }
+                                                    inc(l,aktprocdef.parast.address_fixup);
+                                                    hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer]+')';
+                                                    if pos(',',s) > 0 then
+                                                      tvarsym(sym).varstate:=vs_used;
+                                                 end;
+                                            end
+                                          { I added that but it creates a problem in line.ppi
+                                          because there is a local label wbuffer and
+                                          a static variable WBUFFER ...
+                                          what would you decide, florian ?}
+                                          else
+                                            begin
+                                               searchsym(upper(hs),sym,srsymtable);
+                                               if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
+                                                 begin
+                                                   case sym.typ of
+                                                     varsym :
+                                                       begin
+                                                         Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+                                                         hs:=tvarsym(sym).mangledname;
+                                                         inc(tvarsym(sym).refs);
+                                                       end;
+                                                     typedconstsym :
+                                                       begin
+                                                         Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+                                                         hs:=ttypedconstsym(sym).mangledname;
+                                                       end;
+                                                     procsym :
+                                                       begin
+                                                         { procs can be called or the address can be loaded }
+                                                         if (pos('BL',upper(s))>0) {or (pos('LEA',upper(s))>0))}  then
+                                                          begin
+                                                            if Tprocsym(sym).procdef_count>1 then
+                                                              Message1(asmr_w_direct_global_is_overloaded_func,hs);
+                                                            Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
+                                                            hs:=tprocsym(sym).first_procdef.mangledname;
+                                                          end;
+                                                       end;
+                                                     else
+                                                       Message(asmr_e_wrong_sym_type);
+                                                   end;
+                                                 end
+{$ifdef dummy}
+                                               else if upper(hs)='__SELF' then
+                                                 begin
+                                                    if assigned(procinfo^._class) then
+                                                      hs:=tostr(procinfo^.selfpointer_offset)+
+                                                          '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                    else
+                                                     Message(asmr_e_cannot_use_SELF_outside_a_method);
+                                                 end
+                                               else if upper(hs)='__RESULT' then
+                                                 begin
+                                                    if (not is_void(aktprocdef.rettype.def)) then
+                                                      hs:=retstr
+                                                    else
+                                                      Message(asmr_e_void_function);
+                                                 end
+                                               { implement old stack/frame pointer access for nested procedures }
+                                               {!!!!
+                                               else if upper(hs)='__OLDSP' then
+                                                 begin
+                                                    { complicate to check there }
+                                                    { we do it: }
+                                                    if lexlevel>normal_function_level then
+                                                      hs:=tostr(procinfo^.framepointer_offset)+
+                                                        '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                    else
+                                                      Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+                                                 end;
+                                               }
+                                               end;
+{$endif dummy}
+                                            end;
+                                       end;
+                                  end;
+                             end;
+                         s:=s+hs;
+                      end;
+                end;
+              '{',';',#10,#13:
+                begin
+                   if pos(retstr,s) > 0 then
+                     tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                   writeasmline;
+                   c:=current_scanner.asmgetchar;
+                end;
+              #26:
+                Message(scan_f_end_of_file);
+              else
+                begin
+                  current_scanner.gettokenpos;
+                  inc(byte(s[0]));
+                  s[length(s)]:=c;
+                  c:=current_scanner.asmgetchar;
+                end;
+            end;
+         end;
+       writeasmline;
+       assemble:=casmnode.create(code);
+     end;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_ppc_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_direct;
+            idtxt : 'DIRECT'
+          );
+
+initialization
+  RegisterAsmMode(asmmode_ppc_direct_info);
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:42:45  florian
+    * several fixes to get forward with alpha compilation
+
+  Revision 1.5  2002/09/03 19:04:18  daniel
+    * Fixed PowerPC & M68000 compilation
+
+  Revision 1.4  2002/09/03 16:26:28  daniel
+    * Make Tprocdef.defs protected
+
+  Revision 1.3  2002/08/31 15:59:31  florian
+    + HEAP* stuff must be generated for Linux/PPC as well
+    + direct assembler reader searches now global and static symtables as well
+
+  Revision 1.2  2002/08/18 21:36:42  florian
+    + handling of local variables in direct reader implemented
+
+  Revision 1.1  2002/08/10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.2  2002/07/28 20:45:23  florian
+    + added direct assembler reader for PowerPC
+
+  Revision 1.1  2002/07/11 14:41:34  florian
+    * start of the new generic parameter handling
+}

compiler/alpha/rasm.pas

@@ -0,0 +1,71 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by The Free Pascal Team
+
+    This unit does the parsing process for the inline assembler
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+  This unit does the parsing process for the inline assembler.
+}
+Unit Rasm;
+
+{$i fpcdefs.inc}
+
+Interface
+
+uses
+  node;
+
+   {
+     This routine is called to parse the instructions in assembler
+     blocks. It returns a complete list of directive and instructions
+   }
+   function assemble: tnode;
+
+
+Implementation
+
+    uses
+       { common }
+       cutils,cclasses,
+       { global }
+       globtype,globals,verbose,
+       systems,
+       { aasm }
+       cpubase,aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner
+       // ,rautils
+       ;
+
+    function assemble : tnode;
+     begin
+     end;
+
+Begin
+end.
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:42:45  florian
+    * several fixes to get forward with alpha compilation
+}

compiler/alpha/rgcpu.pas

@@ -0,0 +1,89 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements the powerpc specific class for the register
+    allocator
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit rgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+     uses
+       aasmbase,aasmtai,
+       cpubase,
+       rgobj;
+
+     type
+       trgcpu = class(trgobj)
+         function getexplicitregisterint(list: taasmoutput; reg: tregister): tregister; override;
+         procedure ungetregisterint(list: taasmoutput; reg: tregister); override;
+       end;
+
+  implementation
+
+    uses
+      cgobj;
+
+    function trgcpu.getexplicitregisterint(list: taasmoutput; reg: tregister): tregister;
+
+      begin
+        if reg = R_0 then
+          begin
+            cg.a_reg_alloc(list,reg);
+            result := reg;
+          end
+        else result := inherited getexplicitregisterint(list,reg);
+      end;
+
+
+    procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
+
+      begin
+        if reg = R_0 then
+          cg.a_reg_dealloc(list,reg)
+        else
+          inherited ungetregisterint(list,reg);
+      end;
+
+initialization
+  rg := trgcpu.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-29 23:42:45  florian
+    * several fixes to get forward with alpha compilation
+
+  Revision 1.3  2002/07/07 09:44:32  florian
+    * powerpc target fixed, very simple units can be compiled
+
+  Revision 1.2  2002/05/16 19:46:53  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.1  2002/04/06 18:13:02  jonas
+    * several powerpc-related additions and fixes
+
+}

compiler/alpha/tgcpu.pas

@@ -20,29 +20,33 @@
 
  ****************************************************************************
 }
+{
+  This unit handles the temporary variables stuff for Alpha.
+}
 unit tgcpu;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses
        tgobj;
 
     type
-
-       ttgalpha = Object(ttgobj)
+       ttgalpha = class(ttgobj)
        end;
 
-    var
-       tg : ttgalpha;
-
 implementation
 
 begin
-  tg.init;
+  tg:=ttgalpha.create;
 end.
 {
   $Log$
-  Revision 1.2  2002-09-07 15:25:10  peter
+  Revision 1.3  2002-09-29 23:42:46  florian
+    * several fixes to get forward with alpha compilation
+
+  Revision 1.2  2002/09/07 15:25:10  peter
     * old logs removed and tabs fixed
 
   Revision 1.1  2002/08/18 09:06:54  florian