Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,8 @@ source_link.json
.vs/
System.ValueTuple.dll
tests/fsharpqa/testenv/bin/System.ValueTuple.dll
*/.fake
**/.fake
.ionide
/fcs/packages/
*/paket-files/
/fcs/TestResult.xml
Expand Down
12 changes: 12 additions & 0 deletions fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -225,6 +225,18 @@
</Compile>
</ItemGroup>
<ItemGroup>
<Compile Include="$(FSharpSourcesRoot)/absil/writenativeres.fsi">
<Link>AbsIL/writenativeres.fsi</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/absil/writenativeres.fs">
<Link>AbsIL/writenativeres.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/absil/cvtres.fsi">
<Link>AbsIL/cvtres.fsi</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/absil/cvtres.fs">
<Link>AbsIL/cvtres.fs</Link>
</Compile>
<Compile Include="$(FSharpSourcesRoot)/absil/ilsupp.fsi">
<Link>AbsIL/ilsupp.fsi</Link>
</Compile>
Expand Down
723 changes: 723 additions & 0 deletions src/absil/cvtres.fs

Large diffs are not rendered by default.

37 changes: 37 additions & 0 deletions src/absil/cvtres.fsi
Original file line number Diff line number Diff line change
@@ -0,0 +1,37 @@
module internal FSharp.Compiler.AbstractIL.Internal.CVTres

open System
open System.IO

type BYTE = System.Byte
type DWORD = System.UInt32
type WCHAR = System.Char
type WORD = System.UInt16

[<Class>]
type RESOURCE_STRING =
member Ordinal: WORD with get, set
member theString : string with get, set

[<Class>]
type RESOURCE =
member pstringType : RESOURCE_STRING with get, set
member pstringName : RESOURCE_STRING with get, set
member DataSize : DWORD with get, set
member HeaderSize : DWORD with get, set
member DataVersion : DWORD with get, set
member MemoryFlags : WORD with get, set
member LanguageId : WORD with get, set
member Version : DWORD with get, set
member Characteristics : DWORD with get, set
member data : byte[] with get, set

[<Class>]
type CvtResFile =
static member ReadResFile : stream:Stream -> System.Collections.Generic.List<RESOURCE>

[<Class>]
type Win32ResourceConversions =
static member AppendIconToResourceStream : resStream:Stream * iconStream:Stream -> unit
static member AppendVersionToResourceStream : resStream:Stream * isDll:System.Boolean * fileVersion:string * originalFileName:string * internalName:string * productVersion:string * assemblyVersion:Version * ?fileDescription:string * ?legalCopyright:string * ?legalTrademarks:string * ?productName:string * ?comments:string * ?companyName:string -> unit
static member AppendManifestToResourceStream : resStream:Stream * manifestStream:Stream * isDll:System.Boolean -> unit
8 changes: 1 addition & 7 deletions src/absil/ilread.fs
Original file line number Diff line number Diff line change
Expand Up @@ -20,9 +20,7 @@ open Internal.Utilities
open Internal.Utilities.Collections
open FSharp.Compiler.AbstractIL
open FSharp.Compiler.AbstractIL.Internal
#if !FX_NO_PDB_READER
open FSharp.Compiler.AbstractIL.Internal.Support
#endif
open FSharp.Compiler.AbstractIL.Internal.Support
open FSharp.Compiler.AbstractIL.Diagnostics
open FSharp.Compiler.AbstractIL.Internal.BinaryConstants
open FSharp.Compiler.AbstractIL.IL
Expand Down Expand Up @@ -1551,14 +1549,10 @@ let readNativeResources (pectxt: PEReader) =
[ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then
let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr)
if pectxt.noFileOnDisk then
#if !FX_NO_LINKEDRESOURCES
let unlinkedResource =
let linkedResource = seekReadBytes (pectxt.pefile.GetView()) start pectxt.nativeResourcesSize
unlinkResource pectxt.nativeResourcesAddr linkedResource
yield ILNativeResource.Out unlinkedResource
#else
()
#endif
else
yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ]

Expand Down
40 changes: 35 additions & 5 deletions src/absil/ilsupp.fs
Original file line number Diff line number Diff line change
Expand Up @@ -22,16 +22,15 @@ open System.Diagnostics.SymbolStore
open System.Runtime.InteropServices
open System.Runtime.CompilerServices


