* failn removed

  * inherited result code check moven to pexpr

compiler/cgbase.pas

@@ -191,7 +191,6 @@ unit cgbase;
        aktexit2label : tasmlabel;
 
        {# only used in constructor for fail keyword or if getmem fails }
-       faillabel      : tasmlabel;
        quickexitlabel : tasmlabel;
 
        {# true, if there was an error while code generation occurs }
@@ -641,7 +640,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  2003-05-09 17:47:02  peter
+  Revision 1.47  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.46  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/cgobj.pas

@@ -404,7 +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_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
              routine, and which should be declared as saved in the std_saved_registers
@@ -1631,45 +1630,6 @@ unit cgobj;
                             Entry/Exit Code Functions
 *****************************************************************************}
 
-    procedure tcg.g_call_fail_helper(list : taasmoutput);
-      var
-        href : treference;
-     begin
-        if is_class(current_procdef._class) then
-          begin
-            if current_procinfo.selfpointer_offset=0 then
-             internalerror(200303256);
-            { parameter 2 : flag, 0 -> inherited call (=no dispose) }
-            a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
-            { parameter 1 : self }
-            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(200303257);
-            if current_procinfo.vmtpointer_offset=0 then
-             internalerror(200303258);
-            { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
-            { parameter 2 : pointer to vmt, will be reset to 0 when freed }
-            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_FAIL');
-          end
-        else
-          internalerror(200006163);
-        { set self to nil }
-        reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
-        a_load_const_ref(list,OS_ADDR,0,href);
-      end;
-
-
     procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
       begin
       end;
@@ -1737,7 +1697,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.96  2003-05-11 21:37:03  peter
+  Revision 1.97  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  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
 

compiler/nbas.pas

@@ -292,10 +292,6 @@ implementation
     function tstatementnode.pass_1 : tnode;
       begin
          result:=nil;
-         { no temps over several statements }
-      {$ifndef newra}
-         rg.cleartempgen;
-      {$endif}
          { left is the statement itself calln assignn or a complex one }
          firstpass(left);
          if codegenerror then
@@ -426,9 +422,6 @@ implementation
                 end;
               if assigned(hp.left) then
                 begin
-                {$ifndef newra}
-                   rg.cleartempgen;
-                {$endif}
                    codegenerror:=false;
                    firstpass(hp.left);
 
@@ -805,7 +798,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.49  2003-05-11 14:45:12  peter
+  Revision 1.50  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.49  2003/05/11 14:45:12  peter
     * tloadnode does not support objectsymtable,withsymtable anymore
     * withnode cleanup
     * direct with rewritten to use temprefnode

compiler/ncgcal.pas

@@ -856,26 +856,11 @@ implementation
          testregisters32;
 {$endif TEMPREGDEBUG}
 
-         { Called an inherited constructor? Then
-           we need to check the result }
-         if (inlined or (right=nil)) and
-            (procdefinition.proctypeoption=potype_constructor) and
-            assigned(methodpointer) and
-            (methodpointer.nodetype=typen) and
-            (current_procdef.proctypeoption=potype_constructor) then
-          begin
-            accreg.enum:=R_INTREGISTER;
-            accreg.number:=NR_ACCUMULATOR;
-            cg.a_reg_alloc(exprasmlist,accreg);
-            cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accreg,faillabel);
-            cg.a_reg_dealloc(exprasmlist,accreg);
-          end;
-
          { handle function results }
          if (not is_void(resulttype.def)) then
-          handle_return_value(inlined)
+           handle_return_value(inlined)
          else
-          location_reset(location,LOC_VOID,OS_NO);
+           location_reset(location,LOC_VOID,OS_NO);
 
          { perhaps i/o check ? }
          if iolabel<>nil then
@@ -1140,7 +1125,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.62  2003-05-13 15:18:18  peter
+  Revision 1.63  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.62  2003/05/13 15:18:18  peter
     * generate code for procvar first before pushing parameters. Made
       the already existing code for powerpc available for all platforms
 

compiler/ncgflw.pas

@@ -63,10 +63,6 @@ interface
           procedure pass_2;override;
        end;
 
-       tcgfailnode = class(tfailnode)
-          procedure pass_2;override;
-       end;
-
        tcgraisenode = class(traisenode)
           procedure pass_2;override;
        end;
@@ -901,18 +897,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                             SecondFail
-*****************************************************************************}
-
-    procedure tcgfailnode.pass_2;
-      begin
-        location_reset(location,LOC_VOID,OS_NO);
-
-        cg.a_jmp_always(exprasmlist,faillabel);
-      end;
-
-
 {*****************************************************************************
                              SecondRaise
 *****************************************************************************}
