2
0
Эх сурвалжийг харах

* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...

florian 22 жил өмнө
parent
commit
0284016ee9

+ 21 - 3
compiler/cgbase.pas

@@ -72,6 +72,8 @@ unit cgbase;
           procdef : tprocdef;
           procdef : tprocdef;
           {# offset from frame pointer to get parent frame pointer reference
           {# offset from frame pointer to get parent frame pointer reference
              (used in nested routines only)
              (used in nested routines only)
+             On the PowerPC, this is used to store the offset where the
+             frame pointer from the outer procedure is stored.
           }
           }
           framepointer_offset : longint;
           framepointer_offset : longint;
           {# offset from frame pointer to get self reference }
           {# offset from frame pointer to get self reference }
@@ -217,6 +219,8 @@ unit cgbase;
        { save the size of pushed parameter, needed for aligning }
        { save the size of pushed parameter, needed for aligning }
        pushedparasize : longint;
        pushedparasize : longint;
 
 
+       { procinfo instance which is used in procedures created automatically by the compiler }
+       voidprocpi : tprocinfo;
 
 
     { message calls with codegenerror support }
     { message calls with codegenerror support }
     procedure cgmessage(t : longint);
     procedure cgmessage(t : longint);
@@ -515,6 +519,14 @@ implementation
          ResourceStrings:=TResourceStrings.Create;
          ResourceStrings:=TResourceStrings.Create;
          { use the librarydata from current_module }
          { use the librarydata from current_module }
          objectlibrary:=current_module.librarydata;
          objectlibrary:=current_module.librarydata;
+         { for the implicitly generated init/final. procedures for global init. variables,
+           a dummy procinfo is necessary }
+         voidprocpi:=cprocinfo.create;
+         with voidprocpi do
+           begin
+              framepointer.enum:=R_INTREGISTER;
+              framepointer.number:=NR_FRAME_POINTER_REG;
+           end;
       end;
       end;
 
 
 
 
@@ -549,6 +561,7 @@ implementation
          { resource strings }
          { resource strings }
          ResourceStrings.free;
          ResourceStrings.free;
          objectlibrary:=nil;
          objectlibrary:=nil;
+         // voidprocpi.free;
       end;
       end;
 
 
 
 
@@ -644,7 +657,6 @@ implementation
         commutativeop := list[op];
         commutativeop := list[op];
       end;
       end;
 
 
-
 {$ifdef fixLeaksOnError}
 {$ifdef fixLeaksOnError}
 procedure hcodegen_do_stop;
 procedure hcodegen_do_stop;
 var p: pprocinfo;
 var p: pprocinfo;
@@ -652,7 +664,8 @@ begin
   p := pprocinfo(procinfoStack.pop);
   p := pprocinfo(procinfoStack.pop);
   while p <> nil Do
   while p <> nil Do
     begin
     begin
-      dispose(p,done);
+      if p<>voidprocpi then
+        p.free;
       p := pprocinfo(procinfoStack.pop);
       p := pprocinfo(procinfoStack.pop);
     end;
     end;
   procinfoStack.done;
   procinfoStack.done;
@@ -668,7 +681,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.40  2003-04-22 13:47:08  peter
+  Revision 1.41  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.40  2003/04/22 13:47:08  peter
     * fixed C style array of const
     * fixed C style array of const
     * fixed C array passing
     * fixed C array passing
     * fixed left to right with high parameters
     * fixed left to right with high parameters

+ 13 - 3
compiler/cginfo.pas

@@ -44,9 +44,14 @@ interface
          LOC_FPUREGISTER,  { FPU stack }
          LOC_FPUREGISTER,  { FPU stack }
          LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
          LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
          LOC_MMXREGISTER,  { MMX register }
          LOC_MMXREGISTER,  { MMX register }
-         LOC_CMMXREGISTER, { MMX register variable }
+         { MMX register variable }
+         LOC_CMMXREGISTER,
          LOC_SSEREGISTER,
          LOC_SSEREGISTER,
-         LOC_CSSEREGISTER
+         LOC_CSSEREGISTER,
+         { multimedia register }
+         LOC_MMREGISTER,
+         { Constant multimedia reg which shouldn't be modified }
+         LOC_CMMREGISTER
        );
        );
 
 
        {# Generic opcodes, which must be supported by all processors
        {# Generic opcodes, which must be supported by all processors
@@ -126,7 +131,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.19  2003-04-22 23:50:22  peter
+  Revision 1.20  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.19  2003/04/22 23:50:22  peter
     * firstpass uses expectloc
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG
       location.loc from secondpass in EXTDEBUG

+ 7 - 2
compiler/cgobj.pas

@@ -1808,7 +1808,7 @@ unit cgobj;
     var r:Tregister;
     var r:Tregister;
 
 
      begin
      begin
-       r.enum:=R_INTREGISTER;;
+       r.enum:=R_INTREGISTER;
        r.number:=NR_ACCUMULATOR;
        r.number:=NR_ACCUMULATOR;
        a_load_ref_reg(list, OS_S32, href, r);
        a_load_ref_reg(list, OS_S32, href, r);
      end;
      end;
@@ -1838,7 +1838,12 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.84  2003-04-22 14:33:38  peter
+  Revision 1.85  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.84  2003/04/22 14:33:38  peter
     * removed some notes/hints
     * removed some notes/hints
 
 
   Revision 1.83  2003/04/22 13:47:08  peter
   Revision 1.83  2003/04/22 13:47:08  peter

+ 9 - 1
compiler/fpcdefs.inc

@@ -52,6 +52,9 @@
   {$define cpu64bit}
   {$define cpu64bit}
   {$undef cpuflags}
   {$undef cpuflags}
 {$endif alpha}
 {$endif alpha}
+{$ifdef powerpc}
+  {$define callparatemp}
+{$endif powerpc}
 
 
 { FPU Emulator support }
 { FPU Emulator support }
 {$ifdef m68k}
 {$ifdef m68k}
@@ -60,7 +63,12 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.14  2002-12-06 16:56:57  peter
+  Revision 1.15  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.14  2002/12/06 16:56:57  peter
     * only compile cs_fp_emulation support when cpufpuemu is defined
     * only compile cs_fp_emulation support when cpufpuemu is defined
     * define cpufpuemu for m68k only
     * define cpufpuemu for m68k only
 
 

+ 18 - 33
compiler/m68k/cpubase.pas

@@ -114,7 +114,7 @@ uses
          R_INTREGISTER,R_FLOATREGISTER);
          R_INTREGISTER,R_FLOATREGISTER);
 
 
       Tnewregister=word;
       Tnewregister=word;
-      
+
       Tregister=record
       Tregister=record
         enum:Toldregister;
         enum:Toldregister;
         number:word;
         number:word;
@@ -151,14 +151,14 @@ uses
       NR_D6 = $0700; NR_D7 = $0800; NR_A0 = $0900;
       NR_D6 = $0700; NR_D7 = $0800; NR_A0 = $0900;
       NR_A1 = $0A00; NR_A2 = $0B00; NR_A3 = $0C00;
       NR_A1 = $0A00; NR_A2 = $0B00; NR_A3 = $0C00;
       NR_A4 = $0D00; NR_A5 = $0E00; NR_A6 = $0F00;
       NR_A4 = $0D00; NR_A5 = $0E00; NR_A6 = $0F00;
-      NR_A7 = $1000; 
+      NR_A7 = $1000;
 
 
     {Super registers.}
     {Super registers.}
-      RS_D0 = $01; RS_D1 = $02; RS_D2 = $03; 
-      RS_D3 = $04; RS_D4 = $05; RS_D5 = $06; 
-      RS_D6 = $07; RS_D7 = $08; RS_A0 = $09; 
-      RS_A1 = $0A; RS_A2 = $0B; RS_A3 = $0C; 
-      RS_A4 = $0D; RS_A5 = $0E; RS_A6 = $0F; 
+      RS_D0 = $01; RS_D1 = $02; RS_D2 = $03;
+      RS_D3 = $04; RS_D4 = $05; RS_D5 = $06;
+      RS_D6 = $07; RS_D7 = $08; RS_A0 = $09;
+      RS_A1 = $0A; RS_A2 = $0B; RS_A3 = $0C;
+      RS_A4 = $0D; RS_A5 = $0E; RS_A6 = $0F;
       RS_A7 = $10;
       RS_A7 = $10;
 
 
      {Sub register numbers:}
      {Sub register numbers:}
@@ -288,35 +288,15 @@ uses
 *****************************************************************************}
 *****************************************************************************}
 
 
     type
     type
