paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-04 18:26:08 +01:00
Code Issues Packages Projects Releases Wiki Activity

* implicit_finally flag must be set in pass1

Browse Source 
* add check whether the implicit frame is generated when expected
This commit is contained in:
peter 2004-05-23 15:06:20 +00:00
parent c47ada7002
commit 72365ec95b
10 changed files with 148 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/globtype.pas
View File

@ -85,8 +85,8 @@ interface
cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes,
{ linking }
cs_link_extern,cs_link_static,cs_link_smart,cs_link_shared,cs_link_deffile,
cs_link_strip,cs_link_staticflag,cs_link_on_target,cs_link_internal,
cs_link_map,cs_link_pthread
cs_link_strip,cs_link_staticflag,cs_link_on_target,cs_link_internal,
cs_link_map,cs_link_pthread
);
tglobalswitches = set of tglobalswitch;
@ -119,7 +119,7 @@ interface
{ Win32, OS/2 & MacOS application types }
tapptype = (
app_none,
app_gui, { graphic user-interface application}
app_gui, { graphic user-interface application}
app_cui, { console application}
app_fs, { full-screen type application (OS/2 and EMX only) }
app_tool { tool application, (MPW tool for MacOS, MacOS only)}
@ -267,7 +267,11 @@ implementation
end.
{
$Log$
Revision 1.55 2004-05-23 14:32:17 peter
Revision 1.56 2004-05-23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.55 2004/05/23 14:32:17 peter
* tprocinfoflag moved to globtype
Revision 1.54 2004/05/02 11:48:46 peter

37
compiler/nbas.pas
View File

@ -51,7 +51,6 @@ interface
tasmnode = class(tnode)
p_asm : taasmoutput;
currenttai : tai;
getposition : boolean;
{ Used registers in assembler block }
used_regs_int,
used_regs_fpu : tcpuregisterset;
@ -523,7 +522,6 @@ implementation
begin
inherited create(asmn);
p_asm:=p;
getposition:=false;
currenttai:=nil;
used_regs_int:=[];
used_regs_fpu:=[];
@ -534,7 +532,7 @@ implementation
begin
inherited create(asmn);
p_asm:=nil;
getposition:=true;
include(flags,nf_get_asm_position);
currenttai:=nil;
end;
@ -552,8 +550,7 @@ implementation
hp : tai;
begin
inherited ppuload(t,ppufile);
getposition:=boolean(ppufile.getbyte);
if not getposition then
if not(nf_get_asm_position in flags) then
begin
p_asm:=taasmoutput.create;
repeat
@ -574,9 +571,8 @@ implementation
hp : tai;
begin
inherited ppuwrite(ppufile);
ppufile.putbyte(byte(getposition));
{$warning FIXME Add saving of register sets}
if not getposition then
if not(nf_get_asm_position in flags) then
begin
hp:=tai(p_asm.first);
while assigned(hp) do
@ -595,7 +591,7 @@ implementation
hp : tai;
begin
inherited buildderefimpl;
if not getposition then
if not(nf_get_asm_position in flags) then
begin
hp:=tai(p_asm.first);
while assigned(hp) do
@ -612,7 +608,7 @@ implementation
hp : tai;
begin
inherited derefimpl;
if not getposition then
if not(nf_get_asm_position in flags) then
begin
hp:=tai(p_asm.first);
while assigned(hp) do
@ -635,7 +631,6 @@ implementation
n.p_asm.concatlistcopy(p_asm);
end
else n.p_asm := nil;
n.getposition:=getposition;
n.currenttai:=currenttai;
getcopy := n;
end;
@ -643,17 +638,17 @@ implementation
function tasmnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidtype;
if not getposition then
include(current_procinfo.flags,pi_uses_asm);
result:=nil;
resulttype:=voidtype;
if not(nf_get_asm_position in flags) then
include(current_procinfo.flags,pi_uses_asm);
end;
function tasmnode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_VOID;
result:=nil;
expectloc:=LOC_VOID;
end;
@ -756,8 +751,11 @@ implementation
begin
result := nil;
expectloc:=LOC_VOID;
if (tempinfo^.restype.def.needs_inittable) then
include(current_procinfo.flags,pi_needs_implicit_finally);
end;
function ttempcreatenode.det_resulttype: tnode;
begin
result := nil;
@ -765,6 +763,7 @@ implementation
resulttype := voidtype;
end;
function ttempcreatenode.docompare(p: tnode): boolean;
begin
result :=
@ -1013,7 +1012,11 @@ begin
end.
{
$Log$
Revision 1.81 2004-03-10 20:41:17 peter
Revision 1.82 2004-05-23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.81 2004/03/10 20:41:17 peter
* maybe_in_reg moved to tempinfo
* fixed expectloc for maybe_in_reg

16
compiler/ncal.pas
View File

@ -1571,8 +1571,8 @@ type
else
resulttype:=restype;
if resulttype.def.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally);
{if resulttype.def.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally);}
if assigned(methodpointer) then
begin
@ -1838,6 +1838,12 @@ type
end;
{ implicit finally needed ? }
if resulttype.def.needs_inittable and
not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) and
not assigned(funcretnode) then
include(current_procinfo.flags,pi_needs_implicit_finally);
{ get a register for the return value }
if (not is_void(resulttype.def)) then
begin
@ -2050,7 +2056,11 @@ begin
end.
{
$Log$
Revision 1.233 2004-05-12 13:21:09 karoly
Revision 1.234 2004-05-23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.233 2004/05/12 13:21:09 karoly
* few small changes to add syscall support to M68k/Amiga target
Revision 1.232 2004/05/01 22:05:01 florian

8
compiler/ncgbas.pas
View File

@ -211,7 +211,7 @@ interface
begin
location_reset(location,LOC_VOID,OS_NO);
if getposition then
if (nf_get_asm_position in flags) then
begin
{ Add a marker, to be sure the list is not empty }
exprasmlist.concat(tai_marker.create(marker_position));
@ -476,7 +476,11 @@ begin
end.
{
$Log$
Revision 1.60 2004-03-15 08:44:51 michael
Revision 1.61 2004-05-23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.60 2004/03/15 08:44:51 michael
+ Fix from peter: fixes crash when inlining assembler code referencing local vars
Revision 1.59 2004/03/10 20:41:17 peter

17
compiler/ncgutil.pas
View File

@ -785,12 +785,9 @@ implementation
begin
if (tsym(p).typ=varsym) and
(tvarsym(p).refs>0) and
assigned(tvarsym(p).vartype.def) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
oldexprasmlist:=exprasmlist;
exprasmlist:=taasmoutput(arg);
hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
@ -815,7 +812,6 @@ implementation
begin
if (tvarsym(p).refs>0) and
not(vo_is_funcret in tvarsym(p).varoptions) and
assigned(tvarsym(p).vartype.def) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
dofinalize:=true;
@ -829,6 +825,7 @@ implementation
end;
if dofinalize then
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
oldexprasmlist:=exprasmlist;
exprasmlist:=taasmoutput(arg);
hp:=finalize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
@ -856,8 +853,6 @@ implementation
case tvarsym(p).varspez of
vs_value :
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309187);
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
@ -895,6 +890,7 @@ implementation
begin
if (tvarsym(p).varspez=vs_value) then
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309188);
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
@ -929,8 +925,6 @@ implementation
if assigned(hp^.def) and
hp^.def.needs_inittable then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.g_initialize(list,hp^.def,href,false);
end;
@ -952,6 +946,7 @@ implementation
if assigned(hp^.def) and
hp^.def.needs_inittable then
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.g_finalize(list,hp^.def,href,false);
end;
@ -2139,7 +2134,11 @@ implementation
end.
{
$Log$
Revision 1.200 2004-05-22 23:34:28 peter
Revision 1.201 2004-05-23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.200 2004/05/22 23:34:28 peter
tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
Revision 1.199 2004/05/19 21:16:12 peter

13
compiler/node.pas
View File

@ -200,6 +200,7 @@ interface
nf_error,
{ general }
nf_pass1_done,
nf_write, { Node is written to }
nf_isproperty,
@ -243,7 +244,10 @@ interface
nf_explicit,
{ tinlinenode }
nf_inlineconst
nf_inlineconst,
{ tasmnode }
nf_get_asm_position
);
tnodeflags = set of tnodeflag;
@ -752,6 +756,7 @@ implementation
{ node type and not one of tnode! }
p:=tnodeclass(classtype).createforcopy;
p.nodetype:=nodetype;
p.expectloc:=expectloc;
p.location:=location;
p.parent:=parent;
p.flags:=flags;
@ -1088,7 +1093,11 @@ implementation
end.
{
$Log$
Revision 1.82 2004-05-20 21:54:33 florian
Revision 1.83 2004-05-23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.82 2004/05/20 21:54:33 florian
+ <pointer> - <pointer> result is divided by the pointer element size now
this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)

