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

* added extra header to ppu inside a subsection, so we won't run into

Browse Source 
trouble when the ppu version hits 255
  * also moved several ppu flags to a set inside that section

git-svn-id: trunk@41846 -
This commit is contained in:
Jonas Maebe 2019-04-06 21:28:43 +00:00
parent 162bd5e251
commit 0b61b5d4cf
22 changed files with 330 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/cresstr.pas
View File

@ -308,7 +308,7 @@ uses
resstrs.RegisterResourceStrings;
if not resstrs.List.Empty then
begin
current_module.flags:=current_module.flags or uf_has_resourcestrings;
include(current_module.moduleflags,mf_has_resourcestrings);
resstrs.CreateResourceStringData;
resstrs.WriteRSJFile;
end;

4
compiler/dbgdwarf.pas
View File

@ -3387,7 +3387,7 @@ implementation
bind: tasmsymbind;
lang: tdwarf_source_language;
begin
current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo;
include(current_module.moduleflags,mf_has_dwarf_debuginfo);
storefilepos:=current_filepos;
current_filepos:=current_module.mainfilepos;
@ -3631,7 +3631,7 @@ implementation
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
If ((hp.flags and uf_has_dwarf_debuginfo)=uf_has_dwarf_debuginfo) and not assigned(hp.package) then
If (mf_has_dwarf_debuginfo in hp.moduleflags) and not assigned(hp.package) then
begin
list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));

4
compiler/dbgstabs.pas
View File

@ -1679,7 +1679,7 @@ implementation
{ include symbol that will be referenced from the main to be sure to
include this debuginfo .o file }
current_module.flags:=current_module.flags or uf_has_stabs_debuginfo;
include(current_module.moduleflags,mf_has_stabs_debuginfo);
if not(target_info.system in systems_darwin) then
begin
new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),sizeof(pint));
@ -1867,7 +1867,7 @@ implementation
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
If ((hp.flags and uf_has_stabs_debuginfo)=uf_has_stabs_debuginfo) and not assigned(hp.package) then
If (mf_has_stabs_debuginfo in hp.moduleflags) and not assigned(hp.package) then
begin
list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0));
list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));

1
compiler/entfile.pas
View File

@ -38,6 +38,7 @@ const
subentryid = 2;
{special}
iberror = 0;
ibextraheader = 242;
ibpputable = 243;
ibstartrequireds = 244;
ibendrequireds = 245;

14
compiler/fmodule.pas
View File

@ -128,7 +128,9 @@ interface
crc,
interface_crc,
indirect_crc : cardinal;
flags : cardinal; { the PPU flags }
headerflags : cardinal; { the PPU header flags }
longversion : cardinal; { longer version than what fits in the ppu header }
moduleflags : tmoduleflags; { ppu flags that do not need to be known by just reading the ppu header }
islibrary : boolean; { if it is a library (win32 dll) }
IsPackage : boolean;
moduleid : longint;
@ -574,7 +576,9 @@ implementation
crc:=0;
interface_crc:=0;
indirect_crc:=0;
flags:=0;
headerflags:=0;
longversion:=0;
moduleflags:=[];
scanner:=nil;
unitmap:=nil;
unitmapsize:=0;
@ -886,7 +890,9 @@ implementation
crc:=0;
interface_crc:=0;
indirect_crc:=0;
flags:=0;
headerflags:=0;
longversion:=0;
moduleflags:=[];
mainfilepos.line:=0;
mainfilepos.column:=0;
mainfilepos.fileindex:=0;
@ -1061,7 +1067,7 @@ implementation
this is for units with an initialization/finalization }
if (unitmap[pu.u.moduleid].refs=0) and
pu.in_uses and
((pu.u.flags and (uf_init or uf_finalize))=0) then
((pu.u.moduleflags * [mf_init,mf_finalize])=[]) then
CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
end;
pu:=tused_unit(pu.next);

7
compiler/fpcp.pas
View File

