* failn removed

* inherited result code check moven to pexpr
This commit is contained in:
peter 2003-05-13 19:14:41 +00:00
parent c37cdcf4e8
commit 05c05f2555
16 changed files with 471 additions and 431 deletions

View File

@ -191,7 +191,6 @@ unit cgbase;
aktexit2label : tasmlabel; aktexit2label : tasmlabel;
{# only used in constructor for fail keyword or if getmem fails } {# only used in constructor for fail keyword or if getmem fails }
faillabel : tasmlabel;
quickexitlabel : tasmlabel; quickexitlabel : tasmlabel;
{# true, if there was an error while code generation occurs } {# true, if there was an error while code generation occurs }
@ -641,7 +640,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.46 2003-05-09 17:47:02 peter Revision 1.47 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.46 2003/05/09 17:47:02 peter
* self moved to hidden parameter * self moved to hidden parameter
* removed hdisposen,hnewn,selfn * removed hdisposen,hnewn,selfn

View File

@ -404,7 +404,6 @@ unit cgobj;
@param(parasize Number of bytes of parameters to deallocate from stack) @param(parasize Number of bytes of parameters to deallocate from stack)
} }
procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract; procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
procedure g_call_fail_helper(list : taasmoutput);virtual;
{# This routine is called when generating the code for the entry point {# This routine is called when generating the code for the entry point
of a routine. It should save all registers which are not used in this of a routine. It should save all registers which are not used in this
routine, and which should be declared as saved in the std_saved_registers routine, and which should be declared as saved in the std_saved_registers
@ -1631,45 +1630,6 @@ unit cgobj;
Entry/Exit Code Functions Entry/Exit Code Functions
*****************************************************************************} *****************************************************************************}
procedure tcg.g_call_fail_helper(list : taasmoutput);
var
href : treference;
begin
if is_class(current_procdef._class) then
begin
if current_procinfo.selfpointer_offset=0 then
internalerror(200303256);
{ parameter 2 : flag, 0 -> inherited call (=no dispose) }
a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
{ parameter 1 : self }
reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
a_call_name(list,'FPC_DISPOSE_CLASS');
end
else if is_object(current_procdef._class) then
begin
if current_procinfo.selfpointer_offset=0 then
internalerror(200303257);
if current_procinfo.vmtpointer_offset=0 then
internalerror(200303258);
{ parameter 3 : vmt_offset }
a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
{ parameter 2 : pointer to vmt, will be reset to 0 when freed }
reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
{ parameter 1 : self pointer }
reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
a_param_ref(list,OS_ADDR,href,paramanager.getintparaloc(1));
a_call_name(list,'FPC_HELP_FAIL');
end
else
internalerror(200006163);
{ set self to nil }
reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
a_load_const_ref(list,OS_ADDR,0,href);
end;
procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput); procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
begin begin
end; end;
@ -1737,7 +1697,11 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.96 2003-05-11 21:37:03 peter Revision 1.97 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.96 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub * moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub * constructor/destructor helpers moved from cobj/ncgutil to psub

View File

@ -292,10 +292,6 @@ implementation
function tstatementnode.pass_1 : tnode; function tstatementnode.pass_1 : tnode;
begin begin
result:=nil; result:=nil;
{ no temps over several statements }
{$ifndef newra}
rg.cleartempgen;
{$endif}
{ left is the statement itself calln assignn or a complex one } { left is the statement itself calln assignn or a complex one }
firstpass(left); firstpass(left);
if codegenerror then if codegenerror then
@ -426,9 +422,6 @@ implementation
end; end;
if assigned(hp.left) then if assigned(hp.left) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
codegenerror:=false; codegenerror:=false;
firstpass(hp.left); firstpass(hp.left);
@ -805,7 +798,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.49 2003-05-11 14:45:12 peter Revision 1.50 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.49 2003/05/11 14:45:12 peter
* tloadnode does not support objectsymtable,withsymtable anymore * tloadnode does not support objectsymtable,withsymtable anymore
* withnode cleanup * withnode cleanup
* direct with rewritten to use temprefnode * direct with rewritten to use temprefnode

View File

@ -856,21 +856,6 @@ implementation
testregisters32; testregisters32;
{$endif TEMPREGDEBUG} {$endif TEMPREGDEBUG}
{ Called an inherited constructor? Then
we need to check the result }
if (inlined or (right=nil)) and
(procdefinition.proctypeoption=potype_constructor) and
assigned(methodpointer) and
(methodpointer.nodetype=typen) and
(current_procdef.proctypeoption=potype_constructor) then
begin
accreg.enum:=R_INTREGISTER;
accreg.number:=NR_ACCUMULATOR;
cg.a_reg_alloc(exprasmlist,accreg);
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accreg,faillabel);
cg.a_reg_dealloc(exprasmlist,accreg);
end;
{ handle function results } { handle function results }
if (not is_void(resulttype.def)) then if (not is_void(resulttype.def)) then
handle_return_value(inlined) handle_return_value(inlined)
@ -1140,7 +1125,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.62 2003-05-13 15:18:18 peter Revision 1.63 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.62 2003/05/13 15:18:18 peter
* generate code for procvar first before pushing parameters. Made * generate code for procvar first before pushing parameters. Made
the already existing code for powerpc available for all platforms the already existing code for powerpc available for all platforms

