paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 21:48:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add support for $SetPE{OS,SubSys,User}Version directives; Delphi compatible; Note: $SetPEUserVersion takes precedence to $Version

Browse Source 
+ added test

git-svn-id: trunk@37364 -
This commit is contained in:
svenbarth 2017-09-30 13:55:29 +00:00
parent 76a6c67022
commit 9619576515
8 changed files with 934 additions and 764 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11408,6 +11408,7 @@ tests/tbs/tb0629.pp svneol=native#text/pascal
tests/tbs/tb0630.pp svneol=native#text/pascal
tests/tbs/tb0631.pp svneol=native#text/pascal
tests/tbs/tb0632.pp svneol=native#text/pascal
tests/tbs/tb0633.pp svneol=native#text/pascal
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tb610.pp svneol=native#text/pascal
tests/tbs/tb613.pp svneol=native#text/plain

12
compiler/globals.pas
View File

@ -287,6 +287,9 @@ interface
description : string;
SetPEFlagsSetExplicity,
SetPEOptFlagsSetExplicity,
SetPEOSVersionSetExplicitely,
SetPESubSysVersionSetExplicitely,
SetPEUserVersionSetExplicitely,
ImageBaseSetExplicity,
MinStackSizeSetExplicity,
MaxStackSizeSetExplicity,
@ -296,6 +299,12 @@ interface
dllminor,
dllrevision : word; { revision only for netware }
{ win pe }
peosversionminor,
peosversionmajor,
pesubsysversionminor,
pesubsysversionmajor,
peuserversionminor,
peuserversionmajor : word;
peoptflags,
peflags : longint;
minstacksize,
@ -1517,6 +1526,9 @@ implementation
DescriptionSetExplicity:=false;
SetPEFlagsSetExplicity:=false;
SetPEOptFlagsSetExplicity:=false;
SetPEOSVersionSetExplicitely:=false;
SetPESubSysVersionSetExplicitely:=false;
SetPEUserVersionSetExplicitely:=false;
ImageBaseSetExplicity:=false;
MinStackSizeSetExplicity:=false;
MaxStackSizeSetExplicity:=false;

8
compiler/msg/errore.msg
View File

@ -142,7 +142,7 @@ general_e_exception_raised=01026_E_Compilation raised exception internally
#
# Scanner
#
# 02101 is the last used one
# 02104 is the last used one
#
% \section{Scanner messages.}
% This section lists the messages that the scanner emits. The scanner takes
@ -421,6 +421,12 @@ scan_w_syscall_convention_not_useable_on_target=02100_W_Specified syscall conven
% is not useable on the current target system.
scan_w_syscall_convention_invalid=02101_W_Invalid syscall convention specified
% The compiler did not recognize the syscall convention specified by the \var{\{\$SYSCALL xxx\}} directive.
scan_w_setpeuserversion_not_support=02102_W_SETPEUSERVERSION is not supported by the target OS
% The \var{\{\$SETPEUSERVERSION\}} directive is not supported by the target OS.
scan_w_setpeosversion_not_support=02103_W_SETPEOSVERSION is not supported by the target OS
% The \var{\{\$SETPEOSVERSION\}} directive is not supported by the target OS.
scan_w_setpesubsysversion_not_support=02104_W_SETPESUBSYSVERSION is not supported by the target OS
% The \var{\{\$SETPESUBSYSVERSION\}} directive is not supported by the target OS.
% \end{description}
#
# Parser

7
compiler/msgidx.inc
View File

@ -124,6 +124,9 @@ const
scan_e_illegal_asmcpu_specifier=02099;
scan_w_syscall_convention_not_useable_on_target=02100;
scan_w_syscall_convention_invalid=02101;
scan_w_setpeuserversion_not_support=02102;
scan_w_setpeosversion_not_support=02103;
scan_w_setpesubsysversion_not_support=02104;
parser_e_syntax_error=03000;
parser_e_dont_nest_interrupt=03004;
parser_w_proc_directive_ignored=03005;
@ -1080,9 +1083,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 80284;
MsgTxtSize = 80461;
MsgIdxMax : array[1..20] of longint=(
27,102,347,124,96,58,132,33,221,67,
27,105,347,124,96,58,132,33,221,67,
60,20,30,1,1,1,1,1,1,1
);

1507
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

40
compiler/ogcoff.pas
View File

