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

* failn removed

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/cgbase.pas
View File

@ -191,7 +191,6 @@ unit cgbase;
aktexit2label : tasmlabel;
{# only used in constructor for fail keyword or if getmem fails }
faillabel : tasmlabel;
quickexitlabel : tasmlabel;
{# true, if there was an error while code generation occurs }
@ -641,7 +640,11 @@ implementation
end.
{
$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
* removed hdisposen,hnewn,selfn

46
compiler/cgobj.pas
View File

@ -404,7 +404,6 @@ unit cgobj;
@param(parasize Number of bytes of parameters to deallocate from stack)
}
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
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
@ -1631,45 +1630,6 @@ unit cgobj;
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);
begin
end;
@ -1737,7 +1697,11 @@ finalization
end.
{
$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
* constructor/destructor helpers moved from cobj/ncgutil to psub

13
compiler/nbas.pas
View File

@ -292,10 +292,6 @@ implementation
function tstatementnode.pass_1 : tnode;
begin
result:=nil;
{ no temps over several statements }
{$ifndef newra}
rg.cleartempgen;
{$endif}
{ left is the statement itself calln assignn or a complex one }
firstpass(left);
if codegenerror then
@ -426,9 +422,6 @@ implementation
end;
if assigned(hp.left) then
begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
codegenerror:=false;
firstpass(hp.left);
@ -805,7 +798,11 @@ begin
end.
{
$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
* withnode cleanup
* direct with rewritten to use temprefnode

25
compiler/ncgcal.pas
View File

@ -856,26 +856,11 @@ implementation
testregisters32;
{$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 }
if (not is_void(resulttype.def)) then
handle_return_value(inlined)
handle_return_value(inlined)
else
location_reset(location,LOC_VOID,OS_NO);
location_reset(location,LOC_VOID,OS_NO);
{ perhaps i/o check ? }
if iolabel<>nil then
@ -1140,7 +1125,11 @@ begin
end.
{
$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
the already existing code for powerpc available for all platforms

354
compiler/ncgflw.pas
View File

@ -63,10 +63,6 @@ interface
procedure pass_2;override;
end;
tcgfailnode = class(tfailnode)
procedure pass_2;override;
end;
tcgraisenode = class(traisenode)
procedure pass_2;override;
end;
@ -901,18 +897,6 @@ implementation
end;
{*****************************************************************************
SecondFail
*****************************************************************************}
procedure tcgfailnode.pass_2;
begin
location_reset(location,LOC_VOID,OS_NO);
cg.a_jmp_always(exprasmlist,faillabel);
end;
{*****************************************************************************
SecondRaise
*****************************************************************************}
@ -1117,133 +1101,108 @@ implementation
secondpass(right);
cg.a_label(exprasmlist,lastonlabel);
if onlyreraise then
{ default handling except handling }
if assigned(t1) 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;
{ FPC_CATCHES must be called with
'default handler' flag (=-1)
}
cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_CATCHES');
{ the destruction of the exception object must be also }
{ guarded by an exception frame }
objectlibrary.getlabel(doobjectdestroy);
objectlibrary.getlabel(doobjectdestroyandreraise);
try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
{ here we don't have to reset flowcontrol }
{ the default and on flowcontrols are handled equal }
secondpass(t1);
exceptflowcontrol:=flowcontrol;
cg.a_label(exprasmlist,doobjectdestroyandreraise);
try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR;
cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
{ we don't need to restore esi here because reraise never }
{ returns }
cg.a_call_name(exprasmlist,'FPC_RERAISE');
cg.a_label(exprasmlist,doobjectdestroy);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,endexceptlabel);
end
else
begin
{ default handling except handling }
if assigned(t1) then
begin
{ FPC_CATCHES must be called with
'default handler' flag (=-1)
}
cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_CATCHES');
cg.a_call_name(exprasmlist,'FPC_RERAISE');
exceptflowcontrol:=flowcontrol;
end;
{ the destruction of the exception object must be also }
{ guarded by an exception frame }
objectlibrary.getlabel(doobjectdestroy);
objectlibrary.getlabel(doobjectdestroyandreraise);
if fc_exit in exceptflowcontrol then
begin
{ do some magic for exit in the try block }
cg.a_label(exprasmlist,exitexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,oldaktexitlabel);
end;
try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
if fc_break in exceptflowcontrol then
begin
cg.a_label(exprasmlist,breakexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
end;
{ here we don't have to reset flowcontrol }
{ the default and on flowcontrols are handled equal }
secondpass(t1);
exceptflowcontrol:=flowcontrol;
if fc_continue in exceptflowcontrol then
begin
cg.a_label(exprasmlist,continueexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end;
cg.a_label(exprasmlist,doobjectdestroyandreraise);
if fc_exit in tryflowcontrol then
begin
{ do some magic for exit in the try block }
cg.a_label(exprasmlist,exittrylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktexitlabel);
end;
try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
if fc_break in tryflowcontrol then
begin
cg.a_label(exprasmlist,breaktrylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
end;
cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR;
cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
{ we don't need to restore esi here because reraise never }
{ returns }
cg.a_call_name(exprasmlist,'FPC_RERAISE');
cg.a_label(exprasmlist,doobjectdestroy);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,endexceptlabel);
end
else
begin
cg.a_call_name(exprasmlist,'FPC_RERAISE');
exceptflowcontrol:=flowcontrol;
end;
if fc_exit in exceptflowcontrol then
begin
{ do some magic for exit in the try block }
cg.a_label(exprasmlist,exitexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,oldaktexitlabel);
end;
if fc_break in exceptflowcontrol then
begin
cg.a_label(exprasmlist,breakexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
end;
if fc_continue in exceptflowcontrol then
begin
cg.a_label(exprasmlist,continueexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cleanupobjectstack;
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end;
if fc_exit in tryflowcontrol then
begin
{ do some magic for exit in the try block }
cg.a_label(exprasmlist,exittrylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktexitlabel);
end;
if fc_break in tryflowcontrol then
begin
cg.a_label(exprasmlist,breaktrylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
end;
if fc_continue in tryflowcontrol then
begin
cg.a_label(exprasmlist,continuetrylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end;
if fc_continue in tryflowcontrol then
begin
cg.a_label(exprasmlist,continuetrylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
cg.g_exception_reason_load(exprasmlist,href);
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end;
cg.a_label(exprasmlist,endexceptlabel);
@ -1265,6 +1224,7 @@ implementation
tryflowcontrol;
end;
procedure tcgonnode.pass_2;
var
nextonlabel,
@ -1434,15 +1394,26 @@ implementation
{ statements }
oldaktexitlabel:=aktexitlabel;
oldaktexit2label:=aktexit2label;
objectlibrary.getlabel(exitfinallylabel);
if implicitframe then
exitfinallylabel:=finallylabel
else
objectlibrary.getlabel(exitfinallylabel);
aktexitlabel:=exitfinallylabel;
aktexit2label:=exitfinallylabel;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
oldaktbreaklabel:=aktbreaklabel;
objectlibrary.getlabel(breakfinallylabel);
objectlibrary.getlabel(continuefinallylabel);
if implicitframe then
begin
breakfinallylabel:=finallylabel;
continuefinallylabel:=finallylabel;
end
else
begin
objectlibrary.getlabel(breakfinallylabel);
objectlibrary.getlabel(continuefinallylabel);
end;
aktcontinuelabel:=continuefinallylabel;
aktbreaklabel:=breakfinallylabel;
end;
@ -1475,55 +1446,69 @@ implementation
cg.g_exception_reason_load(exprasmlist,href);
r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR;
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_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
if fc_exit in tryflowcontrol then
if implicitframe then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktexitlabel);
decconst:=1;
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
decconst:=2;
if fc_break in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktbreaklabel);
decconst:=1;
end
else
inc(decconst);
if fc_continue in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktcontinuelabel);
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_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
if fc_exit in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktexitlabel);
decconst:=1;
end
else
decconst:=2;
if fc_break in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktbreaklabel);
decconst:=1;
end
else
inc(decconst);
if fc_continue in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktcontinuelabel);
end;
cg.a_label(exprasmlist,reraiselabel);
cg.a_call_name(exprasmlist,'FPC_RERAISE');
{ do some magic for exit,break,continue in the try block }
if fc_exit in tryflowcontrol then
begin
cg.a_label(exprasmlist,exitfinallylabel);
cg.g_exception_reason_load(exprasmlist,href);
cg.g_exception_reason_save_const(exprasmlist,href,2);
cg.a_jmp_always(exprasmlist,finallylabel);
end;
if fc_break in tryflowcontrol then
begin
cg.a_label(exprasmlist,breakfinallylabel);
cg.g_exception_reason_load(exprasmlist,href);
cg.g_exception_reason_save_const(exprasmlist,href,3);
cg.a_jmp_always(exprasmlist,finallylabel);
end;
if fc_continue in tryflowcontrol then
begin
cg.a_label(exprasmlist,continuefinallylabel);
cg.g_exception_reason_load(exprasmlist,href);
cg.g_exception_reason_save_const(exprasmlist,href,4);
cg.a_jmp_always(exprasmlist,finallylabel);
end;
end;
cg.a_label(exprasmlist,reraiselabel);
cg.a_call_name(exprasmlist,'FPC_RERAISE');
{ do some magic for exit,break,continue in the try block }
if fc_exit in tryflowcontrol then
begin
cg.a_label(exprasmlist,exitfinallylabel);
cg.g_exception_reason_load(exprasmlist,href);
cg.g_exception_reason_save_const(exprasmlist,href,2);
cg.a_jmp_always(exprasmlist,finallylabel);
end;
if fc_break in tryflowcontrol then
begin
cg.a_label(exprasmlist,breakfinallylabel);
cg.g_exception_reason_load(exprasmlist,href);
cg.g_exception_reason_save_const(exprasmlist,href,3);
cg.a_jmp_always(exprasmlist,finallylabel);
end;
if fc_continue in tryflowcontrol then
begin
cg.a_label(exprasmlist,continuefinallylabel);
cg.g_exception_reason_load(exprasmlist,href);
cg.g_exception_reason_save_const(exprasmlist,href,4);
cg.a_jmp_always(exprasmlist,finallylabel);
end;
cg.a_label(exprasmlist,endfinallylabel);
aktexitlabel:=oldaktexitlabel;
@ -1537,8 +1522,6 @@ implementation
end;
begin
cwhilerepeatnode:=tcgwhilerepeatnode;
cifnode:=tcgifnode;
@ -1548,7 +1531,6 @@ begin
ccontinuenode:=tcgcontinuenode;
cgotonode:=tcggotonode;
clabelnode:=tcglabelnode;
cfailnode:=tcgfailnode;
craisenode:=tcgraisenode;
ctryexceptnode:=tcgtryexceptnode;
ctryfinallynode:=tcgtryfinallynode;
@ -1556,7 +1538,11 @@ begin
end.
{
$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
* constructor/destructor helpers moved from cobj/ncgutil to psub

9
compiler/ncgutil.pas
View File

@ -1664,9 +1664,6 @@ implementation
begin
objectlibrary.getlabel(okexitlabel);
cg.a_jmp_always(list,okexitlabel);
{ Failure exit }
cg.a_label(list,faillabel);
cg.g_call_fail_helper(list);
{ Success exit }
cg.a_label(list,okexitlabel);
r.enum:=R_INTREGISTER;
@ -1850,7 +1847,11 @@ implementation
end.
{
$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
* fixed ret_in_param for win32 cdecl array

141
compiler/nflw.pas
View File

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

8
compiler/node.pas
View File

@ -108,7 +108,6 @@ interface
isn, {Represents the is operator}
asn, {Represents the as typecast}
caretn, {Represents the ^ operator}
failn, {Represents the fail statement}
starstarn, {Represents the ** operator exponentiation }
procinlinen, {Procedures that can be inlined }
arrayconstructorn, {Construction node for [...] parsing}
@ -188,7 +187,6 @@ interface
'isn',
'asn',
'caretn',
'failn',
'starstarn',
'procinlinen',
'arrayconstructn',
@ -986,7 +984,11 @@ implementation
end.
{
$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
* constructor/destructor helpers moved from cobj/ncgutil to psub

15
compiler/nset.pas
View File

@ -590,9 +590,6 @@ implementation
result:=nil;
expectloc:=LOC_VOID;
{ evalutes the case expression }
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(left);
set_varstate(left,true);
if codegenerror then
@ -617,9 +614,6 @@ implementation
hp:=tstatementnode(right);
while assigned(hp) do
begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(hp.left);
{ searchs max registers }
@ -638,9 +632,6 @@ implementation
{ may be handle else tree }
if assigned(elseblock) then
begin
{$ifndef newra}
rg.cleartempgen;
{$endif}
firstpass(elseblock);
if codegenerror then
exit;
@ -714,7 +705,11 @@ begin
end.
{
$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
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be

78
compiler/nutils.pas
View File

@ -47,12 +47,18 @@ interface
staticforeachnodefunction = function(var n: tnode): foreachnoderesult;
function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
function call_fail_node:tnode;
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;
begin
@ -144,13 +150,75 @@ implementation
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.
{
$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
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
}
}

7
compiler/options.pas
View File

@ -1644,6 +1644,7 @@ begin
def_symbol('HASCURRENCY');
def_symbol('HASTHREADVAR');
def_symbol('HAS_GENERICCONSTRUCTOR');
def_symbol('NOCLASSHELPERS');
{ using a case is pretty useless here (FK) }
{ some stuff for TP compatibility }
@ -1924,7 +1925,11 @@ finalization
end.
{
$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
Revision 1.97 2003/05/01 07:59:42 florian

7
compiler/pass_2.pas
View File

@ -133,7 +133,6 @@ implementation
'is', {isn}
'as', {asn}
'error-caret', {caretn}
'fail', {failn}
'add-starstar', {starstarn}
'procinline', {procinlinen}
'arrayconstruc', {arrayconstructn}
@ -303,7 +302,11 @@ implementation
end.
{
$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
* removed hdisposen,hnewn,selfn

82
compiler/pexpr.pas
View File

@ -71,7 +71,7 @@ implementation
symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
{ pass 1 }
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 }
scanner,
pbase,pinline,
@ -958,7 +958,8 @@ implementation
static_name : string;
isclassref : boolean;
srsymtable : tsymtable;
newstatement : tstatementnode;
newblock : tblocknode;
begin
if sym=nil then
begin
@ -994,13 +995,70 @@ implementation
p1.flags:=p1.flags+callnflags;
{ we need to know which procedure is called }
do_resulttypepass(p1);
{ now we know the real method e.g. we can check for a class method }
if isclassref and
(p1.nodetype=calln) and
assigned(tcallnode(p1).procdefinition) and
not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
Message(parser_e_only_class_methods_via_class_ref);
{ 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
not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
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;
varsym:
begin
@ -2339,7 +2397,11 @@ implementation
end.
{
$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
* constructor/destructor helpers moved from cobj/ncgutil to psub

12
compiler/pstatmnt.pas
View File

@ -50,7 +50,7 @@ implementation
paramgr,
{ pass 1 }
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 }
scanner,
pbase,pexpr,
@ -935,7 +935,7 @@ implementation
if (current_procdef.proctypeoption<>potype_constructor) then
Message(parser_e_fail_only_in_constructor);
consume(_FAIL);
code:=cfailnode.create;
code:=call_fail_node;
end;
_ASM :
code:=_asm_statement;
@ -977,7 +977,7 @@ implementation
{ blockn support because a read/write is changed into a blocknode }
{ with a separate statement for each read/write operation (JM) }
{ 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
Message(cg_e_illegal_expression);
@ -1185,7 +1185,11 @@ implementation
end.
{
$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
* withnode cleanup
* direct with rewritten to use temprefnode

91
compiler/psub.pas
View File

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

7
compiler/psystem.pas
View File

@ -415,7 +415,6 @@ implementation
nodeclass[isn]:=cisnode;
nodeclass[asn]:=casnode;
nodeclass[caretn]:=caddnode;
nodeclass[failn]:=cfailnode;
nodeclass[starstarn]:=caddnode;
nodeclass[procinlinen]:=cprocinlinenode;
nodeclass[arrayconstructorn]:=carrayconstructornode;
@ -488,7 +487,11 @@ implementation
end.
{
$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
* removed hdisposen,hnewn,selfn