13
compiler/pass_1.pas
View File

@ -44,6 +44,7 @@ implementation
uses
globtype,systems,cclasses,
cutils,globals,
procinfo,
cgbase,symdef
{$ifdef extdebug}
,verbose,htypechk
@ -117,6 +118,8 @@ implementation
oldpos : tfileposinfo;
hp : tnode;
begin
if (nf_pass1_done in p.flags) then
exit;
if not(nf_error in p.flags) then
begin
oldcodegenerror:=codegenerror;
@ -125,6 +128,9 @@ implementation
codegenerror:=false;
aktfilepos:=p.fileinfo;
aktlocalswitches:=p.localswitches;
{ checks make always a call }
if ([cs_check_range,cs_check_overflow,cs_check_stack] * aktlocalswitches <> []) then
include(current_procinfo.flags,pi_do_call);
{ determine the resulttype if not done }
if (p.resulttype.def=nil) then
begin
@ -176,6 +182,7 @@ implementation
{$endif EXTDEBUG}
end;
end;
include(p.flags,nf_pass1_done);
codegenerror:=codegenerror or oldcodegenerror;
aktlocalswitches:=oldlocalswitches;
aktfilepos:=oldpos;
@ -214,7 +221,11 @@ implementation
end.
{
$Log$
Revision 1.32 2003-10-01 20:34:49 peter
Revision 1.33 2004-05-23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.32 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

11
compiler/pass_2.pas
View File

@ -200,6 +200,11 @@ implementation
function do_secondpass(var p : tnode) : boolean;
begin
{ exprasmlist must be empty }
if not exprasmlist.empty then
internalerror(200405201);
{ clear errors before starting }
codegenerror:=false;
if not(nf_error in p.flags) then
secondpass(p);
@ -210,7 +215,11 @@ implementation
end.
{
$Log$
Revision 1.74 2003-11-10 22:02:52 peter
Revision 1.75 2004-05-23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.74 2003/11/10 22:02:52 peter
* cross unit inlining fixed
Revision 1.73 2003/10/30 16:22:40 peter

7
compiler/pmodules.pas
View File

@ -851,7 +851,6 @@ implementation
internalerror(200304253);
end;
tcgprocinfo(current_procinfo).code:=cnothingnode.create;
tcgprocinfo(current_procinfo).add_entry_exit_code;
tcgprocinfo(current_procinfo).generate_code;
release_main_proc(pd);
end;
@ -1489,7 +1488,11 @@ implementation
end.
{
$Log$
Revision 1.153 2004-05-19 21:16:13 peter
Revision 1.154 2004-05-23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.153 2004/05/19 21:16:13 peter
* add DEBUGINFO symbol to reference the .o file that includes the
stabs info for types and global/static variables
* debuginfo flag added to ppu to indicate whether debuginfo is

72
compiler/psub.pas
View File

@ -34,6 +34,9 @@ interface
type
tcgprocinfo = class(tprocinfo)
private
procedure add_entry_exit_code;
public
{ code for the subroutine as tree }
code : tnode;
{ positions in the tree for init/final }
@ -51,7 +54,6 @@ interface
procedure add_to_symtablestack;
procedure remove_from_symtablestack;
procedure parse_body;
procedure add_entry_exit_code;
end;
@ -132,6 +134,27 @@ implementation
end;
procedure check_finalize_paras(p : tnamedindexitem;arg:pointer);
begin
if (tsym(p).typ=varsym) and
(tvarsym(p).varspez=vs_value) and
not is_class(tvarsym(p).vartype.def) and
tvarsym(p).vartype.def.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally);
end;
procedure check_finalize_locals(p : tnamedindexitem;arg:pointer);
begin
if (tsym(p).typ=varsym) and
(tvarsym(p).refs>0) and
not(vo_is_funcret in tvarsym(p).varoptions) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally);
end;
function block(islibrary : boolean) : tnode;
begin
{ parse const,types and vars }
@ -205,14 +228,6 @@ implementation
if symtablestack.symtabletype=localsymtable then
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}initializevars,block);
end;
if (current_procinfo.procdef.localst.symtablelevel=main_program_level) and
(not current_module.is_unit) then
begin
{ there's always a call to FPC_DO_EXIT in the main program }
include(current_procinfo.flags,pi_do_call);
end;
if ([cs_check_range,cs_check_overflow,cs_check_stack] * aktlocalswitches <> []) then
include(current_procinfo.flags,pi_do_call);
end;
@ -273,8 +288,7 @@ implementation
begin
if is_class(current_procinfo.procdef._class) then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
include(current_procinfo.flags,pi_needs_implicit_finally);
srsym:=search_class_member(current_procinfo.procdef._class,'NEWINSTANCE');
if assigned(srsym) and
(srsym.typ=procsym) then
@ -532,7 +546,8 @@ implementation
depending on the implicit finally we need to add
an try...finally...end wrapper }
newblock:=internalstatements(newstatement);
if (pi_needs_implicit_finally in flags) and
if (cs_implicit_exceptions in aktmoduleswitches) and
(pi_needs_implicit_finally in flags) and
{ but it's useless in init/final code of units }
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin
@ -555,6 +570,8 @@ implementation
finalcode,
exceptcode));
addstatement(newstatement,exitlabel_asmnode);
{ set flag the implicit finally has been generated }
include(flags,pi_has_implicit_finally);
end
else
begin
@ -567,7 +584,7 @@ implementation
addstatement(newstatement,bodyexitcode);
addstatement(newstatement,final_asmnode);
end;
resulttypepass(newblock);
do_firstpass(newblock);
code:=newblock;
aktfilepos:=oldfilepos;
end;
@ -632,12 +649,24 @@ implementation
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs,nil);
symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs,nil);
{ there's always a call to FPC_INITIALIZEUNITS/FPC_DO_EXIT in the main program }
if (procdef.localst.symtablelevel=main_program_level) and
(not current_module.is_unit) then
include(flags,pi_do_call);
{ set implicit_finally flag when there are locals/paras to be finalized }
current_procinfo.procdef.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_finalize_paras,nil);
current_procinfo.procdef.localst.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_finalize_locals,nil);
{ firstpass everything }
flowcontrol:=[];
do_firstpass(code);
if code.registersfpu>0 then
include(current_procinfo.flags,pi_uses_fpu);
{ add implicit entry and exit code }
add_entry_exit_code;
{ only do secondpass if there are no errors }
if ErrorCount=0 then
begin
@ -774,6 +803,14 @@ implementation
gen_stackfree_code(templist,usesacc,usesacchi);
aktproccode.concatlist(templist);
{ check if the implicit finally has been generated. The flag
should already be set in pass1 }
if (cs_implicit_exceptions in aktmoduleswitches) and
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and
(pi_needs_implicit_finally in flags) and
not(pi_has_implicit_finally in flags) then
internalerror(200405231);
{$ifndef NoOpt}
if not(cs_no_regalloc in aktglobalswitches) then
begin
@ -986,9 +1023,6 @@ implementation
{ get a better entry point }
entrypos:=code.fileinfo;
{ add implicit entry and exit code }
add_entry_exit_code;
{ Finish type checking pass }
do_resulttypepass(code);
end;
@ -1345,7 +1379,11 @@ implementation
end.
{
$Log$
Revision 1.190 2004-05-20 21:54:33 florian
Revision 1.191 2004-05-23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected
Revision 1.190 2004/05/20 21:54:33 florian
+ <pointer> - <pointer> result is divided by the pointer element size now
this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)