paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 10:39:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* unit names and procedure names are stored mixed case

Browse Source
This commit is contained in:
peter 2000-10-15 07:47:51 +00:00
parent 0ddba9e6cd
commit eb3ca9c51d
12 changed files with 137 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/browcol.pas
View File

@ -38,7 +38,7 @@ const
SymbolTypLen : sw_integer = 6; SymbolTypLen : sw_integer = 6;
RecordTypes : set of tsymtyp = RecordTypes : set of tsymtyp =
([typesym,unitsym,programsym]); ([typesym,unitsym]);
sfRecord = $00000001; sfRecord = $00000001;
sfObject = $00000002; sfObject = $00000002;
@ -766,7 +766,6 @@ begin
else else
S:='func'; S:='func';
unitsym : S:='unit'; unitsym : S:='unit';
programsym : S:='prog';
constsym : S:='const'; constsym : S:='const';
enumsym : S:='enum'; enumsym : S:='enum';
typedconstsym: S:='const'; typedconstsym: S:='const';
@ -2094,7 +2093,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.9 2000-09-24 15:06:11 peter Revision 1.10 2000-10-15 07:47:51 peter
* unit names and procedure names are stored mixed case
Revision 1.9 2000/09/24 15:06:11 peter
* use defines.inc * use defines.inc
Revision 1.8 2000/09/11 17:00:22 florian Revision 1.8 2000/09/11 17:00:22 florian
@ -2121,4 +2123,4 @@ end.
Revision 1.2 2000/07/13 11:32:32 michael Revision 1.2 2000/07/13 11:32:32 michael
+ removed logs + removed logs
} }

26
compiler/fmodule.pas
View File

@ -132,6 +132,7 @@ interface
path, { path where the module is find/created } path, { path where the module is find/created }
outputpath, { path where the .s / .o / exe are created } outputpath, { path where the .s / .o / exe are created }
modulename, { name of the module in uppercase } modulename, { name of the module in uppercase }
realmodulename, { name of the module in the orignal case }
objfilename, { fullname of the objectfile } objfilename, { fullname of the objectfile }
asmfilename, { fullname of the assemblerfile } asmfilename, { fullname of the assemblerfile }
ppufilename, { fullname of the ppufile } ppufilename, { fullname of the ppufile }
@ -710,13 +711,20 @@ end;
FSplit(s,p,n,e); FSplit(s,p,n,e);
{ Programs have the name program to don't conflict with dup id's } { Programs have the name program to don't conflict with dup id's }
if _is_unit then if _is_unit then
begin
{$ifdef UNITALIASES} {$ifdef UNITALIASES}
modulename:=stringdup(GetUnitAlias(Upper(n))) modulename:=stringdup(GetUnitAlias(Upper(n)));
realmodulename:=stringdup(GetUnitAlias(n));
{$else} {$else}
modulename:=stringdup(Upper(n)) modulename:=stringdup(Upper(n));
realmodulename:=stringdup(n);
{$endif} {$endif}
end
else else
modulename:=stringdup('PROGRAM'); begin
modulename:=stringdup('PROGRAM');
realmodulename:=stringdup('Program');
end;
mainsource:=stringdup(s); mainsource:=stringdup(s);
ppufilename:=nil; ppufilename:=nil;
objfilename:=nil; objfilename:=nil;
@ -779,7 +787,9 @@ end;
{ search the PPU file if it is an unit } { search the PPU file if it is an unit }
if is_unit then if is_unit then
begin begin
search_unit(modulename^,false); { use the realmodulename so we can also find a case sensitive
source filename }
search_unit(realmodulename^,false);
{ it the sources_available is changed then we know that { it the sources_available is changed then we know that
the sources aren't available } the sources aren't available }
if not sources_avail then if not sources_avail then
@ -828,6 +838,7 @@ end;
stringdispose(outputpath); stringdispose(outputpath);
stringdispose(path); stringdispose(path);
stringdispose(modulename); stringdispose(modulename);
stringdispose(realmodulename);
stringdispose(mainsource); stringdispose(mainsource);
stringdispose(asmprefix); stringdispose(asmprefix);
localunitsearchpath.done; localunitsearchpath.done;
@ -901,11 +912,14 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-09-24 15:06:16 peter Revision 1.3 2000-10-15 07:47:51 peter
* unit names and procedure names are stored mixed case
Revision 1.2 2000/09/24 15:06:16 peter
* use defines.inc * use defines.inc
Revision 1.1 2000/08/27 16:11:50 peter Revision 1.1 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
} }

36
compiler/pdecsub.pas
View File

