paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 17:30:38 +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 if assigned(usedasmsymbollist) then
internalerror(78455782); internalerror(78455782);
new(usedasmsymbollist,init); new(usedasmsymbollist,init);
usedasmsymbollist^.noclear:=true;
end; end;
@ -1181,7 +1180,11 @@ uses
end. end.
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * splitted files into finput,fmodule

18
compiler/cobjects.pas
View File

@ -245,11 +245,11 @@ unit cobjects;
psinglelist=^tsinglelist; psinglelist=^tsinglelist;
tsinglelist=object tsinglelist=object
noclear : boolean;
first, first,
last : Pnamedindexobject; last : Pnamedindexobject;
constructor init; constructor init;
destructor done; destructor done;
procedure reset;
procedure clear; procedure clear;
procedure insert(p:Pnamedindexobject); procedure insert(p:Pnamedindexobject);
end; end;
@ -1467,14 +1467,18 @@ end;
begin begin
first:=nil; first:=nil;
last:=nil; last:=nil;
noclear:=false;
end; end;
destructor tsinglelist.done; destructor tsinglelist.done;
begin begin
if not noclear then end;
clear;
procedure tsinglelist.reset;
begin
first:=nil;
last:=nil;
end; end;
@ -1868,7 +1872,11 @@ end;
end. end.
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * splitted files into finput,fmodule

15
compiler/pbase.pas
View File

@ -160,12 +160,9 @@ unit pbase;
begin begin
sc:=new(pstringcontainer,init); sc:=new(pstringcontainer,init);
repeat repeat
sc^.insert_with_tokeninfo(pattern, sc^.insert_with_tokeninfo(orgpattern,tokenpos);
tokenpos); consume(_ID);
consume(_id); until not try_to_consume(_COMMA);
if token=_COMMA then consume(_COMMA)
else break
until false;
idlist:=sc; idlist:=sc;
end; end;
@ -197,7 +194,11 @@ end.
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * 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'); Comment(V_Error,'default value only allowed for one parameter');
sc^.insert_with_tokeninfo(s,hpos); sc^.insert_with_tokeninfo(s,hpos);
{ prefix 'def' to the parameter name } { prefix 'def' to the parameter name }
pdefaultvalue:=ReadConstant('def'+s,hpos); pdefaultvalue:=ReadConstant('$def'+Upper(s),hpos);
if assigned(pdefaultvalue) then if assigned(pdefaultvalue) then
pprocdef(aktprocdef)^.parast^.insert(pdefaultvalue); pprocdef(aktprocdef)^.parast^.insert(pdefaultvalue);
defaultrequired:=true; defaultrequired:=true;
@ -328,7 +328,7 @@ unit pdecl;
{ also need to push a high value? } { also need to push a high value? }
if inserthigh then if inserthigh then
begin begin
hvs:=new(Pvarsym,initdef('high'+s,s32bitdef)); hvs:=new(Pvarsym,initdef('$high'+Upper(s),s32bitdef));
hvs^.varspez:=vs_const; hvs^.varspez:=vs_const;
pprocdef(aktprocdef)^.parast^.insert(hvs); pprocdef(aktprocdef)^.parast^.insert(hvs);
end; end;
@ -351,10 +351,6 @@ unit pdecl;
end; end;
const const
variantrecordlevel : longint = 0; variantrecordlevel : longint = 0;
@ -1053,7 +1049,7 @@ unit pdecl;
procedure type_dec; procedure type_dec;
var var
typename : stringid; typename,orgtypename : stringid;
newtype : ptypesym; newtype : ptypesym;
sym : psym; sym : psym;
tt : ttype; tt : ttype;
@ -1066,6 +1062,7 @@ unit pdecl;
typecanbeforward:=true; typecanbeforward:=true;
repeat repeat
typename:=pattern; typename:=pattern;
orgtypename:=orgpattern;
defpos:=tokenpos; defpos:=tokenpos;
consume(_ID); consume(_ID);
consume(_EQUAL); consume(_EQUAL);
@ -1089,7 +1086,7 @@ unit pdecl;
begin begin
{ we can ignore the result } { we can ignore the result }
{ the definition is modified } { the definition is modified }
object_dec(typename,pobjectdef(ptypesym(sym)^.restype.def)); object_dec(orgtypename,pobjectdef(ptypesym(sym)^.restype.def));
newtype:=ptypesym(sym); newtype:=ptypesym(sym);
end; end;
end; end;
@ -1102,12 +1099,12 @@ unit pdecl;
will give an error (PFV) } will give an error (PFV) }
tt.setdef(generrordef); tt.setdef(generrordef);
storetokenpos:=tokenpos; storetokenpos:=tokenpos;
newtype:=new(ptypesym,init(typename,tt)); newtype:=new(ptypesym,init(orgtypename,tt));
symtablestack^.insert(newtype); symtablestack^.insert(newtype);
tokenpos:=defpos; tokenpos:=defpos;
tokenpos:=storetokenpos; tokenpos:=storetokenpos;
{ read the type definition } { read the type definition }
read_type(tt,typename); read_type(tt,orgtypename);
{ update the definition of the type } { update the definition of the type }
newtype^.restype:=tt; newtype^.restype:=tt;
if not assigned(tt.sym) then if not assigned(tt.sym) then
@ -1299,7 +1296,11 @@ unit pdecl;
end. end.
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * splitted files into finput,fmodule

11
compiler/pmodules.pas
View File

@ -710,7 +710,7 @@ unit pmodules;
procedure loadunits; procedure loadunits;
var var
s : stringid; s,sorg : stringid;
pu, pu,
hp : pused_unit; hp : pused_unit;
hp2 : pmodule; hp2 : pmodule;
@ -725,6 +725,7 @@ unit pmodules;
{$endif DEBUG} {$endif DEBUG}
repeat repeat
s:=pattern; s:=pattern;
sorg:=orgpattern;
consume(_ID); consume(_ID);
{ Give a warning if objpas is loaded } { Give a warning if objpas is loaded }
if s='OBJPAS' then if s='OBJPAS' then
@ -747,7 +748,7 @@ unit pmodules;
pused_unit(current_module^.used_units.last)^.in_uses:=true; pused_unit(current_module^.used_units.last)^.in_uses:=true;
if current_module^.compiled then if current_module^.compiled then
exit; exit;
unitsym:=new(punitsym,init(s,hp2^.globalsymtable)); unitsym:=new(punitsym,init(sorg,hp2^.globalsymtable));
{ never claim about unused unit if { never claim about unused unit if
there is init or finalize code PM } there is init or finalize code PM }
if (hp2^.flags and (uf_init or uf_finalize))<>0 then if (hp2^.flags and (uf_init or uf_finalize))<>0 then
@ -1713,7 +1714,11 @@ unit pmodules;
end. end.
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * 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 all intern procedures for system unit
} }
begin begin
p^.insert(new(psyssym,init('CONCAT',in_concat_x))); p^.insert(new(psyssym,init('Concat',in_concat_x)));
p^.insert(new(psyssym,init('WRITE',in_write_x))); p^.insert(new(psyssym,init('Write',in_write_x)));
p^.insert(new(psyssym,init('WRITELN',in_writeln_x))); p^.insert(new(psyssym,init('WriteLn',in_writeln_x)));
p^.insert(new(psyssym,init('ASSIGNED',in_assigned_x))); p^.insert(new(psyssym,init('Assigned',in_assigned_x)));
p^.insert(new(psyssym,init('READ',in_read_x))); p^.insert(new(psyssym,init('Read',in_read_x)));
p^.insert(new(psyssym,init('READLN',in_readln_x))); p^.insert(new(psyssym,init('ReadLn',in_readln_x)));
p^.insert(new(psyssym,init('OFS',in_ofs_x))); p^.insert(new(psyssym,init('Ofs',in_ofs_x)));
p^.insert(new(psyssym,init('SIZEOF',in_sizeof_x))); p^.insert(new(psyssym,init('SizeOf',in_sizeof_x)));
p^.insert(new(psyssym,init('TYPEOF',in_typeof_x))); p^.insert(new(psyssym,init('TypeOf',in_typeof_x)));
p^.insert(new(psyssym,init('LOW',in_low_x))); p^.insert(new(psyssym,init('Low',in_low_x)));
p^.insert(new(psyssym,init('HIGH',in_high_x))); p^.insert(new(psyssym,init('High',in_high_x)));
p^.insert(new(psyssym,init('SEG',in_seg_x))); p^.insert(new(psyssym,init('Seg',in_seg_x)));
p^.insert(new(psyssym,init('ORD',in_ord_x))); p^.insert(new(psyssym,init('Ord',in_ord_x)));
p^.insert(new(psyssym,init('PRED',in_pred_x))); p^.insert(new(psyssym,init('Pred',in_pred_x)));
p^.insert(new(psyssym,init('SUCC',in_succ_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('Exclude',in_exclude_x_y)));
p^.insert(new(psyssym,init('INCLUDE',in_include_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('Break',in_break)));
p^.insert(new(psyssym,init('CONTINUE',in_continue))); p^.insert(new(psyssym,init('Continue',in_continue)));
p^.insert(new(psyssym,init('DEC',in_dec_x))); p^.insert(new(psyssym,init('Dec',in_dec_x)));
p^.insert(new(psyssym,init('INC',in_inc_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('Str',in_str_x_string)));
p^.insert(new(psyssym,init('ASSERT',in_assert_x_y))); p^.insert(new(psyssym,init('Assert',in_assert_x_y)));
p^.insert(new(psyssym,init('VAL',in_val_x))); p^.insert(new(psyssym,init('Val',in_val_x)));
p^.insert(new(psyssym,init('ADDR',in_addr_x))); p^.insert(new(psyssym,init('Addr',in_addr_x)));
p^.insert(new(psyssym,init('TYPEINFO',in_typeinfo_x))); p^.insert(new(psyssym,init('TypeInfo',in_typeinfo_x)));
end; end;
@ -80,79 +80,79 @@ var
vmtsymtable : psymtable; vmtsymtable : psymtable;
begin begin
{ Internal types } { Internal types }
p^.insert(new(ptypesym,initdef('formal',cformaldef))); p^.insert(new(ptypesym,initdef('$formal',cformaldef)));
p^.insert(new(ptypesym,initdef('void',voiddef))); p^.insert(new(ptypesym,initdef('$void',voiddef)));
p^.insert(new(ptypesym,initdef('byte',u8bitdef))); p^.insert(new(ptypesym,initdef('$byte',u8bitdef)));
p^.insert(new(ptypesym,initdef('word',u16bitdef))); p^.insert(new(ptypesym,initdef('$word',u16bitdef)));
p^.insert(new(ptypesym,initdef('ulong',u32bitdef))); p^.insert(new(ptypesym,initdef('$ulong',u32bitdef)));
p^.insert(new(ptypesym,initdef('longint',s32bitdef))); p^.insert(new(ptypesym,initdef('$longint',s32bitdef)));
p^.insert(new(ptypesym,initdef('qword',cu64bitdef))); p^.insert(new(ptypesym,initdef('$qword',cu64bitdef)));
p^.insert(new(ptypesym,initdef('int64',cs64bitdef))); p^.insert(new(ptypesym,initdef('$int64',cs64bitdef)));
p^.insert(new(ptypesym,initdef('char',cchardef))); p^.insert(new(ptypesym,initdef('$char',cchardef)));
p^.insert(new(ptypesym,initdef('widechar',cwidechardef))); p^.insert(new(ptypesym,initdef('$widechar',cwidechardef)));
p^.insert(new(ptypesym,initdef('shortstring',cshortstringdef))); p^.insert(new(ptypesym,initdef('$shortstring',cshortstringdef)));
p^.insert(new(ptypesym,initdef('longstring',clongstringdef))); p^.insert(new(ptypesym,initdef('$longstring',clongstringdef)));
p^.insert(new(ptypesym,initdef('ansistring',cansistringdef))); p^.insert(new(ptypesym,initdef('$ansistring',cansistringdef)));
p^.insert(new(ptypesym,initdef('widestring',cwidestringdef))); p^.insert(new(ptypesym,initdef('$widestring',cwidestringdef)));
p^.insert(new(ptypesym,initdef('openshortstring',openshortstringdef))); p^.insert(new(ptypesym,initdef('$openshortstring',openshortstringdef)));
p^.insert(new(ptypesym,initdef('boolean',booldef))); p^.insert(new(ptypesym,initdef('$boolean',booldef)));
p^.insert(new(ptypesym,initdef('void_pointer',voidpointerdef))); p^.insert(new(ptypesym,initdef('$void_pointer',voidpointerdef)));
p^.insert(new(ptypesym,initdef('char_pointer',charpointerdef))); p^.insert(new(ptypesym,initdef('$char_pointer',charpointerdef)));
p^.insert(new(ptypesym,initdef('void_farpointer',voidfarpointerdef))); p^.insert(new(ptypesym,initdef('$void_farpointer',voidfarpointerdef)));
p^.insert(new(ptypesym,initdef('openchararray',openchararraydef))); p^.insert(new(ptypesym,initdef('$openchararray',openchararraydef)));
p^.insert(new(ptypesym,initdef('file',cfiledef))); p^.insert(new(ptypesym,initdef('$file',cfiledef)));
p^.insert(new(ptypesym,initdef('s32real',s32floatdef))); p^.insert(new(ptypesym,initdef('$s32real',s32floatdef)));
p^.insert(new(ptypesym,initdef('s64real',s64floatdef))); p^.insert(new(ptypesym,initdef('$s64real',s64floatdef)));
p^.insert(new(ptypesym,initdef('s80real',s80floatdef))); p^.insert(new(ptypesym,initdef('$s80real',s80floatdef)));
{$ifdef SUPPORT_FIXED} {$ifdef SUPPORT_FIXED}
p^.insert(new(ptypesym,initdef('s32fixed',s32fixeddef))); p^.insert(new(ptypesym,initdef('$s32fixed',s32fixeddef)));
{$endif SUPPORT_FIXED} {$endif SUPPORT_FIXED}
{ Add a type for virtual method tables in lowercase } { Add a type for virtual method tables in lowercase }
{ so it isn't reachable! } { so it isn't reachable! }
vmtsymtable:=new(psymtable,init(recordsymtable)); vmtsymtable:=new(psymtable,init(recordsymtable));
vmtdef:=new(precorddef,init(vmtsymtable)); vmtdef:=new(precorddef,init(vmtsymtable));
pvmtdef:=new(ppointerdef,initdef(vmtdef)); pvmtdef:=new(ppointerdef,initdef(vmtdef));
vmtsymtable^.insert(new(pvarsym,initdef('parent',pvmtdef))); vmtsymtable^.insert(new(pvarsym,initdef('$parent',pvmtdef)));
vmtsymtable^.insert(new(pvarsym,initdef('length',globaldef('longint')))); vmtsymtable^.insert(new(pvarsym,initdef('$length',globaldef('longint'))));
vmtsymtable^.insert(new(pvarsym,initdef('mlength',globaldef('longint')))); vmtsymtable^.insert(new(pvarsym,initdef('$mlength',globaldef('longint'))));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef)); vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.elementtype.setdef(voidpointerdef); vmtarraydef^.elementtype.setdef(voidpointerdef);
vmtsymtable^.insert(new(pvarsym,initdef('__pfn',vmtarraydef))); vmtsymtable^.insert(new(pvarsym,initdef('$__pfn',vmtarraydef)));
p^.insert(new(ptypesym,initdef('__vtbl_ptr_type',vmtdef))); p^.insert(new(ptypesym,initdef('$__vtbl_ptr_type',vmtdef)));
p^.insert(new(ptypesym,initdef('pvmt',pvmtdef))); p^.insert(new(ptypesym,initdef('$pvmt',pvmtdef)));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef)); vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.elementtype.setdef(pvmtdef); vmtarraydef^.elementtype.setdef(pvmtdef);
p^.insert(new(ptypesym,initdef('vtblarray',vmtarraydef))); p^.insert(new(ptypesym,initdef('$vtblarray',vmtarraydef)));
insertinternsyms(p); insertinternsyms(p);
{ Normal types } { Normal types }
p^.insert(new(ptypesym,initdef('SINGLE',s32floatdef))); p^.insert(new(ptypesym,initdef('Single',s32floatdef)));
p^.insert(new(ptypesym,initdef('DOUBLE',s64floatdef))); p^.insert(new(ptypesym,initdef('Double',s64floatdef)));
p^.insert(new(ptypesym,initdef('EXTENDED',s80floatdef))); p^.insert(new(ptypesym,initdef('Extended',s80floatdef)));
p^.insert(new(ptypesym,initdef('REAL',s64floatdef))); p^.insert(new(ptypesym,initdef('Real',s64floatdef)));
{$ifdef i386} {$ifdef i386}
p^.insert(new(ptypesym,initdef('COMP',new(pfloatdef,init(s64comp))))); p^.insert(new(ptypesym,initdef('Comp',new(pfloatdef,init(s64comp)))));
{$endif} {$endif}
p^.insert(new(ptypesym,initdef('POINTER',voidpointerdef))); p^.insert(new(ptypesym,initdef('Pointer',voidpointerdef)));
p^.insert(new(ptypesym,initdef('FARPOINTER',voidfarpointerdef))); p^.insert(new(ptypesym,initdef('FarPointer',voidfarpointerdef)));
p^.insert(new(ptypesym,initdef('SHORTSTRING',cshortstringdef))); p^.insert(new(ptypesym,initdef('ShortString',cshortstringdef)));
p^.insert(new(ptypesym,initdef('LONGSTRING',clongstringdef))); p^.insert(new(ptypesym,initdef('LongString',clongstringdef)));
p^.insert(new(ptypesym,initdef('ANSISTRING',cansistringdef))); p^.insert(new(ptypesym,initdef('AnsiString',cansistringdef)));
p^.insert(new(ptypesym,initdef('WIDESTRING',cwidestringdef))); p^.insert(new(ptypesym,initdef('WideString',cwidestringdef)));
p^.insert(new(ptypesym,initdef('BOOLEAN',booldef))); p^.insert(new(ptypesym,initdef('Boolean',booldef)));
p^.insert(new(ptypesym,initdef('BYTEBOOL',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('WordBool',new(porddef,init(bool16bit,0,1)))));
p^.insert(new(ptypesym,initdef('LONGBOOL',new(porddef,init(bool32bit,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('Char',cchardef)));
p^.insert(new(ptypesym,initdef('WIDECHAR',cwidechardef))); p^.insert(new(ptypesym,initdef('WideChar',cwidechardef)));
p^.insert(new(ptypesym,initdef('TEXT',new(pfiledef,inittext)))); p^.insert(new(ptypesym,initdef('Text',new(pfiledef,inittext))));
p^.insert(new(ptypesym,initdef('CARDINAL',u32bitdef))); p^.insert(new(ptypesym,initdef('Cardinal',u32bitdef)));
{$ifdef SUPPORT_FIXED} {$ifdef SUPPORT_FIXED}
p^.insert(new(ptypesym,initdef('FIXED',new(pfloatdef,init(f32bit))))); 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('Fixed16',new(pfloatdef,init(f16bit)))));
{$endif SUPPORT_FIXED} {$endif SUPPORT_FIXED}
p^.insert(new(ptypesym,initdef('QWORD',cu64bitdef))); p^.insert(new(ptypesym,initdef('QWord',cu64bitdef)));
p^.insert(new(ptypesym,initdef('INT64',cs64bitdef))); p^.insert(new(ptypesym,initdef('Int64',cs64bitdef)));
p^.insert(new(ptypesym,initdef('TYPEDFILE',new(pfiledef,inittypeddef(voiddef))))); p^.insert(new(ptypesym,initdef('TypedFile',new(pfiledef,inittypeddef(voiddef)))));
end; end;
@ -250,7 +250,11 @@ end;
end. end.
{ {
$Log$ $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 + support of 64 bit integer constants
Revision 1.2 2000/07/13 11:32:47 michael Revision 1.2 2000/07/13 11:32:47 michael

20
compiler/ptype.pas
View File

@ -322,7 +322,7 @@ uses
datacoll:=nil; datacoll:=nil;
if token=_ID then if token=_ID then
begin begin
p:=new(ppropertysym,init(pattern)); p:=new(ppropertysym,init(orgpattern));
propname:=pattern; propname:=pattern;
consume(_ID); consume(_ID);
{ property parameters ? } { property parameters ? }
@ -755,7 +755,7 @@ uses
{ is the current class tobject? } { is the current class tobject? }
{ so you could define your own tobject } { so you could define your own tobject }
if (cs_compilesystem in aktmoduleswitches) and if (cs_compilesystem in aktmoduleswitches) and
(n='TOBJECT') then (upper(n)='TOBJECT') then
begin begin
if assigned(fd) then if assigned(fd) then
aktclass:=fd aktclass:=fd
@ -1080,7 +1080,7 @@ uses
aktclass^.symtable^.next:=symtablestack; aktclass^.symtable^.next:=symtablestack;
symtablestack:=aktclass^.symtable; symtablestack:=aktclass^.symtable;
testcurobject:=1; testcurobject:=1;
curobjectname:=n; curobjectname:=Upper(n);
{ new procinfo } { new procinfo }
oldprocinfo:=procinfo; oldprocinfo:=procinfo;
@ -1460,7 +1460,7 @@ uses
l:=-1; l:=-1;
aktenumdef:=new(penumdef,init); aktenumdef:=new(penumdef,init);
repeat repeat
s:=pattern; s:=orgpattern;
defpos:=tokenpos; defpos:=tokenpos;
consume(_ID); consume(_ID);
{ only allow assigning of specific numbers under fpc mode } { only allow assigning of specific numbers under fpc mode }
@ -1481,11 +1481,7 @@ uses
tokenpos:=defpos; tokenpos:=defpos;
constsymtable^.insert(new(penumsym,init(s,aktenumdef,l))); constsymtable^.insert(new(penumsym,init(s,aktenumdef,l)));
tokenpos:=storepos; tokenpos:=storepos;
if token=_COMMA then until not try_to_consume(_COMMA);
consume(_COMMA)
else
break;
until false;
tt.setdef(aktenumdef); tt.setdef(aktenumdef);
consume(_RKLAMMER); consume(_RKLAMMER);
end; end;
@ -1606,7 +1602,11 @@ uses
end. end.
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * splitted files into finput,fmodule

28
compiler/symdef.inc
View File

@ -422,7 +422,7 @@
{ name } { name }
if assigned(typesym) then if assigned(typesym) then
begin begin
str:=typesym^.name; str:=typesym^.realname;
rttilist^.concat(new(pai_string,init(chr(length(str))+str))); rttilist^.concat(new(pai_string,init(chr(length(str))+str)));
end end
else else
@ -3138,7 +3138,7 @@ Const local_symtable_index : longint = $8001;
s := procsym^.name; s := procsym^.name;
if procsym^.owner^.symtabletype=objectsymtable then if procsym^.owner^.symtabletype=objectsymtable then
begin begin
s2:=pobjectdef(procsym^.owner^.defowner)^.objname^; s2:=upper(pobjectdef(procsym^.owner^.defowner)^.objname^);
case proctypeoption of case proctypeoption of
potype_destructor: potype_destructor:
s:='_$_'+tostr(length(s2))+s2; s:='_$_'+tostr(length(s2))+s2;
@ -3419,7 +3419,7 @@ Const local_symtable_index : longint = $8001;
{ it ! } { it ! }
if (childof=nil) and if (childof=nil) and
is_class and is_class and
(objname^='TOBJECT') then (upper(objname^)='TOBJECT') then
class_tobject:=@self; class_tobject:=@self;
end; end;
@ -3644,7 +3644,7 @@ Const local_symtable_index : longint = $8001;
if objname=nil then if objname=nil then
s2:='' s2:=''
else else
s2:=objname^; s2:=Upper(objname^);
vmt_mangledname:='VMT_'+s1+'$_'+s2; vmt_mangledname:='VMT_'+s1+'$_'+s2;
end; end;
@ -3660,7 +3660,7 @@ Const local_symtable_index : longint = $8001;
if objname=nil then if objname=nil then
s2:='' s2:=''
else else
s2:=objname^; s2:=Upper(objname^);
rtti_name:='RTTI_'+s1+'$_'+s2; rtti_name:='RTTI_'+s1+'$_'+s2;
end; end;
@ -3945,8 +3945,8 @@ Const local_symtable_index : longint = $8001;
rttilist^.concat(new(pai_const,init_16bit(count))); rttilist^.concat(new(pai_const,init_16bit(count)));
inc(count); inc(count);
rttilist^.concat(new(pai_const,init_8bit(proctypesinfo))); rttilist^.concat(new(pai_const,init_8bit(proctypesinfo)));
rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.name)))); rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.realname))));
rttilist^.concat(new(pai_string,init(pvarsym(sym)^.name))); rttilist^.concat(new(pai_string,init(pvarsym(sym)^.realname)));
{$endif dummy} {$endif dummy}
end; end;
propertysym: propertysym:
@ -3971,8 +3971,8 @@ Const local_symtable_index : longint = $8001;
rttilist^.concat(new(pai_const,init_16bit(count))); rttilist^.concat(new(pai_const,init_16bit(count)));
inc(count); inc(count);
rttilist^.concat(new(pai_const,init_8bit(proctypesinfo))); rttilist^.concat(new(pai_const,init_8bit(proctypesinfo)));
rttilist^.concat(new(pai_const,init_8bit(length(ppropertysym(sym)^.name)))); rttilist^.concat(new(pai_const,init_8bit(length(ppropertysym(sym)^.realname))));
rttilist^.concat(new(pai_string,init(ppropertysym(sym)^.name))); rttilist^.concat(new(pai_string,init(ppropertysym(sym)^.realname)));
end; end;
else internalerror(1509992); else internalerror(1509992);
end; end;
@ -4085,8 +4085,8 @@ Const local_symtable_index : longint = $8001;
if not(assigned(hp)) then if not(assigned(hp)) then
internalerror(0206002); internalerror(0206002);
rttilist^.concat(new(pai_const,init_16bit(hp^.index))); rttilist^.concat(new(pai_const,init_16bit(hp^.index)));
rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.name)))); rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.realname))));
rttilist^.concat(new(pai_string,init(pvarsym(sym)^.name))); rttilist^.concat(new(pai_string,init(pvarsym(sym)^.realname)));
end; end;
end; end;
@ -4257,7 +4257,11 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $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 * moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule * splitted files into finput,fmodule

