diff --git a/compiler/aasm.pas b/compiler/aasm.pas index e4a2e90f97..600ef6a25b 100644 --- a/compiler/aasm.pas +++ b/compiler/aasm.pas @@ -1055,7 +1055,6 @@ uses if assigned(usedasmsymbollist) then internalerror(78455782); new(usedasmsymbollist,init); - usedasmsymbollist^.noclear:=true; end; @@ -1181,7 +1180,11 @@ uses end. { $Log$ - Revision 1.11 2000-08-27 16:11:48 peter + Revision 1.12 2000-08-27 20:19:38 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.11 2000/08/27 16:11:48 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index 808ad83ddb..27c8c79087 100644 --- a/compiler/cobjects.pas +++ b/compiler/cobjects.pas @@ -245,11 +245,11 @@ unit cobjects; psinglelist=^tsinglelist; tsinglelist=object - noclear : boolean; first, last : Pnamedindexobject; constructor init; destructor done; + procedure reset; procedure clear; procedure insert(p:Pnamedindexobject); end; @@ -1467,14 +1467,18 @@ end; begin first:=nil; last:=nil; - noclear:=false; end; destructor tsinglelist.done; begin - if not noclear then - clear; + end; + + + procedure tsinglelist.reset; + begin + first:=nil; + last:=nil; end; @@ -1868,7 +1872,11 @@ end; end. { $Log$ - Revision 1.11 2000-08-27 16:11:50 peter + Revision 1.12 2000-08-27 20:19:38 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.11 2000/08/27 16:11:50 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/pbase.pas b/compiler/pbase.pas index d2c140cfdd..bd5e209daf 100644 --- a/compiler/pbase.pas +++ b/compiler/pbase.pas @@ -160,12 +160,9 @@ unit pbase; begin sc:=new(pstringcontainer,init); repeat - sc^.insert_with_tokeninfo(pattern, - tokenpos); - consume(_id); - if token=_COMMA then consume(_COMMA) - else break - until false; + sc^.insert_with_tokeninfo(orgpattern,tokenpos); + consume(_ID); + until not try_to_consume(_COMMA); idlist:=sc; end; @@ -197,7 +194,11 @@ end. { $Log$ - Revision 1.3 2000-08-27 16:11:51 peter + Revision 1.4 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.3 2000/08/27 16:11:51 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 9ef32f9351..41ac7b189d 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -268,7 +268,7 @@ unit pdecl; Comment(V_Error,'default value only allowed for one parameter'); sc^.insert_with_tokeninfo(s,hpos); { prefix 'def' to the parameter name } - pdefaultvalue:=ReadConstant('def'+s,hpos); + pdefaultvalue:=ReadConstant('$def'+Upper(s),hpos); if assigned(pdefaultvalue) then pprocdef(aktprocdef)^.parast^.insert(pdefaultvalue); defaultrequired:=true; @@ -328,7 +328,7 @@ unit pdecl; { also need to push a high value? } if inserthigh then begin - hvs:=new(Pvarsym,initdef('high'+s,s32bitdef)); + hvs:=new(Pvarsym,initdef('$high'+Upper(s),s32bitdef)); hvs^.varspez:=vs_const; pprocdef(aktprocdef)^.parast^.insert(hvs); end; @@ -351,10 +351,6 @@ unit pdecl; end; - - - - const variantrecordlevel : longint = 0; @@ -1053,7 +1049,7 @@ unit pdecl; procedure type_dec; var - typename : stringid; + typename,orgtypename : stringid; newtype : ptypesym; sym : psym; tt : ttype; @@ -1066,6 +1062,7 @@ unit pdecl; typecanbeforward:=true; repeat typename:=pattern; + orgtypename:=orgpattern; defpos:=tokenpos; consume(_ID); consume(_EQUAL); @@ -1089,7 +1086,7 @@ unit pdecl; begin { we can ignore the result } { the definition is modified } - object_dec(typename,pobjectdef(ptypesym(sym)^.restype.def)); + object_dec(orgtypename,pobjectdef(ptypesym(sym)^.restype.def)); newtype:=ptypesym(sym); end; end; @@ -1102,12 +1099,12 @@ unit pdecl; will give an error (PFV) } tt.setdef(generrordef); storetokenpos:=tokenpos; - newtype:=new(ptypesym,init(typename,tt)); + newtype:=new(ptypesym,init(orgtypename,tt)); symtablestack^.insert(newtype); tokenpos:=defpos; tokenpos:=storetokenpos; { read the type definition } - read_type(tt,typename); + read_type(tt,orgtypename); { update the definition of the type } newtype^.restype:=tt; if not assigned(tt.sym) then @@ -1299,7 +1296,11 @@ unit pdecl; end. { $Log$ - Revision 1.12 2000-08-27 16:11:51 peter + Revision 1.13 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.12 2000/08/27 16:11:51 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 217427f82b..be6d433679 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -710,7 +710,7 @@ unit pmodules; procedure loadunits; var - s : stringid; + s,sorg : stringid; pu, hp : pused_unit; hp2 : pmodule; @@ -725,6 +725,7 @@ unit pmodules; {$endif DEBUG} repeat s:=pattern; + sorg:=orgpattern; consume(_ID); { Give a warning if objpas is loaded } if s='OBJPAS' then @@ -747,7 +748,7 @@ unit pmodules; pused_unit(current_module^.used_units.last)^.in_uses:=true; if current_module^.compiled then exit; - unitsym:=new(punitsym,init(s,hp2^.globalsymtable)); + unitsym:=new(punitsym,init(sorg,hp2^.globalsymtable)); { never claim about unused unit if there is init or finalize code PM } if (hp2^.flags and (uf_init or uf_finalize))<>0 then @@ -1713,7 +1714,11 @@ unit pmodules; end. { $Log$ - Revision 1.6 2000-08-27 16:11:52 peter + Revision 1.7 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.6 2000/08/27 16:11:52 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/psystem.pas b/compiler/psystem.pas index b1de995825..a12ac05373 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -40,32 +40,32 @@ procedure insertinternsyms(p : psymtable); all intern procedures for system unit } begin - p^.insert(new(psyssym,init('CONCAT',in_concat_x))); - p^.insert(new(psyssym,init('WRITE',in_write_x))); - p^.insert(new(psyssym,init('WRITELN',in_writeln_x))); - p^.insert(new(psyssym,init('ASSIGNED',in_assigned_x))); - p^.insert(new(psyssym,init('READ',in_read_x))); - p^.insert(new(psyssym,init('READLN',in_readln_x))); - p^.insert(new(psyssym,init('OFS',in_ofs_x))); - p^.insert(new(psyssym,init('SIZEOF',in_sizeof_x))); - p^.insert(new(psyssym,init('TYPEOF',in_typeof_x))); - p^.insert(new(psyssym,init('LOW',in_low_x))); - p^.insert(new(psyssym,init('HIGH',in_high_x))); - p^.insert(new(psyssym,init('SEG',in_seg_x))); - p^.insert(new(psyssym,init('ORD',in_ord_x))); - p^.insert(new(psyssym,init('PRED',in_pred_x))); - p^.insert(new(psyssym,init('SUCC',in_succ_x))); - p^.insert(new(psyssym,init('EXCLUDE',in_exclude_x_y))); - p^.insert(new(psyssym,init('INCLUDE',in_include_x_y))); - p^.insert(new(psyssym,init('BREAK',in_break))); - p^.insert(new(psyssym,init('CONTINUE',in_continue))); - p^.insert(new(psyssym,init('DEC',in_dec_x))); - p^.insert(new(psyssym,init('INC',in_inc_x))); - p^.insert(new(psyssym,init('STR',in_str_x_string))); - p^.insert(new(psyssym,init('ASSERT',in_assert_x_y))); - p^.insert(new(psyssym,init('VAL',in_val_x))); - p^.insert(new(psyssym,init('ADDR',in_addr_x))); - p^.insert(new(psyssym,init('TYPEINFO',in_typeinfo_x))); + p^.insert(new(psyssym,init('Concat',in_concat_x))); + p^.insert(new(psyssym,init('Write',in_write_x))); + p^.insert(new(psyssym,init('WriteLn',in_writeln_x))); + p^.insert(new(psyssym,init('Assigned',in_assigned_x))); + p^.insert(new(psyssym,init('Read',in_read_x))); + p^.insert(new(psyssym,init('ReadLn',in_readln_x))); + p^.insert(new(psyssym,init('Ofs',in_ofs_x))); + p^.insert(new(psyssym,init('SizeOf',in_sizeof_x))); + p^.insert(new(psyssym,init('TypeOf',in_typeof_x))); + p^.insert(new(psyssym,init('Low',in_low_x))); + p^.insert(new(psyssym,init('High',in_high_x))); + p^.insert(new(psyssym,init('Seg',in_seg_x))); + p^.insert(new(psyssym,init('Ord',in_ord_x))); + p^.insert(new(psyssym,init('Pred',in_pred_x))); + p^.insert(new(psyssym,init('Succ',in_succ_x))); + p^.insert(new(psyssym,init('Exclude',in_exclude_x_y))); + p^.insert(new(psyssym,init('Include',in_include_x_y))); + p^.insert(new(psyssym,init('Break',in_break))); + p^.insert(new(psyssym,init('Continue',in_continue))); + p^.insert(new(psyssym,init('Dec',in_dec_x))); + p^.insert(new(psyssym,init('Inc',in_inc_x))); + p^.insert(new(psyssym,init('Str',in_str_x_string))); + p^.insert(new(psyssym,init('Assert',in_assert_x_y))); + p^.insert(new(psyssym,init('Val',in_val_x))); + p^.insert(new(psyssym,init('Addr',in_addr_x))); + p^.insert(new(psyssym,init('TypeInfo',in_typeinfo_x))); end; @@ -80,79 +80,79 @@ var vmtsymtable : psymtable; begin { Internal types } - p^.insert(new(ptypesym,initdef('formal',cformaldef))); - p^.insert(new(ptypesym,initdef('void',voiddef))); - p^.insert(new(ptypesym,initdef('byte',u8bitdef))); - p^.insert(new(ptypesym,initdef('word',u16bitdef))); - p^.insert(new(ptypesym,initdef('ulong',u32bitdef))); - p^.insert(new(ptypesym,initdef('longint',s32bitdef))); - p^.insert(new(ptypesym,initdef('qword',cu64bitdef))); - p^.insert(new(ptypesym,initdef('int64',cs64bitdef))); - p^.insert(new(ptypesym,initdef('char',cchardef))); - p^.insert(new(ptypesym,initdef('widechar',cwidechardef))); - p^.insert(new(ptypesym,initdef('shortstring',cshortstringdef))); - p^.insert(new(ptypesym,initdef('longstring',clongstringdef))); - p^.insert(new(ptypesym,initdef('ansistring',cansistringdef))); - p^.insert(new(ptypesym,initdef('widestring',cwidestringdef))); - p^.insert(new(ptypesym,initdef('openshortstring',openshortstringdef))); - p^.insert(new(ptypesym,initdef('boolean',booldef))); - p^.insert(new(ptypesym,initdef('void_pointer',voidpointerdef))); - p^.insert(new(ptypesym,initdef('char_pointer',charpointerdef))); - p^.insert(new(ptypesym,initdef('void_farpointer',voidfarpointerdef))); - p^.insert(new(ptypesym,initdef('openchararray',openchararraydef))); - p^.insert(new(ptypesym,initdef('file',cfiledef))); - p^.insert(new(ptypesym,initdef('s32real',s32floatdef))); - p^.insert(new(ptypesym,initdef('s64real',s64floatdef))); - p^.insert(new(ptypesym,initdef('s80real',s80floatdef))); + p^.insert(new(ptypesym,initdef('$formal',cformaldef))); + p^.insert(new(ptypesym,initdef('$void',voiddef))); + p^.insert(new(ptypesym,initdef('$byte',u8bitdef))); + p^.insert(new(ptypesym,initdef('$word',u16bitdef))); + p^.insert(new(ptypesym,initdef('$ulong',u32bitdef))); + p^.insert(new(ptypesym,initdef('$longint',s32bitdef))); + p^.insert(new(ptypesym,initdef('$qword',cu64bitdef))); + p^.insert(new(ptypesym,initdef('$int64',cs64bitdef))); + p^.insert(new(ptypesym,initdef('$char',cchardef))); + p^.insert(new(ptypesym,initdef('$widechar',cwidechardef))); + p^.insert(new(ptypesym,initdef('$shortstring',cshortstringdef))); + p^.insert(new(ptypesym,initdef('$longstring',clongstringdef))); + p^.insert(new(ptypesym,initdef('$ansistring',cansistringdef))); + p^.insert(new(ptypesym,initdef('$widestring',cwidestringdef))); + p^.insert(new(ptypesym,initdef('$openshortstring',openshortstringdef))); + p^.insert(new(ptypesym,initdef('$boolean',booldef))); + p^.insert(new(ptypesym,initdef('$void_pointer',voidpointerdef))); + p^.insert(new(ptypesym,initdef('$char_pointer',charpointerdef))); + p^.insert(new(ptypesym,initdef('$void_farpointer',voidfarpointerdef))); + p^.insert(new(ptypesym,initdef('$openchararray',openchararraydef))); + p^.insert(new(ptypesym,initdef('$file',cfiledef))); + p^.insert(new(ptypesym,initdef('$s32real',s32floatdef))); + p^.insert(new(ptypesym,initdef('$s64real',s64floatdef))); + p^.insert(new(ptypesym,initdef('$s80real',s80floatdef))); {$ifdef SUPPORT_FIXED} - p^.insert(new(ptypesym,initdef('s32fixed',s32fixeddef))); + p^.insert(new(ptypesym,initdef('$s32fixed',s32fixeddef))); {$endif SUPPORT_FIXED} { Add a type for virtual method tables in lowercase } { so it isn't reachable! } vmtsymtable:=new(psymtable,init(recordsymtable)); vmtdef:=new(precorddef,init(vmtsymtable)); pvmtdef:=new(ppointerdef,initdef(vmtdef)); - vmtsymtable^.insert(new(pvarsym,initdef('parent',pvmtdef))); - vmtsymtable^.insert(new(pvarsym,initdef('length',globaldef('longint')))); - vmtsymtable^.insert(new(pvarsym,initdef('mlength',globaldef('longint')))); + vmtsymtable^.insert(new(pvarsym,initdef('$parent',pvmtdef))); + vmtsymtable^.insert(new(pvarsym,initdef('$length',globaldef('longint')))); + vmtsymtable^.insert(new(pvarsym,initdef('$mlength',globaldef('longint')))); vmtarraydef:=new(parraydef,init(0,1,s32bitdef)); vmtarraydef^.elementtype.setdef(voidpointerdef); - vmtsymtable^.insert(new(pvarsym,initdef('__pfn',vmtarraydef))); - p^.insert(new(ptypesym,initdef('__vtbl_ptr_type',vmtdef))); - p^.insert(new(ptypesym,initdef('pvmt',pvmtdef))); + vmtsymtable^.insert(new(pvarsym,initdef('$__pfn',vmtarraydef))); + p^.insert(new(ptypesym,initdef('$__vtbl_ptr_type',vmtdef))); + p^.insert(new(ptypesym,initdef('$pvmt',pvmtdef))); vmtarraydef:=new(parraydef,init(0,1,s32bitdef)); vmtarraydef^.elementtype.setdef(pvmtdef); - p^.insert(new(ptypesym,initdef('vtblarray',vmtarraydef))); + p^.insert(new(ptypesym,initdef('$vtblarray',vmtarraydef))); insertinternsyms(p); { Normal types } - p^.insert(new(ptypesym,initdef('SINGLE',s32floatdef))); - p^.insert(new(ptypesym,initdef('DOUBLE',s64floatdef))); - p^.insert(new(ptypesym,initdef('EXTENDED',s80floatdef))); - p^.insert(new(ptypesym,initdef('REAL',s64floatdef))); + p^.insert(new(ptypesym,initdef('Single',s32floatdef))); + p^.insert(new(ptypesym,initdef('Double',s64floatdef))); + p^.insert(new(ptypesym,initdef('Extended',s80floatdef))); + p^.insert(new(ptypesym,initdef('Real',s64floatdef))); {$ifdef i386} - p^.insert(new(ptypesym,initdef('COMP',new(pfloatdef,init(s64comp))))); + p^.insert(new(ptypesym,initdef('Comp',new(pfloatdef,init(s64comp))))); {$endif} - p^.insert(new(ptypesym,initdef('POINTER',voidpointerdef))); - p^.insert(new(ptypesym,initdef('FARPOINTER',voidfarpointerdef))); - p^.insert(new(ptypesym,initdef('SHORTSTRING',cshortstringdef))); - p^.insert(new(ptypesym,initdef('LONGSTRING',clongstringdef))); - p^.insert(new(ptypesym,initdef('ANSISTRING',cansistringdef))); - p^.insert(new(ptypesym,initdef('WIDESTRING',cwidestringdef))); - p^.insert(new(ptypesym,initdef('BOOLEAN',booldef))); - p^.insert(new(ptypesym,initdef('BYTEBOOL',booldef))); - p^.insert(new(ptypesym,initdef('WORDBOOL',new(porddef,init(bool16bit,0,1))))); - p^.insert(new(ptypesym,initdef('LONGBOOL',new(porddef,init(bool32bit,0,1))))); - p^.insert(new(ptypesym,initdef('CHAR',cchardef))); - p^.insert(new(ptypesym,initdef('WIDECHAR',cwidechardef))); - p^.insert(new(ptypesym,initdef('TEXT',new(pfiledef,inittext)))); - p^.insert(new(ptypesym,initdef('CARDINAL',u32bitdef))); + p^.insert(new(ptypesym,initdef('Pointer',voidpointerdef))); + p^.insert(new(ptypesym,initdef('FarPointer',voidfarpointerdef))); + p^.insert(new(ptypesym,initdef('ShortString',cshortstringdef))); + p^.insert(new(ptypesym,initdef('LongString',clongstringdef))); + p^.insert(new(ptypesym,initdef('AnsiString',cansistringdef))); + p^.insert(new(ptypesym,initdef('WideString',cwidestringdef))); + p^.insert(new(ptypesym,initdef('Boolean',booldef))); + p^.insert(new(ptypesym,initdef('ByteBool',booldef))); + p^.insert(new(ptypesym,initdef('WordBool',new(porddef,init(bool16bit,0,1))))); + p^.insert(new(ptypesym,initdef('LongBool',new(porddef,init(bool32bit,0,1))))); + p^.insert(new(ptypesym,initdef('Char',cchardef))); + p^.insert(new(ptypesym,initdef('WideChar',cwidechardef))); + p^.insert(new(ptypesym,initdef('Text',new(pfiledef,inittext)))); + p^.insert(new(ptypesym,initdef('Cardinal',u32bitdef))); {$ifdef SUPPORT_FIXED} - p^.insert(new(ptypesym,initdef('FIXED',new(pfloatdef,init(f32bit))))); - p^.insert(new(ptypesym,initdef('FIXED16',new(pfloatdef,init(f16bit))))); + p^.insert(new(ptypesym,initdef('Fixed',new(pfloatdef,init(f32bit))))); + p^.insert(new(ptypesym,initdef('Fixed16',new(pfloatdef,init(f16bit))))); {$endif SUPPORT_FIXED} - p^.insert(new(ptypesym,initdef('QWORD',cu64bitdef))); - p^.insert(new(ptypesym,initdef('INT64',cs64bitdef))); - p^.insert(new(ptypesym,initdef('TYPEDFILE',new(pfiledef,inittypeddef(voiddef))))); + p^.insert(new(ptypesym,initdef('QWord',cu64bitdef))); + p^.insert(new(ptypesym,initdef('Int64',cs64bitdef))); + p^.insert(new(ptypesym,initdef('TypedFile',new(pfiledef,inittypeddef(voiddef))))); end; @@ -250,7 +250,11 @@ end; end. { $Log$ - Revision 1.3 2000-08-16 13:06:06 florian + Revision 1.4 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.3 2000/08/16 13:06:06 florian + support of 64 bit integer constants Revision 1.2 2000/07/13 11:32:47 michael diff --git a/compiler/ptype.pas b/compiler/ptype.pas index a15159e609..150fe1a416 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -322,7 +322,7 @@ uses datacoll:=nil; if token=_ID then begin - p:=new(ppropertysym,init(pattern)); + p:=new(ppropertysym,init(orgpattern)); propname:=pattern; consume(_ID); { property parameters ? } @@ -755,7 +755,7 @@ uses { is the current class tobject? } { so you could define your own tobject } if (cs_compilesystem in aktmoduleswitches) and - (n='TOBJECT') then + (upper(n)='TOBJECT') then begin if assigned(fd) then aktclass:=fd @@ -1080,7 +1080,7 @@ uses aktclass^.symtable^.next:=symtablestack; symtablestack:=aktclass^.symtable; testcurobject:=1; - curobjectname:=n; + curobjectname:=Upper(n); { new procinfo } oldprocinfo:=procinfo; @@ -1460,7 +1460,7 @@ uses l:=-1; aktenumdef:=new(penumdef,init); repeat - s:=pattern; + s:=orgpattern; defpos:=tokenpos; consume(_ID); { only allow assigning of specific numbers under fpc mode } @@ -1481,11 +1481,7 @@ uses tokenpos:=defpos; constsymtable^.insert(new(penumsym,init(s,aktenumdef,l))); tokenpos:=storepos; - if token=_COMMA then - consume(_COMMA) - else - break; - until false; + until not try_to_consume(_COMMA); tt.setdef(aktenumdef); consume(_RKLAMMER); end; @@ -1606,7 +1602,11 @@ uses end. { $Log$ - Revision 1.7 2000-08-27 16:11:52 peter + Revision 1.8 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.7 2000/08/27 16:11:52 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/symdef.inc b/compiler/symdef.inc index e4edfed604..6546177cc0 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -422,7 +422,7 @@ { name } if assigned(typesym) then begin - str:=typesym^.name; + str:=typesym^.realname; rttilist^.concat(new(pai_string,init(chr(length(str))+str))); end else @@ -3138,7 +3138,7 @@ Const local_symtable_index : longint = $8001; s := procsym^.name; if procsym^.owner^.symtabletype=objectsymtable then begin - s2:=pobjectdef(procsym^.owner^.defowner)^.objname^; + s2:=upper(pobjectdef(procsym^.owner^.defowner)^.objname^); case proctypeoption of potype_destructor: s:='_$_'+tostr(length(s2))+s2; @@ -3419,7 +3419,7 @@ Const local_symtable_index : longint = $8001; { it ! } if (childof=nil) and is_class and - (objname^='TOBJECT') then + (upper(objname^)='TOBJECT') then class_tobject:=@self; end; @@ -3644,7 +3644,7 @@ Const local_symtable_index : longint = $8001; if objname=nil then s2:='' else - s2:=objname^; + s2:=Upper(objname^); vmt_mangledname:='VMT_'+s1+'$_'+s2; end; @@ -3660,7 +3660,7 @@ Const local_symtable_index : longint = $8001; if objname=nil then s2:='' else - s2:=objname^; + s2:=Upper(objname^); rtti_name:='RTTI_'+s1+'$_'+s2; end; @@ -3945,8 +3945,8 @@ Const local_symtable_index : longint = $8001; rttilist^.concat(new(pai_const,init_16bit(count))); inc(count); rttilist^.concat(new(pai_const,init_8bit(proctypesinfo))); - rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.name)))); - rttilist^.concat(new(pai_string,init(pvarsym(sym)^.name))); + rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.realname)))); + rttilist^.concat(new(pai_string,init(pvarsym(sym)^.realname))); {$endif dummy} end; propertysym: @@ -3971,8 +3971,8 @@ Const local_symtable_index : longint = $8001; rttilist^.concat(new(pai_const,init_16bit(count))); inc(count); rttilist^.concat(new(pai_const,init_8bit(proctypesinfo))); - rttilist^.concat(new(pai_const,init_8bit(length(ppropertysym(sym)^.name)))); - rttilist^.concat(new(pai_string,init(ppropertysym(sym)^.name))); + rttilist^.concat(new(pai_const,init_8bit(length(ppropertysym(sym)^.realname)))); + rttilist^.concat(new(pai_string,init(ppropertysym(sym)^.realname))); end; else internalerror(1509992); end; @@ -4085,8 +4085,8 @@ Const local_symtable_index : longint = $8001; if not(assigned(hp)) then internalerror(0206002); rttilist^.concat(new(pai_const,init_16bit(hp^.index))); - rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.name)))); - rttilist^.concat(new(pai_string,init(pvarsym(sym)^.name))); + rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.realname)))); + rttilist^.concat(new(pai_string,init(pvarsym(sym)^.realname))); end; end; @@ -4257,7 +4257,11 @@ Const local_symtable_index : longint = $8001; { $Log$ - Revision 1.13 2000-08-27 16:11:53 peter + Revision 1.14 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.13 2000/08/27 16:11:53 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 704783a90d..60550d3464 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -26,7 +26,11 @@ constructor tsym.init(const n : string); begin - inherited initname(n); + if n[1]='$' then + inherited initname(copy(n,2,255)) + else + inherited initname(upper(n)); + _realname:=stringdup(n); typ:=abstractsym; symoptions:=current_object_option; {$ifdef GDB} @@ -50,7 +54,11 @@ begin inherited init; indexnr:=readword; - setname(readstring); + _realname:=stringdup(readstring); + if _realname^[1]='$' then + setname(copy(_realname^,2,255)) + else + setname(upper(_realname^)); typ:=abstractsym; readsmallset(symoptions); readposinfo(fileinfo); @@ -146,11 +154,12 @@ destructor tsym.done; begin - if assigned(defref) then - begin - defref^.freechain; - dispose(defref,done); - end; + if assigned(defref) then + begin + defref^.freechain; + dispose(defref,done); + end; + stringdispose(_realname); inherited done; end; @@ -158,7 +167,7 @@ procedure tsym.write; begin writeword(indexnr); - writestring(name); + writestring(_realname^); writesmallset(symoptions); writeposinfo(fileinfo); end; @@ -174,6 +183,15 @@ end; + function tsym.realname : string; + begin + if assigned(_realname) then + realname:=_realname^ + else + realname:=name; + end; + + function tsym.mangledname : string; begin mangledname:=name; @@ -2208,7 +2226,11 @@ { $Log$ - Revision 1.6 2000-08-21 11:27:44 pierre + Revision 1.7 2000-08-27 20:19:39 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.6 2000/08/21 11:27:44 pierre * fix the stabs problems Revision 1.5 2000/08/16 13:06:07 florian diff --git a/compiler/symsymh.inc b/compiler/symsymh.inc index 0e5ce0ee61..14c03ebc15 100644 --- a/compiler/symsymh.inc +++ b/compiler/symsymh.inc @@ -28,6 +28,7 @@ tsym = object(tsymtableentry) typ : tsymtyp; symoptions : tsymoptions; + _realname : pstring; fileinfo : tfileposinfo; {$ifdef GDB} isstabwritten : boolean; @@ -43,6 +44,7 @@ procedure write;virtual; procedure prederef;virtual; { needed for ttypesym to be deref'd first } procedure deref;virtual; + function realname : string;virtual; function mangledname : string;virtual; procedure insert_in_data;virtual; {$ifdef GDB} @@ -319,7 +321,11 @@ { $Log$ - Revision 1.4 2000-08-16 13:06:07 florian + Revision 1.5 2000-08-27 20:19:40 peter + * store strings with case in ppu, when an internal symbol is created + a '$' is prefixed so it's not automatic uppercased + + Revision 1.4 2000/08/16 13:06:07 florian + support of 64 bit integer constants Revision 1.3 2000/08/13 12:54:56 peter