paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-24 10:01:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* vs_hidden released

Browse Source
This commit is contained in:
peter 2003-04-10 17:57:52 +00:00
parent 635280c5d2
commit 8da3f59d32
11 changed files with 482 additions and 584 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/defcmp.pas
View File

@ -1057,8 +1057,8 @@ implementation
{ we need to parse the list from left-right so the
not-default parameters are checked first }
lowesteq:=high(tequaltype);
def1:=TParaItem(paralist1.last);
def2:=TParaItem(paralist2.last);
def1:=TParaItem(paralist1.first);
def2:=TParaItem(paralist2.first);
while (assigned(def1)) and (assigned(def2)) do
begin
eq:=te_incompatible;
@ -1116,8 +1116,8 @@ implementation
if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
exit;
end;
def1:=TParaItem(def1.previous);
def2:=TParaItem(def2.previous);
def1:=TParaItem(def1.next);
def2:=TParaItem(def2.next);
end;
{ when both lists are empty then the parameters are equal. Also
when one list is empty and the other has a parameter with default
@ -1182,7 +1182,10 @@ implementation
end.
{
$Log$
Revision 1.20 2003-03-20 17:52:18 peter
Revision 1.21 2003-04-10 17:57:52 peter
* vs_hidden released
Revision 1.20 2003/03/20 17:52:18 peter
* fix compare for unique types, they are allowed when they match
exact

397
compiler/ncal.pas
View File

@ -65,6 +65,7 @@ interface
{$ifdef EXTDEBUG}
procedure candidates_dump_info(lvl:longint;procs:pcandidate);
{$endif EXTDEBUG}
procedure bind_paraitem;
public
{ the symbol containing the definition of the procedure }
{ to call }
@ -127,9 +128,6 @@ interface
tcallparanode = class(tbinarynode)
callparaflags : set of tcallparaflags;
paraitem : tparaitem;
{$ifndef VS_HIDDEN}
hightree : tnode;
{$endif VS_HIDDEN}
{ only the processor specific nodes need to override this }
{ constructor }
constructor create(expr,next : tnode);virtual;
@ -139,9 +137,8 @@ interface
procedure derefimpl;override;
function getcopy : tnode;override;
procedure insertintolist(l : tnodelist);override;
procedure gen_high_tree(openstring:boolean);
procedure get_paratype;
procedure insert_typeconv(defcoll : tparaitem;do_count : boolean);
procedure insert_typeconv(do_count : boolean);
procedure det_registers;
procedure firstcallparan(do_count : boolean);
procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
@ -215,6 +212,71 @@ type
end;
function gen_high_tree(p:tnode;openstring:boolean):tnode;
var
temp: tnode;
len : integer;
loadconst : boolean;
hightree : tnode;
begin
len:=-1;
loadconst:=true;
hightree:=nil;
case p.resulttype.def.deftype of
arraydef :
begin
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,p.getcopy);
{ only substract low(array) if it's <> 0 }
temp := geninlinenode(in_low_x,false,p.getcopy);
resulttypepass(temp);
if (temp.nodetype <> ordconstn) or
(tordconstnode(temp).value <> 0) then
hightree := caddnode.create(subn,hightree,temp)
else
temp.free;
end;
stringdef :
begin
if openstring then
begin
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,p.getcopy);
end
else
begin
{ passing a string to an array of char }
if (p.nodetype=stringconstn) then
begin
len:=str_length(p);
if len>0 then
dec(len);
end
else
begin
hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy),
cordconstnode.create(1,s32bittype,false));
loadconst:=false;
end;
end;
end;
else
len:=0;
end;
if loadconst then
hightree:=cordconstnode.create(len,s32bittype,true)
else
begin
if not assigned(hightree) then
internalerror(200304071);
hightree:=ctypeconvnode.create(hightree,s32bittype);
end;
result:=hightree;
end;
procedure search_class_overloads(aprocsym : tprocsym);
{ searches n in symtable of pd and all anchestors }
var
@ -463,9 +525,6 @@ type
begin
inherited create(callparan,expr,next);
{$ifndef VS_HIDDEN}
hightree:=nil;
{$endif VS_HIDDEN}
if assigned(expr) then
expr.set_file_line(self);
callparaflags:=[];
@ -474,9 +533,6 @@ type
destructor tcallparanode.destroy;
begin
{$ifndef VS_HIDDEN}
hightree.free;
{$endif VS_HIDDEN}
inherited destroy;
end;
@ -485,9 +541,6 @@ type
begin
inherited ppuload(t,ppufile);
ppufile.getsmallset(callparaflags);
{$ifndef VS_HIDDEN}
hightree:=ppuloadnode(ppufile);
{$endif VS_HIDDEN}
end;
@ -495,19 +548,12 @@ type
begin
inherited ppuwrite(ppufile);
ppufile.putsmallset(callparaflags);
{$ifndef VS_HIDDEN}
ppuwritenode(ppufile,hightree);
{$endif VS_HIDDEN}
end;
procedure tcallparanode.derefimpl;
begin
inherited derefimpl;
{$ifndef VS_HIDDEN}
if assigned(hightree) then
hightree.derefimpl;
{$endif VS_HIDDEN}
end;
@ -519,12 +565,6 @@ type
begin
n:=tcallparanode(inherited getcopy);
n.callparaflags:=callparaflags;
{$ifndef VS_HIDDEN}
if assigned(hightree) then
n.hightree:=hightree.getcopy
else
n.hightree:=nil;
{$endif VS_HIDDEN}
n.paraitem:=paraitem;
result:=n;
end;
@ -558,7 +598,7 @@ type
end;
procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
procedure tcallparanode.insert_typeconv(do_count : boolean);
var
oldtype : ttype;
{$ifdef extdebug}
@ -567,8 +607,6 @@ type
begin
inc(parsing_para_level);
paraitem:=defcoll;
if not assigned(paraitem) then
internalerror(200104261);
@ -603,14 +641,14 @@ type
end
else
begin
{ Do we need arrayconstructor -> set conversion, then insert
it here before the arrayconstructor node breaks the tree
with its conversions of enum->ord }
if (left.nodetype=arrayconstructorn) and
(paraitem.paratype.def.deftype=setdef) then
inserttypeconv(left,paraitem.paratype);
{ set some settings needed for arrayconstructor }
if is_array_constructor(left.resulttype.def) then
begin
@ -630,15 +668,11 @@ type
tarrayconstructornode(left).force_type(tarraydef(paraitem.paratype.def).elementtype);
end;
end;
{ check if local proc/func is assigned to procvar }
if left.resulttype.def.deftype=procvardef then
test_local_to_procvar(tprocvardef(left.resulttype.def),paraitem.paratype.def);
{ generate the high() value tree }
if paramanager.push_high_param(paraitem.paratype.def,aktcallprocdef.proccalloption) then
gen_high_tree(is_open_string(paraitem.paratype.def));
{ test conversions }
if not(is_shortstring(left.resulttype.def) and
is_shortstring(paraitem.paratype.def)) and
@ -675,7 +709,7 @@ type
exit;
end;
end;
{ check var strings }
if (cs_strict_var_strings in aktlocalswitches) and
is_shortstring(left.resulttype.def) and
@ -687,7 +721,7 @@ type
aktfilepos:=left.fileinfo;
CGMessage(type_e_strict_var_string_violation);
end;
{ Handle formal parameters separate }
if (paraitem.paratype.def.deftype=formaldef) then
begin
@ -696,7 +730,7 @@ type
(left.nodetype=calln) and
(is_void(left.resulttype.def)) then
load_procvar_from_calln(left);
case paraitem.paratyp of
vs_var,
vs_out :
@ -717,7 +751,7 @@ type
if (paraitem.paratyp in [vs_out,vs_var]) then
valid_for_var(left);
end;
if paraitem.paratyp in [vs_var,vs_const] then
begin
{ Causes problems with const ansistrings if also }
@ -726,12 +760,12 @@ type
set_unique(left);
make_not_regable(left);
end;
{ ansistrings out paramaters doesn't need to be }
{ unique, they are finalized }
if paraitem.paratyp=vs_out then
make_not_regable(left);
if do_count then
begin
{ not completly proper, but avoids some warnings }
@ -743,15 +777,9 @@ type
resulttype:=paraitem.paratype;
end;
{ process next node }
if assigned(right) then
begin
{ if we are a para that belongs to varargs then keep
the current paraitem }
if (nf_varargs_para in flags) then
tcallparanode(right).insert_typeconv(paraitem,do_count)
else
tcallparanode(right).insert_typeconv(tparaitem(paraitem.next),do_count)
end;
tcallparanode(right).insert_typeconv(do_count);
dec(parsing_para_level);
{$ifdef extdebug}
@ -809,149 +837,16 @@ type
det_registers;
end;
{$ifdef VS_HIDDEN}
procedure tcallparanode.gen_high_tree(openstring:boolean);
var
temp: tnode;
len : integer;
loadconst : boolean;
hightree : tnode;
begin
{ if assigned(hightree) then
exit;
}
if (nf_hightree_generated in flags) then
exit;
len:=-1;
loadconst:=true;
case left.resulttype.def.deftype of
arraydef :
begin
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,left.getcopy);
{ only substract low(array) if it's <> 0 }
temp := geninlinenode(in_low_x,false,left.getcopy);
firstpass(temp);
if (temp.nodetype <> ordconstn) or
(tordconstnode(temp).value <> 0) then
hightree := caddnode.create(subn,hightree,temp)
else
temp.free;
end;
stringdef :
begin
if openstring then
begin
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,left.getcopy);
end
else
{ passing a string to an array of char }
begin
if (left.nodetype=stringconstn) then
begin
len:=str_length(left);
if len>0 then
dec(len);
end
else
begin
hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,left.getcopy),
cordconstnode.create(1,s32bittype,false));
loadconst:=false;
end;
end;
end;
else
len:=0;
end;
if loadconst then
hightree:=cordconstnode.create(len,s32bittype,true)
else
hightree:=ctypeconvnode.create(hightree,s32bittype);
temp:=ccallparanode.create(hightree,right);
right:=temp;
if (tparaitem(paraitem.next).paratyp <> vs_hidden) then
internalerror(200304071);
include(flags,nf_hightree_generated);
end;
{$else VS_HIDDEN}
procedure tcallparanode.gen_high_tree(openstring:boolean);
var
temp: tnode;
len : integer;
loadconst : boolean;
begin
if assigned(hightree) then
exit;
len:=-1;
loadconst:=true;
case left.resulttype.def.deftype of
arraydef :
begin
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,left.getcopy);
{ only substract low(array) if it's <> 0 }
temp := geninlinenode(in_low_x,false,left.getcopy);
firstpass(temp);
if (temp.nodetype <> ordconstn) or
(tordconstnode(temp).value <> 0) then
hightree := caddnode.create(subn,hightree,temp)
else
temp.free;
end;
stringdef :
begin
if openstring then
begin
{ handle via a normal inline in_high_x node }
loadconst := false;
hightree := geninlinenode(in_high_x,false,left.getcopy);
end
else
{ passing a string to an array of char }
begin
if (left.nodetype=stringconstn) then
begin
len:=str_length(left);
if len>0 then
dec(len);
end
else
begin
hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,left.getcopy),
cordconstnode.create(1,s32bittype,false));
loadconst:=false;
end;
end;
end;
else
len:=0;
end;
if loadconst then
hightree:=cordconstnode.create(len,s32bittype,true)
else
hightree:=ctypeconvnode.create(hightree,s32bittype);
firstpass(hightree);
end;
{$endif VS_HIDDEN}
function tcallparanode.docompare(p: tnode): boolean;
begin
docompare :=
inherited docompare(p) and
(callparaflags = tcallparanode(p).callparaflags)
{$ifndef VS_HIDDEN}
and hightree.isequal(tcallparanode(p).hightree)
{$endif VS_HIDDEN}
;
end;
{****************************************************************************
TCALLNODE
****************************************************************************}
@ -998,6 +893,7 @@ type
self.create(params,tprocsym(srsym),symowner,nil);
end;
constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
begin
self.createintern(name,params);
@ -1224,13 +1120,13 @@ type
hp^.data:=pd;
hp^.next:=procs;
procs:=hp;
{ Setup first parameter, skip all default parameters
{ Find last parameter, skip all default parameters
that are not passed. Ignore this skipping for varargs }
hp^.firstpara:=tparaitem(pd.Para.first);
hp^.firstpara:=tparaitem(pd.Para.last);
if not(po_varargs in pd.procoptions) then
begin
for i:=1 to pd.maxparacount-paralength do
hp^.firstpara:=tparaitem(hp^.firstPara.next);
hp^.firstpara:=tparaitem(hp^.firstPara.previous);
end;
end;
@ -1429,11 +1325,13 @@ type
hp:=procs;
while assigned(hp) do
begin
{ Setup first parameter to compare }
{ We compare parameters in reverse order (right to left),
the firstpara is already pointing to the last parameter
were we need to start comparing }
currparanr:=paralength;
currpara:=hp^.firstpara;
while assigned(currpara) and (currpara.paratyp=vs_hidden) do
currpara:=tparaitem(currpara.next);
currpara:=tparaitem(currpara.previous);
pt:=tcallparanode(left);
while assigned(pt) and assigned(currpara) do
begin
@ -1551,7 +1449,7 @@ type
begin
{ Ignore vs_hidden parameters }
repeat
currpara:=tparaitem(currpara.next);
currpara:=tparaitem(currpara.previous);
until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
end;
dec(currparanr);
@ -1653,6 +1551,64 @@ type
end;
procedure tcallnode.bind_paraitem;
var
i : integer;
pt : tcallparanode;
oldppt : ^tcallparanode;
currpara : tparaitem;
hiddentree : tnode;
begin
pt:=tcallparanode(left);
oldppt:=@left;
{ flag all callparanodes that belong to the varargs }
if (po_varargs in procdefinition.procoptions) then
begin
i:=paralength;
while (i>procdefinition.maxparacount) do
begin
include(tcallparanode(pt).flags,nf_varargs_para);
oldppt:=@pt.right;
pt:=tcallparanode(pt.right);
dec(i);
end;
end;
{ insert hidden parameters }
currpara:=tparaitem(procdefinition.Para.last);
while assigned(currpara) do
begin
if not assigned(pt) then
internalerror(200304082);
if (currpara.paratyp=vs_hidden) then
begin
hiddentree:=nil;
if assigned(currpara.previous) and
paramanager.push_high_param(tparaitem(currpara.previous).paratype.def,procdefinition.proccalloption) then
// if vo_is_high_value in tvarsym(currpara.parasym).varoptions then
begin
{ we need the information of the next parameter }
hiddentree:=gen_high_tree(pt.left,is_open_string(tparaitem(currpara.previous).paratype.def));
end;
{ add a callparanode for the hidden parameter and
let the previous node point to this new node }
if not assigned(hiddentree) then
internalerror(200304073);
pt:=ccallparanode.create(hiddentree,oldppt^);
oldppt^:=pt;
end;
{ Bind paraitem to this node }
pt.paraitem:=currpara;
{ Next node and paraitem }
oldppt:=@pt.right;
pt:=tcallparanode(pt.right);
currpara:=tparaitem(currpara.previous);
end;
end;
function tcallnode.det_resulttype:tnode;
var
procs : pcandidate;
@ -1660,7 +1616,7 @@ type
hpt : tnode;
pt : tcallparanode;
lastpara : longint;
pdc : tparaitem;
currpara : tparaitem;
cand_cnt : integer;
i : longint;
is_const : boolean;
@ -1700,26 +1656,26 @@ type
procdefinition:=tabstractprocdef(right.resulttype.def);
{ check the amount of parameters }
pdc:=tparaitem(procdefinition.Para.first);
while assigned(pdc) and (pdc.paratyp=vs_hidden) do
pdc:=tparaitem(pdc.next);
{ Compare parameters from right to left }
currpara:=tparaitem(procdefinition.Para.last);
while assigned(currpara) and (currpara.paratyp=vs_hidden) do
currpara:=tparaitem(currpara.previous);
pt:=tcallparanode(left);
lastpara:=paralength;
while assigned(pdc) and assigned(pt) do
while assigned(currpara) and assigned(pt) do
begin
{ only goto next para if we're out of the varargs }
if not(po_varargs in procdefinition.procoptions) or
(lastpara<=procdefinition.maxparacount) then
begin
repeat
pdc:=tparaitem(pdc.next);
until (not assigned(pdc)) or (pdc.paratyp<>vs_hidden);
currpara:=tparaitem(currpara.previous);
until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
end;
pt:=tcallparanode(pt.right);
dec(lastpara);
end;
if assigned(pt) or assigned(pdc) then
if assigned(pt) or assigned(currpara) then
begin
if assigned(pt) then
aktfilepos:=pt.fileinfo;
@ -1850,15 +1806,15 @@ type
if assigned(procdefinition) and
(paralength<procdefinition.maxparacount) then
begin
pdc:=tparaitem(procdefinition.Para.last);
currpara:=tparaitem(procdefinition.Para.first);
for i:=1 to paralength do
pdc:=tparaitem(pdc.previous);
while assigned(pdc) do
currpara:=tparaitem(currpara.next);
while assigned(currpara) do
begin
if not assigned(pdc.defaultvalue) then
if not assigned(currpara.defaultvalue) then
internalerror(200212142);
left:=ccallparanode.create(genconstsymtree(tconstsym(pdc.defaultvalue)),left);
pdc:=tparaitem(pdc.previous);
left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
currpara:=tparaitem(currpara.next);
end;
end;
end;
@ -1922,25 +1878,13 @@ type
resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
end;
{ flag all callparanodes that belong to the varargs }
if (po_varargs in procdefinition.procoptions) then
begin
pt:=tcallparanode(left);
i:=paralength;
while (i>procdefinition.maxparacount) do
begin
include(tcallparanode(pt).flags,nf_varargs_para);
pt:=tcallparanode(pt.right);
dec(i);
end;
end;
{ bind paraitems to the callparanodes and insert hidden parameters }
aktcallprocdef:=procdefinition;
bind_paraitem;
{ insert type conversions }
{ insert type conversions for parameters }
if assigned(left) then
begin
aktcallprocdef:=procdefinition;
tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
end;
tcallparanode(left).insert_typeconv(true);
{ direct call to inherited abstract method, then we
can already give a error in the compiler instead
@ -2411,7 +2355,10 @@ begin
end.
{
$Log$
Revision 1.134 2003-04-07 11:58:22 jonas
Revision 1.135 2003-04-10 17:57:52 peter
* vs_hidden released
Revision 1.134 2003/04/07 11:58:22 jonas
* more vs_invisible fixes
Revision 1.133 2003/04/07 10:40:21 jonas

31
compiler/ncgcal.pas
View File

@ -95,31 +95,11 @@ implementation
*****************************************************************************}
procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
{$ifndef VS_HIDDEN}
{ goes to pass 1 }
procedure maybe_push_high;
begin
{ open array ? }
{ defcoll.data can be nil for read/write }
if assigned(paraitem.paratype.def) and
assigned(hightree) then
begin
secondpass(hightree);
{ this is a longint anyway ! }
push_value_para(exprasmlist,hightree,calloption,para_offset,4,paraitem.paraloc);
end;
end;
{$endif VS_HIDDEN}
var
otlabel,oflabel : tasmlabel;
{ temporary variables: }
tempdeftype : tdeftype;
tmpreg : tregister;
href : treference;
begin
{ set default para_alignment to target_info.stackalignment }
if para_alignment=0 then
@ -214,9 +194,6 @@ implementation
(left.nodetype=selfn)) then
internalerror(200106041);
end;
{$ifndef VS_HIDDEN}
maybe_push_high;
{$endif VS_HIDDEN}
if (paraitem.paratyp=vs_out) and
assigned(paraitem.paratype.def) and
not is_class(paraitem.paratype.def) and
@ -270,9 +247,6 @@ implementation
internalerror(200204011);
end;
{$ifndef VS_HIDDEN}
maybe_push_high;
{$endif VS_HIDDEN}
inc(pushedparasize,POINTER_SIZE);
if calloption=pocall_inline then
begin
@ -1448,7 +1422,10 @@ begin
end.
{
$Log$
Revision 1.43 2003-04-06 21:11:23 olle
Revision 1.44 2003-04-10 17:57:52 peter
* vs_hidden released
Revision 1.43 2003/04/06 21:11:23 olle
* changed newasmsymbol to newasmsymboldata for data symbols
Revision 1.42 2003/04/04 15:38:56 peter

14
compiler/nmem.pas
View File

@ -425,13 +425,12 @@ implementation
if not assigned(tloadnode(left).left) then
include(tprocvardef(resulttype.def).procoptions,po_addressonly);
{ we need to process the parameters reverse so they are inserted
in the correct right2left order (PFV) }
hp2:=TParaItem(hp3.Para.last);
{ Add parameters in left to right order }
hp2:=TParaItem(hp3.Para.first);
while assigned(hp2) do
begin
tprocvardef(resulttype.def).concatpara(hp2.paratype,hp2.parasym,hp2.paratyp,hp2.defaultvalue);
hp2:=TParaItem(hp2.previous);
tprocvardef(resulttype.def).concatpara(nil,hp2.paratype,hp2.parasym,hp2.paratyp,hp2.defaultvalue);
hp2:=TParaItem(hp2.next);
end;
end
else
@ -1055,7 +1054,10 @@ begin
end.
{
$Log$
Revision 1.46 2003-01-30 21:46:57 peter
Revision 1.47 2003-04-10 17:57:52 peter
* vs_hidden released
Revision 1.46 2003/01/30 21:46:57 peter
* self fixes for static methods (merged)
Revision 1.45 2003/01/09 21:52:37 peter

6
compiler/node.pas
View File

@ -226,7 +226,6 @@ interface
{ flags used by tcallparanode }
nf_varargs_para, { belongs this para to varargs }
nf_hightree_generated, { has the hightree for thispara been generated }
{ taddrnode }
nf_procvarload,
@ -973,7 +972,10 @@ implementation
end.
{
$Log$
Revision 1.51 2003-03-28 19:16:56 peter
Revision 1.52 2003-04-10 17:57:52 peter
* vs_hidden released
Revision 1.51 2003/03/28 19:16:56 peter
* generic constructor working for i386
* remove fixed self register
* esi added as address register for i386

74
compiler/pdecobj.pas
View File

@ -201,29 +201,6 @@ implementation
var
sym : tsym;
propertyparas : tparalinkedlist;
{ returns the matching procedure to access a property }
{ function get_procdef : tprocdef;
var
p : pprocdeflist;
begin
get_procdef:=nil;
p:=tprocsym(sym).defs;
while assigned(p) do
begin
if equal_paras(p^.def.para,propertyparas,cp_value_equal_const) or
convertable_paras(p^.def.para,propertyparas,cp_value_equal_const) then
begin
get_procdef:=p^.def;
exit;
end;
p:=p^.next;
end;
end;}
var
hp2,datacoll : tparaitem;
p : tpropertysym;
overriden : tsym;
hs : string;
@ -238,6 +215,9 @@ implementation
dummyst : tparasymtable;
vs : tvarsym;
sc : tsinglelist;
oldregisterdef : boolean;
temppara : tparaitem;
propertyprocdef : tprocvardef;
begin
{ check for a class }
aktprocsym:=nil;
@ -246,8 +226,10 @@ implementation
((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
Message(parser_e_syntax_error);
consume(_PROPERTY);
propertyparas:=TParaLinkedList.Create;
datacoll:=nil;
oldregisterdef:=registerdef;
registerdef:=false;
propertyprocdef:=tprocvardef.create;
registerdef:=oldregisterdef;
if token=_ID then
begin
p:=tpropertysym.create(orgpattern);
@ -259,8 +241,7 @@ implementation
if (sp_published in current_object_option) then
Message(parser_e_cant_publish_that_property);
{ create a list of the parameters in propertyparas }
{ create a list of the parameters }
dummyst:=tparasymtable.create;
dummyst.next:=symtablestack;
symtablestack:=dummyst;
@ -313,10 +294,7 @@ implementation
vs:=tvarsym(sc.first);
while assigned(vs) do
begin
hp2:=TParaItem.create;
hp2.paratyp:=varspez;
hp2.paratype:=tt;
propertyparas.insert(hp2);
propertyprocdef.concatpara(nil,tt,nil,varspez,nil);
vs:=tvarsym(vs.listnext);
end;
until not try_to_consume(_SEMICOLON);
@ -330,12 +308,12 @@ implementation
{ the parser need to know if a property has parameters, the
index parameter doesn't count (PFV) }
if not(propertyparas.empty) then
if propertyprocdef.minparacount>0 then
include(p.propoptions,ppo_hasparameters);
end;
{ overriden property ? }
{ force property interface, if there is a property parameter }
if (token=_COLON) or not(propertyparas.empty) then
if (token=_COLON) or (propertyprocdef.minparacount>0) then
begin
consume(_COLON);
single_type(p.proptype,hs,false);
@ -355,10 +333,7 @@ implementation
p.indextype.setdef(pt.resulttype.def);
include(p.propoptions,ppo_indexed);
{ concat a longint to the para template }
hp2:=TParaItem.Create;
hp2.paratyp:=vs_value;
hp2.paratype:=p.indextype;
propertyparas.insert(hp2);
propertyprocdef.concatpara(nil,p.indextype,nil,vs_value,nil);
pt.free;
end;
end
@ -380,11 +355,6 @@ implementation
not(p.proptype.def.is_publishable) then
Message(parser_e_cant_publish_that_property);
{ create data defcoll to allow correct parameter checks }
datacoll:=TParaItem.Create;
datacoll.paratyp:=vs_value;
datacoll.paratype:=p.proptype;
if try_to_consume(_READ) then
begin
p.readaccess.clear;
@ -394,7 +364,7 @@ implementation
case sym.typ of
procsym :
begin
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
pd:=Tprocsym(sym).search_procdef_bypara(propertyprocdef.para,true,false);
if not(assigned(pd)) or
not(equal_defs(pd.rettype.def,p.proptype.def)) then
Message(parser_e_ill_property_access_sym);
@ -430,10 +400,10 @@ implementation
procsym :
begin
{ insert data entry to check access method }
propertyparas.insert(datacoll);
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
temppara:=propertyprocdef.concatpara(nil,p.proptype,nil,vs_value,nil);
pd:=Tprocsym(sym).search_procdef_bypara(propertyprocdef.para,true,false);
{ ... and remove it }
propertyparas.remove(datacoll);
propertyprocdef.removepara(temppara);
if not(assigned(pd)) then
Message(parser_e_ill_property_access_sym);
p.writeaccess.setdef(pd);
@ -551,21 +521,18 @@ implementation
}
begin
include(p.propoptions,ppo_defaultproperty);
if propertyparas.empty then
if propertyprocdef.maxparacount=0 then
message(parser_e_property_need_paras);
end;
consume(_SEMICOLON);
end;
{ clean up }
if assigned(datacoll) then
datacoll.free;
end
else
begin
consume(_ID);
consume(_SEMICOLON);
end;
propertyparas.free;
propertyprocdef.free;
end;
@ -1172,7 +1139,10 @@ implementation
end.
{
$Log$
Revision 1.58 2003-01-09 21:52:37 peter
Revision 1.59 2003-04-10 17:57:52 peter
* vs_hidden released
Revision 1.58 2003/01/09 21:52:37 peter
* merged some verbosity options.
* V_LineInfo is a verbosity flag to include line info

346
compiler/pdecsub.pas
View File

@ -41,6 +41,7 @@ interface
function is_proc_directive(tok:ttoken):boolean;
procedure insert_hidden_para(pd:tabstractprocdef);
procedure check_self_para(aktprocdef:tabstractprocdef);
procedure parameter_dec(aktprocdef:tabstractprocdef);
@ -87,6 +88,48 @@ implementation
;
procedure insert_hidden_para(pd:tabstractprocdef);
var
currpara : tparaitem;
hvs : tvarsym;
begin
{ walk from right to left, so we can insert the
high parameters after the current parameter }
currpara:=tparaitem(pd.para.last);
while assigned(currpara) do
begin
{ need high parameter ? }
if paramanager.push_high_param(currpara.paratype.def,pd.proccalloption) then
begin
if assigned(currpara.parasym) then
begin
hvs:=tvarsym.create('$high'+tvarsym(currpara.parasym).name,s32bittype);
hvs.varspez:=vs_const;
include(hvs.varoptions,vo_is_high_value);
tvarsym(currpara.parasym).owner.insert(hvs);
tvarsym(currpara.parasym).highvarsym:=hvs;
end
else
hvs:=nil;
pd.concatpara(currpara,s32bittype,hvs,vs_hidden,nil);
end
else
begin
{ Give a warning that cdecl routines does not include high()
support }
if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
paramanager.push_high_param(currpara.paratype.def,pocall_fpccall) then
begin
if is_open_string(currpara.paratype.def) then
Message(parser_w_cdecl_no_openstring);
Message(parser_w_cdecl_has_no_high);
end;
end;
currpara:=tparaitem(currpara.previous);
end;
end;
procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
begin
if tsym(p).typ<>varsym then
@ -106,7 +149,7 @@ implementation
end;
procedure checkparatype(p:tnamedindexitem;arg:pointer);
procedure check_c_para(p:tnamedindexitem;arg:pointer);
begin
if (tsym(p).typ<>varsym) then
exit;
@ -121,35 +164,12 @@ implementation
if (varspez<>vs_var) then
Message(parser_h_c_arrays_are_references);
end;
if is_array_of_const(vartype.def) or
is_open_array(vartype.def) then
begin
if assigned(highvarsym) then
begin
Message(parser_w_cdecl_has_no_high);
{ removing it is too complicated, we just hide it PM }
owner.rename(highvarsym.name,'hidden'+copy(highvarsym.name,5,length(highvarsym.name)));
end;
end;
if is_array_of_const(vartype.def) and
assigned(indexnext) and
(tsym(indexnext).typ=varsym) and
not(vo_is_high_value in tvarsym(indexnext).varoptions) then
Message(parser_e_C_array_of_const_must_be_last);
end;
stringdef :
begin
if is_open_string(vartype.def) then
begin
Message(parser_w_cdecl_no_openstring);
if assigned(highvarsym) then
begin
Message(parser_w_cdecl_has_no_high);
{ removing it is too complicated, we just hide it PM }
owner.rename(highvarsym.name,'hidden'+copy(highvarsym.name,5,high(name)));
end;
end;
end;
end;
end;
end;
@ -190,13 +210,11 @@ implementation
sc : tsinglelist;
tt : ttype;
arrayelementtype : ttype;
hvs,
vs : tvarsym;
srsym : tsym;
hs1 : string;
varspez : Tvarspez;
hpara : tparaitem;
inserthigh : boolean;
tdefaultvalue : tconstsym;
defaultrequired : boolean;
old_object_option : tsymoptions;
@ -242,151 +260,122 @@ implementation
end
else
varspez:=vs_value;
inserthigh:=false;
tdefaultvalue:=nil;
tt.reset;
begin
{ read identifiers and insert with error type }
sc.reset;
repeat
vs:=tvarsym.create(orgpattern,generrortype);
currparast.insert(vs);
if assigned(vs.owner) then
sc.insert(vs)
else
vs.free;
consume(_ID);
until not try_to_consume(_COMMA);
{ read type declaration, force reading for value and const paras }
if (token=_COLON) or (varspez=vs_value) then
begin
consume(_COLON);
{ check for an open array }
if token=_ARRAY then
begin
consume(_ARRAY);
consume(_OF);
{ define range and type of range }
tt.setdef(tarraydef.create(0,-1,s32bittype));
{ array of const ? }
if (token=_CONST) and (m_objpas in aktmodeswitches) then
begin
consume(_CONST);
srsym:=searchsymonlyin(systemunit,'TVARREC');
if not assigned(srsym) then
InternalError(1234124);
tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
tarraydef(tt.def).IsArrayOfConst:=true;
end
else
begin
{ define field type }
single_type(arrayelementtype,hs1,false);
tarraydef(tt.def).setelementtype(arrayelementtype);
end;
inserthigh:=true;
end
else
begin
{ open string ? }
if (varspez=vs_var) and
(
(
((token=_STRING) or (idtoken=_SHORTSTRING)) and
(cs_openstring in aktmoduleswitches) and
not(cs_ansistrings in aktlocalswitches)
) or
(idtoken=_OPENSTRING)) then
begin
consume(token);
tt:=openshortstringtype;
hs1:='openstring';
inserthigh:=true;
end
else
begin
{ everything else }
single_type(tt,hs1,false);
end;
{ read identifiers and insert with error type }
sc.reset;
repeat
vs:=tvarsym.create(orgpattern,generrortype);
currparast.insert(vs);
if assigned(vs.owner) then
sc.insert(vs)
else
vs.free;
consume(_ID);
until not try_to_consume(_COMMA);
{ read type declaration, force reading for value and const paras }
if (token=_COLON) or (varspez=vs_value) then
begin
consume(_COLON);
{ check for an open array }
if token=_ARRAY then
begin
consume(_ARRAY);
consume(_OF);
{ define range and type of range }
tt.setdef(tarraydef.create(0,-1,s32bittype));
{ array of const ? }
if (token=_CONST) and (m_objpas in aktmodeswitches) then
begin
consume(_CONST);
srsym:=searchsymonlyin(systemunit,'TVARREC');
if not assigned(srsym) then
InternalError(1234124);
tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
tarraydef(tt.def).IsArrayOfConst:=true;
end
else
begin
{ define field type }
single_type(arrayelementtype,hs1,false);
tarraydef(tt.def).setelementtype(arrayelementtype);
end;
end
else
begin
{ open string ? }
if (varspez=vs_var) and
(
(
((token=_STRING) or (idtoken=_SHORTSTRING)) and
(cs_openstring in aktmoduleswitches) and
not(cs_ansistrings in aktlocalswitches)
) or
(idtoken=_OPENSTRING)) then
begin
consume(token);
tt:=openshortstringtype;
hs1:='openstring';
end
else
begin
{ everything else }
single_type(tt,hs1,false);
end;
{ default parameter }
if (m_default_para in aktmodeswitches) then
begin
if try_to_consume(_EQUAL) then
begin
vs:=tvarsym(sc.first);
if assigned(vs.listnext) then
Message(parser_e_default_value_only_one_para);
{ prefix 'def' to the parameter name }
tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
if assigned(tdefaultvalue) then
tprocdef(aktprocdef).parast.insert(tdefaultvalue);
defaultrequired:=true;
end
else
begin
if defaultrequired then
Message1(parser_e_default_value_expected_for_para,vs.name);
end;
end;
end;
end
else
begin
{ default parameter }
if (m_default_para in aktmodeswitches) then
begin
if try_to_consume(_EQUAL) then
begin
vs:=tvarsym(sc.first);
if assigned(vs.listnext) then
Message(parser_e_default_value_only_one_para);
{ prefix 'def' to the parameter name }
tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
if assigned(tdefaultvalue) then
tprocdef(aktprocdef).parast.insert(tdefaultvalue);
defaultrequired:=true;
end
else
begin
if defaultrequired then
Message1(parser_e_default_value_expected_for_para,vs.name);
end;
end;
end;
end
else
begin
{$ifndef UseNiceNames}
hs1:='$$$';
hs1:='$$$';
{$else UseNiceNames}
hs1:='var';
hs1:='var';
{$endif UseNiceNames}
tt:=cformaltype;
end;
tt:=cformaltype;
end;
{ For proc vars we only need the definitions }
if not is_procvar then
begin
vs:=tvarsym(sc.first);
while assigned(vs) do
begin
{ update varsym }
vs.vartype:=tt;
vs.varspez:=varspez;
if (varspez in [vs_var,vs_const,vs_out]) and
paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
include(vs.varoptions,vo_regable);
{ also need to push a high value? }
if inserthigh then
begin
hvs:=tvarsym.create('$high'+vs.name,s32bittype);
hvs.varspez:=vs_const;
include(hvs.varoptions,vo_is_high_value);
{$ifdef vs_hidden}
aktprocdef.concatpara(s32bittype,hvs,vs_hidden,nil);
{$endif vs_hidden}
currparast.insert(hvs);
vs.highvarsym:=hvs;
end;
hpara:=aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue);
if vs.name='SELF' then
aktprocdef.selfpara:=hpara;
vs:=tvarsym(vs.listnext);
end;
end
else
begin
vs:=tvarsym(sc.first);
while assigned(vs) do
begin
{ don't insert a parasym, the varsyms will be
disposed }
hpara:=aktprocdef.concatpara(tt,nil,varspez,tdefaultvalue);
if vs.name='SELF' then
aktprocdef.selfpara:=hpara;
vs:=tvarsym(vs.listnext);
end;
end;
end;
{ set the new mangled name }
vs:=tvarsym(sc.first);
while assigned(vs) do
begin
{ update varsym }
vs.vartype:=tt;
vs.varspez:=varspez;
{ For proc vars we only need the definitions }
if not is_procvar then
begin
if (varspez in [vs_var,vs_const,vs_out]) and
paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
include(vs.varoptions,vo_regable);
hpara:=aktprocdef.concatpara(nil,tt,vs,varspez,tdefaultvalue);
end
else
hpara:=aktprocdef.concatpara(nil,tt,nil,varspez,tdefaultvalue);
{ save position of self parameter }
if vs.name='SELF' then
aktprocdef.selfpara:=hpara;
vs:=tvarsym(vs.listnext);
end;
until not try_to_consume(_SEMICOLON);
{ remove parasymtable from stack }
if is_procvar then
@ -1594,9 +1583,6 @@ const
{ set the default calling convention }
if def.proccalloption=pocall_none then
def.proccalloption:=aktdefproccall;
{ generate symbol names for local copies }
if (def.deftype=procdef) then
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
{ handle proccall specific settings }
case def.proccalloption of
pocall_cdecl :
@ -1617,7 +1603,7 @@ const
if not assigned(tprocdef(def).parast) then
internalerror(200110234);
{ check C cdecl para types }
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil);
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
{ Adjust alignment to match cdecl or stdcall }
tprocdef(def).parast.dataalignment:=std_param_align;
end;
@ -1637,7 +1623,7 @@ const
if not assigned(tprocdef(def).parast) then
internalerror(200110235);
{ check C cdecl para types }
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil);
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
{ Adjust alignment to match cdecl or stdcall }
tprocdef(def).parast.dataalignment:=std_param_align;
end;
@ -1709,6 +1695,14 @@ const
end;
end;
{ insert hidden high parameters }
insert_hidden_para(def);
{ insert local valXXX value parameters }
if (def.deftype=procdef) then
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
{ add mangledname to external list }
if (def.deftype=procdef) and
(po_external in def.procoptions) and
@ -1733,13 +1727,8 @@ const
ps:=tsym(st.symindex.first);
while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
ps:=tsym(ps.indexnext);
if (ps.typ=varsym) and
not(vo_is_high_value in tvarsym(ps).varoptions) then
begin
st.insertvardata(ps);
if assigned(tvarsym(ps).highvarsym) then
st.insertvardata(tvarsym(ps).highvarsym);
end;
if (ps.typ=varsym) then
st.insertvardata(ps);
lastps:=ps;
end;
end
@ -2143,7 +2132,10 @@ const
end.
{
$Log$
Revision 1.110 2003-03-28 19:16:56 peter
Revision 1.111 2003-04-10 17:57:53 peter
* vs_hidden released
Revision 1.110 2003/03/28 19:16:56 peter
* generic constructor working for i386
* remove fixed self register
* esi added as address register for i386

7
compiler/ppu.pas
View File

@ -41,7 +41,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=31;
CurrentPPUVersion=32;
{ buffer sizes }
maxentrysize = 1024;
@ -985,7 +985,10 @@ end;
end.
{
$Log$
Revision 1.30 2003-03-17 15:54:22 peter
Revision 1.31 2003-04-10 17:57:53 peter
* vs_hidden released
Revision 1.30 2003/03/17 15:54:22 peter
* store symoptions also for procdef
* check symoptions (private,public) when calculating possible
overload candidates

123
compiler/symdef.pas
View File

@ -98,22 +98,16 @@ interface
end;
tparaitem = class(TLinkedListItem)
paratype : ttype;
paratype : ttype; { required for procvar }
parasym : tsym;
defaultvalue : tsym; { tconstsym }
paratyp : tvarspez;
paratyp : tvarspez; { required for procvar }
paraloc : tparalocation;
{$ifdef EXTDEBUG}
eqval : tequaltype;
{$endif EXTDEBUG}
end;
{ this is only here to override the count method,
which can't be used }
tparalinkedlist = class(tlinkedlist)
function count:longint;
end;
tfiletyp = (ft_text,ft_typed,ft_untyped);
tfiledef = class(tstoreddef)
@ -419,7 +413,7 @@ interface
tabstractprocdef = class(tstoreddef)
{ saves a definition to the return type }
rettype : ttype;
para : tparalinkedlist;
para : tlinkedlist;
selfpara : tparaitem;
proctypeoption : tproctypeoption;
proccalloption : tproccalloption;
@ -433,7 +427,8 @@ interface
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure deref;override;
function concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
function concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
procedure removepara(currpara:tparaitem);
function para_size(alignsize:longint) : longint;
function typename_paras : string;
procedure test_if_fpu_result;
@ -1190,19 +1185,6 @@ implementation
{****************************************************************************
TPARALINKEDLIST
****************************************************************************}
function tparalinkedlist.count:longint;
begin
{ You must use tabstractprocdef.minparacount and .maxparacount instead }
internalerror(432432978);
count:=0;
end;
{****************************************************************************
Tstringdef
****************************************************************************}
@ -3073,7 +3055,7 @@ implementation
constructor tabstractprocdef.create;
begin
inherited create;
para:=TParaLinkedList.Create;
para:=TLinkedList.Create;
selfpara:=nil;
minparacount:=0;
maxparacount:=0;
@ -3094,7 +3076,7 @@ implementation
end;
function tabstractprocdef.concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
function tabstractprocdef.concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
var
hp : TParaItem;
begin
@ -3103,7 +3085,11 @@ implementation
hp.parasym:=sym;
hp.paratype:=tt;
hp.defaultvalue:=defval;
Para.insert(hp);
{ Parameters are stored from left to right }
if assigned(afterpara) then
Para.insertafter(hp,afterpara)
else
Para.concat(hp);
{ Don't count hidden parameters }
if (vsp<>vs_hidden) then
begin
@ -3115,6 +3101,18 @@ implementation
end;
procedure tabstractprocdef.removepara(currpara:tparaitem);
begin
{ Don't count hidden parameters }
if (currpara.paratyp<>vs_hidden) then
begin
if not assigned(currpara.defaultvalue) then
dec(minparacount);
dec(maxparacount);
end;
Para.Remove(currpara);
currpara.free;
end;
{ all functions returning in FPU are
@ -3152,7 +3150,7 @@ implementation
count,i : word;
begin
inherited ppuloaddef(ppufile);
Para:=TParaLinkedList.Create;
Para:=TLinkedList.Create;
selfpara:=nil;
minparacount:=0;
maxparacount:=0;
@ -3168,7 +3166,6 @@ implementation
begin
hp:=TParaItem.Create;
hp.paratyp:=tvarspez(ppufile.getbyte);
{ hp.register:=tregister(ppufile.getbyte); }
ppufile.gettype(hp.paratype);
hp.defaultvalue:=tsym(ppufile.getderef);
hp.parasym:=tsym(ppufile.getderef);
@ -3181,6 +3178,7 @@ implementation
inc(minparacount);
inc(maxparacount);
end;
{ Parameters are stored left to right in both ppu and memory }
Para.concat(hp);
end;
end;
@ -3202,12 +3200,12 @@ implementation
ppufile.putbyte(ord(proccalloption));
ppufile.putsmallset(procoptions);
ppufile.do_interface_crc:=oldintfcrc;
ppufile.putbyte(maxparacount);
{ we need to store the count including vs_hidden }
ppufile.putbyte(para.count);
hp:=TParaItem(Para.first);
while assigned(hp) do
begin
ppufile.putbyte(byte(hp.paratyp));
{ ppufile.putbyte(byte(hp.register)); }
ppufile.puttype(hp.paratype);
ppufile.putderef(hp.defaultvalue);
ppufile.putderef(hp.parasym);
@ -3247,31 +3245,18 @@ implementation
hp : TParaItem;
hpc : tconstsym;
begin
{ look for a visible parameter }
hp:=TParaItem(Para.last);
while assigned(hp) do
begin
if hp.paratyp<>vs_hidden then
break;
hp:=TParaItem(hp.previous);
end;
{ no visible parameter? }
if not(assigned(hp)) then
begin
typename_paras:='';
exit;
end;
hp:=TParaItem(Para.last);
hp:=TParaItem(Para.first);
s:='(';
while assigned(hp) do
begin
if hp.paratyp=vs_var then
s:=s+'var'
else if hp.paratyp=vs_const then
s:=s+'const'
else if hp.paratyp=vs_out then
s:=s+'out';
case hp.paratyp of
vs_var :
s:=s+'var';
vs_const :
s:=s+'const';
vs_out :
s:=s+'out';
end;
if hp.paratyp<>vs_hidden then
begin
if assigned(hp.paratype.def.typesym) then
@ -3316,15 +3301,18 @@ implementation
if hs<>'' then
s:=s+'="'+hs+'"';
end;
if assigned(hp.next) then
s:=s+',';
end;
hp:=TParaItem(hp.previous);
if assigned(hp) and (hp.paratyp<>vs_hidden) then
s:=s+',';
hp:=TParaItem(hp.next);
end;
s:=s+')';
if (po_varargs in procoptions) then
s:=s+';VarArgs';
typename_paras:=s;
if s='()' then
typename_paras:=''
else
typename_paras:=s;
end;
@ -3992,16 +3980,12 @@ implementation
if overloadnumber>0 then
s:=s+'$'+tostr(overloadnumber);
{ add parameter types }
hp:=TParaItem(Para.last);
if assigned(hp) and (hp.paratyp<>vs_hidden) then
s:=s+'$';
hp:=TParaItem(Para.first);
while assigned(hp) do
begin
if hp.paratyp<>vs_hidden then
s:=s+hp.paratype.def.mangledparaname;
hp:=TParaItem(hp.previous);
if assigned(hp) and (hp.paratyp<>vs_hidden) then
s:=s+'$';
s:=s+'$'+hp.paratype.def.mangledparaname;
hp:=TParaItem(hp.next);
end;
_mangledname:=stringdup(s);
mangledname:=_mangledname^;
@ -4213,9 +4197,9 @@ implementation
{ write parameter info. The parameters must be written in reverse order
if this method uses right to left parameter pushing! }
if (po_leftright in procoptions) then
pdc:=TParaItem(Para.last)
pdc:=TParaItem(Para.first)
else
pdc:=TParaItem(Para.first);
pdc:=TParaItem(Para.last);
while assigned(pdc) do
begin
case pdc.paratyp of
@ -4233,9 +4217,9 @@ implementation
tstoreddef(pdc.paratype.def).write_rtti_name;
if (po_leftright in procoptions) then
pdc:=TParaItem(pdc.previous)
pdc:=TParaItem(pdc.next)
else
pdc:=TParaItem(pdc.next);
pdc:=TParaItem(pdc.previous);
end;
{ write name of result type }
@ -5725,7 +5709,10 @@ implementation
end.
{
$Log$
Revision 1.132 2003-03-18 16:25:50 peter
Revision 1.133 2003-04-10 17:57:53 peter
* vs_hidden released
Revision 1.132 2003/03/18 16:25:50 peter
* no itnernalerror for errordef.concatstabto()
Revision 1.131 2003/03/17 16:54:41 peter

9
compiler/symsym.pas
View File

@ -137,7 +137,7 @@ interface
function last_procdef:Tprocdef;
function search_procdef_nopara_boolret:Tprocdef;
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function search_procdef_bypara(params:Tparalinkedlist;
function search_procdef_bypara(params:Tlinkedlist;
allowconvert,
allowdefault:boolean):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
@ -1025,7 +1025,7 @@ implementation
end;
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
function Tprocsym.search_procdef_bypara(params:Tlinkedlist;
allowconvert,
allowdefault:boolean):Tprocdef;
var
@ -2563,7 +2563,10 @@ implementation
end.
{
$Log$
Revision 1.94 2003-03-17 15:54:22 peter
Revision 1.95 2003-04-10 17:57:53 peter
* vs_hidden released
Revision 1.94 2003/03/17 15:54:22 peter
* store symoptions also for procdef
* check symoptions (private,public) when calculating possible
overload candidates

46
compiler/utils/ppudump.pp
View File

@ -160,6 +160,17 @@ begin
end;
Function Varspez2Str(w:longint):string;
const
varspezstr : array[0..4] of string[6]=('Value','Const','Var','Out','Hidden');
begin
if w<=ord(high(varspezstr)) then
Varspez2Str:=varspezstr[w]
else
Varspez2Str:='<Unknown>';
end;
function PPUFlags2Str(flags:longint):string;
type
tflagopt=record
@ -714,7 +725,6 @@ const
(mask:po_clearstack; str:'ClearStack'),
(mask:po_internconst; str:'InternConst')
);
tvarspez : array[0..3] of string[5]=('Value','Const','Var ','Out ');
var
proctypeoption : tproctypeoption;
proccalloption : tproccalloption;
@ -731,7 +741,7 @@ begin
begin
write(space,' TypeOption : ');
first:=true;
for i:=1to proctypeopts do
for i:=1 to proctypeopts do
if (proctypeopt[i].mask=proctypeoption) then
begin
if first then
@ -763,20 +773,19 @@ begin
end;
params:=ppufile.getbyte;
writeln(space,' Nr of parameters : ',params);
if params>0 then
for i:=1 to params do
begin
repeat
write(space,' - ',tvarspez[ppufile.getbyte],' : ');
readtype;
write(space,' Default : ');
readsymref;
write(space,' Symbol : ');
readsymref;
write(space,' Location : ');
writeln('<not yet implemented>');
ppufile.getdata(paraloc,sizeof(paraloc));
dec(params);
until params=0;
writeln(space,' - Parameter ',i);
writeln(space,' Spez : ',Varspez2Str(ppufile.getbyte));
write (space,' Type : ');
readtype;
write (space,' Default : ');
readsymref;
write (space,' Symbol : ');
readsymref;
write (space,' Location : ');
writeln('<not yet implemented>');
ppufile.getdata(paraloc,sizeof(paraloc));
end;
end;
@ -993,7 +1002,7 @@ begin
ibvarsym :
begin
readcommonsym('Variable symbol ');
writeln(space,' Type: ',getbyte);
writeln(space,' Spez: ',Varspez2Str(getbyte));
writeln(space,' Address: ',getlongint);
write (space,' Var Type: ');
readtype;
@ -1929,7 +1938,10 @@ begin
end.
{
$Log$
Revision 1.37 2003-03-24 19:57:54 hajny
Revision 1.38 2003-04-10 17:57:53 peter
* vs_hidden released
Revision 1.37 2003/03/24 19:57:54 hajny
+ emx target added
Revision 1.36 2003/03/17 15:54:22 peter