Browse Source

* some code added

florian 27 years ago
parent
commit
3f56077131
4 changed files with 152 additions and 71 deletions
  1. 84 0
      compiler/new/cgbase.pas
  2. 59 64
      compiler/new/cgobj.pas
  3. 4 5
      compiler/new/i386.pas
  4. 5 2
      compiler/new/systems.pas

+ 84 - 0
compiler/new/cgbase.pas

@@ -0,0 +1,84 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    This units implements some code generator helper routines
+
+    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 cgbase;
+
+  interface
+
+    uses
+       globtype,cobjects,symtable,aasm
+{$I cpuunit.inc}
+       ;
+    { clears a location record }
+    procedure clear_location(var loc : tlocation);
+    { copies a location, takes care of the symbol }
+    procedure set_location(var destloc,sourceloc : tlocation);
+    { swaps two locations }
+    procedure swap_location(var destloc,sourceloc : tlocation);
+
+  implementation
+
+    procedure clear_location(var loc : tlocation);
+
+      begin
+        if ((loc.loc=LOC_MEM) or (loc.loc=LOC_REFERENCE)) and
+           assigned(loc.reference.symbol) then
+          stringdispose(loc.reference.symbol);
+        loc.loc:=LOC_INVALID;
+      end;
+
+    procedure set_location(var destloc,sourceloc : tlocation);
+
+      begin
+         { this is needed if you want to be able to delete }
+         { the string with the nodes                       }
+         if assigned(destloc.reference.symbol) then
+           stringdispose(destloc.reference.symbol);
+         destloc:= sourceloc;
+         if sourceloc.loc in [LOC_MEM,LOC_REFERENCE] then
+           begin
+              if assigned(sourceloc.reference.symbol) then
+                destloc.reference.symbol:=
+                  stringdup(sourceloc.reference.symbol^);
+           end
+         else
+           destloc.reference.symbol:=nil;
+      end;
+
+    procedure swap_location(var destloc,sourceloc : tlocation);
+
+      var
+         swapl : tlocation;
+
+      begin
+         swapl:=destloc;
+         destloc:=sourceloc;
+         sourceloc:=swapl;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-15 22:18:55  florian
+    * some code added
+
+}

+ 59 - 64
compiler/new/cgobj.pas

@@ -1,46 +1,71 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    This unit implements the basic code generator 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 cgobj;
 unit cgobj;
 
 
   interface
   interface
 
 
-    pcg = ^tcg;
+    uses
+       aasm;
 
 
-    tcg = object
-       procedure a_call_name_ext(list : paasmoutput;const s : string;
-         offset : longint;m : texternaltyp);
+    type
+       pcg = ^tcg;
+       tcg = object
+          procedure a_call_name_ext(list : paasmoutput;const s : string;
+            offset : longint;m : texternaltyp);
 
 
-       procedure g_entrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
-                           stackframe:longint;
-                           var parasize:longint;var nostackframe:boolean;
-                           inlined : boolean);
+          procedure g_entrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
+                              stackframe:longint;
+                              var parasize:longint;var nostackframe:boolean;
+                              inlined : boolean);
 
 
-       { these methods must be overriden: }
-       procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
-       procedure a_call_name(list : paasmoutput;const s : string;
-         offset : longint);virtual;
+          { these methods must be overriden: }
+          procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
+          procedure a_call_name(list : paasmoutput;const s : string;
+            offset : longint);virtual;
 
 
-       procedure a_load_const8_ref(list : paasmoutput;b : byte;ref : treference);virtual;
-       procedure a_load_const16_ref(list : paasmoutput;w : word;ref : treference);virtual;
-       procedure a_load_const32_ref(list : paasmoutput;l : longint;ref : treference);virtual;
-       procedure a_load_const64_ref(list : paasmoutput;{ q : qword; }ref : treference);virtual;
+          procedure a_load_const8_ref(list : paasmoutput;b : byte;ref : treference);virtual;
+          procedure a_load_const16_ref(list : paasmoutput;w : word;ref : treference);virtual;
+          procedure a_load_const32_ref(list : paasmoutput;l : longint;ref : treference);virtual;
+          procedure a_load_const64_ref(list : paasmoutput;{ q : qword; }ref : treference);virtual;
 
 
-       procedure g_stackframe_entry(list : paasmoutput;localsize : longint);
+          procedure g_stackframe_entry(list : paasmoutput;localsize : longint);
 
 
-       { these methods can be overriden for extra functionality }
+          { these methods can be overriden for extra functionality }
 
 
-       { the following do nothing: }
-       procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual;
-       procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual;
+          { the following methods do nothing: }
+          procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual;
+          procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual;
 
 
-       procedure g_profilecode(list : paasmoutput);virtual;
-       procedure g_stackcheck(list : paasmoutput);virtual;
+          procedure g_profilecode(list : paasmoutput);virtual;
+          procedure g_stackcheck(list : paasmoutput);virtual;
 
 
-       { passing parameters, per default the parameter is pushed }
-       { nr gives the number of the parameter (enumerated from   }
-       { left to right), this allows to move the parameter to    }
-       { register, if the cpu supports register calling          }
-       { conventions                                             }
-       procedure a_param_reg(list : paasmoutput;r : tregister;nr : longint);virtual;
-    end;
+          { passing parameters, per default the parameter is pushed }
+          { nr gives the number of the parameter (enumerated from   }
+          { left to right), this allows to move the parameter to    }
+          { register, if the cpu supports register calling          }
+          { conventions                                             }
+          procedure a_param_reg(list : paasmoutput;r : tregister;nr : longint);virtual;
+       end;
 
 
   implementation
   implementation
 
 