@@ -1117,133 +1101,108 @@ implementation
            secondpass(right);
 
          cg.a_label(exprasmlist,lastonlabel);
-         if onlyreraise then
-           begin
-             { 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
+         { default handling except handling }
+         if assigned(t1) then
            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');
+              { 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);
+              { the destruction of the exception object must be also }
+              { guarded by an exception frame                        }
+              objectlibrary.getlabel(doobjectdestroy);
+              objectlibrary.getlabel(doobjectdestroyandreraise);
 
-                  try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
+              try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
 
-                  { here we don't have to reset flowcontrol           }
-                  { the default and on flowcontrols are handled equal }
-                  secondpass(t1);
-                  exceptflowcontrol:=flowcontrol;
+              { here we don't have to reset flowcontrol           }
+              { the default and on flowcontrols are handled equal }
+              secondpass(t1);
+              exceptflowcontrol:=flowcontrol;
 
-                  cg.a_label(exprasmlist,doobjectdestroyandreraise);
+              cg.a_label(exprasmlist,doobjectdestroyandreraise);
 
-                  try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
+              try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
 
-                  cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
+              cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
 
-                  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;
+              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');
 
-             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;
+              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_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_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_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_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_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_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_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_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_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;
+         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);
            end;
          cg.a_label(exprasmlist,endexceptlabel);
 
@@ -1265,6 +1224,7 @@ implementation
            tryflowcontrol;
       end;
 
+
     procedure tcgonnode.pass_2;
       var
          nextonlabel,
@@ -1434,15 +1394,26 @@ implementation
          { statements                                            }
          oldaktexitlabel:=aktexitlabel;
          oldaktexit2label:=aktexit2label;
-         objectlibrary.getlabel(exitfinallylabel);
+         if implicitframe then
+           exitfinallylabel:=finallylabel
+         else
+           objectlibrary.getlabel(exitfinallylabel);
          aktexitlabel:=exitfinallylabel;
          aktexit2label:=exitfinallylabel;
          if assigned(aktbreaklabel) then
           begin
             oldaktcontinuelabel:=aktcontinuelabel;
             oldaktbreaklabel:=aktbreaklabel;
-            objectlibrary.getlabel(breakfinallylabel);
-            objectlibrary.getlabel(continuefinallylabel);
+            if implicitframe then
+              begin
+                breakfinallylabel:=finallylabel;
+                continuefinallylabel:=finallylabel;
+              end
+            else
+              begin
+                objectlibrary.getlabel(breakfinallylabel);
+                objectlibrary.getlabel(continuefinallylabel);
+              end;
             aktcontinuelabel:=continuefinallylabel;
             aktbreaklabel:=breakfinallylabel;
           end;
@@ -1475,55 +1446,69 @@ implementation
          cg.g_exception_reason_load(exprasmlist,href);
          r.enum:=R_INTREGISTER;
          r.number:=NR_ACCUMULATOR;
-         cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
-         cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
-         cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
-         if fc_exit in tryflowcontrol then
+         if implicitframe then
            begin
-              cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
-              cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktexitlabel);
-              decconst:=1;
-           end
-         else
-           decconst:=2;
-         if fc_break in tryflowcontrol then
-           begin
-              cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
-              cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktbreaklabel);
-              decconst:=1;
+             cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
+             { finally code only needed to be executed on exception }
+             flowcontrol:=[];
+             secondpass(t1);
+             if flowcontrol<>[] then
+               CGMessage(cg_e_control_flow_outside_finally);
+             if codegenerror then
+               exit;
+             cg.a_call_name(exprasmlist,'FPC_RERAISE');
            end
          else
-           inc(decconst);
-         if fc_continue in tryflowcontrol then
-           begin
-              cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
-              cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktcontinuelabel);
-           end;
-         cg.a_label(exprasmlist,reraiselabel);
-         cg.a_call_name(exprasmlist,'FPC_RERAISE');
-         { do some magic for exit,break,continue in the try block }
-         if fc_exit in tryflowcontrol then
            begin