View File

@ -63,10 +63,6 @@ interface
procedure pass_2;override; procedure pass_2;override;
end; end;
tcgfailnode = class(tfailnode)
procedure pass_2;override;
end;
tcgraisenode = class(traisenode) tcgraisenode = class(traisenode)
procedure pass_2;override; procedure pass_2;override;
end; end;
@ -901,18 +897,6 @@ implementation
end; end;
{*****************************************************************************
SecondFail
*****************************************************************************}
procedure tcgfailnode.pass_2;
begin
location_reset(location,LOC_VOID,OS_NO);
cg.a_jmp_always(exprasmlist,faillabel);
end;
{***************************************************************************** {*****************************************************************************
SecondRaise SecondRaise
*****************************************************************************} *****************************************************************************}
@ -1117,30 +1101,6 @@ implementation
secondpass(right); secondpass(right);
cg.a_label(exprasmlist,lastonlabel); cg.a_label(exprasmlist,lastonlabel);
if onlyreraise then
begin
{ implicit except frame to cleanup and reraise only }
if assigned(t1) then
secondpass(t1);
cg.a_call_name(exprasmlist,'FPC_RERAISE');
if fc_exit in tryflowcontrol then
begin
cg.a_label(exprasmlist,exittrylabel);
cg.a_jmp_always(exprasmlist,oldaktexitlabel);
end;
if fc_break in tryflowcontrol then
begin
cg.a_label(exprasmlist,breaktrylabel);
cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
end;
if fc_continue in tryflowcontrol then
begin
cg.a_label(exprasmlist,continuetrylabel);
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end;
end
else
begin
{ default handling except handling } { default handling except handling }
if assigned(t1) then if assigned(t1) then
begin begin
@ -1244,7 +1204,6 @@ implementation
cg.g_exception_reason_load(exprasmlist,href); cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel); cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end; end;
end;
cg.a_label(exprasmlist,endexceptlabel); cg.a_label(exprasmlist,endexceptlabel);
errorexit: errorexit:
@ -1265,6 +1224,7 @@ implementation
tryflowcontrol; tryflowcontrol;
end; end;
procedure tcgonnode.pass_2; procedure tcgonnode.pass_2;
var var
nextonlabel, nextonlabel,
@ -1434,6 +1394,9 @@ implementation
{ statements } { statements }
oldaktexitlabel:=aktexitlabel; oldaktexitlabel:=aktexitlabel;
oldaktexit2label:=aktexit2label; oldaktexit2label:=aktexit2label;
if implicitframe then
exitfinallylabel:=finallylabel
else
objectlibrary.getlabel(exitfinallylabel); objectlibrary.getlabel(exitfinallylabel);
aktexitlabel:=exitfinallylabel; aktexitlabel:=exitfinallylabel;
aktexit2label:=exitfinallylabel; aktexit2label:=exitfinallylabel;
@ -1441,8 +1404,16 @@ implementation
begin begin
oldaktcontinuelabel:=aktcontinuelabel; oldaktcontinuelabel:=aktcontinuelabel;
oldaktbreaklabel:=aktbreaklabel; oldaktbreaklabel:=aktbreaklabel;
if implicitframe then
begin
breakfinallylabel:=finallylabel;
continuefinallylabel:=finallylabel;
end
else
begin
objectlibrary.getlabel(breakfinallylabel); objectlibrary.getlabel(breakfinallylabel);
objectlibrary.getlabel(continuefinallylabel); objectlibrary.getlabel(continuefinallylabel);
end;
aktcontinuelabel:=continuefinallylabel; aktcontinuelabel:=continuefinallylabel;
aktbreaklabel:=breakfinallylabel; aktbreaklabel:=breakfinallylabel;
end; end;
@ -1475,6 +1446,20 @@ implementation
cg.g_exception_reason_load(exprasmlist,href); cg.g_exception_reason_load(exprasmlist,href);
r.enum:=R_INTREGISTER; r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR; r.number:=NR_ACCUMULATOR;
if implicitframe then
begin
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
{ finally code only needed to be executed on exception }
flowcontrol:=[];
secondpass(t1);
if flowcontrol<>[] then
CGMessage(cg_e_control_flow_outside_finally);
if codegenerror then
exit;
cg.a_call_name(exprasmlist,'FPC_RERAISE');
end
else
begin
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel); cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
cg.a_op_const_reg(exprasmlist,OP_SUB,1,r); cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel); cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
@ -1523,7 +1508,7 @@ implementation
cg.g_exception_reason_save_const(exprasmlist,href,4); cg.g_exception_reason_save_const(exprasmlist,href,4);
cg.a_jmp_always(exprasmlist,finallylabel); cg.a_jmp_always(exprasmlist,finallylabel);
end; end;
end;
cg.a_label(exprasmlist,endfinallylabel); cg.a_label(exprasmlist,endfinallylabel);
aktexitlabel:=oldaktexitlabel; aktexitlabel:=oldaktexitlabel;
@ -1537,8 +1522,6 @@ implementation
end; end;
begin begin
cwhilerepeatnode:=tcgwhilerepeatnode; cwhilerepeatnode:=tcgwhilerepeatnode;
cifnode:=tcgifnode; cifnode:=tcgifnode;
@ -1548,7 +1531,6 @@ begin
ccontinuenode:=tcgcontinuenode; ccontinuenode:=tcgcontinuenode;
cgotonode:=tcggotonode; cgotonode:=tcggotonode;
clabelnode:=tcglabelnode; clabelnode:=tcglabelnode;
cfailnode:=tcgfailnode;
craisenode:=tcgraisenode; craisenode:=tcgraisenode;
ctryexceptnode:=tcgtryexceptnode; ctryexceptnode:=tcgtryexceptnode;
ctryfinallynode:=tcgtryfinallynode; ctryfinallynode:=tcgtryfinallynode;
@ -1556,7 +1538,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.59 2003-05-11 21:37:03 peter Revision 1.60 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.59 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub * moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub * constructor/destructor helpers moved from cobj/ncgutil to psub

