* fixed goto/label/try bugs

compiler/globals.pas

@@ -143,7 +143,8 @@ interface
        use_esp_stackframe : boolean;     { to test for call with ESP as stack frame }
        inlining_procedure : boolean;     { are we inlining a procedure }
        statement_level : integer;
-       aktexceptblock : integer;         { each except block gets a number check gotos }
+       exceptblockcounter    : integer;  { each except block gets a unique number check gotos      }
+       aktexceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
 
      { commandline values }
        initdefines        : tstringlist;
@@ -1410,7 +1411,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2001-10-12 16:06:17  peter
+  Revision 1.45  2001-10-16 15:10:34  jonas
+    * fixed goto/label/try bugs
+
+  Revision 1.44  2001/10/12 16:06:17  peter
     * pathexists fix (merged)
 
   Revision 1.43  2001/09/18 11:30:47  michael

compiler/nflw.pas

@@ -733,10 +733,7 @@ implementation
     constructor tgotonode.create(p : tlabelsym);
       begin
         inherited create(goton);
-        if statement_level>1 then
-         exceptionblock:=aktexceptblock
-        else
-         exceptionblock:=0;
+        exceptionblock:=aktexceptblock;
         labsym:=p;
         labelnr:=p.lab;
       end;
@@ -756,7 +753,11 @@ implementation
          if assigned(labsym) and
             assigned(labsym.code) and
             (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
-           CGMessage(cg_e_goto_inout_of_exception_block);
+           begin
+             writeln('goto exceptblock: ',exceptionblock);
+             writeln('label exceptblock: ',tlabelnode(labsym.code).exceptionblock);
+             CGMessage(cg_e_goto_inout_of_exception_block);
+           end;
       end;
 
 
@@ -795,10 +796,7 @@ implementation
     constructor tlabelnode.create(p : tlabelsym;l:tnode);
       begin
         inherited create(labeln,l);
-        if statement_level>1 then
-         exceptionblock:=aktexceptblock
-        else
-         exceptionblock:=0;
+        exceptionblock:=aktexceptblock;
         labsym:=p;
         labelnr:=p.lab;
         { save the current labelnode in the labelsym }
@@ -1180,7 +1178,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2001-09-02 21:12:07  peter
+  Revision 1.25  2001-10-16 15:10:35  jonas
+    * fixed goto/label/try bugs
+
+  Revision 1.24  2001/09/02 21:12:07  peter
     * move class of definitions into type section for delphi
 
   Revision 1.23  2001/08/30 20:56:38  peter

compiler/parser.pas

@@ -275,7 +275,9 @@ implementation
          oldaktinterfacetype: tinterfacetypes;
          oldaktmodeswitches : tmodeswitches;
          old_compiled_module : tmodule;
-         oldaktexceptblock  : integer;
+{        will only be increased once we start parsing blocks in the }
+{         implementation, so doesn't need to be saved/restored (JM) }
+{          oldexceptblockcounter  : integer;                        }
          oldstatement_level : integer;
          prev_name          : pstring;
 {$ifdef USEEXCEPT}
@@ -350,10 +352,10 @@ implementation
          oldaktfilepos:=aktfilepos;
          oldaktmodeswitches:=aktmodeswitches;
          oldstatement_level:=statement_level;
-         oldaktexceptblock:=aktexceptblock;
+{         oldexceptblockcounter:=exceptblockcounter; }
 {$ifdef newcg}
          oldcg:=cg;
-{$endif newcg}
+{$endif newcg} 
 {$ifdef GDB}
          store_dbx:=dbx_counter;
          dbx_counter:=nil;
@@ -371,6 +373,7 @@ implementation
          registerdef:=true;
          statement_level:=0;
          aktexceptblock:=0;
+         exceptblockcounter:=0;
          aktmaxfpuregisters:=-1;
          fillchar(overloaded_operators,sizeof(toverloaded_operators),0);
        { reset the unit or create a new program }
@@ -547,7 +550,8 @@ implementation
               aktfilepos:=oldaktfilepos;
               aktmodeswitches:=oldaktmodeswitches;
               statement_level:=oldstatement_level;
-              aktexceptblock:=oldaktexceptblock;
+              aktexceptblock:=0;
+              exceptblockcounter:=0;
            end;
        { Shut down things when the last file is compiled }
          if (compile_level=1) then
@@ -617,7 +621,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  2001-08-26 13:36:43  florian
+  Revision 1.23  2001-10-16 15:10:35  jonas
+    * fixed goto/label/try bugs
+
+  Revision 1.22  2001/08/26 13:36:43  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/pstatmnt.pas

@@ -512,6 +512,7 @@ implementation
          objname,objrealname : stringid;
          srsym : tsym;
          srsymtable : tsymtable;
+         oldaktexceptblock: integer;
 
       begin
          procinfo^.flags:=procinfo^.flags or pi_uses_exceptions;
@@ -522,7 +523,9 @@ implementation
          { read statements to try }
          consume(_TRY);
          first:=nil;
-         inc(aktexceptblock);
+         inc(exceptblockcounter);
+         oldaktexceptblock := aktexceptblock;
+         aktexceptblock := exceptblockcounter;
          inc(statement_level);
 
          while (token<>_FINALLY) and (token<>_EXCEPT) do
@@ -545,7 +548,8 @@ implementation
 
          if try_to_consume(_FINALLY) then
            begin
-              inc(aktexceptblock);
+              inc(exceptblockcounter);
+              aktexceptblock := exceptblockcounter;
               p_finally_block:=statements_til_end;
               try_statement:=ctryfinallynode.create(p_try_block,p_finally_block);
               dec(statement_level);
@@ -555,7 +559,8 @@ implementation
               consume(_EXCEPT);
               old_block_type:=block_type;
               block_type:=bt_except;
-              inc(aktexceptblock);
+              inc(exceptblockcounter);
+              aktexceptblock := exceptblockcounter;
               ot:=generrortype;
               p_specific:=nil;
               if (idtoken=_ON) then
@@ -689,6 +694,7 @@ implementation
               block_type:=old_block_type;
               try_statement:=ctryexceptnode.create(p_try_block,p_specific,p_default);
            end;
+         aktexceptblock := oldaktexceptblock;
       end;
 
 
@@ -1264,7 +1270,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2001-09-22 11:11:43  peter
+  Revision 1.38  2001-10-16 15:10:35  jonas
+    * fixed goto/label/try bugs
+
+  Revision 1.37  2001/09/22 11:11:43  peter
     * "fpc -P?" command to query for used ppcXXX compiler
 
   Revision 1.36  2001/09/06 10:21:50  jonas