Browse Source

* newcg is compiling
* fixed the dup id problem reported by Paul Y.

florian 25 years ago
parent
commit
df41d1395c

+ 7 - 3
compiler/new/cgbase.pas

@@ -74,7 +74,7 @@ unit cgbase;
           { firsttemp position }
           firsttemp_offset : longint;
           { parameter offset }
-          call_offset : longint;
+          para_offset : longint;
 
           { every register which must be saved by the entry code }
           { (and restored by the exit code) must be in that set  }
@@ -329,7 +329,7 @@ unit cgbase;
         selfpointer_offset:=0;
         return_offset:=0;
         firsttemp_offset:=0;
-        call_offset:=0;
+        para_offset:=0;
         registerstosave:=[];
         flags:=0;
         framepointer:=R_NO;
@@ -515,7 +515,11 @@ unit cgbase;
 end.
 {
   $Log$
-  Revision 1.16  2000-02-17 14:48:36  florian
+  Revision 1.17  2000-02-20 20:49:46  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.16  2000/02/17 14:48:36  florian
      * updated to use old firstpass
 
   Revision 1.15  2000/01/07 01:14:52  peter

+ 9 - 6
compiler/new/cgobj.pas

@@ -485,7 +485,7 @@ unit cgobj;
               a_param_ref_addr(list,hr,2);
               reset_reference(hr);
               hr.base:=procinfo^.framepointer;
-              hr.offset:=pvarsym(p)^.address+procinfo^.call_offset;
+              hr.offset:=pvarsym(p)^.address+procinfo^.para_offset;
               a_param_ref_addr(list,hr,1);
               reset_reference(hr);
               a_call_name(list,'FPC_ADDREF',0);
@@ -523,7 +523,7 @@ unit cgobj;
                  parasymtable:
                    begin
                       hr.base:=procinfo^.framepointer;
-                      hr.offset:=pvarsym(p)^.address+procinfo^.call_offset;
+                      hr.offset:=pvarsym(p)^.address+procinfo^.para_offset;
                    end;
                  else
                    hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
@@ -644,14 +644,14 @@ unit cgobj;
                if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                  parasize:=0
                else
-                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.call_offset-pointersize;
+                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-pointersize;
             end
           else
             begin
                if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                  parasize:=0
                else
-                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.call_offset-pointersize*2;
+                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-pointersize*2;
                nostackframe:=false;
 
                if (po_interrupt in aktprocsym^.definition^.procoptions) then
@@ -1116,7 +1116,11 @@ unit cgobj;
 end.
 {
   $Log$
-  Revision 1.33  2000-01-07 01:14:53  peter
+  Revision 1.34  2000-02-20 20:49:46  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.33  2000/01/07 01:14:53  peter
     * updated copyright to 2000
 
   Revision 1.32  1999/12/01 12:42:33  peter
@@ -1225,4 +1229,3 @@ end.
     + first version, derived from old routines
 
 }
-

+ 15 - 9
compiler/new/pass_2.pas

@@ -31,7 +31,7 @@ uses
 
 { produces assembler for the expression in variable p }
 { and produces an assembler node at the end           }
-procedure generatecode(var p : pnode);
+procedure generatecode(var _p : ptree);
 
 { produces the actual code }
 function do_secondpass(p : pnode) : boolean;
@@ -44,7 +44,7 @@ implementation
      globtype,systems,
      cobjects,verbose,comphook,globals,files,
      symconst,symtable,types,aasm,scanner,
-     pass_1,tgobj,cgbase,cgobj,tgcpu,cpuasm,cpubase
+     pass_1,tgobj,cgbase,cgobj,tgcpu,cpuasm,cpubase,convtree
 {$ifdef GDB}
      ,gdb
 {$endif}
@@ -259,13 +259,14 @@ implementation
            end;
       end;
 
-    procedure generatecode(var p : pnode);
+    procedure generatecode(var _p : ptree);
       var
          i       : longint;
          hr      : preference;
 {$ifdef i386}
          regsize : topsize;
 {$endif i386}
+         p : pnode;
 
       label
          nextreg;
@@ -282,8 +283,9 @@ implementation
          tg.clearregistercount;
          use_esp_stackframe:=false;
 
-         if not(do_firstpassnode(p)) then
+         if not(do_firstpass(_p)) then
            begin
+              p:=convtree2node(_p);
               { max. optimizations     }
               { only if no asm is used }
               { and no try statement   }
@@ -318,8 +320,8 @@ implementation
                          if procinfo^.return_offset>=0 then
                            dec(procinfo^.return_offset,4);
 
-                         dec(procinfo^.call_offset,4);
-                         aktprocsym^.definition^.parast^.address_fixup:=procinfo^.call_offset;
+                         dec(procinfo^.para_offset,4);
+                         aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
                        end;
                      end;
                    if (p^.registersint<maxvarregs) then
@@ -413,7 +415,7 @@ implementation
                                        { when loading parameter to reg  }
                                        new(hr);
                                        reset_reference(hr^);
-                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.call_offset;
+                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.para_offset;
                                        hr^.base:=procinfo^.framepointer;
 {$ifdef i386}
                                        procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
@@ -464,7 +466,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2000-01-07 01:14:54  peter
+  Revision 1.11  2000-02-20 20:49:46  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.10  2000/01/07 01:14:54  peter
     * updated copyright to 2000
 
   Revision 1.9  1999/12/06 18:17:10  peter
@@ -495,4 +501,4 @@ end.
   Revision 1.1  1999/08/03 00:07:16  florian
     * initial revision
 
-}
+}