View File

@ -1664,9 +1664,6 @@ implementation
begin begin
objectlibrary.getlabel(okexitlabel); objectlibrary.getlabel(okexitlabel);
cg.a_jmp_always(list,okexitlabel); cg.a_jmp_always(list,okexitlabel);
{ Failure exit }
cg.a_label(list,faillabel);
cg.g_call_fail_helper(list);
{ Success exit } { Success exit }
cg.a_label(list,okexitlabel); cg.a_label(list,okexitlabel);
r.enum:=R_INTREGISTER; r.enum:=R_INTREGISTER;
@ -1850,7 +1847,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.101 2003-05-13 15:16:13 peter Revision 1.102 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.101 2003/05/13 15:16:13 peter
* removed ret_in_acc, it's the reverse of ret_in_param * removed ret_in_acc, it's the reverse of ret_in_param
* fixed ret_in_param for win32 cdecl array * fixed ret_in_param for win32 cdecl array

View File

@ -33,11 +33,6 @@ interface
symppu,symtype,symbase,symdef,symsym; symppu,symtype,symbase,symdef,symsym;
type type
{ internal labels for gotonode.createintern }
{ tgotolabel = (
gnl_fail
); }
{ flags used by loop nodes } { flags used by loop nodes }
tloopflag = ( tloopflag = (
{ set if it is a for ... downto ... do loop } { set if it is a for ... downto ... do loop }
@ -168,16 +163,16 @@ interface
traisenodeclass = class of traisenode; traisenodeclass = class of traisenode;
ttryexceptnode = class(tloopnode) ttryexceptnode = class(tloopnode)
onlyreraise : boolean;
constructor create(l,r,_t1 : tnode);virtual; constructor create(l,r,_t1 : tnode);virtual;
constructor createintern(l,_t1 : tnode);virtual;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
end; end;
ttryexceptnodeclass = class of ttryexceptnode; ttryexceptnodeclass = class of ttryexceptnode;
ttryfinallynode = class(tbinarynode) ttryfinallynode = class(tloopnode)
implicitframe : boolean;
constructor create(l,r:tnode);virtual; constructor create(l,r:tnode);virtual;
constructor create_implicit(l,r,_t1:tnode);virtual;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
end; end;
@ -196,14 +191,6 @@ interface
end; end;
tonnodeclass = class of tonnode; tonnodeclass = class of tonnode;
tfailnode = class(tnode)
constructor create;virtual;
function det_resulttype:tnode;override;
function pass_1: tnode;override;
function docompare(p: tnode): boolean; override;
end;
tfailnodeclass = class of tfailnode;
{ for compatibilty } { for compatibilty }
function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode; function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
@ -220,7 +207,7 @@ interface
ctryexceptnode : ttryexceptnodeclass; ctryexceptnode : ttryexceptnodeclass;
ctryfinallynode : ttryfinallynodeclass; ctryfinallynode : ttryfinallynodeclass;
connode : tonnodeclass; connode : tonnodeclass;
cfailnode : tfailnodeclass;
implementation implementation
@ -228,7 +215,7 @@ implementation
globtype,systems, globtype,systems,
cutils,verbose,globals, cutils,verbose,globals,
symconst,symtable,paramgr,defutil,htypechk,pass_1, symconst,symtable,paramgr,defutil,htypechk,pass_1,
ncon,nmem,nld,ncnv,nbas,rgobj, ncal,nadd,ncon,nmem,nld,ncnv,nbas,rgobj,
{$ifdef state_tracking} {$ifdef state_tracking}
nstate, nstate,
{$endif} {$endif}
@ -412,9 +399,6 @@ implementation
{ calc register weight } { calc register weight }
if not(cs_littlesize in aktglobalswitches ) then if not(cs_littlesize in aktglobalswitches ) then
rg.t_times:=rg.t_times*8; rg.t_times:=rg.t_times*8;
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
if codegenerror then if codegenerror then
@ -428,9 +412,6 @@ implementation
{ loop instruction } { loop instruction }
if assigned(right) then if assigned(right) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(right); firstpass(right);
if codegenerror then if codegenerror then
exit; exit;
@ -576,9 +557,6 @@ implementation
result:=nil; result:=nil;
expectloc:=LOC_VOID; expectloc:=LOC_VOID;
old_t_times:=rg.t_times; old_t_times:=rg.t_times;
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
registers32:=left.registers32; registers32:=left.registers32;
registersfpu:=left.registersfpu; registersfpu:=left.registersfpu;
@ -595,9 +573,6 @@ implementation
{ if path } { if path }
if assigned(right) then if assigned(right) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(right); firstpass(right);
if registers32<right.registers32 then if registers32<right.registers32 then
@ -613,9 +588,6 @@ implementation
{ else path } { else path }
if assigned(t1) then if assigned(t1) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(t1); firstpass(t1);
if registers32<t1.registers32 then if registers32<t1.registers32 then
@ -793,14 +765,8 @@ implementation
if not(cs_littlesize in aktglobalswitches) then if not(cs_littlesize in aktglobalswitches) then
rg.t_times:=rg.t_times*8; rg.t_times:=rg.t_times*8;
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
{$ifndef newra}
rg.cleartempgen;
{$endif}
if assigned(t1) then if assigned(t1) then
begin begin
firstpass(t1); firstpass(t1);
@ -822,9 +788,6 @@ implementation
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
{ process count var } { process count var }
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(t2); firstpass(t2);
if codegenerror then if codegenerror then
exit; exit;
@ -837,9 +800,6 @@ implementation
registersmmx:=t2.registersmmx; registersmmx:=t2.registersmmx;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(right); firstpass(right);
{$ifdef loopvar_dont_mind} {$ifdef loopvar_dont_mind}
{ Check count var, record fields are also allowed in tp7 } { Check count var, record fields are also allowed in tp7 }
@ -1138,9 +1098,6 @@ implementation
expectloc:=LOC_VOID; expectloc:=LOC_VOID;
if assigned(left) then if assigned(left) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
registers32:=left.registers32; registers32:=left.registers32;
registersfpu:=left.registersfpu; registersfpu:=left.registersfpu;
@ -1285,14 +1242,6 @@ implementation
constructor ttryexceptnode.create(l,r,_t1 : tnode); constructor ttryexceptnode.create(l,r,_t1 : tnode);
begin begin
inherited create(tryexceptn,l,r,_t1,nil); inherited create(tryexceptn,l,r,_t1,nil);
onlyreraise:=false;
end;
constructor ttryexceptnode.createintern(l,_t1 : tnode);
begin
inherited create(tryexceptn,l,nil,_t1,nil);
onlyreraise:=true;
end; end;
@ -1314,16 +1263,10 @@ implementation
begin begin
result:=nil; result:=nil;
expectloc:=LOC_VOID; expectloc:=LOC_VOID;
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
{ on statements } { on statements }
if assigned(right) then if assigned(right) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(right); firstpass(right);
registers32:=max(registers32,right.registers32); registers32:=max(registers32,right.registers32);
registersfpu:=max(registersfpu,right.registersfpu); registersfpu:=max(registersfpu,right.registersfpu);
@ -1350,7 +1293,15 @@ implementation
constructor ttryfinallynode.create(l,r:tnode); constructor ttryfinallynode.create(l,r:tnode);
begin begin
inherited create(tryfinallyn,l,r); inherited create(tryfinallyn,l,r,nil,nil);
implicitframe:=false;
end;
constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
begin
inherited create(tryfinallyn,l,r,_t1,nil);
implicitframe:=true;
end; end;
@ -1364,6 +1315,13 @@ implementation
resulttypepass(right); resulttypepass(right);
set_varstate(right,true); set_varstate(right,true);
{ special finally block only executed when there was an exception }
if assigned(t1) then
begin
resulttypepass(t1);
set_varstate(t1,true);
end;
end; end;
@ -1371,16 +1329,20 @@ implementation
begin begin
result:=nil; result:=nil;
expectloc:=LOC_VOID; expectloc:=LOC_VOID;
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(right); firstpass(right);
left_right_max; left_right_max;
if assigned(t1) then
begin
firstpass(t1);
registers32:=max(registers32,t1.registers32);
registersfpu:=max(registersfpu,t1.registersfpu);
{$ifdef SUPPORT_MMX}
registersmmx:=max(registersmmx,t1.registersmmx);
{$endif SUPPORT_MMX}
end;
end; end;
@ -1440,7 +1402,6 @@ implementation
begin begin
result:=nil; result:=nil;
expectloc:=LOC_VOID; expectloc:=LOC_VOID;
rg.cleartempgen;
registers32:=0; registers32:=0;
registersfpu:=0; registersfpu:=0;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
@ -1456,7 +1417,6 @@ implementation
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
end; end;
rg.cleartempgen;
if assigned(right) then if assigned(right) then
begin begin
firstpass(right); firstpass(right);
@ -1475,38 +1435,6 @@ implementation
end; end;
{*****************************************************************************
TFAILNODE
*****************************************************************************}
constructor tfailnode.create;
begin
inherited create(failn);
end;
function tfailnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidtype;
end;
function tfailnode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_VOID;
end;
function tfailnode.docompare(p: tnode): boolean;
begin
docompare := false;
end;
begin begin
cwhilerepeatnode:=twhilerepeatnode; cwhilerepeatnode:=twhilerepeatnode;
cifnode:=tifnode; cifnode:=tifnode;
@ -1518,11 +1446,14 @@ begin
ctryexceptnode:=ttryexceptnode; ctryexceptnode:=ttryexceptnode;
ctryfinallynode:=ttryfinallynode; ctryfinallynode:=ttryfinallynode;
connode:=tonnode; connode:=tonnode;
cfailnode:=tfailnode;
end. end.
{ {
$Log$ $Log$
Revision 1.73 2003-05-11 21:37:03 peter Revision 1.74 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.73 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub * moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub * constructor/destructor helpers moved from cobj/ncgutil to psub

View File

@ -108,7 +108,6 @@ interface
isn, {Represents the is operator} isn, {Represents the is operator}
asn, {Represents the as typecast} asn, {Represents the as typecast}
caretn, {Represents the ^ operator} caretn, {Represents the ^ operator}
failn, {Represents the fail statement}
starstarn, {Represents the ** operator exponentiation } starstarn, {Represents the ** operator exponentiation }
procinlinen, {Procedures that can be inlined } procinlinen, {Procedures that can be inlined }
arrayconstructorn, {Construction node for [...] parsing} arrayconstructorn, {Construction node for [...] parsing}
@ -188,7 +187,6 @@ interface
'isn', 'isn',
'asn', 'asn',
'caretn', 'caretn',
'failn',
'starstarn', 'starstarn',
'procinlinen', 'procinlinen',
'arrayconstructn', 'arrayconstructn',
@ -986,7 +984,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.60 2003-05-11 21:37:03 peter Revision 1.61 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.60 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub * moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub * constructor/destructor helpers moved from cobj/ncgutil to psub

View File

@ -590,9 +590,6 @@ implementation
result:=nil; result:=nil;
expectloc:=LOC_VOID; expectloc:=LOC_VOID;
{ evalutes the case expression } { evalutes the case expression }
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left); firstpass(left);
set_varstate(left,true); set_varstate(left,true);
if codegenerror then if codegenerror then
@ -617,9 +614,6 @@ implementation
hp:=tstatementnode(right); hp:=tstatementnode(right);
while assigned(hp) do while assigned(hp) do
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(hp.left); firstpass(hp.left);
{ searchs max registers } { searchs max registers }
@ -638,9 +632,6 @@ implementation
{ may be handle else tree } { may be handle else tree }
if assigned(elseblock) then if assigned(elseblock) then
begin begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(elseblock); firstpass(elseblock);
if codegenerror then if codegenerror then
exit; exit;
@ -714,7 +705,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.41 2003-04-27 11:21:33 peter Revision 1.42 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.41 2003/04/27 11:21:33 peter
* aktprocdef renamed to current_procdef * aktprocdef renamed to current_procdef
* procinfo renamed to current_procinfo * procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be * procinfo will now be stored in current_module so it can be

View File

@ -50,9 +50,15 @@ interface
function foreachnode(var n: tnode; f: foreachnodefunction): boolean; function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean; function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
function call_fail_node:tnode;
implementation implementation
uses nflw,nset,ncal; uses
verbose,
symconst,symsym,symtype,symdef,symtable,
nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd;
function foreachnode(var n: tnode; f: foreachnodefunction): boolean; function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
begin begin
@ -144,11 +150,73 @@ implementation
end; end;
function call_fail_node:tnode;
var
para : tcallparanode;
newstatement : tstatementnode;
srsym : tsym;
begin
result:=internalstatements(newstatement,true);
{ call fail helper and exit normal }
if is_class(current_procdef._class) then
begin
srsym:=search_class_member(current_procdef._class,'FREEINSTANCE');
if assigned(srsym) and
(srsym.typ=procsym) then
begin
{ if self<>0 and vmt=1 then freeinstance }
addstatement(newstatement,cifnode.create(
caddnode.create(unequaln,
load_self_pointer_node,
cnilnode.create),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
nil));
end
else
internalerror(200305108);
end
else
if is_object(current_procdef._class) then
begin
{ parameter 3 : vmt_offset }
{ parameter 2 : pointer to vmt }
{ parameter 1 : self pointer }
para:=ccallparanode.create(
cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
ccallparanode.create(
ctypeconvnode.create_explicit(
load_vmt_pointer_node,
voidpointertype),
ccallparanode.create(
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
nil)));
addstatement(newstatement,
ccallnode.createintern('fpc_help_fail',para));
end
else
internalerror(200305132);
{ self:=nil }
addstatement(newstatement,cassignmentnode.create(
load_self_pointer_node,
cnilnode.create));
{ exit }
addstatement(newstatement,cexitnode.create(nil));
end;
end. end.
{ {
$Log$ $Log$
Revision 1.1 2003-04-23 12:35:34 florian Revision 1.2 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.1 2003/04/23 12:35:34 florian
* fixed several issues with powerpc * fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only) + applied a patch from Jonas for nested function calls (PowerPC only)
* ... * ...

View File

@ -1644,6 +1644,7 @@ begin
def_symbol('HASCURRENCY'); def_symbol('HASCURRENCY');
def_symbol('HASTHREADVAR'); def_symbol('HASTHREADVAR');
def_symbol('HAS_GENERICCONSTRUCTOR'); def_symbol('HAS_GENERICCONSTRUCTOR');
def_symbol('NOCLASSHELPERS');
{ using a case is pretty useless here (FK) } { using a case is pretty useless here (FK) }
{ some stuff for TP compatibility } { some stuff for TP compatibility }
@ -1924,7 +1925,11 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.98 2003-05-11 19:17:16 florian Revision 1.99 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.98 2003/05/11 19:17:16 florian
* FPC_LITTLE_ENDIAN and FPC_BIG_ENDIAN is now defined as well * FPC_LITTLE_ENDIAN and FPC_BIG_ENDIAN is now defined as well
Revision 1.97 2003/05/01 07:59:42 florian Revision 1.97 2003/05/01 07:59:42 florian

View File

@ -133,7 +133,6 @@ implementation
'is', {isn} 'is', {isn}
'as', {asn} 'as', {asn}
'error-caret', {caretn} 'error-caret', {caretn}
'fail', {failn}
'add-starstar', {starstarn} 'add-starstar', {starstarn}
'procinline', {procinlinen} 'procinline', {procinlinen}
'arrayconstruc', {arrayconstructn} 'arrayconstruc', {arrayconstructn}
@ -303,7 +302,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.50 2003-05-09 17:47:02 peter Revision 1.51 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.50 2003/05/09 17:47:02 peter
* self moved to hidden parameter * self moved to hidden parameter
* removed hdisposen,hnewn,selfn * removed hdisposen,hnewn,selfn

View File

@ -71,7 +71,7 @@ implementation
symconst,symbase,symdef,symsym,symtable,defutil,defcmp, symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
{ pass 1 } { pass 1 }
pass_1,htypechk, pass_1,htypechk,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas, nutils,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
{ parser } { parser }
scanner, scanner,
pbase,pinline, pbase,pinline,
@ -958,7 +958,8 @@ implementation
static_name : string; static_name : string;
isclassref : boolean; isclassref : boolean;
srsymtable : tsymtable; srsymtable : tsymtable;
newstatement : tstatementnode;
newblock : tblocknode;
begin begin
if sym=nil then if sym=nil then
begin begin
@ -994,13 +995,70 @@ implementation
p1.flags:=p1.flags+callnflags; p1.flags:=p1.flags+callnflags;
{ we need to know which procedure is called } { we need to know which procedure is called }
do_resulttypepass(p1); do_resulttypepass(p1);
{ now we know the real method e.g. we can check for a class method } { now we know the method that is called }
if (p1.nodetype=calln) and
assigned(tcallnode(p1).procdefinition) then
begin
{ calling using classref? }
if isclassref and if isclassref and
(p1.nodetype=calln) and
assigned(tcallnode(p1).procdefinition) and
not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
Message(parser_e_only_class_methods_via_class_ref); Message(parser_e_only_class_methods_via_class_ref);
{ when calling inherited constructor we need to check the return value }
if (nf_inherited in callnflags) and
(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
begin
{
For Classes:
self:=inherited constructor
if self=nil then
exit
For objects:
if inherited constructor=false then
begin
self:=nil;
exit;
end;
}
if is_class(tprocdef(tcallnode(p1).procdefinition)._class) then
begin
newblock:=internalstatements(newstatement,true);
addstatement(newstatement,cassignmentnode.create(
ctypeconvnode.create(
load_self_pointer_node,
voidpointertype),
ctypeconvnode.create(
p1,
voidpointertype)));
addstatement(newstatement,cifnode.create(
caddnode.create(equaln,
load_self_pointer_node,
cnilnode.create),
cexitnode.create(nil),
nil));
p1:=newblock;
end
else
if is_object(tprocdef(tcallnode(p1).procdefinition)._class) then
begin
newblock:=internalstatements(newstatement,true);
addstatement(newstatement,call_fail_node);
addstatement(newstatement,cexitnode.create(nil));
p1:=cifnode.create(
caddnode.create(equaln,
cordconstnode.create(0,booltype,false),
p1),
newblock,
nil);
end
else
internalerror(200305133);
do_resulttypepass(p1);
end;
end;
end; end;
varsym: varsym:
begin begin
@ -2339,7 +2397,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.117 2003-05-11 21:37:03 peter Revision 1.118 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.117 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub * moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub * constructor/destructor helpers moved from cobj/ncgutil to psub

View File

@ -50,7 +50,7 @@ implementation
paramgr, paramgr,
{ pass 1 } { pass 1 }
pass_1,htypechk, pass_1,htypechk,
nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw, nutils,nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
{ parser } { parser }
scanner, scanner,
pbase,pexpr, pbase,pexpr,
@ -935,7 +935,7 @@ implementation
if (current_procdef.proctypeoption<>potype_constructor) then if (current_procdef.proctypeoption<>potype_constructor) then
Message(parser_e_fail_only_in_constructor); Message(parser_e_fail_only_in_constructor);
consume(_FAIL); consume(_FAIL);
code:=cfailnode.create; code:=call_fail_node;
end; end;
_ASM : _ASM :
code:=_asm_statement; code:=_asm_statement;
@ -977,7 +977,7 @@ implementation
{ blockn support because a read/write is changed into a blocknode } { blockn support because a read/write is changed into a blocknode }
{ with a separate statement for each read/write operation (JM) } { with a separate statement for each read/write operation (JM) }
{ the same is true for val() if the third parameter is not 32 bit } { the same is true for val() if the third parameter is not 32 bit }
if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen, if not(p.nodetype in [nothingn,calln,ifn,assignn,breakn,inlinen,
continuen,labeln,blockn,exitn]) then continuen,labeln,blockn,exitn]) then
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -1185,7 +1185,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.97 2003-05-11 14:45:12 peter Revision 1.98 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.97 2003/05/11 14:45:12 peter
* tloadnode does not support objectsymtable,withsymtable anymore * tloadnode does not support objectsymtable,withsymtable anymore
* withnode cleanup * withnode cleanup
* direct with rewritten to use temprefnode * direct with rewritten to use temprefnode

View File

@ -56,7 +56,7 @@ implementation
ppu,fmodule, ppu,fmodule,
{ pass 1 } { pass 1 }
node, node,
nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem, nutils,nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem,
pass_1, pass_1,
{$ifdef state_tracking} {$ifdef state_tracking}
nstate, nstate,
@ -225,14 +225,14 @@ implementation
end; end;
function generate_entry_block:tblocknode; function generate_initialize_block:tnode;
var var
srsym : tsym; srsym : tsym;
para : tcallparanode; para : tcallparanode;
newstatement : tstatementnode; newstatement : tstatementnode;
htype : ttype; htype : ttype;
begin begin
generate_entry_block:=internalstatements(newstatement,true); result:=internalstatements(newstatement,true);
if assigned(current_procdef._class) then if assigned(current_procdef._class) then
begin begin
@ -291,12 +291,14 @@ implementation
end end
else else
internalerror(200305103); internalerror(200305103);
{ if self=nil then fail } { if self=nil then exit
calling fail instead of exit is useless because
there is nothing to dispose (PFV) }
addstatement(newstatement,cifnode.create( addstatement(newstatement,cifnode.create(
caddnode.create(equaln, caddnode.create(equaln,
load_self_pointer_node, load_self_pointer_node,
cnilnode.create), cnilnode.create),
cfailnode.create, cexitnode.create(nil),
nil)); nil));
end; end;
@ -323,7 +325,19 @@ implementation
end; end;
function generate_exit_block:tblocknode; function generate_finalize_block:tnode;
begin
result:=cnothingnode.create;
end;
function generate_entry_block:tnode;
begin
result:=cnothingnode.create;
end;
function generate_exit_block:tnode;
var var
srsym : tsym; srsym : tsym;
para : tcallparanode; para : tcallparanode;
@ -406,7 +420,7 @@ implementation
end; end;
function generate_except_block:tblocknode; function generate_except_block:tnode;
var var
pd : tprocdef; pd : tprocdef;
newstatement : tstatementnode; newstatement : tstatementnode;
@ -442,22 +456,36 @@ implementation
end; end;
procedure add_entry_exit_block(var code:tnode;const entrypos,exitpos:tfileposinfo); procedure add_entry_exit_code(var code:tnode;const entrypos,exitpos:tfileposinfo);
var var
entryblock, initializecode,
exitblock, finalizecode,
entrycode,
exitcode,
exceptcode : tnode;
codeblock,
newblock : tblocknode; newblock : tblocknode;
codestatement,
newstatement : tstatementnode; newstatement : tstatementnode;
oldfilepos : tfileposinfo; oldfilepos : tfileposinfo;
begin begin
oldfilepos:=aktfilepos; oldfilepos:=aktfilepos;
{ Generate entry and exit } { Generate entry,exit and init,final blocks }
aktfilepos:=entrypos; aktfilepos:=entrypos;
entryblock:=generate_entry_block; initializecode:=generate_initialize_block;
entrycode:=generate_entry_block;
aktfilepos:=exitpos; aktfilepos:=exitpos;
exitblock:=generate_exit_block; exitcode:=generate_exit_block;
finalizecode:=generate_finalize_block;
exceptcode:=generate_except_block;
{ Generate procedure by combining entry+body+exit, { Generate body of the procedure by combining entry+body+exit }
codeblock:=internalstatements(codestatement,true);
addstatement(codestatement,entrycode);
addstatement(codestatement,code);
addstatement(codestatement,exitcode);
{ Generate procedure by combining init+body+final,
depending on the implicit finally we need to add depending on the implicit finally we need to add
an try...finally...end wrapper } an try...finally...end wrapper }
newblock:=internalstatements(newstatement,true); newblock:=internalstatements(newstatement,true);
@ -465,18 +493,18 @@ implementation
{ but it's useless in init/final code of units } { but it's useless in init/final code of units }
not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin begin
addstatement(newstatement,entryblock); addstatement(newstatement,initializecode);
aktfilepos:=exitpos; aktfilepos:=entrypos;
addstatement(newstatement,ctryexceptnode.createintern( addstatement(newstatement,ctryfinallynode.create_implicit(
code, codeblock,
generate_except_block)); finalizecode,
addstatement(newstatement,exitblock); exceptcode));
end end
else else
begin begin
addstatement(newstatement,entryblock); addstatement(newstatement,initializecode);
addstatement(newstatement,code); addstatement(newstatement,codeblock);
addstatement(newstatement,exitblock); addstatement(newstatement,finalizecode);
end; end;
resulttypepass(newblock); resulttypepass(newblock);
code:=newblock; code:=newblock;
@ -490,7 +518,7 @@ implementation
} }
var var
oldexitlabel,oldexit2label : tasmlabel; oldexitlabel,oldexit2label : tasmlabel;
oldfaillabel,oldquickexitlabel:tasmlabel; oldquickexitlabel:tasmlabel;
_class,hp:tobjectdef; _class,hp:tobjectdef;
{ switches can change inside the procedure } { switches can change inside the procedure }
entryswitches, exitswitches : tlocalswitches; entryswitches, exitswitches : tlocalswitches;
@ -524,16 +552,12 @@ implementation
oldexitlabel:=aktexitlabel; oldexitlabel:=aktexitlabel;
oldexit2label:=aktexit2label; oldexit2label:=aktexit2label;
oldquickexitlabel:=quickexitlabel; oldquickexitlabel:=quickexitlabel;
oldfaillabel:=faillabel;
{ get new labels } { get new labels }
objectlibrary.getlabel(aktexitlabel); objectlibrary.getlabel(aktexitlabel);
objectlibrary.getlabel(aktexit2label); objectlibrary.getlabel(aktexit2label);
{ exit for fail in constructors } { exit for fail in constructors }
if (current_procdef.proctypeoption=potype_constructor) then if (current_procdef.proctypeoption=potype_constructor) then
begin
objectlibrary.getlabel(faillabel);
objectlibrary.getlabel(quickexitlabel); objectlibrary.getlabel(quickexitlabel);
end;
{ reset break and continue labels } { reset break and continue labels }
block_type:=bt_general; block_type:=bt_general;
aktbreaklabel:=nil; aktbreaklabel:=nil;
@ -594,7 +618,7 @@ implementation
savepos:=aktfilepos; savepos:=aktfilepos;
{ add implicit entry and exit code } { add implicit entry and exit code }
if assigned(code) then if assigned(code) then
add_entry_exit_block(code,entrypos,exitpos); add_entry_exit_code(code,entrypos,exitpos);
{ store a copy of the original tree for inline, for { store a copy of the original tree for inline, for
normal procedures only store a reference to the normal procedures only store a reference to the
current tree } current tree }
@ -778,7 +802,6 @@ implementation
aktexitlabel:=oldexitlabel; aktexitlabel:=oldexitlabel;
aktexit2label:=oldexit2label; aktexit2label:=oldexit2label;
quickexitlabel:=oldquickexitlabel; quickexitlabel:=oldquickexitlabel;
faillabel:=oldfaillabel;
{ reset to normal non static function } { reset to normal non static function }
if (current_procdef.parast.symtablelevel=normal_function_level) then if (current_procdef.parast.symtablelevel=normal_function_level) then
@ -1104,7 +1127,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.110 2003-05-13 15:18:49 peter Revision 1.111 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.110 2003/05/13 15:18:49 peter
* fixed various crashes * fixed various crashes
Revision 1.109 2003/05/11 21:37:03 peter Revision 1.109 2003/05/11 21:37:03 peter

View File

@ -415,7 +415,6 @@ implementation
nodeclass[isn]:=cisnode; nodeclass[isn]:=cisnode;
nodeclass[asn]:=casnode; nodeclass[asn]:=casnode;
nodeclass[caretn]:=caddnode; nodeclass[caretn]:=caddnode;
nodeclass[failn]:=cfailnode;
nodeclass[starstarn]:=caddnode; nodeclass[starstarn]:=caddnode;
nodeclass[procinlinen]:=cprocinlinenode; nodeclass[procinlinen]:=cprocinlinenode;
nodeclass[arrayconstructorn]:=carrayconstructornode; nodeclass[arrayconstructorn]:=carrayconstructornode;
@ -488,7 +487,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.49 2003-05-09 17:47:03 peter Revision 1.50 2003-05-13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.49 2003/05/09 17:47:03 peter
* self moved to hidden parameter * self moved to hidden parameter
* removed hdisposen,hnewn,selfn * removed hdisposen,hnewn,selfn