summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2019-04-06 21:28:43 +0000
committerjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2019-04-06 21:28:43 +0000
commit16c4b2098bf51b2562fb33f3258b13220a6ed06f (patch)
treee2bf43d209c584df5420ef966a9643ca9fe83045 /compiler
parent6fb791fbff85c479f58a24a5819595b1d9c7376f (diff)
downloadfpc-16c4b2098bf51b2562fb33f3258b13220a6ed06f.tar.gz
* added extra header to ppu inside a subsection, so we won't run into
trouble when the ppu version hits 255 * also moved several ppu flags to a set inside that section git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@41846 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'compiler')
-rw-r--r--compiler/cresstr.pas2
-rw-r--r--compiler/dbgdwarf.pas4
-rw-r--r--compiler/dbgstabs.pas4
-rw-r--r--compiler/entfile.pas1
-rw-r--r--compiler/fmodule.pas14
-rw-r--r--compiler/fpcp.pas7
-rw-r--r--compiler/fppu.pas278
-rw-r--r--compiler/globtype.pas27
-rw-r--r--compiler/jvm/njvmutil.pas2
-rw-r--r--compiler/link.pas18
-rw-r--r--compiler/ngenutil.pas46
-rw-r--r--compiler/pcp.pas7
-rw-r--r--compiler/pdecobj.pas4
-rw-r--r--compiler/pdecsub.pas2
-rw-r--r--compiler/pexports.pas2
-rw-r--r--compiler/pexpr.pas2
-rw-r--r--compiler/pkgutil.pas10
-rw-r--r--compiler/pmodules.pas56
-rw-r--r--compiler/ppu.pas27
-rw-r--r--compiler/scandir.pas22
-rw-r--r--compiler/utils/ppuutils/ppudump.pp67
-rw-r--r--compiler/utils/ppuutils/ppuout.pp1
22 files changed, 330 insertions, 273 deletions
diff --git a/compiler/cresstr.pas b/compiler/cresstr.pas
index 0180cdc376..cb16ee51ad 100644
--- a/compiler/cresstr.pas
+++ b/compiler/cresstr.pas
@@ -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;
diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas
index 25ea38a0f5..c83ceda72d 100644
--- a/compiler/dbgdwarf.pas
+++ b/compiler/dbgdwarf.pas
@@ -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));
diff --git a/compiler/dbgstabs.pas b/compiler/dbgstabs.pas
index 45ea3e678d..391be2fe15 100644
--- a/compiler/dbgstabs.pas
+++ b/compiler/dbgstabs.pas
@@ -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));
diff --git a/compiler/entfile.pas b/compiler/entfile.pas
index 8b7fc3abc4..4feec407cc 100644
--- a/compiler/entfile.pas
+++ b/compiler/entfile.pas
@@ -38,6 +38,7 @@ const
subentryid = 2;
{special}
iberror = 0;
+ ibextraheader = 242;
ibpputable = 243;
ibstartrequireds = 244;
ibendrequireds = 245;
diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas
index c2dce8b017..9774e8293b 100644
--- a/compiler/fmodule.pas
+++ b/compiler/fmodule.pas
@@ -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);
diff --git a/compiler/fpcp.pas b/compiler/fpcp.pas
index 3ad2e75d32..3d6cee1288 100644
--- a/compiler/fpcp.pas
+++ b/compiler/fpcp.pas
@@ -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}));
diff --git a/compiler/fppu.pas b/compiler/fppu.pas
index acff8e0528..8b00cc29cf 100644
--- a/compiler/fppu.pas
+++ b/compiler/fppu.pas
@@ -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;
- 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}
+
+ 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 ((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;
+ { 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;
+ 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);
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index f883227ca1..1da88ae881 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -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];
diff --git a/compiler/jvm/njvmutil.pas b/compiler/jvm/njvmutil.pas
index c412ec43e1..bc9cdad852 100644
--- a/compiler/jvm/njvmutil.pas
+++ b/compiler/jvm/njvmutil.pas
@@ -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
diff --git a/compiler/link.pas b/compiler/link.pas
index 887a5f1ebd..03432fdf18 100644
--- a/compiler/link.pas
+++ b/compiler/link.pas
@@ -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;
diff --git a/compiler/ngenutil.pas b/compiler/ngenutil.pas
index 7891dec94d..9a892f53a6 100644
--- a/compiler/ngenutil.pas
+++ b/compiler/ngenutil.pas
@@ -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])),
diff --git a/compiler/pcp.pas b/compiler/pcp.pas
index b1f96cde07..5d9960d395 100644
--- a/compiler/pcp.pas
+++ b/compiler/pcp.pas
@@ -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;
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index e8e6f4a961..5d906b84fe 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -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);
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 4bf64c462b..9632a4afa1 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -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);
diff --git a/compiler/pexports.pas b/compiler/pexports.pas
index 031b081723..d789977fdd 100644
--- a/compiler/pexports.pas
+++ b/compiler/pexports.pas
@@ -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);
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 251c613ef1..8caed39b77 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -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;
diff --git a/compiler/pkgutil.pas b/compiler/pkgutil.pas
index cd353c71c7..1c62bc8924 100644
--- a/compiler/pkgutil.pas
+++ b/compiler/pkgutil.pas
@@ -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? }
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index 4c538c82ca..c2752e8225 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -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);
diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index 1c86e7ff0a..45f6d22532 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -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 }
diff --git a/compiler/scandir.pas b/compiler/scandir.pas
index f3fe0286d8..3b9b479fc3 100644
--- a/compiler/scandir.pas
+++ b/compiler/scandir.pas
@@ -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;
diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp
index 3063b90464..d7542c6d02 100644
--- a/compiler/utils/ppuutils/ppudump.pp
+++ b/compiler/utils/ppuutils/ppudump.pp
@@ -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
diff --git a/compiler/utils/ppuutils/ppuout.pp b/compiler/utils/ppuutils/ppuout.pp
index e11724f8c5..348d7f1b90 100644
--- a/compiler/utils/ppuutils/ppuout.pp
+++ b/compiler/utils/ppuutils/ppuout.pp
@@ -177,6 +177,7 @@ type
UsedUnits: TPpuContainerDef;
RefUnits: array of string;
SourceFiles: TPpuContainerDef;
+ LongVersion: Cardinal;
constructor Create(AParent: TPpuContainerDef); override;
destructor Destroy; override;