paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-26 11:49:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Make Tprocdef.defs protected

Browse Source
This commit is contained in:
daniel 2002-09-03 16:26:26 +00:00
parent 64c4be5ca9
commit b0364566d1
24 changed files with 369 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/i386/ra386att.pas
View File

@ -1017,9 +1017,9 @@ Begin
hs:=ttypedconstsym(sym).mangledname;
procsym :
begin
if assigned(tprocsym(sym).defs^.next) then
if Tprocsym(sym).procdef_count>1 then
Message(asmr_w_calling_overload_func);
hs:=tprocsym(sym).defs^.def.mangledname;
hs:=tprocsym(sym).first_procdef.mangledname;
end;
typesym :
begin
@ -2129,7 +2129,10 @@ finalization
end.
{
$Log$
Revision 1.30 2002-08-13 18:01:52 carl
Revision 1.31 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.30 2002/08/13 18:01:52 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline

9
compiler/i386/ra386int.pas
View File

@ -904,9 +904,9 @@ Begin
hs:=ttypedconstsym(sym).mangledname;
procsym :
begin
if assigned(tprocsym(sym).defs^.next) then
if Tprocsym(sym).procdef_count>1 then
Message(asmr_w_calling_overload_func);
hs:=tprocsym(sym).defs^.def.mangledname;
hs:=tprocsym(sym).first_procdef.mangledname;
end;
typesym :
begin
@ -1959,7 +1959,10 @@ finalization
end.
{
$Log$
Revision 1.33 2002-08-17 09:23:47 florian
Revision 1.34 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.33 2002/08/17 09:23:47 florian
* first part of procinfo rewrite
Revision 1.32 2002/08/13 18:01:52 carl

13
compiler/i386/radirect.pas
View File

@ -177,7 +177,7 @@ interface
if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
(pos('LEA',upper(s))>0)) then
begin
hs:=tprocsym(sym).defs^.def.mangledname;
hs:=tprocsym(sym).first_procdef.mangledname;
end;
end
else
@ -225,10 +225,10 @@ interface
{ procs can be called or the address can be loaded }
if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
begin
if assigned(tprocsym(sym).defs^.def) then
if tprocsym(sym).procdef_count>1 then
Message1(asmr_w_direct_global_is_overloaded_func,hs);
Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
hs:=tprocsym(sym).defs^.def.mangledname;
Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
hs:=tprocsym(sym).first_procdef.mangledname;
end;
end;
else
@ -304,7 +304,10 @@ initialization
end.
{
$Log$
Revision 1.2 2002-08-17 09:23:47 florian
Revision 1.3 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.2 2002/08/17 09:23:47 florian
* first part of procinfo rewrite
Revision 1.1 2002/08/10 14:47:50 carl

7
compiler/ncal.pas
View File

@ -966,7 +966,7 @@ implementation
repeat
for i:=1 to srprocsym.procdef_count do
begin
def:=srprocsym.procdef(i);
def:=srprocsym.procdef[i];
{ only when the # of parameters are supported by the procedure }
if (paralength>=def.minparacount) and
((po_varargs in def.procoptions) or (paralength<=def.maxparacount)) then
@ -2595,7 +2595,10 @@ begin
end.
{
$Log$
Revision 1.92 2002-09-01 13:28:37 daniel
Revision 1.93 2002-09-03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.92 2002/09/01 13:28:37 daniel
- write_access fields removed in favor of a flag
Revision 1.91 2002/09/01 12:14:15 peter

9
compiler/nld.pas
View File

@ -312,9 +312,9 @@ implementation
begin
if not assigned(procdef) then
begin
if assigned(tprocsym(symtableentry).defs^.next) then
if Tprocsym(symtableentry).procdef_count>1 then
CGMessage(parser_e_no_overloaded_procvars);
resulttype.setdef(tprocsym(symtableentry).defs^.def);
resulttype.setdef(tprocsym(symtableentry).first_procdef);
end
else
resulttype.setdef(procdef);
@ -1143,7 +1143,10 @@ begin
end.
{
$Log$
Revision 1.56 2002-09-01 13:28:37 daniel
Revision 1.57 2002-09-03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.56 2002/09/01 13:28:37 daniel
- write_access fields removed in favor of a flag
Revision 1.55 2002/09/01 08:01:16 daniel

53
compiler/nmat.pas
View File

@ -430,7 +430,7 @@ implementation
function tunaryminusnode.det_resulttype : tnode;
var
t : tnode;
minusdef : pprocdeflist;
minusdef : Tprocdef;
begin
result:=nil;
resulttypepass(left);
@ -481,22 +481,16 @@ implementation
end
else
begin
minusdef:=nil;
if assigned(overloaded_operators[_minus]) then
minusdef:=overloaded_operators[_minus].defs
else
minusdef:=nil;
while assigned(minusdef) do
minusdef:=overloaded_operators[_minus].search_procdef_by1paradef(left.resulttype.def);
if minusdef<>nil then
begin
if is_equal(tparaitem(minusdef^.def.para.first).paratype.def,left.resulttype.def) and
(tparaitem(minusdef^.def.para.first).next=nil) then
begin
t:=ccallnode.create(ccallparanode.create(left,nil),
overloaded_operators[_minus],nil,nil);
left:=nil;
result:=t;
exit;
end;
minusdef:=minusdef^.next;
t:=ccallnode.create(ccallparanode.create(left,nil),
overloaded_operators[_minus],nil,nil);
left:=nil;
result:=t;
exit;
end;
CGMessage(type_e_mismatch);
end;
@ -567,7 +561,7 @@ implementation
function tnotnode.det_resulttype : tnode;
var
t : tnode;
notdef : pprocdeflist;
notdef : Tprocdef;
v : tconstexprint;
begin
result:=nil;
@ -660,22 +654,16 @@ implementation
end
else
begin
notdef:=nil;
if assigned(overloaded_operators[_op_not]) then
notdef:=overloaded_operators[_op_not].defs
else
notdef:=nil;
while assigned(notdef) do
notdef:=overloaded_operators[_op_not].search_procdef_by1paradef(left.resulttype.def);
if notdef<>nil then
begin
if is_equal(tparaitem(notdef^.def.para.first).paratype.def,left.resulttype.def) and
(tparaitem(notdef^.def.para.first).next=nil) then
begin
t:=ccallnode.create(ccallparanode.create(left,nil),
overloaded_operators[_op_not],nil,nil);
left:=nil;
result:=t;
exit;
end;
notdef:=notdef^.next;
t:=ccallnode.create(ccallparanode.create(left,nil),
overloaded_operators[_op_not],nil,nil);
left:=nil;
result:=t;
exit;
end;
CGMessage(type_e_mismatch);
end;
@ -759,7 +747,10 @@ begin
end.
{
$Log$
Revision 1.40 2002-08-25 11:32:33 peter
Revision 1.41 2002-09-03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.40 2002/08/25 11:32:33 peter
* don't optimize not([lten,gten]) for setdefs
Revision 1.39 2002/08/25 09:10:58 peter

110
compiler/nobj.pas
View File

@ -224,50 +224,47 @@ implementation
procedure tclassheader.insertmsgint(p : tnamedindexitem;arg:pointer);
var
hp : pprocdeflist;
i : cardinal;
def: Tprocdef;
pt : pprocdeftree;
begin
if tsym(p).typ=procsym then
begin
hp:=tprocsym(p).defs;
while assigned(hp) do
begin
if (po_msgint in hp^.def.procoptions) then
begin
new(pt);
pt^.data:=hp^.def;
pt^.l:=nil;
pt^.r:=nil;
insertint(pt,root);
end;
hp:=hp^.next;
end;
end;
for i:=1 to Tprocsym(p).procdef_count do
begin
def:=Tprocsym(p).procdef[i];
if po_msgint in def.procoptions then
begin
new(pt);
pt^.data:=def;
pt^.l:=nil;
pt^.r:=nil;
insertint(pt,root);
end;
end;
end;
procedure tclassheader.insertmsgstr(p : tnamedindexitem;arg:pointer);
var
hp : pprocdeflist;
i : cardinal;
def: Tprocdef;
pt : pprocdeftree;
begin
if tsym(p).typ=procsym then
begin
hp:=tprocsym(p).defs;
while assigned(hp) do
begin
if (po_msgstr in hp^.def.procoptions) then
begin
new(pt);
pt^.data:=hp^.def;
pt^.l:=nil;
pt^.r:=nil;
insertstr(pt,root);
end;
hp:=hp^.next;
end;
end;
for i:=1 to Tprocsym(p).procdef_count do
begin
def:=Tprocsym(p).procdef[i];
if po_msgint in def.procoptions then
begin
new(pt);
pt^.data:=def;
pt^.l:=nil;
pt^.r:=nil;
insertstr(pt,root);
end;
end;
end;
procedure tclassheader.writenames(p : pprocdeftree);
@ -463,9 +460,9 @@ implementation
begin
if (tsym(p).typ=procsym) and (sp_published in tsym(p).symoptions) then
begin
if assigned(tprocsym(p).defs^.next) then
if Tprocsym(p).procdef_count>1 then
internalerror(1209992);
hp:=tprocsym(p).defs^.def;
hp:=tprocsym(p).first_procdef;
objectlibrary.getdatalabel(l);
Consts.concat(Tai_label.Create(l));
@ -539,6 +536,9 @@ implementation
{ creates a new entry in the procsym list }
procedure newentry;
var i:cardinal;
begin
{ if not, generate a new symbol item }
new(symcoll);
@ -548,18 +548,15 @@ implementation
wurzel:=symcoll;
{ inserts all definitions }
hp:=tprocsym(sym).defs;
while assigned(hp) do
begin
newdefentry(hp^.def);
hp:=hp^.next;
end;
for i:=1 to Tprocsym(sym).procdef_count do
newdefentry(Tprocsym(sym).procdef[i]);
end;
label
handlenextdef;
var
pd : tprocdef;
i : cardinal;
is_visible,
pdoverload : boolean;
begin
@ -584,10 +581,9 @@ implementation
if _name=symcoll^.name^ then
begin
{ walk through all defs of the symbol }
hp:=tprocsym(sym).defs;
while assigned(hp) do
begin
pd:=hp^.def;
for i:=1 to Tprocsym(sym).procdef_count do
begin
pd:=Tprocsym(sym).procdef[i];
if pd.procsym=sym then
begin
pdoverload:=(po_overload in pd.procoptions);
@ -719,7 +715,6 @@ implementation
newdefentry(pd);
end;
handlenextdef:
hp:=hp^.next;
end;
exit;
end;
@ -998,24 +993,22 @@ implementation
function tclassheader.gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
var
sym: tprocsym;
implprocdef : pprocdeflist;
implprocdef : Tprocdef;
i: cardinal;
begin
gintfgetcprocdef:=nil;
sym:=tprocsym(search_class_member(_class,name));
if assigned(sym) and (sym.typ=procsym) then
begin
implprocdef:=sym.defs;
while assigned(implprocdef) do
begin
if equal_paras(proc.para,implprocdef^.def.para,cp_none) and
(proc.proccalloption=implprocdef^.def.proccalloption) then
for i:=1 to sym.procdef_count do
begin
implprocdef:=sym.procdef[i];
if equal_paras(proc.para,implprocdef.para,cp_none) and
(proc.proccalloption=implprocdef.proccalloption) then
begin
gintfgetcprocdef:=implprocdef^.def;
gintfgetcprocdef:=implprocdef;
exit;
end;
implprocdef:=implprocdef^.next;
end;
end;
end;
end;
@ -1308,7 +1301,10 @@ initialization
end.
{
$Log$
Revision 1.26 2002-09-03 15:44:44 peter
Revision 1.27 2002-09-03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.26 2002/09/03 15:44:44 peter
* fixed private methods hiding public virtual methods
Revision 1.25 2002/08/11 14:32:27 peter

18
compiler/node.pas
View File

@ -342,7 +342,7 @@ interface
{$ifdef var_notification}
{ For a t1:=t2 tree, mark the part of the tree t1 that gets
written to (normally the loadnode) as write access. }
procedure mark_write;virtual;
procedure mark_write;virtual;abstract;
{$endif}
procedure det_temp;virtual;abstract;
@ -719,17 +719,6 @@ implementation
fileinfo:=filepos;
end;
{$ifdef var_notification}
{ For a t1:=t2 tree, mark the part of the tree t1 that gets
written to (normally the loadnode) as write access. }
procedure Tnode.mark_write;
begin
writenode(self);
runerror(211);
end;
{$endif}
{****************************************************************************
TUNARYNODE
****************************************************************************}
@ -989,7 +978,10 @@ implementation
end.
{
$Log$
Revision 1.41 2002-09-01 13:28:38 daniel
Revision 1.42 2002-09-03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.41 2002/09/01 13:28:38 daniel
- write_access fields removed in favor of a flag
Revision 1.40 2002/09/01 08:01:16 daniel

39
compiler/pdecobj.pas
View File

@ -196,10 +196,10 @@ implementation
var
sym : tsym;
propertyparas : tlinkedlist;
propertyparas : tparalinkedlist;
{ returns the matching procedure to access a property }
function get_procdef : tprocdef;
{ function get_procdef : tprocdef;
var
p : pprocdeflist;
begin
@ -215,7 +215,7 @@ implementation
end;
p:=p^.next;
end;
end;
end;}
var
hp2,datacoll : tparaitem;
@ -227,7 +227,7 @@ implementation
s : string;
tt : ttype;
declarepos : tfileposinfo;
pp : pprocdeflist;
pp : Tprocdef;
pd : tprocdef;
pt : tnode;
propname : stringid;
@ -385,7 +385,7 @@ implementation
case sym.typ of
procsym :
begin
pd:=get_procdef;
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true);
if not(assigned(pd)) or
not(is_equal(pd.rettype.def,p.proptype.def)) then
Message(parser_e_ill_property_access_sym);
@ -420,7 +420,7 @@ implementation
begin
{ insert data entry to check access method }
propertyparas.insert(datacoll);
pd:=get_procdef;
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true);
{ ... and remove it }
propertyparas.remove(datacoll);
if not(assigned(pd)) then
@ -464,20 +464,11 @@ implementation
case sym.typ of
procsym :
begin
pp:=tprocsym(sym).defs;
while assigned(pp) do
begin
{ the stored function shouldn't have any parameters }
if pp^.def.Para.empty then
break;
pp:=pp^.next;
end;
{ found we a procedure and does it really return a bool? }
if assigned(pp) and
is_boolean(pp^.def.rettype.def) then
p.storedaccess.setdef(pp^.def)
else
Message(parser_e_ill_property_storage_sym);
pp:=Tprocsym(sym).search_procdef_nopara_boolret;
if assigned(pp) then
p.storedaccess.setdef(pp)
else
message(parser_e_ill_property_storage_sym);
end;
varsym :
begin
@ -536,9 +527,8 @@ implementation
symtablestack.insert(p);
{ default property ? }
consume(_SEMICOLON);
if (idtoken=_DEFAULT) then
if try_to_consume(_DEFAULT) then
begin
consume(_DEFAULT);
{ overriding a default propertyp is allowed
p2:=search_default_property(aktclass);
if assigned(p2) then
@ -1157,7 +1147,10 @@ implementation
end.
{
$Log$
Revision 1.49 2002-08-17 09:23:38 florian
Revision 1.50 2002-09-03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.49 2002/08/17 09:23:38 florian
* first part of procinfo rewrite
Revision 1.48 2002/08/09 07:33:02 florian

25
compiler/pdecsub.pas
View File

@ -524,16 +524,8 @@ implementation
begin
{ create the procsym with saving the original case }
aktprocsym:=tprocsym.create('$'+sp);
{ add already known overloaded defs }
if assigned(overloaded_operators[optoken]) then
begin
pdl:=overloaded_operators[optoken].defs;
while assigned(pdl) do
begin
aktprocsym.addprocdef(pdl^.def);
pdl:=pdl^.next;
end;
end;
overloaded_operators[optoken].concat_procdefs_to(aktprocsym);
end;
end
else
@ -1741,17 +1733,16 @@ const
}
var
hd : tprocdef;
pdl : pprocdeflist;
ad,fd : tsym;
forwardfound : boolean;
i : cardinal;
begin
forwardfound:=false;
{ check overloaded functions if the same function already exists }
pdl:=aprocsym.defs;
while assigned(pdl) do
for i:=1 to aprocsym.procdef_count do
begin
hd:=pdl^.def;
hd:=aprocsym.procdef[i];
{ check the parameters, for delphi/tp it is possible to
leave the parameters away in the implementation (forwarddef=false).
@ -1939,9 +1930,6 @@ const
end;
end;
end; { equal arguments }
{ try next overloaded }
pdl:=pdl^.next;
end;
{ if we didn't reuse a forwarddef then we add the procdef to the overloaded
@ -1988,7 +1976,10 @@ const
end.
{
$Log$
Revision 1.69 2002-09-01 12:11:33 peter
Revision 1.70 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.69 2002/09/01 12:11:33 peter
* calc param_offset after parameters are read, because the calculation
depends on po_containself

189
compiler/pexports.pas
View File

@ -64,106 +64,98 @@ implementation
DefString:='';
InternalProcName:='';
consume(_EXPORTS);
while true do
begin
hp:=texported_item.create;
if token=_ID then
begin
orgs:=orgpattern;
consume_sym(srsym,srsymtable);
hp.sym:=srsym;
InternalProcName:='';
case srsym.typ of
varsym :
InternalProcName:=tvarsym(srsym).mangledname;
typedconstsym :
InternalProcName:=ttypedconstsym(srsym).mangledname;
procsym :
begin
if assigned(tprocsym(srsym).defs^.next) or
((tf_need_export in target_info.flags) and
not(po_exports in tprocsym(srsym).defs^.def.procoptions)) then
Message(parser_e_illegal_symbol_exported)
else
InternalProcName:=tprocsym(srsym).defs^.def.mangledname;
end;
else
Message(parser_e_illegal_symbol_exported)
end;
if InternalProcName<>'' then
repeat
hp:=texported_item.create;
if token=_ID then
begin
orgs:=orgpattern;
consume_sym(srsym,srsymtable);
hp.sym:=srsym;
InternalProcName:='';
case srsym.typ of
varsym :
InternalProcName:=tvarsym(srsym).mangledname;
typedconstsym :
InternalProcName:=ttypedconstsym(srsym).mangledname;
procsym :
begin
{ This is wrong if the first is not
an underline }
if InternalProcName[1]='_' then
delete(InternalProcName,1,1)
else if (target_info.system in [system_i386_win32,system_i386_wdosx]) and UseDeffileForExport then
begin
Message(parser_e_dlltool_unit_var_problem);
Message(parser_e_dlltool_unit_var_problem2);
end;
if length(InternalProcName)<2 then
Message(parser_e_procname_to_short_for_export);
DefString:=srsym.realname+'='+InternalProcName;
end;
if (idtoken=_INDEX) then
begin
consume(_INDEX);
pt:=comp_expr(true);
if pt.nodetype=ordconstn then
hp.index:=tordconstnode(pt).value
if (Tprocsym(srsym).procdef_count>1) or
((tf_need_export in target_info.flags) and
not(po_exports in tprocsym(srsym).first_procdef.procoptions)) then
Message(parser_e_illegal_symbol_exported)
else
begin
hp.index:=0;
consume(_INTCONST);
end;
hp.options:=hp.options or eo_index;
pt.free;
if target_info.system in [system_i386_win32,system_i386_wdosx] then
DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(hp.index)
else
DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
InternalProcName:=tprocsym(srsym).first_procdef.mangledname;
end;
if (idtoken=_NAME) then
begin
consume(_NAME);
pt:=comp_expr(true);
if pt.nodetype=stringconstn then
hp.name:=stringdup(strpas(tstringconstnode(pt).value_str))
else
begin
hp.name:=stringdup('');
consume(_CSTRING);
end;
hp.options:=hp.options or eo_name;
pt.free;
DefString:=hp.name^+'='+InternalProcName;
end;
if (idtoken=_RESIDENT) then
begin
consume(_RESIDENT);
hp.options:=hp.options or eo_resident;
DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
end;
if (DefString<>'') and UseDeffileForExport then
DefFile.AddExport(DefString);
{ Default to generate a name entry with the provided name }
if not assigned(hp.name) then
begin
hp.name:=stringdup(orgs);
hp.options:=hp.options or eo_name;
end;
if hp.sym.typ=procsym then
exportlib.exportprocedure(hp)
else
Message(parser_e_illegal_symbol_exported)
end;
if InternalProcName<>'' then
begin
{ This is wrong if the first is not
an underline }
if InternalProcName[1]='_' then
delete(InternalProcName,1,1)
else if (target_info.system in [system_i386_win32,system_i386_wdosx]) and UseDeffileForExport then
begin
Message(parser_e_dlltool_unit_var_problem);
Message(parser_e_dlltool_unit_var_problem2);
end;
if length(InternalProcName)<2 then
Message(parser_e_procname_to_short_for_export);
DefString:=srsym.realname+'='+InternalProcName;
end;
if try_to_consume(_INDEX) then
begin
pt:=comp_expr(true);
if pt.nodetype=ordconstn then
hp.index:=tordconstnode(pt).value
else
exportlib.exportvar(hp);
end
else
consume(_ID);
if token=_COMMA then
consume(_COMMA)
else
break;
end;
begin
hp.index:=0;
consume(_INTCONST);
end;
hp.options:=hp.options or eo_index;
pt.free;
if target_info.system in [system_i386_win32,system_i386_wdosx] then
DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(hp.index)
else
DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
end;
if try_to_consume(_NAME) then
begin
pt:=comp_expr(true);
if pt.nodetype=stringconstn then
hp.name:=stringdup(strpas(tstringconstnode(pt).value_str))
else
begin
hp.name:=stringdup('');
consume(_CSTRING);
end;
hp.options:=hp.options or eo_name;
pt.free;
DefString:=hp.name^+'='+InternalProcName;
end;
if try_to_consume(_RESIDENT) then
begin
hp.options:=hp.options or eo_resident;
DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
end;
if (DefString<>'') and UseDeffileForExport then
DefFile.AddExport(DefString);
{ Default to generate a name entry with the provided name }
if not assigned(hp.name) then
begin
hp.name:=stringdup(orgs);
hp.options:=hp.options or eo_name;
end;
if hp.sym.typ=procsym then
exportlib.exportprocedure(hp)
else
exportlib.exportvar(hp);
end
else
consume(_ID);
until not try_to_consume(_COMMA);
consume(_SEMICOLON);
if not DefFile.empty then
DefFile.writefile;
@ -173,7 +165,10 @@ end.
{
$Log$
Revision 1.22 2002-07-26 21:15:41 florian
Revision 1.23 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.22 2002/07/26 21:15:41 florian
* rewrote the system handling
Revision 1.21 2002/05/18 13:34:12 peter

9
compiler/pexpr.pas
View File

@ -897,7 +897,7 @@ implementation
(assigned(getprocvardef) and
((block_type=bt_const) or
((m_tp_procvar in aktmodeswitches) and
proc_to_procvar_equal(tprocsym(sym).defs^.def,getprocvardef,false)
proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef,false)
)
)
),again,p1);
@ -1232,7 +1232,7 @@ implementation
(assigned(getprocvardef) and
((block_type=bt_const) or
((m_tp_procvar in aktmodeswitches) and
proc_to_procvar_equal(tprocsym(srsym).defs^.def,getprocvardef,false)
proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef,false)
)
)
),again,p1);
@ -2248,7 +2248,10 @@ implementation
end.
{
$Log$
Revision 1.77 2002-08-18 20:06:24 peter
Revision 1.78 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.77 2002/08/18 20:06:24 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu

11
compiler/pmodules.pas
View File

@ -617,7 +617,6 @@ implementation
procedure gen_main_procsym(const name:string;options:tproctypeoption;st:tsymtable);
var
stt : tsymtable;
procdefs : pprocdeflist;
begin
{Generate a procsym for main}
make_ref:=false;
@ -628,10 +627,7 @@ implementation
stt:=symtablestack;
symtablestack:=st;
aktprocdef:=tprocdef.create;
new(procdefs);
procdefs^.def:=aktprocdef;
procdefs^.next:=aktprocsym.defs;
aktprocsym.defs:=procdefs;
aktprocsym.addprocdef(aktprocdef);
aktprocdef.procsym:=aktprocsym;
symtablestack:=stt;
aktprocdef.proctypeoption:=options;
@ -1390,7 +1386,10 @@ implementation
end.
{
$Log$
Revision 1.76 2002-09-02 18:46:26 peter
Revision 1.77 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.76 2002/09/02 18:46:26 peter
* insert PASCALMAIN in library for Win32 only
Revision 1.75 2002/08/31 15:59:30 florian

11
compiler/powerpc/radirect.pas
View File

@ -181,7 +181,7 @@ interface
else
{ call to local function }
if (sym.typ=procsym) and (pos('BL',upper(s))>0) then
hs:=tprocsym(sym).defs^.def.mangledname;
hs:=tprocsym(sym).first_procdef.mangledname;
end
else
begin
@ -227,10 +227,10 @@ interface
{ procs can be called or the address can be loaded }
if (pos('BL',upper(s))>0) {or (pos('LEA',upper(s))>0))} then
begin
if assigned(tprocsym(sym).defs^.def) then
if Tprocsym(sym).procdef_count>1 then
Message1(asmr_w_direct_global_is_overloaded_func,hs);
Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
hs:=tprocsym(sym).defs^.def.mangledname;
hs:=tprocsym(sym).first_procdef.mangledname;
end;
end;
else
@ -314,7 +314,10 @@ initialization
end.
{
$Log$
Revision 1.3 2002-08-31 15:59:31 florian
Revision 1.4 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.3 2002/08/31 15:59:31 florian
+ HEAP* stuff must be generated for Linux/PPC as well
+ direct assembler reader searches now global and static symtables as well

13
compiler/psub.pas
View File

@ -580,10 +580,10 @@ implementation
{ Give a better error if there is a forward def in the interface and only
a single implementation }
if (not aktprocdef.forwarddef) and
assigned(aktprocsym.defs^.next) and
aktprocsym.defs^.def.forwarddef and
aktprocsym.defs^.def.interfacedef and
not(assigned(aktprocsym.defs^.next^.next)) then
(aktprocsym.procdef_count>1) and
aktprocsym.first_procdef.forwarddef and
aktprocsym.first_procdef.interfacedef and
not(aktprocsym.procdef_count>2) then
begin
Message1(parser_e_header_dont_match_forward,aktprocdef.fullprocname);
aktprocsym.write_parameter_lists(aktprocdef);
@ -788,7 +788,10 @@ implementation
end.
{
$Log$
Revision 1.69 2002-08-25 19:25:20 peter
Revision 1.70 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.69 2002/08/25 19:25:20 peter
* sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be

11
compiler/ptconst.pas
View File

@ -393,9 +393,9 @@ implementation
case srsym.typ of
procsym :
begin
if assigned(tprocsym(srsym).defs^.next) then
if Tprocsym(srsym).procdef_count>1 then
Message(parser_e_no_overloaded_procvars);
curconstSegment.concat(Tai_const_symbol.Createname_offset(tprocsym(srsym).defs^.def.mangledname,offset));
curconstSegment.concat(Tai_const_symbol.Createname_offset(tprocsym(srsym).first_procdef.mangledname,offset));
end;
varsym :
curconstSegment.concat(Tai_const_symbol.Createname_offset(tvarsym(srsym).mangledname,offset));
@ -733,7 +733,7 @@ implementation
(tloadnode(p).symtableentry.typ=procsym) then
begin
curconstSegment.concat(Tai_const_symbol.createname(
tprocsym(tloadnode(p).symtableentry).defs^.def.mangledname));
tprocsym(tloadnode(p).symtableentry).first_procdef.mangledname));
end
else
Message(cg_e_illegal_expression);
@ -986,7 +986,10 @@ implementation
end.
{
$Log$
Revision 1.55 2002-08-11 14:32:27 peter
Revision 1.56 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.55 2002/08/11 14:32:27 peter
* renamed current_library to objectlibrary
Revision 1.54 2002/08/11 13:24:13 peter

9
compiler/rautils.pas
View File

@ -985,11 +985,11 @@ Begin
end;
procsym :
begin
if assigned(tprocsym(sym).defs^.next) then
if Tprocsym(sym).procdef_count>1 then
Message(asmr_w_calling_overload_func);
l:=opr.ref.offset;
opr.typ:=OPR_SYMBOL;
opr.symbol:=objectlibrary.newasmsymbol(tprocsym(sym).defs^.def.mangledname);
opr.symbol:=objectlibrary.newasmsymbol(tprocsym(sym).first_procdef.mangledname);
opr.symofs:=l;
hasvar:=true;
SetupVar:=TRUE;
@ -1592,7 +1592,10 @@ end;
end.
{
$Log$
Revision 1.45 2002-08-25 19:25:20 peter
Revision 1.46 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.45 2002/08/25 19:25:20 peter
* sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be

97
compiler/symsym.pas
View File

@ -110,12 +110,15 @@ interface
Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);
tprocsym = class(tstoredsym)
{ protected}
defs : pprocdeflist; { linked list of overloaded procdefs }
protected
defs : pprocdeflist; { linked list of overloaded procdefs }
function getprocdef(nr:cardinal):Tprocdef;
public
procdef_count : cardinal;
is_global : boolean;
overloadchecked : boolean;
overloadcount : longint; { amount of overloaded functions in this module }
overloadcount : longint; { amount of overloaded functions in this module }
property procdef[nr:cardinal]:Tprocdef read getprocdef;
constructor create(const n : string);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -128,18 +131,19 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure deref;override;
procedure addprocdef(p:tprocdef);
function procdef_count:byte;
function procdef(nr:byte):Tprocdef;
procedure add_para_match_to(Aprocsym:Tprocsym);
procedure concat_procdefs_to(s:Tprocsym);
procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
function first_procdef:Tprocdef;
function last_procdef:Tprocdef;
function search_procdef_nopara_boolret:Tprocdef;
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function search_procdef_bypara(params:Tparalinkedlist):Tprocdef;
function search_procdef_bypara(params:Tparalinkedlist;
allowconvert:boolean):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
matchtype:Tdefmatch):Tprocdef;
matchtype:Tdefmatch):Tprocdef;
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
{$ifdef GDB}
function stabstring : pchar;override;
@ -786,6 +790,7 @@ implementation
is_global:=false;
overloadchecked:=false;
overloadcount:=0;
procdef_count:=0;
end;
@ -796,6 +801,7 @@ implementation
inherited loadsym(ppufile);
typ:=procsym;
defs:=nil;
procdef_count:=0;
repeat
pd:=tprocdef(ppufile.getderef);
if pd=nil then
@ -877,32 +883,19 @@ implementation
pd^.def:=p;
pd^.next:=defs;
defs:=pd;
inc(procdef_count);
end;
function Tprocsym.procdef_count:byte;
function Tprocsym.getprocdef(nr:cardinal):Tprocdef;
var pd:Pprocdeflist;
begin
procdef_count:=0;
pd:=defs;
while assigned(pd) do
begin
inc(procdef_count);
pd:=pd^.next;
end;
end;
function Tprocsym.procdef(nr:byte):Tprocdef;
var i:byte;
pd:Pprocdeflist;
var i:cardinal;
pd:Pprocdeflist;
begin
pd:=defs;
for i:=2 to nr do
pd:=pd^.next;
procdef:=pd^.def;
getprocdef:=pd^.def;
end;
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
@ -913,7 +906,7 @@ implementation
pd:=defs;
while assigned(pd) do
begin
if Aprocsym.search_procdef_bypara(pd^.def.para)=nil then
if Aprocsym.search_procdef_bypara(pd^.def.para,false)=nil then
Aprocsym.addprocdef(pd^.def);
pd:=pd^.next;
end;
@ -964,6 +957,24 @@ implementation
end;
end;
function Tprocsym.search_procdef_nopara_boolret:Tprocdef;
var p:Pprocdeflist;
begin
search_procdef_nopara_boolret:=nil;
p:=defs;
while p<>nil do
begin
if p^.def.para.empty and is_boolean(p^.def.rettype.def) then
begin
search_procdef_nopara_boolret:=p^.def;
break;
end;
p:=p^.next;
end;
end;
function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
var p:Pprocdeflist;
@ -982,7 +993,8 @@ implementation
end;
end;
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist):Tprocdef;
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
allowconvert:boolean):Tprocdef;
var pd:Pprocdeflist;
@ -991,7 +1003,9 @@ implementation
pd:=defs;
while assigned(pd) do
begin
if equal_paras(pd^.def.para,params,cp_value_equal_const) then
if equal_paras(pd^.def.para,params,cp_value_equal_const) or
(allowconvert and convertable_paras(pd^.def.para,params,
cp_value_equal_const)) then
begin
search_procdef_bypara:=pd^.def;
break;
@ -1046,8 +1060,27 @@ implementation
end;
end;
function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
var pd:Pprocdeflist;
begin
search_procdef_by1paradef:=nil;
pd:=defs;
while assigned(pd) do
begin
if is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
(Tparaitem(pd^.def.para.first).next=nil) then
begin
search_procdef_by1paradef:=pd^.def;
break;
end;
pd:=pd^.next;
end;
end;
function Tprocsym.search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
matchtype:Tdefmatch):Tprocdef;
matchtype:Tdefmatch):Tprocdef;
var pd:Pprocdeflist;
convtyp:Tconverttype;
@ -1152,6 +1185,7 @@ implementation
begin
{ remove }
dispose(p);
dec(procdef_count);
end;
p:=hp;
end;
@ -2443,7 +2477,10 @@ implementation
end.
{
$Log$
Revision 1.58 2002-09-01 08:01:16 daniel
Revision 1.59 2002-09-03 16:26:27 daniel
* Make Tprocdef.defs protected
Revision 1.58 2002/09/01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example

9
compiler/targets/t_beos.pas
View File

@ -166,13 +166,13 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in codesegment }
codesegment.concat(Tai_align.Create_op(4,$90));
codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;
@ -465,7 +465,10 @@ initialization
end.
{
$Log$
Revision 1.23 2002-08-12 15:08:44 carl
Revision 1.24 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.23 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

9
compiler/targets/t_fbsd.pas
View File

@ -168,13 +168,13 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in codesegment }
codesegment.concat(Tai_align.Create_op(4,$90));
codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;
@ -514,7 +514,10 @@ initialization
end.
{
$Log$
Revision 1.28 2002-08-12 15:08:44 carl
Revision 1.29 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.28 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

9
compiler/targets/t_linux.pas
View File

@ -175,13 +175,13 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in codesegment }
codesegment.concat(Tai_align.Create_op(4,$90));
codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;
@ -524,7 +524,10 @@ end.
{
$Log$
Revision 1.32 2002-08-12 15:08:44 carl
Revision 1.33 2002-09-03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.32 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

9
compiler/targets/t_nwm.pas
View File

@ -233,13 +233,13 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in codesegment }
codesegment.concat(Tai_align.Create_op(4,$90));
codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;
@ -484,7 +484,10 @@ initialization
end.
{
$Log$
Revision 1.29 2002-08-12 15:08:44 carl
Revision 1.30 2002-09-03 16:26:29 daniel
* Make Tprocdef.defs protected
Revision 1.29 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

9
compiler/targets/t_sunos.pas
View File

@ -182,13 +182,13 @@ begin
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in codesegment }
codesegment.concat(Tai_align.Create_op(4,$90));
codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;
@ -486,7 +486,10 @@ initialization
end.
{
$Log$
Revision 1.28 2002-08-12 15:08:44 carl
Revision 1.29 2002-09-03 16:26:29 daniel
* Make Tprocdef.defs protected
Revision 1.28 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

9
compiler/targets/t_win32.pas
View File

@ -740,7 +740,7 @@ const
typedconstsym :
address_table.concat(Tai_const_symbol.Createname_rva(ttypedconstsym(hp.sym).mangledname));
procsym :
address_table.concat(Tai_const_symbol.Createname_rva(tprocsym(hp.sym).defs^.def.mangledname));
address_table.concat(Tai_const_symbol.Createname_rva(tprocsym(hp.sym).first_procdef.mangledname));
end;
inc(current_index);
hp:=texported_item(hp.next);
@ -773,7 +773,7 @@ const
typedconstsym :
s:=ttypedconstsym(hp.sym).mangledname;
procsym :
s:=tprocsym(hp.sym).defs^.def.mangledname;
s:=tprocsym(hp.sym).first_procdef.mangledname;
else
s:='';
end;
@ -1553,7 +1553,10 @@ initialization
end.
{
$Log$
Revision 1.39 2002-08-12 15:08:44 carl
Revision 1.40 2002-09-03 16:26:29 daniel
* Make Tprocdef.defs protected
Revision 1.39 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class