* fixed crash in labelnode

  * easier detection of goto and label in try blocks

compiler/globals.pas

@@ -138,15 +138,15 @@ interface
        block_type : tblock_type;
 
        in_args : boolean;                { arguments must be checked especially }
-       parsing_para_level : longint;     { parameter level, used to convert
-                                             proc calls to proc loads in firstcalln }
-       { Must_be_valid : boolean;           should the variable already have a value
-        obsolete replace by set_varstate function }
+       parsing_para_level : integer;     { parameter level, used to convert
+                                           proc calls to proc loads in firstcalln }
        compile_level : word;
        make_ref : boolean;
        resolving_forward : boolean;      { used to add forward reference as second ref }
        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 }
 
      { commandline values }
        initdefines        : tstringlist;
@@ -1312,7 +1312,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  2001-04-13 01:22:07  peter
+  Revision 1.31  2001-04-15 09:48:29  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.30  2001/04/13 01:22:07  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/n386flw.pas

@@ -773,9 +773,6 @@ do_jmp:
          oldaktexit2label,
          oldaktcontinuelabel,
          oldaktbreaklabel : tasmlabel;
-         oldexceptblock : tnode;
-
-
          oldflowcontrol,tryflowcontrol,
          exceptflowcontrol : tflowcontrol;
          tempbuf,tempaddr : treference;
@@ -843,12 +840,9 @@ do_jmp:
             aktbreaklabel:=breaktrylabel;
           end;
 
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=left;
          flowcontrol:=[];
          secondpass(left);
          tryflowcontrol:=flowcontrol;
-         aktexceptblock:=oldexceptblock;
          if codegenerror then
            goto errorexit;
 
@@ -878,12 +872,7 @@ do_jmp:
          flowcontrol:=[];
          { on statements }
          if assigned(right) then
-           begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=right;
-              secondpass(right);
-              aktexceptblock:=oldexceptblock;
-           end;
+           secondpass(right);
 
          emitlab(lastonlabel);
          { default handling except handling }