-              cg.a_label(exprasmlist,exitfinallylabel);
-              cg.g_exception_reason_load(exprasmlist,href);
-              cg.g_exception_reason_save_const(exprasmlist,href,2);
-              cg.a_jmp_always(exprasmlist,finallylabel);
-           end;
-         if fc_break in tryflowcontrol then
-          begin
-             cg.a_label(exprasmlist,breakfinallylabel);
-             cg.g_exception_reason_load(exprasmlist,href);
-             cg.g_exception_reason_save_const(exprasmlist,href,3);
-             cg.a_jmp_always(exprasmlist,finallylabel);
-           end;
-         if fc_continue in tryflowcontrol then
-           begin
-              cg.a_label(exprasmlist,continuefinallylabel);
-              cg.g_exception_reason_load(exprasmlist,href);
-              cg.g_exception_reason_save_const(exprasmlist,href,4);
-              cg.a_jmp_always(exprasmlist,finallylabel);
+             cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
+             cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
+             cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
+             if fc_exit in tryflowcontrol then
+               begin
+                  cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
+                  cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktexitlabel);
+                  decconst:=1;
+               end
+             else
+               decconst:=2;
+             if fc_break in tryflowcontrol then
+               begin
+                  cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
+                  cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktbreaklabel);
+                  decconst:=1;
+               end
+             else
+               inc(decconst);
+             if fc_continue in tryflowcontrol then
+               begin
+                  cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
+                  cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktcontinuelabel);
+               end;
+             cg.a_label(exprasmlist,reraiselabel);
+             cg.a_call_name(exprasmlist,'FPC_RERAISE');
+             { do some magic for exit,break,continue in the try block }
+             if fc_exit in tryflowcontrol then
+               begin
+                  cg.a_label(exprasmlist,exitfinallylabel);
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cg.g_exception_reason_save_const(exprasmlist,href,2);
+                  cg.a_jmp_always(exprasmlist,finallylabel);
+               end;
+             if fc_break in tryflowcontrol then
+              begin
+                 cg.a_label(exprasmlist,breakfinallylabel);
+                 cg.g_exception_reason_load(exprasmlist,href);
+                 cg.g_exception_reason_save_const(exprasmlist,href,3);
+                 cg.a_jmp_always(exprasmlist,finallylabel);
+               end;
+             if fc_continue in tryflowcontrol then
+               begin
+                  cg.a_label(exprasmlist,continuefinallylabel);
+                  cg.g_exception_reason_load(exprasmlist,href);
+                  cg.g_exception_reason_save_const(exprasmlist,href,4);
+                  cg.a_jmp_always(exprasmlist,finallylabel);
+               end;
            end;
-
          cg.a_label(exprasmlist,endfinallylabel);
 
          aktexitlabel:=oldaktexitlabel;
@@ -1537,8 +1522,6 @@ implementation
       end;
 
 
-
-
 begin
    cwhilerepeatnode:=tcgwhilerepeatnode;
    cifnode:=tcgifnode;
@@ -1548,7 +1531,6 @@ begin
    ccontinuenode:=tcgcontinuenode;
    cgotonode:=tcggotonode;
    clabelnode:=tcglabelnode;
-   cfailnode:=tcgfailnode;
    craisenode:=tcgraisenode;
    ctryexceptnode:=tcgtryexceptnode;
    ctryfinallynode:=tcgtryfinallynode;
@@ -1556,7 +1538,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.59  2003-05-11 21:37:03  peter
+  Revision 1.60  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  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
 

compiler/ncgutil.pas

@@ -1664,9 +1664,6 @@ implementation
               begin
                 objectlibrary.getlabel(okexitlabel);
                 cg.a_jmp_always(list,okexitlabel);
-                { Failure exit }
-                cg.a_label(list,faillabel);
-                cg.g_call_fail_helper(list);
                 { Success exit }
                 cg.a_label(list,okexitlabel);
                 r.enum:=R_INTREGISTER;
@@ -1850,7 +1847,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.101  2003-05-13 15:16:13  peter
+  Revision 1.102  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.101  2003/05/13 15:16:13  peter
     * removed ret_in_acc, it's the reverse of ret_in_param
     * fixed ret_in_param for win32 cdecl array
 

compiler/nflw.pas

@@ -33,11 +33,6 @@ interface
        symppu,symtype,symbase,symdef,symsym;
 
     type
