paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 20:29:17 +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 else
begin begin
{ When this is method the methodpointer must be available } { 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); internalerror(200305061);
end; end;
@ -2729,7 +2730,10 @@ begin
end. end.
{ {
$Log$ $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 * 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

155
compiler/pdecsub.pas
View File

@ -796,61 +796,75 @@ implementation
begin begin
consume(_FUNCTION); consume(_FUNCTION);
pd:=parse_proc_head(aclass,potype_none); pd:=parse_proc_head(aclass,potype_none);
if token<>_COLON then if assigned(pd) then
begin begin
if ( if try_to_consume(_COLON) then
not(is_interface(pd._class)) and begin
not(pd.forwarddef) inc(testcurobject);
) or single_type(pd.rettype,hs,false);
(m_repeat_forward in aktmodeswitches) then pd.test_if_fpu_result;
begin if (pd.rettype.def.deftype=stringdef) and
consume(_COLON); (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
consume_all_until(_SEMICOLON); include(current_procinfo.flags,pi_needs_implicit_finally);
end; dec(testcurobject);
end 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 else
begin begin
consume(_COLON); { recover }
inc(testcurobject); consume(_COLON);
single_type(pd.rettype,hs,false); consume_all_until(_SEMICOLON);
pd.test_if_fpu_result; end;
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);
end; end;
_PROCEDURE : _PROCEDURE :
begin begin
consume(_PROCEDURE); consume(_PROCEDURE);
pd:=parse_proc_head(aclass,potype_none); pd:=parse_proc_head(aclass,potype_none);
pd.rettype:=voidtype; if assigned(pd) then
if isclassmethod then begin
include(pd.procoptions,po_classmethod); pd.rettype:=voidtype;
if isclassmethod then
include(pd.procoptions,po_classmethod);
end;
end; end;
_CONSTRUCTOR : _CONSTRUCTOR :
begin begin
consume(_CONSTRUCTOR); consume(_CONSTRUCTOR);
pd:=parse_proc_head(aclass,potype_constructor); pd:=parse_proc_head(aclass,potype_constructor);
if not assigned(pd._class) then if assigned(pd) and
internalerror(200304263); assigned(pd._class) then
{ Set return type, class constructors return the begin
created instance, object constructors return boolean } { Set return type, class constructors return the
if is_class(pd._class) then created instance, object constructors return boolean }
pd.rettype.setdef(pd._class) if is_class(pd._class) then
else pd.rettype.setdef(pd._class)
pd.rettype:=booltype; else
pd.rettype:=booltype;
end;
end; end;
_DESTRUCTOR : _DESTRUCTOR :
begin begin
consume(_DESTRUCTOR); consume(_DESTRUCTOR);
pd:=parse_proc_head(aclass,potype_destructor); pd:=parse_proc_head(aclass,potype_destructor);
pd.rettype:=voidtype; if assigned(pd) then
pd.rettype:=voidtype;
end; end;
_OPERATOR : _OPERATOR :
@ -869,39 +883,49 @@ implementation
end; end;
consume(token); consume(token);
pd:=parse_proc_head(aclass,potype_operator); pd:=parse_proc_head(aclass,potype_operator);
if pd.parast.symtablelevel>normal_function_level then if assigned(pd) then
Message(parser_e_no_local_operator);
if token<>_ID then
begin begin
if not(m_result in aktmodeswitches) then if pd.parast.symtablelevel>normal_function_level then
consume(_ID); 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 end
else else
begin begin
pd.resultname:=orgpattern; { recover }
consume(_ID); try_to_consume(_ID);
end;
if not try_to_consume(_COLON) then
begin
consume(_COLON); consume(_COLON);
pd.rettype:=generrortype;
consume_all_until(_SEMICOLON); consume_all_until(_SEMICOLON);
end 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; end;
{ support procedure proc;stdcall export; in Delphi mode only } { support procedure proc;stdcall export; in Delphi mode only }
@ -2200,7 +2224,10 @@ const
end. end.
{ {
$Log$ $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 * self moved to hidden parameter
* removed hdisposen,hnewn,selfn * removed hdisposen,hnewn,selfn

267
compiler/psub.pas
View File

@ -234,88 +234,91 @@ implementation
begin begin
generate_entry_block:=internalstatements(newstatement,true); generate_entry_block:=internalstatements(newstatement,true);
{ a constructor needs a help procedure } if assigned(current_procdef._class) then
if (current_procdef.proctypeoption=potype_constructor) then
begin begin
if is_class(current_procdef._class) then { a constructor needs a help procedure }
if (current_procdef.proctypeoption=potype_constructor) then
begin begin
if (cs_implicit_exceptions in aktmoduleswitches) then if is_class(current_procdef._class) then
include(current_procinfo.flags,pi_needs_implicit_finally); begin
srsym:=search_class_member(current_procdef._class,'NEWINSTANCE'); 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 if assigned(srsym) and
(srsym.typ=procsym) then (srsym.typ=procsym) then
begin begin
{ if vmt<>0 then newinstance } { if vmt<>0 then beforedestruction }
addstatement(newstatement,cifnode.create( addstatement(newstatement,cifnode.create(
caddnode.create(unequaln, caddnode.create(unequaln,
load_vmt_pointer_node, load_vmt_pointer_node,
cnilnode.create), cnilnode.create),
cassignmentnode.create( ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
nil)); nil));
end end
else else
internalerror(200305108); internalerror(200305104);
end 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);
end; end;
end; end;
@ -328,74 +331,77 @@ implementation
begin begin
generate_exit_block:=internalstatements(newstatement,true); generate_exit_block:=internalstatements(newstatement,true);
{ maybe call AfterConstruction for classes } if assigned(current_procdef._class) then
if (current_procdef.proctypeoption=potype_constructor) and
is_class(current_procdef._class) then
begin begin
srsym:=search_class_member(current_procdef._class,'AFTERCONSTRUCTION'); { maybe call AfterConstruction for classes }
if assigned(srsym) and if (current_procdef.proctypeoption=potype_constructor) and
(srsym.typ=procsym) then is_class(current_procdef._class) then
begin begin
{ if vmt<>0 then afterconstruction } srsym:=search_class_member(current_procdef._class,'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');
if assigned(srsym) and if assigned(srsym) and
(srsym.typ=procsym) then (srsym.typ=procsym) then
begin begin
{ if self<>0 and vmt=1 then freeinstance } { if vmt<>0 then afterconstruction }
addstatement(newstatement,cifnode.create( addstatement(newstatement,cifnode.create(
caddnode.create(andn, caddnode.create(unequaln,
caddnode.create(unequaln, load_vmt_pointer_node,
load_self_pointer_node, cnilnode.create),
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), ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
nil)); nil));
end end
else else
internalerror(200305108); internalerror(200305106);
end end;
else
if is_object(current_procdef._class) then { a destructor needs a help procedure }
begin if (current_procdef.proctypeoption=potype_destructor) then
{ parameter 3 : vmt_offset } begin
{ parameter 2 : pointer to vmt } if is_class(current_procdef._class) then
{ parameter 1 : self pointer } begin
para:=ccallparanode.create( srsym:=search_class_member(current_procdef._class,'FREEINSTANCE');
cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false), if assigned(srsym) and
ccallparanode.create( (srsym.typ=procsym) then
ctypeconvnode.create_explicit( begin
load_vmt_pointer_node, { if self<>0 and vmt=1 then freeinstance }
voidpointertype), addstatement(newstatement,cifnode.create(
ccallparanode.create( caddnode.create(andn,
ctypeconvnode.create_explicit( caddnode.create(unequaln,
load_self_pointer_node, load_self_pointer_node,
voidpointertype), cnilnode.create),
nil))); caddnode.create(equaln,
addstatement(newstatement, ctypeconvnode.create(
ccallnode.createintern('fpc_help_destructor',para)); load_vmt_pointer_node,
end voidpointertype),
else cpointerconstnode.create(1,voidpointertype))),
internalerror(200305105); 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;
end; end;
@ -1098,7 +1104,10 @@ implementation
end. end.
{ {
$Log$ $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 * 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