@ -87,9 +87,6 @@ implementation
{$endif} {$endif}
; ;
var
realname : string; { contains the real name of a procedure as it's typed }
procedure parameter_dec(aktprocdef:pabstractprocdef); procedure parameter_dec(aktprocdef:pabstractprocdef);
{ {
@ -313,7 +310,7 @@ implementation
procedure parse_proc_head(options:tproctypeoption); procedure parse_proc_head(options:tproctypeoption);
var sp:stringid; var orgsp,sp:stringid;
pd:Pprocdef; pd:Pprocdef;
paramoffset:longint; paramoffset:longint;
sym:Psym; sym:Psym;
@ -331,12 +328,12 @@ begin
if (options=potype_operator) then if (options=potype_operator) then
begin begin
sp:=overloaded_names[optoken]; sp:=overloaded_names[optoken];
realname:=sp; orgsp:=sp;
end end
else else
begin begin
sp:=pattern; sp:=pattern;
realname:=orgpattern; orgsp:=orgpattern;
consume(_ID); consume(_ID);
end; end;
@ -352,7 +349,7 @@ begin
tokenpos:=storepos; tokenpos:=storepos;
{ load proc name } { load proc name }
sp:=pattern; sp:=pattern;
realname:=orgpattern; orgsp:=orgpattern;
procstartfilepos:=tokenpos; procstartfilepos:=tokenpos;
{ qualifier is class name ? } { qualifier is class name ? }
if (sym^.typ<>typesym) or if (sym^.typ<>typesym) or
@ -460,7 +457,7 @@ begin
DuplicateSym(aktprocsym); DuplicateSym(aktprocsym);
{ try to recover by creating a new aktprocsym } { try to recover by creating a new aktprocsym }
tokenpos:=procstartfilepos; tokenpos:=procstartfilepos;
aktprocsym:=new(pprocsym,init(sp)); aktprocsym:=new(pprocsym,init(orgsp));
end; end;
end end
else else
@ -483,7 +480,7 @@ begin
{$endif DONOTCHAINOPERATORS} {$endif DONOTCHAINOPERATORS}
end end
else else
aktprocsym:=new(pprocsym,init(sp)); aktprocsym:=new(pprocsym,init(orgsp));
symtablestack^.insert(aktprocsym); symtablestack^.insert(aktprocsym);
end; end;
@ -726,7 +723,7 @@ begin
{ only os/2 needs this } { only os/2 needs this }
if target_info.target=target_i386_os2 then if target_info.target=target_i386_os2 then
begin begin
procnames.insert(realname); procnames.insert(aktprocsym^.realname);
procinfo^.exported:=true; procinfo^.exported:=true;
if cs_link_deffile in aktglobalswitches then if cs_link_deffile in aktglobalswitches then
deffile.AddExport(aktprocsym^.definition^.mangledname); deffile.AddExport(aktprocsym^.definition^.mangledname);
@ -787,7 +784,7 @@ end;
procedure pd_system(const procnames:Tstringcontainer); procedure pd_system(const procnames:Tstringcontainer);
begin begin
aktprocsym^.definition^.setmangledname(realname); aktprocsym^.definition^.setmangledname(aktprocsym^.realname);
end; end;
procedure pd_abstract(const procnames:Tstringcontainer); procedure pd_abstract(const procnames:Tstringcontainer);
@ -889,7 +886,7 @@ end;
procedure pd_cdecl(const procnames:Tstringcontainer); procedure pd_cdecl(const procnames:Tstringcontainer);
begin begin
if aktprocsym^.definition^.deftype<>procvardef then if aktprocsym^.definition^.deftype<>procvardef then
aktprocsym^.definition^.setmangledname(target_os.Cprefix+realname); aktprocsym^.definition^.setmangledname(target_os.Cprefix+aktprocsym^.realname);
{ do not copy on local !! } { do not copy on local !! }
if (aktprocsym^.definition^.deftype=procdef) and if (aktprocsym^.definition^.deftype=procdef) and
assigned(aktprocsym^.definition^.parast) then assigned(aktprocsym^.definition^.parast) then
@ -900,7 +897,7 @@ procedure pd_cppdecl(const procnames:Tstringcontainer);
begin begin
if aktprocsym^.definition^.deftype<>procvardef then if aktprocsym^.definition^.deftype<>procvardef then
aktprocsym^.definition^.setmangledname( aktprocsym^.definition^.setmangledname(
target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname(realname)); target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname(aktprocsym^.realname));
{ do not copy on local !! } { do not copy on local !! }
if (aktprocsym^.definition^.deftype=procdef) and if (aktprocsym^.definition^.deftype=procdef) and
assigned(aktprocsym^.definition^.parast) then assigned(aktprocsym^.definition^.parast) then
@ -992,7 +989,7 @@ begin
else else
Message(parser_w_empty_import_name);} Message(parser_w_empty_import_name);}
{ this should work both for win32 and Linux !! PM } { this should work both for win32 and Linux !! PM }
import_name:=realname; import_name:=aktprocsym^.realname;
if not(current_module^.uses_imports) then if not(current_module^.uses_imports) then
begin begin
current_module^.uses_imports:=true; current_module^.uses_imports:=true;
@ -1583,7 +1580,7 @@ begin
(aktprocsym^.definition^.maxparacount>0)) then (aktprocsym^.definition^.maxparacount>0)) then
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward, MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
aktprocsym^.demangledName); aktprocsym^.declarationstr);
exit; exit;
end; end;
if hd^.forwarddef then if hd^.forwarddef then
@ -1596,7 +1593,7 @@ begin
(m_repeat_forward in aktmodeswitches)) then (m_repeat_forward in aktmodeswitches)) then
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward, MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
aktprocsym^.demangledName); aktprocsym^.declarationstr);
exit; exit;
end; end;
{ Check calling convention, no check for internconst,internproc which { Check calling convention, no check for internconst,internproc which
@ -1651,7 +1648,7 @@ begin
if hd^.forwarddef and aktprocsym^.definition^.forwarddef then if hd^.forwarddef and aktprocsym^.definition^.forwarddef then
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo, MessagePos1(aktprocsym^.definition^.fileinfo,
parser_e_function_already_declared_public_forward,aktprocsym^.demangledName); parser_e_function_already_declared_public_forward,aktprocsym^.declarationstr);
check_identical_proc:=true; check_identical_proc:=true;
{ Remove other forward from the list to reduce errors } { Remove other forward from the list to reduce errors }
pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded; pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
@ -1817,7 +1814,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.1 2000-10-14 10:14:51 peter Revision 1.2 2000-10-15 07:47:51 peter
* unit names and procedure names are stored mixed case
Revision 1.1 2000/10/14 10:14:51 peter
* moehrendorf oct 2000 rewrite * moehrendorf oct 2000 rewrite
} }

