paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 08:06:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed goto/label/try bugs

Browse Source
This commit is contained in:
Jonas Maebe 2001-10-16 15:10:34 +00:00
parent 06e08d9302
commit d8c104b25d
4 changed files with 42 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/globals.pas
View File

@ -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

21
compiler/nflw.pas
View File

@ -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

17
compiler/parser.pas
View File

@ -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

17
compiler/pstatmnt.pas
View File

@ -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