paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 04:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* store strings with case in ppu, when an internal symbol is created

Browse Source 
a '$' is prefixed so it's not automatic uppercased
This commit is contained in:
peter 2000-08-27 20:19:38 +00:00
parent 4c94659743
commit bec1c5cdf9
10 changed files with 197 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/aasm.pas
View File

@ -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

18
compiler/cobjects.pas
View File

@ -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

15
compiler/pbase.pas
View File

@ -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

23
compiler/pdecl.pas
View File

@ -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

11
compiler/pmodules.pas
View File

@ -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

170
compiler/psystem.pas
View File

@ -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

20
compiler/ptype.pas
View File

@ -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

28
compiler/symdef.inc
View File

@ -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

40
compiler/symsym.inc
View File

@ -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

8
compiler/symsymh.inc
View File

@ -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