* first part of procinfo rewrite

compiler/cgbase.pas

@@ -63,10 +63,9 @@ unit cgbase;
        {# This object gives information on the current routine being
           compiled.
        }
-       pprocinfo = ^tprocinfo;
-       tprocinfo = object
-          {# pointer to parent in nested procedures }
-          parent : pprocinfo;
+       tprocinfo = class
+          { pointer to parent in nested procedures }
+          parent : tprocinfo;
           {# current class, if we are in a method }
           _class : tobjectdef;
           {# the definition of the routine itself }
@@ -126,12 +125,6 @@ unit cgbase;
           }
           exception_result_ref :treference;
 
-          { overall size of allocated stack space, currently this is used for the PowerPC only }
-          localsize : aword;
-
-          { max. of space need for parameters, currently used by the PowerPC port only }
-          maxpushedparasize : aword;
-
           {# Holds the reference used to store alll saved registers.
 
              This is used on systems which do not have direct stack
@@ -151,8 +144,30 @@ unit cgbase;
           aktexitcode: taasmoutput;
           aktlocaldata : taasmoutput;
 
-          constructor init;
-          destructor done;
+          constructor create;virtual;
+          destructor destroy;override;
+
+          procedure allocate_interrupt_stackframe;virtual;
+
+          { Updates usedinproc depending on the resulttype }
+          procedure update_usedinproc_result;virtual;
+
+          { Does the necessary stuff before a procedure body is compiled }
+          procedure handle_body_start;virtual;
+
+          { This is called by parser, after the header of a subroutine is parsed.
+            If the local symtable offset depends on the para symtable size, the
+            necessary stuff must be done here.
+          }
+          procedure after_header;virtual;
+
+          { This procedure is called after the pass 1 of the subroutine body is done.
+            Here the address fix ups to generate code for the body must be done.
+          }
+          procedure after_pass1;virtual;
+
+          { sets the offset for a temp used by the result }
+          procedure set_result_offset;virtual;
        end;
 
        pregvarinfo = ^tregvarinfo;
@@ -169,7 +184,9 @@ unit cgbase;
 
     var
        {# information about the current sub routine being parsed (@var(pprocinfo))}
-       procinfo : pprocinfo;
+       procinfo : tprocinfo;
+
+       cprocinfo : class of tprocinfo;
 
        { labels for BREAK and CONTINUE }
        aktbreaklabel,aktcontinuelabel : tasmlabel;
@@ -237,7 +254,7 @@ implementation
 {$ifdef fixLeaksOnError}
         ,comphook
 {$endif fixLeaksOnError}
-
+        ,symbase,paramgr
         ;
 
 {$ifdef fixLeaksOnError}
@@ -351,7 +368,7 @@ implementation
                                  TProcInfo
 ****************************************************************************}
 
-    constructor tprocinfo.init;
+    constructor tprocinfo.create;
       begin
         parent:=nil;
         _class:=nil;
@@ -366,8 +383,6 @@ implementation
         globalsymbol:=false;
         exported:=false;
         no_fast_exit:=false;
-        maxpushedparasize:=0;
-        localsize:=0;
 
         aktentrycode:=Taasmoutput.Create;
         aktexitcode:=Taasmoutput.Create;
@@ -379,7 +394,7 @@ implementation
       end;
 
 
-    destructor tprocinfo.done;
+    destructor tprocinfo.destroy;
       begin
          aktentrycode.free;
          aktexitcode.free;
@@ -387,6 +402,64 @@ implementation
          aktlocaldata.free;
       end;
 
+    procedure tprocinfo.allocate_interrupt_stackframe;
+      begin
+      end;
+
+
+    procedure tprocinfo.handle_body_start;
+      begin
+         { temporary space is set, while the BEGIN of the procedure }
+         if (symtablestack.symtabletype=localsymtable) then
+           procinfo.firsttemp_offset := -symtablestack.datasize
+         else
+           procinfo.firsttemp_offset := 0;
+         { space for the return value }
+         { !!!!!   this means that we can not set the return value
+         in a subfunction !!!!! }
+         { because we don't know yet where the address is }
+         if not is_void(aktprocdef.rettype.def) then
+           begin
+              if paramanager.ret_in_reg(aktprocdef) then
+                begin
+                   { the space has been set in the local symtable }
+                   procinfo.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
+                   if ((procinfo.flags and pi_operator)<>0) and
+                      assigned(otsym) then
+                     otsym.address:=-procinfo.return_offset;
+
+		   rg.usedinproc := rg.usedinproc +	
+                      getfuncretusedregisters(aktprocdef.rettype.def);
+                end;
+           end;
+
+      end;
+
+    { updates usedinproc depending on the resulttype }
+    procedure tprocinfo.update_usedinproc_result;
+      begin
+         if paramanager.ret_in_reg(procdef.rettype.def) then
+           begin
+              rg.usedinproc := rg.usedinproc +
+              getfuncretusedregisters(procdef.rettype.def);
+           end;
+      end;
+
+    procedure tprocinfo.set_result_offset;
+      begin
+         if paramanager.ret_in_reg(aktprocdef) then
+           procinfo.return_offset:=-tfuncretsym(procdef.funcretsym).address;
+      end;
+
+
+    procedure tprocinfo.after_header;
+      begin
+      end;
+
+    procedure tprocinfo.after_pass1;
+      begin
+      end;
+
 
 {*****************************************************************************
          initialize/terminate the codegen for procedure and modules
@@ -399,7 +472,7 @@ implementation
          { aktexitlabel:=0; is store in oldaktexitlabel
            so it must not be reset to zero before this storage !}
          { new procinfo }
-         new(procinfo,init);
+         procinfo:=cprocinfo.create;
 {$ifdef fixLeaksOnError}
          procinfoStack.push(procinfo);
 {$endif fixLeaksOnError}
@@ -413,7 +486,7 @@ implementation
          if procinfo <> procinfoStack.pop then
            writeln('problem with procinfoStack!');
 {$endif fixLeaksOnError}
-         dispose(procinfo,done);
+         procinfo.free;
          procinfo:=nil;
       end;
 
@@ -582,7 +655,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2002-08-11 14:32:26  peter
+  Revision 1.25  2002-08-17 09:23:33  florian
+    * first part of procinfo rewrite
+
+  Revision 1.24  2002/08/11 14:32:26  peter
     * renamed current_library to objectlibrary
 
   Revision 1.23  2002/08/11 13:24:11  peter

compiler/cgobj.pas

@@ -101,7 +101,7 @@ unit cgobj;
           {# Pass a parameter, which is located in a register, to a routine.
 
              This routine should push/send the parameter to the routine, as
-             required by the specific processor ABI and routine modifiers. 
+             required by the specific processor ABI and routine modifiers.
              This must be overriden for each CPU target.
 
              @param(size size of the operand in the register)
@@ -244,16 +244,16 @@ unit cgobj;
           procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
           procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
 
-          { 
+          {
              This routine tries to optimize the const_reg opcode, and should be
              called at the start of a_op_const_reg. It returns the actual opcode
              to emit, and the constant value to emit. If this routine returns
              FALSE, no instruction should be emitted (.eg : imul reg by 1 )
-             
+
              @param(op The opcode to emit, returns the opcode which must be emitted)
              @param(a  The constant which should be emitted, returns the constant which must
                     be amitted)
-          }   
+          }
           function optimize_const_reg(var op: topcg; var a : aword): boolean;virtual;
 
          {#
@@ -385,28 +385,24 @@ unit cgobj;
           {# This routine is called when generating the code for the entry point
              of a routine. It should save all registers which are not used in this
              routine, and which should be declared as saved in the std_saved_registers
-             set. 
-             
+             set.
+
              This routine is mainly used when linking to code which is generated
              by ABI-compliant compilers (like GCC), to make sure that the reserved
              registers of that ABI are not clobbered.
-             
+
              @param(usedinproc Registers which are used in the code of this routine)
-          }             
+          }
           procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);virtual;abstract;
           {# This routine is called when generating the code for the exit point
-             of a routine. It should restore all registers which were previously 
+             of a routine. It should restore all registers which were previously
              saved in @var(g_save_standard_registers).
 
              @param(usedinproc Registers which are used in the code of this routine)
-          }             
+          }
           procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);virtual;abstract;
           procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);virtual;abstract;
-          {# This routine verifies if two references are the same, and
-             if so, returns TRUE, otherwise returns false.
-          }
-          function issameref(const sref, dref : treference):boolean; 
        end;
 
     {# @abstract(Abstract code generator for 64 Bit operations)
@@ -639,7 +635,7 @@ unit cgobj;
 
       begin
         { verify if we have the same reference }
-        if issameref(sref,dref) then
+        if references_equal(sref,dref) then
           exit;
 {$ifdef i386}
         { the following is done with defines to avoid a speed penalty,  }
@@ -761,7 +757,7 @@ unit cgobj;
         powerval : longint;
       begin
         optimize_const_reg := true;
-        case op of 
+        case op of
           { or with zero returns same result }
           OP_OR : if a = 0 then optimize_const_reg := false;
           { and with max returns same result }
@@ -769,10 +765,10 @@ unit cgobj;
           { division by 1 returns result }
           OP_DIV :
             begin
-              if a = 1 then 
+              if a = 1 then
                 optimize_const_reg := false
               else if ispowerof2(int64(a), powerval) then
-                begin 
+                begin
                   a := powerval;
                   op:= OP_SHR;
                 end;
@@ -780,10 +776,10 @@ unit cgobj;
             end;
           OP_IDIV:
             begin
-              if a = 1 then 
+              if a = 1 then
                 optimize_const_reg := false
               else if ispowerof2(int64(a), powerval) then
-                begin 
+                begin
                   a := powerval;
                   op:= OP_SAR;
                 end;
@@ -791,22 +787,22 @@ unit cgobj;
             end;
         OP_MUL,OP_IMUL:
             begin
-               if a = 1 then 
+               if a = 1 then
                   optimize_const_reg := false
                else if ispowerof2(int64(a), powerval) then
-                 begin 
+                 begin
                    a := powerval;
                    op:= OP_SHL;
                  end;
-               exit;  
+               exit;
             end;
         OP_SAR,OP_SHL,OP_SHR:
            begin
-              if a = 1 then 
+              if a = 1 then
                  optimize_const_reg := false;
               exit;
            end;
-        end;    
+        end;
       end;
 
     procedure tcg.a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
@@ -1319,29 +1315,29 @@ unit cgobj;
     procedure tcg.g_maybe_loadself(list : taasmoutput);
       var
          hp : treference;
-         p : pprocinfo;
+         p : tprocinfo;
          i : longint;
       begin
-         if assigned(procinfo^._class) then
+         if assigned(procinfo._class) then
            begin
               list.concat(tai_regalloc.Alloc(SELF_POINTER_REG));
               if lexlevel>normal_function_level then
                 begin
-                   reference_reset_base(hp,procinfo^.framepointer,procinfo^.framepointer_offset);
+                   reference_reset_base(hp,procinfo.framepointer,procinfo.framepointer_offset);
                    a_load_ref_reg(list,OS_ADDR,hp,SELF_POINTER_REG);
-                   p:=procinfo^.parent;
+                   p:=procinfo.parent;
                    for i:=3 to lexlevel-1 do
                      begin
-                        reference_reset_base(hp,SELF_POINTER_REG,p^.framepointer_offset);
+                        reference_reset_base(hp,SELF_POINTER_REG,p.framepointer_offset);
                         a_load_ref_reg(list,OS_ADDR,hp,SELF_POINTER_REG);
-                        p:=p^.parent;
+                        p:=p.parent;
                      end;
-                   reference_reset_base(hp,SELF_POINTER_REG,p^.selfpointer_offset);
+                   reference_reset_base(hp,SELF_POINTER_REG,p.selfpointer_offset);
                    a_load_ref_reg(list,OS_ADDR,hp,SELF_POINTER_REG);
                 end
               else
                 begin
-                   reference_reset_base(hp,procinfo^.framepointer,procinfo^.selfpointer_offset);
+                   reference_reset_base(hp,procinfo.framepointer,procinfo.selfpointer_offset);
                    a_load_ref_reg(list,OS_ADDR,hp,SELF_POINTER_REG);
                 end;
            end;
@@ -1357,17 +1353,17 @@ unit cgobj;
       href : treference;
       hregister : tregister;
      begin
-        if is_class(procinfo^._class) then
+        if is_class(procinfo._class) then
           begin
-            procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+            procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
             { parameter 2 : self pointer / flag }
             {!! this is a terrible hack, normally the helper should get three params : }
             {    one with self register, one with flag and one with VMT pointer        }
-            {reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset+POINTER_SIZE);}
+            {reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset+POINTER_SIZE);}
             a_param_reg(list, OS_ADDR, SELF_POINTER_REG, paramanager.getintparaloc(2));
 
             { parameter 1 : vmt pointer (stored at the selfpointer address on stack)  }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_NEW_CLASS');
             a_load_reg_reg(list,OS_ADDR,accumulator,SELF_POINTER_REG);
@@ -1375,19 +1371,19 @@ unit cgobj;
             a_load_reg_ref(list,OS_ADDR,SELF_POINTER_REG,href);
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,accumulator,faillabel);
           end
-        else if is_object(procinfo^._class) then
+        else if is_object(procinfo._class) then
           begin
             { parameter 3 :vmt_offset     }
-            a_param_const(list, OS_32, procinfo^._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, procinfo._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : address of pointer to vmt }
             {  this is the first(?) parameter which was pushed to the constructor }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset-POINTER_SIZE);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
             a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(2));
             free_scratch_reg(list, hregister);
             { parameter 1 : address of self pointer   }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
             a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(1));
@@ -1407,37 +1403,37 @@ unit cgobj;
         href : treference;
       hregister : tregister;
       begin
-        if is_class(procinfo^._class) then
+        if is_class(procinfo._class) then
          begin
            { 2nd parameter  : flag }
-           reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset+POINTER_SIZE);
+           reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset+POINTER_SIZE);
            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
            { 1st parameter to destructor : self }
-           reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+           reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
            a_call_name(list,'FPC_DISPOSE_CLASS')
          end
-        else if is_object(procinfo^._class) then
+        else if is_object(procinfo._class) then
          begin
            { must the object be finalized ? }
-           if procinfo^._class.needs_inittable then
+           if procinfo._class.needs_inittable then
             begin
               objectlibrary.getlabel(nofinal);
-              reference_reset_base(href,procinfo^.framepointer,target_info.first_parm_offset);
+              reference_reset_base(href,procinfo.framepointer,target_info.first_parm_offset);
               a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
               reference_reset_base(href,SELF_POINTER_REG,0);
-              g_finalize(list,procinfo^._class,href,false);
+              g_finalize(list,procinfo._class,href,false);
               a_label(list,nofinal);
             end;
            { actually call destructor }
             { parameter 3 :vmt_offset     }
-            a_param_const(list, OS_32, procinfo^._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, procinfo._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : pointer to vmt }
             {  this is the first parameter which was pushed to the destructor }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset-POINTER_SIZE);
             a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(2));
             { parameter 1 : address of self pointer   }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
             a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(1));
@@ -1454,7 +1450,7 @@ unit cgobj;
         href : treference;
         hregister : tregister;
       begin
-        if is_class(procinfo^._class) then
+        if is_class(procinfo._class) then
           begin
             {
               Dispose of the class then set self_pointer to nil
@@ -1463,7 +1459,7 @@ unit cgobj;
             { 2nd parameter  : flag }
             a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
             { 1st parameter to destructor : self }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_DISPOSE_CLASS');
             { SET SELF TO NIL }
@@ -1471,19 +1467,19 @@ unit cgobj;
             { set the self pointer in the stack to nil }
             a_load_reg_ref(list,OS_ADDR,SELF_POINTER_REG,href);
           end
-        else if is_object(procinfo^._class) then
+        else if is_object(procinfo._class) then
           begin
             { parameter 3 :vmt_offset     }
-            a_param_const(list, OS_32, procinfo^._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, procinfo._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : address of pointer to vmt }
             {  this is the first(?) parameter which was pushed to the constructor }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset-POINTER_SIZE);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
             a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(2));
             free_scratch_reg(list, hregister);
             { parameter 1 : address of self pointer   }
-            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
             a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(1));
@@ -1517,27 +1513,19 @@ unit cgobj;
        a_load_reg_ref(exprasmlist, OS_S32, accumulator, href);
      end;
 
+
     procedure tcg.g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);
      begin
        a_load_const_ref(list, OS_S32, a, href);
      end;
 
+
     procedure tcg.g_exception_reason_load(list : taasmoutput; const href : treference);
      begin
        a_load_ref_reg(list, OS_S32, href, accumulator);
      end;
 
 
-    function tcg.issameref(const sref, dref : treference):boolean; 
-      begin
-        if CompareByte(sref,dref,sizeof(treference))=0 then
-          issameref := true
-        else
-          issameref := false;
-      end;
-
-
-
     procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
       begin
         a_load64_reg_reg(list,regsrc,regdst);
@@ -1560,7 +1548,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.50  2002-08-16 14:24:57  carl
+  Revision 1.51  2002-08-17 09:23:33  florian
+    * first part of procinfo rewrite
+
+  Revision 1.50  2002/08/16 14:24:57  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)

compiler/compiler.pas

@@ -125,6 +125,8 @@ uses
   ,cputarg
   { cpu parameter handling }
   ,cpupara