71
compiler/pmodules.pas
View File

@ -641,7 +641,7 @@ implementation
symtablestack:=systemunit; symtablestack:=systemunit;
{ add to the used units } { add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true))); current_module^.used_units.concat(new(pused_unit,init(hp,true)));
unitsym:=new(punitsym,init('SYSTEM',systemunit)); unitsym:=new(punitsym,init('System',systemunit));
inc(unitsym^.refs); inc(unitsym^.refs);
refsymtable^.insert(unitsym); refsymtable^.insert(unitsym);
{ read default constant definitions } { read default constant definitions }
@ -660,24 +660,24 @@ implementation
{ Objpas unit? } { Objpas unit? }
if m_objpas in aktmodeswitches then if m_objpas in aktmodeswitches then
begin begin
hp:=loadunit('OBJPAS',false); hp:=loadunit('ObjPas',false);
psymtable(hp^.globalsymtable)^.next:=symtablestack; psymtable(hp^.globalsymtable)^.next:=symtablestack;
symtablestack:=hp^.globalsymtable; symtablestack:=hp^.globalsymtable;
{ add to the used units } { add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true))); current_module^.used_units.concat(new(pused_unit,init(hp,true)));
unitsym:=new(punitsym,init('OBJPAS',hp^.globalsymtable)); unitsym:=new(punitsym,init('ObjPas',hp^.globalsymtable));
inc(unitsym^.refs); inc(unitsym^.refs);
refsymtable^.insert(unitsym); refsymtable^.insert(unitsym);
end; end;
{ Profile unit? Needed for go32v2 only } { Profile unit? Needed for go32v2 only }
if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
begin begin
hp:=loadunit('PROFILE',false); hp:=loadunit('Profile',false);
psymtable(hp^.globalsymtable)^.next:=symtablestack; psymtable(hp^.globalsymtable)^.next:=symtablestack;
symtablestack:=hp^.globalsymtable; symtablestack:=hp^.globalsymtable;
{ add to the used units } { add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true))); current_module^.used_units.concat(new(pused_unit,init(hp,true)));
unitsym:=new(punitsym,init('PROFILE',hp^.globalsymtable)); unitsym:=new(punitsym,init('Profile',hp^.globalsymtable));
inc(unitsym^.refs); inc(unitsym^.refs);
refsymtable^.insert(unitsym); refsymtable^.insert(unitsym);
end; end;
@ -687,24 +687,24 @@ implementation
{ Heaptrc unit } { Heaptrc unit }
if (cs_gdb_heaptrc in aktglobalswitches) then if (cs_gdb_heaptrc in aktglobalswitches) then
begin begin
hp:=loadunit('HEAPTRC',false); hp:=loadunit('HeapTrc',false);
psymtable(hp^.globalsymtable)^.next:=symtablestack; psymtable(hp^.globalsymtable)^.next:=symtablestack;
symtablestack:=hp^.globalsymtable; symtablestack:=hp^.globalsymtable;
{ add to the used units } { add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true))); current_module^.used_units.concat(new(pused_unit,init(hp,true)));
unitsym:=new(punitsym,init('HEAPTRC',hp^.globalsymtable)); unitsym:=new(punitsym,init('HeapTrc',hp^.globalsymtable));
inc(unitsym^.refs); inc(unitsym^.refs);
refsymtable^.insert(unitsym); refsymtable^.insert(unitsym);
end; end;
{ Lineinfo unit } { Lineinfo unit }
if (cs_gdb_lineinfo in aktglobalswitches) then if (cs_gdb_lineinfo in aktglobalswitches) then
begin begin
hp:=loadunit('LINEINFO',false); hp:=loadunit('LineInfo',false);
psymtable(hp^.globalsymtable)^.next:=symtablestack; psymtable(hp^.globalsymtable)^.next:=symtablestack;
symtablestack:=hp^.globalsymtable; symtablestack:=hp^.globalsymtable;
{ add to the used units } { add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true))); current_module^.used_units.concat(new(pused_unit,init(hp,true)));
unitsym:=new(punitsym,init('LINEINFO',hp^.globalsymtable)); unitsym:=new(punitsym,init('LineInfo',hp^.globalsymtable));
inc(unitsym^.refs); inc(unitsym^.refs);
refsymtable^.insert(unitsym); refsymtable^.insert(unitsym);
end; end;
@ -984,9 +984,7 @@ implementation
{$ifdef GDB} {$ifdef GDB}
pu : pused_unit; pu : pused_unit;
{$endif GDB} {$endif GDB}
{$ifndef Dont_use_double_checksum} store_crc,store_interface_crc : longint;
store_crc,store_interface_crc : longint;
{$endif}
s1,s2 : ^string; {Saves stack space} s1,s2 : ^string; {Saves stack space}
force_init_final : boolean; force_init_final : boolean;
@ -1003,7 +1001,9 @@ implementation
current_module^.SetFileName(main_file^.path^+main_file^.name^,true); current_module^.SetFileName(main_file^.path^+main_file^.name^,true);
stringdispose(current_module^.modulename); stringdispose(current_module^.modulename);
current_module^.modulename:=stringdup(upper(pattern)); stringdispose(current_module^.realmodulename);
current_module^.modulename:=stringdup(pattern);
current_module^.realmodulename:=stringdup(orgpattern);
{ check for system unit } { check for system unit }
new(s1); new(s1);
new(s2); new(s2);
@ -1014,7 +1014,7 @@ implementation
if ((length(current_module^.modulename^)>8) or if ((length(current_module^.modulename^)>8) or
(current_module^.modulename^<>s1^) or (current_module^.modulename^<>s1^) or
(current_module^.modulename^<>s2^)) then (current_module^.modulename^<>s2^)) then
Message1(unit_e_illegal_unit_name,current_module^.modulename^); Message1(unit_e_illegal_unit_name,current_module^.realmodulename^);
end end
else else
begin begin
@ -1022,7 +1022,7 @@ implementation
not((current_module^.modulename^=s2^) or not((current_module^.modulename^=s2^) or
((length(current_module^.modulename^)>8) and ((length(current_module^.modulename^)>8) and
(copy(current_module^.modulename^,1,8)=s2^))) then (copy(current_module^.modulename^,1,8)=s2^))) then
Message1(unit_e_illegal_unit_name,current_module^.modulename^); Message1(unit_e_illegal_unit_name,current_module^.realmodulename^);
if (current_module^.modulename^=s1^) then if (current_module^.modulename^=s1^) then
Message(unit_w_switch_us_missed); Message(unit_w_switch_us_missed);
end; end;
@ -1039,10 +1039,10 @@ implementation
{ handle the global switches } { handle the global switches }
setupglobalswitches; setupglobalswitches;
Message1(unit_u_start_parse_interface,current_module^.modulename^); Message1(unit_u_start_parse_interface,current_module^.realmodulename^);
{ update status } { update status }
status.currentmodule:=current_module^.modulename^; status.currentmodule:=current_module^.realmodulename^;
{ maybe turn off m_objpas if we are compiling objpas } { maybe turn off m_objpas if we are compiling objpas }
if (current_module^.modulename^='OBJPAS') then if (current_module^.modulename^='OBJPAS') then
@ -1068,7 +1068,7 @@ implementation
{ inside the unit itself (PM) } { inside the unit itself (PM) }
{ this also forbids to have another symbol } { this also forbids to have another symbol }
{ with the same name as the unit } { with the same name as the unit }
refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst))); refsymtable^.insert(new(punitsym,init(current_module^.realmodulename^,unitst)));
{ a unit compiled at command line must be inside the loaded_unit list } { a unit compiled at command line must be inside the loaded_unit list }
if (compile_level=1) then if (compile_level=1) then
@ -1125,7 +1125,7 @@ implementation
numberunits; numberunits;
{ ... parse the declarations } { ... parse the declarations }
Message1(parser_u_parsing_interface,current_module^.modulename^); Message1(parser_u_parsing_interface,current_module^.realmodulename^);
read_interface_declarations; read_interface_declarations;
{ leave when we got an error } { leave when we got an error }
@ -1142,11 +1142,9 @@ implementation
write_gdb_info; write_gdb_info;
{$endIf Def New_GDB} {$endIf Def New_GDB}
{$ifndef Dont_use_double_checksum}
if not(cs_compilesystem in aktmoduleswitches) then if not(cs_compilesystem in aktmoduleswitches) then
if (Errorcount=0) then if (Errorcount=0) then
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true); writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true);
{$endif Test_Double_checksum}
{ Parse the implementation section } { Parse the implementation section }
consume(_IMPLEMENTATION); consume(_IMPLEMENTATION);
@ -1208,7 +1206,7 @@ implementation
allow_special:=false; allow_special:=false;
{$endif Splitheap} {$endif Splitheap}
Message1(parser_u_parsing_implementation,current_module^.modulename^); Message1(parser_u_parsing_implementation,current_module^.realmodulename^);
{ Compile the unit } { Compile the unit }
codegen_newprocedure; codegen_newprocedure;
@ -1373,27 +1371,23 @@ implementation
if cs_local_browser in aktmoduleswitches then if cs_local_browser in aktmoduleswitches then
current_module^.localsymtable:=refsymtable; current_module^.localsymtable:=refsymtable;
{ Write out the ppufile } { Write out the ppufile }
{$ifndef Dont_use_double_checksum} store_interface_crc:=current_module^.interface_crc;
store_interface_crc:=current_module^.interface_crc; store_crc:=current_module^.crc;
store_crc:=current_module^.crc;
{$endif Test_Double_checksum}
if (Errorcount=0) then if (Errorcount=0) then
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false); writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false);
{$ifndef Dont_use_double_checksum}
if not(cs_compilesystem in aktmoduleswitches) then if not(cs_compilesystem in aktmoduleswitches) then
if store_interface_crc<>current_module^.interface_crc then if store_interface_crc<>current_module^.interface_crc then
Comment(V_Warning,current_module^.ppufilename^+' Interface CRC changed '+ Comment(V_Warning,current_module^.ppufilename^+' Interface CRC changed '+
tostr(store_crc)+'<>'+tostr(current_module^.interface_crc)); tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if not(cs_compilesystem in aktmoduleswitches) then if not(cs_compilesystem in aktmoduleswitches) then
if (store_crc<>current_module^.crc) and simplify_ppu then if (store_crc<>current_module^.crc) and simplify_ppu then
Comment(V_Warning,current_module^.ppufilename^+' implementation CRC changed '+ Comment(V_Warning,current_module^.ppufilename^+' implementation CRC changed '+
tostr(store_crc)+'<>'+tostr(current_module^.interface_crc)); tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
{$endif EXTDEBUG} {$endif EXTDEBUG}
{$endif ndef Dont_use_Double_checksum} { must be done only after local symtable ref stores !! }
{ must be done only after local symtable ref stores !! } closecurrentppu;
closecurrentppu;
{$ifdef GDB} {$ifdef GDB}
pu:=pused_unit(usedunits.first); pu:=pused_unit(usedunits.first);
while assigned(pu) do while assigned(pu) do
@ -1411,7 +1405,6 @@ implementation
current_module^.localsymtable:=nil; current_module^.localsymtable:=nil;
end; end;
RestoreUnitSyms; RestoreUnitSyms;
if is_assembler_generated then if is_assembler_generated then
@ -1486,7 +1479,9 @@ implementation
begin begin
consume(_PROGRAM); consume(_PROGRAM);
stringdispose(current_module^.modulename); stringdispose(current_module^.modulename);
stringdispose(current_module^.realmodulename);
current_module^.modulename:=stringdup(pattern); current_module^.modulename:=stringdup(pattern);
current_module^.realmodulename:=stringdup(orgpattern);
if (target_info.target=target_i386_WIN32) then if (target_info.target=target_i386_WIN32) then
exportlib^.preparelib(pattern); exportlib^.preparelib(pattern);
consume(_ID); consume(_ID);
@ -1541,9 +1536,8 @@ implementation
numberunits; numberunits;
{Insert the name of the main program into the symbol table.} {Insert the name of the main program into the symbol table.}
if current_module^.modulename^<>'' then if current_module^.realmodulename^<>'' then
{st^.insert(new(pprogramsym,init(current_module^.modulename^)));} st^.insert(new(punitsym,init(current_module^.realmodulename^,punitsymtable(st))));
st^.insert(new(punitsym,init(current_module^.modulename^,punitsymtable(st))));
{ ...is also constsymtable, this is the symtable where } { ...is also constsymtable, this is the symtable where }
{ the elements of enumeration types are inserted } { the elements of enumeration types are inserted }
@ -1714,7 +1708,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.13 2000-10-04 14:51:08 pierre Revision 1.14 2000-10-15 07:47:51 peter
* unit names and procedure names are stored mixed case
Revision 1.13 2000/10/04 14:51:08 pierre
* IsExe restored * IsExe restored
Revision 1.12 2000/09/30 16:07:40 peter Revision 1.12 2000/09/30 16:07:40 peter

13
compiler/psub.pas
View File

@ -626,7 +626,7 @@ implementation
{ A method must be forward defined (in the object declaration) } { A method must be forward defined (in the object declaration) }
if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
begin begin
Message1(parser_e_header_dont_match_any_member,aktprocsym^.demangledName); Message1(parser_e_header_dont_match_any_member,aktprocsym^.declarationstr);
aktprocsym^.write_parameter_lists(aktprocsym^.definition); aktprocsym^.write_parameter_lists(aktprocsym^.definition);
end end
else else
@ -639,7 +639,7 @@ implementation
aktprocsym^.definition^.nextoverloaded^.interfacedef and aktprocsym^.definition^.nextoverloaded^.interfacedef and
not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then
begin begin
Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName); Message1(parser_e_header_dont_match_forward,aktprocsym^.declarationstr);
aktprocsym^.write_parameter_lists(aktprocsym^.definition); aktprocsym^.write_parameter_lists(aktprocsym^.definition);
end end
else else
@ -686,7 +686,7 @@ implementation
{ compile procedure when a body is needed } { compile procedure when a body is needed }
if (pdflags and pd_body)<>0 then if (pdflags and pd_body)<>0 then
begin begin
Message1(parser_p_procedure_start,aktprocsym^.demangledname); Message1(parser_p_procedure_start,aktprocsym^.declarationstr);
names^.insert(aktprocsym^.definition^.mangledname); names^.insert(aktprocsym^.definition^.mangledname);
{ set _FAIL as keyword if constructor } { set _FAIL as keyword if constructor }
if (aktprocsym^.definition^.proctypeoption=potype_constructor) then if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
@ -828,7 +828,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.16 2000-10-14 10:14:52 peter Revision 1.17 2000-10-15 07:47:51 peter
* unit names and procedure names are stored mixed case
Revision 1.16 2000/10/14 10:14:52 peter
* moehrendorf oct 2000 rewrite * moehrendorf oct 2000 rewrite
Revision 1.15 2000/09/24 21:33:47 peter Revision 1.15 2000/09/24 21:33:47 peter
@ -879,4 +882,4 @@ end.
Revision 1.2 2000/07/13 11:32:46 michael Revision 1.2 2000/07/13 11:32:46 michael
+ removed logs + removed logs
} }

9
compiler/symconst.pas
View File

@ -231,7 +231,7 @@ type
classrefdef,forwarddef); classrefdef,forwarddef);
{ possible types for symtable entries } { possible types for symtable entries }
tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym, tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,
constsym,enumsym,typedconstsym,errorsym,syssym, constsym,enumsym,typedconstsym,errorsym,syssym,
labelsym,absolutesym,propertysym,funcretsym, labelsym,absolutesym,propertysym,funcretsym,
macrosym); macrosym);
@ -271,7 +271,7 @@ const
const const
SymTypeName : array[tsymtyp] of string[12] = SymTypeName : array[tsymtyp] of string[12] =
('abstractsym','variable','type','proc','unit','program', ('abstractsym','variable','type','proc','unit',
'const','enum','typed const','errorsym','system sym', 'const','enum','typed const','errorsym','system sym',
'label','absolute','property','funcret', 'label','absolute','property','funcret',
'macrosym'); 'macrosym');
@ -281,7 +281,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 2000-10-14 10:14:52 peter Revision 1.9 2000-10-15 07:47:52 peter
* unit names and procedure names are stored mixed case
Revision 1.8 2000/10/14 10:14:52 peter
* moehrendorf oct 2000 rewrite * moehrendorf oct 2000 rewrite
Revision 1.7 2000/09/24 15:06:28 peter Revision 1.7 2000/09/24 15:06:28 peter

16
compiler/symdef.inc
View File

@ -3056,6 +3056,7 @@ Const local_symtable_index : longint = $8001;
end; end;
{$ifdef dummy}
function tprocdef.procname: string; function tprocdef.procname: string;
var var
s : string; s : string;
@ -3082,6 +3083,7 @@ Const local_symtable_index : longint = $8001;
else else
procname:=Copy(s,1,l-1); procname:=Copy(s,1,l-1);
end; end;
{$endif}
function tprocdef.cplusplusmangledname(const rn : string) : string; function tprocdef.cplusplusmangledname(const rn : string) : string;
@ -4252,13 +4254,8 @@ Const local_symtable_index : longint = $8001;
rttilist^.concat(new(pai_const,init_16bit(count))); rttilist^.concat(new(pai_const,init_16bit(count)));
{ write unit name } { write unit name }
if assigned(owner^.name) then rttilist^.concat(new(pai_const,init_8bit(length(current_module^.realmodulename^))));
begin rttilist^.concat(new(pai_string,init(current_module^.realmodulename^)));
rttilist^.concat(new(pai_const,init_8bit(length(owner^.name^))));
rttilist^.concat(new(pai_string,init(owner^.name^)));
end
else
rttilist^.concat(new(pai_const,init_8bit(0)));
{ write published properties count } { write published properties count }
count:=0; count:=0;
@ -4342,7 +4339,10 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $Log$
Revision 1.22 2000-10-14 10:14:52 peter Revision 1.23 2000-10-15 07:47:52 peter
* unit names and procedure names are stored mixed case
Revision 1.22 2000/10/14 10:14:52 peter
* moehrendorf oct 2000 rewrite * moehrendorf oct 2000 rewrite
Revision 1.21 2000/10/04 23:16:48 pierre Revision 1.21 2000/10/04 23:16:48 pierre