@ -2621,15 +2621,39 @@ const pemagic : array[0..3] of byte = (
peoptheader.ImageBase:=ImageBase;
peoptheader.SectionAlignment:=SectionMemAlign;
peoptheader.FileAlignment:=SectionDataAlign;
peoptheader.MajorOperatingSystemVersion:=4;
peoptheader.MinorOperatingSystemVersion:=0;
peoptheader.MajorImageVersion:=dllmajor;
peoptheader.MinorImageVersion:=dllminor;
if target_info.system in systems_wince then
peoptheader.MajorSubsystemVersion:=3
if SetPEOSVersionSetExplicitely then
begin
peoptheader.MajorOperatingSystemVersion:=peosversionmajor;
peoptheader.MinorOperatingSystemVersion:=peosversionminor;
end
else
peoptheader.MajorSubsystemVersion:=4;
peoptheader.MinorSubsystemVersion:=0;
begin
peoptheader.MajorOperatingSystemVersion:=10;
peoptheader.MinorOperatingSystemVersion:=0;
end;
if SetPEUserVersionSetExplicitely then
begin
peoptheader.MajorImageVersion:=peuserversionmajor;
peoptheader.MinorImageVersion:=peuserversionminor;
end
else
begin
peoptheader.MajorImageVersion:=dllmajor;
peoptheader.MinorImageVersion:=dllminor;
end;
if SetPESubSysVersionSetExplicitely then
begin
peoptheader.MajorSubsystemVersion:=pesubsysversionmajor;
peoptheader.MinorSubsystemVersion:=pesubsysversionminor;
end
else
begin
if target_info.system in systems_wince then
peoptheader.MajorSubsystemVersion:=3
else
peoptheader.MajorSubsystemVersion:=6;
peoptheader.MinorSubsystemVersion:=2;
end;
peoptheader.Win32Version:=0;
peoptheader.SizeOfImage:=Align(CurrMemPos,SectionMemAlign);
peoptheader.SizeOfHeaders:=textExeSec.DataPos;

111
compiler/scandir.pas
View File

@ -140,6 +140,75 @@ unit scandir;
Message1(w,current_scanner.readcomment);
end;
procedure do_version(out major, minor, revision: word; out verstr: string; allowrevision: boolean; out isset: boolean);
var
majorl,
minorl,
revisionl,
error : longint;
begin
{ change description global var in all cases }
{ it not used but in win32, os2 and netware }
current_scanner.skipspace;
{ we should only accept Major.Minor format for win32 and os2 }
current_scanner.readnumber;
major:=0;
minor:=0;
revision:=0;
verstr:='';
isset:=false;
majorl:=0;
minorl:=0;
revisionl:=0;
val(pattern,majorl,error);
if (error<>0) or (majorl > high(word)) or (majorl < 0) then
begin
Message1(scan_w_wrong_version_ignored,pattern);
exit;
end;
isset:=true;
if c='.' then
begin
current_scanner.readchar;
current_scanner.readnumber;
val(pattern,minorl,error);
if (error<>0) or (minorl > high(word)) or (minorl < 0) then
begin
Message1(scan_w_wrong_version_ignored,tostr(majorl)+'.'+pattern);
exit;
end;
if (c='.') and
allowrevision then
begin
current_scanner.readchar;
current_scanner.readnumber;
val(pattern,revisionl,error);
if (error<>0) or (revisionl > high(word)) or (revisionl < 0) then
begin
Message1(scan_w_wrong_version_ignored,tostr(majorl)+'.'+tostr(minorl)+'.'+pattern);
exit;
end;
major:=word(majorl);
minor:=word(minorl);
revision:=word(revisionl);
verstr:=tostr(major)+','+tostr(minor)+','+tostr(revision);
end
else
begin
major:=word(majorl);
minor:=word(minorl);
verstr:=tostr(major)+'.'+tostr(minor);
end;
end
else
begin
major:=word(majorl);
verstr:=tostr(major);
end;
end;
{*****************************************************************************
Directive Callbacks
*****************************************************************************}
@ -1256,6 +1325,45 @@ unit scandir;
SetPEOptFlagsSetExplicity:=true;
end;
procedure dir_setpeuserversion;
var
dummystr : string;
dummyrev : word;
begin
if not (target_info.system in systems_all_windows) then
Message(scan_w_setpeuserversion_not_support);
if (compile_level<>1) then
Message(scan_n_only_exe_version)
else
do_version(peuserversionmajor,peuserversionminor,dummyrev,dummystr,false,SetPEUserVersionSetExplicitely);
end;
procedure dir_setpeosversion;
var
dummystr : string;
dummyrev : word;
begin
if not (target_info.system in systems_all_windows) then
Message(scan_w_setpeosversion_not_support);
if (compile_level<>1) then
Message(scan_n_only_exe_version)
else
do_version(peosversionmajor,peosversionminor,dummyrev,dummystr,false,SetPEOSVersionSetExplicitely);
end;
procedure dir_setpesubsysversion;
var
dummystr : string;
dummyrev : word;
begin
if not (target_info.system in systems_all_windows) then
Message(scan_w_setpesubsysversion_not_support);
if (compile_level<>1) then
Message(scan_n_only_exe_version)
else
do_version(pesubsysversionmajor,pesubsysversionminor,dummyrev,dummystr,false,SetPESubSysVersionSetExplicitely);
end;
procedure dir_smartlink;
begin
do_moduleswitch(cs_create_smart);
@ -1855,6 +1963,9 @@ unit scandir;
AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums);
AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
AddDirective('SETPEOPTFLAGS', directive_all, @dir_setpeoptflags);
AddDirective('SETPEOSVERSION', directive_all, @dir_setpeosversion);
AddDirective('SETPEUSERVERSION', directive_all, @dir_setpeuserversion);
AddDirective('SETPESUBSYSVERSION', directive_all, @dir_setpesubsysversion);
AddDirective('SCREENNAME',directive_all, @dir_screenname);
AddDirective('SMARTLINK',directive_all, @dir_smartlink);
AddDirective('STACKFRAMES',directive_all, @dir_stackframes);

12
tests/tbs/tb0633.pp Normal file
View File

@ -0,0 +1,12 @@
{ %NORUN }
{ %TARGET=win32,win64,wince }
{ %OPT=-Sew }
program tb0633;
{$SetPESubSysVersion 8.3}
{$SetPEUserVersion 13.6}
{$SetPEOSVersion 24.8}
begin
end.