Browse Source

+ implemented directives $setpeflags, $maxstacksize, $minstacksize and $imagebase, fixes #6349 and #6714

git-svn-id: trunk@3935 -
florian 19 years ago
parent
commit
dc2bef3875
7 changed files with 452 additions and 413 deletions
  1. 17 3
      compiler/globals.pas
  2. 8 0
      compiler/msg/errore.msg
  3. 6 2
      compiler/msgidx.inc
  4. 247 245
      compiler/msgtxt.inc
  5. 94 87
      compiler/ogcoff.pas
  6. 41 0
      compiler/scandir.pas
  7. 39 76
      compiler/systems/t_win.pas

+ 17 - 3
compiler/globals.pas

@@ -171,11 +171,20 @@ interface
        { linking }
        { linking }
        usewindowapi  : boolean;
        usewindowapi  : boolean;
        description   : string;
        description   : string;
+       SetPEFlagsSetExplicity,
+       ImageBaseSetExplicity,
+       MinStackSizeSetExplicity,
+       MaxStackSizeSetExplicity,
        DescriptionSetExplicity : boolean;
        DescriptionSetExplicity : boolean;
        dllversion    : string;
        dllversion    : string;
        dllmajor,
        dllmajor,
        dllminor,
        dllminor,
        dllrevision   : word;  { revision only for netware }
        dllrevision   : word;  { revision only for netware }
+       { win pe  }
+       peflags : longint;
+       minstacksize,
+       maxstacksize,
+       imagebase : aword;
        UseDeffileForExports    : boolean;
        UseDeffileForExports    : boolean;
        UseDeffileForExportsSetExplicitly : boolean;
        UseDeffileForExportsSetExplicitly : boolean;
        GenerateImportSection,
        GenerateImportSection,
@@ -205,7 +214,7 @@ interface
        aktexceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
        aktexceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
        LinkLibraryAliases : TLinkStrMap;
        LinkLibraryAliases : TLinkStrMap;
        LinkLibraryOrder   : TLinkStrMap;
        LinkLibraryOrder   : TLinkStrMap;
-             
+
 
 
      { commandline values }
      { commandline values }
        initglobalswitches : tglobalswitches;
        initglobalswitches : tglobalswitches;
@@ -2246,6 +2255,11 @@ end;
         usewindowapi:=false;
         usewindowapi:=false;
         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
         DescriptionSetExplicity:=false;
         DescriptionSetExplicity:=false;
+        SetPEFlagsSetExplicity:=false;
+        ImageBaseSetExplicity:=false;
+        MinStackSizeSetExplicity:=false;
+        MaxStackSizeSetExplicity:=false;
+
         dllversion:='';
         dllversion:='';
         dllmajor:=1;
         dllmajor:=1;
         dllminor:=0;
         dllminor:=0;
@@ -2318,10 +2332,10 @@ end;
 {$endif x86_64}
 {$endif x86_64}
         if initoptimizecputype=cpu_none then
         if initoptimizecputype=cpu_none then
           initoptimizecputype:=initcputype;
           initoptimizecputype:=initcputype;
-          
+
         LinkLibraryAliases :=TLinkStrMap.Create;
         LinkLibraryAliases :=TLinkStrMap.Create;
         LinkLibraryOrder   :=TLinkStrMap.Create;
         LinkLibraryOrder   :=TLinkStrMap.Create;
-              
+
      end;
      end;
 
 
 end.
 end.

+ 8 - 0
compiler/msg/errore.msg

@@ -334,6 +334,14 @@ scan_n_app_type_not_support=02073_N_APPTYPE is not supported by the target OS
 scan_e_illegal_optimization_specifier=02074_E_Illegal optimization specified "$1"
 scan_e_illegal_optimization_specifier=02074_E_Illegal optimization specified "$1"
 % When you specify an optimization with the \var{\{\$OPTIMIZATION xxx\}}
 % When you specify an optimization with the \var{\{\$OPTIMIZATION xxx\}}
 % the compiler didn't recognize the optimization you specified.
 % the compiler didn't recognize the optimization you specified.
+scan_w_setpeflags_not_support=02075_W_SETPEFLAGS is not supported by the target OS
+% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS
+scan_w_imagebase_not_support=02076_W_IMAGEBASE is not supported by the target OS
+% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS
+scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE is not supported by the target OS
+% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS
+scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE is not supported by the target OS
+% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS
 % \end{description}
 % \end{description}
 #
 #
 # Parser
 # Parser