7
compiler/symdefh.inc
View File

@ -461,7 +461,9 @@
procedure setmangledname(const s : string); procedure setmangledname(const s : string);
procedure load_references; procedure load_references;
function write_references : boolean; function write_references : boolean;
{$ifdef dummy}
function procname: string; function procname: string;
{$endif dummy}
function cplusplusmangledname(const rn : string) : string; function cplusplusmangledname(const rn : string) : string;
{ debug } { debug }
{$ifdef GDB} {$ifdef GDB}
@ -557,7 +559,10 @@
{ {
$Log$ $Log$
Revision 1.11 2000-10-14 10:14:53 peter Revision 1.12 2000-10-15 07:47:52 peter
* unit names and procedure names are stored mixed case
Revision 1.11 2000/10/14 10:14:53 peter
* moehrendorf oct 2000 rewrite * moehrendorf oct 2000 rewrite
Revision 1.10 2000/09/24 15:06:29 peter Revision 1.10 2000/09/24 15:06:29 peter

19
compiler/symppu.inc
View File

@ -694,7 +694,7 @@
procedure load_interface; procedure load_interface;
var var
b : byte; b : byte;
newmodulename : pstring; newmodulename : string;
begin begin
{ read interface part } { read interface part }
repeat repeat
@ -702,11 +702,13 @@
case b of case b of
ibmodulename : ibmodulename :
begin begin
newmodulename:=stringdup(current_ppu^.getstring); newmodulename:=current_ppu^.getstring;
if newmodulename^<>current_module^.modulename^ then if upper(newmodulename)<>current_module^.modulename^ then
Message2(unit_f_unit_name_error,current_module^.modulename^,newmodulename^); Message2(unit_f_unit_name_error,current_module^.realmodulename^,newmodulename);
stringdispose(current_module^.modulename); stringdispose(current_module^.modulename);
current_module^.modulename:=newmodulename; stringdispose(current_module^.realmodulename);
current_module^.modulename:=stringdup(upper(newmodulename));
current_module^.realmodulename:=stringdup(newmodulename);
end; end;
ibsourcefiles : ibsourcefiles :
readsourcefiles; readsourcefiles;
@ -736,7 +738,10 @@
{ {
$Log$ $Log$
Revision 1.4 2000-09-24 21:33:47 peter Revision 1.5 2000-10-15 07:47:53 peter
* unit names and procedure names are stored mixed case
Revision 1.4 2000/09/24 21:33:47 peter
* message updates merges * message updates merges
Revision 1.3 2000/09/21 20:56:19 pierre Revision 1.3 2000/09/21 20:56:19 pierre
@ -745,4 +750,4 @@
Revision 1.2 2000/07/13 11:32:49 michael Revision 1.2 2000/07/13 11:32:49 michael
+ removed logs + removed logs
} }

25
compiler/symsym.inc
View File

@ -394,9 +394,9 @@
end; end;
function tprocsym.demangledname:string; function tprocsym.declarationstr:string;
begin begin
demangledname:=name+definition^.demangled_paras; declarationstr:=realname+definition^.demangled_paras;
end; end;
@ -424,9 +424,9 @@
if pd^.forwarddef then if pd^.forwarddef then
begin begin
if assigned(pd^._class) then if assigned(pd^._class) then
MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+demangledname) MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+declarationstr)
else else
MessagePos1(fileinfo,sym_e_forward_not_resolved,demangledname); MessagePos1(fileinfo,sym_e_forward_not_resolved,declarationstr);
{ Turn futher error messages off } { Turn futher error messages off }
pd^.forwarddef:=false; pd^.forwarddef:=false;
end; end;
@ -641,16 +641,6 @@
{$endif GDB} {$endif GDB}
{****************************************************************************
TPROGRAMSYM
****************************************************************************}
constructor tprogramsym.init(const n : string);
begin
inherited init(n);
typ:=programsym;
end;
{**************************************************************************** {****************************************************************************
TERRORSYM TERRORSYM
****************************************************************************} ****************************************************************************}
@ -2218,7 +2208,10 @@
{ {
$Log$ $Log$
Revision 1.9 2000-09-24 21:19:52 peter Revision 1.10 2000-10-15 07:47:53 peter
* unit names and procedure names are stored mixed case
Revision 1.9 2000/09/24 21:19:52 peter
* delphi compile fixes * delphi compile fixes
Revision 1.8 2000/09/19 23:08:03 pierre Revision 1.8 2000/09/19 23:08:03 pierre
@ -2246,4 +2239,4 @@
Revision 1.2 2000/07/13 11:32:49 michael Revision 1.2 2000/07/13 11:32:49 michael
+ removed logs + removed logs
} }

