Browse Source

+ introduced tainstruction

michael 26 years ago
parent
commit
75a3aea72e
5 changed files with 317 additions and 123 deletions
  1. 29 105
      compiler/new/alpha/cpuasm.pas
  2. 27 13
      compiler/new/alpha/cpubase.pas
  3. 7 4
      compiler/new/cgobj.pas
  4. 249 0
      compiler/new/tainst.pas
  5. 5 1
      compiler/new/tgobj.pas

+ 29 - 105
compiler/new/alpha/cpuasm.pas

@@ -27,17 +27,9 @@ interface
 uses
 uses
   cobjects,
   cobjects,
   aasm,globals,verbose,
   aasm,globals,verbose,
-  cpubase;
+  cpubase,tainst;
 
 
 type
 type
-  pairegalloc = ^tairegalloc;
-  tairegalloc = object(tai)
-     allocation : boolean;
-     reg        : tregister;
-     constructor alloc(r : tregister);
-     constructor dealloc(r : tregister);
-  end;
-
   paiframe = ^taiframe;
   paiframe = ^taiframe;
   taiframe = object(tai)
   taiframe = object(tai)
      G,R : TRegister;
      G,R : TRegister;
@@ -53,12 +45,7 @@ type
 
 
 
 
   paialpha = ^taialpha;
   paialpha = ^taialpha;
-  taialpha = object(tai)
-     is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
-     opcode    : tasmop;
-     ops       : longint;
-     condition : TasmCond;
-     oper      : array[0..2] of toper;
+  taialpha = object(tainstruction)
      constructor op_none(op : tasmop);
      constructor op_none(op : tasmop);
 
 
      constructor op_reg(op : tasmop;_op1 : tregister);
      constructor op_reg(op : tasmop;_op1 : tregister);
@@ -92,194 +79,142 @@ type
      constructor op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
      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);
      constructor op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
 
 
-     destructor done;virtual;
      function  getcopy:plinkedlist_item;virtual;
      function  getcopy:plinkedlist_item;virtual;
   private
   private
      segprefix : tregister;
      segprefix : tregister;
-     procedure init(op : tasmop); { this need to be called by all constructor }
   end;
   end;
 
 
 
 
 implementation
 implementation
 
 