-       { internal labels for gotonode.createintern }
-{       tgotolabel = (
-         gnl_fail
-       ); }
-
        { flags used by loop nodes }
        tloopflag = (
          { set if it is a for ... downto ... do loop }
@@ -168,16 +163,16 @@ 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;
        ttryexceptnodeclass = class of ttryexceptnode;
 
-       ttryfinallynode = class(tbinarynode)
+       ttryfinallynode = class(tloopnode)
+          implicitframe : boolean;
           constructor create(l,r:tnode);virtual;
+          constructor create_implicit(l,r,_t1:tnode);virtual;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
        end;
@@ -196,14 +191,6 @@ interface
        end;
        tonnodeclass = class of tonnode;
 
-       tfailnode = class(tnode)
-          constructor create;virtual;
-          function det_resulttype:tnode;override;
-          function pass_1: tnode;override;
-          function docompare(p: tnode): boolean; override;
-       end;
-       tfailnodeclass = class of tfailnode;
-
     { for compatibilty }
     function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
 
@@ -220,7 +207,7 @@ interface
        ctryexceptnode : ttryexceptnodeclass;
        ctryfinallynode : ttryfinallynodeclass;
        connode : tonnodeclass;
-       cfailnode : tfailnodeclass;
+
 
 implementation
 
@@ -228,7 +215,7 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symtable,paramgr,defutil,htypechk,pass_1,
-      ncon,nmem,nld,ncnv,nbas,rgobj,
+      ncal,nadd,ncon,nmem,nld,ncnv,nbas,rgobj,
     {$ifdef state_tracking}
       nstate,
     {$endif}
@@ -412,9 +399,6 @@ implementation
          { calc register weight }
          if not(cs_littlesize in aktglobalswitches ) then
            rg.t_times:=rg.t_times*8;
-       {$ifndef newra}
-         rg.cleartempgen;
-       {$endif}
 
          firstpass(left);
          if codegenerror then
@@ -428,9 +412,6 @@ implementation
          { loop instruction }
          if assigned(right) then
            begin
-            {$ifndef newra}
-              rg.cleartempgen;
-            {$endif}
               firstpass(right);
               if codegenerror then
                 exit;
@@ -576,9 +557,6 @@ implementation
          result:=nil;
          expectloc:=LOC_VOID;
          old_t_times:=rg.t_times;
-      {$ifndef newra}
-         rg.cleartempgen;
-      {$endif}
          firstpass(left);
          registers32:=left.registers32;
          registersfpu:=left.registersfpu;
@@ -595,9 +573,6 @@ implementation
          { if path }
          if assigned(right) then
            begin
-            {$ifndef newra}
-              rg.cleartempgen;
-            {$endif}
               firstpass(right);
 
               if registers32<right.registers32 then
@@ -613,9 +588,6 @@ implementation
          { else path }
          if assigned(t1) then
            begin
-            {$ifndef newra}
-              rg.cleartempgen;
-            {$endif}
               firstpass(t1);
 
               if registers32<t1.registers32 then
@@ -793,14 +765,8 @@ implementation
          if not(cs_littlesize in aktglobalswitches) then
            rg.t_times:=rg.t_times*8;
 
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          firstpass(left);
 
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          if assigned(t1) then
           begin
             firstpass(t1);
@@ -822,9 +788,6 @@ implementation
 {$endif SUPPORT_MMX}
 
          { process count var }
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          firstpass(t2);
          if codegenerror then
           exit;
@@ -837,9 +800,6 @@ implementation
            registersmmx:=t2.registersmmx;
 {$endif SUPPORT_MMX}
 
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          firstpass(right);
       {$ifdef loopvar_dont_mind}
          { Check count var, record fields are also allowed in tp7 }
@@ -1138,9 +1098,6 @@ implementation
          expectloc:=LOC_VOID;
          if assigned(left) then
           begin
-          {$ifndef newra}
-            rg.cleartempgen;
-          {$endif}
             firstpass(left);
             registers32:=left.registers32;
             registersfpu:=left.registersfpu;
@@ -1285,14 +1242,6 @@ 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;
 
 
@@ -1314,16 +1263,10 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_VOID;
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          firstpass(left);
          { on statements }
          if assigned(right) then
            begin
-            {$ifndef newra}
-              rg.cleartempgen;
-            {$endif}
               firstpass(right);
               registers32:=max(registers32,right.registers32);
               registersfpu:=max(registersfpu,right.registersfpu);
@@ -1350,7 +1293,15 @@ implementation
 
     constructor ttryfinallynode.create(l,r:tnode);
       begin
-        inherited create(tryfinallyn,l,r);
+        inherited create(tryfinallyn,l,r,nil,nil);
+        implicitframe:=false;
+      end;
+
+
+    constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
+      begin
+        inherited create(tryfinallyn,l,r,_t1,nil);
+        implicitframe:=true;
       end;
 
 
@@ -1364,6 +1315,13 @@ implementation
 
          resulttypepass(right);
          set_varstate(right,true);
+
+         { special finally block only executed when there was an exception }
+         if assigned(t1) then
+           begin
+             resulttypepass(t1);
+             set_varstate(t1,true);
+           end;
       end;
 
 
@@ -1371,16 +1329,20 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_VOID;
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          firstpass(left);
 
-        {$ifndef newra}
-         rg.cleartempgen;
-        {$endif}
          firstpass(right);
          left_right_max;
+
+         if assigned(t1) then
+           begin
+             firstpass(t1);
+             registers32:=max(registers32,t1.registers32);
+             registersfpu:=max(registersfpu,t1.registersfpu);
+{$ifdef SUPPORT_MMX}
+             registersmmx:=max(registersmmx,t1.registersmmx);
+{$endif SUPPORT_MMX}
+           end;
       end;
 
 
@@ -1440,7 +1402,6 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_VOID;
-         rg.cleartempgen;
          registers32:=0;
          registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1456,7 +1417,6 @@ implementation
 {$endif SUPPORT_MMX}
            end;
 
-         rg.cleartempgen;
          if assigned(right) then
            begin
               firstpass(right);
@@ -1475,38 +1435,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                                TFAILNODE
-*****************************************************************************}
-
-
-    constructor tfailnode.create;
-      begin
-         inherited create(failn);
-      end;
-
-
-    function tfailnode.det_resulttype:tnode;
-      begin
-        result:=nil;
-        resulttype:=voidtype;
-      end;
-
-
-    function tfailnode.pass_1 : tnode;
-      begin
-        result:=nil;
-        expectloc:=LOC_VOID;
-      end;
-
-
-    function tfailnode.docompare(p: tnode): boolean;
-      begin
-        docompare := false;
-      end;
-
-
-
 begin
    cwhilerepeatnode:=twhilerepeatnode;
    cifnode:=tifnode;