@@ -918,13 +907,10 @@ do_jmp:
               exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
               emitjmp(C_NE,doobjectdestroyandreraise);
 
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=t1;
               { here we don't have to reset flowcontrol           }
               { the default and on flowcontrols are handled equal }
               secondpass(t1);
               exceptflowcontrol:=flowcontrol;
-              aktexceptblock:=oldexceptblock;
 
               emitlab(doobjectdestroyandreraise);
               emitcall('FPC_POPADDRSTACK');
@@ -1041,7 +1027,6 @@ do_jmp:
          doobjectdestroy,
          oldaktbreaklabel : tasmlabel;
          ref : treference;
-         oldexceptblock : tnode;
          oldflowcontrol : tflowcontrol;
          tempbuf,tempaddr : treference;
 
@@ -1110,10 +1095,7 @@ do_jmp:
 
               { esi is destroyed by FPC_CATCHES }
               maybe_loadself;
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=right;
               secondpass(right);
-              aktexceptblock:=oldexceptblock;
            end;
          getlabel(doobjectdestroy);
          emitlab(doobjectdestroyandreraise);
@@ -1200,7 +1182,6 @@ do_jmp:
          oldaktexit2label,
          oldaktcontinuelabel,
          oldaktbreaklabel : tasmlabel;
-         oldexceptblock : tnode;
          oldflowcontrol,tryflowcontrol : tflowcontrol;
          decconst : longint;
          tempbuf,tempaddr : treference;
@@ -1252,13 +1233,10 @@ do_jmp:
          { try code }
          if assigned(left) then
            begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=left;
               secondpass(left);
               tryflowcontrol:=flowcontrol;
               if codegenerror then
                 exit;
-              aktexceptblock:=oldexceptblock;
            end;
 
          emitlab(finallylabel);
@@ -1267,13 +1245,10 @@ do_jmp:
          ungetpersistanttempreference(tempbuf);
 
          { finally code }
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=right;
          flowcontrol:=[];
          secondpass(right);
          if flowcontrol<>[] then
            CGMessage(cg_e_control_flow_outside_finally);
-         aktexceptblock:=oldexceptblock;
          if codegenerror then
            exit;
          { allocate eax }
@@ -1380,7 +1355,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2001-04-14 14:07:11  peter
+  Revision 1.12  2001-04-15 09:48:31  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.11  2001/04/14 14:07:11  peter
     * moved more code from pass_1 to det_resulttype
 
   Revision 1.10  2001/04/13 01:22:19  peter

compiler/nflw.pas

@@ -82,6 +82,7 @@ interface
        tgotonode = class(tnode)
           labelnr : tasmlabel;
           labsym : tlabelsym;
+          exceptionblock : integer;
           constructor create(p : tlabelsym);virtual;
           function getcopy : tnode;override;
           function det_resulttype:tnode;override;
@@ -91,8 +92,8 @@ interface
 
        tlabelnode = class(tunarynode)
           labelnr : tasmlabel;
-          exceptionblock : tnode;
           labsym : tlabelsym;
+          exceptionblock : integer;
           constructor createcase(p : tasmlabel;l:tnode);virtual;
           constructor create(p : tlabelsym;l:tnode);virtual;
           function getcopy : tnode;override;
@@ -720,6 +721,10 @@ implementation
     constructor tgotonode.create(p : tlabelsym);
       begin
         inherited create(goton);
+        if statement_level>1 then
+         exceptionblock:=aktexceptblock
+        else
+         exceptionblock:=0;
         labsym:=p;
         labelnr:=p.lab;
       end;
@@ -738,7 +743,7 @@ implementation
          { check if }
          if assigned(labsym) and
             assigned(labsym.code) and
-            (aktexceptblock<>tlabelnode(labsym.code).exceptionblock) then
+            (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
            CGMessage(cg_e_goto_inout_of_exception_block);
       end;
 
@@ -750,6 +755,7 @@ implementation
         p:=tgotonode(inherited getcopy);
         p.labelnr:=labelnr;
         p.labsym:=labsym;
+        p.exceptionblock:=exceptionblock;
         result:=p;
      end;
 
@@ -767,7 +773,8 @@ implementation
     constructor tlabelnode.createcase(p : tasmlabel;l:tnode);
       begin
         inherited create(labeln,l);
-        exceptionblock:=nil;
+        { it shouldn't be possible to jump to case labels using goto }
+        exceptionblock:=-1;
         labsym:=nil;
         labelnr:=p;
       end;
@@ -776,7 +783,10 @@ implementation
     constructor tlabelnode.create(p : tlabelsym;l:tnode);
       begin
         inherited create(labeln,l);
-        exceptionblock:=nil;
+        if statement_level>1 then
+         exceptionblock:=aktexceptblock
+        else
+         exceptionblock:=0;
         labsym:=p;
         labelnr:=p.lab;
         { save the current labelnode in the labelsym }
@@ -787,8 +797,9 @@ implementation
     function tlabelnode.det_resulttype:tnode;
       begin
         result:=nil;
-        exceptionblock:=aktexceptblock;
-        resulttypepass(left);
+        { left could still be unassigned }
+        if assigned(left) then
+         resulttypepass(left);
         resulttype:=voidtype;
       end;
 
@@ -796,17 +807,20 @@ implementation
     function tlabelnode.pass_1 : tnode;
       begin
          result:=nil;
+         if assigned(left) then
+          begin
 {$ifdef newcg}
-         tg.cleartempgen;
+            tg.cleartempgen;
 {$else newcg}
-         cleartempgen;
+            cleartempgen;
 {$endif newcg}
-         firstpass(left);
-         registers32:=left.registers32;
-         registersfpu:=left.registersfpu;
+            firstpass(left);
+            registers32:=left.registers32;
+            registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
-         registersmmx:=left.registersmmx;
+            registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
+          end;
       end;
 
 
@@ -907,6 +921,7 @@ implementation
            end;
       end;
 
+
     function traisenode.docompare(p: tnode): boolean;
       begin
         docompare := false;
@@ -918,44 +933,26 @@ implementation
 *****************************************************************************}
 
     constructor ttryexceptnode.create(l,r,_t1 : tnode);
-
       begin
          inherited create(tryexceptn,l,r,_t1,nil);
       end;
 
 
     function ttryexceptnode.det_resulttype:tnode;
-      var
-        oldexceptblock : tnode;
       begin
          result:=nil;
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=left;
          resulttypepass(left);
-         aktexceptblock:=oldexceptblock;
          { on statements }
          if assigned(right) then
-           begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=right;
-              resulttypepass(right);
-              aktexceptblock:=oldexceptblock;
-           end;
+           resulttypepass(right);
          { else block }
          if assigned(t1) then
-           begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=t1;
-              resulttypepass(t1);
-              aktexceptblock:=oldexceptblock;
-           end;
-        resulttype:=voidtype;
+           resulttypepass(t1);
+         resulttype:=voidtype;
       end;
 
 
     function ttryexceptnode.pass_1 : tnode;
-      var
-        oldexceptblock : tnode;
       begin
          result:=nil;
 {$ifdef newcg}
@@ -963,10 +960,7 @@ implementation
 {$else newcg}
          cleartempgen;
 {$endif newcg}
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=left;
          firstpass(left);
-         aktexceptblock:=oldexceptblock;
          { on statements }
          if assigned(right) then
            begin
@@ -975,10 +969,7 @@ implementation
 {$else newcg}
               cleartempgen;
 {$endif newcg}
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=right;
               firstpass(right);
-              aktexceptblock:=oldexceptblock;
               registers32:=max(registers32,right.registers32);
               registersfpu:=max(registersfpu,right.registersfpu);
 {$ifdef SUPPORT_MMX}
@@ -988,10 +979,7 @@ implementation
          { else block }
          if assigned(t1) then
            begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=t1;
               firstpass(t1);
-              aktexceptblock:=oldexceptblock;
               registers32:=max(registers32,t1.registers32);
               registersfpu:=max(registersfpu,t1.registersfpu);
 {$ifdef SUPPORT_MMX}
@@ -1012,29 +1000,19 @@ implementation
 
 
     function ttryfinallynode.det_resulttype:tnode;
-      var
-         oldexceptblock : tnode;
       begin
          result:=nil;
          resulttype:=voidtype;
 
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=left;
          resulttypepass(left);
-         aktexceptblock:=oldexceptblock;
          set_varstate(left,true);
 
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=right;
          resulttypepass(right);
-         aktexceptblock:=oldexceptblock;
          set_varstate(right,true);
       end;
 
 
     function ttryfinallynode.pass_1 : tnode;
-      var
-         oldexceptblock : tnode;
       begin
          result:=nil;
 {$ifdef newcg}
@@ -1042,22 +1020,14 @@ implementation
 {$else newcg}
          cleartempgen;
 {$endif newcg}
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=left;
          firstpass(left);
-         aktexceptblock:=oldexceptblock;
 
 {$ifdef newcg}
          tg.cleartempgen;
 {$else newcg}
          cleartempgen;
 {$endif newcg}
-         oldexceptblock:=aktexceptblock;
-         aktexceptblock:=right;
          firstpass(right);
-         aktexceptblock:=oldexceptblock;
-         if codegenerror then
-           exit;
          left_right_max;
       end;
 
@@ -1094,8 +1064,6 @@ implementation
 
 
     function tonnode.det_resulttype:tnode;
-      var
-         oldexceptblock : tnode;
       begin
          result:=nil;
          resulttype:=voidtype;
@@ -1104,18 +1072,11 @@ implementation
          if assigned(left) then
            resulttypepass(left);
          if assigned(right) then
-           begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=right;
-              resulttypepass(right);
-              aktexceptblock:=oldexceptblock;
-           end;
+           resulttypepass(right);
       end;
 
 
     function tonnode.pass_1 : tnode;
-      var
-         oldexceptblock : tnode;
       begin
          result:=nil;
 {$ifdef newcg}
@@ -1145,10 +1106,7 @@ implementation
 {$endif newcg}
          if assigned(right) then
            begin
-              oldexceptblock:=aktexceptblock;
-              aktexceptblock:=right;
               firstpass(right);
-              aktexceptblock:=oldexceptblock;
               registers32:=max(registers32,right.registers32);
               registersfpu:=max(registersfpu,right.registersfpu);
 {$ifdef SUPPORT_MMX}
@@ -1210,7 +1168,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-04-14 14:07:10  peter
+  Revision 1.18  2001-04-15 09:48:30  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.17  2001/04/14 14:07:10  peter
     * moved more code from pass_1 to det_resulttype
 
   Revision 1.16  2001/04/13 01:22:09  peter

compiler/parser.pas

@@ -275,6 +275,8 @@ implementation
          oldaktinterfacetype: tinterfacetypes;
          oldaktmodeswitches : tmodeswitches;
          old_compiled_module : tmodule;
+         oldaktexceptblock  : integer;
+         oldstatement_level : integer;
          prev_name          : pstring;
 {$ifdef USEEXCEPT}
 {$ifndef Delphi}
@@ -347,6 +349,8 @@ implementation
          oldaktinterfacetype:=aktinterfacetype;
          oldaktfilepos:=aktfilepos;
          oldaktmodeswitches:=aktmodeswitches;
+         oldstatement_level:=statement_level;
+         oldaktexceptblock:=aktexceptblock;
 {$ifdef newcg}
          oldcg:=cg;
 {$endif newcg}
@@ -365,6 +369,8 @@ implementation
          aktprocsym:=nil;
          procprefix:='';
          registerdef:=true;
+         statement_level:=0;
+         aktexceptblock:=0;
          aktmaxfpuregisters:=-1;
          fillchar(overloaded_operators,sizeof(toverloaded_operators),0);
        { reset the unit or create a new program }
@@ -543,6 +549,8 @@ implementation
               aktinterfacetype:=oldaktinterfacetype;
               aktfilepos:=oldaktfilepos;
               aktmodeswitches:=oldaktmodeswitches;
+              statement_level:=oldstatement_level;
+              aktexceptblock:=oldaktexceptblock;
            end;
        { Shut down things when the last file is compiled }
          if (compile_level=1) then
@@ -612,7 +620,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2001-04-13 18:08:37  peter
+  Revision 1.16  2001-04-15 09:48:30  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.15  2001/04/13 18:08:37  peter
     * scanner object to class
 
   Revision 1.14  2001/04/13 01:22:10  peter

compiler/pass_1.pas

@@ -39,9 +39,6 @@ interface
     procedure firstpass(var p : tnode);
     function  do_firstpass(var p : tnode) : boolean;
 
-    var
-       { the block node of the current exception block to check gotos }
-       aktexceptblock : tnode;
 
 implementation
 
@@ -104,7 +101,6 @@ implementation
 
     function do_resulttypepass(var p : tnode) : boolean;
       begin
-         aktexceptblock:=nil;
          codegenerror:=false;
          resulttypepass(p);
          do_resulttypepass:=codegenerror;
@@ -171,7 +167,6 @@ implementation
 
     function do_firstpass(var p : tnode) : boolean;
       begin
-         aktexceptblock:=nil;
          codegenerror:=false;
          firstpass(p);
          do_firstpass:=codegenerror;
@@ -180,7 +175,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  2001-04-13 01:22:10  peter
+  Revision 1.14  2001-04-15 09:48:30  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.13  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pass_2.pas

@@ -236,7 +236,6 @@ implementation
          { clear register count }
          clearregistercount;
          use_esp_stackframe:=false;
-         aktexceptblock:=nil;
          symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs);
          symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs);
          if not(do_firstpass(p)) then