+  { procinfo stuff }
+  ,cpupi
   { system information for source system }
   { the information about the target os  }
   { are pulled in by the t_* units       }
@@ -391,7 +393,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.33  2002-07-26 21:15:37  florian
+  Revision 1.34  2002-08-17 09:23:34  florian
+    * first part of procinfo rewrite
+
+  Revision 1.33  2002/07/26 21:15:37  florian
     * rewrote the system handling
 
   Revision 1.32  2002/07/11 14:41:27  florian

compiler/i386/cpupi.pas

@@ -0,0 +1,60 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    This unit contains the CPU specific part of tprocinfo
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+{ This unit contains the CPU specific part of tprocinfo. }
+unit cpupi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cgbase;
+
+    type
+       ti386procinfo = class(tprocinfo)
+          procedure allocate_interrupt_stackframe;override;
+       end;
+
+
+  implementation
+
+    procedure ti386procinfo.allocate_interrupt_stackframe;
+
+      begin
+         { we push Flags and CS as long
+           to cope with the IRETD
+           and we save 6 register + 4 selectors }
+         inc(procinfo.para_offset,8+6*4+4*2);
+      end;
+
+begin
+   cprocinfo:=ti386procinfo;
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-17 09:23:44  florian
+    * first part of procinfo rewrite
+}
+
+

compiler/i386/csopt386.pas

@@ -352,8 +352,8 @@ Begin {CheckSequence}
   OrgRegResult := False;
   with startRegInfo do
     begin
-      newRegsEncountered := [procinfo^.FramePointer, STACK_POINTER_REG];
-      new2OldReg[procinfo^.FramePointer] := procinfo^.FramePointer;
+      newRegsEncountered := [procinfo.FramePointer, STACK_POINTER_REG];
+      new2OldReg[procinfo.FramePointer] := procinfo.FramePointer;
       new2OldReg[STACK_POINTER_REG] := STACK_POINTER_REG;
       oldRegsEncountered := newRegsEncountered;
     end;
@@ -399,11 +399,11 @@ Begin {CheckSequence}
                     if (found <> 0) and
                        ((base = R_NO) or
                         regModified[base] or
-                        (base = procinfo^.framepointer) or
-                        (assigned(procinfo^._class) and (base = R_ESI))) and
+                        (base = procinfo.framepointer) or
+                        (assigned(procinfo._class) and (base = R_ESI))) and
                        ((index = R_NO) or
                         regModified[index] or
-                        (assigned(procinfo^._class) and (index = R_ESI))) and
+                        (assigned(procinfo._class) and (index = R_ESI))) and
                         not(regInRef(tmpReg,Taicpu(hp3).oper[0].ref^)) then
                       with pTaiprop(hp3.optinfo)^.regs[tmpreg] do
                         if nrOfMods > (oldNrOfMods - found) then
@@ -1407,7 +1407,7 @@ begin
   for regcount := LoGPReg to HiGPReg do
     if assigned(pTaiProp(t1.optinfo)^.regs[regcount].memwrite) and
        (taicpu(pTaiProp(t1.optinfo)^.regs[regcount].memwrite).oper[1].ref^.base
-         = procinfo^.framepointer) then
+         = procinfo.framepointer) then
       begin
         pTaiProp(pTaiProp(t1.optinfo)^.regs[regcount].memwrite.optinfo)^.canberemoved := true;
         clearmemwrites(pTaiProp(t1.optinfo)^.regs[regcount].memwrite,regcount);
@@ -1553,7 +1553,7 @@ Begin
  { If some registers were different in the old and the new sequence, move }
  { the contents of those old registers to the new ones                    }
                                    For RegCounter := R_EAX To R_EDI Do
