paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 09:47:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed crash in labelnode

Browse Source 
* easier detection of goto and label in try blocks
This commit is contained in:
peter 2001-04-15 09:48:29 +00:00
parent bd745d3e82
commit 5677fbe1b4
7 changed files with 84 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/globals.pas
View File

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

33
compiler/i386/n386flw.pas
View File

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

110
compiler/nflw.pas
View File

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

14
compiler/parser.pas
View File

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

11
compiler/pass_1.pas
View File

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

7
compiler/pass_2.pas
View File

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

14
compiler/pstatmnt.pas
View File

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