* moved implicit exception frame from ncgutil to psub

  * constructor/destructor helpers moved from cobj/ncgutil to psub

compiler/cgobj.pas

@@ -307,7 +307,6 @@ unit cgobj;
           }
          procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
 
-          function g_load_self(list : taasmoutput):tregister;
           procedure g_maybe_testself(list : taasmoutput;reg:tregister);
           procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
@@ -405,8 +404,6 @@ unit cgobj;
              @param(parasize  Number of bytes of parameters to deallocate from stack)
           }
           procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
-          procedure g_call_constructor_helper(list : taasmoutput);virtual;
-          procedure g_call_destructor_helper(list : taasmoutput);virtual;
           procedure g_call_fail_helper(list : taasmoutput);virtual;
           {# 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
@@ -1594,38 +1591,6 @@ unit cgobj;
       end;
 
 
-    function tcg.g_load_self(list : taasmoutput):tregister;
-      var
-         hp : treference;
-         p  : tprocinfo;
-         self_reg : tregister;
-      begin
-         if not assigned(current_procdef._class) then
-           internalerror(200303211);
-         self_reg:=rg.getaddressregister(list);
-         if current_procdef.parast.symtablelevel>normal_function_level then
-           begin
-             reference_reset_base(hp,current_procinfo.framepointer,current_procinfo.framepointer_offset);
-             a_load_ref_reg(list,OS_ADDR,hp,self_reg);
-             p:=current_procinfo.parent;
-             while (p.procdef.parast.symtablelevel>normal_function_level) do
-              begin
-                reference_reset_base(hp,self_reg,p.framepointer_offset);
-                a_load_ref_reg(list,OS_ADDR,hp,self_reg);
-                p:=p.parent;
-              end;
-             reference_reset_base(hp,self_reg,p.selfpointer_offset);
-             a_load_ref_reg(list,OS_ADDR,hp,self_reg);
-           end
-         else
-           begin
-             reference_reset_base(hp,current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-             a_load_ref_reg(list,OS_ADDR,hp,self_reg);
-           end;
-        g_load_self:=self_reg;
-      end;
-
-
     procedure tcg.g_maybe_testself(list : taasmoutput;reg:tregister);
       var
         OKLabel : tasmlabel;
@@ -1666,114 +1631,6 @@ unit cgobj;
                             Entry/Exit Code Functions
 *****************************************************************************}
 
-    procedure tcg.g_call_constructor_helper(list : taasmoutput);
-     var
-       href : treference;
-       acc : Tregister;
-     begin
-        if current_procinfo.vmtpointer_offset=0 then
-         internalerror(200303251);
-        if current_procinfo.selfpointer_offset=0 then
-         internalerror(200303252);
-        acc.enum:=R_INTREGISTER;
-        acc.number:=NR_ACCUMULATOR;
-        if is_class(current_procdef._class) then
-          begin
-            if (cs_implicit_exceptions in aktmoduleswitches) then
-              include(current_procinfo.flags,pi_needs_implicit_finally);
-            { parameter 2 : vmt pointer, 0 when called by inherited }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
-            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
-            { parameter 1 : self pointer }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
-            a_call_name(list,'FPC_NEW_CLASS');
-            { save the self pointer }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-            a_load_reg_ref(list,OS_ADDR,acc,href);
-            { fail? }
-            a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
-          end
-        else if is_object(current_procdef._class) then
-          begin
-            { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
-            { parameter 2 : address of pointer to vmt,
-              this is required to allow setting the vmt to -1 to indicate
-              that memory was allocated }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
-            a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
-            { parameter 1 : self pointer }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-            a_param_ref(list,OS_ADDR,href,paramanager.getintparaloc(1));
-            a_call_name(list,'FPC_HELP_CONSTRUCTOR');
-            { save the self pointer }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-            a_load_reg_ref(list,OS_ADDR,acc,href);
-            { fail? }
-            a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
-          end
-        else
-          internalerror(200006161);
-     end;
-
-
-    procedure tcg.g_call_destructor_helper(list : taasmoutput);
-      var
-        nofinal : tasmlabel;
-        href : treference;
-        reg  : tregister;
-     begin
-        if is_class(current_procdef._class) then
-         begin
-           if current_procinfo.selfpointer_offset=0 then
-            internalerror(200303253);
-           { parameter 2 : flag }
-           if current_procinfo.inheritedflag_offset=0 then
-            internalerror(200303251);
-           reference_reset_base(href, current_procinfo.framepointer,current_procinfo.inheritedflag_offset);
-           a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
-           { parameter 1 : self }
-           if current_procinfo.selfpointer_offset=0 then
-            internalerror(200303252);
-           reference_reset_base(href, current_procinfo.framepointer,current_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(current_procdef._class) then
-         begin
-            if current_procinfo.selfpointer_offset=0 then
-             internalerror(200303254);
-            if current_procinfo.vmtpointer_offset=0 then
-             internalerror(200303255);
-            { must the object be finalized ? }
-            if current_procdef._class.needs_inittable then
-             begin
-               objectlibrary.getlabel(nofinal);
-               reference_reset_base(href,current_procinfo.framepointer,target_info.first_parm_offset);
-               a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
-               reg:=g_load_self(list);
-               reference_reset_base(href,reg,0);
-               g_finalize(list,current_procdef._class,href,false);
-               reference_release(list,href);
-               a_label(list,nofinal);
-             end;
-            { actually call destructor }
-            { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
-            { parameter 2 : pointer to vmt }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
-            a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(2));
-            { parameter 1 : address of self pointer }
-            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-            a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(1));
-            a_call_name(list,'FPC_HELP_DESTRUCTOR');
-         end
-        else
-         internalerror(200006162);
-      end;
-
-
     procedure tcg.g_call_fail_helper(list : taasmoutput);
       var
         href : treference;
@@ -1880,7 +1737,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.95  2003-05-09 17:47:02  peter
+  Revision 1.96  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.95  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/ncal.pas

@@ -91,6 +91,7 @@ interface
           { only the processor specific nodes need to override this }
           { constructor                                             }
           constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
+          constructor create_def(l:tnode;def:tprocdef;mp:tnode);virtual;
           constructor create_procvar(l,r:tnode);
           constructor createintern(const name: string; params: tnode);
           constructor createinternres(const name: string; params: tnode; const res: ttype);
@@ -173,6 +174,8 @@ interface
        end;
        tprocinlinenodeclass = class of tprocinlinenode;
 
+    function initialize_data_node(p:tnode):tnode;
+    function finalize_data_node(p:tnode):tnode;
     function reverseparameters(p: tcallparanode): tcallparanode;
 
 
@@ -222,6 +225,36 @@ type
       end;
 
 
+    function initialize_data_node(p:tnode):tnode;
+      begin
+        result:=ccallnode.createintern('fpc_initialize',
+              ccallparanode.create(
+                  caddrnode.create(
+                      crttinode.create(
+                          tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
+              ccallparanode.create(
+                  p,
+              nil)));
+      end;
+
+
+    function finalize_data_node(p:tnode):tnode;
+      begin
+        if not assigned(p.resulttype.def) then
+          resulttypepass(p);
+        if p.resulttype.def.deftype<>pointerdef then
+          internalerror(2003051010);
+        result:=ccallnode.createintern('fpc_finalize',
+              ccallparanode.create(
+                  caddrnode.create(
+                      crttinode.create(
+                          tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
+              ccallparanode.create(
+                  p,
+              nil)));
+      end;
+
+
     function gen_high_tree(p:tnode;openstring:boolean):tnode;
       var
         temp: tnode;
@@ -535,8 +568,9 @@ type
 
       begin
          inherited create(callparan,expr,next);
-         if assigned(expr) then
-          expr.set_file_line(self);
+         if not assigned(expr) then
+           internalerror(200305091);
+         expr.set_file_line(self);
          callparaflags:=[];
       end;
 
@@ -876,7 +910,6 @@ type
  ****************************************************************************}
 
     constructor tcallnode.create(l:tnode;v : tprocsym;st : tsymtable; mp : tnode);
-
       begin
          inherited create(calln,l,nil);
          symtableprocentry:=v;
@@ -890,6 +923,20 @@ type
       end;
 
 
+    constructor tcallnode.create_def(l:tnode;def:tprocdef;mp:tnode);
+      begin
+         inherited create(calln,l,nil);
+         symtableprocentry:=nil;
+         symtableproc:=nil;
+         include(flags,nf_return_value_used);
+         methodpointer:=mp;
+         procdefinition:=def;
+         restypeset:=false;
+         funcretnode:=nil;
+         paralength:=-1;
+      end;
+
+
     constructor tcallnode.create_procvar(l,r:tnode);
       begin
          inherited create(calln,l,r);
@@ -1601,13 +1648,13 @@ type
                 else
                   begin
                     if methodpointer.nodetype=typen then
-                      selftree:=load_self
+                      selftree:=load_self_node
                     else
                       selftree:=methodpointer.getcopy;
                   end;
               end
             else
-              selftree:=load_self;
+              selftree:=load_self_node;
           end
         else
           begin
@@ -1639,7 +1686,7 @@ type
             else
               begin
                 if methodpointer.nodetype=typen then
-                  selftree:=load_self
+                  selftree:=load_self_node
                 else
                   selftree:=methodpointer.getcopy;
               end;
@@ -2682,7 +2729,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.150  2003-05-11 14:45:12  peter
+  Revision 1.151  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.150  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/ncgflw.pas

@@ -1097,10 +1097,8 @@ implementation
 
          cg.a_label(exprasmlist,exceptlabel);
 
-
          try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,endexceptlabel,false);
 
-
          cg.a_label(exprasmlist,doexceptlabel);
 
          { set control flow labels for the except block }
@@ -1119,110 +1117,134 @@ implementation
            secondpass(right);
 
          cg.a_label(exprasmlist,lastonlabel);
-         { default handling except handling }
-         if assigned(t1) then
+         if onlyreraise then
            begin
-              { FPC_CATCHES must be called with
-                'default handler' flag (=-1)
-              }
-              cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(1));
-              cg.a_call_name(exprasmlist,'FPC_CATCHES');
-
-              { the destruction of the exception object must be also }
-              { guarded by an exception frame                        }
-              objectlibrary.getlabel(doobjectdestroy);
-              objectlibrary.getlabel(doobjectdestroyandreraise);
+             { implicit except frame to cleanup and reraise only }
+             if assigned(t1) then
+               secondpass(t1);
+             cg.a_call_name(exprasmlist,'FPC_RERAISE');
+             if fc_exit in tryflowcontrol then
+               begin
+                 cg.a_label(exprasmlist,exittrylabel);
+                 cg.a_jmp_always(exprasmlist,oldaktexitlabel);
+               end;
+             if fc_break in tryflowcontrol then
+               begin
+                 cg.a_label(exprasmlist,breaktrylabel);
+                 cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
+               end;
+             if fc_continue in tryflowcontrol then
+               begin
+                 cg.a_label(exprasmlist,continuetrylabel);
+                 cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
+               end;
+           end
+         else
+           begin
+             { default handling except handling }
+             if assigned(t1) then
+               begin
+                  { FPC_CATCHES must be called with
+                    'default handler' flag (=-1)
+                  }
+                  cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(1));
+                  cg.a_call_name(exprasmlist,'FPC_CATCHES');
 
-              try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
+                  { the destruction of the exception object must be also }
+                  { guarded by an exception frame                        }
+                  objectlibrary.getlabel(doobjectdestroy);
+                  objectlibrary.getlabel(doobjectdestroyandreraise);
 
-              { here we don't have to reset flowcontrol           }
-              { the default and on flowcontrols are handled equal }
-              secondpass(t1);
-              exceptflowcontrol:=flowcontrol;
+                  try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
 
-              cg.a_label(exprasmlist,doobjectdestroyandreraise);
+                  { here we don't have to reset flowcontrol           }
+                  { the default and on flowcontrols are handled equal }
+                  secondpass(t1);
+                  exceptflowcontrol:=flowcontrol;
 
-              try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
+                  cg.a_label(exprasmlist,doobjectdestroyandreraise);
 
-              cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
+                  try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
 
-              r.enum:=R_INTREGISTER;
-              r.number:=NR_ACCUMULATOR;
-              cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
-              cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
-              { we don't need to restore esi here because reraise never }
-              { returns                                                 }
-              cg.a_call_name(exprasmlist,'FPC_RERAISE');
+                  cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
 
-              cg.a_label(exprasmlist,doobjectdestroy);
-              cleanupobjectstack;
-              cg.a_jmp_always(exprasmlist,endexceptlabel);
-           end
-         else
-           begin
-              cg.a_call_name(exprasmlist,'FPC_RERAISE');
-              exceptflowcontrol:=flowcontrol;
-           end;
+                  r.enum:=R_INTREGISTER;
+                  r.number:=NR_ACCUMULATOR;
+                  cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
+                  cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+                  { we don't need to restore esi here because reraise never }
+                  { returns                                                 }
+                  cg.a_call_name(exprasmlist,'FPC_RERAISE');
+
+                  cg.a_label(exprasmlist,doobjectdestroy);
+                  cleanupobjectstack;
+                  cg.a_jmp_always(exprasmlist,endexceptlabel);
+               end
+             else
+               begin
+                  cg.a_call_name(exprasmlist,'FPC_RERAISE');
+                  exceptflowcontrol:=flowcontrol;
+               end;
 
-         if fc_exit in exceptflowcontrol then
-           begin
-              { do some magic for exit in the try block }
-              cg.a_label(exprasmlist,exitexceptlabel);
-              { we must also destroy the address frame which guards }
-              { exception object                                    }
-              cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(exprasmlist,href);
-              cleanupobjectstack;
-              cg.a_jmp_always(exprasmlist,oldaktexitlabel);
-           end;
+             if fc_exit in exceptflowcontrol then
+               begin
+                  { do some magic for exit in the try block }
+                  cg.a_label(exprasmlist,exitexceptlabel);
+                  { we must also destroy the address frame which guards }
+                  { exception object                                    }
+                  cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cleanupobjectstack;
+                  cg.a_jmp_always(exprasmlist,oldaktexitlabel);
+               end;
 
-         if fc_break in exceptflowcontrol then
-           begin
-              cg.a_label(exprasmlist,breakexceptlabel);
-              { we must also destroy the address frame which guards }
-              { exception object                                    }
-              cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(exprasmlist,href);
-              cleanupobjectstack;
-              cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
-           end;
+             if fc_break in exceptflowcontrol then
+               begin
+                  cg.a_label(exprasmlist,breakexceptlabel);
+                  { we must also destroy the address frame which guards }
+                  { exception object                                    }
+                  cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cleanupobjectstack;
+                  cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
+               end;
 
-         if fc_continue in exceptflowcontrol then
-           begin
-              cg.a_label(exprasmlist,continueexceptlabel);
-              { we must also destroy the address frame which guards }
-              { exception object                                    }
-              cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(exprasmlist,href);
-              cleanupobjectstack;
-              cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
-           end;
+             if fc_continue in exceptflowcontrol then
+               begin
+                  cg.a_label(exprasmlist,continueexceptlabel);
+                  { we must also destroy the address frame which guards }
+                  { exception object                                    }
+                  cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cleanupobjectstack;
+                  cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
+               end;
 
-         if fc_exit in tryflowcontrol then
-           begin
-              { do some magic for exit in the try block }
-              cg.a_label(exprasmlist,exittrylabel);
-              cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(exprasmlist,href);
-              cg.a_jmp_always(exprasmlist,oldaktexitlabel);
-           end;
+             if fc_exit in tryflowcontrol then
+               begin
+                  { do some magic for exit in the try block }
+                  cg.a_label(exprasmlist,exittrylabel);
+                  cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cg.a_jmp_always(exprasmlist,oldaktexitlabel);
+               end;
 
-         if fc_break in tryflowcontrol then
-           begin
-              cg.a_label(exprasmlist,breaktrylabel);
-              cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(exprasmlist,href);
-              cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
-           end;
+             if fc_break in tryflowcontrol then
+               begin
+                  cg.a_label(exprasmlist,breaktrylabel);
+                  cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
+               end;
 
-         if fc_continue in tryflowcontrol then
-           begin
-              cg.a_label(exprasmlist,continuetrylabel);
-              cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(exprasmlist,href);
-              cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
+             if fc_continue in tryflowcontrol then
+               begin
+                  cg.a_label(exprasmlist,continuetrylabel);
+                  cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
+               end;
            end;
-
          cg.a_label(exprasmlist,endexceptlabel);
 
        errorexit:
@@ -1534,7 +1556,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2003-04-30 15:45:35  florian
+  Revision 1.59  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.58  2003/04/30 15:45:35  florian
     * merged more x86-64/i386 code
 
   Revision 1.57  2003/04/29 07:29:14  michael

compiler/ncgld.pas

@@ -249,25 +249,25 @@ implementation
                          end;
                     end;
 
-                  { handle call by reference variables }
-                  if (symtabletype in [parasymtable,inlineparasymtable]) then
+                  { handle call by reference variables, ignore the reference
+                    when we need to load the self pointer for objects }
+                  if (symtabletype in [parasymtable,inlineparasymtable]) and
+                     not(nf_load_self_pointer in flags) and
+                     (
+                      (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
+                      paramanager.push_addr_param(tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption)
+                     ) then
                     begin
-                      { in case call by reference, then calculate. Open array
-                        is always an reference! }
-                      if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
-                         paramanager.push_addr_param(tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption) then
-                        begin
-                           if hregister.enum=R_NO then
-                             hregister:=rg.getaddressregister(exprasmlist);
-                           { we need to load only an address }
-                           location.size:=OS_ADDR;
-                           cg.a_load_loc_reg(exprasmlist,location,hregister);
-                           if tvarsym(symtableentry).varspez=vs_const then
-                            location_reset(location,LOC_CREFERENCE,newsize)
-                           else
-                            location_reset(location,LOC_REFERENCE,newsize);
-                           location.reference.base:=hregister;
-                       end;
+                      if hregister.enum=R_NO then
+                        hregister:=rg.getaddressregister(exprasmlist);
+                      { we need to load only an address }
+                      location.size:=OS_ADDR;
+                      cg.a_load_loc_reg(exprasmlist,location,hregister);
+                      if tvarsym(symtableentry).varspez=vs_const then
+                       location_reset(location,LOC_CREFERENCE,newsize)
+                      else
+                       location_reset(location,LOC_REFERENCE,newsize);
+                      location.reference.base:=hregister;
                     end;
                end;
             procsym:
@@ -936,7 +936,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.56  2003-05-11 14:45:12  peter
+  Revision 1.57  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.56  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/ncgmem.pas

@@ -464,7 +464,7 @@ implementation
             if not(current_procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
              begin
                { Get high value }
-               hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
+               hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
                { it must be available }
                if not assigned(hightree) then
                  internalerror(200212201);
@@ -824,7 +824,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2003-05-11 14:45:12  peter
+  Revision 1.53  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.52  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/ncgutil.pas

@@ -1296,9 +1296,7 @@ implementation
         stackalloclist : taasmoutput;
         hp : tparaitem;
         paraloc : tparalocation;
-        rsp,
-        tmpreg : tregister;
-        inheriteddesctructorlabel : tasmlabel;
+        rsp : tregister;
       begin
         if not inlined then
            stackalloclist:=taasmoutput.Create;
@@ -1397,12 +1395,6 @@ implementation
               cg.g_profilecode(list);
           end;
 
-        { a constructor needs a help procedure }
-        if (current_procdef.proctypeoption=potype_constructor) then
-         begin
-           cg.g_call_constructor_helper(list);
-         end;
-
         if not is_void(current_procdef.rettype.def) then
           begin
              { for now the pointer to the result can't be a register }
@@ -1497,57 +1489,15 @@ implementation
               cg.a_call_name(list,'FPC_INITIALIZEUNITS');
             end;
 
-           { do we need an exception frame because of ansi/widestrings/interfaces ? }
-           if (pi_needs_implicit_finally in current_procinfo.flags) and
-              { but it's useless in init/final code of units }
-              not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
-            begin
-              include(rg.usedinproc,accumulator);
-              tg.GetTemp(list,JMP_BUF_SIZE,tt_noreuse,current_procinfo.exception_jmp_ref);
-              tg.GetTemp(list,12,tt_noreuse,current_procinfo.exception_env_ref);
-              tg.GetTemp(list,sizeof(aword),tt_noreuse,current_procinfo.exception_result_ref);
-              new_exception(list,current_procinfo.exception_jmp_ref,
-                  current_procinfo.exception_env_ref,
-                  current_procinfo.exception_result_ref,1,aktexitlabel);
-            end;
-
 {$ifdef GDB}
            if (cs_debuginfo in aktmoduleswitches) then
             list.concat(Tai_force_line.Create);
 {$endif GDB}
          end;
 
-        { maybe call BeforeDestruction for classes }
-        if (current_procdef.proctypeoption=potype_destructor) and
-           is_class(current_procdef._class) then
-         begin
-           objectlibrary.getlabel(inheriteddesctructorlabel);
-           reference_reset_base(href,current_procinfo.framepointer,current_procinfo.inheritedflag_offset);
-           cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,inheriteddesctructorlabel);
-           reference_reset_base(href,current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-         {$ifdef newra}
-           tmpreg:=rg.getaddressregister(list);
-         {$else}
-           tmpreg:=cg.get_scratch_reg_address(list);
-         {$endif}
-           cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
-           cg.a_param_reg(list,OS_ADDR,tmpreg,paramanager.getintparaloc(1));
-           reference_reset_base(href,tmpreg,0);
-           cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
-           reference_reset_base(href,tmpreg,72);
-           cg.a_call_ref(list,href);
-         {$ifdef newra}
-           rg.ungetregisterint(list,tmpreg);
-         {$else}
-           cg.free_scratch_reg(list,tmpreg);
-         {$endif}
-           cg.a_label(list,inheriteddesctructorlabel);
-         end;
-
         if inlined then
           load_regvars(list,nil);
 
-
         {************************* Stack allocation **************************}
         { and symbol entry point as well as debug information                 }
         { will be inserted in front of the rest of this list.                 }
@@ -1647,15 +1597,12 @@ implementation
         p : pchar;
         st : string[2];
 {$endif GDB}
-        inheritedconstructorlabel,
-        okexitlabel,
-        noreraiselabel,nodestroycall : tasmlabel;
+        okexitlabel : tasmlabel;
         href : treference;
         usesacc,
         usesacchi,
         usesself,usesfpu : boolean;
-        pd : tprocdef;
-        rsp,tmpreg,r  : Tregister;
+        rsp,r  : Tregister;
       begin
         if aktexit2label.is_used and
            ((pi_needs_implicit_finally in current_procinfo.flags) or
@@ -1671,11 +1618,6 @@ implementation
 
         cleanup_regvars(list);
 
-        { call the destructor help procedure }
-        if (current_procdef.proctypeoption=potype_destructor) and
-           assigned(current_procdef._class) then
-         cg.g_call_destructor_helper(list);
-
         { finalize temporary data }
         finalizetempvariables(list);
 
@@ -1701,89 +1643,6 @@ implementation
         if assigned(current_procdef.parast) then
           current_procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
 
-        { do we need to handle exceptions because of ansi/widestrings ? }
-        if not inlined and
-           (pi_needs_implicit_finally in current_procinfo.flags) and
-           { but it's useless in init/final code of units }
-           not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
-          begin
-             { the exception helper routines modify all registers }
-             current_procdef.usedintregisters:=all_intregisters;
-             current_procdef.usedotherregisters:=all_registers;
-             objectlibrary.getlabel(noreraiselabel);
-             free_exception(list,
-                  current_procinfo.exception_jmp_ref,
-                  current_procinfo.exception_env_ref,
-                  current_procinfo.exception_result_ref,0,
-                  noreraiselabel,false);
-             tg.Ungettemp(list,current_procinfo.exception_jmp_ref);
-             tg.Ungettemp(list,current_procinfo.exception_env_ref);
-             tg.Ungettemp(list,current_procinfo.exception_result_ref);
-
-             if (current_procdef.proctypeoption=potype_constructor) then
-               begin
-                  if assigned(current_procdef._class) then
-                    begin
-                       pd:=current_procdef._class.searchdestructor;
-                       if assigned(pd) then
-                         begin
-                            objectlibrary.getlabel(nodestroycall);
-                            { check VMT pointer if this is an inherited constructor }
-                            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
-                            cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
-{                            srsym:=pd.parast.searchsym('self');
-                            if not assigned(srsym) then
-                              internalerror(200305101);
-                            reference_reset_base(href,current_procinfo.framepointer,tvarsym(srsym).adjusted_address);
-                            cg.a_load_ref_reg( }
-                            r:=cg.g_load_self(list);
-                            if is_class(current_procdef._class) then
-                             begin
-                               cg.a_param_const(list,OS_INT,1,paramanager.getintparaloc(2));
-                               cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
-                             end
-                            else if is_object(current_procdef._class) then
-                             begin
-                               cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(2));
-                               reference_reset_symbol(href,objectlibrary.newasmsymboldata(current_procdef._class.vmt_mangledname),0);
-                               cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
-                             end
-                            else
-                             Internalerror(200006164);
-                            if (po_virtualmethod in pd.procoptions) then
-                             begin
-                               reference_reset_base(href,r,0);
-                               cg.a_load_ref_reg(list,OS_ADDR,href,r);
-                               reference_reset_base(href,r,current_procdef._class.vmtmethodoffset(pd.extnumber));
-                               cg.a_call_ref(list,href);
-                             end
-                            else
-                             cg.a_call_name(list,pd.mangledname);
-                            rg.ungetregisterint(list,r);
-                            { not necessary because the result is never assigned in the
-                              case of an exception (FK) }
-                            cg.a_label(list,nodestroycall);
-                         end;
-                    end
-               end
-             else
-              begin
-                { no constructor }
-                { must be the return value finalized before reraising the exception? }
-                if (not is_void(current_procdef.rettype.def)) and
-                   (current_procdef.rettype.def.needs_inittable) and
-                   ((current_procdef.rettype.def.deftype<>objectdef) or
-                    not is_class(current_procdef.rettype.def)) then
-                  begin
-                     reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
-                     cg.g_finalize(list,current_procdef.rettype.def,href,paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption));
-                  end;
-              end;
-
-             cg.a_call_name(list,'FPC_RERAISE');
-             cg.a_label(list,noreraiselabel);
-          end;
-
         { call __EXIT for main program }
         if (not DLLsource) and
            (not inlined) and
@@ -1803,44 +1662,17 @@ implementation
           begin
             if (current_procdef.proctypeoption=potype_constructor) then
               begin
-                objectlibrary.getlabel(inheritedconstructorlabel);
                 objectlibrary.getlabel(okexitlabel);
                 cg.a_jmp_always(list,okexitlabel);
                 { Failure exit }
                 cg.a_label(list,faillabel);
                 cg.g_call_fail_helper(list);
-                cg.a_jmp_always(list,inheritedconstructorlabel);
                 { Success exit }
                 cg.a_label(list,okexitlabel);
                 r.enum:=R_INTREGISTER;
                 r.number:=NR_ACCUMULATOR;
                 cg.a_reg_alloc(list,r);
-                { maybe call AfterConstructor for classes }
-                if is_class(current_procdef._class) then
-                 begin
-                   reference_reset_base(href,current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
-                   cg.a_load_ref_reg(list,OS_ADDR,href,r);
-                   cg.a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,r,inheritedconstructorlabel);
-                   reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-                   cg.a_load_ref_reg(list,OS_ADDR,href,r);
-                   cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
-                   reference_reset_base(href,r,0);
-                 {$ifdef newra}
-                   tmpreg:=rg.getaddressregister(list);
-                 {$else newra}
-                   tmpreg:=cg.get_scratch_reg_address(list);
-                 {$endif}
-                   cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
-                   reference_reset_base(href,tmpreg,68);
-                   cg.a_call_ref(list,href);
-                 {$ifdef newra}
-                   rg.ungetregisterint(list,tmpreg);
-                 {$else}
-                   cg.free_scratch_reg(list,tmpreg);
-                 {$endif}
-                 end;
                 { return the self pointer }
-                cg.a_label(list,inheritedconstructorlabel);
                 reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
                 cg.a_load_ref_reg(list,OS_ADDR,href,r);
                 cg.a_reg_dealloc(list,r);
@@ -2018,7 +1850,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.98  2003-05-11 14:45:12  peter
+  Revision 1.99  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.98  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/ncnv.pas

@@ -1178,7 +1178,7 @@ implementation
                            if assigned(tcallnode(left).methodpointer) then
                              tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy)
                            else
-                             tloadnode(hp).set_mp(load_self);
+                             tloadnode(hp).set_mp(load_self_node);
                          end;
                         resulttypepass(hp);
                       end;
@@ -2091,7 +2091,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.110  2003-05-09 17:47:02  peter
+  Revision 1.111  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.110  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/nflw.pas

@@ -33,8 +33,13 @@ interface
        symppu,symtype,symbase,symdef,symsym;
 
     type
+       { internal labels for gotonode.createintern }
+{       tgotolabel = (
+         gnl_fail
+       ); }
+
        { flags used by loop nodes }
-       tloopflags = (
+       tloopflag = (
          { set if it is a for ... downto ... do loop }
          lnf_backward,
          { Do we need to parse childs to set var state? }
@@ -45,6 +50,8 @@ interface
          lnf_checknegate,
          { Should the value of the loop variable on exit be correct. }
          lnf_dont_mind_loopvar_on_exit);
+       tloopflags = set of tloopflag;
+
     const
          { loop flags which must match to consider loop nodes equal regarding the flags }
          loopflagsequal = [lnf_backward];
@@ -52,7 +59,7 @@ interface
     type
        tloopnode = class(tbinarynode)
           t1,t2 : tnode;
-          loopflags : set of tloopflags;
+          loopflags : tloopflags;
           constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
@@ -117,7 +124,9 @@ interface
        tgotonode = class(tnode)
           labsym : tlabelsym;
           exceptionblock : integer;
+//          internlab : tinterngotolabel;
           constructor create(p : tlabelsym);virtual;
+//          constructor createintern(g:tinterngotolabel);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure derefimpl;override;
@@ -159,7 +168,9 @@ interface
        traisenodeclass = class of traisenode;
 
        ttryexceptnode = class(tloopnode)
+          onlyreraise : boolean;
           constructor create(l,r,_t1 : tnode);virtual;
+          constructor createintern(l,_t1 : tnode);virtual;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
        end;
@@ -1274,6 +1285,14 @@ implementation
     constructor ttryexceptnode.create(l,r,_t1 : tnode);
       begin
          inherited create(tryexceptn,l,r,_t1,nil);
+         onlyreraise:=false;
+      end;
+
+
+    constructor ttryexceptnode.createintern(l,_t1 : tnode);
+      begin
+         inherited create(tryexceptn,l,nil,_t1,nil);
+         onlyreraise:=true;
       end;
 
 
@@ -1503,7 +1522,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.72  2003-05-01 07:59:42  florian
+  Revision 1.73  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.72  2003/05/01 07:59:42  florian
     * introduced defaultordconsttype to decribe the default size of ordinal constants
       on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef
     + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs

compiler/ninl.pas

@@ -924,10 +924,12 @@ implementation
             { create a temp codepara, but save the original code para to }
             { assign the result to later on                              }
             if assigned(codepara) then
-              orgcode := codepara.left
+              begin
+                orgcode := codepara.left;
+                codepara.left := ctemprefnode.create(tempcode);
+              end
             else
-              codepara := ccallparanode.create(nil,nil);
-            codepara.left := ctemprefnode.create(tempcode);
+              codepara := ccallparanode.create(ctemprefnode.create(tempcode),nil);
             { we need its resulttype later on }
             codepara.get_paratype;
           end
@@ -1388,7 +1390,7 @@ implementation
                   set_varstate(left,false);
                   if paramanager.push_high_param(left.resulttype.def,current_procdef.proccalloption) then
                    begin
-                     hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
+                     hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
                      if assigned(hightree) then
                       begin
                         hp:=caddnode.create(addn,hightree,
@@ -1545,7 +1547,7 @@ implementation
                         if is_open_array(left.resulttype.def) or
                            is_array_of_const(left.resulttype.def) then
                          begin
-                           hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
+                           hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
                            if assigned(hightree) then
                             begin
                               hp:=caddnode.create(addn,hightree,
@@ -1788,7 +1790,7 @@ implementation
                            if is_open_array(left.resulttype.def) or
                               is_array_of_const(left.resulttype.def) then
                             begin
-                              result:=load_high_value(tvarsym(tloadnode(left).symtableentry));
+                              result:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
                             end
                            else
                             if is_dynamic_array(left.resulttype.def) then
@@ -1817,7 +1819,7 @@ implementation
                         else
                          begin
                            if is_open_string(left.resulttype.def) then
-                            result:=load_high_value(tvarsym(tloadnode(left).symtableentry))
+                            result:=load_high_value_node(tvarsym(tloadnode(left).symtableentry))
                            else
                             result:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8bittype,true);
                          end;
@@ -2349,7 +2351,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.110  2003-05-09 17:47:02  peter
+  Revision 1.111  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.110  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/nld.pas

@@ -127,8 +127,11 @@ interface
 
 
     procedure load_procvar_from_calln(var p1:tnode);
-    function load_high_value(vs:tvarsym):tnode;
-    function load_self:tnode;
+    function load_high_value_node(vs:tvarsym):tnode;
+    function load_self_node:tnode;
+    function load_result_node:tnode;
+    function load_self_pointer_node:tnode;
+    function load_vmt_pointer_node:tnode;
     function is_self_node(p:tnode):boolean;
 
 
@@ -179,7 +182,7 @@ implementation
         end;
 
 
-    function load_high_value(vs:tvarsym):tnode;
+    function load_high_value_node(vs:tvarsym):tnode;
       var
         srsym : tsym;
         srsymtable : tsymtable;
@@ -195,13 +198,16 @@ implementation
          end;
         srsym:=searchsymonlyin(srsymtable,'high'+vs.name);
         if assigned(srsym) then
-          result:=cloadnode.create(srsym,srsymtable)
+          begin
+            result:=cloadnode.create(srsym,srsymtable);
+            resulttypepass(result);
+          end
         else
           CGMessage(cg_e_illegal_expression);
       end;
 
 
-    function load_self:tnode;
+    function load_self_node:tnode;
       var
         srsym : tsym;
         srsymtable : tsymtable;
@@ -209,7 +215,62 @@ implementation
         result:=nil;
         searchsym('self',srsym,srsymtable);
         if assigned(srsym) then
-          result:=cloadnode.create(srsym,srsymtable)
+          begin
+            result:=cloadnode.create(srsym,srsymtable);
+            resulttypepass(result);
+          end
+        else
+          CGMessage(cg_e_illegal_expression);
+      end;
+
+
+    function load_result_node:tnode;
+      var
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        result:=nil;
+        searchsym('result',srsym,srsymtable);
+        if assigned(srsym) then
+          begin
+            result:=cloadnode.create(srsym,srsymtable);
+            resulttypepass(result);
+          end
+        else
+          CGMessage(cg_e_illegal_expression);
+      end;
+
+
+    function load_self_pointer_node:tnode;
+      var
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        result:=nil;
+        searchsym('self',srsym,srsymtable);
+        if assigned(srsym) then
+          begin
+            result:=cloadnode.create(srsym,srsymtable);
+            include(result.flags,nf_load_self_pointer);
+            resulttypepass(result);
+          end
+        else
+          CGMessage(cg_e_illegal_expression);
+      end;
+
+
+    function load_vmt_pointer_node:tnode;
+      var
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        result:=nil;
+        searchsym('vmt',srsym,srsymtable);
+        if assigned(srsym) then
+          begin
+            result:=cloadnode.create(srsym,srsymtable);
+            resulttypepass(result);
+          end
         else
           CGMessage(cg_e_illegal_expression);
       end;
@@ -327,23 +388,29 @@ implementation
               begin
                 { if it's refered by absolute then it's used }
                 if nf_absolute in flags then
-                  tvarsym(symtableentry).varstate:=vs_used;
-
-                { fix self type which is declared as voidpointer in the
-                  definition }
-                if vo_is_self in tvarsym(symtableentry).varoptions then
+                  tvarsym(symtableentry).varstate:=vs_used
+                else
                   begin
-                    if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
-                       (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
+                    { fix self type which is declared as voidpointer in the
+                      definition }
+                    if vo_is_self in tvarsym(symtableentry).varoptions then
+                      begin
+                        resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                        if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
+                           (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
+                          resulttype.setdef(tclassrefdef.create(resulttype))
+                        else if is_object(resulttype.def) and
+                                (nf_load_self_pointer in flags) then
+                          resulttype.setdef(tpointerdef.create(resulttype));
+                      end
+                    else if vo_is_vmt in tvarsym(symtableentry).varoptions then
                       begin
                         resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
                         resulttype.setdef(tclassrefdef.create(resulttype));
                       end
                     else
-                      resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
-                  end
-                else
-                  resulttype:=tvarsym(symtableentry).vartype;
+                      resulttype:=tvarsym(symtableentry).vartype;
+                  end;
               end;
             typedconstsym :
                 if not(nf_absolute in flags) then
@@ -1148,7 +1215,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.92  2003-05-11 14:45:12  peter
+  Revision 1.93  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.92  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/node.pas

@@ -234,11 +234,9 @@ interface
          nf_memseg,
          nf_callunique,
 
-         { twithnode }
-         nf_islocal,
-
          { tloadnode }
          nf_absolute,
+         nf_load_self_pointer,
 
          { taddnode }
          nf_is_currency,
@@ -988,7 +986,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.59  2003-05-09 17:47:02  peter
+  Revision 1.60  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.59  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/pexpr.pas

@@ -647,7 +647,7 @@ implementation
                end;
              objectsymtable :
                begin
-                 p1:=load_self;
+                 p1:=load_self_node;
                  maybe_load_methodpointer:=true;
                end;
            end;
@@ -817,7 +817,7 @@ implementation
                         withsymtable :
                           p1:=tnode(twithsymtable(st).withrefnode).getcopy;
                         objectsymtable :
-                          p1:=load_self;
+                          p1:=load_self_node;
                       end;
                     end;
                    if assigned(p1) then
@@ -1112,7 +1112,7 @@ implementation
 
                     case srsymtable.symtabletype of
                       objectsymtable :
-                        p1:=csubscriptnode.create(srsym,load_self);
+                        p1:=csubscriptnode.create(srsym,load_self_node);
                       withsymtable :
                         p1:=csubscriptnode.create(srsym,tnode(twithsymtable(srsymtable).withrefnode).getcopy);
                       else
@@ -1771,7 +1771,7 @@ implementation
                 end
                else
                 begin
-                  p1:=load_self;
+                  p1:=load_self_node;
                   postfixoperators(p1,again);
                 end;
              end;
@@ -2339,7 +2339,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.116  2003-05-11 14:45:12  peter
+  Revision 1.117  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.116  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/psub.pas

@@ -56,7 +56,7 @@ implementation
        ppu,fmodule,
        { pass 1 }
        node,
-       nbas,nld,
+       nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem,
        pass_1,
     {$ifdef state_tracking}
        nstate,
@@ -225,6 +225,259 @@ implementation
       end;
 
 
+    function generate_entry_block:tblocknode;
+      var
+        srsym        : tsym;
+        para         : tcallparanode;
+        newstatement : tstatementnode;
+        htype        : ttype;
+      begin
+        generate_entry_block:=internalstatements(newstatement,true);
+
+        { a constructor needs a help procedure }
+        if (current_procdef.proctypeoption=potype_constructor) then
+          begin
+            if is_class(current_procdef._class) then
+              begin
+                if (cs_implicit_exceptions in aktmoduleswitches) then
+                  include(current_procinfo.flags,pi_needs_implicit_finally);
+                srsym:=search_class_member(current_procdef._class,'NEWINSTANCE');
+                if assigned(srsym) and
+                   (srsym.typ=procsym) then
+                  begin
+                    { if vmt<>0 then newinstance }
+                    addstatement(newstatement,cifnode.create(
+                        caddnode.create(unequaln,
+                            load_vmt_pointer_node,
+                            cnilnode.create),
+                        cassignmentnode.create(
+                            ctypeconvnode.create_explicit(
+                                load_self_pointer_node,
+                                voidpointertype),
+                            ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
+                        nil));
+                  end
+                else
+                  internalerror(200305108);
+              end
+            else
+              if is_object(current_procdef._class) then
+                begin
+                  htype.setdef(current_procdef._class);
+                  htype.setdef(tpointerdef.create(htype));
+                  { parameter 3 : vmt_offset }
+                  { parameter 2 : address of pointer to vmt,
+                    this is required to allow setting the vmt to -1 to indicate
+                    that memory was allocated }
+                  { parameter 1 : self pointer }
+                  para:=ccallparanode.create(
+                            cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
+                        ccallparanode.create(
+                            ctypeconvnode.create_explicit(
+                                load_vmt_pointer_node,
+                                voidpointertype),
+                        ccallparanode.create(
+                            ctypeconvnode.create_explicit(
+                                load_self_pointer_node,
+                                voidpointertype),
+                        nil)));
+                  addstatement(newstatement,cassignmentnode.create(
+                      ctypeconvnode.create_explicit(
+                          load_self_pointer_node,
+                          voidpointertype),
+                      ccallnode.createintern('fpc_help_constructor',para)));
+                end
+            else
+              internalerror(200305103);
+            { if self=nil then fail }
+            addstatement(newstatement,cifnode.create(
+                caddnode.create(equaln,
+                    load_self_pointer_node,
+                    cnilnode.create),
+                cfailnode.create,
+                nil));
+          end;
+
+        { maybe call BeforeDestruction for classes }
+        if (current_procdef.proctypeoption=potype_destructor) and
+           is_class(current_procdef._class) then
+          begin
+            srsym:=search_class_member(current_procdef._class,'BEFOREDESTRUCTION');
+            if assigned(srsym) and
+               (srsym.typ=procsym) then
+              begin
+                { if vmt<>0 then beforedestruction }
+                addstatement(newstatement,cifnode.create(
+                    caddnode.create(unequaln,
+                        load_vmt_pointer_node,
+                        cnilnode.create),
+                    ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
+                    nil));
+              end
+            else
+              internalerror(200305104);
+          end;
+      end;
+
+
+    function generate_exit_block:tblocknode;
+      var
+        srsym : tsym;
+        para : tcallparanode;
+        newstatement : tstatementnode;
+      begin
+        generate_exit_block:=internalstatements(newstatement,true);
+
+        { maybe call AfterConstruction for classes }
+        if (current_procdef.proctypeoption=potype_constructor) and
+           is_class(current_procdef._class) then
+          begin
+            srsym:=search_class_member(current_procdef._class,'AFTERCONSTRUCTION');
+            if assigned(srsym) and
+               (srsym.typ=procsym) then
+              begin
+                { if vmt<>0 then afterconstruction }
+                addstatement(newstatement,cifnode.create(
+                    caddnode.create(unequaln,
+                        load_vmt_pointer_node,
+                        cnilnode.create),
+                    ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
+                    nil));
+              end
+            else
+              internalerror(200305106);
+          end;
+
+        { a destructor needs a help procedure }
+        if (current_procdef.proctypeoption=potype_destructor) then
+          begin
+            if is_class(current_procdef._class) then
+              begin
+                srsym:=search_class_member(current_procdef._class,'FREEINSTANCE');
+                if assigned(srsym) and
+                   (srsym.typ=procsym) then
+                  begin
+                    { if self<>0 and vmt=1 then freeinstance }
+                    addstatement(newstatement,cifnode.create(
+                        caddnode.create(andn,
+                            caddnode.create(unequaln,
+                                load_self_pointer_node,
+                                cnilnode.create),
+                            caddnode.create(equaln,
+                                ctypeconvnode.create(
+                                    load_vmt_pointer_node,
+                                    voidpointertype),
+                                cpointerconstnode.create(1,voidpointertype))),
+                        ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
+                        nil));
+                  end
+                else
+                  internalerror(200305108);
+              end
+            else
+              if is_object(current_procdef._class) then
+                begin
+                  { parameter 3 : vmt_offset }
+                  { parameter 2 : pointer to vmt }
+                  { parameter 1 : self pointer }
+                  para:=ccallparanode.create(
+                            cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
+                        ccallparanode.create(
+                            ctypeconvnode.create_explicit(
+                                load_vmt_pointer_node,
+                                voidpointertype),
+                        ccallparanode.create(
+                            ctypeconvnode.create_explicit(
+                                load_self_pointer_node,
+                                voidpointertype),
+                        nil)));
+                  addstatement(newstatement,
+                      ccallnode.createintern('fpc_help_destructor',para));
+                end
+            else
+              internalerror(200305105);
+          end;
+      end;
+
+
+    function generate_except_block:tblocknode;
+      var
+        pd : tprocdef;
+        newstatement : tstatementnode;
+      begin
+        generate_except_block:=internalstatements(newstatement,true);
+
+        { a constructor needs call destroy when it is not inherited }
+        if (current_procdef.proctypeoption=potype_constructor) then
+          begin
+            pd:=current_procdef._class.searchdestructor;
+            if assigned(pd) then
+              begin
+                { if vmt<>0 then call destructor }
+                addstatement(newstatement,cifnode.create(
+                    caddnode.create(unequaln,
+                        load_vmt_pointer_node,
+                        cnilnode.create),
+                    ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node),
+                    nil));
+              end
+            else
+              internalerror(200305107);
+          end
+        else
+          begin
+            { no constructor }
+            { must be the return value finalized before reraising the exception? }
+            if (not is_void(current_procdef.rettype.def)) and
+               (current_procdef.rettype.def.needs_inittable) and
+               (not is_class(current_procdef.rettype.def)) then
+              finalize_data_node(caddrnode.create(load_result_node));
+          end;
+      end;
+
+
+    procedure add_entry_exit_block(var code:tnode;const entrypos,exitpos:tfileposinfo);
+      var
+        entryblock,
+        exitblock,
+        newblock     : tblocknode;
+        newstatement : tstatementnode;
+        oldfilepos   : tfileposinfo;
+      begin
+        oldfilepos:=aktfilepos;
+        { Generate entry and exit }
+        aktfilepos:=entrypos;
+        entryblock:=generate_entry_block;
+        aktfilepos:=exitpos;
+        exitblock:=generate_exit_block;
+
+        { Generate procedure by combining entry+body+exit,
+          depending on the implicit finally we need to add
+          an try...finally...end wrapper }
+        newblock:=internalstatements(newstatement,true);
+        if (pi_needs_implicit_finally in current_procinfo.flags) and
+           { but it's useless in init/final code of units }
+           not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
+          begin
+            addstatement(newstatement,entryblock);
+            aktfilepos:=exitpos;
+            addstatement(newstatement,ctryexceptnode.createintern(
+               code,
+               generate_except_block));
+            addstatement(newstatement,exitblock);
+          end
+        else
+          begin
+            addstatement(newstatement,entryblock);
+            addstatement(newstatement,code);
+            addstatement(newstatement,exitblock);
+          end;
+        resulttypepass(newblock);
+        code:=newblock;
+        aktfilepos:=oldfilepos;
+      end;
+
+
     procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
       {
         Compile the body of a procedure
@@ -325,13 +578,6 @@ implementation
          localmaxfpuregisters:=aktmaxfpuregisters;
          { parse the code ... }
          code:=block(current_module.islibrary);
-         { store a copy of the original tree for inline, for
-           normal procedures only store a reference to the
-           current tree }
-         if (current_procdef.proccalloption=pocall_inline) then
-           current_procdef.code:=code.getcopy
-         else
-           current_procdef.code:=code;
          { get a better entry point }
          if assigned(code) then
            entrypos:=code.fileinfo;
@@ -340,6 +586,16 @@ implementation
          exitpos:=last_endtoken_filepos;
          { save current filepos }
          savepos:=aktfilepos;
+         { add implicit entry and exit code }
+         if assigned(code) then
+           add_entry_exit_block(code,entrypos,exitpos);
+         { store a copy of the original tree for inline, for
+           normal procedures only store a reference to the
+           current tree }
+         if (current_procdef.proccalloption=pocall_inline) then
+           current_procdef.code:=code.getcopy
+         else
+           current_procdef.code:=code;
 
          {When we are called to compile the body of a unit, aktprocsym should
           point to the unit initialization. If the unit has no initialization,
@@ -842,7 +1098,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.108  2003-05-09 17:47:03  peter
+  Revision 1.109  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.108  2003/05/09 17:47:03  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/symdef.pas

@@ -240,8 +240,6 @@ interface
 
        tobjectdef = class(tabstractrecorddef)
        private
-          sd : tprocdef;
-          procedure _searchdestructor(sym : tnamedindexitem;arg:pointer);
 {$ifdef GDB}
           procedure addprocname(p :tnamedindexitem;arg:pointer);
 {$endif GDB}
@@ -4607,26 +4605,27 @@ implementation
           end;
      end;*)
 
-    procedure Tobjectdef._searchdestructor(sym:Tnamedindexitem;arg:pointer);
+    procedure _searchdestructor(sym:Tnamedindexitem;sd:pointer);
 
     begin
         { if we found already a destructor, then we exit }
-        if (sd=nil) and (Tsym(sym).typ=procsym) then
-            sd:=Tprocsym(sym).search_procdef_bytype(potype_destructor);
+        if (ppointer(sd)^=nil) and
+           (Tsym(sym).typ=procsym) then
+          ppointer(sd)^:=Tprocsym(sym).search_procdef_bytype(potype_destructor);
     end;
 
    function tobjectdef.searchdestructor : tprocdef;
 
      var
         o : tobjectdef;
-
+        sd : tprocdef;
      begin
         searchdestructor:=nil;
         o:=self;
         sd:=nil;
         while assigned(o) do
           begin
-             symtable.foreach({$ifdef FPCPROCVAR}@{$endif}_searchdestructor,nil);
+             o.symtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}_searchdestructor,@sd);
              if assigned(sd) then
                begin
                   searchdestructor:=sd;
@@ -5762,7 +5761,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.141  2003-05-09 17:47:03  peter
+  Revision 1.142  2003-05-11 21:37:03  peter
+    * moved implicit exception frame from ncgutil to psub
+    * constructor/destructor helpers moved from cobj/ncgutil to psub
+
+  Revision 1.141  2003/05/09 17:47:03  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn