Add video output

Assembler.Tests/Assembler.Tests.fsproj

@@ -29,6 +29,9 @@
     <None Include="test_code\ex3_quick_sort.s">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
+    <None Include="test_code\ex4_short_video.s">
+      <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
+    </None>
     <None Include="test_code\test_expressions.s">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
@@ -49,13 +52,13 @@
     <Compile Include="CompositionTests.fs" />
     <Compile Include="IntegrationTests.fs" />
     <Compile Include="Main.fs" />
+    <PackageReference Include="Expecto" Version="8.11.0" />
+    <PackageReference Include="FsCheck" Version="2.14.0" />
+    <ProjectReference Include="..\Machine\Machine.fsproj" />
     <PackageReference Include="Unquote" Version="5.0.0" />
     <PackageReference Include="YoloDev.Expecto.TestSdk" Version="0.8.0" />
     <ProjectReference Include="..\Assembler\Assembler.fsproj" />
     <PackageReference Include="Expecto.FsCheck" Version="8.11.0" />
-    <PackageReference Include="Expecto" Version="8.11.0" />
-    <PackageReference Include="FsCheck" Version="2.14.0" />
-    <ProjectReference Include="..\Machine\Machine.fsproj" />
     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="16.2.0" />
   </ItemGroup>
-</Project>
+</Project>

Assembler.Tests/test_code/ex4_short_video.s

@@ -0,0 +1,65 @@
+### Render 5.12 s video at 50 FPS, 256 x 128 resolution and 44100 Hz sample
+### rate. Observe that when a pixel is not set, its color is undefined. In
+### particular, this is the case for the whole bottom left half of each frame.
+
+    stack_size = 16384
+    allocate! stack_size
+    add! stack_size
+    set_sp
+
+    fps = 50
+    frames = 256                # 5.12 seconds
+
+    ratio = 2
+    width = frames
+    height = (/u frames ratio)
+
+    sample_rate = 44100
+    base_volume = 1024
+    volume_factor = (/u 8192 frames) # Max_volume: 1024 + 8192
+    left_step = 50
+    right_step = 75
+
+### "Local variables"
+    push!!!!!! 0 0 0 0 0 0
+    i = 5                       # Frame counter
+    x = 4
+    y = 3
+    left = 2
+    right = 1
+    sample = 0
+
+per_frame:
+    new_frame!!! width height sample_rate
+
+### Image
+    store8!! 0 &x
+per_column:
+    store8!! 0 &y
+per_row:
+    set_pixel!!!!! $x $y (+ 255 -$i) (+ $i -$x) (+ $i -(* $y 2))
+    store8!! (+ $y 1) &y
+    jump_not_zero!! (<=u (* $y ratio) $x) per_row
+    store8!! (+ $x 1) &x
+    jump_not_zero!! (<=u $x $i) per_column
+
+### Sound
+    store8!! (/u sample_rate fps) &sample # 44100/50 = 882
+per_sample:
+    store8!! (+ $left left_step) &left
+    jump_not_zero!! (<s $left (+ base_volume (* $i volume_factor))) left_ok
+    store8!! -$left &left       # Does this makes sense?
+left_ok:
+    store8!! (+ $right right_step) &right
+    jump_not_zero!! (<s $right (+ base_volume (* (+ frames -$i) volume_factor))) right_ok
+    store8!! -$right &right
+right_ok:
+    add_sample!! $left $right
+    store8!! (+ $sample -1) &sample
+    jump_not_zero!! $sample per_sample
+
+    store8!! (+ $i 1) &i
+    jump_not_zero!! (<u $i frames) per_frame
+
+    set_sp! &6                  # Clear local variables
+    exit

Assembler/Ast.fs

@@ -71,4 +71,6 @@ type Statement =
 
     | SAlloc | SDealloc
 
-    // TODO: Input and output
+    | SNewFrame |SSetPixel | SAddSample
+
+    // TODO: More input and output

Assembler/Checker.fs

