mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-26 13:31:27 +01:00
* vs_hidden released
This commit is contained in:
peter
parent
635280c5d2
commit
8da3f59d32
@ -1057,8 +1057,8 @@ implementation
|
|||||||
{ we need to parse the list from left-right so the
|
{ we need to parse the list from left-right so the
|
||||||
not-default parameters are checked first }
|
not-default parameters are checked first }
|
||||||
lowesteq:=high(tequaltype);
|
lowesteq:=high(tequaltype);
|
||||||
def1:=TParaItem(paralist1.last);
|
def1:=TParaItem(paralist1.first);
|
||||||
def2:=TParaItem(paralist2.last);
|
def2:=TParaItem(paralist2.first);
|
||||||
while (assigned(def1)) and (assigned(def2)) do
|
while (assigned(def1)) and (assigned(def2)) do
|
||||||
begin
|
begin
|
||||||
eq:=te_incompatible;
|
eq:=te_incompatible;
|
||||||
@ -1116,8 +1116,8 @@ implementation
|
|||||||
if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
|
if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
def1:=TParaItem(def1.previous);
|
def1:=TParaItem(def1.next);
|
||||||
def2:=TParaItem(def2.previous);
|
def2:=TParaItem(def2.next);
|
||||||
end;
|
end;
|
||||||
{ when both lists are empty then the parameters are equal. Also
|
{ when both lists are empty then the parameters are equal. Also
|
||||||
when one list is empty and the other has a parameter with default
|
when one list is empty and the other has a parameter with default
|
||||||
@ -1182,7 +1182,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* fix compare for unique types, they are allowed when they match
|
||||||
exact
|
exact
|
||||||
|
|
||||||
|
|||||||
@ -65,6 +65,7 @@ interface
|
|||||||
{$ifdef EXTDEBUG}
|
{$ifdef EXTDEBUG}
|
||||||
procedure candidates_dump_info(lvl:longint;procs:pcandidate);
|
procedure candidates_dump_info(lvl:longint;procs:pcandidate);
|
||||||
{$endif EXTDEBUG}
|
{$endif EXTDEBUG}
|
||||||
|
procedure bind_paraitem;
|
||||||
public
|
public
|
||||||
{ the symbol containing the definition of the procedure }
|
{ the symbol containing the definition of the procedure }
|
||||||
{ to call }
|
{ to call }
|
||||||
@ -127,9 +128,6 @@ interface
|
|||||||
tcallparanode = class(tbinarynode)
|
tcallparanode = class(tbinarynode)
|
||||||
callparaflags : set of tcallparaflags;
|
callparaflags : set of tcallparaflags;
|
||||||
paraitem : tparaitem;
|
paraitem : tparaitem;
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
hightree : tnode;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
{ only the processor specific nodes need to override this }
|
{ only the processor specific nodes need to override this }
|
||||||
{ constructor }
|
{ constructor }
|
||||||
constructor create(expr,next : tnode);virtual;
|
constructor create(expr,next : tnode);virtual;
|
||||||
@ -139,9 +137,8 @@ interface
|
|||||||
procedure derefimpl;override;
|
procedure derefimpl;override;
|
||||||
function getcopy : tnode;override;
|
function getcopy : tnode;override;
|
||||||
procedure insertintolist(l : tnodelist);override;
|
procedure insertintolist(l : tnodelist);override;
|
||||||
procedure gen_high_tree(openstring:boolean);
|
|
||||||
procedure get_paratype;
|
procedure get_paratype;
|
||||||
procedure insert_typeconv(defcoll : tparaitem;do_count : boolean);
|
procedure insert_typeconv(do_count : boolean);
|
||||||
procedure det_registers;
|
procedure det_registers;
|
||||||
procedure firstcallparan(do_count : boolean);
|
procedure firstcallparan(do_count : boolean);
|
||||||
procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
|
procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
|
||||||
@ -215,6 +212,71 @@ type
|
|||||||
end;
|
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);
|
procedure search_class_overloads(aprocsym : tprocsym);
|
||||||
{ searches n in symtable of pd and all anchestors }
|
{ searches n in symtable of pd and all anchestors }
|
||||||
var
|
var
|
||||||
@ -463,9 +525,6 @@ type
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
inherited create(callparan,expr,next);
|
inherited create(callparan,expr,next);
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
hightree:=nil;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
if assigned(expr) then
|
if assigned(expr) then
|
||||||
expr.set_file_line(self);
|
expr.set_file_line(self);
|
||||||
callparaflags:=[];
|
callparaflags:=[];
|
||||||
@ -474,9 +533,6 @@ type
|
|||||||
destructor tcallparanode.destroy;
|
destructor tcallparanode.destroy;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
hightree.free;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
inherited destroy;
|
inherited destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -485,9 +541,6 @@ type
|
|||||||
begin
|
begin
|
||||||
inherited ppuload(t,ppufile);
|
inherited ppuload(t,ppufile);
|
||||||
ppufile.getsmallset(callparaflags);
|
ppufile.getsmallset(callparaflags);
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
hightree:=ppuloadnode(ppufile);
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -495,19 +548,12 @@ type
|
|||||||
begin
|
begin
|
||||||
inherited ppuwrite(ppufile);
|
inherited ppuwrite(ppufile);
|
||||||
ppufile.putsmallset(callparaflags);
|
ppufile.putsmallset(callparaflags);
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
ppuwritenode(ppufile,hightree);
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tcallparanode.derefimpl;
|
procedure tcallparanode.derefimpl;
|
||||||
begin
|
begin
|
||||||
inherited derefimpl;
|
inherited derefimpl;
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
if assigned(hightree) then
|
|
||||||
hightree.derefimpl;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -519,12 +565,6 @@ type
|
|||||||
begin
|
begin
|
||||||
n:=tcallparanode(inherited getcopy);
|
n:=tcallparanode(inherited getcopy);
|
||||||
n.callparaflags:=callparaflags;
|
n.callparaflags:=callparaflags;
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
if assigned(hightree) then
|
|
||||||
n.hightree:=hightree.getcopy
|
|
||||||
else
|
|
||||||
n.hightree:=nil;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
n.paraitem:=paraitem;
|
n.paraitem:=paraitem;
|
||||||
result:=n;
|
result:=n;
|
||||||
end;
|
end;
|
||||||
@ -558,7 +598,7 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
|
procedure tcallparanode.insert_typeconv(do_count : boolean);
|
||||||
var
|
var
|
||||||
oldtype : ttype;
|
oldtype : ttype;
|
||||||
{$ifdef extdebug}
|
{$ifdef extdebug}
|
||||||
@ -567,8 +607,6 @@ type
|
|||||||
begin
|
begin
|
||||||
inc(parsing_para_level);
|
inc(parsing_para_level);
|
||||||
|
|
||||||
paraitem:=defcoll;
|
|
||||||
|
|
||||||
if not assigned(paraitem) then
|
if not assigned(paraitem) then
|
||||||
internalerror(200104261);
|
internalerror(200104261);
|
||||||
|
|
||||||
@ -635,10 +673,6 @@ type
|
|||||||
if left.resulttype.def.deftype=procvardef then
|
if left.resulttype.def.deftype=procvardef then
|
||||||
test_local_to_procvar(tprocvardef(left.resulttype.def),paraitem.paratype.def);
|
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 }
|
{ test conversions }
|
||||||
if not(is_shortstring(left.resulttype.def) and
|
if not(is_shortstring(left.resulttype.def) and
|
||||||
is_shortstring(paraitem.paratype.def)) and
|
is_shortstring(paraitem.paratype.def)) and
|
||||||
@ -743,15 +777,9 @@ type
|
|||||||
resulttype:=paraitem.paratype;
|
resulttype:=paraitem.paratype;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ process next node }
|
||||||
if assigned(right) then
|
if assigned(right) then
|
||||||
begin
|
tcallparanode(right).insert_typeconv(do_count);
|
||||||
{ 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;
|
|
||||||
|
|
||||||
dec(parsing_para_level);
|
dec(parsing_para_level);
|
||||||
{$ifdef extdebug}
|
{$ifdef extdebug}
|
||||||
@ -809,149 +837,16 @@ type
|
|||||||
det_registers;
|
det_registers;
|
||||||
end;
|
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;
|
function tcallparanode.docompare(p: tnode): boolean;
|
||||||
begin
|
begin
|
||||||
docompare :=
|
docompare :=
|
||||||
inherited docompare(p) and
|
inherited docompare(p) and
|
||||||
(callparaflags = tcallparanode(p).callparaflags)
|
(callparaflags = tcallparanode(p).callparaflags)
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
and hightree.isequal(tcallparanode(p).hightree)
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
TCALLNODE
|
TCALLNODE
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
@ -998,6 +893,7 @@ type
|
|||||||
self.create(params,tprocsym(srsym),symowner,nil);
|
self.create(params,tprocsym(srsym),symowner,nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
|
constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
|
||||||
begin
|
begin
|
||||||
self.createintern(name,params);
|
self.createintern(name,params);
|
||||||
@ -1224,13 +1120,13 @@ type
|
|||||||
hp^.data:=pd;
|
hp^.data:=pd;
|
||||||
hp^.next:=procs;
|
hp^.next:=procs;
|
||||||
procs:=hp;
|
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 }
|
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
|
if not(po_varargs in pd.procoptions) then
|
||||||
begin
|
begin
|
||||||
for i:=1 to pd.maxparacount-paralength do
|
for i:=1 to pd.maxparacount-paralength do
|
||||||
hp^.firstpara:=tparaitem(hp^.firstPara.next);
|
hp^.firstpara:=tparaitem(hp^.firstPara.previous);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1429,11 +1325,13 @@ type
|
|||||||
hp:=procs;
|
hp:=procs;
|
||||||
while assigned(hp) do
|
while assigned(hp) do
|
||||||
begin
|
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;
|
currparanr:=paralength;
|
||||||
currpara:=hp^.firstpara;
|
currpara:=hp^.firstpara;
|
||||||
while assigned(currpara) and (currpara.paratyp=vs_hidden) do
|
while assigned(currpara) and (currpara.paratyp=vs_hidden) do
|
||||||
currpara:=tparaitem(currpara.next);
|
currpara:=tparaitem(currpara.previous);
|
||||||
pt:=tcallparanode(left);
|
pt:=tcallparanode(left);
|
||||||
while assigned(pt) and assigned(currpara) do
|
while assigned(pt) and assigned(currpara) do
|
||||||
begin
|
begin
|
||||||
@ -1551,7 +1449,7 @@ type
|
|||||||
begin
|
begin
|
||||||
{ Ignore vs_hidden parameters }
|
{ Ignore vs_hidden parameters }
|
||||||
repeat
|
repeat
|
||||||
currpara:=tparaitem(currpara.next);
|
currpara:=tparaitem(currpara.previous);
|
||||||
until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
|
until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
|
||||||
end;
|
end;
|
||||||
dec(currparanr);
|
dec(currparanr);
|
||||||
@ -1653,6 +1551,64 @@ type
|
|||||||
end;
|
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;
|
function tcallnode.det_resulttype:tnode;
|
||||||
var
|
var
|
||||||
procs : pcandidate;
|
procs : pcandidate;
|
||||||
@ -1660,7 +1616,7 @@ type
|
|||||||
hpt : tnode;
|
hpt : tnode;
|
||||||
pt : tcallparanode;
|
pt : tcallparanode;
|
||||||
lastpara : longint;
|
lastpara : longint;
|
||||||
pdc : tparaitem;
|
currpara : tparaitem;
|
||||||
cand_cnt : integer;
|
cand_cnt : integer;
|
||||||
i : longint;
|
i : longint;
|
||||||
is_const : boolean;
|
is_const : boolean;
|
||||||
@ -1700,26 +1656,26 @@ type
|
|||||||
|
|
||||||
procdefinition:=tabstractprocdef(right.resulttype.def);
|
procdefinition:=tabstractprocdef(right.resulttype.def);
|
||||||
|
|
||||||
{ check the amount of parameters }
|
{ Compare parameters from right to left }
|
||||||
pdc:=tparaitem(procdefinition.Para.first);
|
currpara:=tparaitem(procdefinition.Para.last);
|
||||||
while assigned(pdc) and (pdc.paratyp=vs_hidden) do
|
while assigned(currpara) and (currpara.paratyp=vs_hidden) do
|
||||||
pdc:=tparaitem(pdc.next);
|
currpara:=tparaitem(currpara.previous);
|
||||||
pt:=tcallparanode(left);
|
pt:=tcallparanode(left);
|
||||||
lastpara:=paralength;
|
lastpara:=paralength;
|
||||||
while assigned(pdc) and assigned(pt) do
|
while assigned(currpara) and assigned(pt) do
|
||||||
begin
|
begin
|
||||||
{ only goto next para if we're out of the varargs }
|
{ only goto next para if we're out of the varargs }
|
||||||
if not(po_varargs in procdefinition.procoptions) or
|
if not(po_varargs in procdefinition.procoptions) or
|
||||||
(lastpara<=procdefinition.maxparacount) then
|
(lastpara<=procdefinition.maxparacount) then
|
||||||
begin
|
begin
|
||||||
repeat
|
repeat
|
||||||
pdc:=tparaitem(pdc.next);
|
currpara:=tparaitem(currpara.previous);
|
||||||
until (not assigned(pdc)) or (pdc.paratyp<>vs_hidden);
|
until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
|
||||||
end;
|
end;
|
||||||
pt:=tcallparanode(pt.right);
|
pt:=tcallparanode(pt.right);
|
||||||
dec(lastpara);
|
dec(lastpara);
|
||||||
end;
|
end;
|
||||||
if assigned(pt) or assigned(pdc) then
|
if assigned(pt) or assigned(currpara) then
|
||||||
begin
|
begin
|
||||||
if assigned(pt) then
|
if assigned(pt) then
|
||||||
aktfilepos:=pt.fileinfo;
|
aktfilepos:=pt.fileinfo;
|
||||||
@ -1850,15 +1806,15 @@ type
|
|||||||
if assigned(procdefinition) and
|
if assigned(procdefinition) and
|
||||||
(paralength<procdefinition.maxparacount) then
|
(paralength<procdefinition.maxparacount) then
|
||||||
begin
|
begin
|
||||||
pdc:=tparaitem(procdefinition.Para.last);
|
currpara:=tparaitem(procdefinition.Para.first);
|
||||||
for i:=1 to paralength do
|
for i:=1 to paralength do
|
||||||
pdc:=tparaitem(pdc.previous);
|
currpara:=tparaitem(currpara.next);
|
||||||
while assigned(pdc) do
|
while assigned(currpara) do
|
||||||
begin
|
begin
|
||||||
if not assigned(pdc.defaultvalue) then
|
if not assigned(currpara.defaultvalue) then
|
||||||
internalerror(200212142);
|
internalerror(200212142);
|
||||||
left:=ccallparanode.create(genconstsymtree(tconstsym(pdc.defaultvalue)),left);
|
left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
|
||||||
pdc:=tparaitem(pdc.previous);
|
currpara:=tparaitem(currpara.next);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1922,25 +1878,13 @@ type
|
|||||||
resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
|
resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ flag all callparanodes that belong to the varargs }
|
{ bind paraitems to the callparanodes and insert hidden parameters }
|
||||||
if (po_varargs in procdefinition.procoptions) then
|
aktcallprocdef:=procdefinition;
|
||||||
begin
|
bind_paraitem;
|
||||||
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;
|
|
||||||
|
|
||||||
{ insert type conversions }
|
{ insert type conversions for parameters }
|
||||||
if assigned(left) then
|
if assigned(left) then
|
||||||
begin
|
tcallparanode(left).insert_typeconv(true);
|
||||||
aktcallprocdef:=procdefinition;
|
|
||||||
tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ direct call to inherited abstract method, then we
|
{ direct call to inherited abstract method, then we
|
||||||
can already give a error in the compiler instead
|
can already give a error in the compiler instead
|
||||||
@ -2411,7 +2355,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* more vs_invisible fixes
|
||||||
|
|
||||||
Revision 1.133 2003/04/07 10:40:21 jonas
|
Revision 1.133 2003/04/07 10:40:21 jonas
|
||||||
|
|||||||
@ -95,31 +95,11 @@ implementation
|
|||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
|
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
|
var
|
||||||
otlabel,oflabel : tasmlabel;
|
otlabel,oflabel : tasmlabel;
|
||||||
{ temporary variables: }
|
|
||||||
tempdeftype : tdeftype;
|
tempdeftype : tdeftype;
|
||||||
tmpreg : tregister;
|
tmpreg : tregister;
|
||||||
href : treference;
|
href : treference;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{ set default para_alignment to target_info.stackalignment }
|
{ set default para_alignment to target_info.stackalignment }
|
||||||
if para_alignment=0 then
|
if para_alignment=0 then
|
||||||
@ -214,9 +194,6 @@ implementation
|
|||||||
(left.nodetype=selfn)) then
|
(left.nodetype=selfn)) then
|
||||||
internalerror(200106041);
|
internalerror(200106041);
|
||||||
end;
|
end;
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
maybe_push_high;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
if (paraitem.paratyp=vs_out) and
|
if (paraitem.paratyp=vs_out) and
|
||||||
assigned(paraitem.paratype.def) and
|
assigned(paraitem.paratype.def) and
|
||||||
not is_class(paraitem.paratype.def) and
|
not is_class(paraitem.paratype.def) and
|
||||||
@ -270,9 +247,6 @@ implementation
|
|||||||
internalerror(200204011);
|
internalerror(200204011);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$ifndef VS_HIDDEN}
|
|
||||||
maybe_push_high;
|
|
||||||
{$endif VS_HIDDEN}
|
|
||||||
inc(pushedparasize,POINTER_SIZE);
|
inc(pushedparasize,POINTER_SIZE);
|
||||||
if calloption=pocall_inline then
|
if calloption=pocall_inline then
|
||||||
begin
|
begin
|
||||||
@ -1448,7 +1422,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* changed newasmsymbol to newasmsymboldata for data symbols
|
||||||
|
|
||||||
Revision 1.42 2003/04/04 15:38:56 peter
|
Revision 1.42 2003/04/04 15:38:56 peter
|
||||||
|
|||||||
@ -425,13 +425,12 @@ implementation
|
|||||||
if not assigned(tloadnode(left).left) then
|
if not assigned(tloadnode(left).left) then
|
||||||
include(tprocvardef(resulttype.def).procoptions,po_addressonly);
|
include(tprocvardef(resulttype.def).procoptions,po_addressonly);
|
||||||
|
|
||||||
{ we need to process the parameters reverse so they are inserted
|
{ Add parameters in left to right order }
|
||||||
in the correct right2left order (PFV) }
|
hp2:=TParaItem(hp3.Para.first);
|
||||||
hp2:=TParaItem(hp3.Para.last);
|
|
||||||
while assigned(hp2) do
|
while assigned(hp2) do
|
||||||
begin
|
begin
|
||||||
tprocvardef(resulttype.def).concatpara(hp2.paratype,hp2.parasym,hp2.paratyp,hp2.defaultvalue);
|
tprocvardef(resulttype.def).concatpara(nil,hp2.paratype,hp2.parasym,hp2.paratyp,hp2.defaultvalue);
|
||||||
hp2:=TParaItem(hp2.previous);
|
hp2:=TParaItem(hp2.next);
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -1055,7 +1054,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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)
|
* self fixes for static methods (merged)
|
||||||
|
|
||||||
Revision 1.45 2003/01/09 21:52:37 peter
|
Revision 1.45 2003/01/09 21:52:37 peter
|
||||||
|
|||||||
@ -226,7 +226,6 @@ interface
|
|||||||
|
|
||||||
{ flags used by tcallparanode }
|
{ flags used by tcallparanode }
|
||||||
nf_varargs_para, { belongs this para to varargs }
|
nf_varargs_para, { belongs this para to varargs }
|
||||||
nf_hightree_generated, { has the hightree for thispara been generated }
|
|
||||||
|
|
||||||
{ taddrnode }
|
{ taddrnode }
|
||||||
nf_procvarload,
|
nf_procvarload,
|
||||||
@ -973,7 +972,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* generic constructor working for i386
|
||||||
* remove fixed self register
|
* remove fixed self register
|
||||||
* esi added as address register for i386
|
* esi added as address register for i386
|
||||||
|
|||||||
@ -201,29 +201,6 @@ implementation
|
|||||||
|
|
||||||
var
|
var
|
||||||
sym : tsym;
|
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;
|
p : tpropertysym;
|
||||||
overriden : tsym;
|
overriden : tsym;
|
||||||
hs : string;
|
hs : string;
|
||||||
@ -238,6 +215,9 @@ implementation
|
|||||||
dummyst : tparasymtable;
|
dummyst : tparasymtable;
|
||||||
vs : tvarsym;
|
vs : tvarsym;
|
||||||
sc : tsinglelist;
|
sc : tsinglelist;
|
||||||
|
oldregisterdef : boolean;
|
||||||
|
temppara : tparaitem;
|
||||||
|
propertyprocdef : tprocvardef;
|
||||||
begin
|
begin
|
||||||
{ check for a class }
|
{ check for a class }
|
||||||
aktprocsym:=nil;
|
aktprocsym:=nil;
|
||||||
@ -246,8 +226,10 @@ implementation
|
|||||||
((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
|
((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
|
||||||
Message(parser_e_syntax_error);
|
Message(parser_e_syntax_error);
|
||||||
consume(_PROPERTY);
|
consume(_PROPERTY);
|
||||||
propertyparas:=TParaLinkedList.Create;
|
oldregisterdef:=registerdef;
|
||||||
datacoll:=nil;
|
registerdef:=false;
|
||||||
|
propertyprocdef:=tprocvardef.create;
|
||||||
|
registerdef:=oldregisterdef;
|
||||||
if token=_ID then
|
if token=_ID then
|
||||||
begin
|
begin
|
||||||
p:=tpropertysym.create(orgpattern);
|
p:=tpropertysym.create(orgpattern);
|
||||||
@ -259,8 +241,7 @@ implementation
|
|||||||
if (sp_published in current_object_option) then
|
if (sp_published in current_object_option) then
|
||||||
Message(parser_e_cant_publish_that_property);
|
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:=tparasymtable.create;
|
||||||
dummyst.next:=symtablestack;
|
dummyst.next:=symtablestack;
|
||||||
symtablestack:=dummyst;
|
symtablestack:=dummyst;
|
||||||
@ -313,10 +294,7 @@ implementation
|
|||||||
vs:=tvarsym(sc.first);
|
vs:=tvarsym(sc.first);
|
||||||
while assigned(vs) do
|
while assigned(vs) do
|
||||||
begin
|
begin
|
||||||
hp2:=TParaItem.create;
|
propertyprocdef.concatpara(nil,tt,nil,varspez,nil);
|
||||||
hp2.paratyp:=varspez;
|
|
||||||
hp2.paratype:=tt;
|
|
||||||
propertyparas.insert(hp2);
|
|
||||||
vs:=tvarsym(vs.listnext);
|
vs:=tvarsym(vs.listnext);
|
||||||
end;
|
end;
|
||||||
until not try_to_consume(_SEMICOLON);
|
until not try_to_consume(_SEMICOLON);
|
||||||
@ -330,12 +308,12 @@ implementation
|
|||||||
|
|
||||||
{ the parser need to know if a property has parameters, the
|
{ the parser need to know if a property has parameters, the
|
||||||
index parameter doesn't count (PFV) }
|
index parameter doesn't count (PFV) }
|
||||||
if not(propertyparas.empty) then
|
if propertyprocdef.minparacount>0 then
|
||||||
include(p.propoptions,ppo_hasparameters);
|
include(p.propoptions,ppo_hasparameters);
|
||||||
end;
|
end;
|
||||||
{ overriden property ? }
|
{ overriden property ? }
|
||||||
{ force property interface, if there is a property parameter }
|
{ 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
|
begin
|
||||||
consume(_COLON);
|
consume(_COLON);
|
||||||
single_type(p.proptype,hs,false);
|
single_type(p.proptype,hs,false);
|
||||||
@ -355,10 +333,7 @@ implementation
|
|||||||
p.indextype.setdef(pt.resulttype.def);
|
p.indextype.setdef(pt.resulttype.def);
|
||||||
include(p.propoptions,ppo_indexed);
|
include(p.propoptions,ppo_indexed);
|
||||||
{ concat a longint to the para template }
|
{ concat a longint to the para template }
|
||||||
hp2:=TParaItem.Create;
|
propertyprocdef.concatpara(nil,p.indextype,nil,vs_value,nil);
|
||||||
hp2.paratyp:=vs_value;
|
|
||||||
hp2.paratype:=p.indextype;
|
|
||||||
propertyparas.insert(hp2);
|
|
||||||
pt.free;
|
pt.free;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
@ -380,11 +355,6 @@ implementation
|
|||||||
not(p.proptype.def.is_publishable) then
|
not(p.proptype.def.is_publishable) then
|
||||||
Message(parser_e_cant_publish_that_property);
|
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
|
if try_to_consume(_READ) then
|
||||||
begin
|
begin
|
||||||
p.readaccess.clear;
|
p.readaccess.clear;
|
||||||
@ -394,7 +364,7 @@ implementation
|
|||||||
case sym.typ of
|
case sym.typ of
|
||||||
procsym :
|
procsym :
|
||||||
begin
|
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
|
if not(assigned(pd)) or
|
||||||
not(equal_defs(pd.rettype.def,p.proptype.def)) then
|
not(equal_defs(pd.rettype.def,p.proptype.def)) then
|
||||||
Message(parser_e_ill_property_access_sym);
|
Message(parser_e_ill_property_access_sym);
|
||||||
@ -430,10 +400,10 @@ implementation
|
|||||||
procsym :
|
procsym :
|
||||||
begin
|
begin
|
||||||
{ insert data entry to check access method }
|
{ insert data entry to check access method }
|
||||||
propertyparas.insert(datacoll);
|
temppara:=propertyprocdef.concatpara(nil,p.proptype,nil,vs_value,nil);
|
||||||
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
|
pd:=Tprocsym(sym).search_procdef_bypara(propertyprocdef.para,true,false);
|
||||||
{ ... and remove it }
|
{ ... and remove it }
|
||||||
propertyparas.remove(datacoll);
|
propertyprocdef.removepara(temppara);
|
||||||
if not(assigned(pd)) then
|
if not(assigned(pd)) then
|
||||||
Message(parser_e_ill_property_access_sym);
|
Message(parser_e_ill_property_access_sym);
|
||||||
p.writeaccess.setdef(pd);
|
p.writeaccess.setdef(pd);
|
||||||
@ -551,21 +521,18 @@ implementation
|
|||||||
}
|
}
|
||||||
begin
|
begin
|
||||||
include(p.propoptions,ppo_defaultproperty);
|
include(p.propoptions,ppo_defaultproperty);
|
||||||
if propertyparas.empty then
|
if propertyprocdef.maxparacount=0 then
|
||||||
message(parser_e_property_need_paras);
|
message(parser_e_property_need_paras);
|
||||||
end;
|
end;
|
||||||
consume(_SEMICOLON);
|
consume(_SEMICOLON);
|
||||||
end;
|
end;
|
||||||
{ clean up }
|
|
||||||
if assigned(datacoll) then
|
|
||||||
datacoll.free;
|
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
consume(_ID);
|
consume(_ID);
|
||||||
consume(_SEMICOLON);
|
consume(_SEMICOLON);
|
||||||
end;
|
end;
|
||||||
propertyparas.free;
|
propertyprocdef.free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -1172,7 +1139,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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.
|
* merged some verbosity options.
|
||||||
* V_LineInfo is a verbosity flag to include line info
|
* V_LineInfo is a verbosity flag to include line info
|
||||||
|
|
||||||
|
|||||||
@ -41,6 +41,7 @@ interface
|
|||||||
|
|
||||||
function is_proc_directive(tok:ttoken):boolean;
|
function is_proc_directive(tok:ttoken):boolean;
|
||||||
|
|
||||||
|
procedure insert_hidden_para(pd:tabstractprocdef);
|
||||||
procedure check_self_para(aktprocdef:tabstractprocdef);
|
procedure check_self_para(aktprocdef:tabstractprocdef);
|
||||||
procedure parameter_dec(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);
|
procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
|
||||||
begin
|
begin
|
||||||
if tsym(p).typ<>varsym then
|
if tsym(p).typ<>varsym then
|
||||||
@ -106,7 +149,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure checkparatype(p:tnamedindexitem;arg:pointer);
|
procedure check_c_para(p:tnamedindexitem;arg:pointer);
|
||||||
begin
|
begin
|
||||||
if (tsym(p).typ<>varsym) then
|
if (tsym(p).typ<>varsym) then
|
||||||
exit;
|
exit;
|
||||||
@ -121,35 +164,12 @@ implementation
|
|||||||
if (varspez<>vs_var) then
|
if (varspez<>vs_var) then
|
||||||
Message(parser_h_c_arrays_are_references);
|
Message(parser_h_c_arrays_are_references);
|
||||||
end;
|
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
|
if is_array_of_const(vartype.def) and
|
||||||
assigned(indexnext) and
|
assigned(indexnext) and
|
||||||
(tsym(indexnext).typ=varsym) and
|
(tsym(indexnext).typ=varsym) and
|
||||||
not(vo_is_high_value in tvarsym(indexnext).varoptions) then
|
not(vo_is_high_value in tvarsym(indexnext).varoptions) then
|
||||||
Message(parser_e_C_array_of_const_must_be_last);
|
Message(parser_e_C_array_of_const_must_be_last);
|
||||||
end;
|
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;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -190,13 +210,11 @@ implementation
|
|||||||
sc : tsinglelist;
|
sc : tsinglelist;
|
||||||
tt : ttype;
|
tt : ttype;
|
||||||
arrayelementtype : ttype;
|
arrayelementtype : ttype;
|
||||||
hvs,
|
|
||||||
vs : tvarsym;
|
vs : tvarsym;
|
||||||
srsym : tsym;
|
srsym : tsym;
|
||||||
hs1 : string;
|
hs1 : string;
|
||||||
varspez : Tvarspez;
|
varspez : Tvarspez;
|
||||||
hpara : tparaitem;
|
hpara : tparaitem;
|
||||||
inserthigh : boolean;
|
|
||||||
tdefaultvalue : tconstsym;
|
tdefaultvalue : tconstsym;
|
||||||
defaultrequired : boolean;
|
defaultrequired : boolean;
|
||||||
old_object_option : tsymoptions;
|
old_object_option : tsymoptions;
|
||||||
@ -242,151 +260,122 @@ implementation
|
|||||||
end
|
end
|
||||||
else
|
else
|
||||||
varspez:=vs_value;
|
varspez:=vs_value;
|
||||||
inserthigh:=false;
|
|
||||||
tdefaultvalue:=nil;
|
tdefaultvalue:=nil;
|
||||||
tt.reset;
|
tt.reset;
|
||||||
begin
|
{ read identifiers and insert with error type }
|
||||||
{ read identifiers and insert with error type }
|
sc.reset;
|
||||||
sc.reset;
|
repeat
|
||||||
repeat
|
vs:=tvarsym.create(orgpattern,generrortype);
|
||||||
vs:=tvarsym.create(orgpattern,generrortype);
|
currparast.insert(vs);
|
||||||
currparast.insert(vs);
|
if assigned(vs.owner) then
|
||||||
if assigned(vs.owner) then
|
sc.insert(vs)
|
||||||
sc.insert(vs)
|
else
|
||||||
else
|
vs.free;
|
||||||
vs.free;
|
consume(_ID);
|
||||||
consume(_ID);
|
until not try_to_consume(_COMMA);
|
||||||
until not try_to_consume(_COMMA);
|
{ read type declaration, force reading for value and const paras }
|
||||||
{ read type declaration, force reading for value and const paras }
|
if (token=_COLON) or (varspez=vs_value) then
|
||||||
if (token=_COLON) or (varspez=vs_value) then
|
begin
|
||||||
begin
|
consume(_COLON);
|
||||||
consume(_COLON);
|
{ check for an open array }
|
||||||
{ check for an open array }
|
if token=_ARRAY then
|
||||||
if token=_ARRAY then
|
begin
|
||||||
begin
|
consume(_ARRAY);
|
||||||
consume(_ARRAY);
|
consume(_OF);
|
||||||
consume(_OF);
|
{ define range and type of range }
|
||||||
{ define range and type of range }
|
tt.setdef(tarraydef.create(0,-1,s32bittype));
|
||||||
tt.setdef(tarraydef.create(0,-1,s32bittype));
|
{ array of const ? }
|
||||||
{ array of const ? }
|
if (token=_CONST) and (m_objpas in aktmodeswitches) then
|
||||||
if (token=_CONST) and (m_objpas in aktmodeswitches) then
|
begin
|
||||||
begin
|
consume(_CONST);
|
||||||
consume(_CONST);
|
srsym:=searchsymonlyin(systemunit,'TVARREC');
|
||||||
srsym:=searchsymonlyin(systemunit,'TVARREC');
|
if not assigned(srsym) then
|
||||||
if not assigned(srsym) then
|
InternalError(1234124);
|
||||||
InternalError(1234124);
|
tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
|
||||||
tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
|
tarraydef(tt.def).IsArrayOfConst:=true;
|
||||||
tarraydef(tt.def).IsArrayOfConst:=true;
|
end
|
||||||
end
|
else
|
||||||
else
|
begin
|
||||||
begin
|
{ define field type }
|
||||||
{ define field type }
|
single_type(arrayelementtype,hs1,false);
|
||||||
single_type(arrayelementtype,hs1,false);
|
tarraydef(tt.def).setelementtype(arrayelementtype);
|
||||||
tarraydef(tt.def).setelementtype(arrayelementtype);
|
end;
|
||||||
end;
|
end
|
||||||
inserthigh:=true;
|
else
|
||||||
end
|
begin
|
||||||
else
|
{ open string ? }
|
||||||
begin
|
if (varspez=vs_var) and
|
||||||
{ open string ? }
|
(
|
||||||
if (varspez=vs_var) and
|
(
|
||||||
(
|
((token=_STRING) or (idtoken=_SHORTSTRING)) and
|
||||||
(
|
(cs_openstring in aktmoduleswitches) and
|
||||||
((token=_STRING) or (idtoken=_SHORTSTRING)) and
|
not(cs_ansistrings in aktlocalswitches)
|
||||||
(cs_openstring in aktmoduleswitches) and
|
) or
|
||||||
not(cs_ansistrings in aktlocalswitches)
|
(idtoken=_OPENSTRING)) then
|
||||||
) or
|
begin
|
||||||
(idtoken=_OPENSTRING)) then
|
consume(token);
|
||||||
begin
|
tt:=openshortstringtype;
|
||||||
consume(token);
|
hs1:='openstring';
|
||||||
tt:=openshortstringtype;
|
end
|
||||||
hs1:='openstring';
|
else
|
||||||
inserthigh:=true;
|
begin
|
||||||
end
|
{ everything else }
|
||||||
else
|
single_type(tt,hs1,false);
|
||||||
begin
|
end;
|
||||||
{ everything else }
|
|
||||||
single_type(tt,hs1,false);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ default parameter }
|
{ default parameter }
|
||||||
if (m_default_para in aktmodeswitches) then
|
if (m_default_para in aktmodeswitches) then
|
||||||
begin
|
begin
|
||||||
if try_to_consume(_EQUAL) then
|
if try_to_consume(_EQUAL) then
|
||||||
begin
|
begin
|
||||||
vs:=tvarsym(sc.first);
|
vs:=tvarsym(sc.first);
|
||||||
if assigned(vs.listnext) then
|
if assigned(vs.listnext) then
|
||||||
Message(parser_e_default_value_only_one_para);
|
Message(parser_e_default_value_only_one_para);
|
||||||
{ prefix 'def' to the parameter name }
|
{ prefix 'def' to the parameter name }
|
||||||
tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
|
tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
|
||||||
if assigned(tdefaultvalue) then
|
if assigned(tdefaultvalue) then
|
||||||
tprocdef(aktprocdef).parast.insert(tdefaultvalue);
|
tprocdef(aktprocdef).parast.insert(tdefaultvalue);
|
||||||
defaultrequired:=true;
|
defaultrequired:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
if defaultrequired then
|
if defaultrequired then
|
||||||
Message1(parser_e_default_value_expected_for_para,vs.name);
|
Message1(parser_e_default_value_expected_for_para,vs.name);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
{$ifndef UseNiceNames}
|
{$ifndef UseNiceNames}
|
||||||
hs1:='$$$';
|
hs1:='$$$';
|
||||||
{$else UseNiceNames}
|
{$else UseNiceNames}
|
||||||
hs1:='var';
|
hs1:='var';
|
||||||
{$endif UseNiceNames}
|
{$endif UseNiceNames}
|
||||||
tt:=cformaltype;
|
tt:=cformaltype;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ For proc vars we only need the definitions }
|
vs:=tvarsym(sc.first);
|
||||||
if not is_procvar then
|
while assigned(vs) do
|
||||||
begin
|
begin
|
||||||
vs:=tvarsym(sc.first);
|
{ update varsym }
|
||||||
while assigned(vs) do
|
vs.vartype:=tt;
|
||||||
begin
|
vs.varspez:=varspez;
|
||||||
{ update varsym }
|
{ For proc vars we only need the definitions }
|
||||||
vs.vartype:=tt;
|
if not is_procvar then
|
||||||
vs.varspez:=varspez;
|
begin
|
||||||
if (varspez in [vs_var,vs_const,vs_out]) and
|
if (varspez in [vs_var,vs_const,vs_out]) and
|
||||||
paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
|
paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
|
||||||
include(vs.varoptions,vo_regable);
|
include(vs.varoptions,vo_regable);
|
||||||
|
hpara:=aktprocdef.concatpara(nil,tt,vs,varspez,tdefaultvalue);
|
||||||
{ also need to push a high value? }
|
end
|
||||||
if inserthigh then
|
else
|
||||||
begin
|
hpara:=aktprocdef.concatpara(nil,tt,nil,varspez,tdefaultvalue);
|
||||||
hvs:=tvarsym.create('$high'+vs.name,s32bittype);
|
{ save position of self parameter }
|
||||||
hvs.varspez:=vs_const;
|
if vs.name='SELF' then
|
||||||
include(hvs.varoptions,vo_is_high_value);
|
aktprocdef.selfpara:=hpara;
|
||||||
{$ifdef vs_hidden}
|
vs:=tvarsym(vs.listnext);
|
||||||
aktprocdef.concatpara(s32bittype,hvs,vs_hidden,nil);
|
end;
|
||||||
{$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 }
|
|
||||||
until not try_to_consume(_SEMICOLON);
|
until not try_to_consume(_SEMICOLON);
|
||||||
{ remove parasymtable from stack }
|
{ remove parasymtable from stack }
|
||||||
if is_procvar then
|
if is_procvar then
|
||||||
@ -1594,9 +1583,6 @@ const
|
|||||||
{ set the default calling convention }
|
{ set the default calling convention }
|
||||||
if def.proccalloption=pocall_none then
|
if def.proccalloption=pocall_none then
|
||||||
def.proccalloption:=aktdefproccall;
|
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 }
|
{ handle proccall specific settings }
|
||||||
case def.proccalloption of
|
case def.proccalloption of
|
||||||
pocall_cdecl :
|
pocall_cdecl :
|
||||||
@ -1617,7 +1603,7 @@ const
|
|||||||
if not assigned(tprocdef(def).parast) then
|
if not assigned(tprocdef(def).parast) then
|
||||||
internalerror(200110234);
|
internalerror(200110234);
|
||||||
{ check C cdecl para types }
|
{ 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 }
|
{ Adjust alignment to match cdecl or stdcall }
|
||||||
tprocdef(def).parast.dataalignment:=std_param_align;
|
tprocdef(def).parast.dataalignment:=std_param_align;
|
||||||
end;
|
end;
|
||||||
@ -1637,7 +1623,7 @@ const
|
|||||||
if not assigned(tprocdef(def).parast) then
|
if not assigned(tprocdef(def).parast) then
|
||||||
internalerror(200110235);
|
internalerror(200110235);
|
||||||
{ check C cdecl para types }
|
{ 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 }
|
{ Adjust alignment to match cdecl or stdcall }
|
||||||
tprocdef(def).parast.dataalignment:=std_param_align;
|
tprocdef(def).parast.dataalignment:=std_param_align;
|
||||||
end;
|
end;
|
||||||
@ -1709,6 +1695,14 @@ const
|
|||||||
end;
|
end;
|
||||||
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 }
|
{ add mangledname to external list }
|
||||||
if (def.deftype=procdef) and
|
if (def.deftype=procdef) and
|
||||||
(po_external in def.procoptions) and
|
(po_external in def.procoptions) and
|
||||||
@ -1733,13 +1727,8 @@ const
|
|||||||
ps:=tsym(st.symindex.first);
|
ps:=tsym(st.symindex.first);
|
||||||
while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
|
while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
|
||||||
ps:=tsym(ps.indexnext);
|
ps:=tsym(ps.indexnext);
|
||||||
if (ps.typ=varsym) and
|
if (ps.typ=varsym) then
|
||||||
not(vo_is_high_value in tvarsym(ps).varoptions) then
|
st.insertvardata(ps);
|
||||||
begin
|
|
||||||
st.insertvardata(ps);
|
|
||||||
if assigned(tvarsym(ps).highvarsym) then
|
|
||||||
st.insertvardata(tvarsym(ps).highvarsym);
|
|
||||||
end;
|
|
||||||
lastps:=ps;
|
lastps:=ps;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
@ -2143,7 +2132,10 @@ const
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* generic constructor working for i386
|
||||||
* remove fixed self register
|
* remove fixed self register
|
||||||
* esi added as address register for i386
|
* esi added as address register for i386
|
||||||
|
|||||||
@ -41,7 +41,7 @@ type
|
|||||||
{$endif Test_Double_checksum}
|
{$endif Test_Double_checksum}
|
||||||
|
|
||||||
const
|
const
|
||||||
CurrentPPUVersion=31;
|
CurrentPPUVersion=32;
|
||||||
|
|
||||||
{ buffer sizes }
|
{ buffer sizes }
|
||||||
maxentrysize = 1024;
|
maxentrysize = 1024;
|
||||||
@ -985,7 +985,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* store symoptions also for procdef
|
||||||
* check symoptions (private,public) when calculating possible
|
* check symoptions (private,public) when calculating possible
|
||||||
overload candidates
|
overload candidates
|
||||||
|
|||||||
@ -98,22 +98,16 @@ interface
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
tparaitem = class(TLinkedListItem)
|
tparaitem = class(TLinkedListItem)
|
||||||
paratype : ttype;
|
paratype : ttype; { required for procvar }
|
||||||
parasym : tsym;
|
parasym : tsym;
|
||||||
defaultvalue : tsym; { tconstsym }
|
defaultvalue : tsym; { tconstsym }
|
||||||
paratyp : tvarspez;
|
paratyp : tvarspez; { required for procvar }
|
||||||
paraloc : tparalocation;
|
paraloc : tparalocation;
|
||||||
{$ifdef EXTDEBUG}
|
{$ifdef EXTDEBUG}
|
||||||
eqval : tequaltype;
|
eqval : tequaltype;
|
||||||
{$endif EXTDEBUG}
|
{$endif EXTDEBUG}
|
||||||
end;
|
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);
|
tfiletyp = (ft_text,ft_typed,ft_untyped);
|
||||||
|
|
||||||
tfiledef = class(tstoreddef)
|
tfiledef = class(tstoreddef)
|
||||||
@ -419,7 +413,7 @@ interface
|
|||||||
tabstractprocdef = class(tstoreddef)
|
tabstractprocdef = class(tstoreddef)
|
||||||
{ saves a definition to the return type }
|
{ saves a definition to the return type }
|
||||||
rettype : ttype;
|
rettype : ttype;
|
||||||
para : tparalinkedlist;
|
para : tlinkedlist;
|
||||||
selfpara : tparaitem;
|
selfpara : tparaitem;
|
||||||
proctypeoption : tproctypeoption;
|
proctypeoption : tproctypeoption;
|
||||||
proccalloption : tproccalloption;
|
proccalloption : tproccalloption;
|
||||||
@ -433,7 +427,8 @@ interface
|
|||||||
destructor destroy;override;
|
destructor destroy;override;
|
||||||
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
||||||
procedure deref;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 para_size(alignsize:longint) : longint;
|
||||||
function typename_paras : string;
|
function typename_paras : string;
|
||||||
procedure test_if_fpu_result;
|
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
|
Tstringdef
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
@ -3073,7 +3055,7 @@ implementation
|
|||||||
constructor tabstractprocdef.create;
|
constructor tabstractprocdef.create;
|
||||||
begin
|
begin
|
||||||
inherited create;
|
inherited create;
|
||||||
para:=TParaLinkedList.Create;
|
para:=TLinkedList.Create;
|
||||||
selfpara:=nil;
|
selfpara:=nil;
|
||||||
minparacount:=0;
|
minparacount:=0;
|
||||||
maxparacount:=0;
|
maxparacount:=0;
|
||||||
@ -3094,7 +3076,7 @@ implementation
|
|||||||
end;
|
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
|
var
|
||||||
hp : TParaItem;
|
hp : TParaItem;
|
||||||
begin
|
begin
|
||||||
@ -3103,7 +3085,11 @@ implementation
|
|||||||
hp.parasym:=sym;
|
hp.parasym:=sym;
|
||||||
hp.paratype:=tt;
|
hp.paratype:=tt;
|
||||||
hp.defaultvalue:=defval;
|
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 }
|
{ Don't count hidden parameters }
|
||||||
if (vsp<>vs_hidden) then
|
if (vsp<>vs_hidden) then
|
||||||
begin
|
begin
|
||||||
@ -3115,6 +3101,18 @@ implementation
|
|||||||
end;
|
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
|
{ all functions returning in FPU are
|
||||||
@ -3152,7 +3150,7 @@ implementation
|
|||||||
count,i : word;
|
count,i : word;
|
||||||
begin
|
begin
|
||||||
inherited ppuloaddef(ppufile);
|
inherited ppuloaddef(ppufile);
|
||||||
Para:=TParaLinkedList.Create;
|
Para:=TLinkedList.Create;
|
||||||
selfpara:=nil;
|
selfpara:=nil;
|
||||||
minparacount:=0;
|
minparacount:=0;
|
||||||
maxparacount:=0;
|
maxparacount:=0;
|
||||||
@ -3168,7 +3166,6 @@ implementation
|
|||||||
begin
|
begin
|
||||||
hp:=TParaItem.Create;
|
hp:=TParaItem.Create;
|
||||||
hp.paratyp:=tvarspez(ppufile.getbyte);
|
hp.paratyp:=tvarspez(ppufile.getbyte);
|
||||||
{ hp.register:=tregister(ppufile.getbyte); }
|
|
||||||
ppufile.gettype(hp.paratype);
|
ppufile.gettype(hp.paratype);
|
||||||
hp.defaultvalue:=tsym(ppufile.getderef);
|
hp.defaultvalue:=tsym(ppufile.getderef);
|
||||||
hp.parasym:=tsym(ppufile.getderef);
|
hp.parasym:=tsym(ppufile.getderef);
|
||||||
@ -3181,6 +3178,7 @@ implementation
|
|||||||
inc(minparacount);
|
inc(minparacount);
|
||||||
inc(maxparacount);
|
inc(maxparacount);
|
||||||
end;
|
end;
|
||||||
|
{ Parameters are stored left to right in both ppu and memory }
|
||||||
Para.concat(hp);
|
Para.concat(hp);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -3202,12 +3200,12 @@ implementation
|
|||||||
ppufile.putbyte(ord(proccalloption));
|
ppufile.putbyte(ord(proccalloption));
|
||||||
ppufile.putsmallset(procoptions);
|
ppufile.putsmallset(procoptions);
|
||||||
ppufile.do_interface_crc:=oldintfcrc;
|
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);
|
hp:=TParaItem(Para.first);
|
||||||
while assigned(hp) do
|
while assigned(hp) do
|
||||||
begin
|
begin
|
||||||
ppufile.putbyte(byte(hp.paratyp));
|
ppufile.putbyte(byte(hp.paratyp));
|
||||||
{ ppufile.putbyte(byte(hp.register)); }
|
|
||||||
ppufile.puttype(hp.paratype);
|
ppufile.puttype(hp.paratype);
|
||||||
ppufile.putderef(hp.defaultvalue);
|
ppufile.putderef(hp.defaultvalue);
|
||||||
ppufile.putderef(hp.parasym);
|
ppufile.putderef(hp.parasym);
|
||||||
@ -3247,31 +3245,18 @@ implementation
|
|||||||
hp : TParaItem;
|
hp : TParaItem;
|
||||||
hpc : tconstsym;
|
hpc : tconstsym;
|
||||||
begin
|
begin
|
||||||
{ look for a visible parameter }
|
hp:=TParaItem(Para.first);
|
||||||
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);
|
|
||||||
s:='(';
|
s:='(';
|
||||||
while assigned(hp) do
|
while assigned(hp) do
|
||||||
begin
|
begin
|
||||||
if hp.paratyp=vs_var then
|
case hp.paratyp of
|
||||||
s:=s+'var'
|
vs_var :
|
||||||
else if hp.paratyp=vs_const then
|
s:=s+'var';
|
||||||
s:=s+'const'
|
vs_const :
|
||||||
else if hp.paratyp=vs_out then
|
s:=s+'const';
|
||||||
s:=s+'out';
|
vs_out :
|
||||||
|
s:=s+'out';
|
||||||
|
end;
|
||||||
if hp.paratyp<>vs_hidden then
|
if hp.paratyp<>vs_hidden then
|
||||||
begin
|
begin
|
||||||
if assigned(hp.paratype.def.typesym) then
|
if assigned(hp.paratype.def.typesym) then
|
||||||
@ -3316,15 +3301,18 @@ implementation
|
|||||||
if hs<>'' then
|
if hs<>'' then
|
||||||
s:=s+'="'+hs+'"';
|
s:=s+'="'+hs+'"';
|
||||||
end;
|
end;
|
||||||
|
if assigned(hp.next) then
|
||||||
|
s:=s+',';
|
||||||
end;
|
end;
|
||||||
hp:=TParaItem(hp.previous);
|
hp:=TParaItem(hp.next);
|
||||||
if assigned(hp) and (hp.paratyp<>vs_hidden) then
|
|
||||||
s:=s+',';
|
|
||||||
end;
|
end;
|
||||||
s:=s+')';
|
s:=s+')';
|
||||||
if (po_varargs in procoptions) then
|
if (po_varargs in procoptions) then
|
||||||
s:=s+';VarArgs';
|
s:=s+';VarArgs';
|
||||||
typename_paras:=s;
|
if s='()' then
|
||||||
|
typename_paras:=''
|
||||||
|
else
|
||||||
|
typename_paras:=s;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -3992,16 +3980,12 @@ implementation
|
|||||||
if overloadnumber>0 then
|
if overloadnumber>0 then
|
||||||
s:=s+'$'+tostr(overloadnumber);
|
s:=s+'$'+tostr(overloadnumber);
|
||||||
{ add parameter types }
|
{ add parameter types }
|
||||||
hp:=TParaItem(Para.last);
|
hp:=TParaItem(Para.first);
|
||||||
if assigned(hp) and (hp.paratyp<>vs_hidden) then
|
|
||||||
s:=s+'$';
|
|
||||||
while assigned(hp) do
|
while assigned(hp) do
|
||||||
begin
|
begin
|
||||||
if hp.paratyp<>vs_hidden then
|
if hp.paratyp<>vs_hidden then
|
||||||
s:=s+hp.paratype.def.mangledparaname;
|
s:=s+'$'+hp.paratype.def.mangledparaname;
|
||||||
hp:=TParaItem(hp.previous);
|
hp:=TParaItem(hp.next);
|
||||||
if assigned(hp) and (hp.paratyp<>vs_hidden) then
|
|
||||||
s:=s+'$';
|
|
||||||
end;
|
end;
|
||||||
_mangledname:=stringdup(s);
|
_mangledname:=stringdup(s);
|
||||||
mangledname:=_mangledname^;
|
mangledname:=_mangledname^;
|
||||||
@ -4213,9 +4197,9 @@ implementation
|
|||||||
{ write parameter info. The parameters must be written in reverse order
|
{ write parameter info. The parameters must be written in reverse order
|
||||||
if this method uses right to left parameter pushing! }
|
if this method uses right to left parameter pushing! }
|
||||||
if (po_leftright in procoptions) then
|
if (po_leftright in procoptions) then
|
||||||
pdc:=TParaItem(Para.last)
|
pdc:=TParaItem(Para.first)
|
||||||
else
|
else
|
||||||
pdc:=TParaItem(Para.first);
|
pdc:=TParaItem(Para.last);
|
||||||
while assigned(pdc) do
|
while assigned(pdc) do
|
||||||
begin
|
begin
|
||||||
case pdc.paratyp of
|
case pdc.paratyp of
|
||||||
@ -4233,9 +4217,9 @@ implementation
|
|||||||
tstoreddef(pdc.paratype.def).write_rtti_name;
|
tstoreddef(pdc.paratype.def).write_rtti_name;
|
||||||
|
|
||||||
if (po_leftright in procoptions) then
|
if (po_leftright in procoptions) then
|
||||||
pdc:=TParaItem(pdc.previous)
|
pdc:=TParaItem(pdc.next)
|
||||||
else
|
else
|
||||||
pdc:=TParaItem(pdc.next);
|
pdc:=TParaItem(pdc.previous);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ write name of result type }
|
{ write name of result type }
|
||||||
@ -5725,7 +5709,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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()
|
* no itnernalerror for errordef.concatstabto()
|
||||||
|
|
||||||
Revision 1.131 2003/03/17 16:54:41 peter
|
Revision 1.131 2003/03/17 16:54:41 peter
|
||||||
|
|||||||
@ -137,7 +137,7 @@ interface
|
|||||||
function last_procdef:Tprocdef;
|
function last_procdef:Tprocdef;
|
||||||
function search_procdef_nopara_boolret:Tprocdef;
|
function search_procdef_nopara_boolret:Tprocdef;
|
||||||
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
|
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
|
||||||
function search_procdef_bypara(params:Tparalinkedlist;
|
function search_procdef_bypara(params:Tlinkedlist;
|
||||||
allowconvert,
|
allowconvert,
|
||||||
allowdefault:boolean):Tprocdef;
|
allowdefault:boolean):Tprocdef;
|
||||||
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
|
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
|
||||||
@ -1025,7 +1025,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
|
function Tprocsym.search_procdef_bypara(params:Tlinkedlist;
|
||||||
allowconvert,
|
allowconvert,
|
||||||
allowdefault:boolean):Tprocdef;
|
allowdefault:boolean):Tprocdef;
|
||||||
var
|
var
|
||||||
@ -2563,7 +2563,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* store symoptions also for procdef
|
||||||
* check symoptions (private,public) when calculating possible
|
* check symoptions (private,public) when calculating possible
|
||||||
overload candidates
|
overload candidates
|
||||||
|
|||||||
@ -160,6 +160,17 @@ begin
|
|||||||
end;
|
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;
|
function PPUFlags2Str(flags:longint):string;
|
||||||
type
|
type
|
||||||
tflagopt=record
|
tflagopt=record
|
||||||
@ -714,7 +725,6 @@ const
|
|||||||
(mask:po_clearstack; str:'ClearStack'),
|
(mask:po_clearstack; str:'ClearStack'),
|
||||||
(mask:po_internconst; str:'InternConst')
|
(mask:po_internconst; str:'InternConst')
|
||||||
);
|
);
|
||||||
tvarspez : array[0..3] of string[5]=('Value','Const','Var ','Out ');
|
|
||||||
var
|
var
|
||||||
proctypeoption : tproctypeoption;
|
proctypeoption : tproctypeoption;
|
||||||
proccalloption : tproccalloption;
|
proccalloption : tproccalloption;
|
||||||
@ -731,7 +741,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
write(space,' TypeOption : ');
|
write(space,' TypeOption : ');
|
||||||
first:=true;
|
first:=true;
|
||||||
for i:=1to proctypeopts do
|
for i:=1 to proctypeopts do
|
||||||
if (proctypeopt[i].mask=proctypeoption) then
|
if (proctypeopt[i].mask=proctypeoption) then
|
||||||
begin
|
begin
|
||||||
if first then
|
if first then
|
||||||
@ -763,20 +773,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
params:=ppufile.getbyte;
|
params:=ppufile.getbyte;
|
||||||
writeln(space,' Nr of parameters : ',params);
|
writeln(space,' Nr of parameters : ',params);
|
||||||
if params>0 then
|
for i:=1 to params do
|
||||||
begin
|
begin
|
||||||
repeat
|
writeln(space,' - Parameter ',i);
|
||||||
write(space,' - ',tvarspez[ppufile.getbyte],' : ');
|
writeln(space,' Spez : ',Varspez2Str(ppufile.getbyte));
|
||||||
readtype;
|
write (space,' Type : ');
|
||||||
write(space,' Default : ');
|
readtype;
|
||||||
readsymref;
|
write (space,' Default : ');
|
||||||
write(space,' Symbol : ');
|
readsymref;
|
||||||
readsymref;
|
write (space,' Symbol : ');
|
||||||
write(space,' Location : ');
|
readsymref;
|
||||||
writeln('<not yet implemented>');
|
write (space,' Location : ');
|
||||||
ppufile.getdata(paraloc,sizeof(paraloc));
|
writeln('<not yet implemented>');
|
||||||
dec(params);
|
ppufile.getdata(paraloc,sizeof(paraloc));
|
||||||
until params=0;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -993,7 +1002,7 @@ begin
|
|||||||
ibvarsym :
|
ibvarsym :
|
||||||
begin
|
begin
|
||||||
readcommonsym('Variable symbol ');
|
readcommonsym('Variable symbol ');
|
||||||
writeln(space,' Type: ',getbyte);
|
writeln(space,' Spez: ',Varspez2Str(getbyte));
|
||||||
writeln(space,' Address: ',getlongint);
|
writeln(space,' Address: ',getlongint);
|
||||||
write (space,' Var Type: ');
|
write (space,' Var Type: ');
|
||||||
readtype;
|
readtype;
|
||||||
@ -1929,7 +1938,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ emx target added
|
||||||
|
|
||||||
Revision 1.36 2003/03/17 15:54:22 peter
|
Revision 1.36 2003/03/17 15:54:22 peter
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user