12
compiler/symsymh.inc
View File

@ -112,7 +112,7 @@
constructor load; constructor load;
destructor done;virtual; destructor done;virtual;
function mangledname : string;virtual; function mangledname : string;virtual;
function demangledname:string; function declarationstr:string;
{ writes all declarations } { writes all declarations }
procedure write_parameter_lists(skipdef:pprocdef); procedure write_parameter_lists(skipdef:pprocdef);
{ tests, if all procedures definitions are defined and not } { tests, if all procedures definitions are defined and not }
@ -302,11 +302,6 @@
{$endif GDB} {$endif GDB}
end; end;
pprogramsym = ^tprogramsym;
tprogramsym = object(tsym)
constructor init(const n : string);
end;
psyssym = ^tsyssym; psyssym = ^tsyssym;
tsyssym = object(tsym) tsyssym = object(tsym)
number : longint; number : longint;
@ -321,7 +316,10 @@
{ {
$Log$ $Log$
Revision 1.5 2000-08-27 20:19:40 peter Revision 1.6 2000-10-15 07:47:53 peter
* unit names and procedure names are stored mixed case
Revision 1.5 2000/08/27 20:19:40 peter
* store strings with case in ppu, when an internal symbol is created * store strings with case in ppu, when an internal symbol is created
a '$' is prefixed so it's not automatic uppercased a '$' is prefixed so it's not automatic uppercased

7
compiler/symtable.pas
View File

@ -2385,7 +2385,7 @@ implementation
pu : pused_unit; pu : pused_unit;
begin begin
{ first the unitname } { first the unitname }
current_ppu^.putstring(name^); current_ppu^.putstring(current_module^.realmodulename^);
current_ppu^.writeentry(ibmodulename); current_ppu^.writeentry(ibmodulename);
writesourcefiles; writesourcefiles;
@ -2880,7 +2880,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.10 2000-10-14 10:14:53 peter Revision 1.11 2000-10-15 07:47:53 peter
* unit names and procedure names are stored mixed case
Revision 1.10 2000/10/14 10:14:53 peter
* moehrendorf oct 2000 rewrite * moehrendorf oct 2000 rewrite
Revision 1.9 2000/10/01 19:48:25 peter Revision 1.9 2000/10/01 19:48:25 peter