Skip to content

Commit

Permalink
Fix dotnet#3113 by porting the relevant roslyn codeand integrate it i…
Browse files Browse the repository at this point in the history
…nto the codebase
  • Loading branch information
matthid committed Jun 20, 2019
1 parent b1caf77 commit da881d8
Show file tree
Hide file tree
Showing 13 changed files with 1,078 additions and 43 deletions.
3 changes: 2 additions & 1 deletion .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,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 @@ -19,9 +19,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
41 changes: 35 additions & 6 deletions src/absil/ilsupp.fs
Original file line number Diff line number Diff line change
Expand Up @@ -26,13 +26,11 @@ open System.Diagnostics.SymbolStore
open System.Runtime.InteropServices
open System.Runtime.CompilerServices

#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 @@ -55,7 +53,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 @@ -578,7 +575,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 @@ -660,7 +657,7 @@ let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseR

// REVIEW: We really shouldn't be calling out to cvtres
let mutable psi = System.Diagnostics.ProcessStartInfo(cvtres)
psi.Arguments <- cmdLineArgs
psi.Arguments <- cmdLineArgs
psi.CreateNoWindow <- true ; // REVIEW: For some reason, this still creates a window unless WindowStyle is set to hidden
psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden
let p = System.Diagnostics.Process.Start(psi)
Expand Down Expand Up @@ -746,6 +743,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
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 @@ -849,7 +879,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
39 changes: 14 additions & 25 deletions src/absil/ilwrite.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3723,28 +3723,19 @@ 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 +4130,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

0 comments on commit da881d8

Please sign in to comment.