From a540ff122c3d24e2224fd227818fd4b404ff1216 Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 9 Sep 2002 17:34:14 +0000 Subject: [PATCH] * tdicationary.replace added to replace and item in a dictionary. This is only allowed for the same name * varsyms are inserted in symtable before the types are parsed. This fixes the long standing "var longint : longint" bug - consume_idlist and idstringlist removed. The loops are inserted at the callers place and uses the symtable for duplicate id checking --- compiler/cclasses.pas | 109 +++++++++++- compiler/import.pas | 17 +- compiler/pbase.pas | 139 +-------------- compiler/pdecobj.pas | 69 +++++--- compiler/pdecsub.pas | 169 ++++++++++-------- compiler/pdecvar.pas | 332 ++++++++++++++++------------------- compiler/pmodules.pas | 14 +- compiler/symbase.pas | 24 ++- compiler/symdef.pas | 14 +- compiler/symsym.pas | 17 +- compiler/symtable.pas | 31 +++- compiler/systems/t_beos.pas | 21 ++- compiler/systems/t_fbsd.pas | 18 +- compiler/systems/t_linux.pas | 21 ++- compiler/systems/t_nwm.pas | 18 +- compiler/systems/t_sunos.pas | 18 +- compiler/systems/t_win32.pas | 27 ++- 17 files changed, 589 insertions(+), 469 deletions(-) diff --git a/compiler/cclasses.pas b/compiler/cclasses.pas index 99a308715d..a282ce8528 100644 --- a/compiler/cclasses.pas +++ b/compiler/cclasses.pas @@ -196,7 +196,6 @@ interface procedure inserttree(currtree,currroot:TNamedIndexItem); public noclear : boolean; - replace_existing : boolean; delete_doubles : boolean; constructor Create; destructor Destroy;override; @@ -207,6 +206,7 @@ interface procedure foreach(proc2call:TNamedIndexcallback;arg:pointer); procedure foreach_static(proc2call:TNamedIndexStaticCallback;arg:pointer); function insert(obj:TNamedIndexItem):TNamedIndexItem; + function replace(oldobj,newobj:TNamedIndexItem):boolean; function rename(const olds,News : string):TNamedIndexItem; function search(const s:string):TNamedIndexItem; function speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem; @@ -237,6 +237,7 @@ interface procedure deleteindex(p:TNamedIndexItem); procedure delete(var p:TNamedIndexItem); procedure insert(p:TNamedIndexItem); + procedure replace(oldp,newp:TNamedIndexItem); function search(nr:integer):TNamedIndexItem; private growsize, @@ -844,7 +845,6 @@ end; FRoot:=nil; FHashArray:=nil; noclear:=false; - replace_existing:=false; delete_doubles:=false; end; @@ -1120,6 +1120,78 @@ end; end; + function Tdictionary.replace(oldobj,newobj:TNamedIndexItem):boolean; + var + hp : TNamedIndexItem; + begin + hp:=nil; + Replace:=false; + newobj.FSpeedValue:=GetSpeedValue(newobj.FName^); + { must be the same name and hash } + if (oldobj.FSpeedValue<>newobj.FSpeedValue) or + (oldobj.FName^<>newobj.FName^) then + exit; + { copy tree info } + newobj.FLeft:=oldobj.FLeft; + newobj.FRight:=oldobj.FRight; + { update treeroot } + if assigned(FHashArray) then + begin + hp:=FHashArray^[newobj.FSpeedValue mod hasharraysize]; + if hp=oldobj then + begin + FHashArray^[newobj.FSpeedValue mod hasharraysize]:=newobj; + hp:=nil; + end; + end + else + begin + hp:=FRoot; + if hp=oldobj then + begin + FRoot:=newobj; + hp:=nil; + end; + end; + { update parent entry } + while assigned(hp) do + begin + { is the node to replace the left or right, then + update this node and stop } + if hp.FLeft=oldobj then + begin + hp.FLeft:=newobj; + break; + end; + if hp.FRight=oldobj then + begin + hp.FRight:=newobj; + break; + end; + { First check SpeedValue, to allow a fast insert } + if hp.SpeedValue>oldobj.SpeedValue then + hp:=hp.FRight + else + if hp.SpeedValuehp.FName^ then + hp:=hp.FLeft + else + hp:=hp.FRight; + end; + end; + Replace:=true; + end; + + function Tdictionary.insert(obj:TNamedIndexItem):TNamedIndexItem; begin obj.FSpeedValue:=GetSpeedValue(obj.FName^); @@ -1153,7 +1225,7 @@ end; insertNode:=insertNode(NewNode,currNode.FLeft) else begin - if (replace_existing or delete_doubles) and + if (delete_doubles) and assigned(currNode) then begin NewNode.FLeft:=currNode.FLeft; @@ -1515,6 +1587,27 @@ end; end; + procedure tindexarray.replace(oldp,newp:TNamedIndexItem); + var + i : integer; + begin + newp.FIndexnr:=oldp.FIndexnr; + newp.FIndexNext:=oldp.FIndexNext; + data^[newp.FIndexnr]:=newp; + { update Linked List backward } + i:=newp.FIndexnr; + while (i>0) do + begin + dec(i); + if (i>0) and assigned(data^[i]) then + begin + data^[i].FIndexNext:=newp; + break; + end; + end; + end; + + {**************************************************************************** tdynamicarray ****************************************************************************} @@ -1751,7 +1844,15 @@ end; end. { $Log$ - Revision 1.18 2002-09-05 19:29:42 peter + Revision 1.19 2002-09-09 17:34:14 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.18 2002/09/05 19:29:42 peter * memdebug enhancements Revision 1.17 2002/08/11 13:24:11 peter diff --git a/compiler/import.pas b/compiler/import.pas index d5fa8b35cc..aa3d4a6205 100644 --- a/compiler/import.pas +++ b/compiler/import.pas @@ -28,7 +28,8 @@ interface uses cutils,cclasses, systems, - aasmbase; + aasmbase, + symsym; type timported_item = class(TLinkedListItem) @@ -58,7 +59,7 @@ type destructor Destroy;override; procedure preparelib(const s:string);virtual; procedure importprocedure(const func,module:string;index:longint;const name:string);virtual; - procedure importvariable(const varname,module:string;const name:string);virtual; + procedure importvariable(vs:tvarsym;const name,module:string);virtual; procedure generatelib;virtual; procedure generatesmartlib;virtual; end; @@ -185,7 +186,7 @@ begin end; -procedure timportlib.importvariable(const varname,module:string;const name:string); +procedure timportlib.importvariable(vs:tvarsym;const name,module:string); begin NotSupported; end; @@ -237,7 +238,15 @@ end; end. { $Log$ - Revision 1.19 2002-07-26 21:15:38 florian + Revision 1.20 2002-09-09 17:34:14 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.19 2002/07/26 21:15:38 florian * rewrote the system handling Revision 1.18 2002/07/01 18:46:22 peter diff --git a/compiler/pbase.pas b/compiler/pbase.pas index fd53d27ba8..0541b0b37d 100644 --- a/compiler/pbase.pas +++ b/compiler/pbase.pas @@ -30,9 +30,6 @@ interface cutils,cclasses, tokens,globals, symconst,symbase,symtype,symdef,symsym,symtable -{$ifdef fixLeaksOnError} - ,comphook -{$endif fixLeaksOnError} ; const @@ -42,21 +39,6 @@ interface { special for handling procedure vars } getprocvardef : tprocvardef = nil; - type - { listitem } - tidstringlistitem = class(tlinkedlistitem) - data : pstring; - file_info : tfileposinfo; - constructor Create(const s:string;const pos:tfileposinfo); - destructor Destroy;override; - end; - - tidstringlist=class(tlinkedlist) - procedure add(const s : string;const file_info : tfileposinfo); - function get(var file_info : tfileposinfo) : string; - function find(const s:string):boolean; - end; - var { size of data segment, set by proc_unit or proc_program } datasize : longint; @@ -73,12 +55,6 @@ interface { true, if we should ignore an equal in const x : 1..2=2 } ignore_equal : boolean; -{$ifdef fixLeaksOnError} - { not worth it to make a pstack, there's only one data field (a pointer). } - { in the interface, because pmodules and psub also use it for their names } - var strContStack: TStack; - pbase_old_do_stop: tstopprocedure; -{$endif fixLeaksOnError} procedure identifier_not_found(const s:string); @@ -99,8 +75,6 @@ interface procedure consume_emptystats; { reads a list of identifiers into a string list } - function consume_idlist : tidstringlist; - { consume a symbol, if not found give an error and and return an errorsym } function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean; @@ -117,73 +91,6 @@ implementation uses globtype,scanner,systems,verbose; -{**************************************************************************** - TIdStringlistItem -****************************************************************************} - - constructor TIDStringlistItem.Create(const s:string;const pos:tfileposinfo); - begin - data:=stringdup(s); - file_info:=pos; - end; - - - destructor TIDStringlistItem.Destroy; - begin - stringdispose(data); - end; - - -{**************************************************************************** - TIdStringlist -****************************************************************************} - - procedure tidstringlist.add(const s : string; const file_info : tfileposinfo); - begin - if find(s) then - exit; - inherited concat(tidstringlistitem.create(s,file_info)); - end; - - - function tidstringlist.get(var file_info : tfileposinfo) : string; - var - p : tidstringlistitem; - begin - p:=tidstringlistitem(inherited getfirst); - if p=nil then - begin - get:=''; - file_info.fileindex:=0; - file_info.line:=0; - file_info.column:=0; - end - else - begin - get:=p.data^; - file_info:=p.file_info; - p.free; - end; - end; - - function tidstringlist.find(const s:string):boolean; - var - newnode : tidstringlistitem; - begin - find:=false; - newnode:=tidstringlistitem(First); - while assigned(newnode) do - begin - if newnode.data^=s then - begin - find:=true; - exit; - end; - newnode:=tidstringlistitem(newnode.next); - end; - end; - - {**************************************************************************** Token Parsing ****************************************************************************} @@ -258,20 +165,6 @@ implementation end; - { reads a list of identifiers into a string list } - function consume_idlist : tidstringlist; - var - sc : tIdstringlist; - begin - sc:=TIdStringlist.Create; - repeat - sc.add(orgpattern,akttokenpos); - consume(_ID); - until not try_to_consume(_COMMA); - consume_idlist:=sc; - end; - - function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean; begin { first check for identifier } @@ -342,32 +235,18 @@ implementation until false; end; - -{$ifdef fixLeaksOnError} -procedure pbase_do_stop; -var names: PStringlist; -begin - names := PStringlist(strContStack.pop); - while names <> nil do - begin - dispose(names,done); - names := PStringlist(strContStack.pop); - end; - strContStack.done; - do_stop := pbase_old_do_stop; - do_stop{$ifdef FPCPROCVAR}(){$endif}; -end; - -begin - strContStack.init; - pbase_old_do_stop := do_stop; - do_stop := {$ifdef FPCPROCVAR}(){$endif}pbase_do_stop; -{$endif fixLeaksOnError} end. - { $Log$ - Revision 1.18 2002-08-17 09:23:38 florian + Revision 1.19 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.18 2002/08/17 09:23:38 florian * first part of procinfo rewrite Revision 1.17 2002/05/18 13:34:11 peter diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 0574bd7aa1..05f0b2203d 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -223,7 +223,6 @@ implementation overriden : tsym; hs : string; varspez : tvarspez; - sc : tidstringlist; s : string; tt : ttype; declarepos : tfileposinfo; @@ -231,6 +230,9 @@ implementation pd : tprocdef; pt : tnode; propname : stringid; + dummyst : tparasymtable; + vs : tvarsym; + sc : tsinglelist; begin { check for a class } aktprocsym:=nil; @@ -253,6 +255,11 @@ implementation Message(parser_e_cant_publish_that_property); { create a list of the parameters in propertyparas } + + dummyst:=tparasymtable.create; + dummyst.next:=symtablestack; + symtablestack:=dummyst; + sc:=tsinglelist.create; consume(_LECKKLAMMER); inc(testcurobject); repeat @@ -271,24 +278,20 @@ implementation consume(_OUT); varspez:=vs_out; end - else varspez:=vs_value; - sc:=consume_idlist; -{$ifdef fixLeaksOnError} - strContStack.push(sc); -{$endif fixLeaksOnError} + else + varspez:=vs_value; + sc.reset; + repeat + vs:=tvarsym.create(orgpattern,generrortype); + dummyst.insert(vs); + sc.insert(vs); + consume(_ID); + until not try_to_consume(_COMMA); if token=_COLON then begin consume(_COLON); if token=_ARRAY then begin - { - if (varspez<>vs_const) and - (varspez<>vs_var) then - begin - varspez:=vs_const; - Message(parser_e_illegal_open_parameter); - end; - } consume(_ARRAY); consume(_OF); { define range and type of range } @@ -301,24 +304,24 @@ implementation end else tt:=cformaltype; - repeat - s:=sc.get(declarepos); - if s='' then - break; - hp2:=TParaItem.create; - hp2.paratyp:=varspez; - hp2.paratype:=tt; - propertyparas.insert(hp2); - until false; -{$ifdef fixLeaksOnError} - if strContStack.pop <> sc then - writeln('problem with strContStack in ptype'); -{$endif fixLeaksOnError} - sc.free; + vs:=tvarsym(sc.first); + while assigned(vs) do + begin + hp2:=TParaItem.create; + hp2.paratyp:=varspez; + hp2.paratype:=tt; + propertyparas.insert(hp2); + vs:=tvarsym(vs.listnext); + end; until not try_to_consume(_SEMICOLON); dec(testcurobject); consume(_RECKKLAMMER); + { remove dummy symtable } + symtablestack:=symtablestack.next; + dummyst.free; + sc.free; + { the parser need to know if a property has parameters, the index parameter doesn't count (PFV) } if not(propertyparas.empty) then @@ -1147,7 +1150,15 @@ implementation end. { $Log$ - Revision 1.50 2002-09-03 16:26:26 daniel + Revision 1.51 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.50 2002/09/03 16:26:26 daniel * Make Tprocdef.defs protected Revision 1.49 2002/08/17 09:23:38 florian diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index b2a093f95f..c99df968cd 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -102,10 +102,7 @@ implementation } var is_procvar : boolean; - sc : tidstringlist; - s : string; - hpos, - storetokenpos : tfileposinfo; + sc : tsinglelist; htype, tt : ttype; hvs, @@ -117,17 +114,37 @@ implementation tdefaultvalue : tconstsym; defaultrequired : boolean; old_object_option : tsymoptions; + dummyst : tparasymtable; + currparast : tparasymtable; begin - { reset } - defaultrequired:=false; - { parsing a proc or procvar ? } - is_procvar:=(aktprocdef.deftype=procvardef); consume(_LKLAMMER); { Delphi/Kylix supports nonsense like } { procedure p(); } if try_to_consume(_RKLAMMER) and not(m_tp7 in aktmodeswitches) then exit; + { parsing a proc or procvar ? } + is_procvar:=(aktprocdef.deftype=procvardef); + { create dummy symtable for procvars } + if is_procvar then + begin + { we can't insert the dummyst in the symtablestack, + because definitions will be inserted in the symtablestack. And + this symtable is disposed at the end of the parsing, so the + definitions are lost } + dummyst:=tparasymtable.create; + currparast:=dummyst; + end + else + begin + { parast is available, we can insert in symtablestack } + tprocdef(aktprocdef).parast.next:=symtablestack; + symtablestack:=tprocdef(aktprocdef).parast; + currparast:=tparasymtable(tprocdef(aktprocdef).parast); + end; + { reset } + sc:=tsinglelist.create; + defaultrequired:=false; { the variables are always public } old_object_option:=current_object_option; current_object_option:=[sp_public]; @@ -182,11 +199,14 @@ implementation end else begin - { read identifiers } - sc:=consume_idlist; -{$ifdef fixLeaksOnError} - strContStack.push(sc); -{$endif fixLeaksOnError} + { read identifiers and insert with error type } + sc.reset; + repeat + vs:=tvarsym.create(orgpattern,generrortype); + currparast.insert(vs); + sc.insert(vs); + 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 @@ -237,17 +257,18 @@ implementation { 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 - s:=sc.get(hpos); - if not sc.empty then - Comment(V_Error,'default value only allowed for one parameter'); - sc.add(s,hpos); + vs:=tvarsym(sc.first); + if assigned(vs) and + assigned(vs.listnext) then + Comment(V_Error,'default value only allowed for one parameter'); { prefix 'def' to the parameter name } - tdefaultvalue:=ReadConstant('$def'+Upper(s),hpos); + tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo); if assigned(tdefaultvalue) then tprocdef(aktprocdef).parast.insert(tdefaultvalue); defaultrequired:=true; @@ -269,57 +290,59 @@ implementation {$endif UseNiceNames} tt:=cformaltype; end; - storetokenpos:=akttokenpos; - while not sc.empty do + + { For proc vars we only need the definitions } + if not is_procvar then begin - s:=sc.get(akttokenpos); - { For proc vars we only need the definitions } - if not is_procvar then + vs:=tvarsym(sc.first); + while assigned(vs) do begin - vs:=tvarsym.create(s,tt); + { update varsym } + vs.vartype:=tt; vs.varspez:=varspez; - { we have to add this to avoid var param to be in registers !!!} - { I don't understand the comment above, } - { but I suppose the comment is wrong and } - { it means that the address of var parameters can be placed } - { in a register (FK) } if (varspez in [vs_var,vs_const,vs_out]) and paramanager.push_addr_param(tt.def,false) then include(vs.varoptions,vo_regable); - { insert the sym in the parasymtable } - tprocdef(aktprocdef).parast.insert(vs); - - { do we need a local copy? Then rename the varsym, do this after the - insert so the dup id checking is done correctly } + { do we need a local copy? Then rename the varsym, do this after the + insert so the dup id checking is done correctly } if (varspez=vs_value) and paramanager.push_addr_param(tt.def,aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) and not(is_open_array(tt.def) or is_array_of_const(tt.def)) then - tprocdef(aktprocdef).parast.rename(vs.name,'val'+vs.name); + currparast.rename(vs.name,'val'+vs.name); - { also need to push a high value? } + { also need to push a high value? } if inserthigh then begin - hvs:=tvarsym.create('$high'+Upper(s),s32bittype); + hvs:=tvarsym.create('$high'+vs.name,s32bittype); hvs.varspez:=vs_const; - tprocdef(aktprocdef).parast.insert(hvs); + currparast.insert(hvs); end; - - end - else - vs:=nil; - - aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue); + aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue); + 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 } + aktprocdef.concatpara(tt,nil,varspez,tdefaultvalue); + vs:=tvarsym(vs.listnext); + end; end; -{$ifdef fixLeaksOnError} - if PStringContainer(strContStack.pop) <> sc then - writeln('problem with strContStack in pdecl (1)'); -{$endif fixLeaksOnError} - sc.free; - akttokenpos:=storetokenpos; end; { set the new mangled name } until not try_to_consume(_SEMICOLON); + { remove parasymtable from stack } + if is_procvar then + dummyst.free + else + symtablestack:=symtablestack.next; + sc.free; + { reset object options } dec(testcurobject); current_object_option:=old_object_option; consume(_RKLAMMER); @@ -703,19 +726,18 @@ implementation single_type(aktprocdef.rettype,hs,false); aktprocdef.test_if_fpu_result; if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and - ((aktprocdef.rettype.def.deftype<> - orddef) or (torddef(aktprocdef. - rettype.def).typ<>bool8bit)) then - Message(parser_e_comparative_operator_return_boolean); - if assigned(otsym) then - otsym.vartype.def:=aktprocdef.rettype.def; - if (optoken=_ASSIGNMENT) and - is_equal(aktprocdef.rettype.def, - tvarsym(aktprocdef.parast.symindex.first).vartype.def) then - message(parser_e_no_such_assignment) - else if not isoperatoracceptable(aktprocdef,optoken) then - Message(parser_e_overload_impossible); - end; + ((aktprocdef.rettype.def.deftype<>orddef) or + (torddef(aktprocdef.rettype.def).typ<>bool8bit)) then + Message(parser_e_comparative_operator_return_boolean); + if assigned(otsym) then + otsym.vartype.def:=aktprocdef.rettype.def; + if (optoken=_ASSIGNMENT) and + is_equal(aktprocdef.rettype.def, + tvarsym(aktprocdef.parast.symindex.first).vartype.def) then + message(parser_e_no_such_assignment) + else if not isoperatoracceptable(aktprocdef,optoken) then + Message(parser_e_overload_impossible); + end; end; end; if isclassmethod and @@ -1396,6 +1418,12 @@ const aktprocdef.proccalloption:=proc_direcdata[p].pocall; end; + { check if method and directive not for object, like public. + This needs to be checked also for procvars } + if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and + (aktprocdef.owner.symtabletype=objectsymtable) then + exit; + if aktprocdef.deftype=procdef then begin { Check if the directive is only for objects } @@ -1403,11 +1431,6 @@ const not assigned(aktprocdef._class) then exit; - { check if method and directive not for object public } - if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and - assigned(aktprocdef._class) then - exit; - { check if method and directive not for interface } if ((proc_direcdata[p].pd_flags and pd_notobjintf)<>0) and is_interface(aktprocdef._class) then @@ -1976,7 +1999,15 @@ const end. { $Log$ - Revision 1.71 2002-09-07 15:25:06 peter + Revision 1.72 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.71 2002/09/07 15:25:06 peter * old logs removed and tabs fixed Revision 1.70 2002/09/03 16:26:27 daniel diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index cf28ccfae0..6b93813692 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -34,7 +34,7 @@ implementation uses { common } - cutils, + cutils,cclasses, { global } globtype,globals,tokens,verbose, systems, @@ -62,46 +62,36 @@ implementation { => the procedure is also used to read } { a sequence of variable declaration } - procedure insert_syms(st : tsymtable;sc : tidstringlist;tt : ttype;is_threadvar : boolean); + procedure insert_syms(sc : tsinglelist;tt : ttype;is_threadvar : boolean); { inserts the symbols of sc in st with def as definition or sym as ttypesym, sc is disposed } var - s : string; - filepos : tfileposinfo; - ss,ss2 : tvarsym; + vs,vs2 : tvarsym; begin - filepos:=akttokenpos; - while not sc.empty do + vs:=tvarsym(sc.first); + while assigned(vs) do begin - s:=sc.get(akttokenpos); - ss:=tvarsym.Create(s,tt); + vs.vartype:=tt; if is_threadvar then - include(ss.varoptions,vo_is_thread_var); - st.insert(ss); + include(vs.varoptions,vo_is_thread_var); { static data fields are inserted in the globalsymtable } - if (st.symtabletype=objectsymtable) and + if (symtablestack.symtabletype=objectsymtable) and (sp_static in current_object_option) then begin - ss2:=tvarsym.create('$'+lower(st.name^)+'_'+upper(s),tt); - st.defowner.owner.insert(ss2); - st.defowner.owner.insertvardata(ss2); + vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,tt); + symtablestack.defowner.owner.insert(vs2); + symtablestack.defowner.owner.insertvardata(vs2); end else begin { external data is not possible here } - st.insertvardata(ss); + symtablestack.insertvardata(vs); end; + vs:=tvarsym(vs.listnext); end; -{$ifdef fixLeaksOnError} - if strContStack.pop <> sc then - writeln('problem with strContStack in pdecl (2)'); -{$endif fixLeaksOnError} - sc.free; - akttokenpos:=filepos; end; var - sc : tidstringList; - s : stringid; + sc : tsinglelist; old_block_type : tblock_type; declarepos,storetokenpos : tfileposinfo; oldsymtablestack : tsymtable; @@ -112,10 +102,9 @@ implementation newtype : ttypesym; is_dll, is_gpc_name,is_cdecl, - extern_aktvarsym,export_aktvarsym : boolean; + extern_var,export_var : boolean; old_current_object_option : tsymoptions; - dll_name, - C_name : string; + hs,sorg,C_name,dll_name : string; tt,casetype : ttype; { Delphi initialized vars } tconstsym : ttypedconstsym; @@ -124,6 +113,7 @@ implementation usedalign, maxsize,minalignment,maxalignment,startvarrecalign,startvarrecsize : longint; pt : tnode; + vs : tvarsym; srsym : tsym; srsymtable : tsymtable; unionsymtable : tsymtable; @@ -144,14 +134,18 @@ implementation if not (token in [_ID,_CASE,_END]) then consume(_ID); { read vars } + sc:=tsinglelist.create; while (token=_ID) and not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED])) do begin - C_name:=orgpattern; - sc:=consume_idlist; -{$ifdef fixLeaksOnError} - strContStack.push(sc); -{$endif fixLeaksOnError} + sorg:=orgpattern; + sc.reset; + repeat + vs:=tvarsym.create(orgpattern,generrortype); + symtablestack.insert(vs); + sc.insert(vs); + consume(_ID); + until not try_to_consume(_COMMA); consume(_COLON); if (m_gpc in aktmodeswitches) and not(is_record or is_object or is_threadvar) and @@ -184,20 +178,13 @@ implementation symdone:=false; if is_gpc_name then begin - storetokenpos:=akttokenpos; - s:=sc.get(akttokenpos); - if not sc.empty then - Message(parser_e_absolute_only_one_var); -{$ifdef fixLeaksOnError} - if strContStack.pop <> sc then - writeln('problem with strContStack in pdecl (3)'); -{$endif fixLeaksOnError} - sc.free; - aktvarsym:=tvarsym.create_C(s,target_info.Cprefix+C_name,tt); - include(aktvarsym.varoptions,vo_is_external); - symtablestack.insert(aktvarsym); - { external, so no insert in the data } - akttokenpos:=storetokenpos; + vs:=tvarsym(sc.first); + if assigned(vs.listnext) then + Message(parser_e_absolute_only_one_var); + vs.vartype:=tt; + include(vs.varoptions,vo_is_C_var); + vs.set_mangledname(target_info.Cprefix+sorg); + include(vs.varoptions,vo_is_external); symdone:=true; end; { check for absolute } @@ -206,106 +193,82 @@ implementation begin consume(_ABSOLUTE); { only allowed for one var } - s:=sc.get(declarepos); - if not sc.empty then - Message(parser_e_absolute_only_one_var); -{$ifdef fixLeaksOnError} - if strContStack.pop <> sc then - writeln('problem with strContStack in pdecl (4)'); -{$endif fixLeaksOnError} - sc.free; + vs:=tvarsym(sc.first); + if assigned(vs.listnext) then + Message(parser_e_absolute_only_one_var); { parse the rest } pt:=expr; - if (pt.nodetype=stringconstn) or (is_constcharnode(pt)) then + if (pt.nodetype=stringconstn) or + (is_constcharnode(pt)) then begin - storetokenpos:=akttokenpos; - akttokenpos:=declarepos; - abssym:=tabsolutesym.create(s,tt); + abssym:=tabsolutesym.create(vs.realname,tt); + abssym.fileinfo:=vs.fileinfo; if pt.nodetype=stringconstn then - s:=strpas(tstringconstnode(pt).value_str) + hs:=strpas(tstringconstnode(pt).value_str) else - s:=chr(tordconstnode(pt).value); + hs:=chr(tordconstnode(pt).value); consume(token); abssym.abstyp:=toasm; - abssym.asmname:=stringdup(s); - symtablestack.insert(abssym); - akttokenpos:=storetokenpos; - symdone:=true; - end; - if not symdone then + abssym.asmname:=stringdup(hs); + { replace the varsym } + symtablestack.replace(vs,abssym); + vs.free; + end + { variable } + else if (pt.nodetype=loadn) then begin - { variable } - if (pt.nodetype=loadn) then + { we should check the result type of srsym } + if not (tloadnode(pt).symtableentry.typ in [varsym,typedconstsym,funcretsym]) then + Message(parser_e_absolute_only_to_var_or_const); + abssym:=tabsolutesym.create(vs.realname,tt); + abssym.fileinfo:=vs.fileinfo; + abssym.abstyp:=tovar; + abssym.ref:=tstoredsym(tloadnode(pt).symtableentry); + symtablestack.replace(vs,abssym); + vs.free; + end + { funcret } + else if (pt.nodetype=funcretn) then + begin + abssym:=tabsolutesym.create(vs.realname,tt); + abssym.fileinfo:=vs.fileinfo; + abssym.abstyp:=tovar; + abssym.ref:=tstoredsym(tfuncretnode(pt).funcretsym); + symtablestack.replace(vs,abssym); + vs.free; + end + { address } + else if is_constintnode(pt) and + ((target_info.system=system_i386_go32v2) or + (m_objfpc in aktmodeswitches) or + (m_delphi in aktmodeswitches)) then + begin + abssym:=tabsolutesym.create(vs.realname,tt); + abssym.fileinfo:=vs.fileinfo; + abssym.abstyp:=toaddr; + abssym.absseg:=false; + abssym.address:=tordconstnode(pt).value; + if (token=_COLON) and + (target_info.system=system_i386_go32v2) then begin - { we should check the result type of srsym } - if not (tloadnode(pt).symtableentry.typ in [varsym,typedconstsym,funcretsym]) then - Message(parser_e_absolute_only_to_var_or_const); - storetokenpos:=akttokenpos; - akttokenpos:=declarepos; - abssym:=tabsolutesym.create(s,tt); - abssym.abstyp:=tovar; - abssym.ref:=tstoredsym(tloadnode(pt).symtableentry); - symtablestack.insert(abssym); - akttokenpos:=storetokenpos; - symdone:=true; - end - { funcret } - else if (pt.nodetype=funcretn) then - begin - storetokenpos:=akttokenpos; - akttokenpos:=declarepos; - abssym:=tabsolutesym.create(s,tt); - abssym.abstyp:=tovar; - abssym.ref:=tstoredsym(tfuncretnode(pt).funcretsym); - symtablestack.insert(abssym); - akttokenpos:=storetokenpos; - symdone:=true; - end; - { address } - if (not symdone) then - begin - if is_constintnode(pt) and - ((target_info.system=system_i386_go32v2) or - (m_objfpc in aktmodeswitches) or - (m_delphi in aktmodeswitches)) then - begin - storetokenpos:=akttokenpos; - akttokenpos:=declarepos; - abssym:=tabsolutesym.create(s,tt); - abssym.abstyp:=toaddr; - abssym.absseg:=false; - abssym.address:=tordconstnode(pt).value; - if (token=_COLON) and - (target_info.system=system_i386_go32v2) then - begin - consume(token); - pt.free; - pt:=expr; - if is_constintnode(pt) then - begin - abssym.address:=abssym.address shl 4+tordconstnode(pt).value; - abssym.absseg:=true; - end - else - Message(parser_e_absolute_only_to_var_or_const); - end; - symtablestack.insert(abssym); - akttokenpos:=storetokenpos; - symdone := true; - end + consume(token); + pt.free; + pt:=expr; + if is_constintnode(pt) then + begin + abssym.address:=abssym.address shl 4+tordconstnode(pt).value; + abssym.absseg:=true; + end else - Message(parser_e_absolute_only_to_var_or_const); - end + Message(parser_e_absolute_only_to_var_or_const); + end; + symtablestack.replace(vs,abssym); + vs.free; end else - Message(parser_e_absolute_only_to_var_or_const); - if not symdone then - begin - tt := generrortype; - symtablestack.insert(tvarsym.create(s,tt)); - symdone:=true; - end; + Message(parser_e_absolute_only_to_var_or_const); pt.free; + symdone:=true; end; { Handling of Delphi typed const = initialized vars ! } { When should this be rejected ? @@ -318,14 +281,14 @@ implementation not is_record and not is_object then begin - storetokenpos:=akttokenpos; - s:=sc.get(akttokenpos); - if not sc.empty then + vs:=tvarsym(sc.first); + if assigned(vs.listnext) then Message(parser_e_initialized_only_one_var); - tconstsym:=ttypedconstsym.createtype(s,tt,true); - symtablestack.insert(tconstsym); + tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true); + tconstsym.fileinfo:=vs.fileinfo; + symtablestack.replace(vs,tconstsym); + vs.free; symtablestack.insertconstdata(tconstsym); - akttokenpos:=storetokenpos; consume(_EQUAL); readtypedconst(tt,tconstsym,true); symdone:=true; @@ -356,48 +319,46 @@ implementation (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then begin { only allowed for one var } - s:=sc.get(declarepos); - if not sc.empty then - Message(parser_e_absolute_only_one_var); -{$ifdef fixLeaksOnError} - if strContStack.pop <> sc then - writeln('problem with strContStack in pdecl (5)'); -{$endif fixLeaksOnError} - sc.free; + vs:=tvarsym(sc.first); + if assigned(vs.listnext) then + Message(parser_e_absolute_only_one_var); + { set type of the var } + vs.vartype:=tt; { defaults } is_dll:=false; is_cdecl:=false; - extern_aktvarsym:=false; - export_aktvarsym:=false; + extern_var:=false; + export_var:=false; + C_name:=sorg; { cdecl } if idtoken=_CVAR then begin consume(_CVAR); consume(_SEMICOLON); is_cdecl:=true; - C_name:=target_info.Cprefix+C_name; + C_name:=target_info.Cprefix+sorg; end; { external } if idtoken=_EXTERNAL then begin consume(_EXTERNAL); - extern_aktvarsym:=true; + extern_var:=true; end; { export } if idtoken in [_EXPORT,_PUBLIC] then begin consume(_ID); - if extern_aktvarsym or + if extern_var or (symtablestack.symtabletype in [parasymtable,localsymtable]) then Message(parser_e_not_external_and_export) else - export_aktvarsym:=true; + export_var:=true; end; { external and export need a name after when no cdecl is used } if not is_cdecl then begin { dll name ? } - if (extern_aktvarsym) and (idtoken<>_NAME) then + if (extern_var) and (idtoken<>_NAME) then begin is_dll:=true; dll_name:=get_stringconst; @@ -406,32 +367,27 @@ implementation C_name:=get_stringconst; end; { consume the ; when export or external is used } - if extern_aktvarsym or export_aktvarsym then + if extern_var or export_var then consume(_SEMICOLON); - { insert in the symtable } - storetokenpos:=akttokenpos; - akttokenpos:=declarepos; - if is_dll then - aktvarsym:=tvarsym.create_dll(s,tt) - else - aktvarsym:=tvarsym.create_C(s,C_name,tt); { set some vars options } - if export_aktvarsym then + if is_dll then + include(vs.varoptions,vo_is_dll_var) + else + include(vs.varoptions,vo_is_C_var); + vs.set_mangledname(C_Name); + if export_var then begin - inc(aktvarsym.refs); - include(aktvarsym.varoptions,vo_is_exported); + inc(vs.refs); + include(vs.varoptions,vo_is_exported); end; - if extern_aktvarsym then - include(aktvarsym.varoptions,vo_is_external); - { insert in the symtable } - symtablestack.insert(aktvarsym); + if extern_var then + include(vs.varoptions,vo_is_external); { insert in the datasegment when it is not external } - if not extern_aktvarsym then - symtablestack.insertvardata(aktvarsym); - akttokenpos:=storetokenpos; + if not extern_var then + symtablestack.insertvardata(vs); { now we can insert it in the import lib if its a dll, or add it to the externals } - if extern_aktvarsym then + if extern_var then begin if is_dll then begin @@ -440,11 +396,11 @@ implementation current_module.uses_imports:=true; importlib.preparelib(current_module.modulename^); end; - importlib.importvariable(aktvarsym.mangledname,dll_name,C_name) + importlib.importvariable(vs,C_name,dll_name); end else if target_info.DllScanSupported then - current_module.Externals.insert(tExternalsItem.create(aktvarsym.mangledname)); + current_module.Externals.insert(tExternalsItem.create(vs.mangledname)); end; symdone:=true; end @@ -452,7 +408,7 @@ implementation if (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then begin include(current_object_option,sp_static); - insert_syms(symtablestack,sc,tt,false); + insert_syms(sc,tt,false); exclude(current_object_option,sp_static); consume(_STATIC); consume(_SEMICOLON); @@ -476,7 +432,7 @@ implementation Message(parser_e_only_publishable_classes_can__be_published); exclude(current_object_option,sp_published); end; - insert_syms(symtablestack,sc,tt,is_threadvar); + insert_syms(sc,tt,is_threadvar); current_object_option:=old_current_object_option; end; end; @@ -486,8 +442,9 @@ implementation maxsize:=0; maxalignment:=0; consume(_CASE); - s:=pattern; - searchsym(s,srsym,srsymtable); + sorg:=orgpattern; + hs:=pattern; + searchsym(hs,srsym,srsymtable); { may be only a type: } if assigned(srsym) and (srsym.typ in [typesym,unitsym]) then begin @@ -508,9 +465,9 @@ implementation symtablestack:=symtablestack.next; read_type(casetype,''); symtablestack:=oldsymtablestack; - aktvarsym:=tvarsym.create(s,casetype); - symtablestack.insert(aktvarsym); - symtablestack.insertvardata(aktvarsym); + vs:=tvarsym.create(sorg,casetype); + symtablestack.insert(vs); + symtablestack.insertvardata(vs); end; if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def) then Message(type_e_ordinal_expr_expected); @@ -519,6 +476,7 @@ implementation Unionsymtable.next:=symtablestack; registerdef:=false; UnionDef:=trecorddef.create(unionsymtable); + uniondef.isunion:=true; registerdef:=true; symtablestack:=UnionSymtable; startvarrecsize:=symtablestack.datasize; @@ -597,7 +555,15 @@ implementation end. { $Log$ - Revision 1.31 2002-08-25 19:25:20 peter + Revision 1.32 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.31 2002/08/25 19:25:20 peter * sym.insert_in_data removed * symtable.insertvardata/insertconstdata added * removed insert_in_data call from symtable.insert, it needs to be diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 167062a65c..cc62b7234c 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -1185,7 +1185,9 @@ implementation if token=_LKLAMMER then begin consume(_LKLAMMER); - consume_idlist; + repeat + consume(_ID); + until not try_to_consume(_COMMA); consume(_RKLAMMER); end; consume(_SEMICOLON); @@ -1386,7 +1388,15 @@ implementation end. { $Log$ - Revision 1.78 2002-09-07 15:25:07 peter + Revision 1.79 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.78 2002/09/07 15:25:07 peter * old logs removed and tabs fixed Revision 1.77 2002/09/03 16:26:27 daniel diff --git a/compiler/symbase.pas b/compiler/symbase.pas index 88655196cc..cf54664809 100644 --- a/compiler/symbase.pas +++ b/compiler/symbase.pas @@ -116,6 +116,7 @@ interface procedure foreach(proc2call : tnamedindexcallback;arg:pointer); procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer); procedure insert(sym : tsymentry);virtual; + procedure replace(oldsym,newsym:tsymentry); procedure insertvardata(sym : tsymentry);virtual;abstract; procedure insertconstdata(sym : tsymentry);virtual;abstract; function search(const s : stringid) : tsymentry; @@ -242,6 +243,19 @@ implementation end; + procedure tsymtable.replace(oldsym,newsym:tsymentry); + begin + { Replace the entry in the dictionary, this checks + the name } + if not symsearch.replace(oldsym,newsym) then + internalerror(200209061); + { replace in index } + symindex.replace(oldsym,newsym); + { set owner of new symb } + newsym.owner:=self; + end; + + function tsymtable.search(const s : stringid) : tsymentry; begin search:=speedsearch(s,getspeedvalue(s)); @@ -309,7 +323,15 @@ implementation end. { $Log$ - Revision 1.7 2002-08-25 19:25:20 peter + Revision 1.8 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.7 2002/08/25 19:25:20 peter * sym.insert_in_data removed * symtable.insertvardata/insertconstdata added * removed insert_in_data call from symtable.insert, it needs to be diff --git a/compiler/symdef.pas b/compiler/symdef.pas index a91e50eeaf..3ca64c122a 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -208,6 +208,7 @@ interface trecorddef = class(tabstractrecorddef) public + isunion : boolean; constructor create(p : tsymtable); constructor ppuload(ppufile:tcompilerppufile); destructor destroy;override; @@ -2904,6 +2905,7 @@ implementation symtable.dataalignment:=1 else symtable.dataalignment:=aktalignment.recordalignmax; + isunion:=false; end; @@ -2920,6 +2922,7 @@ implementation trecordsymtable(symtable).ppuload(ppufile); read_member:=oldread_member; symtable.defowner:=self; + isunion:=false; end; @@ -2930,6 +2933,7 @@ implementation inherited destroy; end; + function trecorddef.needs_inittable : boolean; begin needs_inittable:=trecordsymtable(symtable).needs_init_final @@ -5537,7 +5541,15 @@ implementation end. { $Log$ - Revision 1.93 2002-09-07 15:25:07 peter + Revision 1.94 2002-09-09 17:34:15 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.93 2002/09/07 15:25:07 peter * old logs removed and tabs fixed Revision 1.92 2002/09/05 19:29:42 peter diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 127f6fbfd4..d31c58846c 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -355,10 +355,6 @@ interface currently called procedure, only set/unset in ncal } - aktvarsym : tvarsym; { pointer to the symbol for the - currently read var, only used - for variable directives } - generrorsym : tsym; otsym : tvarsym; @@ -1102,7 +1098,7 @@ implementation function Tprocsym.search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef; matchtype:Tdefmatch; var pd : pprocdeflist):Tprocdef; - var + var convtyp:tconverttype; a,b:boolean; oldpd : pprocdeflist; @@ -1578,7 +1574,6 @@ implementation constructor tvarsym.create_C(const n,mangled : string;const tt : ttype); begin tvarsym(self).create(n,tt); - include(varoptions,vo_is_C_var); stringdispose(_mangledname); _mangledname:=stringdup(mangled); end; @@ -2500,7 +2495,15 @@ implementation end. { $Log$ - Revision 1.64 2002-09-08 11:10:17 carl + Revision 1.65 2002-09-09 17:34:16 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.64 2002/09/08 11:10:17 carl * bugfix 2109 (bad imho, but only way) Revision 1.63 2002/09/07 18:17:41 florian diff --git a/compiler/symtable.pas b/compiler/symtable.pas index ef75c6fb70..1d8f919ecb 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -1389,14 +1389,15 @@ implementation hsym : tsym; begin { check for duplicate id in para symtable of methods } - if assigned(procinfo._class) and - { but not in nested procedures !} + if assigned(procinfo) and + assigned(procinfo._class) and + { but not in nested procedures !} (not(assigned(procinfo.parent)) or (assigned(procinfo.parent) and not(assigned(procinfo.parent._class))) ) and - { funcretsym is allowed !! } - (sym.typ<>funcretsym) then + { funcretsym is allowed !! } + (sym.typ<>funcretsym) then begin hsym:=search_class_member(procinfo._class,sym.name); { private ids can be reused } @@ -1906,9 +1907,17 @@ implementation findunitsymtable:=st; break; end; - objectsymtable, - recordsymtable : + objectsymtable : st:=st.defowner.owner; + recordsymtable : + begin + { don't continue when the current + symtable is used for variant records } + if trecorddef(st.defowner).isunion then + st:=nil + else + st:=st.defowner.owner; + end; else internalerror(5566562); end; @@ -2299,7 +2308,15 @@ implementation end. { $Log$ - Revision 1.70 2002-09-05 19:29:45 peter + Revision 1.71 2002-09-09 17:34:16 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.70 2002/09/05 19:29:45 peter * memdebug enhancements Revision 1.69 2002/08/25 19:25:21 peter diff --git a/compiler/systems/t_beos.pas b/compiler/systems/t_beos.pas index 776ee22ec0..941133b774 100644 --- a/compiler/systems/t_beos.pas +++ b/compiler/systems/t_beos.pas @@ -28,13 +28,14 @@ unit t_beos; interface uses + symsym, import,export,link; type timportlibbeos=class(timportlib) procedure preparelib(const s:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; - procedure importvariable(const varname,module:string;const name:string);override; + procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; end; @@ -63,7 +64,7 @@ implementation cutils,cclasses, verbose,systems,globtype,globals, symconst,script, - fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,i_beos; + fmodule,aasmbase,aasmtai,aasmcpu,cpubase,i_beos; {***************************************************************************** TIMPORTLIBBEOS @@ -86,13 +87,13 @@ begin end; -procedure timportlibbeos.importvariable(const varname,module:string;const name:string); +procedure timportlibbeos.importvariable(vs:tvarsym;const name,module:string); begin { insert sharedlibrary } current_module.linkothersharedlibs.add(SplitName(module),link_allways); { reset the mangledname and turn off the dll_var option } - aktvarsym.set_mangledname(name); - exclude(aktvarsym.varoptions,vo_is_dll_var); + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); end; @@ -465,7 +466,15 @@ initialization end. { $Log$ - Revision 1.1 2002-09-06 15:03:51 carl + Revision 1.2 2002-09-09 17:34:17 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.1 2002/09/06 15:03:51 carl * moved files to systems directory Revision 1.24 2002/09/03 16:26:28 daniel diff --git a/compiler/systems/t_fbsd.pas b/compiler/systems/t_fbsd.pas index d10e08f290..2aeffa8e7c 100644 --- a/compiler/systems/t_fbsd.pas +++ b/compiler/systems/t_fbsd.pas @@ -42,7 +42,7 @@ implementation timportlibfreebsd=class(timportlib) procedure preparelib(const s:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; - procedure importvariable(const varname,module:string;const name:string);override; + procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; end; @@ -88,13 +88,13 @@ begin end; -procedure timportlibfreebsd.importvariable(const varname,module:string;const name:string); +procedure timportlibfreebsd.importvariable(vs:tvarsym;const name,module:string); begin { insert sharedlibrary } current_module.linkothersharedlibs.add(SplitName(module),link_allways); { reset the mangledname and turn off the dll_var option } - aktvarsym.set_mangledname(name); - exclude(aktvarsym.varoptions,vo_is_dll_var); + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); end; @@ -514,7 +514,15 @@ initialization end. { $Log$ - Revision 1.1 2002-09-06 15:03:51 carl + Revision 1.2 2002-09-09 17:34:17 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.1 2002/09/06 15:03:51 carl * moved files to systems directory Revision 1.29 2002/09/03 16:26:28 daniel diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas index ca350b1d0b..acb4fb88f3 100644 --- a/compiler/systems/t_linux.pas +++ b/compiler/systems/t_linux.pas @@ -28,13 +28,14 @@ unit t_linux; interface uses + symsym, import,export,link; type timportliblinux=class(timportlib) procedure preparelib(const s:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; - procedure importvariable(const varname,module:string;const name:string);override; + procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; end; @@ -64,7 +65,7 @@ implementation cutils,cclasses, verbose,systems,globtype,globals, symconst,script, - fmodule,symsym + fmodule {$ifdef i386} ,aasmbase,aasmtai,aasmcpu,cpubase {$endif i386} @@ -95,13 +96,13 @@ begin end; -procedure timportliblinux.importvariable(const varname,module:string;const name:string); +procedure timportliblinux.importvariable(vs:tvarsym;const name,module:string); begin { insert sharedlibrary } current_module.linkothersharedlibs.add(SplitName(module),link_allways); { reset the mangledname and turn off the dll_var option } - aktvarsym.set_mangledname(name); - exclude(aktvarsym.varoptions,vo_is_dll_var); + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); end; @@ -524,7 +525,15 @@ end. { $Log$ - Revision 1.1 2002-09-06 15:03:51 carl + Revision 1.2 2002-09-09 17:34:17 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.1 2002/09/06 15:03:51 carl * moved files to systems directory Revision 1.33 2002/09/03 16:26:28 daniel diff --git a/compiler/systems/t_nwm.pas b/compiler/systems/t_nwm.pas index 4860963340..8d96ed2e09 100644 --- a/compiler/systems/t_nwm.pas +++ b/compiler/systems/t_nwm.pas @@ -102,7 +102,7 @@ implementation timportlibnetware=class(timportlib) procedure preparelib(const s:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; - procedure importvariable(const varname,module:string;const name:string);override; + procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; end; @@ -147,13 +147,13 @@ begin end; -procedure timportlibnetware.importvariable(const varname,module:string;const name:string); +procedure timportlibnetware.importvariable(vs:tvarsym;const name,module:string); begin { insert sharedlibrary } current_module.linkothersharedlibs.add(SplitName(module),link_allways); { reset the mangledname and turn off the dll_var option } - aktvarsym.set_mangledname(name); - exclude(aktvarsym.varoptions,vo_is_dll_var); + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); end; @@ -484,7 +484,15 @@ initialization end. { $Log$ - Revision 1.1 2002-09-06 15:03:50 carl + Revision 1.2 2002-09-09 17:34:17 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.1 2002/09/06 15:03:50 carl * moved files to systems directory Revision 1.30 2002/09/03 16:26:29 daniel diff --git a/compiler/systems/t_sunos.pas b/compiler/systems/t_sunos.pas index f8b8bc1225..89b9cc2e15 100644 --- a/compiler/systems/t_sunos.pas +++ b/compiler/systems/t_sunos.pas @@ -45,7 +45,7 @@ implementation timportlibsunos=class(timportlib) procedure preparelib(const s:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; - procedure importvariable(const varname,module:string;const name:string);override; + procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; end; @@ -96,13 +96,13 @@ begin end; -procedure timportlibsunos.importvariable(const varname,module:string;const name:string); +procedure timportlibsunos.importvariable(vs:tvarsym;const name,module:string); begin { insert sharedlibrary } current_module.linkothersharedlibs.add(SplitName(module),link_allways); { reset the mangledname and turn off the dll_var option } - aktvarsym.set_mangledname(name); - exclude(aktvarsym.varoptions,vo_is_dll_var); + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); end; @@ -486,7 +486,15 @@ initialization end. { $Log$ - Revision 1.1 2002-09-06 15:03:50 carl + Revision 1.2 2002-09-09 17:34:17 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.1 2002/09/06 15:03:50 carl * moved files to systems directory Revision 1.29 2002/09/03 16:26:29 daniel diff --git a/compiler/systems/t_win32.pas b/compiler/systems/t_win32.pas index 76034f36d2..a820b26686 100644 --- a/compiler/systems/t_win32.pas +++ b/compiler/systems/t_win32.pas @@ -50,10 +50,13 @@ interface pStr4=^tStr4; timportlibwin32=class(timportlib) + private + procedure importvariable_str(const s:string;const name,module:string); + public procedure GetDefExt(var N:longint;var P:pStr4);virtual; procedure preparelib(const s:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; - procedure importvariable(const varname,module:string;const name:string);override; + procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; procedure generatenasmlib;virtual; procedure generatesmartlib;override; @@ -171,7 +174,13 @@ const end; - procedure timportlibwin32.importvariable(const varname,module:string;const name:string); + procedure timportlibwin32.importvariable(vs:tvarsym;const name,module:string); + begin + importvariable_str(vs.mangledname,name,module); + end; + + + procedure timportlibwin32.importvariable_str(const s:string;const name,module:string); var hp1 : timportlist; hp2 : timported_item; @@ -194,7 +203,7 @@ const hp1:=timportlist.create(hs); current_module.imports.concat(hp1); end; - hp2:=timported_item.create_var(varname,name); + hp2:=timported_item.create_var(s,name); hp1.imported_items.concat(hp2); end; @@ -1413,7 +1422,7 @@ function tDLLScannerWin32.GetEdata(HeaderEntry:cardinal):longbool; importlib.preparelib(current_module.modulename^); end; if IsData then - importlib.importvariable(name,_n,name) + timportlibwin32(importlib).importvariable_str(name,_n,name) else importlib.importprocedure(name,_n,index,name); end; @@ -1553,7 +1562,15 @@ initialization end. { $Log$ - Revision 1.1 2002-09-06 15:03:50 carl + Revision 1.2 2002-09-09 17:34:17 peter + * tdicationary.replace added to replace and item in a dictionary. This + is only allowed for the same name + * varsyms are inserted in symtable before the types are parsed. This + fixes the long standing "var longint : longint" bug + - consume_idlist and idstringlist removed. The loops are inserted + at the callers place and uses the symtable for duplicate id checking + + Revision 1.1 2002/09/06 15:03:50 carl * moved files to systems directory Revision 1.40 2002/09/03 16:26:29 daniel