@@ -279,43 +304,13 @@ unit cgobj;
         curlist:=nil;
         curlist:=nil;
     end;
     end;
 
 
-              if stackframe<>0 then
-                  begin
-                      if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then
-                          begin
-                             list^.insert(new(pai386,op_const_const(A_ENTER,S_NO,stackframe,0)))
-                          end
-                      else
-                          begin
-                             g_stackframe_entry(list,stackframe);
-                              list^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
-                              list^.insert(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
-                              list^.insert(new(pai386,op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
-                              if (cs_check_stack in aktlocalswitches) and
-                                 (target_info.flags in tf_supports_stack_check) then
-                                 emit_stackcheck(@initcode);
-
-                          end;
-                      if (cs_check_stack in aktlocalswitches) and
-                        (target_info.flags in tf_supports_stack_check) then
-                        g_stackcheck(@initcode);
-                  end { endif stackframe <> 0 }
-              else
-                 begin
-                   list^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
-                   list^.insert(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
-                 end;
-            end;
-                         begin
-                            unitinits.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol())));
-                            concat_external('INIT$$'+hp^.u^.modulename^,EXT_NEAR);
-                         end;
-
-
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-12-15 16:32:58  florian
+  Revision 1.2  1998-12-15 22:18:55  florian
+    * some code added
+
+  Revision 1.1  1998/12/15 16:32:58  florian
     + first version, derived from old routines
     + first version, derived from old routines
 
 
 }
 }

+ 4 - 5
compiler/new/i386.pas

@@ -1430,7 +1430,6 @@ unit i386;
               opxt:=opxt+top_ref;
               opxt:=opxt+top_ref;
               op1:=pointer(newreference(_op1.reference));
               op1:=pointer(newreference(_op1.reference));
            end;
            end;
-
       end;
       end;
 
 
     constructor tai386.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister);
     constructor tai386.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister);
@@ -1470,7 +1469,6 @@ unit i386;
          size:=_size;
          size:=_size;
          op1:=pointer(_op1);
          op1:=pointer(_op1);
          op2:=pointer(_op2);
          op2:=pointer(_op2);
-
       end;
       end;
 
 
     constructor tai386.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint);
     constructor tai386.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint);
@@ -1483,7 +1481,6 @@ unit i386;
          size:=_size;
          size:=_size;
          op1:=pointer(_op1);
          op1:=pointer(_op1);
          op2:=pointer(_op2);
          op2:=pointer(_op2);
-
       end;
       end;
 
 
     constructor tai386.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference);
     constructor tai386.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference);
@@ -1757,7 +1754,9 @@ unit i386;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-12-15 16:32:58  florian
-    + first version, derived from old routines
+  Revision 1.2  1998-12-15 22:18:56  florian
+    * some code added
 
 
+  Revision 1.1  1998/12/15 16:32:58  florian
+    + first version, derived from old routines
 }
 }

+ 5 - 2
compiler/new/systems.pas

@@ -1,6 +1,6 @@
 {
 {
     $Id$
     $Id$
-    Copyright (C) 1995,97 by Florian Klaempfl
+    Copyright (C) 1995-98 by Florian Klaempfl
 
 
     This unit contains information about the target systems supported
     This unit contains information about the target systems supported
     (these are not processor specific)
     (these are not processor specific)
@@ -1227,7 +1227,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-12-15 16:32:59  florian
+  Revision 1.2  1998-12-15 22:18:58  florian
+    * some code added
+
+  Revision 1.1  1998/12/15 16:32:59  florian
     + first version, derived from old routines
     + first version, derived from old routines
 
 
 }
 }