-{*****************************************************************************
-                                 TaiRegAlloc
-*****************************************************************************}
-
-    constructor tairegalloc.alloc(r : tregister);
-      begin
-        inherited init;
-        typ:=ait_regalloc;
-        allocation:=true;
-        reg:=r;
-      end;
-
-
-    constructor tairegalloc.dealloc(r : tregister);
-      begin
-        inherited init;
-        typ:=ait_regalloc;
-        allocation:=false;
-        reg:=r;
-      end;
-
 
 
 {*****************************************************************************
 {*****************************************************************************
                                  taialpha Constructors
                                  taialpha Constructors
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure taialpha.init(op : tasmop);
-      begin
-         typ:=ait_instruction;
-         is_jmp:=false;
-         segprefix:=R_NO;
-         opcode:=op;
-         ops:=0;
-         condition:=c_none;
-         fillchar(oper,sizeof(oper),0);
-      end;
 
 
     constructor taialpha.op_none(op : tasmop);
     constructor taialpha.op_none(op : tasmop);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
       end;
       end;
 
 
 
 
     constructor taialpha.op_reg(op : tasmop;_op1 : tregister);
     constructor taialpha.op_reg(op : tasmop;_op1 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=1;
          ops:=1;
       end;
       end;
 
 
 
 
     constructor taialpha.op_const(op : tasmop;_op1 : longint);
     constructor taialpha.op_const(op : tasmop;_op1 : longint);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=1;
          ops:=1;
       end;
       end;
 
 
 
 
     constructor taialpha.op_ref(op : tasmop;_op1 : preference);
     constructor taialpha.op_ref(op : tasmop;_op1 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=1;
          ops:=1;
       end;
       end;
 
 
 
 
     constructor taialpha.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
     constructor taialpha.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
     constructor taialpha.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
     constructor taialpha.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
     constructor taialpha.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_const_const(op : tasmop;_op1,_op2 : longint);
     constructor taialpha.op_const_const(op : tasmop;_op1,_op2 : longint);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
     constructor taialpha.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
     constructor taialpha.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
     constructor taialpha.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_ref_ref(op : tasmop;_op1,_op2 : preference);
     constructor taialpha.op_ref_ref(op : tasmop;_op1,_op2 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
     constructor taialpha.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=3;
          ops:=3;
       end;
       end;
 
 
     constructor taialpha.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
     constructor taialpha.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=3;
          ops:=3;
       end;
       end;
 
 
      constructor taialpha.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference);
      constructor taialpha.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=3;
          ops:=3;
       end;
       end;
 
 
      constructor taialpha.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
      constructor taialpha.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=3;
          ops:=3;
       end;
       end;
 
 
      constructor taialpha.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
      constructor taialpha.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=3;
          ops:=3;
       end;
       end;
 
 
      constructor taialpha.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
      constructor taialpha.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=3;
          ops:=3;
       end;
       end;
 
 
 
 
     constructor taialpha.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
     constructor taialpha.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          condition:=cond;
          condition:=cond;
          ops:=1;
          ops:=1;
       end;
       end;
@@ -287,45 +222,31 @@ implementation
 
 
     constructor taialpha.op_sym(op : tasmop;_op1 : pasmsymbol);
     constructor taialpha.op_sym(op : tasmop;_op1 : pasmsymbol);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=1;
          ops:=1;
       end;
       end;
 
 
 
 
     constructor taialpha.op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
     constructor taialpha.op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=1;
          ops:=1;
       end;
       end;
 
 
 
 
     constructor taialpha.op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
     constructor taialpha.op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
 
 
     constructor taialpha.op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
     constructor taialpha.op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
       begin
       begin
-         inherited init;
-         init(op);
+         inherited init(op);
          ops:=2;
          ops:=2;
       end;
       end;
 
 
-    destructor taialpha.done;
-      var
-        i : longint;
-      begin
-          for i:=1 to ops do
-            if (oper[i-1].typ=top_ref) then
-              dispose(oper[i-1].ref);
-        inherited done;
-      end;
-
     function taialpha.getcopy:plinkedlist_item;
     function taialpha.getcopy:plinkedlist_item;
       var
       var
         i : longint;
         i : longint;
@@ -364,7 +285,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1999-08-06 14:15:54  florian
+  Revision 1.4  1999-08-06 16:04:07  michael
+  + introduced tainstruction
+
+  Revision 1.3  1999/08/06 14:15:54  florian
     * made the alpha version compilable
     * made the alpha version compilable
 
 
   Revision 1.2  1999/08/05 15:50:33  michael
   Revision 1.2  1999/08/05 15:50:33  michael

+ 27 - 13
compiler/new/alpha/cpubase.pas

@@ -165,18 +165,18 @@ Type
 *****************************************************************************}
 *****************************************************************************}
 
 
 
 
-       { 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;
+{ 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
 Const
   { offsets for the integer and floating point registers }
   { offsets for the integer and floating point registers }
@@ -196,6 +196,7 @@ Const
 procedure reset_reference(var ref : treference);
 procedure reset_reference(var ref : treference);
 { set mostly used values of a new reference }
 { set mostly used values of a new reference }
 function new_reference(base : tregister;offset : longint) : preference;
 function new_reference(base : tregister;offset : longint) : preference;
+function newreference(const r : treference) : preference;
 procedure disposereference(var r : preference);
 procedure disposereference(var r : preference);
 
 
 function reg2str(r : tregister) : string;
 function reg2str(r : tregister) : string;
@@ -232,6 +233,16 @@ begin
   new_reference:=r;
   new_reference:=r;
 end;
 end;
 
 
+function newreference(const r : treference) : preference;
+
+var
+   p : preference;
+begin
+   new(p);
+   p^:=r;
+   newreference:=p;
+end;
+
 procedure disposereference(var r : preference);
 procedure disposereference(var r : preference);
 
 
 begin
 begin
@@ -242,7 +253,10 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.11  1999-08-06 15:53:52  florian
+  Revision 1.12  1999-08-06 16:04:08  michael
+  + introduced tainstruction
+
+  Revision 1.11  1999/08/06 15:53:52  florian
     * made the alpha version compilable
     * made the alpha version compilable
 
 
   Revision 1.10  1999/08/06 14:15:55  florian
   Revision 1.10  1999/08/06 14:15:55  florian

+ 7 - 4
compiler/new/cgobj.pas

@@ -26,7 +26,7 @@ unit cgobj;
   interface
   interface
 
 
     uses
     uses
-       cobjects,aasm,symtable,symconst,cpuasm,cpubase,cgbase,cpuinfo;
+       cobjects,aasm,symtable,symconst,cpuasm,cpubase,cgbase,cpuinfo,tainst;
 
 
     type
     type
        qword = comp;
        qword = comp;
@@ -176,7 +176,7 @@ unit cgobj;
     constructor tcg.init;
     constructor tcg.init;
 
 
       var
       var
-         i : aword;
+         i : longint;
 
 
       begin
       begin
          scratch_register_array_pointer:=1;
          scratch_register_array_pointer:=1;
@@ -211,7 +211,7 @@ unit cgobj;
 
 
       var
       var
          r : tregister;
          r : tregister;
-         i : aword;
+         i : longint;
 
 
       begin
       begin
          if unusedscratchregisters=[] then
          if unusedscratchregisters=[] then
@@ -977,7 +977,10 @@ unit cgobj;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.15  1999-08-06 15:53:50  florian
+  Revision 1.16  1999-08-06 16:04:05  michael
+  + introduced tainstruction
+
+  Revision 1.15  1999/08/06 15:53:50  florian
     * made the alpha version compilable
     * made the alpha version compilable
 
 
   Revision 1.14  1999/08/06 14:15:51  florian
   Revision 1.14  1999/08/06 14:15:51  florian

+ 249 - 0
compiler/new/tainst.pas

@@ -0,0 +1,249 @@
+{
+    $Id$
+    Copyright (c) 1999 by Michael Van Canneyt
+
+    Contains a generic assembler instruction object;
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+Unit tainst;
+
+interface
+  
+  Uses aasm,cpubase,cpuinfo,cobjects;
+  
+Type
+
+pairegalloc = ^tairegalloc;
+tairegalloc = object(tai)
+   allocation : boolean;
+   reg        : tregister;
+   constructor alloc(r : tregister);
+   constructor dealloc(r : tregister);
+end;
+
+painstruction = ^tainstruction;
+tainstruction = object(tai)
+  is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
+  opcode    : tasmop;
+  condition : TAsmCond;
+  ops       : longint;
+  oper      : array[0..2] of toper;
+  Constructor init(op : tasmop);
+  Destructor Done;virtual;
+  function getcopy:plinkedlist_item;
+  procedure loadconst(opidx:longint;l:longint);
+  procedure loadsymbol(opidx:longint;s:pasmsymbol;sofs:longint);
+  procedure loadref(opidx:longint;p:preference);
+  procedure loadreg(opidx:longint;r:tregister);
+  procedure loadoper(opidx:longint;o:toper);
+  procedure SetCondition(c:TAsmCond);
+  end;
+     
+implementation
+
+{*****************************************************************************
+                                 TaiRegAlloc
+*****************************************************************************}
+
+constructor tairegalloc.alloc(r : tregister);
+  begin
+    inherited init;
+    typ:=ait_regalloc;
+    allocation:=true;
+    reg:=r;
+  end;
+
+
+constructor tairegalloc.dealloc(r : tregister);
+  begin
+    inherited init;
+    typ:=ait_regalloc;
+    allocation:=false;
+    reg:=r;
+  end;
+
+{ ---------------------------------------------------------------------
+    TaInstruction Constructor/Destructor
+  ---------------------------------------------------------------------}
+
+
+  
+Constructor tainstruction.init(op : tasmop);
+
+begin
+   inherited init;
+   typ:=ait_instruction;
+   is_jmp:=false;
+   opcode:=op;
+   ops:=0;
+   condition:=c_none;
+   fillchar(oper,sizeof(oper),0);
+end;
+
+
+
+Destructor Tainstruction.Done;
+
+Var i : longint;
+
+begin
+  for i:=1 to ops do
+  if (oper[i-1].typ=top_ref) then
+    dispose(oper[i-1].ref);
+  inherited done;
+end;  
+
+
+
+{ ---------------------------------------------------------------------
+    Loading of operands.
+  ---------------------------------------------------------------------}
+
+
+  
+procedure tainstruction.loadconst(opidx:longint;l:longint);
+
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     val:=l;
+     typ:=top_const;
+   end;
+end;
+
+
+
+procedure tainstruction.loadsymbol(opidx:longint;s:pasmsymbol;sofs:longint);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     sym:=s;
+     symofs:=sofs;
+     typ:=top_symbol;
+   end;
+  { Mark the symbol as used }
+  if assigned(s) then
+   inc(s^.refs);
+end;
+
+
+
+procedure tainstruction.loadref(opidx:longint;p:preference);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     if p^.is_immediate then
+       begin
+         val:=p^.offset;
+         disposereference(p);
+         typ:=top_const;
+       end
+     else
+       begin
+         ref:=p;
+{ We allow this exception for i386, since overloading this would be
+  too much of a a speed penalty}         
+{$ifdef i386}
+         if not(ref^.segment in [R_DS,R_NO]) then
+           segprefix:=ref^.segment;
+{$endif}           
+         typ:=top_ref;
+         { mark symbol as used }
+         if assigned(ref^.symbol) then
+           inc(ref^.symbol^.refs);
+       end;
+   end;
+end;
+
+
+
+procedure tainstruction.loadreg(opidx:longint;r:tregister);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     reg:=r;
+     typ:=top_reg;
+   end;
+end;
+
+
+
+procedure tainstruction.loadoper(opidx:longint;o:toper);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  if oper[opidx].typ=top_ref then
+    disposereference(oper[opidx].ref);
+  oper[opidx]:=o;
+  { copy also the reference }
+  if oper[opidx].typ=top_ref then
+   oper[opidx].ref:=newreference(o.ref^);
+end;
+
+
+{ ---------------------------------------------------------------------
+    Miscellaneous methods.
+  ---------------------------------------------------------------------}
+
+procedure tainstruction.SetCondition(c:TAsmCond);
+  begin
+     condition:=c;
+  end;
+
+
+Function tainstruction.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 (painstruction(p)^.oper[i-1].typ=top_ref) then
+    begin
+      new(painstruction(p)^.oper[i-1].ref);
+      painstruction(p)^.oper[i-1].ref^:=oper[i-1].ref^;
+    end;
+  getcopy:=p;
+end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  1999-08-06 16:04:05  michael
+  + introduced tainstruction
+
+}

+ 5 - 1
compiler/new/tgobj.pas

@@ -32,6 +32,7 @@ unit tgobj;
       cpubase,
       cpubase,
       cpuinfo,
       cpuinfo,
       cpuasm,
       cpuasm,
+      tainst,
 {$endif i386}
 {$endif i386}
        cobjects,globals,tree,hcodegen,verbose,files,aasm;
        cobjects,globals,tree,hcodegen,verbose,files,aasm;
 
 
@@ -695,7 +696,10 @@ unit tgobj;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1999-08-03 00:33:23  michael
+  Revision 1.5  1999-08-06 16:04:06  michael
+  + introduced tainstruction
+
+  Revision 1.4  1999/08/03 00:33:23  michael
   + Added cpuasm for alpha
   + Added cpuasm for alpha
 
 
   Revision 1.3  1999/08/03 00:32:13  florian
   Revision 1.3  1999/08/03 00:32:13  florian