@ -127,8 +127,8 @@ implementation
{$ifdef cpufpemu}
{ check if floating point emulation is on?
fpu emulation isn't unit levelwise because it affects calling convention }
if ((pcpfile.header.common.flags and uf_fpu_emulation)<>0) xor
(cs_fp_emulation in current_settings.moduleswitches) then
if ((uf_fpu_emulation and pcpfile.header.common.flags)<>0) <>
(cs_fp_emulation in current_settings.moduleswitches) then
begin
pcpfile.free;
pcpfile:=nil;
@ -137,9 +137,6 @@ implementation
end;
{$endif cpufpemu}
{ Load values to be access easier }
//flags:=pcpfile.header.common.flags;
//crc:=pcpfile.header.checksum;
{ Show Debug info }
Message1(package_u_pcp_time,filetimestring(pcpfiletime));
Message1(package_u_pcp_flags,tostr(pcpfile.header.common.flags{flags}));

278
compiler/fppu.pas
View File

@ -43,7 +43,6 @@ interface
symbase,ppu,symtype;
type
{ tppumodule }
tppumodule = class(tmodule)
@ -99,6 +98,7 @@ interface
procedure writeResources;
procedure writeunitimportsyms;
procedure writeasmsyms(kind:tunitasmlisttype;list:tfphashobjectlist);
procedure writeextraheader;
procedure readsourcefiles;
procedure readloadunit;
procedure readlinkcontainer(var p:tlinkcontainer);
@ -109,6 +109,7 @@ interface
procedure readwpofile;
procedure readunitimportsyms;
procedure readasmsyms;
procedure readextraheader;
{$IFDEF MACRO_DIFF_HINT}
procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
procedure writeusedmacros;
@ -244,98 +245,110 @@ var
function tppumodule.openppu(ppufiletime:longint):boolean;
function checkheader: boolean;
begin
result:=false;
{ check for a valid PPU file }
if not ppufile.CheckPPUId then
begin
Message(unit_u_ppu_invalid_header);
exit;
end;
{ check for allowed PPU versions }
if not (ppufile.getversion = CurrentPPUVersion) then
begin
Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
exit;
end;
{ check the target processor }
if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
begin
Message(unit_u_ppu_invalid_processor,@queuecomment);
exit;
end;
{ check target }
if tsystem(ppufile.header.common.target)<>target_info.system then
begin
Message(unit_u_ppu_invalid_target,@queuecomment);
exit;
end;
{$ifdef cpufpemu}
{ check if floating point emulation is on?
fpu emulation isn't unit levelwise because it affects calling convention }
if ((headerflags and uf_fpu_emulation)<>0) <>
(cs_fp_emulation in current_settings.moduleswitches) then
begin
Message(unit_u_ppu_invalid_fpumode,@queuecomment);
exit;
end;
{$endif cpufpemu}
result:=true;
end;
function checkextraheader: boolean;
begin
result:=false;
if ppufile.readentry<>ibextraheader then
begin
Message(unit_u_ppu_invalid_header);
exit;
end;
readextraheader;
if (longversion<>CurrentPPULongVersion) or
not ppufile.EndOfEntry then
begin
Message(unit_u_ppu_invalid_header);
exit;
end;
{$ifdef i8086}
{ check i8086 memory model flags }
if (mf_i8086_far_code in moduleflags) <>
(current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
begin
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if (mf_i8086_far_data in moduleflags) <>
(current_settings.x86memorymodel in [mm_compact,mm_large]) then
begin
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if (mf_i8086_huge_data in moduleflags) <>
(current_settings.x86memorymodel=mm_huge) then
begin
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if (mf_i8086_cs_equals_ds in moduleflags) <>
(current_settings.x86memorymodel=mm_tiny) then
begin
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if (mf_i8086_ss_equals_ds in moduleflags) <>
(current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium]) then
begin
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
{$endif i8086}
result:=true;
end;
begin
openppu:=false;
{ check for a valid PPU file }
if not ppufile.CheckPPUId then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_header);
exit;
end;
{ check for allowed PPU versions }
if not (ppufile.getversion = CurrentPPUVersion) then
begin
Message1(unit_u_ppu_invalid_version,tostr(ppufile.getversion),@queuecomment);
ppufile.free;
ppufile:=nil;
exit;
end;
{ check the target processor }
if tsystemcpu(ppufile.header.common.cpu)<>target_cpu then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_processor,@queuecomment);
exit;
end;
{ check target }
if tsystem(ppufile.header.common.target)<>target_info.system then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_target,@queuecomment);
exit;
end;
{$ifdef i8086}
{ check i8086 memory model flags }
if ((ppufile.header.common.flags and uf_i8086_far_code)<>0) xor
(current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge]) then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if ((ppufile.header.common.flags and uf_i8086_far_data)<>0) xor
(current_settings.x86memorymodel in [mm_compact,mm_large]) then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if ((ppufile.header.common.flags and uf_i8086_huge_data)<>0) xor
(current_settings.x86memorymodel=mm_huge) then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if ((ppufile.header.common.flags and uf_i8086_cs_equals_ds)<>0) xor
(current_settings.x86memorymodel=mm_tiny) then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
if ((ppufile.header.common.flags and uf_i8086_ss_equals_ds)<>0) xor
(current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium]) then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_memory_model,@queuecomment);
exit;
end;
{$endif i8086}
{$ifdef cpufpemu}
{ check if floating point emulation is on?
fpu emulation isn't unit levelwise because it affects calling convention }
if ((ppufile.header.common.flags and uf_fpu_emulation)<>0) xor
(cs_fp_emulation in current_settings.moduleswitches) then
begin
ppufile.free;
ppufile:=nil;
Message(unit_u_ppu_invalid_fpumode,@queuecomment);
exit;
end;
{$endif cpufpemu}
if not checkheader or
not checkextraheader then
begin
ppufile.free;
ppufile:=nil;
exit;
end;
{ Load values to be access easier }
flags:=ppufile.header.common.flags;
headerflags:=ppufile.header.common.flags;
crc:=ppufile.header.checksum;
interface_crc:=ppufile.header.interface_checksum;
indirect_crc:=ppufile.header.indirect_checksum;
@ -344,7 +357,7 @@ var
Message1(unit_u_ppu_time,filetimestring(ppufiletime))
else
Message1(unit_u_ppu_time,'unknown');
Message1(unit_u_ppu_flags,tostr(flags));
Message1(unit_u_ppu_flags,tostr(headerflags));
Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
@ -961,6 +974,38 @@ var
ppufile.writeentry(ibasmsymbols);
end;
procedure tppumodule.writeextraheader;
var
old_docrc: boolean;
begin
{ create unit flags }
if do_release then
include(moduleflags,mf_release);
if assigned(localsymtable) then
include(moduleflags,mf_local_symtable);
if cs_checkpointer_called in current_settings.moduleswitches then
include(moduleflags,mf_checkpointer_called);
{$ifdef i8086}
if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
include(moduleflags,mf_i8086_far_code);
if current_settings.x86memorymodel in [mm_compact,mm_large] then
include(moduleflags,mf_i8086_far_data);
if current_settings.x86memorymodel=mm_huge then
include(moduleflags,mf_i8086_huge_data);
if current_settings.x86memorymodel=mm_tiny then
include(moduleflags,mf_i8086_cs_equals_ds);
if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
include(moduleflags,mf_i8086_ss_equals_ds);
{$endif i8086}
old_docrc:=ppufile.do_crc;
ppufile.do_crc:=false;
ppufile.putlongint(longint(CurrentPPULongVersion));
ppufile.putsmallset(moduleflags);
ppufile.writeentry(ibextraheader);
ppufile.do_crc:=old_docrc;
end;
{$IFDEF MACRO_DIFF_HINT}
@ -1026,7 +1071,7 @@ var
source_time : longint;
hp : tinputfile;
begin
sources_avail:=(flags and uf_release) = 0;
sources_avail:=not(mf_release in moduleflags);
is_main:=true;
main_dir:='';
while not ppufile.endofentry do
@ -1037,7 +1082,7 @@ var
temp_dir:='';
if sources_avail then
begin
if (flags and uf_in_library)<>0 then
if (headerflags and uf_in_library)<>0 then
begin
sources_avail:=false;
temp:=' library';
@ -1300,6 +1345,13 @@ var
end;
procedure tppumodule.readextraheader;
begin
longversion:=cardinal(ppufile.getlongint);
ppufile.getsmallset(moduleflags);
end;
procedure tppumodule.load_interface;
var
b : byte;
@ -1324,6 +1376,10 @@ var
modulename:=stringdup(upper(newmodulename));
realmodulename:=stringdup(newmodulename);
end;
ibextraheader:
begin
readextraheader;
end;
ibfeatures :
begin
ppufile.getsmallset(features);
@ -1416,27 +1472,9 @@ var
Message1(unit_u_ppu_write,realmodulename^);
{ create unit flags }
if do_release then
flags:=flags or uf_release;
if assigned(localsymtable) then
flags:=flags or uf_local_symtable;
if (cs_checkpointer_called in current_settings.moduleswitches) then
flags:=flags or uf_checkpointer_called;
{$ifdef i8086}
if current_settings.x86memorymodel in [mm_medium,mm_large,mm_huge] then
flags:=flags or uf_i8086_far_code;
if current_settings.x86memorymodel in [mm_compact,mm_large] then
flags:=flags or uf_i8086_far_data;
if current_settings.x86memorymodel=mm_huge then
flags:=flags or uf_i8086_huge_data;
if current_settings.x86memorymodel=mm_tiny then
flags:=flags or uf_i8086_cs_equals_ds;
if current_settings.x86memorymodel in [mm_tiny,mm_small,mm_medium] then
flags:=flags or uf_i8086_ss_equals_ds;
{$endif i8086}
{$ifdef cpufpemu}
if (cs_fp_emulation in current_settings.moduleswitches) then
flags:=flags or uf_fpu_emulation;
headerflags:=headerflags or uf_fpu_emulation;
{$endif cpufpemu}
{$ifdef Test_Double_checksum_write}
Assign(CRCFile,s+'.IMP');
@ -1448,6 +1486,9 @@ var
if not ppufile.createfile then
Message(unit_f_ppu_cannot_write);
{ extra header (sub version, module flags) }
writeextraheader;
{ first the (JVM) namespace }
if assigned(namespace) then
begin
@ -1532,7 +1573,7 @@ var
tstoredsymtable(globalmacrosymtable).buildderefimpl;
end;
if (flags and uf_local_symtable)<>0 then
if mf_local_symtable in moduleflags then
tstoredsymtable(localsymtable).buildderef_registered;
buildderefunitimportsyms;
writederefmap;
@ -1575,7 +1616,7 @@ var
{ write static symtable
needed for local debugging of unit functions }
if (flags and uf_local_symtable)<>0 then
if mf_local_symtable in moduleflags then
tstoredsymtable(localsymtable).ppuwrite(ppufile);
{ write whole program optimisation-related information }
@ -1593,7 +1634,7 @@ var
ppufile.header.common.compiler:=wordversion;
ppufile.header.common.cpu:=word(target_cpu);
ppufile.header.common.target:=word(target_info.system);
ppufile.header.common.flags:=flags;
ppufile.header.common.flags:=headerflags;
ppufile.header.deflistsize:=current_module.deflist.count;
ppufile.header.symlistsize:=current_module.symlist.count;
ppufile.writeheader;
@ -1636,6 +1677,9 @@ var
ppufile.putstring(realmodulename^);
ppufile.writeentry(ibmodulename);
{ extra header (sub version, module flags) }
writeextraheader;
ppufile.putsmallset(moduleoptions);
if mo_has_deprecated_msg in moduleoptions then
ppufile.putstring(deprecatedmsg^);
@ -1699,7 +1743,7 @@ var
ppufile.header.common.compiler:=wordversion;
ppufile.header.common.cpu:=word(target_cpu);
ppufile.header.common.target:=word(target_info.system);
ppufile.header.common.flags:=flags;
ppufile.header.common.flags:=headerflags;
ppufile.writeheader;
ppufile.closefile;
@ -1734,7 +1778,7 @@ var
if (pu.u.interface_crc<>pu.interface_checksum) or
(pu.u.indirect_crc<>pu.indirect_checksum) or
(
((ppufile.header.common.flags and uf_release)=0) and
(not(mf_release in moduleflags)) and
(pu.u.crc<>pu.checksum)
) then
begin
@ -1810,7 +1854,7 @@ var
end;
{ load implementation symtable }
if (flags and uf_local_symtable)<>0 then
if mf_local_symtable in moduleflags then
begin
localsymtable:=tstaticsymtable.create(modulename^,moduleid);
tstaticsymtable(localsymtable).ppuload(ppufile);

27
compiler/globtype.pas
View File

@ -348,6 +348,33 @@ interface
);
twpoptimizerswitches = set of twpoptimizerswitch;
{ module flags (extra unit flags not in ppu header) }
tmoduleflag = (
mf_init, { unit has initialization section }
mf_finalize, { unit has finalization section }
mf_checkpointer_called, { Unit uses experimental checkpointer test code }
mf_has_resourcestrings, { unit has resource string section }
mf_release, { unit was compiled with -Ur option }
mf_threadvars, { unit has threadvars }
mf_has_stabs_debuginfo, { this unit has stabs debuginfo generated }
mf_local_symtable, { this unit has a local symtable stored }
mf_uses_variants, { this unit uses variants }
mf_has_resourcefiles, { this unit has external resources (using $R directive)}
mf_has_exports, { this module or a used unit has exports }
mf_has_dwarf_debuginfo, { this unit has dwarf debuginfo generated }
mf_wideinits, { this unit has winlike widestring typed constants }
mf_classinits, { this unit has class constructors/destructors }
mf_resstrinits, { this unit has string consts referencing resourcestrings }
mf_i8086_far_code, { this unit uses an i8086 memory model with far code (i.e. medium, large or huge) }
mf_i8086_far_data, { this unit uses an i8086 memory model with far data (i.e. compact or large) }
mf_i8086_huge_data, { this unit uses an i8086 memory model with huge data (i.e. huge) }
mf_i8086_cs_equals_ds, { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
mf_i8086_ss_equals_ds, { this unit uses an i8086 memory model with SS=DS (i.e. tiny, small or medium) }
mf_package_deny, { this unit must not be part of a package }
mf_package_weak { this unit may be completely contained in a package }
);
tmoduleflags = set of tmoduleflag;
type
ttargetswitchinfo = record
name: string[22];

2
compiler/jvm/njvmutil.pas
View File

@ -404,7 +404,7 @@ implementation
{ class constructors are automatically handled by the JVM }
{ call the unit init code and make it external }
if (hp.u.flags and (uf_init or uf_finalize))<>0 then
if (hp.u.moduleflags*[mf_init,mf_finalize])<>[] then
begin
{ trigger init code by referencing the class representing the
unit; if necessary, it will register the fini code to run on

18
compiler/link.pas
View File

@ -374,22 +374,22 @@ Implementation
begin
with hp do
begin
if (flags and uf_has_resourcefiles)<>0 then
if mf_has_resourcefiles in moduleflags then
HasResources:=true;
if (flags and uf_has_exports)<>0 then
if mf_has_exports in moduleflags then
HasExports:=true;
{ link unit files }
if (flags and uf_no_link)=0 then
if (headerflags and uf_no_link)=0 then
begin
{ create mask which unit files need linking }
mask:=link_always;
{ static linking ? }
if (cs_link_static in current_settings.globalswitches) then
begin
if (flags and uf_static_linked)=0 then
if (headerflags and uf_static_linked)=0 then
begin
{ if smart not avail then try static linking }
if (flags and uf_smart_linked)<>0 then
if (headerflags and uf_smart_linked)<>0 then
begin
Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
mask:=mask or link_smart;
@ -404,10 +404,10 @@ Implementation
if (cs_link_smart in current_settings.globalswitches) then
begin
if (flags and uf_smart_linked)=0 then
if (headerflags and uf_smart_linked)=0 then
begin
{ if smart not avail then try static linking }
if (flags and uf_static_linked)<>0 then
if (headerflags and uf_static_linked)<>0 then
begin
{ if not create_smartlink_library, then smart linking happens using the
regular object files
@ -425,10 +425,10 @@ Implementation
{ shared linking }
if (cs_link_shared in current_settings.globalswitches) then
begin
if (flags and uf_shared_linked)=0 then
if (headerflags and uf_shared_linked)=0 then
begin
{ if shared not avail then try static linking }
if (flags and uf_static_linked)<>0 then
if (headerflags and uf_static_linked)<>0 then
begin
Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
mask:=mask or link_static;

46
compiler/ngenutil.pas
View File

@ -114,8 +114,8 @@ interface
class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
class procedure InsertInitFinalTable;
protected
class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal); virtual;
class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal); virtual;
class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag); virtual;
class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag); virtual;
class procedure insert_init_final_table(entries:tfplist); virtual;
@ -477,7 +477,7 @@ implementation
TSymtable(current_module.globalsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
{ insert class constructors }
if (current_module.flags and uf_classinits) <> 0 then
if mf_classinits in current_module.moduleflags then
append_struct_initfinis(current_module, potype_class_constructor, stat);
end;
{ units have seperate code for initilization and finalization }
@ -501,7 +501,7 @@ implementation
potype_unitfinalize:
begin
{ insert class destructors }
if (current_module.flags and uf_classinits) <> 0 then
if mf_classinits in current_module.moduleflags then
append_struct_initfinis(current_module, potype_class_destructor, stat);
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
@ -954,17 +954,17 @@ implementation
hp:=tused_unit(usedunits.first);
while assigned(hp) do
begin
if (hp.u.flags and (uf_init or uf_finalize))<>0 then
if (hp.u.moduleflags * [mf_init,mf_finalize])<>[] then
begin
new(entry);
entry^.module:=hp.u;
entry^.initpd:=nil;
entry^.finipd:=nil;
if (hp.u.flags and uf_init)<>0 then
if mf_init in hp.u.moduleflags then
entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
else
entry^.initfunc:='';
if (hp.u.flags and uf_finalize)<>0 then
if mf_finalize in hp.u.moduleflags then
entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
else
entry^.finifunc:='';
@ -974,17 +974,17 @@ implementation
end;
{ Insert initialization/finalization of the program }
if (current_module.flags and (uf_init or uf_finalize))<>0 then
if (current_module.moduleflags * [mf_init,mf_finalize])<>[] then
begin
new(entry);
entry^.module:=current_module;
entry^.initpd:=nil;
entry^.finipd:=nil;
if (current_module.flags and uf_init)<>0 then
if mf_init in current_module.moduleflags then
entry^.initfunc:=make_mangledname('INIT$',current_module.localsymtable,'')
else
entry^.initfunc:='';
if (current_module.flags and uf_finalize)<>0 then
if mf_finalize in current_module.moduleflags then
entry^.finifunc:=make_mangledname('FINALIZE$',current_module.localsymtable,'')
else
entry^.finifunc:='';
@ -1160,7 +1160,7 @@ implementation
hp:=tused_unit(usedunits.first);
while assigned(hp) do
begin
if (hp.u.flags and uf_threadvars)=uf_threadvars then
if mf_threadvars in hp.u.moduleflags then
begin
sym:=current_asmdata.RefAsmSymbol(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),AT_DATA,true);
tcb.emit_tai(
@ -1172,7 +1172,7 @@ implementation
hp:=tused_unit(hp.next);
end;
{ Add program threadvars, if any }
if (current_module.flags and uf_threadvars)=uf_threadvars then
if mf_threadvars in current_module.moduleflags then
begin
sym:=current_asmdata.RefAsmSymbol(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,true);
tcb.emit_tai(
@ -1245,7 +1245,7 @@ implementation
sym:=current_asmdata.DefineAsmSymbol(s,AB_GLOBAL,AT_DATA_FORCEINDIRECT,tabledef);
current_asmdata.asmlists[al_globals].concatlist(
tcb.get_final_asmlist(sym,tabledef,sec_data,s,sizeof(pint)));
current_module.flags:=current_module.flags or uf_threadvars;
include(current_module.moduleflags,mf_threadvars);
current_module.add_public_asmsym(sym);
end
else
@ -1254,7 +1254,7 @@ implementation
end;
class procedure tnodeutils.InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal);
class procedure tnodeutils.InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag);
var
hp: tused_unit;
tcb: ttai_typedconstbuilder;
@ -1273,7 +1273,7 @@ implementation
hp:=tused_unit(usedunits.first);
while assigned(hp) do
begin
if (hp.u.flags and unitflag)=unitflag then
if unitflag in hp.u.moduleflags then
begin
tcb.emit_tai(
Tai_const.Createname(make_mangledname(prefix,hp.u.globalsymtable,''),0),
@ -1283,7 +1283,7 @@ implementation
hp:=tused_unit(hp.next);
end;
{ Add items from program, if any }
if (current_module.flags and unitflag)=unitflag then
if unitflag in current_module.moduleflags then
begin
tcb.emit_tai(
Tai_const.Createname(make_mangledname(prefix,current_module.localsymtable,''),0),
@ -1306,7 +1306,7 @@ implementation
end;
class procedure tnodeutils.InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal);
class procedure tnodeutils.InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag);
var
s: string;
item: TTCInitItem;
@ -1344,31 +1344,31 @@ implementation
current_asmdata.DefineAsmSymbol(s,AB_GLOBAL,AT_DATA,rawdatadef),
rawdatadef,sec_data,s,sizeof(pint)));
tcb.free;
current_module.flags:=current_module.flags or unitflag;
include(current_module.moduleflags,unitflag);
end;
class procedure tnodeutils.InsertWideInits;
begin
InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,uf_wideinits);
InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,mf_wideinits);
end;
class procedure tnodeutils.InsertResStrInits;
begin
InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,uf_resstrinits);
InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,mf_resstrinits);
end;
class procedure tnodeutils.InsertWideInitsTablesTable;
begin
InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',uf_wideinits);
InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',mf_wideinits);
end;
class procedure tnodeutils.InsertResStrTablesTable;
begin
InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',uf_resstrinits);
InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',mf_resstrinits);
end;
@ -1389,7 +1389,7 @@ implementation
countplaceholder:=tcb.emit_placeholder(sizesinttype);
while assigned(hp) do
begin
If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
if mf_has_resourcestrings in hp.moduleflags then
begin
tcb.emit_tai(Tai_const.Create_sym(
ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start('RESSTR',hp.localsymtable,[tcdssso_register_asmsym,tcdssso_use_indirect])),

7
compiler/pcp.pas
View File

@ -31,18 +31,13 @@ interface
const
CurrentPCPVersion=3;
{ unit flags }
//uf_init = $000001; { unit has initialization section }
//uf_finalize = $000002; { unit has finalization section }
{ unit flags }
pf_big_endian = $000004;
//uf_has_browser = $000010;
//uf_in_library = $000020; { is the file in another file than <ppufile>.* ? }
//uf_smart_linked = $000040; { the ppu can be smartlinked }
//uf_static_linked = $000080; { the ppu can be linked static }
//uf_shared_linked = $000100; { the ppu can be linked shared }
//uf_local_browser = $000200;
//uf_no_link = $000400; { unit has no .o generated, but can still have external linking! }
//uf_has_resourcestrings = $000800; { unit has resource string section }
pf_little_endian = $001000;

4
compiler/pdecobj.pas
View File

@ -116,7 +116,7 @@ implementation
Message(parser_e_no_paras_for_class_constructor);
consume(_SEMICOLON);
include(astruct.objectoptions,oo_has_class_constructor);
current_module.flags:=current_module.flags or uf_classinits;
include(current_module.moduleflags,mf_classinits);
{ no return value }
pd.returndef:=voidtype;
constr_destr_finish_head(pd,astruct);
@ -238,7 +238,7 @@ implementation
Message(parser_e_no_paras_for_class_destructor);
consume(_SEMICOLON);
include(astruct.objectoptions,oo_has_class_destructor);
current_module.flags:=current_module.flags or uf_classinits;
include(current_module.moduleflags,mf_classinits);
{ no return value }
pd.returndef:=voidtype;
constr_destr_finish_head(pd,astruct);

2
compiler/pdecsub.pas
View File

@ -1321,7 +1321,7 @@ implementation
{
if ((pd.returndef=cvarianttype) or (pd.returndef=colevarianttype)) and
not(cs_compilesystem in current_settings.moduleswitches) then
current_module.flags:=current_module.flags or uf_uses_variants;
include(current_module.moduleflags,mf_uses_variants);
}
if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
Message1(type_e_not_automatable,pd.returndef.typename);

2
compiler/pexports.pas
View File

@ -82,7 +82,7 @@ implementation
end;
begin
current_module.flags:=current_module.flags or uf_has_exports;
include(current_module.moduleflags,mf_has_exports);
DefString:='';
InternalProcName:='';
consume(_EXPORTS);

2
compiler/pexpr.pas
View File

@ -3165,7 +3165,7 @@ implementation
{ We need to know if this unit uses Variants }
if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
not(cs_compilesystem in current_settings.moduleswitches) then
current_module.flags:=current_module.flags or uf_uses_variants;
include(current_module.moduleflags,mf_uses_variants);
p1:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
end;
end;

10
compiler/pkgutil.pas
View File

@ -235,13 +235,13 @@ implementation
u.localsymtable.symlist.ForEachCall(@insert_export,u.localsymtable);
{ create special exports }
if (u.flags and uf_init)<>0 then
if mf_init in u.moduleflags then
procexport(make_mangledname('INIT$',u.globalsymtable,''));
if (u.flags and uf_finalize)<>0 then
if mf_finalize in u.moduleflags then
procexport(make_mangledname('FINALIZE$',u.globalsymtable,''));
if (u.flags and uf_threadvars)=uf_threadvars then
if mf_threadvars in u.moduleflags then
varexport(make_mangledname('THREADVARLIST',u.globalsymtable,''));
if (u.flags and uf_has_resourcestrings)<>0 then
if mf_has_resourcestrings in u.moduleflags then
begin
varexport(ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start('RESSTR',u.localsymtable,[]).name);
varexport(ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_end('RESSTR',u.localsymtable,[]).name);
@ -778,7 +778,7 @@ implementation
end;
if not assigned(module) then
internalerror(2014101001);
if (uf_in_library and module.flags)=0 then
if (uf_in_library and module.headerflags)=0 then
{ unit is not part of a package, so no need to handle it }
continue;
{ loaded by a package? }

56
compiler/pmodules.pas
View File

@ -123,12 +123,12 @@ implementation
{ Insert the used object file for this unit in the used list for this unit }
begin
current_module.linkunitofiles.add(current_module.objfilename,link_static);
current_module.flags:=current_module.flags or uf_static_linked;
current_module.headerflags:=current_module.headerflags or uf_static_linked;
if create_smartlink_library then
begin
current_module.linkunitstaticlibs.add(current_module.staticlibfilename ,link_smart);
current_module.flags:=current_module.flags or uf_smart_linked;
current_module.headerflags:=current_module.headerflags or uf_smart_linked;
end;
end;
@ -163,13 +163,12 @@ implementation
if not CheckResourcesUsed then exit;
hp:=tused_unit(usedunits.first);
found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
If not found then
While Assigned(hp) and not found do
begin
Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
found:=mf_has_resourcefiles in current_module.moduleflags;
while Assigned(hp) and not found do
begin
found:=mf_has_resourcefiles in hp.u.moduleflags;
hp:=tused_unit(hp.next);
end;
end;
CheckResourcesUsed:=found;
end;
@ -210,7 +209,7 @@ implementation
begin
{ Do we need the variants unit? Skip this
for VarUtils unit for bootstrapping }
if (current_module.flags and uf_uses_variants=0) or
if not(mf_uses_variants in current_module.moduleflags) or
(current_module.modulename^='VARUTILS') then
exit;
{ Variants unit already loaded? }
@ -722,16 +721,16 @@ implementation
{$endif i386 or sparcgen}
end;
function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo;
function gen_implicit_initfinal(flag:tmoduleflag;st:TSymtable):tcgprocinfo;
begin
{ create procdef }
case flag of
uf_init :
mf_init :
begin
result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit$'),potype_unitinit,st);
result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
end;
uf_finalize :
mf_finalize :
begin
result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit$'),potype_unitfinalize,st);
result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
@ -1227,7 +1226,7 @@ type
release_proc_symbol(init_procinfo.procdef);
release_main_proc(init_procinfo);
end;
init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
init_procinfo:=gen_implicit_initfinal(mf_init,current_module.localsymtable);
end;
if (force_init_final or cnodeutils.force_final) and
(
@ -1241,7 +1240,7 @@ type
release_proc_symbol(finalize_procinfo.procdef);
release_main_proc(finalize_procinfo);
end;
finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
finalize_procinfo:=gen_implicit_initfinal(mf_finalize,current_module.localsymtable);
end;
{ Now both init and finalize bodies are read and it is known
@ -1255,7 +1254,7 @@ type
begin
init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
init_procinfo.generate_code;
current_module.flags:=current_module.flags or uf_init;
include(current_module.moduleflags,mf_init);
end
else
release_proc_symbol(init_procinfo.procdef);
@ -1270,7 +1269,7 @@ type
begin
finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
finalize_procinfo.generate_code;
current_module.flags:=current_module.flags or uf_finalize;
include(current_module.moduleflags,mf_finalize);
end
else
release_proc_symbol(finalize_procinfo.procdef);
@ -1352,8 +1351,9 @@ type
insertobjectfile
else
begin
current_module.flags:=current_module.flags or uf_no_link;
current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo);
current_module.headerflags:=current_module.headerflags or uf_no_link;
exclude(current_module.moduleflags,mf_has_stabs_debuginfo);
exclude(current_module.moduleflags,mf_has_dwarf_debuginfo);
end;
if ag then
@ -1643,7 +1643,7 @@ type
begin
if (hp<>current_module) and not assigned(hp.package) then
begin
if (hp.flags and uf_package_deny) <> 0 then
if mf_package_deny in hp.moduleflags then
message1(package_e_unit_deny_package,hp.realmodulename^);
{ part of the package's used, aka contained units? }
uu:=tused_unit(current_module.used_units.first);
@ -1686,13 +1686,13 @@ type
{ should we force unit initialization? }
force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
if force_init_final or cnodeutils.force_init then
{init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)};
{init_procinfo:=gen_implicit_initfinal(mf_init,current_module.localsymtable)};
{ Add symbol to the exports section for win32 so smartlinking a
DLL will include the edata section }
if assigned(exportlib) and
(target_info.system in [system_i386_win32,system_i386_wdosx]) and
((current_module.flags and uf_has_exports)<>0) then
(mf_has_exports in current_module.moduleflags) then
current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
{ all labels must be defined before generating code }
@ -2191,13 +2191,13 @@ type
{ should we force unit initialization? }
force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
if force_init_final or cnodeutils.force_init then
init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
init_procinfo:=gen_implicit_initfinal(mf_init,current_module.localsymtable);
{ Add symbol to the exports section for win32 so smartlinking a
DLL will include the edata section }
if assigned(exportlib) and
(target_info.system in [system_i386_win32,system_i386_wdosx]) and
((current_module.flags and uf_has_exports)<>0) then
(mf_has_exports in current_module.moduleflags) then
current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
if (force_init_final or cnodeutils.force_final) and
@ -2212,7 +2212,7 @@ type
release_proc_symbol(finalize_procinfo.procdef);
release_main_proc(finalize_procinfo);
end;
finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
finalize_procinfo:=gen_implicit_initfinal(mf_finalize,current_module.localsymtable);
end;
{ the finalization routine of libraries is generic (and all libraries need to }
@ -2233,7 +2233,7 @@ type
if assigned(init_procinfo) then
begin
{ initialization can be implicit only }
current_module.flags:=current_module.flags or uf_init;
include(current_module.moduleflags,mf_init);
init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
init_procinfo.generate_code;
init_procinfo.resetprocdef;
@ -2247,7 +2247,7 @@ type
begin
finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
finalize_procinfo.generate_code;
current_module.flags:=current_module.flags or uf_finalize;
include(current_module.moduleflags,mf_finalize);
end;
finalize_procinfo.resetprocdef;
release_main_proc(finalize_procinfo);
@ -2414,10 +2414,10 @@ type
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
if (hp<>sysinitmod) and (hp.flags and uf_in_library=0) then
if (hp<>sysinitmod) and ((hp.headerflags and uf_in_library)=0) then
begin
linker.AddModuleFiles(hp);
if (hp.flags and uf_checkpointer_called)<>0 then
if mf_checkpointer_called in hp.moduleflags then
program_uses_checkpointer:=true;
end;
hp2:=tmodule(hp.next);

27
compiler/ppu.pas
View File

@ -43,41 +43,18 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 206;
CurrentPPUVersion = 207;
CurrentPPULongVersion = 1;
{ unit flags }
uf_init = $000001; { unit has initialization section }
uf_finalize = $000002; { unit has finalization section }
uf_big_endian = $000004;
//uf_has_browser = $000010;
uf_in_library = $000020; { is the file in another file than <ppufile>.* ? }
uf_smart_linked = $000040; { the ppu can be smartlinked }
uf_static_linked = $000080; { the ppu can be linked static }
uf_shared_linked = $000100; { the ppu can be linked shared }
//uf_local_browser = $000200;
uf_checkpointer_called = $000200; { Unit uses experimental checkpointer test code }
uf_no_link = $000400; { unit has no .o generated, but can still have external linking! }
uf_has_resourcestrings = $000800; { unit has resource string section }
uf_little_endian = $001000;
uf_release = $002000; { unit was compiled with -Ur option }
uf_threadvars = $004000; { unit has threadvars }
uf_fpu_emulation = $008000; { this unit was compiled with fpu emulation on }
uf_has_stabs_debuginfo = $010000; { this unit has stabs debuginfo generated }
uf_local_symtable = $020000; { this unit has a local symtable stored }
uf_uses_variants = $040000; { this unit uses variants }
uf_has_resourcefiles = $080000; { this unit has external resources (using $R directive)}
uf_has_exports = $100000; { this module or a used unit has exports }
uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated }
uf_wideinits = $400000; { this unit has winlike widestring typed constants }
uf_classinits = $800000; { this unit has class constructors/destructors }
uf_resstrinits = $1000000; { this unit has string consts referencing resourcestrings }
uf_i8086_far_code = $2000000; { this unit uses an i8086 memory model with far code (i.e. medium, large or huge) }
uf_i8086_far_data = $4000000; { this unit uses an i8086 memory model with far data (i.e. compact or large) }
uf_i8086_huge_data = $8000000; { this unit uses an i8086 memory model with huge data (i.e. huge) }
uf_i8086_cs_equals_ds = $10000000; { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
uf_package_deny = $20000000; { this unit must not be part of a package }
uf_package_weak = $40000000; { this unit may be completely contained in a package }
uf_i8086_ss_equals_ds = $80000000; { this unit uses an i8086 memory model with SS=DS (i.e. tiny, small or medium) }
type
{ bestreal is defined based on the target architecture }

22
compiler/scandir.pas
View File

@ -124,7 +124,7 @@ unit scandir;
end;
procedure do_moduleflagswitch(flag:cardinal;optional:boolean);
procedure do_moduleflagswitch(flag:tmoduleflag;optional:boolean);
var
state : char;
begin
@ -133,9 +133,9 @@ unit scandir;
else
state:=current_scanner.readstate;
if state='-' then
current_module.flags:=current_module.flags and not flag
exclude(current_module.moduleflags,flag)
else
current_module.flags:=current_module.flags or flag;
include(current_module.moduleflags,flag);
end;
@ -472,7 +472,7 @@ unit scandir;
procedure dir_denypackageunit;
begin
do_moduleflagswitch(uf_package_deny,true);
do_moduleflagswitch(mf_package_deny,true);
end;
procedure dir_description;
@ -1278,12 +1278,12 @@ unit scandir;
s:=ChangeFileExt(s,target_info.resext);
if target_info.res<>res_none then
begin
current_module.flags:=current_module.flags or uf_has_resourcefiles;
if (res_single_file in target_res.resflags) and
not (Current_module.ResourceFiles.Empty) then
Message(scan_w_only_one_resourcefile_supported)
else
current_module.resourcefiles.insert(FixFileName(s));
include(current_module.moduleflags,mf_has_resourcefiles);
if (res_single_file in target_res.resflags) and
not (Current_module.ResourceFiles.Empty) then
Message(scan_w_only_one_resourcefile_supported)
else
current_module.resourcefiles.insert(FixFileName(s));
end
else
Message(scan_e_resourcefiles_not_supported);
@ -1727,7 +1727,7 @@ unit scandir;
begin
{ old Delphi versions seem to use merely $WEAKPACKAGEUNIT while newer
Delphis have $WEAPACKAGEUNIT ON... :/ }
do_moduleflagswitch(uf_package_weak, true);
do_moduleflagswitch(mf_package_weak, true);
end;
procedure dir_writeableconst;

67
compiler/utils/ppuutils/ppudump.pp
View File

@ -211,6 +211,9 @@ type
ST_FILEINDEX,
ST_LOADMESSAGES);
TPpuModuleDef = class(TPpuUnitDef)
ModuleFlags: tmoduleflags;
end;
var
ppufile : tppufile;
@ -222,7 +225,7 @@ var
pout: TPpuOutput;
nostdout: boolean;
UnitList: TPpuContainerDef;
CurUnit: TPpuUnitDef;
CurUnit: TPpuModuleDef;
SkipVersionCheck: boolean;
@ -553,41 +556,17 @@ type
str : string[30];
end;
const
flagopts=32;
flagopts=8;
flagopt : array[1..flagopts] of tflagopt=(
(mask: $1 ;str:'init'),
(mask: $2 ;str:'final'),
(mask: $4 ;str:'big_endian'),
(mask: $8 ;str:'dbx'),
// (mask: $10 ;str:'browser'),
(mask: $20 ;str:'in_library'),
(mask: $40 ;str:'smart_linked'),
(mask: $80 ;str:'static_linked'),
(mask: $100 ;str:'shared_linked'),
(mask: $200 ;str:'uses_checkpointer'),
(mask: $400 ;str:'no_link'),
(mask: $800 ;str:'has_resources'),
(mask: $1000 ;str:'little_endian'),
(mask: $2000 ;str:'release'),
(mask: $4000 ;str:'local_threadvars'),
(mask: $8000 ;str:'fpu_emulation_on'),
(mask: $210000 ;str:'has_debug_info'),
(mask: $10000 ;str:'stabs_debug_info'),
(mask: $200000 ;str:'dwarf_debug_info'),
(mask: $20000 ;str:'local_symtable'),
(mask: $40000 ;str:'uses_variants'),
(mask: $80000 ;str:'has_resourcefiles'),
(mask: $100000 ;str:'has_exports'),
(mask: $400000 ;str:'has_wideinits'),
(mask: $800000 ;str:'has_classinits'),
(mask: $1000000 ;str:'has_resstrinits'),
(mask: $2000000 ;str:'i8086_far_code'),
(mask: $4000000 ;str:'i8086_far_data'),
(mask: $8000000 ;str:'i8086_huge_data'),
(mask: $10000000;str:'i8086_cs_equals_ds'),
(mask: $20000000;str:'package_deny'),
(mask: $40000000;str:'package_weak'),
(mask: dword($80000000);str:'i8086_ss_equals_ds')
(mask: $8000 ;str:'fpu_emulation_on')
);
var
i : longint;
@ -3726,6 +3705,13 @@ begin
b:=readentry;
case b of
ibextraheader:
begin
CurUnit.LongVersion:=cardinal(getlongint);
Writeln(['LongVersion: ',CurUnit.LongVersion]);
getsmallset(CurUnit.ModuleFlags);
end;
ibmodulename :
begin
CurUnit.Name:=getstring;
@ -3901,6 +3887,24 @@ begin
end;
function parseextraheader(module: TPpuModuleDef; ppufile: tppufile): boolean;
var
b: byte;
begin
result:=true;
if ppuversion>=207 then
begin
result:=false;
b:=ppufile.readentry;
if b<>ibextraheader then
exit;
CurUnit.LongVersion:=cardinal(ppufile.getlongint);
Writeln(['LongVersion: ',CurUnit.LongVersion]);
ppufile.getsmallset(CurUnit.ModuleFlags);
result:=ppufile.EndOfEntry;
end;
end;
procedure dofile (filename : string);
begin
{ reset }
@ -3936,9 +3940,14 @@ begin
exit;
end;
CurUnit:=TPpuUnitDef.Create(UnitList);
CurUnit:=TPpuModuleDef.Create(UnitList);
CurUnit.Version:=ppuversion;
if not parseextraheader(CurUnit, ppufile) then
begin
WriteError(Format('Unsupported PPU sub-version %d. Expecting PPU sub-version %d.', [CurUnit.LongVersion, CurrentPPULongVersion]));
end;
{ Write PPU Header Information }
if (verbose and v_header)<>0 then
begin
@ -4049,7 +4058,7 @@ begin
Writeln('Implementation symtable');
Writeln('----------------------');
readsymtableoptions('implementation');
if (ppufile.header.common.flags and uf_local_symtable)<>0 then
if (mf_local_symtable in CurUnit.ModuleFlags) then
begin
if (verbose and v_defs)<>0 then
begin

1
compiler/utils/ppuutils/ppuout.pp
View File

@ -177,6 +177,7 @@ type
UsedUnits: TPpuContainerDef;
RefUnits: array of string;
SourceFiles: TPpuContainerDef;
LongVersion: Cardinal;
constructor Create(AParent: TPpuContainerDef); override;
destructor Destroy; override;