@@ -304,7 +303,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2001-04-13 01:22:10  peter
+  Revision 1.15  2001-04-15 09:48:30  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.14  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pstatmnt.pas

@@ -78,9 +78,6 @@ implementation
        ;
 
 
-    const
-      statement_level : longint = 0;
-
     function statement : tnode;forward;
 
 
@@ -525,6 +522,7 @@ implementation
          { read statements to try }
          consume(_TRY);
          first:=nil;
+         inc(aktexceptblock);
          inc(statement_level);
 
          while (token<>_FINALLY) and (token<>_EXCEPT) do
@@ -547,6 +545,7 @@ implementation
 
          if try_to_consume(_FINALLY) then
            begin
+              inc(aktexceptblock);
               p_finally_block:=statements_til_end;
               try_statement:=ctryfinallynode.create(p_try_block,p_finally_block);
               dec(statement_level);
@@ -556,6 +555,7 @@ implementation
               consume(_EXCEPT);
               old_block_type:=block_type;
               block_type:=bt_except;
+              inc(aktexceptblock);
               ot:=generrortype;
               p_specific:=nil;
               if (idtoken=_ON) then
@@ -1076,6 +1076,8 @@ implementation
                  { the pointer to the following instruction }
                  { isn't a very clean way                   }
                  tlabelnode(p).left:=statement{$ifdef FPCPROCVAR}(){$endif};
+                 { be sure to have left also resulttypepass }
+                 resulttypepass(tlabelnode(p).left);
                end;
 
               if not(p.nodetype in [calln,assignn,breakn,inlinen,continuen,labeln]) then
@@ -1215,7 +1217,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2001-04-14 14:07:11  peter
+  Revision 1.26  2001-04-15 09:48:30  peter
+    * fixed crash in labelnode
+    * easier detection of goto and label in try blocks
+
+  Revision 1.25  2001/04/14 14:07:11  peter
     * moved more code from pass_1 to det_resulttype
 
   Revision 1.24  2001/04/13 01:22:13  peter