@@ -1518,11 +1446,14 @@ begin
    ctryexceptnode:=ttryexceptnode;
    ctryfinallynode:=ttryfinallynode;
    connode:=tonnode;
-   cfailnode:=tfailnode;
 end.
 {
   $Log$
-  Revision 1.73  2003-05-11 21:37:03  peter
+  Revision 1.74  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  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
 

compiler/node.pas

@@ -108,7 +108,6 @@ interface
           isn,              {Represents the is operator}
           asn,              {Represents the as typecast}
           caretn,           {Represents the ^ operator}
-          failn,            {Represents the fail statement}
           starstarn,        {Represents the ** operator exponentiation }
           procinlinen,      {Procedures that can be inlined }
           arrayconstructorn, {Construction node for [...] parsing}
@@ -188,7 +187,6 @@ interface
           'isn',
           'asn',
           'caretn',
-          'failn',
           'starstarn',
           'procinlinen',
           'arrayconstructn',
@@ -986,7 +984,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  2003-05-11 21:37:03  peter
+  Revision 1.61  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  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
 

compiler/nset.pas

@@ -590,9 +590,6 @@ implementation
          result:=nil;
          expectloc:=LOC_VOID;
          { evalutes the case expression }
-       {$ifndef newra}
-         rg.cleartempgen;
-       {$endif}
          firstpass(left);
          set_varstate(left,true);
          if codegenerror then
@@ -617,9 +614,6 @@ implementation
          hp:=tstatementnode(right);
          while assigned(hp) do
            begin
-            {$ifndef newra}
-              rg.cleartempgen;
-            {$endif}
               firstpass(hp.left);
 
               { searchs max registers }
@@ -638,9 +632,6 @@ implementation
          { may be handle else tree }
          if assigned(elseblock) then
            begin
-            {$ifndef newra}
-              rg.cleartempgen;
-            {$endif}
               firstpass(elseblock);
               if codegenerror then
                 exit;
@@ -714,7 +705,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.41  2003-04-27 11:21:33  peter
+  Revision 1.42  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.41  2003/04/27 11:21:33  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

compiler/nutils.pas

@@ -47,12 +47,18 @@ interface
   staticforeachnodefunction = function(var n: tnode): foreachnoderesult;
 
 
-  function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
-  function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
+    function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
+    function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
+
+    function call_fail_node:tnode;
+
 
 implementation
 
-  uses nflw,nset,ncal;
+    uses
+      verbose,
+      symconst,symsym,symtype,symdef,symtable,
+      nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd;
 
   function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
     begin
@@ -144,13 +150,75 @@ implementation
     end;
 
 
+    function call_fail_node:tnode;
+      var
+        para : tcallparanode;
+        newstatement : tstatementnode;
+        srsym : tsym;
+      begin
+        result:=internalstatements(newstatement,true);
+
+        { call fail helper and exit normal }
+        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(unequaln,
+                        load_self_pointer_node,
+                        cnilnode.create),
+                    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_fail',para));
+            end
+        else
+          internalerror(200305132);
+        { self:=nil }
+        addstatement(newstatement,cassignmentnode.create(
+            load_self_pointer_node,
+            cnilnode.create));
+        { exit }
+        addstatement(newstatement,cexitnode.create(nil));
+      end;
+
+
+
 end.
 
 {
   $Log$
-  Revision 1.1  2003-04-23 12:35:34  florian
+  Revision 1.2  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.1  2003/04/23 12:35:34  florian
     * fixed several issues with powerpc
     + applied a patch from Jonas for nested function calls (PowerPC only)
     * ...
 
-}
+}

