patrick/WoofWare.PawPrint
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.PawPrint synced 2025-10-10 16:28:41 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add test harness and run the first program (#5)

Browse Source
This commit is contained in:
Patrick Stevens
2025-04-28 20:23:05 +01:00
committed by GitHub
parent 90f95ed6c6
commit 3415b7a73d
14 changed files with 703 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
WoofWare.PawPrint.App/Program.fs
View File

@@ -7,32 +7,6 @@ open Microsoft.Extensions.Logging
open WoofWare.DotnetRuntimeLocator
module Program =
/// Returns the pointer to the resulting array on the heap.
let allocateArgs (args : string list) (state : IlMachineState) : ManagedHeapAddress * IlMachineState =
let argsAllocations, state =
(state, args)
||> Seq.mapFold (fun state arg -> IlMachineState.allocate (ReferenceType.String arg) state
// TODO: set the char values in memory
)
let arrayAllocation, state =
IlMachineState.allocate
(ReferenceType.Array (args.Length, Type.ReferenceType ReferenceType.ManagedObject))
state
// TODO: set the length of the array
let state =
((state, 0), argsAllocations)
||> Seq.fold (fun (state, i) arg ->
let state =
IlMachineState.setArrayValue arrayAllocation (CliObject.OfManagedObject arg) i state
state, i + 1
)
|> fst
arrayAllocation, state
let reallyMain (argv : string[]) : int =
let loggerFactory =
LoggerFactory.Create (fun builder ->
@@ -54,54 +28,8 @@ module Program =
ImmutableArray.Create (FileInfo(dllPath).Directory.FullName)
use fileStream = new FileStream (dllPath, FileMode.Open, FileAccess.Read)
let dumped = Assembly.read loggerFactory fileStream
let entryPoint =
match dumped.MainMethod with
| None -> failwith $"No entry point in {dllPath}"
| Some d -> d
let mainMethod = dumped.Methods.[entryPoint]
if mainMethod.Signature.GenericParameterCount > 0 then
failwith "Refusing to execute generic main method"
let state = IlMachineState.initial dotnetRuntimes dumped
let arrayAllocation, state =
match mainMethod.Signature.ParameterTypes |> Seq.toList with
| [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
allocateArgs args state
| _ -> failwith "Main method must take an array of strings; other signatures not yet implemented"
match mainMethod.Signature.ReturnType with
| TypeDefn.PrimitiveType PrimitiveType.Int32 -> ()
| _ -> failwith "Main method must return int32; other types not currently supported"
let state, mainThread =
state
|> IlMachineState.addThread
// TODO: we need to load the main method's class first, and that's a faff with the current layout
{ MethodState.Empty mainMethod None with
Arguments = ImmutableArray.Create (CliObject.OfManagedObject arrayAllocation)
}
dumped.Name
let mutable state = state
while true do
let state', whatWeDid =
AbstractMachine.executeOneStep loggerFactory state mainThread
state <- state'
match whatWeDid with
| WhatWeDid.Executed -> logger.LogInformation "Executed one step."
| WhatWeDid.SuspendedForClassInit ->
logger.LogInformation "Suspended execution of current method for class initialisation."
| WhatWeDid.NotTellingYou -> logger.LogInformation "(Execution outcome missing.)"
| WhatWeDid.BlockedOnClassInit threadBlockingUs ->
logger.LogInformation "Unable to execute because class has not yet initialised."
let terminalState = Program.run loggerFactory fileStream dotnetRuntimes args
0
| _ ->