-      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 }
-
-        { The m68k doesn't know multi media registers but this is for easier porting
-          because several generic parts of the compiler use it. }
-        LOC_MMREGISTER,
-        { The m68k doesn't know multi media registers but this is for easier porting
-          because several generic parts of the compiler use it. }
-        LOC_CMMREGISTER
-      );
-
       { tparamlocation describes where a parameter for a procedure is stored.
       { tparamlocation describes where a parameter for a procedure is stored.
         References are given from the caller's point of view. The usual
         References are given from the caller's point of view. The usual
         TLocation isn't used, because contains a lot of unnessary fields.
         TLocation isn't used, because contains a lot of unnessary fields.
       }
       }
       tparalocation = packed record
       tparalocation = packed record
          size : TCGSize;
          size : TCGSize;
-         loc  : TLoc;
+         loc  : TCGLoc;
          sp_fixup : longint;
          sp_fixup : longint;
-         case TLoc of
+         case TCGLoc of
             LOC_REFERENCE : (reference : tparareference);
             LOC_REFERENCE : (reference : tparareference);
             { segment in reference at the same place as in loc_register }
             { segment in reference at the same place as in loc_register }
             LOC_REGISTER,LOC_CREGISTER : (
             LOC_REGISTER,LOC_CREGISTER : (
@@ -331,9 +311,9 @@ uses
       end;
       end;
 
 
       tlocation = packed record
       tlocation = packed record
-         loc  : TLoc;
+         loc  : TCGLoc;
          size : TCGSize;
          size : TCGSize;
-         case TLoc of
+         case TCGLoc of
             LOC_FLAGS : (resflags : tresflags);
             LOC_FLAGS : (resflags : tresflags);
             LOC_CONSTANT : (
             LOC_CONSTANT : (
               case longint of
               case longint of
@@ -646,7 +626,7 @@ implementation
 
 
     function flags_to_cond(const f: TResFlags) : TAsmCond;
     function flags_to_cond(const f: TResFlags) : TAsmCond;
       const flags2cond: array[tresflags] of tasmcond = (
       const flags2cond: array[tresflags] of tasmcond = (
-          C_EQ,{F_E     equal}    
+          C_EQ,{F_E     equal}
           C_NE,{F_NE    not equal}
           C_NE,{F_NE    not equal}
           C_GT,{F_G     gt signed}
           C_GT,{F_G     gt signed}
           C_LT,{F_L     lt signed}
           C_LT,{F_L     lt signed}
@@ -726,7 +706,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.18  2003-02-19 22:00:16  daniel
+  Revision 1.19  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.18  2003/02/19 22:00:16  daniel
     * Code generator converted to new register notation
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
     - Horribily outdated todo.txt removed
 
 

+ 103 - 3
compiler/ncal.pas

@@ -29,7 +29,7 @@ interface
     uses
     uses
        cutils,cclasses,
        cutils,cclasses,
        globtype,cpuinfo,
        globtype,cpuinfo,
-       node,
+       node,nbas,
        {$ifdef state_tracking}
        {$ifdef state_tracking}
        nstate,
        nstate,
        {$endif state_tracking}
        {$endif state_tracking}
@@ -113,6 +113,9 @@ interface
           function  docompare(p: tnode): boolean; override;
           function  docompare(p: tnode): boolean; override;
           procedure set_procvar(procvar:tnode);
           procedure set_procvar(procvar:tnode);
        private
        private
+{$ifdef callparatemp}
+          function extract_functioncall_paras: tblocknode;
+{$endif callparatemp}
           AbstractMethodsList : TStringList;
           AbstractMethodsList : TStringList;
        end;
        end;
        tcallnodeclass = class of tcallnode;
        tcallnodeclass = class of tcallnode;
@@ -179,7 +182,8 @@ implementation
       verbose,globals,
       verbose,globals,
       symconst,paramgr,defutil,defcmp,
       symconst,paramgr,defutil,defcmp,
       htypechk,pass_1,cpubase,
       htypechk,pass_1,cpubase,
-      nbas,ncnv,nld,ninl,nadd,ncon,nmem,
+      ncnv,nld,ninl,nadd,ncon,nmem,
+      nutils,
       rgobj,cginfo,cgbase
       rgobj,cginfo,cgbase
       ;
       ;
 
 
@@ -1958,6 +1962,58 @@ type
       end;
       end;
 
 
 
 
+{$ifdef callparatemp}
+    function tree_contains_function_call(var n: tnode): foreachnoderesult;
+      begin
+        result := fen_false;
+        if n.nodetype = calln then
+          { stop when we encounter a call node }
+          result := fen_norecurse_true;
+      end;
+
+
+    function tcallnode.extract_functioncall_paras: tblocknode;
+      var
+        curpara: tcallparanode;
+        newblock: tblocknode;
+        newstatement: tstatementnode;
+        temp: ttempcreatenode;
+        foundcall: boolean;
+      begin
+        foundcall := false;
+        curpara := tcallparanode(left);
+        if assigned(curpara) then
+          curpara := tcallparanode(curpara.right);
+        newblock := nil;
+        while assigned(curpara) do
+          begin
+            if foreachnodestatic(curpara.left,@tree_contains_function_call) then
+              begin
+                if (not foundcall) then
+                  begin
+                    foundcall := true;
+                    newblock := internalstatements(newstatement);
+                  end;
+                temp := ctempcreatenode.create(curpara.left.resulttype,curpara.left.resulttype.def.size,true);
+                addstatement(newstatement,temp);
+                resulttypepass(newstatement);
+                addstatement(newstatement,
+                  cassignmentnode.create(ctemprefnode.create(temp),curpara.left));
+                resulttypepass(newstatement);
+                { after the assignment, turn the temp into a non-persistent one, so }
+                { that it will be freed once it's used as parameter                 }
+                addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+                resulttypepass(newstatement);
+                curpara.left := ctemprefnode.create(temp);
+                { the para's themselves are "resulttypepassed" in in tcallnode.pass_1 }
+              end;
+            curpara := tcallparanode(curpara.right);
+          end;
+        result := newblock;
+      end;
+{$endif callparatemp}
+
+
     function tcallnode.pass_1 : tnode;
     function tcallnode.pass_1 : tnode;
       var
       var
          inlinecode : tnode;
          inlinecode : tnode;
@@ -1965,6 +2021,11 @@ type
 {$ifdef m68k}
 {$ifdef m68k}
          regi : tregister;
          regi : tregister;
 {$endif}
 {$endif}
+{$ifdef callparatemp}
+         callparatemps, newblock: tblocknode;
+         statement: tstatementnode;
+         paras, oldright, newcall: tnode;
+{$endif callparatemp}
       label
       label
         errorexit;
         errorexit;
       begin
       begin
@@ -1972,6 +2033,10 @@ type
          inlined:=false;
          inlined:=false;
          inlinecode := nil;
          inlinecode := nil;
 
 
+{$ifdef callparatemp}
+         callparatemps := extract_functioncall_paras;
+{$endif callparatemp}
+
          { work trough all parameters to get the register requirements }
          { work trough all parameters to get the register requirements }
          if assigned(left) then
          if assigned(left) then
            tcallparanode(left).det_registers;
            tcallparanode(left).det_registers;
@@ -2176,9 +2241,39 @@ type
               registersmmx:=max(left.registersmmx,registersmmx);
               registersmmx:=max(left.registersmmx,registersmmx);
 {$endif SUPPORT_MMX}
 {$endif SUPPORT_MMX}
            end;
            end;
+{$ifdef callparatemp}
+         if (callparatemps <> nil) then
+           begin
+             { we have to replace the callnode with a blocknode. firstpass will }
+             { free the original call node. Avoid copying all subnodes though   }
+             paras := left;
+             oldright := right;
+             left := nil;
+             right := nil;
+             newcall := self.getcopy;
+             tcallnode(newcall).left := paras;
+             tcallnode(newcall).right := oldright;
+             
+             newblock := internalstatements(statement);
+             addstatement(statement,callparatemps);
+             { add the copy of the call node after the callparatemps block    }
+             { and return that. The last statement of a bocknode determines   }
+             { the resulttype & location of the block -> ok. Working with a   }
+             { new block is easier than going to the end of the callparatemps }
+             { block (JM)                                                     }
+             addstatement(statement,newcall);
+             result := newblock;
+             { set to nil so we can free this one in case of an errorexit }
+             callparatemps := nil;
+           end;
+{$endif callparatemp}
       errorexit:
       errorexit:
          if inlined then
          if inlined then
            procdefinition.proccalloption:=pocall_inline;
            procdefinition.proccalloption:=pocall_inline;
+{$ifdef callparatemp}
+         if assigned(callparatemps) then
+           callparatemps.free;
+{$endif callparatemp}
       end;
       end;
 
 
 {$ifdef state_tracking}
 {$ifdef state_tracking}
@@ -2391,7 +2486,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.139  2003-04-22 23:50:22  peter
+  Revision 1.140  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.139  2003/04/22 23:50:22  peter
     * firstpass uses expectloc
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG
       location.loc from secondpass in EXTDEBUG

+ 24 - 3
compiler/ncgutil.pas

@@ -2000,7 +2000,11 @@ implementation
 
 
 
 
     procedure genimplicitunitinit(list : TAAsmoutput);
     procedure genimplicitunitinit(list : TAAsmoutput);
+      var
+         oldprocinfo : tprocinfo;
       begin
       begin
+         oldprocinfo:=procinfo;
+         procinfo:=voidprocpi;
 {$ifdef GDB}
 {$ifdef GDB}
          if (cs_debuginfo in aktmoduleswitches) and
          if (cs_debuginfo in aktmoduleswitches) and
             target_info.use_function_relative_addresses then
             target_info.use_function_relative_addresses then
@@ -2008,17 +2012,26 @@ implementation
 {$endif GDB}
 {$endif GDB}
          list.concat(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
          list.concat(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
          list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
          list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
+{$ifndef i386}
+         { on the 386, g_return_from_proc is a simple return, so we don't need a real stack frame }
+         cg.g_stackframe_entry(list,0);
+{$endif i386}
          { using current_module.globalsymtable is hopefully      }
          { using current_module.globalsymtable is hopefully      }
          { more robust than symtablestack and symtablestack.next }
          { more robust than symtablestack and symtablestack.next }
          if assigned(current_module.globalsymtable) then
          if assigned(current_module.globalsymtable) then
            tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
            tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          cg.g_return_from_proc(list,0);
          cg.g_return_from_proc(list,0);
+         procinfo:=oldprocinfo;
       end;
       end;
 
 
 
 
     procedure genimplicitunitfinal(list : TAAsmoutput);
     procedure genimplicitunitfinal(list : TAAsmoutput);
+      var
+         oldprocinfo : tprocinfo;
       begin
       begin
+         oldprocinfo:=procinfo;
+         procinfo:=voidprocpi;
 {$ifdef GDB}
 {$ifdef GDB}
          if (cs_debuginfo in aktmoduleswitches) and
          if (cs_debuginfo in aktmoduleswitches) and
             target_info.use_function_relative_addresses then
             target_info.use_function_relative_addresses then
@@ -2026,20 +2039,28 @@ implementation
 {$endif GDB}
 {$endif GDB}
          list.concat(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
          list.concat(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
          list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
          list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
+{$ifndef i386}
+         { on the 386, g_return_from_proc is a simple return, so we don't need a real stack frame }
+         cg.g_stackframe_entry(list,0);
+{$endif i386}
          { using current_module.globalsymtable is hopefully      }
          { using current_module.globalsymtable is hopefully      }
          { more robust than symtablestack and symtablestack.next }
          { more robust than symtablestack and symtablestack.next }
          if assigned(current_module.globalsymtable) then
          if assigned(current_module.globalsymtable) then
            tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
            tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          cg.g_return_from_proc(list,0);
          cg.g_return_from_proc(list,0);
+         procinfo:=oldprocinfo;
       end;
       end;
 
 
-
-
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.87  2003-04-22 14:33:38  peter
+  Revision 1.88  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.87  2003/04/22 14:33:38  peter
     * removed some notes/hints
     * removed some notes/hints
 
 
   Revision 1.86  2003/04/22 13:47:08  peter
   Revision 1.86  2003/04/22 13:47:08  peter

+ 156 - 0
compiler/nutils.pas

@@ -0,0 +1,156 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Type checking and register allocation for inline nodes
+
+    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 nutils;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    node;
+
+  type
+    { resulttype of functions that process on all nodes in a (sub)tree }
+    foreachnoderesult = (
+      { false, continue recursion }
+      fen_false,
+      { false, stop recursion }
+      fen_norecurse_false,
+      { true, continue recursion }
+      fen_true,
+      { true, stop recursion }
+      fen_norecurse_true
+    );
+
+
+  foreachnodefunction = function(var n: tnode): foreachnoderesult of object;
+  staticforeachnodefunction = function(var n: tnode): foreachnoderesult;
+
+
+  function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
+  function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
+
+implementation
+
+  uses nflw,nset,ncal;
+
+  function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
+    begin
+      result := false;
+      if not assigned(n) then
+        exit;
+      case f(n) of
+        fen_norecurse_false:
+          exit;
+        fen_norecurse_true:
+          begin
+            result := true;
+            exit;
+          end;
+        fen_true:
+          result := true;
+       { result is already false
+        fen_false:
+          result := false; }
+      end;
+      case n.nodetype of
+        calln:
+          result := foreachnode(tcallnode(n).methodpointer,f) or result;
+        procinlinen:
+          result := foreachnode(tprocinlinenode(n).inlinetree,f) or result;
+        ifn, whilerepeatn, forn:
+          begin
+            { not in one statement, won't work because of b- }
+            result := foreachnode(tloopnode(n).t1,f) or result;
+            result := foreachnode(tloopnode(n).t2,f) or result;
+          end;
+        raisen:
+          result := foreachnode(traisenode(n).frametree,f) or result;
+        casen:
+          result := foreachnode(tcasenode(n). elseblock,f) or result;
+      end;
+      if n.inheritsfrom(tbinarynode) then
+        begin
+          result := foreachnode(tbinarynode(n).right,f) or result;
+          result := foreachnode(tbinarynode(n).left,f) or result;
+        end
+      else if n.inheritsfrom(tunarynode) then
+        result := foreachnode(tunarynode(n).left,f) or result;
+    end;
+
+
+  function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
+    begin
+      result := false;
+      if not assigned(n) then
+        exit;
+      case f(n) of
+        fen_norecurse_false:
+          exit;
+        fen_norecurse_true:
+          begin
+            result := true;
+            exit;
+          end;
+        fen_true:
+          result := true;
+       { result is already false
+        fen_false:
+          result := false; }
+      end;
+      case n.nodetype of
+        calln:
+          result := foreachnodestatic(tcallnode(n).methodpointer,f) or result;
+        procinlinen:
+          result := foreachnodestatic(tprocinlinenode(n).inlinetree,f) or result;
+        ifn, whilerepeatn, forn:
+          begin
+            { not in one statement, won't work because of b- }
+            result := foreachnodestatic(tloopnode(n).t1,f) or result;
+            result := foreachnodestatic(tloopnode(n).t2,f) or result;
+          end;
+        raisen:
+          result := foreachnodestatic(traisenode(n).frametree,f) or result;
+        casen:
+          result := foreachnodestatic(tcasenode(n). elseblock,f) or result;
+      end;
+      if n.inheritsfrom(tbinarynode) then
+        begin
+          result := foreachnodestatic(tbinarynode(n).right,f) or result;
+          result := foreachnodestatic(tbinarynode(n).left,f) or result;
+        end
+      else if n.inheritsfrom(tunarynode) then
+        result := foreachnodestatic(tunarynode(n).left,f) or result;
+    end;
+
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+}

+ 26 - 5
compiler/pmodules.pas

@@ -774,7 +774,9 @@ implementation
          store_crc,store_interface_crc : cardinal;
          store_crc,store_interface_crc : cardinal;
          s2  : ^string; {Saves stack space}
          s2  : ^string; {Saves stack space}
          force_init_final : boolean;
          force_init_final : boolean;
+         initfinalcode : taasmoutput;
       begin
       begin
+         initfinalcode:=taasmoutput.create;
          consume(_UNIT);
          consume(_UNIT);
          if compile_level=1 then
          if compile_level=1 then
           Status.IsExe:=false;
           Status.IsExe:=false;
@@ -999,7 +1001,9 @@ implementation
               { now we can insert a cut }
               { now we can insert a cut }
               if (cs_create_smart in aktmoduleswitches) then
               if (cs_create_smart in aktmoduleswitches) then
                 codeSegment.concat(Tai_cut.Create);
                 codeSegment.concat(Tai_cut.Create);
-              genimplicitunitinit(codesegment);
+              genimplicitunitinit(initfinalcode);
+              initfinalcode.convert_registers;
+              codesegment.concatlist(initfinalcode);
            end;
            end;
          { finalize? }
          { finalize? }
          if token=_FINALIZATION then
          if token=_FINALIZATION then
@@ -1021,7 +1025,9 @@ implementation
               { now we can insert a cut }
               { now we can insert a cut }
               if (cs_create_smart in aktmoduleswitches) then
               if (cs_create_smart in aktmoduleswitches) then
                 codeSegment.concat(Tai_cut.Create);
                 codeSegment.concat(Tai_cut.Create);
-              genimplicitunitfinal(codesegment);
+              genimplicitunitfinal(initfinalcode);
+              initfinalcode.convert_registers;
+              codesegment.concatlist(initfinalcode);
            end;
            end;
 
 
          { the last char should always be a point }
          { the last char should always be a point }
@@ -1166,7 +1172,10 @@ implementation
             exit;
             exit;
           end;
           end;
 
 
+        initfinalcode.free;
+
         Comment(V_Used,'Finished compiling module '+current_module.modulename^);
         Comment(V_Used,'Finished compiling module '+current_module.modulename^);
+
       end;
       end;
 
 
 
 
@@ -1175,7 +1184,9 @@ implementation
          main_file: tinputfile;
          main_file: tinputfile;
          st    : tsymtable;
          st    : tsymtable;
          hp    : tmodule;
          hp    : tmodule;
+         initfinalcode : taasmoutput;
       begin
       begin
+        initfinalcode:=taasmoutput.create;
          DLLsource:=islibrary;
          DLLsource:=islibrary;
          Status.IsLibrary:=IsLibrary;
          Status.IsLibrary:=IsLibrary;
          Status.IsExe:=true;
          Status.IsExe:=true;
@@ -1318,11 +1329,15 @@ So, all parameters are passerd into registers in sparc architecture.}
               { Add initialize section }
               { Add initialize section }
               if (cs_create_smart in aktmoduleswitches) then
               if (cs_create_smart in aktmoduleswitches) then
                 codeSegment.concat(Tai_cut.Create);
                 codeSegment.concat(Tai_cut.Create);
-              genimplicitunitinit(codesegment);
+              genimplicitunitinit(initfinalcode);
+              initfinalcode.convert_registers;
+              codesegment.concatlist(initfinalcode);
               { Add finalize section }
               { Add finalize section }
               if (cs_create_smart in aktmoduleswitches) then
               if (cs_create_smart in aktmoduleswitches) then
                 codeSegment.concat(Tai_cut.Create);
                 codeSegment.concat(Tai_cut.Create);
-              genimplicitunitfinal(codesegment);
+              genimplicitunitfinal(initfinalcode);
+              initfinalcode.convert_registers;
+              codesegment.concatlist(initfinalcode);
            end;
            end;
 
 
          { Add symbol to the exports section for win32 so smartlinking a
          { Add symbol to the exports section for win32 so smartlinking a
@@ -1448,12 +1463,18 @@ So, all parameters are passerd into registers in sparc architecture.}
                 linker.MakeExecutable;
                 linker.MakeExecutable;
              end;
              end;
           end;
           end;
+         initfinalcode.free;
       end;
       end;
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.100  2003-04-12 15:13:03  peter
+  Revision 1.101  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.100  2003/04/12 15:13:03  peter
     * Use the original unitname when defining a unitsym
     * Use the original unitname when defining a unitsym
 
 
   Revision 1.99  2003/03/23 23:21:42  hajny
   Revision 1.99  2003/03/23 23:21:42  hajny

+ 14 - 6
compiler/powerpc/agppcgas.pas

@@ -174,10 +174,10 @@ unit agppcgas;
            if (symaddr <> refs_full) then
            if (symaddr <> refs_full) then
              s := s+')'+symaddr2str[symaddr];
              s := s+')'+symaddr2str[symaddr];
 
 
-            if (index.enum < firstreg) or (index.enum > lastreg) then
-              internalerror(20030312);
-            if (base.enum < firstreg) or (base.enum > lastreg) then
-              internalerror(200303123);
+           if (index.enum < firstreg) or (index.enum > lastreg) then
+             internalerror(20030312);
+           if (base.enum < firstreg) or (base.enum > lastreg) then
+             internalerror(200303123);
            if (index.enum=R_NO) and (base.enum<>R_NO) then
            if (index.enum=R_NO) and (base.enum<>R_NO) then
              begin
              begin
                 if offset=0 then
                 if offset=0 then
@@ -192,7 +192,7 @@ unit agppcgas;
            else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then
            else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then
              s:=s+gas_reg2str[base.enum]+','+gas_reg2str[index.enum]
              s:=s+gas_reg2str[base.enum]+','+gas_reg2str[index.enum]
            else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then
            else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then
-            internalerror(19992);
+             internalerror(19992);
         end;
         end;
       getreferencestring:=s;
       getreferencestring:=s;
     end;
     end;
@@ -364,6 +364,9 @@ unit agppcgas;
                 sep:=#9;
                 sep:=#9;
               for i:=0 to taicpu(hp).ops-1 do
               for i:=0 to taicpu(hp).ops-1 do
                 begin
                 begin
+                   // debug code
+                   // writeln(s);
+                   // writeln(taicpu(hp).fileinfo.line);
                    s:=s+sep+getopstr(taicpu(hp).oper[i]);
                    s:=s+sep+getopstr(taicpu(hp).oper[i]);
                    sep:=',';
                    sep:=',';
                 end;
                 end;
@@ -377,7 +380,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.21  2003-03-12 22:43:38  jonas
+  Revision 1.22  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.21  2003/03/12 22:43:38  jonas
     * more powerpc and generic fixes related to the new register allocator
     * more powerpc and generic fixes related to the new register allocator
 
 
   Revision 1.20  2003/01/08 18:43:57  daniel
   Revision 1.20  2003/01/08 18:43:57  daniel

+ 130 - 3
compiler/powerpc/cgcpu.pas

@@ -76,7 +76,7 @@ unit cgcpu;
 
 
         procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
         procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
 
 
-
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
         procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
         procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
         procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
         procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
         procedure g_restore_frame_pointer(list : taasmoutput);override;
         procedure g_restore_frame_pointer(list : taasmoutput);override;
@@ -958,7 +958,7 @@ const
         { following is the entry code as described in "Altivec Programming }
         { following is the entry code as described in "Altivec Programming }
         { Interface Manual", bar the saving of AltiVec registers           }
         { Interface Manual", bar the saving of AltiVec registers           }
         rsp.enum:=R_INTREGISTER;
         rsp.enum:=R_INTREGISTER;
-        rsp.number:=NR_STACK_POINTER_REG;;
+        rsp.number:=NR_STACK_POINTER_REG;
         a_reg_alloc(list,rsp);
         a_reg_alloc(list,rsp);
         r.enum:=R_INTREGISTER;
         r.enum:=R_INTREGISTER;
         r.number:=NR_R0;
         r.number:=NR_R0;
@@ -1824,6 +1824,128 @@ const
          free_scratch_reg(list,dst.base);
          free_scratch_reg(list,dst.base);
       end;
       end;
 
 
+    procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
+      var
+        lenref : treference;
+        power,len  : longint;
+{$ifndef __NOWINPECOFF__}
+        again,ok : tasmlabel;
+{$endif}
+        r,r2,rsp:Tregister;
+      begin
+         {$warning !!!! FIX ME !!!!}
+{!!!!
+        lenref:=ref;
+        inc(lenref.offset,4);
+        { get stack space }
+        r.enum:=R_INTREGISTER;
+        r.number:=NR_EDI;
+        rsp.enum:=R_INTREGISTER;
+        rsp.number:=NR_ESP;
+        r2.enum:=R_INTREGISTER;
+        rg.getexplicitregisterint(list,NR_EDI);
+        list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
+        list.concat(Taicpu.op_reg(A_INC,S_L,r));
+        if (elesize<>1) then
+         begin
+           if ispowerof2(elesize, power) then
+             list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
+           else
+             list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
+         end;
+{$ifndef __NOWINPECOFF__}
+        { windows guards only a few pages for stack growing, }
+        { so we have to access every page first              }
+        if target_info.system=system_i386_win32 then
+          begin
+             objectlibrary.getlabel(again);
+             objectlibrary.getlabel(ok);
+             a_label(list,again);
+             list.concat(Taicpu.op_const_reg(A_CMP,S_L,winstackpagesize,r));
+             a_jmp_cond(list,OC_B,ok);
+             list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,rsp));
+             r2.number:=NR_EAX;
+             list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
+             list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize,r));
+             a_jmp_always(list,again);
+
+             a_label(list,ok);
+             list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
+             rg.ungetregisterint(list,r);
+             { now reload EDI }
+             rg.getexplicitregisterint(list,NR_EDI);
+             list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
+             list.concat(Taicpu.op_reg(A_INC,S_L,r));
+
+             if (elesize<>1) then
+              begin
+                if ispowerof2(elesize, power) then
+                  list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
+                else
+                  list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
+              end;
+          end
+        else
+{$endif __NOWINPECOFF__}
+          list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
+        { align stack on 4 bytes }
+        list.concat(Taicpu.op_const_reg(A_AND,S_L,$fffffff4,rsp));
+        { load destination }
+        a_load_reg_reg(list,OS_INT,OS_INT,rsp,r);
+
+        { don't destroy the registers! }
+        r2.number:=NR_ECX;
+        list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
+        r2.number:=NR_ESI;
+        list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
+
+        { load count }
+        r2.number:=NR_ECX;
+        a_load_ref_reg(list,OS_INT,lenref,r2);
+
+        { load source }
+        r2.number:=NR_ESI;
+        a_load_ref_reg(list,OS_INT,ref,r2);
+
+        { scheduled .... }
+        r2.number:=NR_ECX;
+        list.concat(Taicpu.op_reg(A_INC,S_L,r2));
+
+        { calculate size }
+        len:=elesize;
+        opsize:=S_B;
+        if (len and 3)=0 then
+         begin
+           opsize:=S_L;
+           len:=len shr 2;
+         end
+        else
+         if (len and 1)=0 then
+          begin
+            opsize:=S_W;
+            len:=len shr 1;
+          end;
+
+        if ispowerof2(len, power) then
+          list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r2))
+        else
+          list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,r2));
+        list.concat(Taicpu.op_none(A_REP,S_NO));
+        case opsize of
+          S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
+          S_W : list.concat(Taicpu.Op_none(A_MOVSW,S_NO));
+          S_L : list.concat(Taicpu.Op_none(A_MOVSD,S_NO));
+        end;
+        rg.ungetregisterint(list,r);
+        r2.number:=NR_ESI;
+        list.concat(Taicpu.op_reg(A_POP,S_L,r2));
+        r2.number:=NR_ECX;
+        list.concat(Taicpu.op_reg(A_POP,S_L,r2));
+
+        { patch the new address }
+        a_load_reg_ref(list,OS_INT,rsp,ref);
+!!!!}
+      end;
 
 
     procedure tcgppc.g_overflowcheck(list: taasmoutput; const p: tnode);
     procedure tcgppc.g_overflowcheck(list: taasmoutput; const p: tnode);
 
 
@@ -2215,7 +2337,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.78  2003-04-16 09:26:55  jonas
+  Revision 1.79  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.78  2003/04/16 09:26:55  jonas
     * assembler procedures now again get a stackframe if they have local
     * assembler procedures now again get a stackframe if they have local
       variables. No space is reserved for a function result however.
       variables. No space is reserved for a function result however.
       Also, the register parameters aren't automatically saved on the stack
       Also, the register parameters aren't automatically saved on the stack

+ 10 - 32
compiler/powerpc/cpubase.pas

@@ -395,33 +395,6 @@ uses
 *****************************************************************************}
 *****************************************************************************}
 
 
     type
     type
-      TLoc=(
-        { added for tracking problems}
-        LOC_INVALID,
-        { ordinal constant }
-        LOC_CONSTANT,
-        { in a processor register }
-        LOC_REGISTER,
-        { Constant register which shouldn't be modified }
-        LOC_CREGISTER,
-        { FPU register}
-        LOC_FPUREGISTER,
-        { Constant FPU register which shouldn't be modified }
-        LOC_CFPUREGISTER,
-        { multimedia register }
-        LOC_MMREGISTER,
-        { Constant multimedia reg which shouldn't be modified }
-        LOC_CMMREGISTER,
-        { in memory }
-        LOC_REFERENCE,
-        { in memory (constant) }
-        LOC_CREFERENCE,
-        { boolean results only, jump to false or true label }
-        LOC_JUMP,
-        { boolean results only, flags are set }
-        LOC_FLAGS
-      );
-
       { tparamlocation describes where a parameter for a procedure is stored.
       { tparamlocation describes where a parameter for a procedure is stored.
         References are given from the caller's point of view. The usual
         References are given from the caller's point of view. The usual
         TLocation isn't used, because contains a lot of unnessary fields.
         TLocation isn't used, because contains a lot of unnessary fields.
@@ -431,7 +404,7 @@ uses
          { The location type where the parameter is passed, usually
          { The location type where the parameter is passed, usually
            LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
            LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
          }
          }
-         loc  : TLoc;
+         loc  : TCGLoc;
          { The stack pointer must be decreased by this value before
          { The stack pointer must be decreased by this value before
            the parameter is copied to the given destination.
            the parameter is copied to the given destination.
            This allows to "encode" pushes with tparalocation.
            This allows to "encode" pushes with tparalocation.
@@ -439,7 +412,7 @@ uses
            because several generic code accesses it.
            because several generic code accesses it.
          }
          }
          sp_fixup : longint;
          sp_fixup : longint;
-         case TLoc of
+         case TCGLoc of
             LOC_REFERENCE : (reference : tparareference);
             LOC_REFERENCE : (reference : tparareference);
             LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
             LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
               LOC_REGISTER,LOC_CREGISTER : (
               LOC_REGISTER,LOC_CREGISTER : (
@@ -466,8 +439,8 @@ uses
 
 
       tlocation = packed record
       tlocation = packed record
          size : TCGSize;
          size : TCGSize;
-         loc : tloc;
-         case tloc of
+         loc : tcgloc;
+         case tcgloc of
             LOC_CREFERENCE,LOC_REFERENCE : (reference : treference);
             LOC_CREFERENCE,LOC_REFERENCE : (reference : treference);
             LOC_CONSTANT : (
             LOC_CONSTANT : (
               case longint of
               case longint of
@@ -879,7 +852,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.47  2003-04-22 11:27:48  florian
+  Revision 1.48  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.47  2003/04/22 11:27:48  florian
     + added first_ and last_imreg
     + added first_ and last_imreg
 
 
   Revision 1.46  2003/03/19 14:26:26  jonas
   Revision 1.46  2003/03/19 14:26:26  jonas

+ 8 - 3
compiler/powerpc/cpupara.pas

@@ -67,7 +67,7 @@ unit cpupara;
            end;
            end;
       end;
       end;
 
 
-    function getparaloc(p : tdef) : tloc;
+    function getparaloc(p : tdef) : tcgloc;
 
 
       begin
       begin
          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
@@ -129,7 +129,7 @@ unit cpupara;
          paradef : tdef;
          paradef : tdef;
          stack_offset : aword;
          stack_offset : aword;
          hp : tparaitem;
          hp : tparaitem;
-         loc : tloc;
+         loc : tcgloc;
          is_64bit: boolean;
          is_64bit: boolean;
 
 
       procedure assignintreg;
       procedure assignintreg;
@@ -301,7 +301,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.25  2003-04-17 18:52:35  jonas
+  Revision 1.26  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.25  2003/04/17 18:52:35  jonas
     * process para's from first to last instead of the other way round
     * process para's from first to last instead of the other way round
 
 
   Revision 1.24  2003/04/16 07:55:07  jonas
   Revision 1.24  2003/04/16 07:55:07  jonas

+ 7 - 2
compiler/powerpc/nppcadd.pas

@@ -73,7 +73,7 @@ interface
             result := nil;
             result := nil;
             firstpass(left);
             firstpass(left);
             firstpass(right);
             firstpass(right);
-            location.loc := LOC_FLAGS;
+            expectloc := LOC_FLAGS;
             calcregisters(self,2,0,0);
             calcregisters(self,2,0,0);
             exit;
             exit;
           end;
           end;
@@ -1479,7 +1479,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.24  2003-03-11 21:46:24  jonas
+  Revision 1.25  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.24  2003/03/11 21:46:24  jonas
     * lots of new regallocator fixes, both in generic and ppc-specific code
     * lots of new regallocator fixes, both in generic and ppc-specific code
       (ppc compiler still can't compile the linux system unit though)
       (ppc compiler still can't compile the linux system unit though)
 
 

+ 24 - 14
compiler/powerpc/nppccal.pas

@@ -72,38 +72,43 @@ implementation
     end;
     end;
 
 
   procedure tppccallnode.push_framepointer;
   procedure tppccallnode.push_framepointer;
-
+    var
+       href : treference;
+       hregister1,hregister2 : tregister;
+       i : longint;
     begin
     begin
-       {
        if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
        if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
          begin
          begin
-            reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
-            cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getframepointerloc(procinfo.procdef));
+            { pass the same framepointer as the current procedure got }
+            hregister2.enum:=R_INTREGISTER;
+            hregister2.number:=NR_R11;
+            cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,procinfo.framepointer,hregister2);
+            { it must be adjusted! }
          end
          end
          { this is only true if the difference is one !!
          { this is only true if the difference is one !!
            but it cannot be more !! }
            but it cannot be more !! }
        else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
        else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
          begin
          begin
-            cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,paramanager.getframepointerloc(procinfo.procdef));
+            // cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paramanager.getframepointerloc(procinfo.procdef));
          end
          end
        else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
        else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
          begin
          begin
-            hregister:=rg.getregisterint(exprasmlist);
-            reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
-            cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+            hregister1:=rg.getregisterint(exprasmlist,OS_ADDR);
+            reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
+            cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
             for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
             for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
               begin
               begin
                  {we should get the correct frame_pointer_offset at each level
                  {we should get the correct frame_pointer_offset at each level
                  how can we do this !!! }
                  how can we do this !!! }
-                 reference_reset_base(href,hregister,procinfo^.framepointer_offset);
-                 cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                 reference_reset_base(href,hregister2,procinfo.framepointer_offset);
+                 cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
               end;
               end;
-            cg.a_param_reg(exprasmlist,OS_ADDR,hregister,-1);
-            rg.ungetregisterint(exprasmlist,hregister);
+            hregister2.enum:=R_11;
+            cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,hregister1,hregister2);
+            rg.ungetregisterint(exprasmlist,hregister1);
          end
          end
        else
        else
          internalerror(2002081303);
          internalerror(2002081303);
-       }
     end;
     end;
 
 
 begin
 begin
@@ -111,7 +116,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2003-04-04 15:38:56  peter
+  Revision 1.6  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.5  2003/04/04 15:38:56  peter
     * moved generic code from n386cal to ncgcal, i386 now also
     * moved generic code from n386cal to ncgcal, i386 now also
       uses the generic ncgcal
       uses the generic ncgcal
 
 

+ 7 - 2
compiler/powerpc/nppccnv.pas

@@ -272,7 +272,7 @@ implementation
       begin
       begin
          { byte(boolean) or word(wordbool) or longint(longbool) must }
          { byte(boolean) or word(wordbool) or longint(longbool) must }
          { be accepted for var parameters                            }
          { be accepted for var parameters                            }
-         if (nf_explizit in flags) and
+         if (nf_explicit in flags) and
             (left.resulttype.def.size=resulttype.def.size) and
             (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
             (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
            begin
            begin
@@ -394,7 +394,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.30  2003-03-11 21:46:24  jonas
+  Revision 1.31  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.30  2003/03/11 21:46:24  jonas
     * lots of new regallocator fixes, both in generic and ppc-specific code
     * lots of new regallocator fixes, both in generic and ppc-specific code
       (ppc compiler still can't compile the linux system unit though)
       (ppc compiler still can't compile the linux system unit though)
 
 

+ 12 - 4
compiler/powerpc/nppcinl.pas

@@ -64,7 +64,7 @@ implementation
 
 
      function tppcinlinenode.first_abs_real : tnode;
      function tppcinlinenode.first_abs_real : tnode;
       begin
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
@@ -75,7 +75,7 @@ implementation
 
 
      function tppcinlinenode.first_sqr_real : tnode;
      function tppcinlinenode.first_sqr_real : tnode;
       begin
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
@@ -86,7 +86,7 @@ implementation
 
 
      function tppcinlinenode.first_sqrt_real : tnode;
      function tppcinlinenode.first_sqrt_real : tnode;
       begin
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
@@ -126,6 +126,7 @@ implementation
 
 
      procedure tppcinlinenode.second_abs_real;
      procedure tppcinlinenode.second_abs_real;
        begin
        begin
+         location.loc:=LOC_FPUREGISTER;
          load_fpu_location;
          load_fpu_location;
          exprasmlist.concat(taicpu.op_reg_reg(A_FABS,location.register,
          exprasmlist.concat(taicpu.op_reg_reg(A_FABS,location.register,
            left.location.register));
            left.location.register));
@@ -133,6 +134,7 @@ implementation
 
 
      procedure tppcinlinenode.second_sqr_real;
      procedure tppcinlinenode.second_sqr_real;
        begin
        begin
+         location.loc:=LOC_FPUREGISTER;
          load_fpu_location;
          load_fpu_location;
          exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMUL,location.register,
          exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMUL,location.register,
            left.location.register,left.location.register));
            left.location.register,left.location.register));
@@ -140,6 +142,7 @@ implementation
 
 
      procedure tppcinlinenode.second_sqrt_real;
      procedure tppcinlinenode.second_sqrt_real;
        begin
        begin
+         location.loc:=LOC_FPUREGISTER;
          load_fpu_location;
          load_fpu_location;
          exprasmlist.concat(taicpu.op_reg_reg(A_FSQRT,location.register,
          exprasmlist.concat(taicpu.op_reg_reg(A_FSQRT,location.register,
            left.location.register));
            left.location.register));
@@ -150,7 +153,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2002-11-25 17:43:28  peter
+  Revision 1.5  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.4  2002/11/25 17:43:28  peter
     * splitted defbase in defutil,symutil,defcmp
     * splitted defbase in defutil,symutil,defcmp
     * merged isconvertable and is_equal into compare_defs(_ext)
     * merged isconvertable and is_equal into compare_defs(_ext)
     * made operator search faster by walking the list only once
     * made operator search faster by walking the list only once

+ 7 - 2
compiler/psub.pas

@@ -329,7 +329,7 @@ implementation
 
 
          {When we are called to compile the body of a unit, aktprocsym should
          {When we are called to compile the body of a unit, aktprocsym should
           point to the unit initialization. If the unit has no initialization,
           point to the unit initialization. If the unit has no initialization,
-          aktprocsym=nil. But in that case code=nil. hus we should check for
+          aktprocsym=nil. But in that case code=nil. Thus we should check for
           code=nil, when we use aktprocsym.}
           code=nil, when we use aktprocsym.}
 
 
          { set the start offset to the start of the temp area in the stack }
          { set the start offset to the start of the temp area in the stack }
@@ -884,7 +884,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.101  2003-04-22 14:33:38  peter
+  Revision 1.102  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.101  2003/04/22 14:33:38  peter
     * removed some notes/hints
     * removed some notes/hints
 
 
   Revision 1.100  2003/04/22 13:47:08  peter
   Revision 1.100  2003/04/22 13:47:08  peter

+ 16 - 27
compiler/sparc/cpubase.pas

@@ -281,7 +281,7 @@ const
   {Subregisters; nothing known about.}
   {Subregisters; nothing known about.}
   R_SUBWHOLE=$00;
   R_SUBWHOLE=$00;
   R_SUBL=$00;
   R_SUBL=$00;
-  
+
 type
 type
   reg2strtable=ARRAY[TOldRegister] OF STRING[7];
   reg2strtable=ARRAY[TOldRegister] OF STRING[7];
 
 
@@ -366,30 +366,14 @@ TYPE
                                Generic Location
                                Generic Location
 *****************************************************************************}
 *****************************************************************************}
 TYPE
 TYPE
-  TLoc=(              {information about the location of an operand}
-    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 }
-    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_MMXREGISTER,  { MMX register }
-    LOC_CMMXREGISTER, { MMX register variable }
-    LOC_MMREGISTER,
-    LOC_CMMREGISTER
-  );
 {tparamlocation describes where a parameter for a procedure is stored.
 {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
 References are given from the caller's point of view. The usual TLocation isn't
 used, because contains a lot of unnessary fields.}
 used, because contains a lot of unnessary fields.}
   TParaLocation=PACKED RECORD
   TParaLocation=PACKED RECORD
     Size:TCGSize;
     Size:TCGSize;
-    Loc:TLoc;
+    Loc:TCGLoc;
     sp_fixup:LongInt;
     sp_fixup:LongInt;
-    CASE TLoc OF
+    CASE TCGLoc OF
       LOC_REFERENCE:(reference:tparareference);
       LOC_REFERENCE:(reference:tparareference);
             { segment in reference at the same place as in loc_register }
             { segment in reference at the same place as in loc_register }
       LOC_REGISTER,LOC_CREGISTER : (
       LOC_REGISTER,LOC_CREGISTER : (
@@ -405,9 +389,9 @@ used, because contains a lot of unnessary fields.}
       LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
       LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
     END;
     END;
     TLocation=PACKED RECORD
     TLocation=PACKED RECORD
-         loc  : TLoc;
+         loc  : TCGLoc;
          size : TCGSize;
          size : TCGSize;
-         case TLoc of
+         case TCGLoc of
             LOC_FLAGS : (resflags : tresflags);
             LOC_FLAGS : (resflags : tresflags);
             LOC_CONSTANT : (
             LOC_CONSTANT : (
               case longint of
               case longint of
@@ -455,13 +439,13 @@ const
   mmregs=[];
   mmregs=[];
   usableregsmm=[];
   usableregsmm=[];
   c_countusableregsmm=0;
   c_countusableregsmm=0;
-  { no distinction on this platform }      
+  { no distinction on this platform }
   maxaddrregs = 0;
   maxaddrregs = 0;
   addrregs    = [];
   addrregs    = [];
   usableregsaddr = [];
   usableregsaddr = [];
   c_countusableregsaddr = 0;
   c_countusableregsaddr = 0;
-  
-  
+
+
   firstsaveintreg = RS_O0;
   firstsaveintreg = RS_O0;
   lastsaveintreg = RS_I7;
   lastsaveintreg = RS_I7;
   firstsavefpureg = R_F0;
   firstsavefpureg = R_F0;
@@ -591,8 +575,8 @@ const
   max_operands = 3;
   max_operands = 3;
   maxintregs = maxvarregs;
   maxintregs = maxvarregs;
   maxfpuregs = maxfpuvarregs;
   maxfpuregs = maxfpuvarregs;
-  
-  
+
+
 
 
 FUNCTION is_calljmp(o:tasmop):boolean;
 FUNCTION is_calljmp(o:tasmop):boolean;
 FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
 FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
@@ -676,7 +660,12 @@ END.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.25  2003-03-10 21:59:54  mazen
+  Revision 1.26  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.25  2003/03/10 21:59:54  mazen
   * fixing index overflow in handling new registers arrays.
   * fixing index overflow in handling new registers arrays.
 
 
   Revision 1.24  2003/02/26 22:06:27  mazen
   Revision 1.24  2003/02/26 22:06:27  mazen

+ 8 - 3
compiler/sparc/cpupara.pas

@@ -63,7 +63,7 @@ function TSparcParaManager.GetIntParaLoc(nr:longint):TParaLocation;
           reference.offset:=-68-nr*4;
           reference.offset:=-68-nr*4;
         end;
         end;
   end;
   end;
-function GetParaLoc(p:TDef):TLoc;
+function GetParaLoc(p:TDef):TCGLoc;
   begin
   begin
 {Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER if
 {Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER if
 push_addr_param for the def is true}
 push_addr_param for the def is true}
@@ -124,7 +124,7 @@ procedure TSparcParaManager.create_param_loc_info(p:TAbstractProcDef);
     nextintreg,nextfloatreg:tregister;
     nextintreg,nextfloatreg:tregister;
     stack_offset:aword;
     stack_offset:aword;
     hp:tparaitem;
     hp:tparaitem;
-    loc:tloc;
+    loc:tcgloc;
     is_64bit:boolean;
     is_64bit:boolean;
   begin
   begin
     nextintreg.enum:=R_O0;
     nextintreg.enum:=R_O0;
@@ -281,7 +281,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.14  2003-01-08 18:43:58  daniel
+  Revision 1.15  2003-04-23 12:35:35  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.14  2003/01/08 18:43:58  daniel
    * Tregister changed into a record
    * Tregister changed into a record
 
 
   Revision 1.13  2003/01/05 21:32:35  mazen
   Revision 1.13  2003/01/05 21:32:35  mazen

+ 21 - 6
compiler/symdef.pas

@@ -687,11 +687,19 @@ interface
        ordpointertype,
        ordpointertype,
        pvmttype      : ttype;     { type of classrefs, used for stabs }
        pvmttype      : ttype;     { type of classrefs, used for stabs }
 
 
-
-       class_tobject : tobjectdef;      { pointer to the anchestor of all classes }
-       interface_iunknown : tobjectdef; { KAZ: pointer to the ancestor }
-       rec_tguid : trecorddef;          { KAZ: pointer to the TGUID type }
-                                        { of all interfaces            }
+       { pointer to the anchestor of all classes }
+       class_tobject : tobjectdef;
+       { pointer to the ancestor of all COM interfaces }
+       interface_iunknown : tobjectdef;
+       { pointer to the TGUID type
+         of all interfaces         }
+       rec_tguid : trecorddef;
+
+       { Pointer to a procdef with no parameters and no return value.
+         This is used for procedures which are generated automatically
+         by the compiler.
+       }
+       voidprocdef : tprocdef;
 
 
     const
     const
 {$ifdef i386}
 {$ifdef i386}
@@ -5706,10 +5714,17 @@ implementation
           (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba]);
           (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba]);
       end;
       end;
 
 
+begin
+   voidprocdef:=tprocdef.create;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.133  2003-04-10 17:57:53  peter
+  Revision 1.134  2003-04-23 12:35:34  florian
+    * fixed several issues with powerpc
+    + applied a patch from Jonas for nested function calls (PowerPC only)
+    * ...
+
+  Revision 1.133  2003/04/10 17:57:53  peter
     * vs_hidden released
     * vs_hidden released
 
 
   Revision 1.132  2003/03/18 16:25:50  peter
   Revision 1.132  2003/03/18 16:25:50  peter