compiler/options.pas

@@ -1644,6 +1644,7 @@ begin
   def_symbol('HASCURRENCY');
   def_symbol('HASTHREADVAR');
   def_symbol('HAS_GENERICCONSTRUCTOR');
+  def_symbol('NOCLASSHELPERS');
 
 { using a case is pretty useless here (FK) }
 { some stuff for TP compatibility }
@@ -1924,7 +1925,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.98  2003-05-11 19:17:16  florian
+  Revision 1.99  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.98  2003/05/11 19:17:16  florian
     * FPC_LITTLE_ENDIAN and FPC_BIG_ENDIAN is now defined as well
 
   Revision 1.97  2003/05/01 07:59:42  florian

compiler/pass_2.pas

@@ -133,7 +133,6 @@ implementation
              'is',    {isn}
              'as',    {asn}
              'error-caret',       {caretn}
-             'fail',        {failn}
              'add-starstar',  {starstarn}
              'procinline',  {procinlinen}
              'arrayconstruc', {arrayconstructn}
@@ -303,7 +302,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2003-05-09 17:47:02  peter
+  Revision 1.51  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.50  2003/05/09 17:47:02  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/pexpr.pas

@@ -71,7 +71,7 @@ implementation
        symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
        { pass 1 }
        pass_1,htypechk,
-       nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
+       nutils,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
        { parser }
        scanner,
        pbase,pinline,
@@ -958,7 +958,8 @@ implementation
          static_name : string;
          isclassref : boolean;
          srsymtable : tsymtable;
-
+         newstatement : tstatementnode;
+         newblock     : tblocknode;
       begin
          if sym=nil then
            begin
@@ -994,13 +995,70 @@ implementation
                         p1.flags:=p1.flags+callnflags;
                       { we need to know which procedure is called }
                       do_resulttypepass(p1);