-                                     If Not(RegCounter in [R_ESP,procinfo^.framepointer]) And
+                                     If Not(RegCounter in [R_ESP,procinfo.framepointer]) And
                                         (RegInfo.New2OldReg[RegCounter] <> R_NO) Then
                                        Begin
                                          AllocRegBetween(AsmL,RegInfo.New2OldReg[RegCounter],
@@ -1984,7 +1984,10 @@ End.
 
 {
   $Log$
-  Revision 1.36  2002-07-01 18:46:31  peter
+  Revision 1.37  2002-08-17 09:23:44  florian
+    * first part of procinfo rewrite
+
+  Revision 1.36  2002/07/01 18:46:31  peter
     * internal linker
     * reorganized aasm layer
 

compiler/i386/daopt386.pas

@@ -1299,7 +1299,7 @@ Begin
           (Taicpu(p).opcode = A_LEA)) and
          (Taicpu(p).oper[0].typ = top_ref) Then
         With Taicpu(p).oper[0].ref^ Do
-          If ((Base = procinfo^.FramePointer) or
+          If ((Base = procinfo.FramePointer) or
               (assigned(symbol) and (base = R_NO))) And
              (Index = R_NO) Then
             Begin
@@ -1379,27 +1379,27 @@ Begin
     Begin
       Case Taicpu(p).oper[0].typ Of
         top_reg:
-          If Not(Taicpu(p).oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
+          If Not(Taicpu(p).oper[0].reg in [R_NO,R_ESP,procinfo.FramePointer]) Then
             RegSet := RegSet + [Taicpu(p).oper[0].reg];
         top_ref:
           With TReference(Taicpu(p).oper[0]^) Do
             Begin
-              If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
+              If Not(Base in [procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Base];
-              If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
+              If Not(Index in [procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Index];
             End;
       End;
       Case Taicpu(p).oper[1].typ Of
         top_reg:
-          If Not(Taicpu(p).oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
+          If Not(Taicpu(p).oper[1].reg in [R_NO,R_ESP,procinfo.FramePointer]) Then
             If RegSet := RegSet + [TRegister(TwoWords(Taicpu(p).oper[1]).Word1];
         top_ref:
           With TReference(Taicpu(p).oper[1]^) Do
             Begin
-              If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
+              If Not(Base in [procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Base];
-              If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
+              If Not(Index in [procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Index];
             End;
       End;
@@ -1501,9 +1501,9 @@ Begin {checks whether two Taicpu instructions are equal}
               Begin
                 With Taicpu(p2).oper[0].ref^ Do
                   Begin
-                    If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP]) Then
+                    If Not(Base in [procinfo.FramePointer, R_NO, R_ESP]) Then
                       RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
-                    If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP]) Then
+                    If Not(Index in [procinfo.FramePointer, R_NO, R_ESP]) Then
                       RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
                   End;
  {add the registers from the reference (.oper[0]) to the RegInfo, all registers
@@ -1524,7 +1524,7 @@ Begin {checks whether two Taicpu instructions are equal}
           Begin
             With Taicpu(p2).oper[0].ref^ Do
               Begin
-                If Not(Base in [procinfo^.FramePointer,
+                If Not(Base in [procinfo.FramePointer,
                      Reg32(Taicpu(p2).oper[1].reg),R_NO,R_ESP]) Then
  {it won't do any harm if the register is already in RegsLoadedForRef}
                   Begin
@@ -1533,7 +1533,7 @@ Begin {checks whether two Taicpu instructions are equal}
                     Writeln(std_reg2str[base], ' added');
 {$endif csdebug}
                   end;
-                If Not(Index in [procinfo^.FramePointer,
+                If Not(Index in [procinfo.FramePointer,
                      Reg32(Taicpu(p2).oper[1].reg),R_NO,R_ESP]) Then
                   Begin
                     RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
@@ -1543,7 +1543,7 @@ Begin {checks whether two Taicpu instructions are equal}
                   end;
 
               End;
-            If Not(Reg32(Taicpu(p2).oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
+            If Not(Reg32(Taicpu(p2).oper[1].reg) In [procinfo.FramePointer,R_NO,R_ESP])
               Then
                 Begin
                   RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
@@ -1690,8 +1690,8 @@ function isSimpleRef(const ref: treference): boolean;
 begin
   isSimpleRef :=
     assigned(ref.symbol) or
-    (ref.base = procinfo^.framepointer) or
-    (assigned(procinfo^._class) and
+    (ref.base = procinfo.framepointer) or
+    (assigned(procinfo._class) and
      (ref.base = R_ESI));
 end;
 
@@ -2591,7 +2591,10 @@ End.
 
 {
   $Log$
-  Revision 1.41  2002-07-01 18:46:31  peter
+  Revision 1.42  2002-08-17 09:23:44  florian
+    * first part of procinfo rewrite
+
+  Revision 1.41  2002/07/01 18:46:31  peter
     * internal linker
     * reorganized aasm layer
 

compiler/i386/n386cal.pas

@@ -147,7 +147,7 @@ implementation
                 begin
                   if inlined then
                     begin
-                       reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                       reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                        cg.a_load_loc_ref(exprasmlist,left.location,href);
                     end
                   else
@@ -164,7 +164,7 @@ implementation
                          begin
                            tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                            cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                           reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                           reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                            cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                            cg.free_scratch_reg(exprasmlist,tmpreg);
                          end
@@ -196,7 +196,7 @@ implementation
                 begin
                    tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                    cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                   reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                   reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                    cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                    cg.free_scratch_reg(exprasmlist,tmpreg);
                 end
@@ -243,7 +243,7 @@ implementation
                      begin
                         tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                         cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                        reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                        reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                         cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                         cg.free_scratch_reg(exprasmlist,tmpreg);
                      end
@@ -522,7 +522,7 @@ implementation
                  begin
                    reference_reset(funcretref);
                    funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
-                   funcretref.base:=procinfo^.framepointer;
+                   funcretref.base:=procinfo.framepointer;
 {$ifdef extdebug}
                    Comment(V_debug,'function return value is at offset '
                                    +tostr(funcretref.offset));
@@ -545,7 +545,7 @@ implementation
                begin
                   hregister:=cg.get_scratch_reg_address(exprasmlist);
                   cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
-                  reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
+                  reference_reset_base(href,procinfo.framepointer,inlinecode.retoffset);
                   cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
                   cg.free_scratch_reg(exprasmlist,hregister);
                end
@@ -802,7 +802,7 @@ implementation
                              loadesi:=false;
                           end;
                         { direct call to destructor: don't remove data! }
-                        if is_class(procinfo^._class) then
+                        if is_class(procinfo._class) then
                           begin
                              if (procdefinition.proctypeoption=potype_destructor) then
                                begin
@@ -817,7 +817,7 @@ implementation
                              else
                                cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
                           end
-                        else if is_object(procinfo^._class) then
+                        else if is_object(procinfo._class) then
                           begin
                              cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
                              if is_con_or_destructor then
@@ -825,7 +825,7 @@ implementation
                                   if (procdefinition.proctypeoption=potype_constructor) then
                                     begin
                                       { it's no bad idea, to insert the VMT }
-                                      reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo^._class.vmt_mangledname),0);
+                                      reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo._class.vmt_mangledname),0);
                                       cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                     end
                                   { destructors haven't to dispose the instance, if this is }
@@ -876,25 +876,25 @@ implementation
                      }
                      if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
                        begin
-                          reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                          reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
                           cg.a_param_ref(exprasmlist,OS_ADDR,href,paralocdummy);
                        end
                        { this is only true if the difference is one !!
                          but it cannot be more !! }
                      else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
                        begin
-                          cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,paralocdummy);
+                          cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paralocdummy);
                        end
                      else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
                        begin
                           hregister:=rg.getregisterint(exprasmlist);
-                          reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                          reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
                           cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                           for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
                             begin
                                {we should get the correct frame_pointer_offset at each level
                                how can we do this !!! }
-                               reference_reset_base(href,hregister,procinfo^.framepointer_offset);
+                               reference_reset_base(href,hregister,procinfo.framepointer_offset);
                                cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                             end;
                           cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paralocdummy);
@@ -1076,7 +1076,7 @@ implementation
                 else if (pushedparasize=8) and
                   not(cs_littlesize in aktglobalswitches) and
                   (aktoptprocessor=ClassP5) and
-                  (procinfo^._class=nil) then
+                  (procinfo._class=nil) then
                     begin
                        rg.getexplicitregisterint(exprasmlist,R_EDI);
                        emit_reg(A_POP,S_L,R_EDI);
@@ -1113,7 +1113,7 @@ implementation
              emitjmp(C_Z,faillabel);
 {$ifdef TEST_GENERIC}
 { should be moved to generic version! }
-             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+             reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
              cg.a_load_ref_reg(exprasmlist, OS_ADDR, href, SELF_POINTER_REG);
 {$endif}
            end;
@@ -1317,7 +1317,7 @@ implementation
            oldprocdef : tprocdef;
            ps, i : longint;
            tmpreg: tregister;
-           oldprocinfo : pprocinfo;
+           oldprocinfo : tprocinfo;
            oldinlining_procedure,
            nostackframe,make_global : boolean;
            inlineentrycode,inlineexitcode : TAAsmoutput;
@@ -1359,15 +1359,22 @@ implementation
           objectlibrary.getlabel(aktexit2label);
           { we're inlining a procedure }
           inlining_procedure:=true;
-          { save old procinfo }
           oldprocdef:=aktprocdef;
-          getmem(oldprocinfo,sizeof(tprocinfo));
-          move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
-          { set new procinfo }
+
           aktprocdef:=inlineprocdef;
-          procinfo^.return_offset:=retoffset;
-          procinfo^.para_offset:=para_offset;
-          procinfo^.no_fast_exit:=false;
+
+          { save old procinfo }
+          oldprocinfo:=procinfo;
+
+          { clone }
+          procinfo:=tprocinfo(cprocinfo.newinstance);
+          move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
+
+          { set new procinfo }
+          procinfo.return_offset:=retoffset;
+          procinfo.para_offset:=para_offset;
+          procinfo.no_fast_exit:=false;
+
           { arg space has been filled by the parent secondcall }
           st:=aktprocdef.localst;
           { set it to the same lexical level }
@@ -1441,8 +1448,8 @@ implementation
               st.address_fixup:=0;
             end;
           { restore procinfo }
-          move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
-          freemem(oldprocinfo,sizeof(tprocinfo));
+          procinfo.free;
+          procinfo:=oldprocinfo;
 {$ifdef GDB}
           if (cs_debuginfo in aktmoduleswitches) then
             begin
@@ -1481,7 +1488,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.63  2002-08-12 15:08:42  carl
+  Revision 1.64  2002-08-17 09:23:45  florian
+    * first part of procinfo rewrite
+
+  Revision 1.63  2002/08/12 15:08:42  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/i386/n386set.pas

@@ -75,7 +75,7 @@ implementation
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          if tsetdef(right.resulttype.def).settype<>smallset then
-           procinfo^.flags:=procinfo^.flags or pi_do_call
+           procinfo.flags:=procinfo.flags or pi_do_call
          else
            begin
               { a smallset needs maybe an misc. register }
@@ -853,7 +853,7 @@ implementation
          objectlibrary.getlabel(endlabel);
          objectlibrary.getlabel(elselabel);
          if (cs_create_smart in aktmoduleswitches) then
-           jumpsegment:=procinfo^.aktlocaldata
+           jumpsegment:=procinfo.aktlocaldata
          else
            jumpsegment:=datasegment;
          with_sign:=is_signed(left.resulttype.def);
@@ -1023,7 +1023,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2002-08-12 15:08:42  carl
+  Revision 1.40  2002-08-17 09:23:46  florian
+    * first part of procinfo rewrite
+
+  Revision 1.39  2002/08/12 15:08:42  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/i386/popt386.pas

@@ -73,8 +73,8 @@ begin
          (hp2.typ = ait_instruction) and
          ((Taicpu(hp2).opcode = A_LEAVE) or
           (Taicpu(hp2).opcode = A_RET)) and
-         (Taicpu(p).oper[0].ref^.Base = procinfo^.FramePointer) and
-         (Taicpu(p).oper[0].ref^.Offset >= procinfo^.Return_Offset) and
+         (Taicpu(p).oper[0].ref^.Base = procinfo.FramePointer) and
+         (Taicpu(p).oper[0].ref^.Offset >= procinfo.Return_Offset) and
          (Taicpu(p).oper[0].ref^.Index = R_NO) then
         begin
           asml.remove(p);
@@ -990,8 +990,8 @@ Begin
                               If ((Taicpu(hp1).opcode = A_LEAVE) Or
                                   (Taicpu(hp1).opcode = A_RET)) And
                                  (Taicpu(p).oper[1].typ = top_ref) And
-                                 (Taicpu(p).oper[1].ref^.base = procinfo^.FramePointer) And
-                                 (Taicpu(p).oper[1].ref^.offset >= procinfo^.Return_Offset) And
+                                 (Taicpu(p).oper[1].ref^.base = procinfo.FramePointer) And
+                                 (Taicpu(p).oper[1].ref^.offset >= procinfo.Return_Offset) And
                                  (Taicpu(p).oper[1].ref^.index = R_NO) And
                                  (Taicpu(p).oper[0].typ = top_reg)
                                 Then
@@ -1552,9 +1552,9 @@ Begin
                      (hp2.typ = ait_instruction) And
                      ((Taicpu(hp2).opcode = A_LEAVE) or
                       (Taicpu(hp2).opcode = A_RET)) And
-                     (Taicpu(p).oper[0].ref^.Base = procinfo^.FramePointer) And
+                     (Taicpu(p).oper[0].ref^.Base = procinfo.FramePointer) And
                      (Taicpu(p).oper[0].ref^.Index = R_NO) And
-                     (Taicpu(p).oper[0].ref^.Offset >= procinfo^.Return_Offset) And
+                     (Taicpu(p).oper[0].ref^.Offset >= procinfo.Return_Offset) And
                      (hp1.typ = ait_instruction) And
                      (Taicpu(hp1).opcode = A_MOV) And
                      (Taicpu(hp1).opsize = S_B) And
@@ -2044,7 +2044,10 @@ End.
 
 {
   $Log$
-  Revision 1.32  2002-08-11 14:32:30  peter
+  Revision 1.33  2002-08-17 09:23:46  florian
+    * first part of procinfo rewrite
+
+  Revision 1.32  2002/08/11 14:32:30  peter
     * renamed current_library to objectlibrary
 
   Revision 1.31  2002/08/11 13:24:17  peter

compiler/i386/ra386int.pas

@@ -1104,7 +1104,7 @@ Begin
               end;
              if GotOffset then
               begin
-                if hasvar and (opr.ref.base=procinfo^.framepointer) then
+                if hasvar and (opr.ref.base=procinfo.framepointer) then
                  begin
                    opr.ref.base:=R_NO;
                    hasvar:=hadvar;
@@ -1122,7 +1122,7 @@ Begin
                 { check if we can move the old base to the index register }
                 if (opr.ref.index<>R_NO) then
                  Message(asmr_e_wrong_base_index)
-                else if assigned(procinfo^._class) and
+                else if assigned(procinfo._class) and
                   (oldbase=SELF_POINTER_REG) and
                   (opr.ref.base=SELF_POINTER_REG) then
                   begin
@@ -1959,7 +1959,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.32  2002-08-13 18:01:52  carl
+  Revision 1.33  2002-08-17 09:23:47  florian
+    * first part of procinfo rewrite
+
+  Revision 1.32  2002/08/13 18:01:52  carl
     * rename swatoperands to swapoperands
     + m68k first compilable version (still needs a lot of testing):
         assembler generator, system information , inline

compiler/i386/radirect.pas

@@ -89,7 +89,7 @@ interface
           is_fpu(aktprocdef.rettype.def) then
          tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
        if (not is_void(aktprocdef.rettype.def)) then
-         retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
+         retstr:=upper(tostr(procinfo.return_offset)+'('+gas_reg2str[procinfo.framepointer]+')')
        else
          retstr:='';
          c:=current_scanner.asmgetchar;
@@ -170,7 +170,7 @@ interface
                                                hs:=tvarsym(sym).mangledname
                                              else
                                                hs:='-'+tostr(tvarsym(sym).address)+
-                                                   '('+gas_reg2str[procinfo^.framepointer]+')';
+                                                   '('+gas_reg2str[procinfo.framepointer]+')';
                                              end
                                            else
                                            { call to local function }
@@ -193,7 +193,7 @@ interface
                                                      l:=tvarsym(sym).address;
                                                      { set offset }
                                                      inc(l,aktprocdef.parast.address_fixup);
-                                                     hs:=tostr(l)+'('+gas_reg2str[procinfo^.framepointer]+')';
+                                                     hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer]+')';
                                                      if pos(',',s) > 0 then
                                                        tvarsym(sym).varstate:=vs_used;
                                                   end;
@@ -237,9 +237,9 @@ interface
                                              end
                                            else if upper(hs)='__SELF' then
                                              begin
-                                                if assigned(procinfo^._class) then
-                                                  hs:=tostr(procinfo^.selfpointer_offset)+
-                                                      '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                if assigned(procinfo._class) then
+                                                  hs:=tostr(procinfo.selfpointer_offset)+
+                                                      '('+gas_reg2str[procinfo.framepointer]+')'
                                                 else
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                              end
@@ -255,8 +255,8 @@ interface
                                                 { complicate to check there }
                                                 { we do it: }
                                                 if lexlevel>normal_function_level then
-                                                  hs:=tostr(procinfo^.framepointer_offset)+
-                                                    '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                  hs:=tostr(procinfo.framepointer_offset)+
+                                                    '('+gas_reg2str[procinfo.framepointer]+')'
                                                 else
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
                                              end;
@@ -304,7 +304,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.1  2002-08-10 14:47:50  carl
+  Revision 1.2  2002-08-17 09:23:47  florian
+    * first part of procinfo rewrite
+
+  Revision 1.1  2002/08/10 14:47:50  carl
     + moved target_cpu_string to cpuinfo
     * renamed asmmode enum.
     * assembler reader has now less ifdef's

compiler/i386/rgcpu.pas

@@ -212,7 +212,7 @@ unit rgcpu;
           exit;
          r := makeregsize(r,OS_INT);
          if (r = R_EDI) or
-            ((not assigned(procinfo^._class)) and (r = R_ESI)) then
+            ((not assigned(procinfo._class)) and (r = R_ESI)) then
            begin
              list.concat(tai_regalloc.DeAlloc(r));
              exit;
@@ -429,7 +429,10 @@ end.
 
 {
   $Log$
-  Revision 1.8  2002-07-01 18:46:34  peter
+  Revision 1.9  2002-08-17 09:23:48  florian
+    * first part of procinfo rewrite
+
+  Revision 1.8  2002/07/01 18:46:34  peter
     * internal linker
     * reorganized aasm layer
 

compiler/m68k/cpupi.pas

@@ -0,0 +1,61 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    This unit contains the CPU specific part of tprocinfo
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+{ This unit contains the CPU specific part of tprocinfo. }
+unit cpupi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cgbase;
+
+    type
+       tm68kprocinfo = class(tprocinfo);
+          procedure allocate_interrupt_stackframe;override;
+       end;
+
+
+  implementation
+
+    procedure tm68kprocinfo.allocate_interrupt_stackframe;
+
+      begin
+         { we push Flags and CS as long
+           to cope with the IRETD
+           and we save 6 register + 4 selectors }
+         { i386 code: inc(procinfo.para_offset,8+6*4+4*2); }
+         internalerror(2002081601);
+      end;
+
+begin
+   cprocinfo:=tm68kprocinfo;
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-17 09:23:48  florian
+    * first part of procinfo rewrite
+}
+
+

compiler/nadd.pas

@@ -1490,7 +1490,7 @@ implementation
          { first do the two subtrees }
          firstpass(left);
          firstpass(right);
-    
+
          if codegenerror then
            exit;
 
@@ -1567,7 +1567,7 @@ implementation
                     location.loc := LOC_REGISTER
                   else
                     location.loc := LOC_JUMP;
-                 calcregisters(self,2,0,0)
+                  calcregisters(self,2,0,0)
                end
              { is there a cardinal? }
              else if (torddef(ld).typ=u32bit) then
@@ -1614,7 +1614,7 @@ implementation
                  calcregisters(self,0,0,0);
                  { here we call SET... }
                  if assigned(procinfo) then
-                    procinfo^.flags:=procinfo^.flags or pi_do_call;
+                    procinfo.flags:=procinfo.flags or pi_do_call;
               end;
            end
 
@@ -1632,7 +1632,7 @@ implementation
                 begin
                    { we use reference counted widestrings so no fast exit here }
                    if assigned(procinfo) then
-                     procinfo^.no_fast_exit:=true;
+                     procinfo.no_fast_exit:=true;
                    { this is only for add, the comparisaion is handled later }
                    location.loc:=LOC_REGISTER;
                 end
@@ -1640,7 +1640,7 @@ implementation
                 begin
                    { we use ansistrings so no fast exit here }
                    if assigned(procinfo) then
-                     procinfo^.no_fast_exit:=true;
+                     procinfo.no_fast_exit:=true;
                    { this is only for add, the comparisaion is handled later }
                    location.loc:=LOC_REGISTER;
                 end
@@ -1814,7 +1814,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.61  2002-08-15 15:15:55  carl
+  Revision 1.62  2002-08-17 09:23:34  florian
+    * first part of procinfo rewrite
+
+  Revision 1.61  2002/08/15 15:15:55  carl
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)
     * more generic nodes for maths
     * several fixes for better m68k support

compiler/nbas.pas

@@ -494,7 +494,7 @@ implementation
     function tasmnode.pass_1 : tnode;
       begin
          result:=nil;
-         procinfo^.flags:=procinfo^.flags or pi_uses_asm;
+         procinfo.flags:=procinfo.flags or pi_uses_asm;
       end;
 
     function tasmnode.docompare(p: tnode): boolean;
@@ -694,7 +694,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-08-15 19:10:35  peter
+  Revision 1.32  2002-08-17 09:23:34  florian
+    * first part of procinfo rewrite
+
+  Revision 1.31  2002/08/15 19:10:35  peter
     * first things tai,tnode storing in ppu
 
   Revision 1.30  2002/07/20 11:57:53  florian

compiler/ncal.pas

@@ -1518,7 +1518,7 @@ implementation
                  begin
                    { we use ansistrings so no fast exit here }
                    if assigned(procinfo) then
-                    procinfo^.no_fast_exit:=true;
+                    procinfo.no_fast_exit:=true;
                  end;
              end;
           end;
@@ -1599,7 +1599,7 @@ implementation
 
               { procedure does a call }
               if not (block_type in [bt_const,bt_type]) then
-                procinfo^.flags:=procinfo^.flags or pi_do_call;
+                procinfo.flags:=procinfo.flags or pi_do_call;
               rg.incrementregisterpushed(all_registers);
            end
          else
@@ -1633,7 +1633,7 @@ implementation
               else
                 begin
                   if not (block_type in [bt_const,bt_type]) then
-                    procinfo^.flags:=procinfo^.flags or pi_do_call;
+                    procinfo.flags:=procinfo.flags or pi_do_call;
                 end;
 
              { It doesn't hurt to calculate it already though :) (JM) }
@@ -1904,7 +1904,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.84  2002-08-16 14:24:57  carl
+  Revision 1.85  2002-08-17 09:23:34  florian
+    * first part of procinfo rewrite
+
+  Revision 1.84  2002/08/16 14:24:57  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)

compiler/ncgcal.pas

@@ -62,7 +62,7 @@ implementation
       gdb,
 {$endif GDB}
       cginfo,cgbase,pass_2,
-      cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu,
+      cpuinfo,cpubase,cpupi,aasmbase,aasmtai,aasmcpu,
       nmem,nld,ncnv,
       ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
 
@@ -143,7 +143,7 @@ implementation
                 begin
                   if inlined then
                     begin
-                       reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                       reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                        cg.a_load_loc_ref(exprasmlist,left.location,href);
                     end
                   else
@@ -160,7 +160,7 @@ implementation
                          begin
                            tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                            cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                           reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                           reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                            cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                            cg.free_scratch_reg(exprasmlist,tmpreg);
                          end
@@ -192,7 +192,7 @@ implementation
                 begin
                    tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                    cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                   reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                   reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                    cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                    cg.free_scratch_reg(exprasmlist,tmpreg);
                 end
@@ -239,7 +239,7 @@ implementation
                      begin
                         tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                         cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                        reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                        reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                         cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                         cg.free_scratch_reg(exprasmlist,tmpreg);
                      end
@@ -522,7 +522,7 @@ implementation
                  begin
                    reference_reset(funcretref);
                    funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
-                   funcretref.base:=procinfo^.framepointer;
+                   funcretref.base:=procinfo.framepointer;
 {$ifdef extdebug}
                    Comment(V_debug,'function return value is at offset '
                                    +tostr(funcretref.offset));
@@ -545,7 +545,7 @@ implementation
                begin
                   hregister:=cg.get_scratch_reg_address(exprasmlist);
                   cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
-                  reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
+                  reference_reset_base(href,procinfo.framepointer,inlinecode.retoffset);
                   cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
                   cg.free_scratch_reg(exprasmlist,hregister);
                end
@@ -804,7 +804,7 @@ implementation
                              loadesi:=false;
                           end;
                         { direct call to destructor: don't remove data! }
-                        if is_class(procinfo^._class) then
+                        if is_class(procinfo._class) then
                           begin
                              if (procdefinition.proctypeoption=potype_destructor) then
                                begin
@@ -819,7 +819,7 @@ implementation
                              else
                                cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
                           end
-                        else if is_object(procinfo^._class) then
+                        else if is_object(procinfo._class) then
                           begin
                              cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
                              if is_con_or_destructor then
@@ -827,7 +827,7 @@ implementation
                                   if (procdefinition.proctypeoption=potype_constructor) then
                                     begin
                                       { it's no bad idea, to insert the VMT }
-                                      reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo^._class.vmt_mangledname),0);
+                                      reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo._class.vmt_mangledname),0);
                                       cg.a_paramaddr_ref(exprasmlist,href,1);
                                     end
                                   { destructors haven't to dispose the instance, if this is }
@@ -1052,7 +1052,7 @@ implementation
 {$ifdef i386}
                   (aktoptprocessor=ClassP5) and
 {$endif}
-                  (procinfo^._class=nil) then
+                  (procinfo._class=nil) then
                     begin
                        rg.getexplicitregisterint(exprasmlist,R_EDI);
                        emit_reg(A_POP,S_L,R_EDI);
@@ -1065,8 +1065,12 @@ implementation
                   emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
              end;
 {$endif dummy}
-         if procinfo^.maxpushedparasize<pushedparasize then
-           procinfo^.maxpushedparasize:=pushedparasize;
+
+{$ifdef powerpc}
+         { this calculation must be done in pass_1 anyway, so don't worry }
+         if tppcprocinfo(procinfo).maxpushedparasize<pushedparasize then
+           tppcprocinfo(procinfo).maxpushedparasize:=pushedparasize;
+{$endif powerpc}
 {$ifdef OPTALIGN}
          if pop_esp then
            emit_reg(A_POP,S_L,R_ESP);
@@ -1301,7 +1305,7 @@ implementation
            oldprocdef : tprocdef;
            ps, i : longint;
            tmpreg: tregister;
-           oldprocinfo : pprocinfo;
+           oldprocinfo : tprocinfo;
            oldinlining_procedure,
            nostackframe,make_global : boolean;
            inlineentrycode,inlineexitcode : TAAsmoutput;
@@ -1343,15 +1347,21 @@ implementation
           objectlibrary.getlabel(aktexit2label);
           { we're inlining a procedure }
           inlining_procedure:=true;
-          { save old procinfo }
           oldprocdef:=aktprocdef;
-          getmem(oldprocinfo,sizeof(tprocinfo));
-          move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
-          { set new procinfo }
+
           aktprocdef:=inlineprocdef;
-          procinfo^.return_offset:=retoffset;
-          procinfo^.para_offset:=para_offset;
-          procinfo^.no_fast_exit:=false;
+          { save old procinfo }
+          oldprocinfo:=procinfo;
+
+          { clone }
+          procinfo:=tprocinfo(cprocinfo.newinstance);
+          move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
+
+          { set new procinfo }
+          procinfo.return_offset:=retoffset;
+          procinfo.para_offset:=para_offset;
+          procinfo.no_fast_exit:=false;
+
           { arg space has been filled by the parent secondcall }
           st:=aktprocdef.localst;
           { set it to the same lexical level }
@@ -1425,8 +1435,8 @@ implementation
               st.address_fixup:=0;
             end;
           { restore procinfo }
-          move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
-          freemem(oldprocinfo,sizeof(tprocinfo));
+          procinfo.free;
+          procinfo:=oldprocinfo;
 {$ifdef GDB}
           if (cs_debuginfo in aktmoduleswitches) then
             begin
@@ -1465,7 +1475,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2002-08-13 21:40:55  florian
+  Revision 1.10  2002-08-17 09:23:35  florian
+    * first part of procinfo rewrite
+
+  Revision 1.9  2002/08/13 21:40:55  florian
     * more fixes for ppc calling conventions
 
   Revision 1.8  2002/08/13 18:01:51  carl

compiler/ncgld.pas

@@ -170,7 +170,7 @@ implementation
                             if (symtabletype in [parasymtable,inlinelocalsymtable,
                                                  inlineparasymtable,localsymtable]) then
                               begin
-                                 location.reference.base:=procinfo^.framepointer;
+                                 location.reference.base:=procinfo.framepointer;
                                  if (symtabletype in [inlinelocalsymtable,
                                                       localsymtable])
 {$ifdef powerpc}
@@ -198,7 +198,7 @@ implementation
                                    begin
                                       hregister:=rg.getaddressregister(exprasmlist);
                                       { make a reference }
-                                      reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                                      reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
                                       cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                                       { walk parents }
                                       i:=lexlevel-1;
@@ -221,7 +221,7 @@ implementation
                                    end;
                                  stt_exceptsymtable:
                                    begin
-                                      location.reference.base:=procinfo^.framepointer;
+                                      location.reference.base:=procinfo.framepointer;
                                       location.reference.offset:=tvarsym(symtableentry).address;
                                    end;
                                  objectsymtable:
@@ -682,7 +682,7 @@ implementation
       var
          hreg : tregister;
          href : treference;
-         pp : pprocinfo;
+         pp : tprocinfo;
          hr_valid : boolean;
          i : integer;
       begin
@@ -693,26 +693,26 @@ implementation
            begin
               hreg:=rg.getaddressregister(exprasmlist);
               hr_valid:=true;
-              reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+              reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
               cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hreg);
 
               { walk up the stack frame }
-              pp:=procinfo^.parent;
+              pp:=procinfo.parent;
               i:=lexlevel-1;
               while i>funcretsym.owner.symtablelevel do
                begin
-                 reference_reset_base(href,hreg,pp^.framepointer_offset);
+                 reference_reset_base(href,hreg,pp.framepointer_offset);
                  cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hreg);
-                 pp:=pp^.parent;
+                 pp:=pp.parent;
                  dec(i);
                end;
               location.reference.base:=hreg;
-              location.reference.offset:=pp^.return_offset;
+              location.reference.offset:=pp.return_offset;
            end
          else
            begin
-             location.reference.base:=procinfo^.framepointer;
-             location.reference.offset:=procinfo^.return_offset;
+             location.reference.base:=procinfo.framepointer;
+             location.reference.offset:=procinfo.return_offset;
            end;
          if paramanager.ret_in_param(resulttype.def) then
            begin
@@ -942,7 +942,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2002-08-14 18:13:28  jonas
+  Revision 1.24  2002-08-17 09:23:35  florian
+    * first part of procinfo rewrite
+
+  Revision 1.23  2002/08/14 18:13:28  jonas
     * adapted previous fix to Peter's asmsymbol patch
 
   Revision 1.22  2002/08/14 18:00:42  jonas

compiler/ncgutil.pas

@@ -85,17 +85,6 @@ interface
     procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
       a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
 
-   {#
-      This routine returns the registers which will be used in
-      function results , depending on the return definition
-      type.
-      
-      An empty set can be returned if this function does not return
-      anything in registers.
-   }
-    function getfuncusedregisters(def : tdef): tregisterset;
-      
-
 implementation
 
   uses
@@ -702,7 +691,7 @@ implementation
 
                   { this is the easiest case for inlined !! }
                   if inlined then
-                   reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize)
+                   reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize)
                   else
                    reference_reset_base(href,stack_pointer_reg,0);
 
@@ -733,7 +722,7 @@ implementation
                      end;
                     if inlined then
                      begin
-                       reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                       reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                        cg.a_load_ref_ref(exprasmlist,cgsize,tempreference,href);
                      end
                     else
@@ -774,7 +763,7 @@ implementation
                        inc(pushedparasize,8);
                        if inlined then
                         begin
-                          reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                          reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                           cg64.a_load64_loc_ref(exprasmlist,p.location,href);
                         end
                        else
@@ -805,7 +794,7 @@ implementation
                        inc(pushedparasize,alignment);
                        if inlined then
                         begin
-                          reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                          reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                           cg.a_load_loc_ref(exprasmlist,p.location,href);
                         end
                        else
@@ -823,7 +812,7 @@ implementation
                      inc(pushedparasize,8);
                      if inlined then
                        begin
-                          reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                          reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                           cg.a_loadmm_reg_ref(exprasmlist,p.location.register,href);
                        end
                      else
@@ -852,13 +841,13 @@ implementation
            (tvarsym(p).varspez=vs_value) and
            (paramanager.push_addr_param(tvarsym(p).vartype.def)) then
          begin
-           reference_reset_base(href1,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
+           reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
            if is_open_array(tvarsym(p).vartype.def) or
               is_array_of_const(tvarsym(p).vartype.def) then
              cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
            else
             begin
-              reference_reset_base(href2,procinfo^.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
+              reference_reset_base(href2,procinfo.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
               if is_shortstring(tvarsym(p).vartype.def) then
                cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
               else
@@ -899,9 +888,9 @@ implementation
            tvarsym(p).vartype.def.needs_inittable then
          begin
            if assigned(procinfo) then
-            procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+            procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
            if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-            reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
+            reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
            else
             reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
            cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
@@ -922,7 +911,7 @@ implementation
            tvarsym(p).vartype.def.needs_inittable then
          begin
            if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-            reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
+            reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
            else
             reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
            cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
@@ -946,17 +935,17 @@ implementation
            case tvarsym(p).varspez of
              vs_value :
                begin
-                 procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+                 procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
                  if assigned(tvarsym(p).localvarsym) then
-                  reference_reset_base(href,procinfo^.framepointer,
+                  reference_reset_base(href,procinfo.framepointer,
                       -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
                  else
-                  reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
+                  reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
                  cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
                end;
              vs_out :
                begin
-                 reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
+                 reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
                  tmpreg:=cg.get_scratch_reg_address(list);
                  cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
                  reference_reset_base(href,tmpreg,0);
@@ -981,10 +970,10 @@ implementation
            if (tvarsym(p).varspez=vs_value) then
             begin
               if assigned(tvarsym(p).localvarsym) then
-               reference_reset_base(href,procinfo^.framepointer,
+               reference_reset_base(href,procinfo.framepointer,
                    -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
               else
-               reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
+               reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
               cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
             end;
          end;
@@ -1004,8 +993,8 @@ implementation
                                tt_widestring,tt_freewidestring,
                                tt_interfacecom] then
             begin
-              procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
-              reference_reset_base(href,procinfo^.framepointer,hp^.pos);
+              procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
+              reference_reset_base(href,procinfo.framepointer,hp^.pos);
               cg.a_load_const_ref(list,OS_ADDR,0,href);
             end;
            hp:=hp^.next;
@@ -1025,20 +1014,20 @@ implementation
              tt_ansistring,
              tt_freeansistring :
                begin
-                 reference_reset_base(href,procinfo^.framepointer,hp^.pos);
+                 reference_reset_base(href,procinfo.framepointer,hp^.pos);
                  cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                  cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
                end;
              tt_widestring,
              tt_freewidestring :
                begin
-                 reference_reset_base(href,procinfo^.framepointer,hp^.pos);
+                 reference_reset_base(href,procinfo.framepointer,hp^.pos);
                  cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
                  cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
                end;
              tt_interfacecom :
                begin
-                 reference_reset_base(href,procinfo^.framepointer,hp^.pos);
+                 reference_reset_base(href,procinfo.framepointer,hp^.pos);
                  cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
                  cg.a_call_name(list,'FPC_INTF_DECR_REF');
                end;
@@ -1060,7 +1049,7 @@ implementation
            if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>vs_assigned) and
               (not inlined) then
             CGMessage(sym_w_function_result_not_set);
-           reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
+           reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
            cgsize:=def_cgsize(aktprocdef.rettype.def);
            case aktprocdef.rettype.def.deftype of
              orddef,
@@ -1097,7 +1086,7 @@ implementation
            end;
          end;
       end;
-      
+
 
     procedure handle_fast_exit_return_value(list:TAAsmoutput);
       var
@@ -1107,7 +1096,7 @@ implementation
       begin
         if not is_void(aktprocdef.rettype.def) then
          begin
-           reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
+           reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
            cgsize:=def_cgsize(aktprocdef.rettype.def);
            case aktprocdef.rettype.def.deftype of
              orddef,
@@ -1135,44 +1124,6 @@ implementation
       end;
 
 
-    function getfuncusedregisters(def : tdef): tregisterset;
-     var
-       paramloc : tparalocation;
-       regset : tregisterset;
-     begin
-       regset:=[];
-       getfuncusedregisters:=[];
-       { if nothing is returned in registers,
-         its useless to continue on in this
-         routine
-       }  
-       if not paramanager.ret_in_reg(def) then
-         exit;
-       paramloc := paramanager.getfuncresultlocreg(def);
-       case paramloc.loc of 
-         LOC_FPUREGISTER, 
-         LOC_CFPUREGISTER, 
-{$ifdef SUPPORT_MMX}         
-         LOC_MMREGISTER, 
-         LOC_CMMREGISTER,
-{$endif}         
-         LOC_REGISTER,LOC_CREGISTER :
-             begin
-               regset := regset + [paramloc.register];
-               if ((paramloc.size in [OS_S64,OS_64]) and
-                  (sizeof(aword) < 8))
-               then
-                 begin
-                    regset := regset + [paramloc.registerhigh];
-                 end;
-             end;
-       else
-         internalerror(20020816);
-      end;
-      getfuncusedregisters:=regset;
-     end;
-
-
     procedure genentrycode(list : TAAsmoutput;
                            make_global:boolean;
                            stackframe:longint;
@@ -1215,7 +1166,7 @@ implementation
         { we must do it for local function }
         { that can be called from a foreach_static }
         { of another object than self !! PM }
-        if assigned(procinfo^._class) and  { !!!!! shouldn't we load ESI always? }
+        if assigned(procinfo._class) and  { !!!!! shouldn't we load ESI always? }
            (lexlevel>normal_function_level) then
          cg.g_maybe_loadself(list);
 
@@ -1224,7 +1175,7 @@ implementation
         If (po_containsself in aktprocdef.procoptions) then
           begin
              list.concat(tai_regalloc.Alloc(self_pointer_reg));
-             reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
+             reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
              cg.a_load_ref_reg(list,OS_ADDR,href,self_pointer_reg);
           end;
 
@@ -1232,8 +1183,8 @@ implementation
         if (not is_void(aktprocdef.rettype.def)) and
            (aktprocdef.rettype.def.needs_inittable) then
           begin
-             procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
-             reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
+             procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
+             reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
              cg.g_initialize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def));
           end;
 
@@ -1267,7 +1218,7 @@ implementation
              { move register parameters which aren't regable into memory                                          }
              { we do this after init_paras because it saves some code in init_paras if parameters are in register }
              { instead in memory                                                                                  }
-             hp:=tparaitem(procinfo^.procdef.para.first);
+             hp:=tparaitem(procinfo.procdef.para.first);
              while assigned(hp) do
                begin
                   if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER
@@ -1276,12 +1227,12 @@ implementation
                        case hp.paraloc.loc of
                           LOC_REGISTER:
                             begin
-                               reference_reset_base(href,procinfo^.framepointer,tvarsym(hp.parasym).address);
+                               reference_reset_base(href,procinfo.framepointer,tvarsym(hp.parasym).address);
                                cg.a_load_reg_ref(list,hp.paraloc.size,hp.paraloc.register,href);
                             end;
                           LOC_FPUREGISTER:
                             begin
-                               reference_reset_base(href,procinfo^.framepointer,tvarsym(hp.parasym).address);
+                               reference_reset_base(href,procinfo.framepointer,tvarsym(hp.parasym).address);
                                cg.a_loadfpu_reg_ref(list,hp.paraloc.size,hp.paraloc.register,href);
                             end;
                           else
@@ -1320,17 +1271,17 @@ implementation
             end;
 
            { do we need an exception frame because of ansi/widestrings/interfaces ? }
-           if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
+           if ((procinfo.flags and pi_needs_implicit_finally)<>0) and
               { but it's useless in init/final code of units }
               not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
             begin
               include(rg.usedinproc,accumulator);
-              tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,procinfo^.exception_jmp_ref);
-              tg.gettempofsizereferencepersistant(list,12,procinfo^.exception_env_ref);
-              tg.gettempofsizereferencepersistant(list,sizeof(aword),procinfo^.exception_result_ref);
-              new_exception(list,procinfo^.exception_jmp_ref,
-                  procinfo^.exception_env_ref,
-                  procinfo^.exception_result_ref,1,aktexitlabel);
+              tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,procinfo.exception_jmp_ref);
+              tg.gettempofsizereferencepersistant(list,12,procinfo.exception_env_ref);
+              tg.gettempofsizereferencepersistant(list,sizeof(aword),procinfo.exception_result_ref);
+              new_exception(list,procinfo.exception_jmp_ref,
+                  procinfo.exception_env_ref,
+                  procinfo.exception_result_ref,1,aktexitlabel);
               { probably we've to reload self here }
               cg.g_maybe_loadself(list);
             end;
@@ -1358,10 +1309,10 @@ implementation
 
            if (cs_profile in aktmoduleswitches) or
               (aktprocdef.owner.symtabletype=globalsymtable) or
-              (assigned(procinfo^._class) and (procinfo^._class.owner.symtabletype=globalsymtable)) then
+              (assigned(procinfo._class) and (procinfo._class.owner.symtabletype=globalsymtable)) then
             make_global:=true;
 
-           if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
+           if make_global or ((procinfo.flags and pi_is_global) <> 0) then
             aktprocsym.is_global := True;
 
 {$ifdef GDB}
@@ -1391,16 +1342,16 @@ implementation
 {$ifndef powerpc}
            { at least for the ppc this applies always, so this code isn't usable (FK) }
            { omit stack frame ? }
-           if (procinfo^.framepointer=STACK_POINTER_REG) then
+           if (procinfo.framepointer=STACK_POINTER_REG) then
             begin
               CGMessage(cg_d_stackframe_omited);
               nostackframe:=true;
               if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-4;
+                parasize:=aktprocdef.parast.datasize+procinfo.para_offset-4;
               if stackframe<>0 then
-                cg.a_op_const_reg(stackalloclist,OP_SUB,stackframe,procinfo^.framepointer);
+                cg.a_op_const_reg(stackalloclist,OP_SUB,stackframe,procinfo.framepointer);
             end
            else
 {$endif powerpc}
@@ -1409,7 +1360,7 @@ implementation
               if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-target_info.first_parm_offset;
+                parasize:=aktprocdef.parast.datasize+procinfo.para_offset-target_info.first_parm_offset;
 
               if (po_interrupt in aktprocdef.procoptions) then
                 cg.g_interrupt_stackframe_entry(stackalloclist);
@@ -1444,7 +1395,7 @@ implementation
         pd : tprocdef;
       begin
         if aktexit2label.is_used and
-           ((procinfo^.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
+           ((procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
           begin
             cg.a_jmp_always(list,aktexitlabel);
             cg.a_label(list,aktexit2label);
@@ -1458,7 +1409,7 @@ implementation
 
         { call the destructor help procedure }
         if (aktprocdef.proctypeoption=potype_destructor) and
-           assigned(procinfo^._class) then
+           assigned(procinfo._class) then
          cg.g_call_destructor_helper(list);
 
         { finalize temporary data }
@@ -1485,7 +1436,7 @@ implementation
 
         { do we need to handle exceptions because of ansi/widestrings ? }
         if not inlined and
-           ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
+           ((procinfo.flags and pi_needs_implicit_finally)<>0) and
            { but it's useless in init/final code of units }
            not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
           begin
@@ -1493,30 +1444,30 @@ implementation
              aktprocdef.usedregisters:=all_registers;
              objectlibrary.getlabel(noreraiselabel);
              free_exception(list,
-                  procinfo^.exception_jmp_ref,
-                  procinfo^.exception_env_ref,
-                  procinfo^.exception_result_ref,0
+                  procinfo.exception_jmp_ref,
+                  procinfo.exception_env_ref,
+                  procinfo.exception_result_ref,0
                 ,noreraiselabel,false);
 
              if (aktprocdef.proctypeoption=potype_constructor) then
                begin
-                  if assigned(procinfo^._class) then
+                  if assigned(procinfo._class) then
                     begin
-                       pd:=procinfo^._class.searchdestructor;
+                       pd:=procinfo._class.searchdestructor;
                        if assigned(pd) then
                          begin
                             objectlibrary.getlabel(nodestroycall);
-                            reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
+                            reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
                             cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
-                            if is_class(procinfo^._class) then
+                            if is_class(procinfo._class) then
                              begin
                                cg.a_param_const(list,OS_INT,1,paramanager.getintparaloc(2));
                                cg.a_param_reg(list,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
                              end
-                            else if is_object(procinfo^._class) then
+                            else if is_object(procinfo._class) then
                              begin
                                cg.a_param_reg(list,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
-                               reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo^._class.vmt_mangledname),0);
+                               reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo._class.vmt_mangledname),0);
                                cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                              end
                             else
@@ -1526,7 +1477,7 @@ implementation
                                reference_reset_base(href,self_pointer_reg,0);
                                tmpreg:=cg.get_scratch_reg_address(list);
                                cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
-                               reference_reset_base(href,tmpreg,procinfo^._class.vmtmethodoffset(pd.extnumber));
+                               reference_reset_base(href,tmpreg,procinfo._class.vmtmethodoffset(pd.extnumber));
                                cg.free_scratch_reg(list,tmpreg);
                                cg.a_call_ref(list,href);
                              end
@@ -1547,7 +1498,7 @@ implementation
                    ((aktprocdef.rettype.def.deftype<>objectdef) or
                     not is_class(aktprocdef.rettype.def)) then
                   begin
-                     reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
+                     reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
                      cg.g_finalize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def));
                   end;
               end;
@@ -1586,7 +1537,7 @@ implementation
 
                 { for classes this is done after the call to }
                 { AfterConstruction                          }
-                if is_object(procinfo^._class) then
+                if is_object(procinfo._class) then
                   begin
                     cg.a_reg_alloc(list,accumulator);
                     cg.a_load_reg_reg(list,OS_ADDR,self_pointer_reg,accumulator);
@@ -1646,9 +1597,9 @@ implementation
 {$ifdef GDB}
         if (cs_debuginfo in aktmoduleswitches) and not inlined  then
           begin
-            if assigned(procinfo^._class) then
-              if (not assigned(procinfo^.parent) or
-                 not assigned(procinfo^.parent^._class)) then
+            if assigned(procinfo._class) then
+              if (not assigned(procinfo.parent) or
+                 not assigned(procinfo.parent._class)) then
                 begin
                   if (po_classmethod in aktprocdef.procoptions) or
                      ((po_virtualmethod in aktprocdef.procoptions) and
@@ -1657,56 +1608,56 @@ implementation
                     begin
                       list.concat(Tai_stabs.Create(strpnew(
                        '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
+                       tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
                     end
                   else
                     begin
-                      if not(is_class(procinfo^._class)) then
+                      if not(is_class(procinfo._class)) then
                         st:='v'
                       else
                         st:='p';
                       list.concat(Tai_stabs.Create(strpnew(
-                       '"$t:'+st+procinfo^._class.numberstring+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
+                       '"$t:'+st+procinfo._class.numberstring+'",'+
+                       tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
                     end;
                 end
               else
                 begin
-                  if not is_class(procinfo^._class) then
+                  if not is_class(procinfo._class) then
                     st:='*'
                   else
                     st:='';
                   list.concat(Tai_stabs.Create(strpnew(
-                   '"$t:r'+st+procinfo^._class.numberstring+'",'+
+                   '"$t:r'+st+procinfo._class.numberstring+'",'+
                    tostr(N_RSYM)+',0,0,'+tostr(stab_regindex[SELF_POINTER_REG]))));
                 end;
 
             { define calling EBP as pseudo local var PM }
             { this enables test if the function is a local one !! }
-            if  assigned(procinfo^.parent) and (lexlevel>normal_function_level) then
+            if  assigned(procinfo.parent) and (lexlevel>normal_function_level) then
               list.concat(Tai_stabs.Create(strpnew(
                '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
-               tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset))));
+               tostr(N_LSYM)+',0,0,'+tostr(procinfo.framepointer_offset))));
 
             if (not is_void(aktprocdef.rettype.def)) then
               begin
                 if paramanager.ret_in_param(aktprocdef.rettype.def) then
                   list.concat(Tai_stabs.Create(strpnew(
                    '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
+                   tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
                 else
                   list.concat(Tai_stabs.Create(strpnew(
                    '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
+                   tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
                 if (m_result in aktmodeswitches) then
                   if paramanager.ret_in_param(aktprocdef.rettype.def) then
                     list.concat(Tai_stabs.Create(strpnew(
                      '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
+                     tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
                   else
                     list.concat(Tai_stabs.Create(strpnew(
                      '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
+                     tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
               end;
             mangled_length:=length(aktprocdef.mangledname);
             getmem(p,2*mangled_length+50);
@@ -1779,7 +1730,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.38  2002-08-16 14:24:57  carl
+  Revision 1.39  2002-08-17 09:23:36  florian
+    * first part of procinfo rewrite
+
+  Revision 1.38  2002/08/16 14:24:57  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)

compiler/ncnv.pas

@@ -941,7 +941,7 @@ implementation
         aprocdef:=assignment_overloaded(left.resulttype.def,resulttype.def);
         if assigned(aprocdef) then
           begin
-             procinfo^.flags:=procinfo^.flags or pi_do_call;
+             procinfo.flags:=procinfo.flags or pi_do_call;
              hp:=ccallnode.create(ccallparanode.create(left,nil),
                                   overloaded_operators[_assignment],nil,nil);
              { tell explicitly which def we must use !! (PM) }
@@ -1939,7 +1939,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.69  2002-08-14 19:26:55  carl
+  Revision 1.70  2002-08-17 09:23:36  florian
+    * first part of procinfo rewrite
+
+  Revision 1.69  2002/08/14 19:26:55  carl
     + generic int_to_real type conversion
     + generic unaryminus node
 

compiler/nflw.pas

@@ -590,7 +590,7 @@ implementation
          result:=nil;
          resulttype:=voidtype;
 
-											  											  
+											  											
          if left.nodetype<>assignn then
            begin
               CGMessage(cg_e_illegal_expression);
@@ -739,8 +739,8 @@ implementation
             begin
               inserttypeconv(left,aktprocdef.rettype);
               if paramanager.ret_in_param(aktprocdef.rettype.def) or
-                 (procinfo^.no_fast_exit) or
-                 ((procinfo^.flags and pi_uses_exceptions)<>0) then
+                 (procinfo.no_fast_exit) or
+                 ((procinfo.flags and pi_uses_exceptions)<>0) then
                begin
                  pt:=cfuncretnode.create(aktprocdef.funcretsym);
                  left:=cassignmentnode.create(pt,left);
@@ -1244,7 +1244,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2002-07-21 06:58:49  daniel
+  Revision 1.45  2002-08-17 09:23:37  florian
+    * first part of procinfo rewrite
+
+  Revision 1.44  2002/07/21 06:58:49  daniel
   * Changed booleans into flags
 
   Revision 1.43  2002/07/20 11:57:54  florian

compiler/nld.pas

@@ -182,7 +182,7 @@ implementation
     function tloadnode.det_resulttype:tnode;
       var
         p1 : tnode;
-        p  : pprocinfo;
+        p  : tprocinfo;
       begin
          result:=nil;
          { optimize simple with loadings }
@@ -219,14 +219,14 @@ implementation
                 p:=procinfo;
                 while assigned(p) do
                  begin
-                   if assigned(p^.procdef.funcretsym) and
-                      ((tfuncretsym(symtableentry)=p^.procdef.resultfuncretsym) or
-                       (tfuncretsym(symtableentry)=p^.procdef.funcretsym)) then
+                   if assigned(p.procdef.funcretsym) and
+                      ((tfuncretsym(symtableentry)=p.procdef.resultfuncretsym) or
+                       (tfuncretsym(symtableentry)=p.procdef.funcretsym)) then
                      begin
-                       symtableentry:=p^.procdef.funcretsym;
+                       symtableentry:=p.procdef.funcretsym;
                        break;
                      end;
-                    p:=p^.parent;
+                    p:=p.parent;
                   end;
                 { generate funcretnode }
                 p1:=cfuncretnode.create(symtableentry);
@@ -330,7 +330,7 @@ implementation
                    begin
                       { we use ansistrings so no fast exit here }
                       if assigned(procinfo) then
-                        procinfo^.no_fast_exit:=true;
+                        procinfo.no_fast_exit:=true;
                       location.loc:=LOC_CREFERENCE;
                    end;
               end;
@@ -995,7 +995,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.49  2002-07-20 11:57:54  florian
+  Revision 1.50  2002-08-17 09:23:37  florian
+    * first part of procinfo rewrite
+
+  Revision 1.49  2002/07/20 11:57:54  florian
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added

compiler/nopt.pas

@@ -140,7 +140,7 @@ begin
   location.loc := LOC_CREFERENCE;
   calcregisters(self,0,0,0);
   { here we call STRCONCAT or STRCMP or STRCOPY }
-  procinfo^.flags:=procinfo^.flags or pi_do_call;
+  procinfo.flags:=procinfo.flags or pi_do_call;
 end;
 
 function taddsstringoptnode.getcopy: tnode;
@@ -278,7 +278,10 @@ end.
 
 {
   $Log$
-  Revision 1.10  2002-07-20 11:57:55  florian
+  Revision 1.11  2002-08-17 09:23:37  florian
+    * first part of procinfo rewrite
+
+  Revision 1.10  2002/07/20 11:57:55  florian
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added

compiler/nset.pas

@@ -306,7 +306,7 @@ implementation
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          if tsetdef(right.resulttype.def).settype<>smallset then
-           procinfo^.flags:=procinfo^.flags or pi_do_call
+           procinfo.flags:=procinfo.flags or pi_do_call
          else
            begin
               { a smallset needs maybe an misc. register }
@@ -597,7 +597,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  2002-07-23 13:19:40  jonas
+  Revision 1.31  2002-08-17 09:23:38  florian
+    * first part of procinfo rewrite
+
+  Revision 1.30  2002/07/23 13:19:40  jonas
     * fixed evaluation of expressions with empty sets that are calculated
       at compile time
 

compiler/paramgr.pas

@@ -39,8 +39,8 @@ unit paramgr;
        tparamanager = class
           {# Returns true if the return value can be put in accumulator }
           function ret_in_acc(def : tdef) : boolean;virtual;
-          {# Returns true if the return value is put in a register 
-             
+          {# Returns true if the return value is put in a register
+
              Either a floating point register, or a general purpose
              register.
           }
@@ -66,7 +66,7 @@ unit paramgr;
           function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
           procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
 
-          {#
+          {
             Returns the location where the invisible parameter for structured
             function results will be passed.
           }
@@ -76,17 +76,19 @@ unit paramgr;
             generating the wrappers for implemented interfaces.
           }
           function getselflocation(p : tabstractprocdef) : tparalocation;virtual;abstract;
-          {# 
+
+          {
             Returns the location of the result if the result is in
             a register, the register(s) return depend on the type of
-            the result. 
-            
+            the result.
+
             @param(def The definition of the result type of the function)
           }
           function getfuncresultlocreg(def : tdef): tparalocation; virtual;
        end;
 
     procedure setparalocs(p : tprocdef);
+    function getfuncretusedregisters(def : tdef): tregisterset;
 
     var
        paralocdummy : tparalocation;
@@ -114,8 +116,6 @@ unit paramgr;
       begin
         ret_in_reg:=ret_in_acc(def) or (def.deftype=floatdef);
       end;
-    
-
 
     { true if uses a parameter as return value }
     function tparamanager.ret_in_param(def : tdef) : boolean;
@@ -167,12 +167,13 @@ unit paramgr;
            end;
          end;
       end;
-      
-    function tparamanager.getfuncresultlocreg(def : tdef): tparalocation; 
+
+
+    function tparamanager.getfuncresultlocreg(def : tdef): tparalocation;
       begin
          fillchar(result,sizeof(tparalocation),0);
          if is_void(def) then exit;
-         
+
          result.size := def_cgsize(def);
          case aktprocdef.rettype.def.deftype of
            orddef,
@@ -206,7 +207,7 @@ unit paramgr;
                    begin
                      result.loc := LOC_REFERENCE;
                      internalerror(2002081602);
-(*                     
+(*
 {$ifdef EXTDEBUG}
                      { it is impossible to have the
                        return value with an index register
@@ -217,12 +218,47 @@ unit paramgr;
 {$endif}
                      result.reference.index := ref.base;
                      result.reference.offset := ref.offset;
-*)                     
+*)
                    end;
              end;
           end;
       end;
-      
+
+
+    function getfuncretusedregisters(def : tdef): tregisterset;
+      var
+        paramloc : tparalocation;
+        regset : tregisterset;
+      begin
+        regset:=[];
+        getfuncretusedregisters:=[];
+        { if nothing is returned in registers,
+          its useless to continue on in this
+          routine
+        }
+        if not paramanager.ret_in_reg(def) then
+          exit;
+        paramloc := paramanager.getfuncresultlocreg(def);
+        case paramloc.loc of
+          LOC_FPUREGISTER,
+          LOC_CFPUREGISTER,
+          LOC_MMREGISTER,
+          LOC_CMMREGISTER,
+          LOC_REGISTER,LOC_CREGISTER :
+              begin
+                regset := regset + [paramloc.register];
+                if ((paramloc.size in [OS_S64,OS_64]) and
+                   (sizeof(aword) < 8))
+                then
+                  begin
+                     regset := regset + [paramloc.registerhigh];
+                  end;
+              end;
+          else
+            internalerror(20020816);
+        end;
+        getfuncretusedregisters:=regset;
+      end;
 
     procedure setparalocs(p : tprocdef);
 
@@ -233,7 +269,7 @@ unit paramgr;
          hp:=tparaitem(p.para.first);
          while assigned(hp) do
            begin
-{$ifdef SUPPORT_MMX}           
+{$ifdef SUPPORT_MMX}
               if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,
                  LOC_MMREGISTER]) and
 {$else}
@@ -248,10 +284,10 @@ unit paramgr;
                        hp.paraloc.loc := LOC_CREGISTER;
                      LOC_FPUREGISTER:
                        hp.paraloc.loc := LOC_CFPUREGISTER;
-{$ifdef SUPPORT_MMX}                       
+{$ifdef SUPPORT_MMX}
                      LOC_MMREGISTER:
                        hp.paraloc.loc := LOC_CMMREGISTER;
-{$endif}                       
+{$endif}
                    end;
                    tvarsym(hp.parasym).reg:=hp.paraloc.register;
                    rg.regvar_loaded[hp.paraloc.register]:=true;
@@ -266,7 +302,10 @@ end.
 
 {
    $Log$
-   Revision 1.12  2002-08-16 14:24:58  carl
+   Revision 1.13  2002-08-17 09:23:38  florian
+     * first part of procinfo rewrite
+
+   Revision 1.12  2002/08/16 14:24:58  carl
      * issameref() to test if two references are the same (then emit no opcodes)
      + ret_in_reg to replace ret_in_acc
        (fix some register allocation bugs at the same time)

compiler/pass_2.pas

@@ -288,11 +288,11 @@ implementation
                         { is this correct ???}
                         { retoffset can be negativ for results in eax !! }
                         { the value should be decreased only if positive }
-                         if procinfo^.retoffset>=0 then
-                           dec(procinfo^.retoffset,4);
+                         if procinfo.retoffset>=0 then
+                           dec(procinfo.retoffset,4);
 
-                         dec(procinfo^.para_offset,4);
-                         aktprocdef.parast.address_fixup:=procinfo^.para_offset;
+                         dec(procinfo.para_offset,4);
+                         aktprocdef.parast.address_fixup:=procinfo.para_offset;
                        end;
                    end;
                   *)
@@ -301,32 +301,38 @@ implementation
 
               { assign parameter locations }
 {$ifndef i386}
-              setparalocs(procinfo^.procdef);
+              setparalocs(procinfo.procdef);
 {$endif i386}
 
+              procinfo.after_pass1;
+
               { process register variable stuff (JM) }
               assign_regvars(p);
-              load_regvars(procinfo^.aktentrycode,p);
+              load_regvars(procinfo.aktentrycode,p);
 
               { for the i386 it must be done in genexitcode because it has  }
               { to add 'fstp' instructions when using fpu regvars and those }
               { must come after the "exitlabel" (JM)                        }
 {$ifndef i386}
-              cleanup_regvars(procinfo^.aktexitcode);
+              cleanup_regvars(procinfo.aktexitcode);
 {$endif i386}
+
               do_secondpass(p);
 
-              if assigned(procinfo^.procdef) then
-                procinfo^.procdef.fpu_used:=p.registersfpu;
+              if assigned(procinfo.procdef) then
+                procinfo.procdef.fpu_used:=p.registersfpu;
 
            end;
-         procinfo^.aktproccode.concatlist(exprasmlist);
+         procinfo.aktproccode.concatlist(exprasmlist);
       end;
 
 end.
 {
   $Log$
-  Revision 1.34  2002-08-15 19:10:35  peter
+  Revision 1.35  2002-08-17 09:23:38  florian
+    * first part of procinfo rewrite
+
+  Revision 1.34  2002/08/15 19:10:35  peter
     * first things tai,tnode storing in ppu
 
   Revision 1.33  2002/07/30 20:50:44  florian

compiler/pbase.pas

@@ -63,7 +63,6 @@ interface
 
        { for operators }
        optoken : ttoken;
-       otsym : tvarsym;
 
        { symtable were unit references are stored }
        refsymtable : tsymtable;
@@ -368,7 +367,10 @@ end.
 
 {
   $Log$
-  Revision 1.17  2002-05-18 13:34:11  peter
+  Revision 1.18  2002-08-17 09:23:38  florian
+    * first part of procinfo rewrite
+
+  Revision 1.17  2002/05/18 13:34:11  peter
     * readded missing revisions
 
   Revision 1.16  2002/05/16 19:46:42  carl

compiler/pdecobj.pas

@@ -588,7 +588,7 @@ implementation
          pcrd       : tclassrefdef;
          tt     : ttype;
          old_object_option : tsymoptions;
-         oldprocinfo : pprocinfo;
+         oldprocinfo : tprocinfo;
          oldprocsym : tprocsym;
          oldprocdef : tprocdef;
          oldparse_only : boolean;
@@ -959,8 +959,8 @@ implementation
 
          { new procinfo }
          oldprocinfo:=procinfo;
-         new(procinfo,init);
-         procinfo^._class:=aktclass;
+         procinfo:=cprocinfo.create;
+         procinfo._class:=aktclass;
 
          { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
@@ -1144,7 +1144,7 @@ implementation
          symtablestack:=symtablestack.next;
          aktobjectdef:=nil;
          {Restore procinfo}
-         dispose(procinfo,done);
+         procinfo.free;
          procinfo:=oldprocinfo;
          {Restore the aktprocsym.}
          aktprocsym:=oldprocsym;
@@ -1157,7 +1157,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.48  2002-08-09 07:33:02  florian
+  Revision 1.49  2002-08-17 09:23:38  florian
+    * first part of procinfo rewrite
+
+  Revision 1.48  2002/08/09 07:33:02  florian
     * a couple of interface related fixes
 
   Revision 1.47  2002/07/20 11:57:55  florian

compiler/pdecsub.pas

@@ -151,18 +151,18 @@ implementation
           { self is only allowed in procvars and class methods }
           if (idtoken=_SELF) and
              (is_procvar or
-              (assigned(procinfo^._class) and is_class(procinfo^._class))) then
+              (assigned(procinfo._class) and is_class(procinfo._class))) then
             begin
               if varspez <> vs_value then
                  CGMessage(parser_e_self_call_by_value);
               if not is_procvar then
                begin
-                 htype.setdef(procinfo^._class);
+                 htype.setdef(procinfo._class);
                  vs:=tvarsym.create('@',htype);
                  vs.varspez:=vs_var;
                { insert the sym in the parasymtable }
                  tprocdef(aktprocdef).parast.insert(vs);
-                 inc(procinfo^.selfpointer_offset,vs.address);
+                 inc(procinfo.selfpointer_offset,vs.address);
                end
               else
                vs:=nil;
@@ -177,7 +177,7 @@ implementation
               aktprocdef.concatpara(tt,vs,varspez,nil);
               { check the types for procedures only }
               if not is_procvar then
-               CheckTypes(tt.def,procinfo^._class);
+               CheckTypes(tt.def,procinfo._class);
             end
           else
             begin
@@ -354,9 +354,9 @@ implementation
 
           { examine interface map: function/procedure iname.functionname=locfuncname }
           if parse_only and
-             assigned(procinfo^._class) and
-             assigned(procinfo^._class.implementedinterfaces) and
-             (procinfo^._class.implementedinterfaces.count>0) and
+             assigned(procinfo._class) and
+             assigned(procinfo._class.implementedinterfaces) and
+             (procinfo._class.implementedinterfaces.count>0) and
              try_to_consume(_POINT) then
             begin
                storepos:=akttokenpos;
@@ -371,7 +371,7 @@ implementation
                akttokenpos:=storepos;
                { load proc name }
                if sym.typ=typesym then
-                 i:=procinfo^._class.implementedinterfaces.searchintf(ttypesym(sym).restype.def);
+                 i:=procinfo._class.implementedinterfaces.searchintf(ttypesym(sym).restype.def);
                { qualifier is interface name? }
                if (sym.typ<>typesym) or (ttypesym(sym).restype.def.deftype<>objectdef) or
                   (i=-1) then
@@ -381,7 +381,7 @@ implementation
                  end
                else
                  begin
-                    aktprocsym:=tprocsym(procinfo^._class.implementedinterfaces.interfaces(i).symtable.search(sp));
+                    aktprocsym:=tprocsym(procinfo._class.implementedinterfaces.interfaces(i).symtable.search(sp));
                     { the method can be declared after the mapping FK
                       if not(assigned(aktprocsym)) then
                         Message(parser_e_methode_id_expected);
@@ -390,7 +390,7 @@ implementation
                consume(_ID);
                consume(_EQUAL);
                if (token=_ID) { and assigned(aktprocsym) } then
-                 procinfo^._class.implementedinterfaces.addmappings(i,sp,pattern);
+                 procinfo._class.implementedinterfaces.addmappings(i,sp,pattern);
                consume(_ID);
                exit;
           end;
@@ -427,11 +427,11 @@ implementation
              begin
                 { used to allow private syms to be seen }
                 aktobjectdef:=tobjectdef(ttypesym(sym).restype.def);
-                procinfo^._class:=tobjectdef(ttypesym(sym).restype.def);
-                aktprocsym:=tprocsym(procinfo^._class.symtable.search(sp));
+                procinfo._class:=tobjectdef(ttypesym(sym).restype.def);
+                aktprocsym:=tprocsym(procinfo._class.symtable.search(sp));
                 {The procedure has been found. So it is
                  a global one. Set the flags to mark this.}
-                procinfo^.flags:=procinfo^.flags or pi_is_global;
+                procinfo.flags:=procinfo.flags or pi_is_global;
                 aktobjectdef:=nil;
                 { we solve this below }
                 if not(assigned(aktprocsym)) then
@@ -471,7 +471,7 @@ implementation
                       DuplicateSym(aktprocsym);
                      {The procedure has been found. So it is
                       a global one. Set the flags to mark this.}
-                     procinfo^.flags:=procinfo^.flags or pi_is_global;
+                     procinfo.flags:=procinfo.flags or pi_is_global;
                    end;
                 end;
              end;
@@ -543,8 +543,8 @@ implementation
         aktprocdef:=tprocdef.create;
         aktprocdef.symtablelevel:=symtablestack.symtablelevel;
 
-        if assigned(procinfo^._class) then
-          aktprocdef._class := procinfo^._class;
+        if assigned(procinfo._class) then
+          aktprocdef._class := procinfo._class;
 
         { set the options from the caller (podestructor or poconstructor) }
         aktprocdef.proctypeoption:=options;
@@ -555,35 +555,35 @@ implementation
         { calculate frame pointer offset }
         if lexlevel>normal_function_level then
           begin
-            procinfo^.framepointer_offset:=paramoffset;
+            procinfo.framepointer_offset:=paramoffset;
             inc(paramoffset,pointer_size);
             { this is needed to get correct framepointer push for local
               forward functions !! }
             aktprocdef.parast.symtablelevel:=lexlevel;
           end;
 
-        if assigned (procinfo^._Class)  and
-           is_object(procinfo^._Class) and
+        if assigned (procinfo._Class)  and
+           is_object(procinfo._Class) and
            (aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) then
           inc(paramoffset,pointer_size);
 
         { self pointer offset                       }
         { self isn't pushed in nested procedure of methods }
-        if assigned(procinfo^._class) and (lexlevel=normal_function_level) then
+        if assigned(procinfo._class) and (lexlevel=normal_function_level) then
           begin
-            procinfo^.selfpointer_offset:=paramoffset;
+            procinfo.selfpointer_offset:=paramoffset;
             if assigned(aktprocdef) and
                not(po_containsself in aktprocdef.procoptions) then
               inc(paramoffset,pointer_size);
           end;
 
         { con/-destructor flag ? }
-        if assigned (procinfo^._Class) and
-           is_class(procinfo^._class) and
+        if assigned (procinfo._Class) and
+           is_class(procinfo._class) and
            (aktprocdef.proctypeoption in [potype_destructor,potype_constructor]) then
           inc(paramoffset,pointer_size);
 
-        procinfo^.para_offset:=paramoffset;
+        procinfo.para_offset:=paramoffset;
 
         aktprocdef.parast.datasize:=0;
 
@@ -654,11 +654,11 @@ implementation
         _CONSTRUCTOR : begin
                          consume(_CONSTRUCTOR);
                          parse_proc_head(potype_constructor);
-                         if assigned(procinfo^._class) and
-                            is_class(procinfo^._class) then
+                         if assigned(procinfo._class) and
+                            is_class(procinfo._class) then
                           begin
                             { CLASS constructors return the created instance }
-                            aktprocdef.rettype.setdef(procinfo^._class);
+                            aktprocdef.rettype.setdef(procinfo._class);
                           end
                          else
                           begin
@@ -677,7 +677,7 @@ implementation
                          consume(_OPERATOR);
                          if (token in [first_overloaded..last_overloaded]) then
                           begin
-                            procinfo^.flags:=procinfo^.flags or pi_operator;
+                            procinfo.flags:=procinfo.flags or pi_operator;
                             optoken:=token;
                           end
                          else
@@ -753,7 +753,7 @@ end;
 
 procedure pd_export;
 begin
-  if assigned(procinfo^._class) then
+  if assigned(procinfo._class) then
     Message(parser_e_methods_dont_be_export);
   if lexlevel<>normal_function_level then
     Message(parser_e_dont_nest_export);
@@ -761,7 +761,7 @@ begin
   if target_info.system=system_i386_os2 then
    begin
      aktprocdef.aliasnames.insert(aktprocsym.realname);
-     procinfo^.exported:=true;
+     procinfo.exported:=true;
      if cs_link_deffile in aktglobalswitches then
        deffile.AddExport(aktprocdef.mangledname);
    end;
@@ -1924,7 +1924,7 @@ const
          end;
 
         { insert otsym only in the right symtable }
-        if ((procinfo^.flags and pi_operator)<>0) and
+        if ((procinfo.flags and pi_operator)<>0) and
            assigned(otsym) then
          begin
            if not parse_only then
@@ -1957,7 +1957,10 @@ const
 end.
 {
   $Log$
-  Revision 1.63  2002-08-11 14:32:27  peter
+  Revision 1.64  2002-08-17 09:23:39  florian
+    * first part of procinfo rewrite
+
+  Revision 1.63  2002/08/11 14:32:27  peter
     * renamed current_library to objectlibrary
 
   Revision 1.62  2002/08/11 13:24:12  peter

compiler/pexpr.pas

@@ -954,40 +954,40 @@ implementation
 
         function is_func_ret(var p1:tnode;var sym : tsym;var srsymtable:tsymtable) : boolean;
         var
-           p : pprocinfo;
+           p : tprocinfo;
            storesymtablestack : tsymtable;
         begin
           is_func_ret:=false;
           if not assigned(procinfo) or
-             ((sym.typ<>funcretsym) and ((procinfo^.flags and pi_operator)=0)) then
+             ((sym.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0)) then
             exit;
           p:=procinfo;
           while assigned(p) do
             begin
                { is this an access to a function result? Accessing _RESULT is
                  always allowed and funcretn is generated }
-               if assigned(p^.procdef.funcretsym) and
-                  ((sym=tsym(p^.procdef.resultfuncretsym)) or
-                   ((sym=tsym(p^.procdef.funcretsym)) or
-                    ((sym=tsym(otsym)) and ((p^.flags and pi_operator)<>0))) and
-                   (not is_void(p^.procdef.rettype.def)) and
+               if assigned(p.procdef.funcretsym) and
+                  ((sym=tsym(p.procdef.resultfuncretsym)) or
+                   ((sym=tsym(p.procdef.funcretsym)) or
+                    ((sym=tsym(otsym)) and ((p.flags and pi_operator)<>0))) and
+                   (not is_void(p.procdef.rettype.def)) and
                    (token<>_LKLAMMER) and
                    (not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args)))
                   ) then
                  begin
                     if ((sym=tsym(otsym)) and
-                       ((p^.flags and pi_operator)<>0)) then
+                       ((p.flags and pi_operator)<>0)) then
                       inc(otsym.refs);
-                    p1:=cfuncretnode.create(p^.procdef.funcretsym);
+                    p1:=cfuncretnode.create(p.procdef.funcretsym);
                     is_func_ret:=true;
-                    if tfuncretsym(p^.procdef.funcretsym).funcretstate=vs_declared then
+                    if tfuncretsym(p.procdef.funcretsym).funcretstate=vs_declared then
                       begin
-                        tfuncretsym(p^.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
+                        tfuncretsym(p.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
                         include(p1.flags,nf_is_first_funcret);
                       end;
                     exit;
                  end;
-               p:=p^.parent;
+               p:=p.parent;
             end;
           { we must use the function call, update the
             sym to be the procsym }
@@ -1092,10 +1092,10 @@ implementation
                          begin
                            consume(_POINT);
                            if assigned(procinfo) and
-                              assigned(procinfo^._class) and
+                              assigned(procinfo._class) and
                               not(getaddr) then
                             begin
-                              if procinfo^._class.is_related(tobjectdef(htype.def)) then
+                              if procinfo._class.is_related(tobjectdef(htype.def)) then
                                begin
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
@@ -1694,7 +1694,7 @@ implementation
              begin
                again:=true;
                consume(_SELF);
-               if not assigned(procinfo^._class) then
+               if not assigned(procinfo._class) then
                 begin
                   p1:=cerrornode.create;
                   again:=false;
@@ -1705,11 +1705,11 @@ implementation
                   if (po_classmethod in aktprocdef.procoptions) then
                    begin
                      { self in class methods is a class reference type }
-                     htype.setdef(procinfo^._class);
+                     htype.setdef(procinfo._class);
                      p1:=cselfnode.create(tclassrefdef.create(htype));
                    end
                   else
-                   p1:=cselfnode.create(procinfo^._class);
+                   p1:=cselfnode.create(procinfo._class);
                   postfixoperators(p1,again);
                 end;
              end;
@@ -1718,7 +1718,7 @@ implementation
              begin
                again:=true;
                consume(_INHERITED);
-               if assigned(procinfo^._class) then
+               if assigned(procinfo._class) then
                 begin
                   { if inherited; only then we need the method with
                     the same name }
@@ -1733,7 +1733,7 @@ implementation
                      consume(_ID);
                      auto_inherited:=false;
                    end;
-                  classh:=procinfo^._class.childof;
+                  classh:=procinfo._class.childof;
                   sym:=searchsym_in_class(classh,hs);
                   if assigned(sym) then
                    begin
@@ -2248,7 +2248,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.75  2002-08-01 16:37:47  jonas
+  Revision 1.76  2002-08-17 09:23:39  florian
+    * first part of procinfo rewrite
+
+  Revision 1.75  2002/08/01 16:37:47  jonas
     - removed some superfluous "in_paras := true" statements
 
   Revision 1.74  2002/07/26 21:15:41  florian

compiler/pmodules.pas

@@ -645,7 +645,7 @@ implementation
         { and insert the procsym in symtable }
         st.insert(aktprocsym);
         { set some informations about the main program }
-        with procinfo^ do
+        with procinfo do
          begin
            _class:=nil;
            para_offset:=target_info.first_parm_offset;
@@ -1388,7 +1388,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  2002-08-11 13:24:12  peter
+  Revision 1.72  2002-08-17 09:23:39  florian
+    * first part of procinfo rewrite
+
+  Revision 1.71  2002/08/11 13:24:12  peter
     * saving of asmsymbols in ppu supported
     * asmsymbollist global is removed and moved into a new class
       tasmlibrarydata that will hold the info of a .a file which

compiler/powerpc/cgcpu.pas

@@ -150,7 +150,7 @@ const
   implementation
 
     uses
-       globtype,globals,verbose,systems,cutils,symconst,symdef,rgobj;
+       globtype,globals,verbose,systems,cutils,symconst,symdef,rgobj,tgobj,cpupi;
 
 { parameter passing... Still needs extra support from the processor }
 { independent code generator                                        }
@@ -254,14 +254,14 @@ const
          list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
          reference_reset_base(href,STACK_POINTER_REG,LA_RTOC);
          list.concat(taicpu.op_reg_ref(A_LWZ,R_TOC,href));
-         procinfo^.flags:=procinfo^.flags or pi_do_call;
+         procinfo.flags:=procinfo.flags or pi_do_call;
       end;
 
     { calling a code fragment through a reference }
     procedure tcgppc.a_call_ref(list : taasmoutput;const ref : treference);
       begin
          {$warning FIX ME}
-         procinfo^.flags:=procinfo^.flags or pi_do_call;
+         procinfo.flags:=procinfo.flags or pi_do_call;
       end;
 
 {********************** load instructions ********************}
@@ -857,6 +857,8 @@ const
          parastart : aword;
 
       begin
+        { we do our own localsize calculation }
+        localsize:=0;
         { CR and LR only have to be saved in case they are modified by the current }
         { procedure, but currently this isn't checked, so save them always         }
         { following is the entry code as described in "Altivec Programming }
@@ -886,7 +888,7 @@ const
             end;
 
         { save link register? }
-        if (procinfo^.flags and pi_do_call)<>0 then
+        if (procinfo.flags and pi_do_call)<>0 then
           begin
              { save return address... }
              list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_LR));
@@ -910,19 +912,13 @@ const
           inc(localsize,(ord(R_F31)-ord(firstregfpu)+1)*8);
 
         { align to 16 bytes }
-        if (localsize mod 16)<>0 then
-          localsize:=(localsize and $fffffff0)+16;
+        localsize:=align(localsize,16);
 
-        parastart:=localsize;
-        inc(localsize,procinfo^.maxpushedparasize);
+        inc(localsize,tg.lasttemp);
 
-        { align to 16 bytes }
-        if (localsize mod 16)<>0 then
-          localsize:=(localsize and $fffffff0)+16;
-
-        procinfo^.procdef.localst.address_fixup:=localsize-parastart;
+        localsize:=align(localsize,16);
 
-        procinfo^.localsize:=localsize;
+        tppcprocinfo(procinfo).localsize:=localsize;
 
         reference_reset_base(href,R_1,-localsize);
         list.concat(taicpu.op_reg_ref(A_STWU,R_1,href));
@@ -931,7 +927,7 @@ const
         gotgot:=false;
         if usesfpr then
           begin
-             { save floating-point registers }
+             { save floating-point registers
              if (cs_create_pic in aktmoduleswitches) and not(usesgpr) then
                begin
                   list.concat(taicpu.op_sym_ofs(A_BL,objectlibrary.newasmsymbol('_savefpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+'_g'),0));
@@ -939,6 +935,12 @@ const
                end
              else
                list.concat(taicpu.op_sym_ofs(A_BL,objectlibrary.newasmsymbol('_savefpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)),0));
+             }
+             for regcounter:=firstreggpr to R_F31 do
+               if regcounter in rg.usedbyproc then
+                 begin
+                 end;
+
              { compute end of gpr save area }
              list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_11,-(ord(R_F31)-ord(firstregfpu)+1)*8));
           end;
@@ -1021,9 +1023,9 @@ const
           begin
              { address of gpr save area to r11 }
              if usesfpr then
-               list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_1,procinfo^.localsize-(ord(R_F31)-ord(firstregfpu)+1)*8))
+               list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_1,tppcprocinfo(procinfo).localsize-(ord(R_F31)-ord(firstregfpu)+1)*8))
              else
-               list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_1,procinfo^.localsize));
+               list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_1,tppcprocinfo(procinfo).localsize));
 
              { restore gprs }
              { at least for now we use LMW }
@@ -1039,7 +1041,7 @@ const
           begin
              { address of fpr save area to r11 }
              list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_11,(ord(R_F31)-ord(firstregfpu)+1)*8));
-             if (procinfo^.flags and pi_do_call)<>0 then
+             if (procinfo.flags and pi_do_call)<>0 then
                list.concat(taicpu.op_sym_ofs(A_BL,objectlibrary.newasmsymbol('_restfpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+
                  '_x'),0))
              else
@@ -1052,10 +1054,10 @@ const
         if genret then
           begin
              { adjust r1 }
-             reference_reset_base(href,R_1,procinfo^.localsize);
+             reference_reset_base(href,R_1,tppcprocinfo(procinfo).localsize);
              list.concat(taicpu.op_reg_ref(A_STWU,R_1,href));
              { load link register? }
-             if (procinfo^.flags and pi_do_call)<>0 then
+             if (procinfo.flags and pi_do_call)<>0 then
                begin
                   reference_reset_base(href,STACK_POINTER_REG,4);
                   list.concat(taicpu.op_reg_ref(A_LWZ,R_0,href));
@@ -1666,7 +1668,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.42  2002-08-16 14:24:59  carl
+  Revision 1.43  2002-08-17 09:23:49  florian
+    * first part of procinfo rewrite
+
+  Revision 1.42  2002/08/16 14:24:59  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)

compiler/powerpc/cpupi.pas

@@ -0,0 +1,96 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    This unit contains the CPU specific part of tprocinfo
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+{ This unit contains the CPU specific part of tprocinfo. }
+unit cpupi;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cutils,
+       cgbase,cpuinfo;
+
+    type
+       tppcprocinfo = class(tprocinfo)
+          { overall size of allocated stack space, currently this is used for the PowerPC only }
+          localsize : aword;
+
+          { max. of space need for parameters, currently used by the PowerPC port only }
+          maxpushedparasize : aword;
+
+          constructor create;override;
+          procedure after_header;override;
+          procedure after_pass1;override;
+       end;
+
+
+  implementation
+
+    uses
+       globtype,globals,
+       aasmtai,
+       tgobj;
+
+    constructor tppcprocinfo.create;
+
+      begin
+         inherited create;
+         maxpushedparasize:=0;
+         localsize:=0;
+      end;
+
+    procedure tppcprocinfo.after_header;
+      begin
+         { this value is necessary for nested procedures }
+         procdef.localst.address_fixup:=align(procdef.parast.datasize,16);
+      end;
+
+    procedure tppcprocinfo.after_pass1;
+      begin
+         procdef.parast.address_fixup:=align(maxpushedparasize,16);
+         if cs_asm_source in aktglobalswitches then
+           aktproccode.insert(Tai_asm_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup))));
+         procdef.localst.address_fixup:=align(procdef.parast.address_fixup+procdef.parast.datasize,16);
+         if cs_asm_source in aktglobalswitches then
+           aktproccode.insert(Tai_asm_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup))));
+         procinfo.firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
+         if cs_asm_source in aktglobalswitches then
+           aktproccode.insert(Tai_asm_comment.Create(strpnew('Temp. space start: r1+'+tostr(procinfo.firsttemp_offset))));
+
+         //!!!! tg.setfirsttemp(procinfo.firsttemp_offset);
+         tg.firsttemp:=procinfo.firsttemp_offset;
+         tg.lasttemp:=procinfo.firsttemp_offset;
+      end;
+
+begin
+   cprocinfo:=tppcprocinfo;
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-17 09:23:49  florian
+    * first part of procinfo rewrite
+}
+
+

compiler/powerpc/nppccal.pas

@@ -31,6 +31,7 @@ interface
 
     type
        tppccallnode = class(tcgcallnode)
+          function pass_1 : tnode;override;
           procedure load_framepointer;override;
        end;
 
@@ -51,7 +52,24 @@ implementation
       cginfo,cgbase,pass_2,
       cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu,
       nmem,nld,ncnv,
-      ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
+      ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu,cpupi;
+
+  function tppccallnode.pass_1 : tnode;
+
+    begin
+       result:=inherited pass_1;
+       if assigned(result) then
+         exit;
+       if procdefinition is tprocdef then
+         begin
+            if tprocdef(procdefinition).parast.datasize>tppcprocinfo(procinfo).maxpushedparasize then
+              tppcprocinfo(procinfo).maxpushedparasize:=tprocdef(procdefinition).parast.datasize
+         end
+       else
+         begin
+            {!!!!}
+         end;
+    end;
 
   procedure tppccallnode.load_framepointer;
 
@@ -103,7 +121,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2002-08-13 21:40:59  florian
+  Revision 1.2  2002-08-17 09:23:49  florian
+    * first part of procinfo rewrite
+
+  Revision 1.1  2002/08/13 21:40:59  florian
     * more fixes for ppc calling conventions
 }
 

compiler/pstatmnt.pas

@@ -523,7 +523,7 @@ implementation
          oldaktexceptblock: integer;
 
       begin
-         procinfo^.flags:=procinfo^.flags or pi_uses_exceptions;
+         procinfo.flags:=procinfo.flags or pi_uses_exceptions;
 
          p_default:=nil;
          p_specific:=nil;
@@ -1012,10 +1012,10 @@ implementation
         i : longint;
       begin
         { replace framepointer with stackpointer }
-        procinfo^.framepointer:=STACK_POINTER_REG;
+        procinfo.framepointer:=STACK_POINTER_REG;
         { set the right value for parameters }
         dec(aktprocdef.parast.address_fixup,pointer_size);
-        dec(procinfo^.para_offset,pointer_size);
+        dec(procinfo.para_offset,pointer_size);
         { replace all references to parameters in the instructions,
           the parameters can be identified by the parafixup option
           that is set. For normal user coded [ebp+4] this field is not
@@ -1077,9 +1077,9 @@ implementation
 
          { temporary space is set, while the BEGIN of the procedure }
          if symtablestack.symtabletype=localsymtable then
-           procinfo^.firsttemp_offset := -symtablestack.datasize
+           procinfo.firsttemp_offset := -symtablestack.datasize
          else
-           procinfo^.firsttemp_offset := 0;
+           procinfo.firsttemp_offset := 0;
 
          { assembler code does not allocate }
          { space for the return value       }
@@ -1093,17 +1093,15 @@ implementation
               { update the symtablesize back to 0 if there were no locals }
               if not haslocals then
                symtablestack.datasize:=0;
+
               { set the used registers depending on the function result }
-              if paramanager.ret_in_reg(aktprocdef.rettype.def) then
-                begin
-                  rg.usedinproc := rg.usedinproc + 
-                    getfuncusedregisters(aktprocdef.rettype.def);
-                end;
+              procinfo.update_usedinproc_result;
+              
             end;
          { force the asm statement }
          if token<>_ASM then
            consume(_ASM);
-         procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
+         procinfo.Flags := procinfo.Flags Or pi_is_assembler;
          p:=_asm_statement;
 
 
@@ -1131,7 +1129,7 @@ implementation
 
         { Flag the result as assigned when it is returned in a
           register.
-        }  
+        }
         if assigned(aktprocdef.funcretsym) and
            paramanager.ret_in_reg(aktprocdef.rettype.def) then
           tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
@@ -1146,7 +1144,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  2002-08-16 14:24:58  carl
+  Revision 1.72  2002-08-17 09:23:40  florian
+    * first part of procinfo rewrite
+
+  Revision 1.71  2002/08/16 14:24:58  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)
@@ -1278,4 +1279,4 @@ end.
   Revision 1.45  2002/01/24 18:25:49  peter
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
-}
+}

compiler/psub.pas

@@ -106,11 +106,8 @@ implementation
               { insert in local symtable }
               symtablestack.insert(aktprocdef.funcretsym);
               akttokenpos:=storepos;
-              { the result will be returned in a register, then setup
-                the temp. memory for the result
-              }  
-              if paramanager.ret_in_reg(aktprocdef.rettype.def) then
-                procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
+
+              procinfo.set_result_offset;
               { insert result also if support is on }
               if (m_result in aktmodeswitches) then
                begin
@@ -120,32 +117,7 @@ implementation
            end;
          read_declarations(islibrary);
 
-         { temporary space is set, while the BEGIN of the procedure }
-         if (symtablestack.symtabletype=localsymtable) then
-           procinfo^.firsttemp_offset := -symtablestack.datasize
-         else
-           procinfo^.firsttemp_offset := 0;
-
-         { space for the return value }
-         { !!!!!   this means that we can not set the return value
-         in a subfunction !!!!! }
-         { because we don't know yet where the address is }
-         if not is_void(aktprocdef.rettype.def) then
-           begin
-              if paramanager.ret_in_reg(aktprocdef.rettype.def) then
-                begin
-                   { the space has been set in the local symtable }
-                   procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
-                   if ((procinfo^.flags and pi_operator)<>0) and
-                      assigned(otsym) then
-                     otsym.address:=-procinfo^.return_offset;
-                   { is the return result in registers? The
-                     set them as used in the routine
-                   }  
-                   rg.usedinproc := rg.usedinproc + 
-                      getfuncusedregisters(aktprocdef.rettype.def);
-                end;
-           end;
+         procinfo.handle_body_start;
 
          {Unit initialization?.}
          if (lexlevel=unit_init_level) and (current_module.is_unit)
@@ -221,7 +193,7 @@ implementation
          { calculate the lexical level }
          inc(lexlevel);
          if lexlevel>32 then
-          Message(parser_e_too_much_lexlevel);
+           Message(parser_e_too_much_lexlevel);
 
          { static is also important for local procedures !! }
          if (po_staticmethod in aktprocdef.procoptions) then
@@ -252,18 +224,18 @@ implementation
     {$endif state_tracking}
 
          { insert symtables for the class, by only if it is no nested function }
-         if assigned(procinfo^._class) and not(parent_has_class) then
+         if assigned(procinfo._class) and not(parent_has_class) then
            begin
              { insert them in the reverse order ! }
              hp:=nil;
              repeat
-               _class:=procinfo^._class;
+               _class:=procinfo._class;
                while _class.childof<>hp do
                  _class:=_class.childof;
                hp:=_class;
                _class.symtable.next:=symtablestack;
                symtablestack:=_class.symtable;
-             until hp=procinfo^._class;
+             until hp=procinfo._class;
            end;
 
          { insert parasymtable in symtablestack}
@@ -308,7 +280,7 @@ implementation
           code=nil, when we use aktprocsym.}
 
          { set the start offset to the start of the temp area in the stack }
-         tg.setfirsttemp(procinfo^.firsttemp_offset);
+         tg.setfirsttemp(procinfo.firsttemp_offset);
 
          { ... and generate assembler }
          { but set the right switches for entry !! }
@@ -336,10 +308,10 @@ implementation
                 { first generate entry code with the correct position and switches }
                 aktfilepos:=entrypos;
                 aktlocalswitches:=entryswitches;
-                genentrycode(procinfo^.aktentrycode,make_global,0,parasize,nostackframe,false);
+                genentrycode(procinfo.aktentrycode,make_global,0,parasize,nostackframe,false);
 
                 { FPC_POPADDRSTACK destroys all registers (JM) }
-                if (procinfo^.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0 then
+                if (procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0 then
                  begin
                    rg.usedinproc := ALL_REGISTERS;
                  end;
@@ -347,33 +319,33 @@ implementation
                 { now generate exit code with the correct position and switches }
                 aktfilepos:=exitpos;
                 aktlocalswitches:=exitswitches;
-                genexitcode(procinfo^.aktexitcode,parasize,nostackframe,false);
+                genexitcode(procinfo.aktexitcode,parasize,nostackframe,false);
 
                 { now all the registers used are known }
                 aktprocdef.usedregisters:=rg.usedinproc;
-                procinfo^.aktproccode.insertlist(procinfo^.aktentrycode);
-                procinfo^.aktproccode.concatlist(procinfo^.aktexitcode);
+                procinfo.aktproccode.insertlist(procinfo.aktentrycode);
+                procinfo.aktproccode.concatlist(procinfo.aktexitcode);
 {$ifdef i386}
    {$ifndef NoOpt}
                 if (cs_optimize in aktglobalswitches) and
                 { do not optimize pure assembler procedures }
-                   ((procinfo^.flags and pi_is_assembler)=0)  then
-                  Optimize(procinfo^.aktproccode);
+                   ((procinfo.flags and pi_is_assembler)=0)  then
+                  Optimize(procinfo.aktproccode);
    {$endif NoOpt}
 {$endif i386}
                 { save local data (casetable) also in the same file }
-                if assigned(procinfo^.aktlocaldata) and
-                   (not procinfo^.aktlocaldata.empty) then
+                if assigned(procinfo.aktlocaldata) and
+                   (not procinfo.aktlocaldata.empty) then
                  begin
-                   procinfo^.aktproccode.concat(Tai_section.Create(sec_data));
-                   procinfo^.aktproccode.concatlist(procinfo^.aktlocaldata);
-                   procinfo^.aktproccode.concat(Tai_section.Create(sec_code));
+                   procinfo.aktproccode.concat(Tai_section.Create(sec_data));
+                   procinfo.aktproccode.concatlist(procinfo.aktlocaldata);
+                   procinfo.aktproccode.concat(Tai_section.Create(sec_code));
                 end;
 
                 { add the procedure to the codesegment }
                 if (cs_create_smart in aktmoduleswitches) then
                  codeSegment.concat(Tai_cut.Create);
-                codeSegment.concatlist(procinfo^.aktproccode);
+                codeSegment.concatlist(procinfo.aktproccode);
               end
             else
               do_resulttypepass(code);
@@ -401,7 +373,7 @@ implementation
                  { remove cross unit overloads }
                  tstoredsymtable(aktprocdef.localst).unchain_overloaded;
                end;
-             if (procinfo^.flags and pi_uses_asm)=0 then
+             if (procinfo.flags and pi_uses_asm)=0 then
                begin
                   { not for unit init, becuase the var can be used in finalize,
                     it will be done in proc_unit }
@@ -507,7 +479,7 @@ implementation
       var
         oldprocsym       : tprocsym;
         oldprocdef       : tprocdef;
-        oldprocinfo      : pprocinfo;
+        oldprocinfo      : tprocinfo;
         oldconstsymtable : tsymtable;
         oldfilepos       : tfileposinfo;
         pdflags          : word;
@@ -519,7 +491,7 @@ implementation
          oldprocinfo:=procinfo;
       { create a new procedure }
          codegen_newprocedure;
-         with procinfo^ do
+         with procinfo do
           begin
             parent:=oldprocinfo;
           { clear flags }
@@ -528,12 +500,12 @@ implementation
             framepointer:=frame_pointer_reg;
           { is this a nested function of a method ? }
             if assigned(oldprocinfo) then
-              _class:=oldprocinfo^._class;
+              _class:=oldprocinfo._class;
           end;
 
          parse_proc_dec;
 
-         procinfo^.procdef:=aktprocdef;
+         procinfo.procdef:=aktprocdef;
 
          { set the default function options }
          if parse_only then
@@ -551,7 +523,7 @@ implementation
              pdflags:=pdflags or pd_implemen;
             if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
              pdflags:=pdflags or pd_global;
-            procinfo^.exported:=false;
+            procinfo.exported:=false;
             aktprocdef.forwarddef:=false;
           end;
 
@@ -595,8 +567,8 @@ implementation
          if not proc_add_definition(aktprocsym,aktprocdef) then
            begin
              { A method must be forward defined (in the object declaration) }
-             if assigned(procinfo^._class) and
-                (not assigned(oldprocinfo^._class)) then
+             if assigned(procinfo._class) and
+                (not assigned(oldprocinfo._class)) then
               begin
                 Message1(parser_e_header_dont_match_any_member,aktprocdef.fullprocname);
                 aktprocsym.write_parameter_lists(aktprocdef);
@@ -619,7 +591,7 @@ implementation
                    { check the global flag, for delphi this is not
                      required }
                    if not(m_delphi in aktmodeswitches) and
-                      ((procinfo^.flags and pi_is_global)<>0) then
+                      ((procinfo.flags and pi_is_global)<>0) then
                      Message(parser_e_overloaded_must_be_all_global);
                  end;
               end;
@@ -627,27 +599,25 @@ implementation
 
          { update procinfo, because the aktprocdef can be
            changed by check_identical_proc (PFV) }
-         procinfo^.procdef:=aktprocdef;
+         procinfo.procdef:=aktprocdef;
+
 
 {$ifdef i386}
          { add implicit pushes for interrupt routines }
          if (po_interrupt in aktprocdef.procoptions) then
+           procinfo.allocate_interrupt_stackframe;
            begin
-             { we push Flags and CS as long
-               to cope with the IRETD
-               and we save 6 register + 4 selectors }
-             inc(procinfo^.para_offset,8+6*4+4*2);
            end;
 {$endif i386}
 
          { pointer to the return value ? }
          if paramanager.ret_in_param(aktprocdef.rettype.def) then
           begin
-            procinfo^.return_offset:=procinfo^.para_offset;
-            inc(procinfo^.para_offset,pointer_size);
+            procinfo.return_offset:=procinfo.para_offset;
+            inc(procinfo.para_offset,pointer_size);
           end;
          { allows to access the parameters of main functions in nested functions }
-         aktprocdef.parast.address_fixup:=procinfo^.para_offset;
+         aktprocdef.parast.address_fixup:=procinfo.para_offset;
 
          { when it is a value para and it needs a local copy then rename
            the parameter and insert a copy in the localst. This is not done
@@ -670,7 +640,7 @@ implementation
             if assigned(aktprocdef._class) then
               tokeninfo^[_SELF].keyword:=m_all;
 
-             compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));
+             compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo._class));
 
             { reset _FAIL as normal }
             if (aktprocdef.proctypeoption=potype_constructor) then
@@ -816,7 +786,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.67  2002-08-16 14:24:59  carl
+  Revision 1.68  2002-08-17 09:23:41  florian
+    * first part of procinfo rewrite
+
+  Revision 1.67  2002/08/16 14:24:59  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)
@@ -960,4 +933,4 @@ end.
   Revision 1.42  2002/01/19 15:12:34  peter
     * check for unresolved forward classes in the interface
 
-}
+}

compiler/rautils.pas

@@ -741,8 +741,8 @@ Begin
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
        end;
-     opr.ref.offset:=procinfo^.return_offset;
-     opr.ref.base:= procinfo^.framepointer;
+     opr.ref.offset:=procinfo.return_offset;
+     opr.ref.base:= procinfo.framepointer;
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
      tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
@@ -759,11 +759,11 @@ end;
 Function TOperand.SetupSelf:boolean;
 Begin
   SetupSelf:=false;
-  if assigned(procinfo^._class) then
+  if assigned(procinfo._class) then
    Begin
      opr.typ:=OPR_REFERENCE;
-     opr.ref.offset:=procinfo^.selfpointer_offset;
-     opr.ref.base:=procinfo^.framepointer;
+     opr.ref.offset:=procinfo.selfpointer_offset;
+     opr.ref.base:=procinfo.framepointer;
      opr.ref.options:=ref_selffixup;
      SetupSelf:=true;
    end
@@ -778,8 +778,8 @@ Begin
   if lexlevel>normal_function_level then
    Begin
      opr.typ:=OPR_REFERENCE;
-     opr.ref.offset:=procinfo^.framepointer_offset;
-     opr.ref.base:=procinfo^.framepointer;
+     opr.ref.offset:=procinfo.framepointer_offset;
+     opr.ref.base:=procinfo.framepointer;
      opr.ref.options:=ref_parafixup;
      SetupOldEBP:=true;
    end
@@ -844,20 +844,20 @@ Begin
               { this below is wrong because there are two parast
                 for global functions one of interface the second of
                 implementation
-              if (tvarsym(sym).owner=procinfo^.def.parast) or }
+              if (tvarsym(sym).owner=procinfo.def.parast) or }
                 GetOffset then
                 begin
-                  opr.ref.base:=procinfo^.framepointer;
+                  opr.ref.base:=procinfo.framepointer;
                 end
               else
                 begin
                   if (aktprocdef.localst.datasize=0) and
-                     assigned(procinfo^.parent) and
+                     assigned(procinfo.parent) and
                      (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
                      { same problem as above !!
-                     (procinfo^.parent^.sym.definition.parast=tvarsym(sym).owner) and }
+                     (procinfo.parent^.sym.definition.parast=tvarsym(sym).owner) and }
                      (lexlevel>normal_function_level) then
-                    opr.ref.base:=procinfo^.parent^.framepointer
+                    opr.ref.base:=procinfo.parent.framepointer
                   else
                     message1(asmr_e_local_para_unreachable,s);
                 end;
@@ -886,17 +886,17 @@ Begin
                   { if we only want the offset we don't have to care
                     the base will be zeroed after ! }
                   if (lexlevel=tvarsym(sym).owner.symtablelevel) or
-                  {if (tvarsym(sym).owner=procinfo^.def.localst) or}
+                  {if (tvarsym(sym).owner=procinfo.def.localst) or}
                     GetOffset then
-                    opr.ref.base:=procinfo^.framepointer
+                    opr.ref.base:=procinfo.framepointer
                   else
                     begin
                       if (aktprocdef.localst.datasize=0) and
-                         assigned(procinfo^.parent) and
+                         assigned(procinfo.parent) and
                          (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
-                         {(procinfo^.parent^.sym.definition.localst=tvarsym(sym).owner) and}
+                         {(procinfo.parent^.sym.definition.localst=tvarsym(sym).owner) and}
                          (lexlevel>normal_function_level) then
-                        opr.ref.base:=procinfo^.parent^.framepointer
+                        opr.ref.base:=procinfo.parent.framepointer
                       else
                         message1(asmr_e_local_para_unreachable,s);
                     end;
@@ -1316,7 +1316,7 @@ Begin
   base:=Copy(s,1,i-1);
   delete(s,1,i);
   if base='SELF' then
-   st:=procinfo^._class.symtable
+   st:=procinfo._class.symtable
   else
    begin
      asmsearchsym(base,sym,srsymtable);
@@ -1592,7 +1592,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.43  2002-08-16 14:24:59  carl
+  Revision 1.44  2002-08-17 09:23:41  florian
+    * first part of procinfo rewrite
+
+  Revision 1.43  2002/08/16 14:24:59  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)

compiler/regvars.pas

@@ -144,7 +144,7 @@ implementation
       { only if no asm is used }
       { and no try statement   }
       if (cs_regalloc in aktglobalswitches) and
-         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+         ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
         begin
           new(regvarinfo);
           fillchar(regvarinfo^,sizeof(regvarinfo^),0);
@@ -228,7 +228,7 @@ implementation
                 { with assigning registers                       }
                 if aktmaxfpuregisters=-1 then
                   begin
-                   if (procinfo^.flags and pi_do_call)<>0 then
+                   if (procinfo.flags and pi_do_call)<>0 then
                      begin
                       for i:=maxfpuvarregs downto 2 do
                         regvarinfo^.fpuregvars[i]:=nil;
@@ -288,7 +288,7 @@ implementation
                       hr.offset:=-vsym.address+vsym.owner.address_fixup
                     else
                       hr.offset:=vsym.address+vsym.owner.address_fixup;
-                    hr.base:=procinfo^.framepointer;
+                    hr.base:=procinfo.framepointer;
                     cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
                   end;
                 asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
@@ -313,7 +313,7 @@ implementation
             hr.offset:=-vsym.address+vsym.owner.address_fixup
           else
             hr.offset:=vsym.address+vsym.owner.address_fixup;
-          hr.base:=procinfo^.framepointer;
+          hr.base:=procinfo.framepointer;
           if (vsym.varspez in [vs_var,vs_out]) or
              ((vsym.varspez=vs_const) and
                paramanager.push_addr_param(vsym.vartype.def)) then
@@ -362,7 +362,7 @@ implementation
       regvarinfo: pregvarinfo;
     begin
       if (cs_regalloc in aktglobalswitches) and
-         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+         ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
         begin
           regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
           { can happen when inlining assembler procedures (JM) }
@@ -444,7 +444,7 @@ implementation
       if not assigned(aktprocdef.regvarinfo) then
         exit;
       if (cs_regalloc in aktglobalswitches) and
-         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+         ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
         with pregvarinfo(aktprocdef.regvarinfo)^ do
           begin
 {$ifdef i386}
@@ -469,7 +469,10 @@ end.
 
 {
   $Log$
-  Revision 1.38  2002-08-06 20:55:22  florian
+  Revision 1.39  2002-08-17 09:23:41  florian
+    * first part of procinfo rewrite
+
+  Revision 1.38  2002/08/06 20:55:22  florian
     * first part of ppc calling conventions fix
 
   Revision 1.37  2002/07/20 11:57:57  florian

compiler/rgobj.pas

@@ -246,6 +246,10 @@ unit rgobj;
      procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
      procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
      procedure reference_release(list: taasmoutput; const ref : treference);
+     { This routine verifies if two references are the same, and
+        if so, returns TRUE, otherwise returns false.
+     }
+     function references_equal(sref : treference;dref : treference) : boolean;
 
      { tlocation handling }
      procedure location_reset(var l : tlocation;lt:TLoc;lsize:TCGSize);
@@ -887,6 +891,12 @@ unit rgobj;
         rg.ungetreference(list,ref);
       end;
 
+
+    function references_equal(sref : treference;dref : treference):boolean;
+      begin
+        references_equal:=CompareByte(sref,dref,sizeof(treference))=0;
+      end;
+
  { on most processors , this routine does nothing, overriden currently  }
  { only by 80x86 processor.                                             }
  function trgobj.makeregsize(reg: tregister; size: tcgsize): tregister;
@@ -953,7 +963,10 @@ end.
 
 {
   $Log$
-  Revision 1.16  2002-08-06 20:55:23  florian
+  Revision 1.17  2002-08-17 09:23:42  florian
+    * first part of procinfo rewrite
+
+  Revision 1.16  2002/08/06 20:55:23  florian
     * first part of ppc calling conventions fix
 
   Revision 1.15  2002/08/05 18:27:48  carl

compiler/symsym.pas

@@ -344,6 +344,8 @@ interface
 
        generrorsym : tsym;
 
+       otsym : tvarsym;
+
     const
        current_object_option : tsymoptions = [sp_public];
 
@@ -1249,7 +1251,7 @@ implementation
          funcretstate:=vs_declared;
          { address valid for ret in param only }
          { otherwise set by insert             }
-         address:=pprocinfo(procinfo)^.return_offset;
+         address:=procinfo.return_offset;
       end;
 
     constructor tfuncretsym.load(ppufile:tcompilerppufile);
@@ -1292,8 +1294,8 @@ implementation
       begin
         { if retoffset is already set then reuse it, this is needed
           when inserting the result variable }
-        if procinfo^.return_offset<>0 then
-         address:=procinfo^.return_offset
+        if procinfo.return_offset<>0 then
+         address:=procinfo.return_offset
         else
          begin
            { allocate space in local if ret in register }
@@ -1304,7 +1306,7 @@ implementation
               varalign:=used_align(varalign,aktalignment.localalignmin,owner.dataalignment);
               address:=align(owner.datasize+l,varalign);
               owner.datasize:=address;
-              procinfo^.return_offset:=-address;
+              procinfo.return_offset:=-address;
             end;
          end;
       end;
@@ -2671,7 +2673,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2002-08-16 14:24:59  carl
+  Revision 1.52  2002-08-17 09:23:42  florian
+    * first part of procinfo rewrite
+
+  Revision 1.51  2002/08/16 14:24:59  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)

compiler/symtable.pas

@@ -1264,24 +1264,24 @@ implementation
          hsym : tsym;
       begin
          { check for duplicate id in para symtable of methods }
-         if assigned(procinfo^._class) and
+         if assigned(procinfo._class) and
          { but not in nested procedures !}
-            (not(assigned(procinfo^.parent)) or
-             (assigned(procinfo^.parent) and
-              not(assigned(procinfo^.parent^._class)))
+            (not(assigned(procinfo.parent)) or
+             (assigned(procinfo.parent) and
+              not(assigned(procinfo.parent._class)))
             ) and
           { funcretsym is allowed !! }
            (sym.typ<>funcretsym) then
            begin
-              hsym:=search_class_member(procinfo^._class,sym.name);
+              hsym:=search_class_member(procinfo._class,sym.name);
               { private ids can be reused }
               if assigned(hsym) and
-                 tstoredsym(hsym).is_visible_for_object(procinfo^._class) then
+                 tstoredsym(hsym).is_visible_for_object(procinfo._class) then
                begin
                  { delphi allows to reuse the names in a class, but not
                    in object (tp7 compatible) }
                  if not((m_delphi in aktmodeswitches) and
-                        is_class_or_interface(procinfo^._class)) then
+                        is_class_or_interface(procinfo._class)) then
                   begin
                     DuplicateSym(hsym);
                     exit;
@@ -2072,7 +2072,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.66  2002-08-11 13:24:15  peter
+  Revision 1.67  2002-08-17 09:23:43  florian
+    * first part of procinfo rewrite
+
+  Revision 1.66  2002/08/11 13:24:15  peter
     * saving of asmsymbols in ppu supported
     * asmsymbollist global is removed and moved into a new class
       tasmlibrarydata that will hold the info of a .a file which

compiler/tgobj.pas

@@ -381,7 +381,7 @@ unit tgobj;
          { do a reset, because the reference isn't used }
          FillChar(ref,sizeof(treference),0);
          ref.offset:=gettempofsize(list,l);
-         ref.base:=procinfo^.framepointer;
+         ref.base:=procinfo.framepointer;
       end;
 
     procedure ttgobj.gettempofsizereferencepersistant(list: taasmoutput; l : longint;var ref : treference);
@@ -389,7 +389,7 @@ unit tgobj;
          { do a reset, because the reference isn't used }
          FillChar(ref,sizeof(treference),0);
          ref.offset:=gettempofsizepersistant(list,l);
-         ref.base:=procinfo^.framepointer;
+         ref.base:=procinfo.framepointer;
       end;
 
 
@@ -399,7 +399,7 @@ unit tgobj;
       begin
          { do a reset, because the reference isn't used }
          FillChar(ref,sizeof(treference),0);
-         ref.base:=procinfo^.framepointer;
+         ref.base:=procinfo.framepointer;
          { Reuse old slot ? }
          foundslot:=nil;
          tl:=templist;
@@ -499,7 +499,7 @@ unit tgobj;
          { ref.index = R_NO was missing
            led to problems with local arrays
            with lower bound > 0 (PM) }
-         istemp:=((ref.base=procinfo^.framepointer) and
+         istemp:=((ref.base=procinfo.framepointer) and
                   (ref.index=R_NO) and
                   (ref.offset<firsttemp));
       end;
@@ -679,7 +679,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.10  2002-07-01 18:46:29  peter
+  Revision 1.11  2002-08-17 09:23:44  florian
+    * first part of procinfo rewrite
+
+  Revision 1.10  2002/07/01 18:46:29  peter
     * internal linker
     * reorganized aasm layer
 

compiler/x86/cgx86.pas

@@ -1493,16 +1493,16 @@ unit cgx86;
 {$ifndef TEST_GENERIC}
     procedure tcgx86.g_call_constructor_helper(list : taasmoutput);
       begin
-        if is_class(procinfo^._class) then
+        if is_class(procinfo._class) then
           begin
-            procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+            procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
             a_call_name(list,'FPC_NEW_CLASS');
             list.concat(Taicpu.Op_cond_sym(A_Jcc,C_Z,S_NO,faillabel));
           end
-        else if is_object(procinfo^._class) then
+        else if is_object(procinfo._class) then
           begin
             rg.getexplicitregisterint(list,R_EDI);
-            a_load_const_reg(list,OS_ADDR,procinfo^._class.vmt_offset,R_EDI);
+            a_load_const_reg(list,OS_ADDR,procinfo._class.vmt_offset,R_EDI);
             a_call_name(list,'FPC_HELP_CONSTRUCTOR');
             list.concat(Taicpu.Op_cond_sym(A_Jcc,C_Z,S_NO,faillabel));
           end
@@ -1515,24 +1515,24 @@ unit cgx86;
         nofinal : tasmlabel;
         href : treference;
       begin
-        if is_class(procinfo^._class) then
+        if is_class(procinfo._class) then
          begin
            a_call_name(list,'FPC_DISPOSE_CLASS')
          end
-        else if is_object(procinfo^._class) then
+        else if is_object(procinfo._class) then
          begin
            { must the object be finalized ? }
-           if procinfo^._class.needs_inittable then
+           if procinfo._class.needs_inittable then
             begin
               objectlibrary.getlabel(nofinal);
               reference_reset_base(href,R_EBP,8);
               a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
               reference_reset_base(href,R_ESI,0);
-              g_finalize(list,procinfo^._class,href,false);
+              g_finalize(list,procinfo._class,href,false);
               a_label(list,nofinal);
             end;
            rg.getexplicitregisterint(list,R_EDI);
-           a_load_const_reg(list,OS_ADDR,procinfo^._class.vmt_offset,R_EDI);
+           a_load_const_reg(list,OS_ADDR,procinfo._class.vmt_offset,R_EDI);
            rg.ungetregisterint(list,R_EDI);
            a_call_name(list,'FPC_HELP_DESTRUCTOR')
          end
@@ -1544,18 +1544,18 @@ unit cgx86;
       var
         href : treference;
       begin
-        if is_class(procinfo^._class) then
+        if is_class(procinfo._class) then
           begin
-            reference_reset_base(href,procinfo^.framepointer,8);
+            reference_reset_base(href,procinfo.framepointer,8);
             a_load_ref_reg(list,OS_ADDR,href,R_ESI);
             a_call_name(list,'FPC_HELP_FAIL_CLASS');
           end
-        else if is_object(procinfo^._class) then
+        else if is_object(procinfo._class) then
           begin
-            reference_reset_base(href,procinfo^.framepointer,12);
+            reference_reset_base(href,procinfo.framepointer,12);
             a_load_ref_reg(list,OS_ADDR,href,R_ESI);
             rg.getexplicitregisterint(list,R_EDI);
-            a_load_const_reg(list,OS_ADDR,procinfo^._class.vmt_offset,R_EDI);
+            a_load_const_reg(list,OS_ADDR,procinfo._class.vmt_offset,R_EDI);
             a_call_name(list,'FPC_HELP_FAIL');
             rg.ungetregisterint(list,R_EDI);
           end
@@ -1644,7 +1644,10 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.11  2002-08-16 14:25:00  carl
+  Revision 1.12  2002-08-17 09:23:50  florian
+    * first part of procinfo rewrite
+
+  Revision 1.11  2002/08/16 14:25:00  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)