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

* fixed various crashes

Browse Source
This commit is contained in:
peter 2003-05-13 15:18:49 +00:00
parent 5e40220d67
commit a467b84faa
3 changed files with 235 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/ncal.pas
View File

@ -2163,7 +2163,8 @@ type
else
begin
{ When this is method the methodpointer must be available }
if procdefinition.owner.symtabletype=objectsymtable then
if (right=nil) and
(procdefinition.owner.symtabletype=objectsymtable) then
internalerror(200305061);
end;
@ -2729,7 +2730,10 @@ begin
end.
{
$Log$
Revision 1.151 2003-05-11 21:37:03 peter
Revision 1.152 2003-05-13 15:18:49 peter
* fixed various crashes
Revision 1.151 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub

155
compiler/pdecsub.pas
View File

@ -796,61 +796,75 @@ implementation
begin
consume(_FUNCTION);
pd:=parse_proc_head(aclass,potype_none);
if token<>_COLON then
begin
if (
not(is_interface(pd._class)) and
not(pd.forwarddef)
) or
(m_repeat_forward in aktmodeswitches) then
begin
consume(_COLON);
consume_all_until(_SEMICOLON);
end;
end
if assigned(pd) then
begin
if try_to_consume(_COLON) then
begin
inc(testcurobject);
single_type(pd.rettype,hs,false);
pd.test_if_fpu_result;
if (pd.rettype.def.deftype=stringdef) and
(tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
include(current_procinfo.flags,pi_needs_implicit_finally);
dec(testcurobject);
end
else
begin
if (
not(is_interface(pd._class)) and
not(pd.forwarddef)
) or
(m_repeat_forward in aktmodeswitches) then
begin
consume(_COLON);
consume_all_until(_SEMICOLON);
end;
end;
if isclassmethod then
include(pd.procoptions,po_classmethod);
end
else
begin
consume(_COLON);
inc(testcurobject);
single_type(pd.rettype,hs,false);
pd.test_if_fpu_result;
if (pd.rettype.def.deftype=stringdef) and
(tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
include(current_procinfo.flags,pi_needs_implicit_finally);
dec(testcurobject);
end;
if isclassmethod then
include(pd.procoptions,po_classmethod);
begin
{ recover }
consume(_COLON);
consume_all_until(_SEMICOLON);
end;
end;
_PROCEDURE :
begin
consume(_PROCEDURE);
pd:=parse_proc_head(aclass,potype_none);
pd.rettype:=voidtype;
if isclassmethod then
include(pd.procoptions,po_classmethod);
if assigned(pd) then
begin
pd.rettype:=voidtype;
if isclassmethod then
include(pd.procoptions,po_classmethod);
end;
end;
_CONSTRUCTOR :
begin
consume(_CONSTRUCTOR);
pd:=parse_proc_head(aclass,potype_constructor);
if not assigned(pd._class) then
internalerror(200304263);
{ Set return type, class constructors return the
created instance, object constructors return boolean }
if is_class(pd._class) then
pd.rettype.setdef(pd._class)
else
pd.rettype:=booltype;
if assigned(pd) and
assigned(pd._class) then
begin
{ Set return type, class constructors return the
created instance, object constructors return boolean }
if is_class(pd._class) then
pd.rettype.setdef(pd._class)
else
pd.rettype:=booltype;
end;
end;
_DESTRUCTOR :
begin
consume(_DESTRUCTOR);
pd:=parse_proc_head(aclass,potype_destructor);
pd.rettype:=voidtype;
if assigned(pd) then
pd.rettype:=voidtype;
end;
_OPERATOR :
@ -869,39 +883,49 @@ implementation
end;
consume(token);
pd:=parse_proc_head(aclass,potype_operator);
if pd.parast.symtablelevel>normal_function_level then
Message(parser_e_no_local_operator);
if token<>_ID then
if assigned(pd) then
begin
if not(m_result in aktmodeswitches) then
consume(_ID);
if pd.parast.symtablelevel>normal_function_level then
Message(parser_e_no_local_operator);
if token<>_ID then
begin
if not(m_result in aktmodeswitches) then
consume(_ID);
end
else
begin
pd.resultname:=orgpattern;
consume(_ID);
end;
if not try_to_consume(_COLON) then
begin
consume(_COLON);
pd.rettype:=generrortype;
consume_all_until(_SEMICOLON);
end
else
begin
single_type(pd.rettype,hs,false);
pd.test_if_fpu_result;
if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
((pd.rettype.def.deftype<>orddef) or
(torddef(pd.rettype.def).typ<>bool8bit)) then
Message(parser_e_comparative_operator_return_boolean);
if (optoken=_ASSIGNMENT) and
equal_defs(pd.rettype.def,
tvarsym(pd.parast.symindex.first).vartype.def) then
message(parser_e_no_such_assignment)
else if not isoperatoracceptable(pd,optoken) then
Message(parser_e_overload_impossible);
end;
end
else
begin
pd.resultname:=orgpattern;
consume(_ID);
end;
if not try_to_consume(_COLON) then
begin
{ recover }
try_to_consume(_ID);
consume(_COLON);
pd.rettype:=generrortype;
consume_all_until(_SEMICOLON);
end
else
begin
single_type(pd.rettype,hs,false);
pd.test_if_fpu_result;
if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
((pd.rettype.def.deftype<>orddef) or
(torddef(pd.rettype.def).typ<>bool8bit)) then
Message(parser_e_comparative_operator_return_boolean);
if (optoken=_ASSIGNMENT) and
equal_defs(pd.rettype.def,
tvarsym(pd.parast.symindex.first).vartype.def) then
message(parser_e_no_such_assignment)
else if not isoperatoracceptable(pd,optoken) then
Message(parser_e_overload_impossible);
end;
end;
end;
end;
{ support procedure proc;stdcall export; in Delphi mode only }
@ -2200,7 +2224,10 @@ const
end.
{
$Log$
Revision 1.122 2003-05-09 17:47:03 peter
Revision 1.123 2003-05-13 15:18:49 peter
* fixed various crashes
Revision 1.122 2003/05/09 17:47:03 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn

267
compiler/psub.pas
View File

@ -234,88 +234,91 @@ implementation
begin
generate_entry_block:=internalstatements(newstatement,true);
{ a constructor needs a help procedure }
if (current_procdef.proctypeoption=potype_constructor) then
if assigned(current_procdef._class) then
begin
if is_class(current_procdef._class) then
{ a constructor needs a help procedure }
if (current_procdef.proctypeoption=potype_constructor) then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
srsym:=search_class_member(current_procdef._class,'NEWINSTANCE');
if is_class(current_procdef._class) then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
srsym:=search_class_member(current_procdef._class,'NEWINSTANCE');
if assigned(srsym) and
(srsym.typ=procsym) then
begin
{ if vmt<>0 then newinstance }
addstatement(newstatement,cifnode.create(
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create),
cassignmentnode.create(
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
nil));
end
else
internalerror(200305108);
end
else
if is_object(current_procdef._class) then
begin
htype.setdef(current_procdef._class);
htype.setdef(tpointerdef.create(htype));
{ parameter 3 : vmt_offset }
{ parameter 2 : address of pointer to vmt,
this is required to allow setting the vmt to -1 to indicate
that memory was allocated }
{ 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,cassignmentnode.create(
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
ccallnode.createintern('fpc_help_constructor',para)));
end
else
internalerror(200305103);
{ if self=nil then fail }
addstatement(newstatement,cifnode.create(
caddnode.create(equaln,
load_self_pointer_node,
cnilnode.create),
cfailnode.create,
nil));
end;
{ maybe call BeforeDestruction for classes }
if (current_procdef.proctypeoption=potype_destructor) and
is_class(current_procdef._class) then
begin
srsym:=search_class_member(current_procdef._class,'BEFOREDESTRUCTION');
if assigned(srsym) and
(srsym.typ=procsym) then
begin
{ if vmt<>0 then newinstance }
{ if vmt<>0 then beforedestruction }
addstatement(newstatement,cifnode.create(
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create),
cassignmentnode.create(
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
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
htype.setdef(current_procdef._class);
htype.setdef(tpointerdef.create(htype));
{ parameter 3 : vmt_offset }
{ parameter 2 : address of pointer to vmt,
this is required to allow setting the vmt to -1 to indicate
that memory was allocated }
{ 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,cassignmentnode.create(
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
ccallnode.createintern('fpc_help_constructor',para)));
end
else
internalerror(200305103);
{ if self=nil then fail }
addstatement(newstatement,cifnode.create(
caddnode.create(equaln,
load_self_pointer_node,
cnilnode.create),
cfailnode.create,
nil));
end;
{ maybe call BeforeDestruction for classes }
if (current_procdef.proctypeoption=potype_destructor) and
is_class(current_procdef._class) then
begin
srsym:=search_class_member(current_procdef._class,'BEFOREDESTRUCTION');
if assigned(srsym) and
(srsym.typ=procsym) then
begin
{ if vmt<>0 then beforedestruction }
addstatement(newstatement,cifnode.create(
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
nil));
end
else
internalerror(200305104);
internalerror(200305104);
end;
end;
end;
@ -328,74 +331,77 @@ implementation
begin
generate_exit_block:=internalstatements(newstatement,true);
{ maybe call AfterConstruction for classes }
if (current_procdef.proctypeoption=potype_constructor) and
is_class(current_procdef._class) then
if assigned(current_procdef._class) then
begin
srsym:=search_class_member(current_procdef._class,'AFTERCONSTRUCTION');
if assigned(srsym) and
(srsym.typ=procsym) then
{ maybe call AfterConstruction for classes }
if (current_procdef.proctypeoption=potype_constructor) and
is_class(current_procdef._class) then
begin
{ if vmt<>0 then afterconstruction }
addstatement(newstatement,cifnode.create(
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
nil));
end
else
internalerror(200305106);
end;
{ a destructor needs a help procedure }
if (current_procdef.proctypeoption=potype_destructor) then
begin
if is_class(current_procdef._class) then
begin
srsym:=search_class_member(current_procdef._class,'FREEINSTANCE');
srsym:=search_class_member(current_procdef._class,'AFTERCONSTRUCTION');
if assigned(srsym) and
(srsym.typ=procsym) then
begin
{ if self<>0 and vmt=1 then freeinstance }
{ if vmt<>0 then afterconstruction }
addstatement(newstatement,cifnode.create(
caddnode.create(andn,
caddnode.create(unequaln,
load_self_pointer_node,
cnilnode.create),
caddnode.create(equaln,
ctypeconvnode.create(
load_vmt_pointer_node,
voidpointertype),
cpointerconstnode.create(1,voidpointertype))),
caddnode.create(unequaln,
load_vmt_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_destructor',para));
end
else
internalerror(200305105);
internalerror(200305106);
end;
{ a destructor needs a help procedure }
if (current_procdef.proctypeoption=potype_destructor) then
begin
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(andn,
caddnode.create(unequaln,
load_self_pointer_node,
cnilnode.create),
caddnode.create(equaln,
ctypeconvnode.create(
load_vmt_pointer_node,
voidpointertype),
cpointerconstnode.create(1,voidpointertype))),
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_destructor',para));
end
else
internalerror(200305105);
end;
end;
end;
@ -1098,7 +1104,10 @@ implementation
end.
{
$Log$
Revision 1.109 2003-05-11 21:37:03 peter
Revision 1.110 2003-05-13 15:18:49 peter
* fixed various crashes
Revision 1.109 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub