From 8da3f59d32b55abf36fdb7a77c8f527d3ec4039d Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 10 Apr 2003 17:57:52 +0000 Subject: [PATCH] * vs_hidden released --- compiler/defcmp.pas | 13 +- compiler/ncal.pas | 397 +++++++++++++++++--------------------- compiler/ncgcal.pas | 31 +-- compiler/nmem.pas | 14 +- compiler/node.pas | 6 +- compiler/pdecobj.pas | 74 +++---- compiler/pdecsub.pas | 346 ++++++++++++++++----------------- compiler/ppu.pas | 7 +- compiler/symdef.pas | 123 ++++++------ compiler/symsym.pas | 9 +- compiler/utils/ppudump.pp | 46 +++-- 11 files changed, 482 insertions(+), 584 deletions(-) diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 6f8e63222f..fe17b173f6 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -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 diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 2b30927ebc..77898e135b 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -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 (paralengthprocdefinition.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 diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 88139a24c7..5ad65c2661 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -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 diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 8a4d623d95..4e40469ed9 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -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 diff --git a/compiler/node.pas b/compiler/node.pas index 74e1507b50..40b8b04141 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -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 diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 9d63683270..678d62d3a3 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -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 diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 5e10e9d52a..6e4eafae1c 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -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 diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 7d257e5f69..4173452351 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -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 diff --git a/compiler/symdef.pas b/compiler/symdef.pas index b5ae475c4b..6192efec71 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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 diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 78eb8c7367..2ceee1a764 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -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 diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index 059551d3fc..d230e88788 100644 --- a/compiler/utils/ppudump.pp +++ b/compiler/utils/ppudump.pp @@ -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:=''; +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(''); - 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(''); + 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