+ 12 - 2
compiler/new/tgeni386.pas

@@ -26,6 +26,7 @@ unit tgeni386;
 
     procedure cleartempgen;
     procedure resettempgen;
+    procedure resetusableregisters;
 
   implementation
 
@@ -44,10 +45,19 @@ unit tgeni386;
          tg.resettempgen;
       end;
 
+    procedure resetusableregisters;
+
+      begin
+         tg.resetusableregisters;
+      end;
 end.
 {
   $Log$
-  Revision 1.3  2000-01-07 01:14:54  peter
+  Revision 1.4  2000-02-20 20:49:46  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.3  2000/01/07 01:14:54  peter
     * updated copyright to 2000
 
   Revision 1.2  1999/08/02 21:29:09  florian
@@ -57,4 +67,4 @@ end.
   Revision 1.1  1999/08/02 17:15:05  florian
     * dummy implementation
 
-}
+}

+ 119 - 0
compiler/nodeh.inc

@@ -0,0 +1,119 @@
+{
+    $Id$
+    Copyright (c) 1999-2000 by Florian Klaempfl
+
+    The declarations of the nodes for the new code generator
+
+    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.
+
+ ****************************************************************************
+}
+    type
+       tnodeflags = (nf_needs_truefalselabel,tf_callunique);
+
+       tnodeflagset = set of tnodeflags;
+
+       pnode = ^tnode;
+       tnode = object(tlinkedlist_item)
+          treetype : ttreetyp;
+          { the location of the result of this node }
+          location : tlocation;
+          { do we need to parse childs to set var state }
+          varstateset : boolean;
+          { the parent node of this is node    }
+          { this field is set by concattolist  }
+          parent : pnode;
+          { there are some properties about the node stored }
+          flags : tnodeflagset;
+          { the number of registers needed to evalute the node }
+          registersint,registersfpu : longint;  { must be longint !!!! }
+{$ifdef SUPPORT_MMX}
+          registersmmx,registerskni : longint;
+{$endif SUPPORT_MMX}
+          resulttype : pdef;
+          fileinfo : tfileposinfo;
+          localswitches : tlocalswitches;
+{$ifdef extdebug}
+          firstpasscount : longint;
+{$endif extdebug}
+          error : boolean;
+          list : paasmoutput;
+          constructor init;
+          destructor done;virtual;
+          { runs det_resulttype and det_temp }
+          procedure pass_1;
+          { dermines the resulttype of the node }
+          procedure det_resulttype;virtual;
+          { dermines the number of necessary temp. locations to evaluate
+            the node }
+          procedure det_temp;virtual;
+          procedure secondpass;virtual;
+{$ifdef EXTDEBUG}
+          { writes a node for debugging purpose, shouldn't be called }
+          { direct, because there is no test for nil, use writenode  }
+          { to write a complete tree                                 }
+          procedure dowrite;virtual;
+{$endif EXTDEBUG}
+          procedure concattolist(l : plinkedlist);virtual;
+          function ischild(p : pnode) : boolean;virtual;
+       end;
+
+       { this node is the anchestor for all classes with at least }
+       { one child, you have to use it if you want to use         }
+       { true- and falselabel                                     }
+       punarynode = ^tunarynode;
+       tunarynode = object(tnode)
+          left : pnode;
+          truelabel,falselabel : pasmlabel;
+ {$ifdef extdebug}
+          procedure dowrite;virtual;
+ {$endif extdebug}
+          constructor init(l : pnode);
+          procedure concattolist(l : plinkedlist);virtual;
+          function ischild(p : pnode) : boolean;virtual;
+          procedure det_resulttype;virtual;
+          procedure det_temp;virtual;
+       end;
+
+       pbinarynode = ^tbinarynode;
+       tbinarynode = object(tunarynode)
+          right : pnode;
+          constructor init(l,r : pnode);
+          procedure concattolist(l : plinkedlist);virtual;
+          function ischild(p : pnode) : boolean;virtual;
+          procedure det_resulttype;virtual;
+          procedure det_temp;virtual;
+       end;
+
+       pvecnode = ^tvecnode;
+       tvecnode = object(tbinarynode)
+       end;
+
+
+       pbinopnode = ^tbinopnode;
+       tbinopnode = object(tbinarynode)
+          { is true, if the right and left operand are swaped }
+          { against the original order                        }
+          swaped : boolean;
+          constructor init(l,r : pnode);
+       end;
+
+{
+  $Log$
+  Revision 1.1  2000-02-20 20:49:45  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+}

+ 6 - 2
compiler/pass_2.pas

@@ -832,7 +832,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  2000-02-10 23:44:43  florian
+  Revision 1.58  2000-02-20 20:49:45  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.57  2000/02/10 23:44:43  florian
     * big update for exception handling code generation: possible mem holes
       fixed, break/continue/exit should work always now as expected
 
@@ -917,4 +921,4 @@ end.
   Revision 1.35  1999/08/27 10:46:26  pierre
    + some EXTTEMPREGDEBUG code added
 
-}
+}