+ 6 - 2
compiler/msgidx.inc

@@ -95,6 +95,10 @@ const
   scan_e_compile_time_typeerror=02072;
   scan_e_compile_time_typeerror=02072;
   scan_n_app_type_not_support=02073;
   scan_n_app_type_not_support=02073;
   scan_e_illegal_optimization_specifier=02074;
   scan_e_illegal_optimization_specifier=02074;
+  scan_w_setpeflags_not_support=02075;
+  scan_w_imagebase_not_support=02076;
+  scan_w_minstacksize_not_support=02077;
+  scan_w_maxstacksize_not_support=02078;
   parser_e_syntax_error=03000;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
   parser_w_proc_directive_ignored=03005;
@@ -680,9 +684,9 @@ const
   option_info=11024;
   option_info=11024;
   option_help_pages=11025;
   option_help_pages=11025;
 
 
-  MsgTxtSize = 39997;
+  MsgTxtSize = 40212;
 
 
   MsgIdxMax : array[1..20] of longint=(
   MsgIdxMax : array[1..20] of longint=(
-    24,75,220,61,62,47,100,22,135,60,
+    24,79,220,61,62,47,100,22,135,60,
     41,1,1,1,1,1,1,1,1,1
     41,1,1,1,1,1,1,1,1,1
   );
   );

File diff suppressed because it is too large
+ 247 - 245
compiler/msgtxt.inc


+ 94 - 87
compiler/ogcoff.pas

@@ -36,7 +36,71 @@ interface
        ogbase,
        ogbase,
        owbase;
        owbase;
 
 
+    const
+       PE_DATADIR_ENTRIES = 16;
+
     type
     type
+       tcoffpedatadir = packed record
+         vaddr : longint;
+         size  : longint;
+       end;
+       tcoffheader = packed record
+         mach   : word;
+         nsects : smallint;
+         time   : longint;
+         sympos : longint;
+         syms   : longint;
+         opthdr : word;
+         flag   : word;
+       end;
+       tcoffpeoptheader = packed record
+         Magic : word;
+         MajorLinkerVersion : byte;
+         MinorLinkerVersion : byte;
+         tsize : longint;
+         dsize : longint;
+         bsize : longint;
+         entry : longint;
+         text_start : longint;
+{$ifndef x86_64}
+         data_start : longint;
+{$endif x86_64}
+         ImageBase : aint;
+         SectionAlignment : longint;
+         FileAlignment : longint;
+         MajorOperatingSystemVersion : word;
+         MinorOperatingSystemVersion : word;
+         MajorImageVersion : word;
+         MinorImageVersion : word;
+         MajorSubsystemVersion : word;
+         MinorSubsystemVersion : word;
+         Win32Version : longint;
+         SizeOfImage : longint;
+         SizeOfHeaders : longint;
+         CheckSum : longint;
+         Subsystem : word;
+         DllCharacteristics : word;
+         SizeOfStackReserve : aint;
+         SizeOfStackCommit : aint;
+         SizeOfHeapReserve : aint;
+         SizeOfHeapCommit : aint;
+         LoaderFlags : longint;
+         NumberOfRvaAndSizes : longint;
+         DataDirectory : array[0..PE_DATADIR_ENTRIES-1] of tcoffpedatadir;
+       end;
+       tcoffsechdr = packed record
+         name     : array[0..7] of char;
+         vsize    : longint;
+         rvaofs   : longint;
+         datasize : longint;
+         datapos  : longint;
+         relocpos : longint;
+         lineno1  : longint;
+         nrelocs  : word;
+         lineno2  : word;
+         flags    : longword;
+       end;
+
        TCoffObjSection = class(TObjSection)
        TCoffObjSection = class(TObjSection)
        private
        private
          orgmempos,
          orgmempos,
@@ -320,7 +384,6 @@ implementation
        PE_SCN_MEM_READ               = $40000000;
        PE_SCN_MEM_READ               = $40000000;
        PE_SCN_MEM_WRITE              = $80000000;
        PE_SCN_MEM_WRITE              = $80000000;
 
 
-       PE_DATADIR_ENTRIES = 16;
        PE_DATADIR_EDATA = 0;
        PE_DATADIR_EDATA = 0;
        PE_DATADIR_IDATA = 1;
        PE_DATADIR_IDATA = 1;
        PE_DATADIR_RSRC = 2;
        PE_DATADIR_RSRC = 2;