@@ -131,9 +131,9 @@ let doAssemble (fileName: string) =
     let buildOrder = getBuildOrder rootDir <| Path.GetFileNameWithoutExtension fileName
     buildOrder |> doBuild rootDir |> doCollect
 
-let doRun binary arg traceSyms =
+let doRun binary arg outputDir traceSyms =
     try
-        execute binary arg traceSyms |> Seq.map int64
+        execute binary arg outputDir traceSyms |> Seq.map int64
     with
         | AccessException msg -> failwith "Access exception!"
         | UndefinedException msg -> failwith "Undefined instruction!"
@@ -150,7 +150,7 @@ let doCheck fileName =
     if not expectationsFound
     then output "Not executed since no expectations were found."
     else
-        let actual = doRun binary Seq.empty None
+        let actual = doRun binary Seq.empty None None
 
         let expected =
             File.ReadLines fileName

Assembler/Checker.fsi

@@ -14,7 +14,7 @@ val getBuildOrder : string -> string -> seq<string>
 
 val doAssemble : string -> assemblerOutput
 
-val doRun : seq<uint8> -> seq<uint8> -> Map<int, string> option -> seq<int64>
+val doRun : seq<uint8> -> seq<uint8> -> string option -> Map<int, string> option -> seq<int64>
 
 // Returns message if stack as expected, otherwise raises exception.
 val doCheck : string -> string

Assembler/Parser.fs

@@ -295,6 +295,10 @@ let statement: Parser<Statement list, State> =
             | "allocate" -> nArgs 1 [SAlloc]
             | "deallocate" -> nArgs 1 [SDealloc]
 
+            | "new_frame" -> nArgs 3 [SNewFrame]
+            | "set_pixel" -> nArgs 5 [SSetPixel]
+            | "add_sample" -> nArgs 3 [SAddSample]
+
             // Better error message than simply 'fail'.
             | _ -> fun _ -> Reply (Error, unexpectedString id)
 

Assembler/Target.fs

@@ -593,5 +593,9 @@ let intermediates (prog: Statement list) : seq<Intermediate> =
 
             | SPush e :: r -> fragment r (expressionPush e)
 
+            | SNewFrame :: r -> frag r [NEW_FRAME]
+            | SSetPixel :: r -> frag r [SET_PIXEL]
+            | SAddSample :: r -> frag r [ADD_SAMPLE]
+
             | _ -> failwithf "Impossible case: %O" rest
     }

Command/Program.fs

@@ -9,19 +9,25 @@ let LABELS_HEADING = "--Labels--"
 let usage () =
     let ex = System.AppDomain.CurrentDomain.FriendlyName
     printfn "Usage:"
-    printfn "  %s                                     -  Show this text" ex
-    printfn "  %s as <source> <binary> <symbols>      -  Assemble" ex
-    printfn "  %s run <binary>                        -  Run binary and print final stack" ex
-    printfn "  %s run <binary> <arg file>             -  Run binary and print final stack" ex
-    printfn "  %s trace <binary> <symbols>            -  Trace binary" ex
-    printfn "  %s trace <binary> <arg file> <symbols> -  Trace binary" ex
-    printfn "  %s as-run <source>                     -  Assemble and run (no output files)" ex
-    printfn "  %s as-trace <source>                   -  Assemble and trace (no output files)" ex
-    printfn "  %s check <source>                      -  Assemble, run, and check final stack" ex
+    printfn "  %s                                                  -  Show this text" ex
+    printfn "  %s as <source> <binary> <symbols>                   -  Assemble" ex
+    printfn "  %s run <binary>                                     -  Run binary and print final stack" ex
+    printfn "  %s run <binary> <arg file>                          -  Run binary and print final stack" ex
+    printfn "  %s run <binary> <arg file> <output dir>             -  Run binary and print final stack" ex
+    printfn "  %s trace <binary> <symbols>                         -  Trace binary" ex
+    printfn "  %s trace <binary> <symbols> <arg file>              -  Trace binary" ex
+    printfn "  %s trace <binary> <symbols> <arg file> <output dir> -  Trace binary" ex
+    printfn "  %s as-run <source>                                  -  Assemble and run" ex
+    printfn "  %s as-run <source> <arg file>                       -  Assemble and run" ex
+    printfn "  %s as-run <source> <arg file> <output dir>          -  Assemble and run" ex
+    printfn "  %s as-trace <source>                                -  Assemble and trace" ex
+    printfn "  %s as-trace <source> <arg file>                     -  Assemble and trace" ex
+    printfn "  %s as-trace <source> <arg file> <output dir>        -  Assemble and trace" ex
+    printfn "  %s check <source>                                   -  Assemble, run, and check final stack" ex
     printfn ""
-    printfn "  %s gen-proj <root dir> <goal>          -  Create prototype project (<goal>.proj)" ex
-    // Ignore incremental builds for now
-    printfn "  %s build <project> <dest dir>          -  Assemble project" ex
+    printfn "  %s gen-proj <root dir> <goal>     -  Create prototype project (<goal>.proj)" ex
+    // No incremental builds for now
+    printfn "  %s build <project> <dest dir>     -  Assemble project" ex
 
 let writeAssemblerOutput binaryFile symbolsFile bytes exported labels previous =
     File.WriteAllBytes (binaryFile, bytes |> List.toArray)
@@ -59,7 +65,7 @@ let writeStack (endStack: seq<int64>) =
     for x in endStack do
         printfn "0x..%05X %7d" (uint64 x &&& 0xfffffUL) x
 
-let run binary (argFile: string option) (symbolsIfShouldTrace: string option) =
+let run binary (argFile: string option) (outputDir: string option) (symbolsIfShouldTrace: string option) =
     let bytes = File.ReadAllBytes binary
     let arg = match argFile with
               | Some name -> File.ReadAllBytes name
@@ -68,10 +74,10 @@ let run binary (argFile: string option) (symbolsIfShouldTrace: string option) =
         match symbolsIfShouldTrace with
         | Some name -> Some <| readTraceSyms name
         | None -> None
-    let stack = doRun bytes arg traceSyms |> Seq.toList
+    let stack = doRun bytes arg outputDir traceSyms |> Seq.toList
     if symbolsIfShouldTrace.IsNone then writeStack stack
 
-let asRun source shouldTrace =
+let asRun source argFile outputDir shouldTrace =
     let _, bytes, exported, labels = doAssemble source
 
     if shouldTrace then
@@ -83,7 +89,10 @@ let asRun source shouldTrace =
         else let flip (x, y) = (y, x)
              Some <| new Map<int, string> (Seq.map flip labels)
 
-    let stack = doRun (List.toArray bytes) Seq.empty traceSyms |> Seq.toList
+    let arg = match argFile with
+              | Some name -> File.ReadAllBytes name
+              | None -> Array.empty
+    let stack = doRun (List.toArray bytes) arg outputDir traceSyms |> Seq.toList
     if not shouldTrace then writeStack stack
 
 let check source =
@@ -134,20 +143,27 @@ let build projectFile destinationDir =
 [<EntryPoint>]
 let main argv =
     try
-        printfn "iVM Assembler and VM, version 0.6"
+        printfn "iVM Assembler and VM, version 0.7"
         let n = Array.length argv
         if n = 0 then usage (); 0
         else
             match argv.[0] with
             | "as" when n = 4 -> assem argv.[1] argv.[2] argv.[3]; 0
-            | "run" when n = 2 -> run argv.[1] None None; 0
-            | "run" when n = 3 -> run argv.[1] (Some argv.[2]) None; 0
-            | "trace" when n = 3 -> run argv.[1] None (Some argv.[2]); 0
-            | "trace" when n = 4 -> run argv.[1] (Some argv.[2]) (Some argv.[3]); 0
-            | "as-run" when n = 2 -> asRun argv.[1] false; 0
-            | "as-trace" when n = 2 -> asRun argv.[1] true; 0
-            | "check" when n = 2 -> check argv.[1]; 0
+            | "run" when n = 2 -> run argv.[1] None None None; 0
+            | "run" when n = 3 -> run argv.[1] (Some argv.[2]) None None; 0
+            | "run" when n = 4 -> run argv.[1] (Some argv.[2]) (Some argv.[3]) None; 0
+            | "trace" when n = 3 -> run argv.[1] None None (Some argv.[2]); 0
+            | "trace" when n = 4 -> run argv.[1] (Some argv.[2]) None (Some argv.[3]); 0
+            | "trace" when n = 5 -> run argv.[1] (Some argv.[2]) (Some argv.[4]) (Some argv.[3]); 0
+
+            | "as-run" when n = 2 -> asRun argv.[1] None None false; 0
+            | "as-run" when n = 3 -> asRun argv.[1] (Some argv.[2]) None false; 0
+            | "as-run" when n = 4 -> asRun argv.[1] (Some argv.[2]) (Some argv.[3]) false; 0
+            | "as-trace" when n = 2 -> asRun argv.[1] None None true; 0
+            | "as-trace" when n = 3 -> asRun argv.[1] (Some argv.[2]) None true; 0
+            | "as-trace" when n = 4 -> asRun argv.[1] (Some argv.[2]) (Some argv.[3]) true; 0
 
+            | "check" when n = 2 -> check argv.[1]; 0
             | "gen-proj" when n = 3 -> genProj argv.[1] argv.[2]; 0
             | "build" when n = 3 -> build argv.[1] argv.[2]; 0
             | _ -> usage (); 1

Machine.Tests/ExecutorTests.fs

@@ -15,7 +15,7 @@ let random = System.Random ()
 let endStack prog expected () =
     let stackSpace = Array.create 1000 0uy
     random.NextBytes (Span stackSpace)
-    let actual = execute (Seq.map uint8 prog) stackSpace None |> Seq.map int64
+    let actual = execute (Seq.map uint8 prog) stackSpace None None |> Seq.map int64
     Expect.sequenceEqual actual expected "Unexpected end stack"
 
 [<Tests>]

Machine/Executor.fs

@@ -3,6 +3,9 @@
 open Machine.Instructions
 open Machine.Utils
 
+open System.Drawing
+open System.IO
+
 exception AccessException of string
 exception UndefinedException of string
 
@@ -14,7 +17,7 @@ let fromBytes : seq<uint8> -> uint64 =
 let toBytes n (x: uint64) : seq<uint8> =
     [| 0 .. n-1 |] |> Seq.map (fun i -> x >>> i*8 |> uint8)
 
-type Machine(initialMemory: seq<uint8>, startLocation: uint64, traceSyms: Map<int, string> option) =
+type Machine(initialMemory: seq<uint8>, startLocation: uint64, outputDir: string option, traceSyms: Map<int, string> option) =
 
     // Reverse ordering
     let mutable arrays = [ (startLocation, Seq.toArray initialMemory) ]
@@ -41,6 +44,53 @@ type Machine(initialMemory: seq<uint8>, startLocation: uint64, traceSyms: Map<in
     let store location value =
         let (a, i) = getArray location in a.[i] <- value
 
+    let mutable outputEncountered = false
+    let mutable frameCounter = -1 // Since the first "flush" will be a no-op.
+    let mutable bitmap : Bitmap option = None
+    let mutable sampleRate = 0u
+    let mutable samples : (int16 * int16) list = [] // Reversed
+    let flushFrame () =
+        if outputDir.IsNone
+        then
+            if not outputEncountered
+            then printfn "Output ignored"
+                 outputEncountered <- true
+        else
+            if not outputEncountered
+            then Directory.CreateDirectory outputDir.Value |> ignore
+                 printfn "Output to: %s" outputDir.Value
+                 outputEncountered <- true
+            let path = Path.Combine(outputDir.Value, sprintf "%08d." frameCounter)
+            match bitmap with
+            | None -> ()
+            | Some b ->
+                b.Save(path + "png", Imaging.ImageFormat.Png)
+            match samples with
+            | [] -> ()
+            | _ ->
+                // See http://www-mmsp.ece.mcgill.ca/Documents/AudioFormats/WAVE/WAVE.html
+                Directory.CreateDirectory outputDir.Value |> ignore
+                let data = samples |> Seq.rev |> Seq.collect (fun (l, r) -> [l; r]) |> Seq.toArray
+                let sampleLength = 2 // 16 bits
+                let channels = 2 // left, right
+                let blockAlign = sampleLength * channels
+                let blocks = Array.length data / channels
+                use s = File.OpenWrite <| path + "wav"
+                let w = new BinaryWriter (s)
+                w.Write("RIFF".ToCharArray ())
+                w.Write(uint32 <| 36 + blocks * channels * sampleLength)
+                w.Write("WAVEfmt ".ToCharArray ());
+                w.Write(uint32 16) // Chunk size
+                w.Write(uint16 1) // WAVE_FORMAT_PCM
+                w.Write(uint16 channels)
+                w.Write(uint32 sampleRate)
+                w.Write(uint32 blocks * sampleRate)
+                w.Write(uint16 <| blockAlign);
+                w.Write(uint16 <| 8 * sampleLength);
+                w.Write("data".ToCharArray ());
+                w.Write(uint32 blockAlign * uint32 blocks) // Chunk size
+                for x in data do w.Write(x)
+            frameCounter <- frameCounter + 1
 
     member m.Allocate size =
         // NB: We leave a gap of 1 unused byte to catch pointer errors.
@@ -123,6 +173,8 @@ type Machine(initialMemory: seq<uint8>, startLocation: uint64, traceSyms: Map<in
                     <| System.String.Join(" ", m.Stack 50 |> Seq.rev |> Seq.map int64)
 
             m.Step ()
+        flushFrame ()
+        printfn ""
 
     // For testing
     member m.Stack ?max : seq<uint64> =
@@ -202,14 +254,35 @@ type Machine(initialMemory: seq<uint8>, startLocation: uint64, traceSyms: Map<in
             if n >= 0UL && n <= 63UL then 1UL <<< int n else 0UL
             |> m.Push
 
+        | NEW_FRAME ->
+            flushFrame ()
+            sampleRate <- m.Pop () |> uint32
+            samples <- []
+            let height = m.Pop () |> int
+            let width = m.Pop () |> int
+            bitmap <- Some <| new Bitmap (width, height)
+            printf "."
+        | SET_PIXEL ->
+            let b = m.Pop () |> int
+            let g = m.Pop () |> int
+            let r = m.Pop () |> int
+            let y = m.Pop () |> int
+            let x = m.Pop () |> int
+            let c = Color.FromArgb(r &&& 255, g &&& 255, b &&& 255)
+            bitmap.Value.SetPixel(x, y, c)
+        | ADD_SAMPLE ->
+            let right = m.Pop () |> int16
+            let left = m.Pop () |> int16
+            samples <- (left, right) :: samples
+
         | undefined -> raise (UndefinedException(sprintf "%d" undefined))
 
 
 let random = System.Random ()
 
-let execute (prog: seq<uint8>) (arg: seq<uint8>)(traceSyms: Map<int, string> option) =
+let execute (prog: seq<uint8>) (arg: seq<uint8>) (outputDir: string option) (traceSyms: Map<int, string> option) =
     // Start at 0, 1000, ... or 7000.
     let start = random.Next () % 8 |> (*) 1000 |> uint64
-    let machine = Machine(Seq.concat [prog; arg; Seq.replicate (2 * 8) 0uy], start, traceSyms)
+    let machine = Machine(Seq.concat [prog; arg; Seq.replicate (2 * 8) 0uy], start, outputDir, traceSyms)
     machine.Run ()
     machine.Stack ()

Machine/Executor.fsi

@@ -6,4 +6,4 @@ exception UndefinedException of string
 // Execute at random location (multiple of 1000) and return terminal stack.
 // Trace execution if symbol mapping is provided.
 // This method is likely to change...
-val execute : seq<uint8> -> seq<uint8> -> Map<int, string> option -> seq<uint64>
+val execute : seq<uint8> -> seq<uint8> -> string option -> Map<int, string> option -> seq<uint64>