mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-02 18:10:23 +02:00
renamed to fit in 8.3 limitation
This commit is contained in:
pierre
parent
b655569229
commit
2d8319c249
368
compiler/utils/postw32.pp
Normal file
368
compiler/utils/postw32.pp
Normal file
@ -0,0 +1,368 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2000 by Pavel Ozerski
|
||||
|
||||
This program implements support post processing
|
||||
for the (i386) Win32 target
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
|
||||
program post_process_win32_executable;
|
||||
|
||||
|
||||
uses
|
||||
globtype,globals,strings;
|
||||
|
||||
const
|
||||
execinfo_f_cant_open_executable='Cannot open file ';
|
||||
execinfo_x_codesize='Code size: ';
|
||||
execinfo_x_initdatasize='Size of Initialized Data: ';
|
||||
execinfo_x_uninitdatasize='Size of Uninitialized Data: ';
|
||||
execinfo_f_cant_process_executable='Cannot process file ';
|
||||
execinfo_x_stackreserve='Size of Stack Reserve: ';
|
||||
execinfo_x_stackcommit='Size of Stack Commit: ';
|
||||
var
|
||||
verbose:longbool;
|
||||
ii,jj:longint;
|
||||
code:integer;
|
||||
DllVersion : sTring;
|
||||
Dllmajor,Dllminor : word;
|
||||
|
||||
procedure Message1(const info,fn:string);
|
||||
var
|
||||
e:longbool;
|
||||
begin
|
||||
e:=pos('Cannot',info)=1;
|
||||
if verbose or e then
|
||||
writeln(info,fn);
|
||||
if e then
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
|
||||
function postprocessexecutable(const fn : string;isdll:boolean):boolean;
|
||||
type
|
||||
tdosheader = packed record
|
||||
e_magic : word;
|
||||
e_cblp : word;
|
||||
e_cp : word;
|
||||
e_crlc : word;
|
||||
e_cparhdr : word;
|
||||
e_minalloc : word;
|
||||
e_maxalloc : word;
|
||||
e_ss : word;
|
||||
e_sp : word;
|
||||
e_csum : word;
|
||||
e_ip : word;
|
||||
e_cs : word;
|
||||
e_lfarlc : word;
|
||||
e_ovno : word;
|
||||
e_res : array[0..3] of word;
|
||||
e_oemid : word;
|
||||
e_oeminfo : word;
|
||||
e_res2 : array[0..9] of word;
|
||||
e_lfanew : longint;
|
||||
end;
|
||||
tpeheader = packed record
|
||||
PEMagic : array[0..3] of char;
|
||||
Machine : word;
|
||||
NumberOfSections : word;
|
||||
TimeDateStamp : longint;
|
||||
PointerToSymbolTable : longint;
|
||||
NumberOfSymbols : longint;
|
||||
SizeOfOptionalHeader : word;
|
||||
Characteristics : word;
|
||||
Magic : word;
|
||||
MajorLinkerVersion : byte;
|
||||
MinorLinkerVersion : byte;
|
||||
SizeOfCode : longint;
|
||||
SizeOfInitializedData : longint;
|
||||
SizeOfUninitializedData : longint;
|
||||
AddressOfEntryPoint : longint;
|
||||
BaseOfCode : longint;
|
||||
BaseOfData : longint;
|
||||
ImageBase : longint;
|
||||
SectionAlignment : longint;
|
||||
FileAlignment : longint;
|
||||
MajorOperatingSystemVersion : word;
|
||||
MinorOperatingSystemVersion : word;
|
||||
MajorImageVersion : word;
|
||||
MinorImageVersion : word;
|
||||
MajorSubsystemVersion : word;
|
||||
MinorSubsystemVersion : word;
|
||||
Reserved1 : longint;
|
||||
SizeOfImage : longint;
|
||||
SizeOfHeaders : longint;
|
||||
CheckSum : longint;
|
||||
Subsystem : word;
|
||||
DllCharacteristics : word;
|
||||
SizeOfStackReserve : longint;
|
||||
SizeOfStackCommit : longint;
|
||||
SizeOfHeapReserve : longint;
|
||||
SizeOfHeapCommit : longint;
|
||||
LoaderFlags : longint;
|
||||
NumberOfRvaAndSizes : longint;
|
||||
DataDirectory : array[1..$80] of byte;
|
||||
end;
|
||||
tcoffsechdr=packed record
|
||||
name : array[0..7] of char;
|
||||
vsize : longint;
|
||||
rvaofs : longint;
|
||||
datalen : longint;
|
||||
datapos : longint;
|
||||
relocpos : longint;
|
||||
lineno1 : longint;
|
||||
nrelocs : word;
|
||||
lineno2 : word;
|
||||
flags : longint;
|
||||
end;
|
||||
psecfill=^tsecfill;
|
||||
tsecfill=record
|
||||
fillpos,
|
||||
fillsize : longint;
|
||||
next : psecfill;
|
||||
end;
|
||||
var
|
||||
f : file;
|
||||
dosheader : tdosheader;
|
||||
peheader : tpeheader;
|
||||
firstsecpos,
|
||||
maxfillsize,
|
||||
l,peheaderpos : longint;
|
||||
coffsec : tcoffsechdr;
|
||||
secroot,hsecroot : psecfill;
|
||||
zerobuf : pointer;
|
||||
begin
|
||||
postprocessexecutable:=false;
|
||||
{ open file }
|
||||
assign(f,fn);
|
||||
{$I-}
|
||||
reset(f,1);
|
||||
if ioresult<>0 then
|
||||
Message1(execinfo_f_cant_open_executable,fn);
|
||||
{ read headers }
|
||||
blockread(f,dosheader,sizeof(tdosheader));
|
||||
peheaderpos:=dosheader.e_lfanew;
|
||||
seek(f,peheaderpos);
|
||||
blockread(f,peheader,sizeof(tpeheader));
|
||||
{ write info }
|
||||
Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
|
||||
Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
|
||||
Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
|
||||
{ change stack size (PM) }
|
||||
{ I am not sure that the default value is adequate !! }
|
||||
peheader.SizeOfStackReserve:=stacksize;
|
||||
{ change the header }
|
||||
{ sub system }
|
||||
{ gui=2 }
|
||||
{ cui=3 }
|
||||
if apptype=at_gui then
|
||||
peheader.Subsystem:=2
|
||||
else if apptype=at_cui then
|
||||
peheader.Subsystem:=3;
|
||||
if dllversion<>'' then
|
||||
begin
|
||||
peheader.MajorImageVersion:=dllmajor;
|
||||
peheader.MinorImageVersion:=dllminor;
|
||||
end;
|
||||
{ reset timestamp }
|
||||
peheader.TimeDateStamp:=0;
|
||||
{ write header back }
|
||||
seek(f,peheaderpos);
|
||||
blockwrite(f,peheader,sizeof(tpeheader));
|
||||
if ioresult<>0 then
|
||||
Message1(execinfo_f_cant_process_executable,fn);
|
||||
seek(f,peheaderpos);
|
||||
blockread(f,peheader,sizeof(tpeheader));
|
||||
{ write the value after the change }
|
||||
Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
|
||||
Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
|
||||
{ read section info }
|
||||
maxfillsize:=0;
|
||||
firstsecpos:=0;
|
||||
secroot:=nil;
|
||||
for l:=1to peheader.NumberOfSections do
|
||||
begin
|
||||
blockread(f,coffsec,sizeof(tcoffsechdr));
|
||||
if coffsec.datapos>0 then
|
||||
begin
|
||||
if secroot=nil then
|
||||
firstsecpos:=coffsec.datapos;
|
||||
new(hsecroot);
|
||||
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
|
||||
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
|
||||
hsecroot^.next:=secroot;
|
||||
secroot:=hsecroot;
|
||||
if secroot^.fillsize>maxfillsize then
|
||||
maxfillsize:=secroot^.fillsize;
|
||||
end;
|
||||
end;
|
||||
if firstsecpos>0 then
|
||||
begin
|
||||
l:=firstsecpos-filepos(f);
|
||||
if l>maxfillsize then
|
||||
maxfillsize:=l;
|
||||
end
|
||||
else
|
||||
l:=0;
|
||||
{ get zero buffer }
|
||||
getmem(zerobuf,maxfillsize);
|
||||
fillchar(zerobuf^,maxfillsize,0);
|
||||
{ zero from sectioninfo until first section }
|
||||
blockwrite(f,zerobuf^,l);
|
||||
{ zero section alignments }
|
||||
while assigned(secroot) do
|
||||
begin
|
||||
seek(f,secroot^.fillpos);
|
||||
blockwrite(f,zerobuf^,secroot^.fillsize);
|
||||
hsecroot:=secroot;
|
||||
secroot:=secroot^.next;
|
||||
dispose(hsecroot);
|
||||
end;
|
||||
freemem(zerobuf,maxfillsize);
|
||||
close(f);
|
||||
{$I+}
|
||||
if ioresult<>0 then;
|
||||
postprocessexecutable:=true;
|
||||
end;
|
||||
|
||||
var
|
||||
fn,s:string;
|
||||
|
||||
function GetSwitchValue(const key,shortkey,default:string;const PossibleValues:array of pchar):string;
|
||||
var
|
||||
i,j,k:longint;
|
||||
x:double;
|
||||
s1,s2:string;
|
||||
code:integer;
|
||||
procedure Error;
|
||||
begin
|
||||
writeln('Error: unrecognized option ',paramstr(i),' ',s1);
|
||||
halt(1);
|
||||
end;
|
||||
begin
|
||||
for i:=1 to paramcount do
|
||||
if(paramstr(i)=key)or(paramstr(i)=shortkey)then
|
||||
begin
|
||||
s1:=paramstr(succ(i));
|
||||
for j:=0 to high(PossibleValues)do
|
||||
begin
|
||||
s2:=strpas(PossibleValues[j]);
|
||||
if(length(s2)>1)and(s2[1]='*')then
|
||||
case s2[2]of
|
||||
'i':
|
||||
begin
|
||||
val(s1,k,code);
|
||||
if code<>0 then
|
||||
error;
|
||||
GetSwitchValue:=s1;
|
||||
exit;
|
||||
end;
|
||||
'r':
|
||||
begin
|
||||
val(s1,x,code);
|
||||
if code<>0 then
|
||||
error;
|
||||
GetSwitchValue:=s1;
|
||||
exit;
|
||||
end;
|
||||
's':
|
||||
begin
|
||||
GetSwitchValue:=s1;
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else if s1=s2 then
|
||||
begin
|
||||
GetSwitchValue:=s1;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
error;
|
||||
end;
|
||||
GetSwitchValue:=default;
|
||||
end;
|
||||
procedure help_info;
|
||||
begin
|
||||
fn:=paramstr(0);
|
||||
for jj:=length(fn)downto 1 do
|
||||
if fn[jj] in [':','\','/']then
|
||||
begin
|
||||
fn:=copy(fn,succ(jj),255);
|
||||
break;
|
||||
end;
|
||||
writeln('Usage: ',fn,' [options]');
|
||||
writeln('Options:');
|
||||
writeln('-i | --input <file> - set input file;');
|
||||
writeln('-m | --subsystem <console | gui> - set Win32 subsystem;');
|
||||
writeln('-s | --stack <size> - set stack size;');
|
||||
writeln('-V | --version <n.n> - set image version;');
|
||||
writeln('-v | --verbose - show info while processing;');
|
||||
writeln('-h | --help | -? - show this screen');
|
||||
halt;
|
||||
end;
|
||||
begin
|
||||
aktglobalswitches:=[];
|
||||
verbose:=false;
|
||||
if paramcount=0 then
|
||||
help_info;
|
||||
for ii:=1 to paramcount do
|
||||
if(paramstr(ii)='-h')or(paramstr(ii)='--help')or(paramstr(ii)='-?')then
|
||||
help_info
|
||||
else if(paramstr(ii)='-v')or(paramstr(ii)='--verbose')then
|
||||
begin
|
||||
verbose:=true;
|
||||
break;
|
||||
end;
|
||||
fn:=GetSwitchValue('--input','-i','',['*s']);
|
||||
val(GetSwitchValue('--stack','-s','33554432',['*i']),stacksize,code);
|
||||
{value from
|
||||
systems.pas
|
||||
for Win32 target}
|
||||
|
||||
s:=GetSwitchValue('--subsystem','-m','console',['gui','console']);
|
||||
if s='gui' then
|
||||
apptype:=at_GUI
|
||||
else
|
||||
apptype:=at_cui;
|
||||
|
||||
dllversion:=GetSwitchValue('--version','-V','1.0',['*r']);
|
||||
ii:=pos('.',dllversion);
|
||||
if ii=0 then
|
||||
begin
|
||||
ii:=succ(length(dllversion));
|
||||
dllversion:=dllversion+'.0';
|
||||
end
|
||||
else if ii=1 then
|
||||
begin
|
||||
ii:=2;
|
||||
dllversion:='0.'+dllversion;
|
||||
end;
|
||||
val(copy(dllversion,1,pred(ii)),dllmajor,code);
|
||||
val(copy(dllversion,succ(ii),length(dllversion)),dllminor,code);
|
||||
if verbose then
|
||||
writeln('Image Version: ',dllmajor,'.',dllminor);
|
||||
PostProcessExecutable(fn,false);
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-04-14 11:10:46 pierre
|
||||
renamed to fit in 8.3 limitation
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user