@@ -375,16 +438,6 @@ implementation
        R_PCRLONG = 20;
        R_PCRLONG = 20;
 
 
     type
     type
-       { Structures which are written directly to the output file }
-       coffheader=packed record
-         mach   : word;
-         nsects : smallint;
-         time   : longint;
-         sympos : longint;
-         syms   : longint;
-         opthdr : word;
-         flag   : word;
-       end;
        coffdjoptheader=packed record
        coffdjoptheader=packed record
          magic  : word;
          magic  : word;
          vstamp : word;
          vstamp : word;
@@ -395,57 +448,6 @@ implementation
          text_start : longint;
          text_start : longint;
          data_start : longint;
          data_start : longint;
        end;
        end;
-       coffpedatadir=packed record
-         vaddr : longint;
-         size  : longint;
-       end;
-       coffpeoptheader=packed record
-         Magic : word;
-         MajorLinkerVersion : byte;
-         MinorLinkerVersion : byte;
-         tsize : longint;
-         dsize : longint;
-         bsize : longint;
-         entry : longint;
-         text_start : longint;
-{$ifndef x86_64}
-         data_start : longint;
-{$endif x86_64}
-         ImageBase : aint;
-         SectionAlignment : longint;
-         FileAlignment : longint;
-         MajorOperatingSystemVersion : word;
-         MinorOperatingSystemVersion : word;
-         MajorImageVersion : word;
-         MinorImageVersion : word;
-         MajorSubsystemVersion : word;
-         MinorSubsystemVersion : word;
-         Win32Version : longint;
-         SizeOfImage : longint;
-         SizeOfHeaders : longint;
-         CheckSum : longint;
-         Subsystem : word;
-         DllCharacteristics : word;
-         SizeOfStackReserve : aint;
-         SizeOfStackCommit : aint;
-         SizeOfHeapReserve : aint;
-         SizeOfHeapCommit : aint;
-         LoaderFlags : longint;
-         NumberOfRvaAndSizes : longint;
-         DataDirectory : array[0..PE_DATADIR_ENTRIES-1] of coffpedatadir;
-       end;
-       coffsechdr=packed record
-         name     : array[0..7] of char;
-         vsize    : longint;
-         rvaofs   : longint;
-         datasize : longint;
-         datapos  : longint;
-         relocpos : longint;
-         lineno1  : longint;
-         nrelocs  : word;
-         lineno2  : word;
-         flags    : longword;
-       end;
        coffsectionrec=packed record
        coffsectionrec=packed record
          len     : longint;
          len     : longint;
          nrelocs : word;
          nrelocs : word;
@@ -621,7 +623,7 @@ const go32v2stub : array[0..2047] of byte=(
   $90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
   $90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
   $90,$90,$90,$90,$90,$90,$90,$90);
   $90,$90,$90,$90,$90,$90,$90,$90);
 
 