let DateTime1970Jan01 = new DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *)
let absilWriteGetTimeStamp () = (DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int

#if !FX_NO_LINKEDRESOURCES
// Force inline, so GetLastWin32Error calls are immediately after interop calls as seen by FxCop under Debug build.
let inline ignore _x = ()

// Native Resource linking/unlinking
type IStream = System.Runtime.InteropServices.ComTypes.IStream
#endif

let check _action (hresult) =
if uint32 hresult >= 0x80000000ul then
Expand All @@ -56,7 +55,6 @@ let bytesToQWord ((b0: byte), (b1: byte), (b2: byte), (b3: byte), (b4: byte), (b
let dwToBytes n = [| byte (n &&& 0xff) ; byte ((n >>> 8) &&& 0xff) ; byte ((n >>> 16) &&& 0xff) ; byte ((n >>> 24) &&& 0xff) |], 4
let wToBytes (n: int16) = [| byte (n &&& 0xffs) ; byte ((n >>> 8) &&& 0xffs) |], 2

#if !FX_NO_LINKEDRESOURCES
// REVIEW: factor these classes under one hierarchy, use reflection for creation from buffer and toBytes()
// Though, everything I'd like to unify is static - metaclasses?
type IMAGE_FILE_HEADER (m: int16, secs: int16, tds: int32, ptst: int32, nos: int32, soh: int16, c: int16) =
Expand Down Expand Up @@ -583,7 +581,7 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink

!size

let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
let linkNativeResourcesViaCVTres (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
let nPEFileType = match fileType with X86 -> 0 | X64 -> 2
let mutable tempResFiles: string list = []
let mutable objBytes: byte[] = [||]
Expand Down Expand Up @@ -751,6 +749,39 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR
// return the buffer
pResBuffer

let linkNativeResourcesManaged (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
ignore fileType
ignore outputFilePath

let resources =
unlinkedResources
|> Seq.map (fun s -> new MemoryStream(s))
|> Seq.map (fun s ->
let res = CVTres.CvtResFile.ReadResFile s
s.Dispose()
res)
|> Seq.collect id
// See MakeWin32ResourceList https://github.com/dotnet/roslyn/blob/f40b89234db51da1e1153c14af184e618504be41/src/Compilers/Core/Portable/Compilation/Compilation.cs
|> Seq.map (fun r ->
WriteNativeRes.Win32Resource(data = r.data, codePage = 0u, languageId = uint32 r.LanguageId,
id = int (int16 r.pstringName.Ordinal), name = r.pstringName.theString,
typeId = int (int16 r.pstringType.Ordinal), typeName = r.pstringType.theString))
let bb = new System.Reflection.Metadata.BlobBuilder()
WriteNativeRes.NativeResourceWriter.SerializeWin32Resources(bb, resources, ulLinkedResourceBaseRVA)
bb.ToArray()

let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
#if ENABLE_MONO_SUPPORT
if IL.runningOnMono then
linkNativeResourcesManaged unlinkedResources ulLinkedResourceBaseRVA fileType outputFilePath
else
#endif
#if !FX_NO_LINKEDRESOURCES
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Let's lose the old spawn cvtres.exe method, the new code should work on desktop just fine, any issues that appear are just bugs that should be found.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes

This change is conservative and only uses the managed implementation when the old one is not available. We could probably remove the old one if we want and get rid of the FX_NO_LINKEDRESOURCES define.

I'm happy to get rid of it, I just decided to be more conservative first.

linkNativeResourcesViaCVTres unlinkedResources ulLinkedResourceBaseRVA fileType outputFilePath
#else
linkNativeResourcesManaged unlinkedResources ulLinkedResourceBaseRVA fileType outputFilePath
#endif

let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) =
let mutable nResNodes = 0

Expand Down Expand Up @@ -854,7 +885,6 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) =
resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset)

pResBuffer
#endif

#if !FX_NO_PDB_WRITER
// PDB Writing
Expand Down
4 changes: 0 additions & 4 deletions src/absil/ilsupp.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -29,20 +29,16 @@ open FSharp.Compiler.AbstractIL
open FSharp.Compiler.AbstractIL.Internal
open FSharp.Compiler.AbstractIL.IL

#if !FX_NO_LINKEDRESOURCES
type IStream = System.Runtime.InteropServices.ComTypes.IStream
#endif

/// Unmanaged resource file linker - for native resources (not managed ones).
/// The function may be called twice, once with a zero-RVA and
/// arbitrary buffer, and once with the real buffer. The size of the
/// required buffer is returned.
type PEFileType = X86 | X64

#if !FX_NO_LINKEDRESOURCES
val linkNativeResources: unlinkedResources:byte[] list -> rva:int32 -> PEFileType -> tempFilePath:string -> byte[]
val unlinkResource: int32 -> byte[] -> byte[]
#endif

#if !FX_NO_PDB_WRITER
/// PDB reader and associated types
Expand Down
38 changes: 13 additions & 25 deletions src/absil/ilwrite.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3723,28 +3723,18 @@ let writeBinaryAndReportMappings (outfile,
match modul.NativeResources with
| [] -> [||]
| resources ->
#if ENABLE_MONO_SUPPORT
if runningOnMono then
[||]
else
#endif
#if FX_NO_LINKEDRESOURCES
ignore resources
ignore resourceFormat
[||]
#else
let unlinkedResources =
resources |> List.map (function
| ILNativeResource.Out bytes -> bytes
| ILNativeResource.In (fileName, linkedResourceBase, start, len) ->
let linkedResource = File.ReadBinaryChunk (fileName, start, len)
unlinkResource linkedResourceBase linkedResource)

begin
try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName outfile)
with e -> failwith ("Linking a native resource failed: "+e.Message+"")
end
#endif
let unlinkedResources =
resources |> List.map (function
| ILNativeResource.Out bytes -> bytes
| ILNativeResource.In (fileName, linkedResourceBase, start, len) ->
let linkedResource = File.ReadBinaryChunk (fileName, start, len)
unlinkResource linkedResourceBase linkedResource)

begin
try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName outfile)
with e -> failwith ("Linking a native resource failed: "+e.Message+"")
end

let nativeResourcesSize = nativeResources.Length

let nativeResourcesChunk, next = chunk nativeResourcesSize next
Expand Down Expand Up @@ -4139,14 +4129,12 @@ let writeBinaryAndReportMappings (outfile,

writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize)

// DATA SECTION
#if !FX_NO_LINKEDRESOURCES
// DATA SECTION
match nativeResources with
| [||] -> ()
| resources ->
write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |]
writeBytes os resources
#endif

if dummydatap.size <> 0x0 then
write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |]
Expand Down
Loading