+ 25 - 5
compiler/psub.pas

@@ -53,7 +53,7 @@ uses
   scanner,aasm,tree,types,
   import,gendef,
 {$ifdef newcg}
-  cgbase,tgcpu,
+  cgbase,
 {$else newcg}
   hcodegen,temp_gen,
 {$endif newcg}
@@ -1391,7 +1391,7 @@ var
    oldaktmaxfpuregisters,localmaxfpuregisters : longint;
    { code for the subroutine as tree }
 {$ifdef newcg}
-   code:pnode;
+   code:ptree;
 {$else newcg}
    code:ptree;
 {$endif newcg}
@@ -1481,11 +1481,18 @@ begin
    entryswitches:=aktlocalswitches;
    localmaxfpuregisters:=aktmaxfpuregisters;
 {$ifdef newcg}
+{$ifdef dummy}
    { parse the code ... }
    if (po_assembler in aktprocsym^.definition^.procoptions) then
      code:=convtree2node(assembler_block)
    else
      code:=convtree2node(block(current_module^.islibrary));
+{$endif dummy}
+   { parse the code ... }
+   if (po_assembler in aktprocsym^.definition^.procoptions) then
+     code:=assembler_block
+   else
+     code:=block(current_module^.islibrary);
 {$else newcg}
    { parse the code ... }
    if (po_assembler in aktprocsym^.definition^.procoptions) then
@@ -1526,7 +1533,8 @@ begin
    aktmaxfpuregisters:=localmaxfpuregisters;
 {$ifndef NOPASS2}
 {$ifdef newcg}
-   tg.setfirsttemp(procinfo^.firsttemp_offset);
+   if assigned(code) then
+     generatecode(code);
 {$else newcg}
    if assigned(code) then
      generatecode(code);
@@ -1648,15 +1656,23 @@ begin
        aktprocsym^.definition^.localst:=nil;
      end;
 
+{$ifdef newcg}
+   { all registers can be used again }
+   tg.resetusableregisters;
+   { only now we can remove the temps }
+   tg.resettempgen;
+{$else newcg}
    { all registers can be used again }
    resetusableregisters;
    { only now we can remove the temps }
    resettempgen;
+{$endif newcg}
 
    { remove code tree, if not inline procedure }
    if assigned(code) and not(pocall_inline in aktprocsym^.definition^.proccalloptions) then
 {$ifdef newcg}
-     dispose(code,done);
+     {!!!!!!! dispose(code,done); }
+     disposetree(code);
 {$else newcg}
      disposetree(code);
 {$endif newcg}
@@ -1970,7 +1986,11 @@ end.
 
 {
   $Log$
-  Revision 1.49  2000-02-17 14:53:42  florian
+  Revision 1.50  2000-02-20 20:49:45  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.49  2000/02/17 14:53:42  florian
     * some updates for the newcg
 
   Revision 1.48  2000/02/09 13:23:00  peter

+ 11 - 4
compiler/symtable.pas

@@ -1770,10 +1770,13 @@ implementation
                   hp:=hp^.next;
                 end;
            end;
-
-         { check for duplicate id in local and parsymtable symtable }
+         { check the current symtable }
+         hsym:=search(sym^.name);
+         if assigned(hsym) then
+           DuplicateSym(hsym);
+         { check for duplicate id in local and parasymtable symtable }
          if (symtabletype=localsymtable) then
-           { to be on the sure side: }
+           { to be on the save side: }
            begin
               if assigned(next) and
                 (next^.symtabletype=parasymtable) then
@@ -2781,7 +2784,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.77  2000-02-11 13:53:49  pierre
+  Revision 1.78  2000-02-20 20:49:45  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.77  2000/02/11 13:53:49  pierre
    * avoid stack overflow in tref.done (bug 846)
 
   Revision 1.76  2000/02/09 13:23:05  peter

+ 7 - 3
compiler/tree.pas

@@ -346,7 +346,7 @@ unit tree;
 {$I innr.inc}
 
 {$ifdef newcg}
-{$I nodeh.inc}
+{$I new/nodeh.inc}
 {$endif newcg}
   implementation
 
@@ -1924,12 +1924,16 @@ unit tree;
       end;
 
 {$ifdef newcg}
-{$I node.inc}
+{$I new/node.inc}
 {$endif newcg}
 end.
 {
   $Log$
-  Revision 1.112  2000-02-17 14:53:43  florian
+  Revision 1.113  2000-02-20 20:49:46  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.112  2000/02/17 14:53:43  florian
     * some updates for the newcg
 
   Revision 1.111  2000/02/09 13:23:09  peter