-const win32stub : array[0..131] of byte=(
+const win32stub : array[0..127] of byte=(
   $4D,$5A,$90,$00,$03,$00,$00,$00,$04,$00,$00,$00,$FF,$FF,$00,$00,
   $4D,$5A,$90,$00,$03,$00,$00,$00,$04,$00,$00,$00,$FF,$FF,$00,$00,
   $B8,$00,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,
   $B8,$00,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,
   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
@@ -629,7 +631,9 @@ const win32stub : array[0..131] of byte=(
   $0E,$1F,$BA,$0E,$00,$B4,$09,$CD,$21,$B8,$01,$4C,$CD,$21,$54,$68,
   $0E,$1F,$BA,$0E,$00,$B4,$09,$CD,$21,$B8,$01,$4C,$CD,$21,$54,$68,
   $69,$73,$20,$70,$72,$6F,$67,$72,$61,$6D,$20,$63,$61,$6E,$6E,$6F,
   $69,$73,$20,$70,$72,$6F,$67,$72,$61,$6D,$20,$63,$61,$6E,$6E,$6F,
   $74,$20,$62,$65,$20,$72,$75,$6E,$20,$69,$6E,$20,$44,$4F,$53,$20,
   $74,$20,$62,$65,$20,$72,$75,$6E,$20,$69,$6E,$20,$44,$4F,$53,$20,
-  $6D,$6F,$64,$65,$2E,$0D,$0D,$0A,$24,$00,$00,$00,$00,$00,$00,$00,
+  $6D,$6F,$64,$65,$2E,$0D,$0D,$0A,$24,$00,$00,$00,$00,$00,$00,$00);
+
+const pemagic : array[0..3] of byte = (
   $50,$45,$00,$00);
   $50,$45,$00,$00);
 
 
 {****************************************************************************
 {****************************************************************************
@@ -1335,7 +1339,7 @@ const win32stub : array[0..131] of byte=(
 
 
     procedure TCoffObjOutput.section_write_header(p:TObject;arg:pointer);
     procedure TCoffObjOutput.section_write_header(p:TObject;arg:pointer);
       var
       var
-        sechdr   : coffsechdr;
+        sechdr   : tcoffsechdr;
         s        : string;
         s        : string;
         strpos   : Aint;
         strpos   : Aint;
       begin
       begin
@@ -1398,7 +1402,7 @@ const win32stub : array[0..131] of byte=(
         sympos   : aint;
         sympos   : aint;
         i        : longint;
         i        : longint;
         gotreloc : boolean;
         gotreloc : boolean;
-        header   : coffheader;
+        header   : tcoffheader;
       begin
       begin
         result:=false;
         result:=false;
         FCoffSyms:=TDynamicArray.Create(symbolresize);
         FCoffSyms:=TDynamicArray.Create(symbolresize);
@@ -1409,7 +1413,7 @@ const win32stub : array[0..131] of byte=(
            create_symbols(data);
            create_symbols(data);
 
 
            { Calculate the filepositions }
            { Calculate the filepositions }
-           datapos:=sizeof(coffheader)+sizeof(coffsechdr)*ObjSectionList.Count;
+           datapos:=sizeof(tcoffheader)+sizeof(tcoffsechdr)*ObjSectionList.Count;
            { Sections first }
            { Sections first }
            ObjSectionList.ForEachCall(@section_set_datapos,@datapos);
            ObjSectionList.ForEachCall(@section_set_datapos,@datapos);
            { relocs }
            { relocs }
@@ -1420,7 +1424,7 @@ const win32stub : array[0..131] of byte=(
            sympos:=datapos;
            sympos:=datapos;
 
 
            { Generate COFF header }
            { Generate COFF header }
-           fillchar(header,sizeof(coffheader),0);
+           fillchar(header,sizeof(tcoffheader),0);
            header.mach:=COFF_MAGIC;
            header.mach:=COFF_MAGIC;
            header.nsects:=ObjSectionList.Count;
            header.nsects:=ObjSectionList.Count;
            header.sympos:=sympos;
            header.sympos:=sympos;
@@ -1770,8 +1774,8 @@ const win32stub : array[0..131] of byte=(
         code     : longint;
         code     : longint;
         objsec   : TCoffObjSection;
         objsec   : TCoffObjSection;
         secoptions : TObjSectionOptions;
         secoptions : TObjSectionOptions;
-        header   : coffheader;
-        sechdr   : coffsechdr;
+        header   : tcoffheader;
+        sechdr   : tcoffsechdr;
         secname  : string;
         secname  : string;
         secnamebuf : array[0..15] of char;
         secnamebuf : array[0..15] of char;
       begin
       begin
@@ -1781,7 +1785,7 @@ const win32stub : array[0..131] of byte=(
         with TCoffObjData(objdata) do
         with TCoffObjData(objdata) do
          begin
          begin
            { Read COFF header }
            { Read COFF header }
-           if not reader.read(header,sizeof(coffheader)) then
+           if not reader.read(header,sizeof(tcoffheader)) then
              begin
              begin
                Comment(V_Error,'Error reading coff file, can''t read header: '+reader.filename);
                Comment(V_Error,'Error reading coff file, can''t read header: '+reader.filename);
                exit;
                exit;
@@ -1813,7 +1817,7 @@ const win32stub : array[0..131] of byte=(
            FSecCount:=header.nsects;
            FSecCount:=header.nsects;
            GetMem(FSecTbl,(header.nsects+1)*sizeof(TObjSection));
            GetMem(FSecTbl,(header.nsects+1)*sizeof(TObjSection));
            FillChar(FSecTbl^,(header.nsects+1)*sizeof(TObjSection),0);
            FillChar(FSecTbl^,(header.nsects+1)*sizeof(TObjSection),0);
-           reader.Seek(sizeof(coffheader)+header.opthdr);
+           reader.Seek(sizeof(tcoffheader)+header.opthdr);
            for i:=1 to header.nsects do
            for i:=1 to header.nsects do
              begin
              begin
                if not reader.read(sechdr,sizeof(sechdr)) then
                if not reader.read(sechdr,sizeof(sechdr)) then
@@ -1984,7 +1988,7 @@ const win32stub : array[0..131] of byte=(
 
 
     procedure TCoffexeoutput.ExeSections_write_header(p:TObject;arg:pointer);
     procedure TCoffexeoutput.ExeSections_write_header(p:TObject;arg:pointer);
       var
       var
-        sechdr    : coffsechdr;
+        sechdr    : tcoffsechdr;
       begin
       begin
         with tExeSection(p) do
         with tExeSection(p) do
           begin
           begin
@@ -2067,8 +2071,8 @@ const win32stub : array[0..131] of byte=(
       begin
       begin
         if win32 then
         if win32 then
           begin
           begin
-            stubsize:=sizeof(win32stub);
-            optheadersize:=sizeof(coffpeoptheader);
+            stubsize:=sizeof(win32stub)+sizeof(pemagic);
+            optheadersize:=sizeof(tcoffpeoptheader);
           end
           end
         else
         else
           begin
           begin
@@ -2079,8 +2083,8 @@ const win32stub : array[0..131] of byte=(
         nsects:=0;
         nsects:=0;
         ExeSections.ForEachCall(@ExeSections_pass2_header,@nsects);
         ExeSections.ForEachCall(@ExeSections_pass2_header,@nsects);
         { calculate start positions after the headers }
         { calculate start positions after the headers }
-        currdatapos:=stubsize+optheadersize+sizeof(coffsechdr)*nsects;
-        currmempos:=stubsize+optheadersize+sizeof(coffsechdr)*nsects;
+        currdatapos:=stubsize+optheadersize+sizeof(tcoffsechdr)*nsects;
+        currmempos:=stubsize+optheadersize+sizeof(tcoffsechdr)*nsects;
       end;
       end;
 
 
 
 
@@ -2100,9 +2104,9 @@ const win32stub : array[0..131] of byte=(
     function TCoffexeoutput.writedata:boolean;
     function TCoffexeoutput.writedata:boolean;
       var
       var
         i           : longint;
         i           : longint;
-        header      : coffheader;
+        header      : tcoffheader;
         djoptheader : coffdjoptheader;
         djoptheader : coffdjoptheader;
-        peoptheader : coffpeoptheader;
+        peoptheader : tcoffpeoptheader;
         textExeSec,
         textExeSec,
         dataExeSec,
         dataExeSec,
         bssExeSec   : TExeSection;
         bssExeSec   : TExeSection;
@@ -2132,7 +2136,10 @@ const win32stub : array[0..131] of byte=(
           internalerror(200602231);
           internalerror(200602231);
         { Stub }
         { Stub }
         if win32 then
         if win32 then
-          FWriter.write(win32stub,sizeof(win32stub))
+          begin
+            FWriter.write(win32stub,sizeof(win32stub));
+            FWriter.write(pemagic,sizeof(pemagic));
+          end
         else
         else
           FWriter.write(go32v2stub,sizeof(go32v2stub));
           FWriter.write(go32v2stub,sizeof(go32v2stub));
         { COFF header }
         { COFF header }
@@ -2142,7 +2149,7 @@ const win32stub : array[0..131] of byte=(
         header.sympos:=sympos;
         header.sympos:=sympos;
         header.syms:=nsyms;
         header.syms:=nsyms;
         if win32 then
         if win32 then
-          header.opthdr:=sizeof(coffpeoptheader)
+          header.opthdr:=sizeof(tcoffpeoptheader)
         else
         else
           header.opthdr:=sizeof(coffdjoptheader);
           header.opthdr:=sizeof(coffdjoptheader);
         if win32 then
         if win32 then
@@ -2597,15 +2604,15 @@ const win32stub : array[0..131] of byte=(
         DLLReader : TObjectReader;
         DLLReader : TObjectReader;
         DosHeader : array[0..$7f] of byte;
         DosHeader : array[0..$7f] of byte;
         PEMagic   : array[0..3] of byte;
         PEMagic   : array[0..3] of byte;
-        Header    : CoffHeader;
-        peheader  : coffpeoptheader;
+        Header    : TCoffHeader;
+        peheader  : tcoffpeoptheader;
         NameOfs,
         NameOfs,
         newheaderofs : longint;
         newheaderofs : longint;
         FuncName  : string;
         FuncName  : string;
         expdir    : TPECoffExpDir;
         expdir    : TPECoffExpDir;
         i         : longint;
         i         : longint;
         found     : boolean;
         found     : boolean;
-        sechdr    : CoffSecHdr;
+        sechdr    : tCoffSecHdr;
 {$ifdef win32}
 {$ifdef win32}
         p : pointer;
         p : pointer;
 {$endif win32}
 {$endif win32}
@@ -2637,15 +2644,15 @@ const win32stub : array[0..131] of byte=(
             Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
             Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
             exit;
             exit;
           end;
           end;
-        if not DLLReader.Read(Header,sizeof(CoffHeader)) or
+        if not DLLReader.Read(Header,sizeof(TCoffHeader)) or
            (Header.mach<>COFF_MAGIC) or
            (Header.mach<>COFF_MAGIC) or
-           (Header.opthdr<>sizeof(coffpeoptheader)) then
+           (Header.opthdr<>sizeof(tcoffpeoptheader)) then
           begin
           begin
             Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
             Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
             exit;
             exit;
           end;
           end;
         { Read optheader }
         { Read optheader }
-        DLLreader.Read(peheader,sizeof(coffpeoptheader));
+        DLLreader.Read(peheader,sizeof(tcoffpeoptheader));
         { Section headers }
         { Section headers }
         found:=false;
         found:=false;
         for i:=1 to header.nsects do
         for i:=1 to header.nsects do

+ 41 - 0
compiler/scandir.pas

@@ -398,6 +398,15 @@ implementation
         do_setverbose('H');
         do_setverbose('H');
       end;
       end;
 
 
+    procedure dir_imagebase;
+      begin
+        if not (target_info.system in (system_windows+system_wince)) then
+          Message(scan_w_imagebase_not_support);
+        current_scanner.skipspace;
+        imagebase:=current_scanner.readval;
+        ImageBaseSetExplicity:=true
+      end;
+
     procedure dir_implicitexceptions;
     procedure dir_implicitexceptions;
       begin
       begin
         do_moduleswitch(cs_implicit_exceptions);
         do_moduleswitch(cs_implicit_exceptions);
@@ -589,6 +598,15 @@ implementation
            end;
            end;
       end;
       end;
 
 
+    procedure dir_maxstacksize;
+      begin
+        if not (target_info.system in (system_windows+system_wince)) then
+          Message(scan_w_maxstacksize_not_support);
+        current_scanner.skipspace;
+        maxstacksize:=current_scanner.readval;
+        MaxStackSizeSetExplicity:=true;
+      end;
+
     procedure dir_memory;
     procedure dir_memory;
       var
       var
         l : longint;
         l : longint;
@@ -653,6 +671,16 @@ implementation
       end;
       end;
 
 
 
 
+    procedure dir_minstacksize;
+      begin
+        if not (target_info.system in (system_windows+system_wince)) then
+          Message(scan_w_minstacksize_not_support);
+        current_scanner.skipspace;
+        minstacksize:=current_scanner.readval;
+        MinStackSizeSetExplicity:=true;
+      end;
+
+
     procedure dir_mode;
     procedure dir_mode;
 
 
     begin
     begin
@@ -907,6 +935,15 @@ implementation
         do_localswitch(cs_mmx_saturation);
         do_localswitch(cs_mmx_saturation);
       end;
       end;
 
 
+    procedure dir_setpeflags;
+      begin
+        if not (target_info.system in (system_windows+system_wince)) then
+          Message(scan_w_setpeflags_not_support);
+        current_scanner.skipspace;
+        peflags:=current_scanner.readval;
+        SetPEFlagsSetExplicity:=true;
+      end;
+
     procedure dir_smartlink;
     procedure dir_smartlink;
       begin
       begin
         do_moduleswitch(cs_create_smart);
         do_moduleswitch(cs_create_smart);
@@ -1193,6 +1230,7 @@ implementation
         AddDirective('HINTS',directive_all, @dir_hints);
         AddDirective('HINTS',directive_all, @dir_hints);
         AddDirective('HPPEMIT',directive_all, @dir_hppemit);
         AddDirective('HPPEMIT',directive_all, @dir_hppemit);
         AddDirective('IOCHECKS',directive_all, @dir_iochecks);
         AddDirective('IOCHECKS',directive_all, @dir_iochecks);
+        AddDirective('IMAGEBASE',directive_all, @dir_imagebase);
         AddDirective('IMPLICITEXCEPTIONS',directive_all, @dir_implicitexceptions);
         AddDirective('IMPLICITEXCEPTIONS',directive_all, @dir_implicitexceptions);
         AddDirective('INCLUDEPATH',directive_all, @dir_includepath);
         AddDirective('INCLUDEPATH',directive_all, @dir_includepath);
         AddDirective('INFO',directive_all, @dir_info);
         AddDirective('INFO',directive_all, @dir_info);
@@ -1208,9 +1246,11 @@ implementation
         AddDirective('M',directive_all, @dir_memory);
         AddDirective('M',directive_all, @dir_memory);
         AddDirective('MACRO',directive_all, @dir_macro);
         AddDirective('MACRO',directive_all, @dir_macro);
         AddDirective('MAXFPUREGISTERS',directive_all, @dir_maxfpuregisters);
         AddDirective('MAXFPUREGISTERS',directive_all, @dir_maxfpuregisters);
+        AddDirective('MAXSTACKSIZE',directive_all, @dir_maxstacksize);
         AddDirective('MEMORY',directive_all, @dir_memory);
         AddDirective('MEMORY',directive_all, @dir_memory);
         AddDirective('MESSAGE',directive_all, @dir_message);
         AddDirective('MESSAGE',directive_all, @dir_message);
         AddDirective('MINENUMSIZE',directive_all, @dir_packenum);
         AddDirective('MINENUMSIZE',directive_all, @dir_packenum);
+        AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize);
         AddDirective('MMX',directive_all, @dir_mmx);
         AddDirective('MMX',directive_all, @dir_mmx);
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);
@@ -1235,6 +1275,7 @@ implementation
         AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo);
         AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo);
         AddDirective('RESOURCE',directive_all, @dir_resource);
         AddDirective('RESOURCE',directive_all, @dir_resource);
         AddDirective('SATURATION',directive_all, @dir_saturation);
         AddDirective('SATURATION',directive_all, @dir_saturation);
+        AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
         AddDirective('SCREENNAME',directive_all, @dir_screenname);
         AddDirective('SCREENNAME',directive_all, @dir_screenname);
         AddDirective('SMARTLINK',directive_all, @dir_smartlink);
         AddDirective('SMARTLINK',directive_all, @dir_smartlink);
         AddDirective('STACKFRAMES',directive_all, @dir_stackframes);
         AddDirective('STACKFRAMES',directive_all, @dir_stackframes);

+ 39 - 76
compiler/systems/t_win.pas

@@ -1416,59 +1416,6 @@ type
      e_res2 : array[0..9] of word;
      e_res2 : array[0..9] of word;
      e_lfanew : longint;
      e_lfanew : longint;
   end;
   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;
   psecfill=^TSecfill;
   TSecfill=record
   TSecfill=record
     fillpos,
     fillpos,
@@ -1479,7 +1426,8 @@ var
   f : file;
   f : file;
   cmdstr : string;
   cmdstr : string;
   dosheader : tdosheader;
   dosheader : tdosheader;
-  peheader : tpeheader;
+  peheader : tcoffheader;
+  peoptheader : tcoffpeoptheader;
   firstsecpos,
   firstsecpos,
   maxfillsize,
   maxfillsize,
   l,peheaderpos : longint;
   l,peheaderpos : longint;
@@ -1516,53 +1464,68 @@ begin
   { read headers }
   { read headers }
   blockread(f,dosheader,sizeof(tdosheader));
   blockread(f,dosheader,sizeof(tdosheader));
   peheaderpos:=dosheader.e_lfanew;
   peheaderpos:=dosheader.e_lfanew;
-  seek(f,peheaderpos);
-  blockread(f,peheader,sizeof(tpeheader));
+  { skip to headerpos and skip pe magic }
+  seek(f,peheaderpos+4);
+  blockread(f,peheader,sizeof(tcoffheader));
+  blockread(f,peoptheader,sizeof(tcoffpeoptheader));
   { write info }
   { write info }
-  Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
-  Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
-  Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
+  Message1(execinfo_x_codesize,tostr(peoptheader.tsize));
+  Message1(execinfo_x_initdatasize,tostr(peoptheader.dsize));
+  Message1(execinfo_x_uninitdatasize,tostr(peoptheader.bsize));
   { change stack size (PM) }
   { change stack size (PM) }
   { I am not sure that the default value is adequate !! }
   { I am not sure that the default value is adequate !! }
-  peheader.SizeOfStackReserve:=stacksize;
+  peoptheader.SizeOfStackReserve:=stacksize;
+  if SetPEFlagsSetExplicity then
+    peoptheader.LoaderFlags:=peflags;
+  if ImageBaseSetExplicity then
+    peoptheader.ImageBase:=imagebase;
+  if MinStackSizeSetExplicity then
+    peoptheader.SizeOfStackCommit:=minstacksize;
+  if MaxStackSizeSetExplicity then
+    peoptheader.SizeOfStackReserve:=maxstacksize;
   { change the header }
   { change the header }
   { sub system }
   { sub system }
   { gui=2 }
   { gui=2 }
   { cui=3 }
   { cui=3 }
   { wincegui=9 }
   { wincegui=9 }
   if target_info.system in [system_arm_wince,system_i386_wince] then
   if target_info.system in [system_arm_wince,system_i386_wince] then
-    peheader.Subsystem:=9
+    peoptheader.Subsystem:=9
   else
   else
     case apptype of
     case apptype of
       app_native :
       app_native :
-        peheader.Subsystem:=1;
+        peoptheader.Subsystem:=1;
       app_gui :
       app_gui :
-        peheader.Subsystem:=2;
+        peoptheader.Subsystem:=2;
       app_cui :
       app_cui :
-        peheader.Subsystem:=3;
+        peoptheader.Subsystem:=3;
     end;
     end;
   if dllversion<>'' then
   if dllversion<>'' then
     begin
     begin
-     peheader.MajorImageVersion:=dllmajor;
-     peheader.MinorImageVersion:=dllminor;
+     peoptheader.MajorImageVersion:=dllmajor;
+     peoptheader.MinorImageVersion:=dllminor;
     end;
     end;
   { reset timestamp }
   { reset timestamp }
-  peheader.TimeDateStamp:=0;
-  { write header back }
-  seek(f,peheaderpos);
-  blockwrite(f,peheader,sizeof(tpeheader));
+  peheader.time:=0;
+  { write header back, skip pe magic }
+  seek(f,peheaderpos+4);
+  blockwrite(f,peheader,sizeof(tcoffheader));
+  if ioresult<>0 then
+    Message1(execinfo_f_cant_process_executable,fn);
+  blockwrite(f,peoptheader,sizeof(tcoffpeoptheader));
   if ioresult<>0 then
   if ioresult<>0 then
     Message1(execinfo_f_cant_process_executable,fn);
     Message1(execinfo_f_cant_process_executable,fn);
-  seek(f,peheaderpos);
-  blockread(f,peheader,sizeof(tpeheader));
+  { skip to headerpos and skip pe magic }
+  seek(f,peheaderpos+4);
+  blockread(f,peheader,sizeof(tcoffheader));
+  blockread(f,peoptheader,sizeof(tcoffpeoptheader));
   { write the value after the change }
   { write the value after the change }
-  Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
-  Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
+  Message1(execinfo_x_stackreserve,tostr(peoptheader.SizeOfStackReserve));
+  Message1(execinfo_x_stackcommit,tostr(peoptheader.SizeOfStackCommit));
   { read section info }
   { read section info }
   maxfillsize:=0;
   maxfillsize:=0;
   firstsecpos:=0;
   firstsecpos:=0;
   secroot:=nil;
   secroot:=nil;
-  for l:=1 to peheader.NumberOfSections do
+  for l:=1 to peheader.nsects do
    begin
    begin
      blockread(f,coffsec,sizeof(tcoffsechdr));
      blockread(f,coffsec,sizeof(tcoffsechdr));
      if coffsec.datapos>0 then
      if coffsec.datapos>0 then
@@ -1571,7 +1534,7 @@ begin
          firstsecpos:=coffsec.datapos;
          firstsecpos:=coffsec.datapos;
         new(hsecroot);
         new(hsecroot);
         hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
         hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
-        hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
+        hsecroot^.fillsize:=coffsec.datasize-coffsec.vsize;
         hsecroot^.next:=secroot;
         hsecroot^.next:=secroot;
         secroot:=hsecroot;
         secroot:=hsecroot;
         if secroot^.fillsize>maxfillsize then
         if secroot^.fillsize>maxfillsize then

Some files were not shown because too many files changed in this diff