From 16c4b2098bf51b2562fb33f3258b13220a6ed06f Mon Sep 17 00:00:00 2001 From: jonas Date: Sat, 6 Apr 2019 21:28:43 +0000 Subject: * 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 --- compiler/cresstr.pas | 2 +- compiler/dbgdwarf.pas | 4 +- compiler/dbgstabs.pas | 4 +- compiler/entfile.pas | 1 + compiler/fmodule.pas | 14 +- compiler/fpcp.pas | 7 +- compiler/fppu.pas | 278 +++++++++++++++++++++---------------- compiler/globtype.pas | 27 ++++ compiler/jvm/njvmutil.pas | 2 +- compiler/link.pas | 18 +-- compiler/ngenutil.pas | 46 +++--- compiler/pcp.pas | 7 +- compiler/pdecobj.pas | 4 +- compiler/pdecsub.pas | 2 +- compiler/pexports.pas | 2 +- compiler/pexpr.pas | 2 +- compiler/pkgutil.pas | 10 +- compiler/pmodules.pas | 56 ++++---- compiler/ppu.pas | 27 +--- compiler/scandir.pas | 22 +-- compiler/utils/ppuutils/ppudump.pp | 67 +++++---- compiler/utils/ppuutils/ppuout.pp | 1 + 22 files changed, 330 insertions(+), 273 deletions(-) (limited to 'compiler') 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 .* ? } //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 .* ? } 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; -- cgit v1.2.1