40
compiler/symsym.inc
View File

@ -26,7 +26,11 @@
constructor tsym.init(const n : string); constructor tsym.init(const n : string);
begin begin
inherited initname(n); if n[1]='$' then
inherited initname(copy(n,2,255))
else
inherited initname(upper(n));
_realname:=stringdup(n);
typ:=abstractsym; typ:=abstractsym;
symoptions:=current_object_option; symoptions:=current_object_option;
{$ifdef GDB} {$ifdef GDB}
@ -50,7 +54,11 @@
begin begin
inherited init; inherited init;
indexnr:=readword; indexnr:=readword;
setname(readstring); _realname:=stringdup(readstring);
if _realname^[1]='$' then
setname(copy(_realname^,2,255))
else
setname(upper(_realname^));
typ:=abstractsym; typ:=abstractsym;
readsmallset(symoptions); readsmallset(symoptions);
readposinfo(fileinfo); readposinfo(fileinfo);
@ -146,11 +154,12 @@
destructor tsym.done; destructor tsym.done;
begin begin
if assigned(defref) then if assigned(defref) then
begin begin
defref^.freechain; defref^.freechain;
dispose(defref,done); dispose(defref,done);
end; end;
stringdispose(_realname);
inherited done; inherited done;
end; end;
@ -158,7 +167,7 @@
procedure tsym.write; procedure tsym.write;
begin begin
writeword(indexnr); writeword(indexnr);
writestring(name); writestring(_realname^);
writesmallset(symoptions); writesmallset(symoptions);
writeposinfo(fileinfo); writeposinfo(fileinfo);
end; end;
@ -174,6 +183,15 @@
end; end;
function tsym.realname : string;
begin
if assigned(_realname) then
realname:=_realname^
else
realname:=name;
end;
function tsym.mangledname : string; function tsym.mangledname : string;
begin begin
mangledname:=name; mangledname:=name;
@ -2208,7 +2226,11 @@
{ {
$Log$ $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 * fix the stabs problems
Revision 1.5 2000/08/16 13:06:07 florian Revision 1.5 2000/08/16 13:06:07 florian

8
compiler/symsymh.inc
View File

@ -28,6 +28,7 @@
tsym = object(tsymtableentry) tsym = object(tsymtableentry)
typ : tsymtyp; typ : tsymtyp;
symoptions : tsymoptions; symoptions : tsymoptions;
_realname : pstring;
fileinfo : tfileposinfo; fileinfo : tfileposinfo;
{$ifdef GDB} {$ifdef GDB}
isstabwritten : boolean; isstabwritten : boolean;
@ -43,6 +44,7 @@
procedure write;virtual; procedure write;virtual;
procedure prederef;virtual; { needed for ttypesym to be deref'd first } procedure prederef;virtual; { needed for ttypesym to be deref'd first }
procedure deref;virtual; procedure deref;virtual;
function realname : string;virtual;
function mangledname : string;virtual; function mangledname : string;virtual;
procedure insert_in_data;virtual; procedure insert_in_data;virtual;
{$ifdef GDB} {$ifdef GDB}
@ -319,7 +321,11 @@
{ {
$Log$ $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 + support of 64 bit integer constants
Revision 1.3 2000/08/13 12:54:56 peter Revision 1.3 2000/08/13 12:54:56 peter