-                      { now we know the real method e.g. we can check for a class method }
-                      if isclassref and
-                         (p1.nodetype=calln) and
-                         assigned(tcallnode(p1).procdefinition) and
-                         not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
-                         not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
-                        Message(parser_e_only_class_methods_via_class_ref);
+                      { now we know the method that is called }
+                      if (p1.nodetype=calln) and
+                         assigned(tcallnode(p1).procdefinition) then
+                        begin
+                          { calling using classref? }
+                          if isclassref and
+                             not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
+                             not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
+                            Message(parser_e_only_class_methods_via_class_ref);
+
+                           { when calling inherited constructor we need to check the return value }
+                           if (nf_inherited in callnflags) and
+                              (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
+                             begin
+                               {
+                                 For Classes:
+
+                                 self:=inherited constructor
+                                 if self=nil then
+                                   exit
+
+                                 For objects:
+                                 if inherited constructor=false then
+                                   begin
+                                     self:=nil;
+                                     exit;
+                                   end;
+                               }
+                               if is_class(tprocdef(tcallnode(p1).procdefinition)._class) then
+                                 begin
+                                   newblock:=internalstatements(newstatement,true);
+                                   addstatement(newstatement,cassignmentnode.create(
+                                       ctypeconvnode.create(
+                                           load_self_pointer_node,
+                                           voidpointertype),
+                                       ctypeconvnode.create(
+                                           p1,
+                                           voidpointertype)));
+                                   addstatement(newstatement,cifnode.create(
+                                       caddnode.create(equaln,
+                                           load_self_pointer_node,
+                                           cnilnode.create),
+                                       cexitnode.create(nil),
+                                       nil));
+                                   p1:=newblock;
+                                 end
+                               else
+                                 if is_object(tprocdef(tcallnode(p1).procdefinition)._class) then
+                                   begin
+                                     newblock:=internalstatements(newstatement,true);
+                                     addstatement(newstatement,call_fail_node);
+                                     addstatement(newstatement,cexitnode.create(nil));
+                                     p1:=cifnode.create(
+                                         caddnode.create(equaln,
+                                             cordconstnode.create(0,booltype,false),
+                                             p1),
+                                         newblock,
+                                         nil);
+                                   end
+                                 else
+                                   internalerror(200305133);
+                               do_resulttypepass(p1);
+                             end;
+                        end;
                    end;
                  varsym:
                    begin
@@ -2339,7 +2397,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.117  2003-05-11 21:37:03  peter
+  Revision 1.118  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  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
 

compiler/pstatmnt.pas

@@ -50,7 +50,7 @@ implementation
        paramgr,
        { pass 1 }
        pass_1,htypechk,
-       nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
+       nutils,nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
        pbase,pexpr,
@@ -935,7 +935,7 @@ implementation
                 if (current_procdef.proctypeoption<>potype_constructor) then
                   Message(parser_e_fail_only_in_constructor);
                 consume(_FAIL);
-                code:=cfailnode.create;
+                code:=call_fail_node;
              end;
            _ASM :
              code:=_asm_statement;
@@ -977,7 +977,7 @@ implementation
              { blockn support because a read/write is changed into a blocknode }
              { with a separate statement for each read/write operation (JM)    }
              { the same is true for val() if the third parameter is not 32 bit }
-             if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen,
+             if not(p.nodetype in [nothingn,calln,ifn,assignn,breakn,inlinen,
                                    continuen,labeln,blockn,exitn]) then
                Message(cg_e_illegal_expression);
 
@@ -1185,7 +1185,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.97  2003-05-11 14:45:12  peter
+  Revision 1.98  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.97  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,ncal,ncon,nflw,nadd,ncnv,nmem,
+       nutils,nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem,
        pass_1,
     {$ifdef state_tracking}
        nstate,
@@ -225,14 +225,14 @@ implementation
       end;
 
 
-    function generate_entry_block:tblocknode;
+    function generate_initialize_block:tnode;
       var
         srsym        : tsym;
         para         : tcallparanode;
         newstatement : tstatementnode;
         htype        : ttype;
       begin
-        generate_entry_block:=internalstatements(newstatement,true);
+        result:=internalstatements(newstatement,true);
 
         if assigned(current_procdef._class) then
           begin
@@ -291,12 +291,14 @@ implementation
                     end
                 else
                   internalerror(200305103);
-                { if self=nil then fail }
+                { if self=nil then exit
+                  calling fail instead of exit is useless because
+                  there is nothing to dispose (PFV) }
                 addstatement(newstatement,cifnode.create(
                     caddnode.create(equaln,
                         load_self_pointer_node,
                         cnilnode.create),
-                    cfailnode.create,
+                    cexitnode.create(nil),
                     nil));
               end;
 
@@ -323,7 +325,19 @@ implementation
       end;
 
 
-    function generate_exit_block:tblocknode;
+    function generate_finalize_block:tnode;
+      begin
+        result:=cnothingnode.create;
+      end;
+
+
+    function generate_entry_block:tnode;
+      begin
+        result:=cnothingnode.create;
+      end;
+
+
+    function generate_exit_block:tnode;
       var
         srsym : tsym;
         para : tcallparanode;
@@ -406,7 +420,7 @@ implementation
       end;
 
 
-    function generate_except_block:tblocknode;
+    function generate_except_block:tnode;
       var
         pd : tprocdef;
         newstatement : tstatementnode;
@@ -442,22 +456,36 @@ implementation
       end;
 
 
-    procedure add_entry_exit_block(var code:tnode;const entrypos,exitpos:tfileposinfo);
+    procedure add_entry_exit_code(var code:tnode;const entrypos,exitpos:tfileposinfo);
       var
-        entryblock,
-        exitblock,
+        initializecode,
+        finalizecode,
+        entrycode,
+        exitcode,
+        exceptcode  : tnode;
+        codeblock,
         newblock     : tblocknode;
+        codestatement,
         newstatement : tstatementnode;
         oldfilepos   : tfileposinfo;
       begin
         oldfilepos:=aktfilepos;
-        { Generate entry and exit }
+        { Generate entry,exit and init,final blocks }
         aktfilepos:=entrypos;
-        entryblock:=generate_entry_block;
+        initializecode:=generate_initialize_block;
+        entrycode:=generate_entry_block;
         aktfilepos:=exitpos;
-        exitblock:=generate_exit_block;
+        exitcode:=generate_exit_block;
+        finalizecode:=generate_finalize_block;
+        exceptcode:=generate_except_block;
+
+        { Generate body of the procedure by combining entry+body+exit }
+        codeblock:=internalstatements(codestatement,true);
+        addstatement(codestatement,entrycode);
+        addstatement(codestatement,code);
+        addstatement(codestatement,exitcode);
 
-        { Generate procedure by combining entry+body+exit,
+        { Generate procedure by combining init+body+final,
           depending on the implicit finally we need to add
           an try...finally...end wrapper }
         newblock:=internalstatements(newstatement,true);
@@ -465,18 +493,18 @@ implementation
            { 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);
+            addstatement(newstatement,initializecode);
+            aktfilepos:=entrypos;
+            addstatement(newstatement,ctryfinallynode.create_implicit(
+               codeblock,
+               finalizecode,
+               exceptcode));
           end
         else
           begin
-            addstatement(newstatement,entryblock);
-            addstatement(newstatement,code);
-            addstatement(newstatement,exitblock);
+            addstatement(newstatement,initializecode);
+            addstatement(newstatement,codeblock);
+            addstatement(newstatement,finalizecode);
           end;
         resulttypepass(newblock);
         code:=newblock;
@@ -490,7 +518,7 @@ implementation
       }
       var
          oldexitlabel,oldexit2label : tasmlabel;
-         oldfaillabel,oldquickexitlabel:tasmlabel;
+         oldquickexitlabel:tasmlabel;
          _class,hp:tobjectdef;
          { switches can change inside the procedure }
          entryswitches, exitswitches : tlocalswitches;
@@ -524,16 +552,12 @@ implementation
          oldexitlabel:=aktexitlabel;
          oldexit2label:=aktexit2label;
          oldquickexitlabel:=quickexitlabel;
-         oldfaillabel:=faillabel;
          { get new labels }
          objectlibrary.getlabel(aktexitlabel);
          objectlibrary.getlabel(aktexit2label);
          { exit for fail in constructors }
          if (current_procdef.proctypeoption=potype_constructor) then
-           begin
-             objectlibrary.getlabel(faillabel);
-             objectlibrary.getlabel(quickexitlabel);
-           end;
+           objectlibrary.getlabel(quickexitlabel);
          { reset break and continue labels }
          block_type:=bt_general;
          aktbreaklabel:=nil;
@@ -594,7 +618,7 @@ implementation
          savepos:=aktfilepos;
          { add implicit entry and exit code }
          if assigned(code) then
-           add_entry_exit_block(code,entrypos,exitpos);
+           add_entry_exit_code(code,entrypos,exitpos);
          { store a copy of the original tree for inline, for
            normal procedures only store a reference to the
            current tree }
@@ -778,7 +802,6 @@ implementation
          aktexitlabel:=oldexitlabel;
          aktexit2label:=oldexit2label;
          quickexitlabel:=oldquickexitlabel;
-         faillabel:=oldfaillabel;
 
          { reset to normal non static function }
          if (current_procdef.parast.symtablelevel=normal_function_level) then
@@ -1104,7 +1127,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.110  2003-05-13 15:18:49  peter
+  Revision 1.111  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.110  2003/05/13 15:18:49  peter
     * fixed various crashes
 
   Revision 1.109  2003/05/11 21:37:03  peter

compiler/psystem.pas

@@ -415,7 +415,6 @@ implementation
         nodeclass[isn]:=cisnode;
         nodeclass[asn]:=casnode;
         nodeclass[caretn]:=caddnode;
-        nodeclass[failn]:=cfailnode;
         nodeclass[starstarn]:=caddnode;
         nodeclass[procinlinen]:=cprocinlinenode;
         nodeclass[arrayconstructorn]:=carrayconstructornode;
@@ -488,7 +487,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.49  2003-05-09 17:47:03  peter
+  Revision 1.50  2003-05-13 19:14:41  peter
+    * failn removed
+    * inherited result code check moven to pexpr
+
+  Revision 1.49  2003/05/09 17:47:03  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn