Code Monkey Have Fun

Memoization

Ashley Nathan Feniello — Sat, 27 Apr 2013 04:13:00 GMT

Don Syme blogged this quite some years ago but it just came up in a design review on my team this afternoon and it bears repeating.

let memoize f =
    let cache = new Dictionary<_,_>()
    (fun x ->
        match cache.TryGetValue x with
        | true, res -> res
| _ -> let res = f x in cache.Add(x, res); res)

This generic function takes a function and returns a new caching version of it. So simple!

You can then take some expensive function such as the standard example Fibonacci:

let rec fib = function
| 1 | 2 -> 1
| n -> fib (n - 1) + fib (n - 2)

Which is quite expensive when written this naïvely because of the exponential number of recursive calls; most with the same arguments.

> fib 42;;
Real: 00:00:01.663, CPU: 00:00:01.669, GC gen0: 0, gen1: 0, gen2: 0
val it : int = 267914296

It takes 1.663 seconds for fib 42!

Okay, let’s make a memoized version:

let rec fastFib = memoize (function
| 1 | 2 -> 1
| n -> fastFib (n - 1) + fastFib (n - 2))

It really can’t be any easier than that! Note that because it's a recursive function simply saying let fastFib = memoize fib doesn't work.

> fastFib 42;;
Real: 00:00:00.000, CPU: 00:00:00.001, GC gen0: 0, gen1: 0, gen2: 0
val it : int = 267914296

Viola!

Colemak

Ashley Nathan Feniello — Sun, 31 Mar 2013 06:50:00 GMT

I switched to Colemak a couple of years ago. I love it. Never going back. Not really any faster than QWERTY, but so much more comfortable.

One issue though is whenever I jump on someone else's machine or remote into some server. I want to switch the layout but I don't really want to install anything.

Here's a little seventy-line F# app that will intercept all keys on the system on which it's running and remap to Colemak:

open System
open System.Diagnostics
open System.Runtime.InteropServices
open System.Windows.Forms
 
[<Literal>]
let WH_KEYBOARD_LL = 13
 
[<StructLayout(LayoutKind.Sequential)>]
type KBDLLHOOKSTRUCT =
 val vkCode : uint32
 val scanCode : uint32
 val flags : uint32
 val time : uint32
 val dwExtraInfo : nativeint

type LowLevelKeyboardProc = delegate of int * nativeint * KBDLLHOOKSTRUCT -> nativeint
 
[<DllImport("kernel32.dll", SetLastError = true)>]
extern nativeint GetModuleHandle(string lpModuleName)
 
[<DllImport("user32.dll", SetLastError = true)>]
extern bool UnhookWindowsHookEx(nativeint hhk)
 
[<DllImport("user32.dll", SetLastError = true)>]
extern nativeint SetWindowsHookEx(int idhook, LowLevelKeyboardProc proc, nativeint hMod, uint32 threadId)
 
[<DllImport("user32.dll", SetLastError = true)>]
extern nativeint CallNextHookEx(IntPtr hhk, int nCode, IntPtr wParam, KBDLLHOOKSTRUCT lParam)
 
let SetHook (proc: LowLevelKeyboardProc) =
 use curProc = Process.GetCurrentProcess ()
 use curMod = curProc.MainModule
 SetWindowsHookEx(WH_KEYBOARD_LL, proc, GetModuleHandle(curMod.ModuleName), 0u)
 
type App(handler) as x =
 inherit ApplicationContext()
 let rec callback (code : int) (wparam : nativeint) (lparam : KBDLLHOOKSTRUCT) : nativeint =
 match handler code wparam lparam with
 | Some keys -> SendKeys.Send keys; nativeint 1
 | None -> CallNextHookEx(hook, code, wparam, lparam)
 and proc = new LowLevelKeyboardProc(callback)
 and hook = SetHook proc
 override x.ExitThreadCore() =
 UnhookWindowsHookEx(hook) |> ignore
 base.ExitThreadCore()
 
printfn "Welcome to Colemak!"
 
Application.Run(new App(fun code wparam lparam ->
 let key = int >> enum
 if lparam.flags &&& 0b10010000u = 0u then // key down and not injected
 match lparam.vkCode |> key with
 | Keys.D -> Some "s"
 | Keys.E -> Some "f"
 | Keys.F -> Some "t"
 | Keys.G -> Some "d"
 | Keys.I -> Some "u"
 | Keys.J -> Some "n"
 | Keys.K -> Some "e"
 | Keys.L -> Some "i"
 | Keys.N -> Some "k"
 | Keys.O -> Some "y"
 | Keys.P -> Some ";"
 | Keys.R -> Some "p"
 | Keys.S -> Some "r"
 | Keys.T -> Some "g"
 | Keys.U -> Some "l"
 | Keys.Y -> Some "j"
 | Keys.OemSemicolon -> Some "o"
 | _ -> None
 else None))

If you can’t beat ‘em, join ‘em

Ashley Nathan Feniello — Wed, 18 Apr 2012 03:30:04 GMT

I’ve had fun making the little DCPU emulator (past couple of posts: 1, 2), but sadly, I’ve had no time to make a Forth for it. But hey, Matt Hellige has already done it! I just took his GoForth and got it up and going. Just grab the image from here and load it up:

let image = File.ReadAllBytes @"..\..\goforth.img"
for i in 0 .. 2 .. image.Length - 1 do
    memory.[i / 2] <- (uint16 image.[i]) <<< 8 ||| uint16 image.[i + 1]
cycle ()

Viola, a nice little interactive Forth!

Take it for a spin!

This sure beats assembly (even with a nice IDE) and, for interactivity, it even beats the C tool chain. Running interactively on the target machine is invaluable!

Now we need Notch to get around to spec’ing all the ship sensors and actuators!

(BTW, the code for the little 100-line F# emulator is at my github)

What’s a computer without I/O? Hot Silicon At Best…

Ashley Nathan Feniello — Sat, 14 Apr 2012 23:45:44 GMT

[FYI: Matt Hellige’s excellent GoForth runs on this]

I’m completely astonished at how quickly a community has sprung up around Notch’s DCPU-16. In the first 24 hours there were already tens of implementations in various languages (including mine). Now there’s a web-based IDE, a whole C compiler/assembler tool chain, an LLVM backend, … It’s craziness!

So I’m way behind in the times (almost a week has gone by!), but I’m now adding I/O to my emulator. Notch has yet to officially publish any I/O specs, but there seems to be a de facto standard. Input is a 16-cell ring buffer at 0x9000 and video is 32x12 cells memory mapped at 0x8000 with characters and foreground/background colors encoded in the high byte. I’ll support everything from this spec (in 25 lines of F#!) except fonts and blinking; just using the standard console.

Input

Input is easy enough. Just call this on every cycle:

open System

let mutable buf = 0
let input () =
    let buffer = 0x9000
    let size = 16
    if Console.KeyAvailable then
        let b = buffer + buf
        memory.[b] <- uint16 (Console.ReadKey true).KeyChar
        if memory.[b] = 13us then memory.[b] <- 10us // CR –> LF
        memory.[buffer + size] <- uint16 (b)
        buf <- (buf + 1) % size

Output

Output too is pretty simple. The output function is called on every memory set:

let vidwidth, vidheight = 32, 12
Console.Clear()
Console.WindowWidth <- vidwidth
Console.WindowHeight <- vidheight
Console.Title <- "F# DCPU-16"

let output i =
    let vidmem = 0x8000
    if i >= vidmem && i <= vidmem + vidwidth * vidheight then
        let p = i - vidmem
        Console.SetCursorPosition(p % vidwidth, p / vidwidth)
        let v = int memory.[i]
        Console.BackgroundColor <- (v >>> 8) &&& 0x0f |> enum
        Console.ForegroundColor <- v >>> 12 |> enum
        Console.Write(v &&& 0x7f |> char)

Demo

I still have no assembler. I’m working on a Forth instead. For now just straight machine code (fun!):

let boot image = List.iteri (fun i c -> memory.[i] <- uint16 c) image; cycle ()

You could modify to load an image from a file and use with the DCPU Toolchain if you like. For a quick demo, let’s just take a couple of samples from the wonderful http://0x10co.de site:

// Screen test (see http://0x10co.de/y5096)
boot [0x7c01; 0xf030; 0x7c61; 0x8000; 0x7c0c; 0xf838; 0x7c03; 0xf000
      0x7c0c; 0x0a3a; 0x9c02; 0x00e1; 0x7c02; 0x0101; 0x8462; 0x19fe
      0x8010; 0x7dc1; 0x0004; 0x0020; 0x0000]

// Keyboard test (see http://0x10co.de/h6bbv) boot [0x7c01; 0x8000; 0x8021; 0x8011; 0x4811; 0x0063; 0x781a; 0x0062 0x0481; 0x8402; 0x8422; 0x812d; 0x0063; 0x7dc1; 0x0004; 0x81ec 0x9010; 0x7dc1; 0x000f; 0x7c10; 0x0056; 0x7c81; 0x20df; 0x81ec 0x9010; 0x7dc1; 0x0015; 0x7821; 0x9010; 0x2811; 0x81e1; 0x9010 0x8021; 0x8121; 0x9000; 0x8422; 0xc02d; 0x7dc1; 0x0021; 0xa01c 0x7c10; 0x0037; 0xa81c; 0x7c10; 0x0044; 0x781a; 0x0062; 0x0481 0x8402; 0x7c0e; 0x817f; 0x7dc1; 0x000f; 0x7dc1; 0x0015; 0x7c81 0x0020; 0x7c0d; 0x8000; 0x8403; 0x788a; 0x0062; 0x7c8c; 0x2020 0x7dc1; 0x0037; 0x7dc1; 0x0015; 0x7c0e; 0x815f; 0x7dc1; 0x0015 0x7c81; 0xf000; 0x7c03; 0x8000; 0x7c02; 0x0020; 0x7c05; 0x0020 0x7c04; 0x0020; 0x7c02; 0x8000; 0x7dc1; 0x0015; 0x7c01; 0x8000 0x7c81; 0x0020; 0x8402; 0x7c0d; 0x8180; 0x7dc1; 0x0058; 0x7c01 0x8000; 0x61c1; 0x2000; 0x0054; 0x0079; 0x0070; 0x0065; 0x0020 0x0073; 0x006f; 0x006d; 0x0065; 0x0074; 0x0068; 0x0069; 0x006e 0x0067; 0x0021; 0x0000; 0x0000]

// Matrix Screen Saver (see http://0x10co.de/gpoke)
boot [0x7c51; 0x1234; 0x1441; 0x7dc1; 0x0009; 0x7c44; 0x274d; 0x8442
      0x61c1; 0x8061; 0x1031; 0x1441; 0x7c01; 0x8000; 0x8071; 0x7c10
      0x0005; 0x808c; 0x7dc1; 0x0024; 0x7c4f; 0x7000; 0x7dc1; 0x0024
      0x11a1; 0x0c41; 0x7c10; 0x0005; 0x7c89; 0xff00; 0x7c49; 0x003f
      0x508a; 0x0080; 0x1031; 0x6041; 0x8472; 0x8402; 0x1dfe; 0x0020
      0x7dc1; 0x000f; 0x8462; 0x1ace; 0x7dc1; 0x000e; 0x0c41; 0xb061
      0x7c01; 0x817f; 0x7c71; 0x0020; 0x808c; 0x7dc1; 0x004d; 0x7d0f
      0x0020; 0xffff; 0x7dc1; 0x004f; 0x7c10; 0x0005; 0x2101; 0x0020
      0x7d09; 0x0020; 0xff00; 0x1031; 0x7c39; 0x003f; 0x4d0a; 0x0020
      0x0080; 0x7c89; 0x7fff; 0x7dc1; 0x0052; 0x8101; 0x0020; 0x7d09
      0x0020; 0x7fff; 0x8473; 0x8403; 0x807e; 0x7dc1; 0x0034; 0x8463
      0x806e; 0x7dc1; 0x0032; 0x0c41; 0x7c01; 0x8000; 0x8071; 0x7c10
      0x0005; 0x7c4f; 0x0700; 0x7dc1; 0x0077; 0x7c8f; 0xffff; 0x7dc1
      0x0076; 0x7c81; 0x2000; 0x7c4f; 0x0800; 0x7c81; 0xa000; 0x1031
      0x7c39; 0x003f; 0x4c8a; 0x0080; 0x7dc1; 0x0077; 0x8081; 0x8472
      0x8402; 0x1dfe; 0x0020; 0x7dc1; 0x005f; 0x7dc1; 0x0009; 0x85c3
      0x0030; 0x0030; 0x0031; 0x0031; 0x0032; 0x0033; 0x0033; 0x0034
      0x0035; 0x0036; 0x0037; 0x0038; 0x0038; 0x0039; 0x0026; 0x007c
      0x007c; 0x0021; 0x0021; 0x0040; 0x003d; 0x003d; 0x003a; 0x003a
      0x002a; 0x002a; 0x0023; 0x0023; 0x003c; 0x003e; 0x003e; 0x005f
      0x005f; 0x0054; 0x0059; 0x0059; 0x0055; 0x0044; 0x0051; 0x005a
      0x004a; 0x004a; 0x0049; 0x0058; 0x002d; 0x0020; 0x007e; 0x007e
      0x006f; 0x0069; 0x0077; 0x006c; 0x0072; 0x006b; 0x006d; 0x002f
      0x002f; 0x005c; 0x0027; 0x005b; 0x005d; 0x005e; 0x0029; 0x0060]

// Psychedelic Screensaver (see http://0x10co.de/4r80g)
boot [0x7801; 0x002c; 0x7c10; 0x0025; 0x01e1; 0x002c; 0x0011; 0x7c16
      0x004f; 0x7c12; 0x0021; 0x7801; 0x002d; 0x7c10; 0x0025; 0x01e1
      0x002d; 0x7c09; 0xf000; 0x001a; 0x7801; 0x002e; 0x7c10; 0x0025
      0x01e1; 0x002e; 0x7c06; 0x0180; 0x0501; 0x8000; 0x8071; 0x8472
      0x1f4e; 0x7dc1; 0x001f; 0x7dc1; 0x0000; 0x19a1; 0x0061; 0x1864
      0x946a; 0x1802; 0x6061; 0x61c1; 0x3241; 0x3432; 0x2837; 0x0000]

Pretty fun stuff!

Notch is Gonna Outdo Himself!

Ashley Nathan Feniello — Thu, 05 Apr 2012 05:28:39 GMT

[Note: I/O has now been added]

My son is completely obsessed with Minecraft. It’s an amazing game and the way he plays it, it really nurtures extreme creativity. I honestly haven’t been able to get into it myself but I was pretty intrigued by the ComputerCraft mod which allows you to script the game in Lua. I thought it might be a good way to introduce my son to programming.

Even better, just today Notch announced his latest game and it looks like it will revolve around programming a 1980’s style 16-bit computer! Based on the spec at the site, I just couldn’t resist implementing the DCPU-16 in F# :) I can’t wait for the game to come out!

let memory = Array.create 0x10000 0us
let registers = Array.create 11 0us

let rec cycle () =
    let mem i = (fun () -> memory.[i] |> int), (fun v -> memory.[i] <- uint16 v)
    let reg i = (fun () -> registers.[i] |> int), (fun v -> registers.[i] <- uint16 v)
    let lit v = (fun () -> v), (fun _ -> ())
    let pc, sp, o = reg 8, reg 9, reg 10
    let get v = (fst v) ()
    let set v i = (snd v) i
    let next () = let p = get pc in let n = mem p |> get in set pc (p + 1); n
    let decode () = let i = next () in i, (i &&& 0x3f0) >>> 4 |> int, (i &&& 0xfc00) >>> 10 |> int
    let skip () =
        let skip' i = if (i > 0xf && i < 0x18) || i = 0x1e || i = 0x1f then get pc + 1 |> set pc else ()
        let _, a, b = decode ()
        skip' a; skip' b
    let value = function
        | x when x <= 0x07 -> reg x // reg
        | x when x <= 0x0f -> (x &&& 0b111 |> reg |> fst) () |> mem // [reg]
        | x when x <= 0x17 -> (x &&& 0b111 |> reg |> fst) () + next () |> mem // [next + reg]
        | 0x18 -> let s = get sp in let x = mem s in set sp (s + 1); x // POP / [SP++]
        | 0x19 -> get sp |> mem // PEEK / [SP]
        | 0x1a -> get sp - 1 |> set sp; get sp |> mem // PUSH / [--SP]
        | 0x1b -> sp // SP
        | 0x1c -> pc // PC
        | 0x1d -> o // O
        | 0x1e -> next () |> mem // [next]
        | 0x1f -> next () |> lit // next (literal)
        | x -> x - 0x20 |> lit // literal 0x00-0x1f
    let instruction, a', b' = decode ()
    let a, b = value a', value b'
    let fxy f = f (get a) (get b)
    let fop op = fxy (fun x y -> op x y |> set a)
    let fif op = fxy (fun x y -> if op x y then skip ())
    match instruction &&& 0xf |> int with
    | 0x0 -> if a' = 0x01 then get pc |> set (value 0x1a (* PUSH *)); get b |> set pc // JSR
    | 0x1 -> get b |> set a // SET
    | 0x2 -> fxy (fun x y -> x + y |> set a; set o (if x + y > 0xffff then 1 else 0)) // ADD
    | 0x3 -> fxy (fun x y -> x - y |> set a; set o (if x - y < 0 then 0xffff else 0)) // SUB
    | 0x4 -> fxy (fun x y -> x * y |> set a; ((x * y) >>> 16) |> set o) // MUL
    | 0x5 -> fxy (fun x y -> if y = 0 then set a 0; set o 0 else x / y |> set a; (x <<< 16) / y |> set o) // DIV
    | 0x6 -> fxy (fun x y -> set a (if y = 0 then 0 else x % y)) // MOD
    | 0x7 -> fxy (fun x y -> let z = x <<< y in set a z; z >>> 16 |> set o) // SHL
    | 0x8 -> fxy (fun x y -> x >>> y |> set a; (x <<< 16) >>> y |> set o) // SHR
    | 0x9 -> fop (&&&) // AND
    | 0xa -> fop (|||) // BOR
    | 0xb -> fop (^^^) // XOR
    | 0xc -> fif (<>) // IFE
    | 0xd -> fif (=) // IFN
    | 0xe -> fif (<=) // IFG
    | 0xf -> fif (fun x y -> x &&& y = 0) // IFB
    cycle ()

Turtle Graphics on the Fignition

Ashley Nathan Feniello — Sun, 19 Feb 2012 04:28:00 GMT

The Fignition board is a fun little piece of 8-bit fun I tell ya! I’ve been having a blast with it. It’s an ATmega168 with 8Kb SRAM and 4Mbits of flash with video out (there’s also a sound mod for it). In this post I want to show off an implementation of Turtle Graphics I’ve made for it.

Forth as an “OS”

Most interestingly the Fignition is a completely standalone FIG-Forth system. It has an 8-button input system and, as is common for old Forths, there is an editor and screen-sized block “file system” of sorts. Compilation happens as blocks are loaded. This is all the “operating system” you need. For the first few days I programmed it entirely this way.

This is what is meant when people say that Forth is a language and an operation system. Normally it doesn’t mean giving up a normal keyboard, but still this idea of a complete system entirely in Forth is where it’s at. I’ll probably fall to temptation when the Raspberry Pi comes out but, com’on Linux is overkill (WinCE single board computers are too).

Development Host Machine

The above being said, it is quite tedious to program with the 8-button keyboard. Yesterday I got bulk loading of data over USB working; still a process but easier. There are instructions here (I initially had driver issues on Win8 – be sure to get the latest USBasp from here). The AVRDude tool allows you to transfer source one 500-byte block at a time from a PC/Mac to EPROM. Then you can edit on the device itself and write to flash, from where it can then be loaded/compiled to the dictionary and executed.

Turtle Graphics!

There was a 160x160 graphics mode added in firmware 0.9.6. This gave me the idea of making a rudimentary Logo-like system (I love it as a teaching language). I had a silly goal of getting it working snugly within a single block of code and managed to pull that off. It adds the following words for controlling the “turtle”:

c – clear screen (cls doesn’t work in 160x160 graphics mode)
g – Go to an x y coordinate (0,0 is the center of the screen)
h – Set heading (0-60 - 0 is North, 15 East, 30 South, 45 West)
b – Begin (enters 160x160 graphics mode, clears, resets turtle)
e – End (waits for key, exits graphics mode)
t – Turn the turtle (see h above – negative values for counter-clockwise)
n – Sine function (used internally – see h above – returns scaled by 255)
m – Move turtle number of pixels along current heading (no drawing)
p – Plot pixel currently under turtle
f – Forward number of pixels while plotting

Yes, this all fits in a single block and compiles to just 307 bytes!

Fixed-point Trig Functions

It uses a table-based cosine function with 6 degree (pi/30 radian) increments – think minute marks on a clock. This is still divisible by many things (2, 3, 4, 5, 6, 10, 12, 15, 20, 30), so it works out well enough for Logo and makes the lookup table small.

Resorting to 8.8 fixed-point numbers, I started with a quarter-cosine table with values scaled by 256. This leaves plenty of room for the turtle coordinates with a desired 160*256 range easily with the 16-bit integers supported. Some F# to generate it:

let table =
let pi = System.Math.PI
let fix x = round (cos x * 256.) |> int
Array.map fix [|0. .. (pi / 30.) .. (pi / 2.)|]

Array.iter (printf "%x ") table

> 100 ff fa f3 ea de cf be ab 96 80 68 4f 35 1b 0

Just these values can be reflected and/or shifted to generate sine/cosine results for all sixty angles; something like the following (but in Forth):

let cosine x =
let a = abs x % 60
let i = if a > 29 then 60 - a else a
let s, i' = if i > 14 then -1, 30 - i else 1, i
table.[i'] * s

let sine x = x - 15 |> cosine

The Forth is intentionally compacted into obfuscation:

-2 var n F9F2 , E9DD , CEBD , AA95 , 7F67 , 4E34 , 1A c,
: s abs 3C mod dup 1D > if 3C swap - then dup E > if
-1 1E rot - else 1 swap then n + c@ 1+ * ;

The rest of the implementation is relatively straight forward (but not so readable because of poor factoring and naming due to wanting to squeeze down the character count):

0 var x 0 var y 0 var a
0 var q 0 var w
: c 9380 C80 0 fill ;
: k >r 50 + 8 << r> ! ;
: m dup q @ * x +! w @ * y +! ;
: g y k x k ;
: h dup a ! dup s w ! 2D + s q ! ;
: f >r q @ x @ y @ w @ r 0 do >r r + >r over +
dup 8 >> r 8 >> plot r> r> loop o y ! x ! o r> o ;
: e key 0 vmode cls ;
: b 1 vmode 1 pen c 0 0 g 0 h ;
: t a @ + h ;

Demo, demo, demo!

In a second block are some demos putting it to use.

[UPDATE: Now 4x faster!] I was stupidly calculating sine/cosine for every single-pixel of motion. Of course this only needs to be done when the heading changes - just keep the multipliers around for future use. Also, I made a small optimization to avoid multiplication for single-pixel movement. This sped things up by a factor of four or five.

[UPDATE: Now 15x faster!] Julian Skidmore, the designer of the Fignition, was nice enough to look at the code and came up with some brilliant performance optimizations - mostly around using 8.8 fixed point so that bit shifts could be used rather than multiplication/division and a slick simplification to the trig function.

(Please visit the site to view this video)

The sine (s) function can be seen to work with:

: sin 160 0 do i i s 4 / 80 + plot loop ;

And we can see that using it to plot lines in each of the 60 available angles works:

: burst 60 0 do 0 0 g i h 110 f loop ;

Other demos show off some of the creative Logo patterns you may have played with as a kid:

: squiral -50 50 g 20 0 do 100 f 21 t loop ;

: circle 60 0 do 4 f 1 t loop ;
: spiral 15 0 do circle 4 t loop ;

: star 5 0 do 80 f 24 t loop ;
: stars 3 0 do star 20 t loop ;

: rose 0 50 0 do 2 + dup f 14 t loop ;

One of my favorites is this flower:

: hp 15 0 do 5 f 1 t loop 15 0 do 2 f -1 t loop ;
: petal hp 30 t hp 30 t ;
: flower 15 0 do petal 4 t loop ;

Here’s the source and generates hex files.

Have fun!

96 Line F# Emulator + 960 bytes of HP-35 Microcode

Ashley Nathan Feniello — Fri, 27 Jan 2012 00:57:00 GMT

[Part 3 of the HP Calc series]

In this post, we’ll create a 96-line F# emulator for the HP-35 calculator with which we’ll run the 960 byte (!) ROM image.

As you may well know, I am a calculator freak. The 40-year-old HP-35 is an especially wonderful device; being the world’s first scientific pocket calculator. I own a couple of them and keep one handy on my desk, but it’ll be useful to have a faithful command-line rendition.

Tiny ROM

Here is a base-64 encoding of the ROM. It was three chips, each with 256 10-bit words, for a total of 7,680 bits; just under 1KB:

let rom = // HP-35 v2 ROM

"N2/4kBdRJEIREFRQsXzDajZ7u+ILiQ+r6vqGuaSoqg//q+r6gwMwqmoEN07MDAACDUQRC7k"+

"Qn6EwsLiQyjb/q+r6hLmfqO13d27OMTg0oDSzt3qjb0uvpFtqh9uo3zbTI3y67jUVPfj+dR"+

"X0ocQzlq767EfR1hOVtbLF7i57hMRIPGiZtbou6Y7K/6a6kUX961RJBBLUHOzuVSqzk6wrq"+

"gag8qlKYrwd3tYHCsR/DLuvb4viIwPNilsApH+LLgwP5qAu/r+n6foSqP67pmmp/romEq+6"+

"O+oDr7qNhmUtMHFqpLDGmcN6rEmJv0GuskO1UTd7OZ6JM/fqBFUzd6sbCgFMfCQHMs0OKIU"+

"zNDlkNBKOu/VxOVTlj0U5PmvvP6pMP7o0lyNqev3M4NGOwxuvfKpeufUzqkURPKgqesZu77"+

"fz8uKFqChaiVAn65VBLN6mUopWYSVaimaU2u7viSbplqpJuhntJ6h3s6jkoi5B4uQze0o65"+

"oi3K5jiKy9jhUJelG3VQVz+74N6S3463+zJ0suS7Ujvaizuyy5Eko/7/iPM4Knit1Ymo65D"+

"KRYybYMm0jIYoybY5m3MUOm0jstzGrqZlRsz+mEZDOWJ6hUpemcxq6lcxq6rpVq7rcxoycY"+

"5gydSMhhjJxQycZxy6TtMVj72MhhmFYJhGJYFTawwu74gQRBDqWi6h3+w6g+ORBEFKRB4tO"+

"qPzkOByUgsqct3ixay+WRYHAss8twc5bbwQXperq16fsbRCBsrP7LsORAzrMdiGFYNiWIYF"+

"hmDYVjDAwBDit7WJ/gsu/qrqGLm7Ok6KjKwyu0QpKkl+7N0sSjIjt+7vsmoB4B0O7JKKSX6"+

"PgQz7/pWRIS2opljoUQ+7tGAOzl+AN/kulnYhHzJPueAdzG1gydZMnH+aMnF9bMnHfZxuWc"+

"fZ65TgaMNTsuBxDhsMfrm+Oc5nqszFZUBtVJT9mnZT9nsQ2uWzJt32jJtfWTJt/mDJtm2bd"+

"Mi7rmYjslF7+qesLxZZ+WQ5alzs40uqb5s8uw46rOi4zlmJR20YeZ52YGx15Ok4lJTDBzDY"+

"NgGIYVgGJY6uWfiS5fobtLrkW67foju74sRJC0t+lfks+DAkLOi6g+OX6f+uRbrm3Mxyleq"+

"8vsmu7LMXGa2xUAMktmfqMumJCJGYlg2BYRh2BY5v5mT45YsTs4PNsxd6r+wwLpi1tDlqm7"+

"PzOSrjp+x/pmOC7DHrkw2BYBgWHYliGAYVhWDY3frkuYaul7fqznq8tnzOwwmDYBgmFYgdTH7"

The authoring of this microcode by David Cochran was an amazing piece work and Peter Monta’s reverse engineering of the ROMs by literally cutting them open and optically extracting the bits is a pretty insane feat! I’ve talked quite a bit about all of this in past posts so I won’t go into detail here.

Perfect Fidelity Emulation

In well under 100 lines, here’s the emulator:

open System

open System.Collections

let calculator input output rom =

let r = Array.init 8 (fun _ -> Array.create 14 0)

let s = Array.create 12 0

let p = ref 0

let pc, offset, ret = ref 0, ref 0, ref 0

let carry, carry' = ref false, ref false

let visible, disp = ref false, ref ""

let waiting, lastKey = ref 0, ref 0

let halt = ref false

let exec code =

let doCarry res = carry := (res > 9 || res < 0); (res + 10) % 10

let doOp fn x y = doCarry (fn (fn x y) (if !carry then 1 else 0))

let iteric c fn (first, last) = carry := c; for i in first..last do fn i

let iteri fn = iteric !carry fn

let setreg a b = iteri (fun i -> r.[a].[i] <- r.[b].[i])

let zeroreg reg = setreg reg 7

let shiftl a (f,l) = for i in (List.rev [f..l]) do r.[a].[i] <- if i = f then 0 else r.[a].[i-1]

let shiftr a (f,l) = for i in f..l do r.[a].[i] <- if i = l then 0 else r.[a].[i+1]

let arith op a b c = iteri (fun i -> r.[a].[i] <- (doOp op) r.[b].[i] r.[c].[i])

let add = arith (+)

let sub = arith (-)

let regsgte a b = iteri (fun i -> (doOp (-)) r.[a].[i] r.[b].[i] |> ignore)

let regsgte1 a = iteric true (fun i -> carry := !carry && r.[a].[i] = 0)

let negcdec dec = iteric dec (fun i -> r.[2].[i] <- (doOp (-)) 0 r.[2].[i])

let opreg op a = iteric true (fun i -> r.[a].[i] <- (doOp op) r.[a].[i] 0)

let ifregzero a = iteri (fun i -> carry := !carry || r.[a].[i] <> 0)

let exchreg a b = iteri (fun i -> let t = r.[a].[i] in r.[a].[i] <- r.[b].[i];r.[b].[i]<-t)

let opp fn = p := (fn !p 1) &&& 0xf

let iterir fn = for i in 0..13 do fn i

let move pairs = iterir (fun i -> List.iter (fun (a, b) -> r.[a].[i] <- r.[b].[i]) pairs)

let n = (code &&& 0b1111111100) >>> 2

pc := (!pc + 1) % 256

match code &&& 0b11 with

| 0b11 -> if not !carry' then pc := n
| 0b01 -> ret := !pc; pc := n

| 0b10 –>
[| ifregzero 1; regsgte 0 2; setreg 2 1; zeroreg 2; shiftl 0; sub 2 0 2; setreg 0 2; add 2 0 2

regsgte 0 1; shiftr 2; shiftr 1; shiftr 0; sub 0 0 1; sub 0 0 2; add 0 0 1; add 0 0 2; zeroreg 1

regsgte1 2; negcdec false; negcdec true; setreg 1 0; opreg (-) 2; ifregzero 2; opreg (+) 2

exchreg 1 2; regsgte1 0; add 2 2 2; zeroreg 0; exchreg 0 1; opreg (-) 0; exchreg 0 2; opreg (+) 0

|].[16 * (n / 8 &&& 1) + (n / 16)] [|!p,!p; 3,12; 0,2; 0,13; 0,!p; 3,13; 2,2; 13,13|].[n % 8]

| 0b00 -> let arg = n / 16

match n % 16 with

| 0 -> () // no-op

| 1 -> s.[arg] <- 1

| 3 -> p := arg

| 4 when arg = 3 -> pc := !lastKey

| 4 when arg % 2 = 0 -> let r = arg / 2 in offset := r * 256

| 5 -> carry := s.[arg] <> 0; if arg = 0 then waiting := !waiting + 1

| 6 -> (if !p < 14 then r.[2].[!p] <- arg); opp (-)

| 7 -> opp (-)

| 9 -> s.[arg] <- 0

| 10 –>
match arg with

| 0 -> visible := not !visible

| 2 -> exchreg 2 6 (0, 13)

| 4 -> move [5, 4; 4, 3; 3, 2]

| 6 -> move [0, 3; 3, 4; 4, 5]

| 8 -> visible := false

| 10 -> setreg 2 6 (0, 13)

| 12 -> iterir (fun i -> let t = r.[2].[i] in move [2,3; 3,4; 4,5]; r.[5].[i] <- t)

| 14 -> for i in 0..13 do for j in 0..7 do r.[j].[i] <- 0

| 11 -> carry := !p = arg

| 12 -> pc := !ret

| 13 -> for i in 0..11 do s.[i] <- 0

| 15 -> p := (!p + 1) &&& 0xf

let display () =

if not !visible then "" else

let render i a b =

(if b >= 8 then " "

elif i = 2 || i = 13 then (if a >= 8 then "-" else " ")

else string a) + (if b = 2 then "." else "")

Array.mapi2 render r.[0] r.[1] |> Array.rev |> Array.fold (+) ""

let code = let bits = let toBits b = [|for s in 0..7 -> 0x80uy >>> s &&& b |> min 1uy|]

rom |> Convert.FromBase64String |> Array.collect toBits

[for i in 0..767 -> List.sum [for b in 0..9 -> (int bits.[i * 10 + 9 - b]) <<< b]]

let rec step () =

let disp' = display ()

if disp' <> !disp then output disp'; disp := disp'

carry' := !carry; carry := false

exec code.[!offset + !pc]

if !waiting > 1 then

match input () with

| Some k ->

match List.tryFind (fst >> (=) k)

             ['0',36; '1',28; '2',27; '3',26; '4',20; '5',19; '6',18; '7',52; '8',51; '9',50; '.',35; '-',54
              '+',22; '*',30; '/',38; 'p',34; '~',59; '!',0; 'x',58; 'a',44; 's',43; 'c',42; 't',40; 'l',3
              'g',4; 'e',2; '^',6; 'q',46; 'f',14; 'w',12; 'r',11; '>',10; '<',8; ',',56; ' ',62] with

| Some (_, addr) -> lastKey := addr; s.[0] <- 1; waiting := 0

| None -> halt := k = '`'

| None -> ()

if not !halt then step () else disp'

step ()

Given a ROM image and a pair of I/O functions, this will emulate the HP-35 perfectly.

What’s amazing really is that the only “mathy” operations we emulate are addition, subtraction and digit shifting. From this, all of the logarithm, trigonometry, etc. are implemented in microcode. Jacques Laporte’s site goes into great detail on how it works. It’s quite an interesting onion to unpeel!

On the real device, key presses cause jumps to particular ROM addresses. In the emulation, input comes from a (unit -> char option) function. The character mappings are:

Digits 0-9 and decimal (.)	Number input
+ - * /	Basic Arithmetic (+ - × ÷)
~	CHS (change sign)
SPACE or RETURN	ENTER
x	EEX (enter exponent)
,	CLX (clear X register)
p	π
^	x^y (x to y power)
g	LOG (log₁₀)
l	LN (log_e)
e	e^x (e to x power)
!	CLR (clear)
q	√x (sqrt x)
a	ARC
s	SIN
c	COS
t	TAN
f	¹/_x (reciprocal – “flip”)
w	x↔y (swap)
r	R↓ (roll down)
>	STO (store)
<	RCL (recall)
`	Quit

The “UI”

The calculator function above takes a ROM image and the pair of I/O functions. Again, input is a (unit -> char option) called repeatedly and output is a (string -> unit) which is passed the display (driven by the A and B registers) formatted exactly as you’d see it on the real device.

We can cobble together a quick console UI like so:

calculator

(fun () ->
if Console.KeyAvailable then

let k = Console.ReadKey true

if k.Key = ConsoleKey.Enter then Some ' '

elif k.Key = ConsoleKey.Escape then Some '`'

else Some (Char.ToLower k.KeyChar)

else None)

(printf "\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b%s")

rom |> ignore

Tests

Another reason for passing in the I/O dependencies is to allow simple testing:

let test keys expected =

let keySequence = ref (List.ofSeq keys)

let testInput () =

match !keySequence with

| h :: t -> keySequence := t; Some h

| [] -> Some '`'

let res = calculator testInput (fun _ -> ()) rom

assert (res = expected)

test "~1.2345678909x~35" "-1.234567890-35" // entry

test "2 3+" " 5. " // add

test "3 2-" " 1. " // subtract

test "3 2*" " 6. " // multiply

test "3 2/" " 1.5 " // divide

test "4f" " .25 " // reciprocal

test "25q" " 5. " // square root

test "pl" " 1.144729886 " // ln

test "pg" " .4971498728 " // log

test "pe" " 23.14069264 " // exp

test "ps" " .054803665 " // sin

test "pc" " .9984971498 " // cos

test "pt" " .0548861507 " // tan

test "pgas" " 29.81161556 " // sin-1

test "pgac" " 60.18838444 " // cos-1

test "pat" " 72.34321286 " // tan-1

test "1 2 3 4 Swrrr" " 2. " // stack

test "123>456 ,<" " 123. " // memory

test "9sctatacas" " 9.002983113 " // "Calculator Forensics" result

test "9 2^" " 512. " // power

I keep this little guy handy now in my console window. I dropped it, along with the F# tools from previous HP-35 posts, in my github as well. Have fun with it if you like!

Introducing the Cult of the Bound Variable to the Cult of Forth

Ashley Nathan Feniello — Sun, 08 Jan 2012 01:07:41 GMT

[The twelfth in a series of posts on the evolution of TransForth]

It’s been quite fun playing with this Universal Machine from the Cult of the Bound Variable. In this post we’re going to continue the journey toward building a full Forth for this machine by assembling a Forth inner interpreter; turning this register machine into a stack machine.

Last time we finished up a single-pass macro assembler for the UM-32 (in 15 lines of F# and 40 lines of Forth!) but did nothing more than a simple “Hello, world” with it. If you remember when we built an inner interpreter for TransForth, you know that this is the heart of Forth. If you’re unclear on the mechanics of a direct threaded inner interpreter, you’d probably enjoy the video from that earlier post:

Register Machines (what a pain)

Being so used to dealing with a stack machine and essentially zero-operand instructions, it can be a bit annoying to deal with a register machine. But that’s what we have with the UM-32. Let’s assign purposes to the remaining registers (remember, z is already the zero constant and registers 1 and 2 are temp registers. Let’s allocate one more temp along with the standard inner interpreter and stack pointers.

: x 3 ; \ Temp register

: w 4 ; \ Working register

: i 5 ; \ Interpreter register

: s 6 ; \ Stack (data) register

: r 7 ; \ Return stack register

In a way you can think of what we’re doing as implementing stack machine mechanics on top of a register machine. There are, of course, many real stack machines implemented in hardware. Koopman’s book is an excellent resource (free online) by the way. For the UM-32, we’ll need to handle the stacks ourselves along with the mechanics of walking nested sequences of stack operations.

Given the data or return stack pointer and a value register, these words will handle the stacks in a few instructions:

: push, ( ab-m ) \ b.push(a)

DUP

dec, \ b--

z store, \ M[b] = a

;

: pop, ( ab-m ) \ b = a.pop()

OVER SWAP

z SWAP \ aazb

fetch, \ b = M[a]

inc, \ a++

;

These don’t emit any UM-32 code at this point. Instead they are assembler “macros” used to inline these instructions as needed later.

Inner Interpreter

Now we’re going to emit the inner interpreter and dictionary structure. Following that, we’ll initialize and kick things off. We’ll start by jumping to the initialization code (yet to be defined):

forward branch, \ over dictionary

It happens to be patched to address 60 later and the following ends up in the image:

00000 60 y literal

00001 z y loadjump

The triumvirate of an inner interpreter is enter,next and exit (in the past I’ve referred to them by their more classic names docol, next and dosemi).

The job of enter is to go into word definitions. It pushes the interpreter (i) register onto the return stack so we can get back out upon exit. It then points i at the body of the word and does a next.

VARIABLE &enter address &enter !

i r push, \ r.push(i)

2 t literal, t w i add, \ i = w + 8 (skip over enter,)

\ falls through to next,

It emits the following UM-32 code to the image (falling through to next):

00002 0 t literal

00003 t t t nand

00004 r t r add

00005 z r i store

00006 2 t literal

00007 i w t add

To make it easy to jump to this, here’s a convenience word:

: enter, &enter @ x literal, x jump, ;

Next comes next, whose job is to jump to the next word in a sequence and advance the interpreter to the one following.

VARIABLE &next address &next !

i z w fetch, \ w = M[i]

i inc, \ i++

w jump,

Emitting:

00008 w z i fetch

00009 1 t literal

00010 i t i add

00011 z w loadjump

And the same kind of convenience macro:

: next, &next @ x literal, x jump, ;

Remember that all primitive words are plain machine code followed by a next. All secondary words begin with enter (that is, with machine code to jump to &enter) and are terminated with exit. The job of exit is to leave and rejoin a parent sequence; simply recovering the return address from the return stack and doing next from there.

VARIABLE &exit address &exit !

r i pop, \ i = r.pop()

next,

Emitting an inlined pop and a jump to next:

00012 i z r fetch

00013 1 t literal

00014 r t r add

00015 8 x literal

00016 z x loadjump

That’s it for the inner interpreter! Just fifteen instructions (plus two for the jump as the start).

Hand-packed Primitives

Now we want to pack a dictionary with primitive and secondary words to exercise things a bit. Using the same example as in the direct threading demo video, we’ll need literals (lit), pick and add primitives then we can define secondary dup (in terms of lit and pick) and double (in terms of dup and add).

Starting with lit, we push the literal which is packed alongside word addresses and advance the interpreter to skip ahead:

VARIABLE &lit address &lit !

i z y fetch, \ y = M[i]

y s push, \ s.push(y)

i inc, \ i++

next,

Emitting:

00017 y z i fetch

00018 0 t literal

00019 t t t nand

00020 s t s add

00021 z s y store

00022 1 t literal

00023 i t i add

00024 8 x literal

00025 z x loadjump

The pick word is used to pull a copy of the nth element on the stack to the top:

VARIABLE &pick address &pick !

s y pop, \ y = s.pop()

s x move, \ x = s

y x x add, \ x = x + y

x z x fetch, \ x = M[x]

x s push, \ s.push(x)

next,

Emitting:

00026 y z s fetch

00027 1 t literal

00028 s t s add

00029 1 t literal

00030 x s t cmove

00031 x x y add

00032 x z x fetch

00033 0 t literal

00034 t t t nand

00035 s t s add

00036 z s x store

00037 8 x literal

00038 z x loadjump

The add word essentially pops two values and pushes back their sum. It could be implemented as:

s y pop, \ y = s.pop()

s x pop, \ x = s.pop()

y x x add, \ x = x + y

x s push, \ s.push(x)

next,

But a more efficient implementation just fetches the top of the stack for the second operand (without popping) and pokes back the result (without pushing):

VARIABLE &add address &add ! \ TODO: More efficient

s y pop, \ y = s.pop()

s z x fetch, \ x = M[s]

y x x add, \ x = x + y

x s z store, \ M[s] = x

next,

Emitting:

00039 y z s fetch

00040 1 t literal

00041 s t s add

00042 x z s fetch

00043 x x y add

00044 z s x store

00045 8 x literal

00046 z x loadjump

For our final primitive in this exercise, we just need a halt. It’s just a single instruction terminating execution (so it doesn’t need to be followed by a next). Later we’ll seed the process by pointing the interpreter here so that once all the nested sequences are complete the machine halts:

VARIABLE &halt address &halt !

halt,

Emitting:

00047 halt

Hand-packed Secondary Words

Now on to the secondary words, which are quite different. They’re a branch to enter followed by a sequence of addresses rather than of machine code. It’s starting to gain a Forth-like feel; a little more comfortable:

VARIABLE &dup address &dup !

enter,

&lit @ m,

0 m,

&pick @ m,

&exit @ m,

Emitting:

00048 2 x literal

00049 z x loadjump

00050 17

00051 0

00052 26

00053 12

Notice how the literal zero is packed in there but otherwise it’s just a list of addresses. This is the essence of threaded code. If you think of the word addresses as op codes for a zero-operand stack machine, you’re not far off!

The double word is another secondary, this time defined in terms of another secondary (the dup from above) and primitives:

VARIABLE &double address &double !

enter,

&dup @ m,

&add @ m,

&exit @ m,

Emitting:

00054 2 x literal

00055 z x loadjump

00056 48

00057 39

00058 12

That’s it for the dictionary.

Sample Program

Now we want to prime the mechanics to run a sample program. We’ll push a 42 to the stack and execute double. This will dup the 42 by doing a 0 pick and add them together. With success we’ll end up with an 84 on the stack and halt.

To kick off the interpreter, we’ll point it at a location in memory containing the address of the halt word in the dictionary. This will be pushed to the return stack upon initially entering double and will be popped and executed upon completion just as we want:

VARIABLE terminate address terminate !

&halt @ m,

Emitting:

00059 47

Remember the jump at the very start of the image? That is patched to the current address and so here finally begins execution of our sample:

tohere

We’ll partition memory much as we did before with return and data stacks in high memory and the dictionary (already packed) in low memory:

16383 r literal, \ top of return stack, 3FFF

12287 s literal, \ top of data stack, 2FFF

And like we said, seed the interpreter pointer with a cell containing the halt address:

terminate @ i literal,

Emitted so far:

00060 16383 r literal

00061 12287 s literal

00062 59 i literal

To set up our little scenario, we manually push a 42 to the stack, point the interpreter (word register) at doubleand branch into it. The inner interpreter takes it from there; walking the nested primitive and secondary words to completion and halting.

42 x literal, x s push,

&double @ w literal,

&double @ branch,

Emitting:

00063 42 x literal

00064 0 t literal

00065 t t t nand

00066 s t s add

00067 z s x store

00068 54 w literal

00069 54 y literal

00070 z y loadjump

We’re done!

We can’t quite just load up this 71-cell image in the UM-32 and go however because we’re using memory at much higher addresses for the stack. We could add code to allocate and copy over the image but I think I’ll just take the easy route and pad the rest of the image with zeros; making a nice little 64KB (16K 32-bit cells) image file:

: pad, 16384 address DO 0 m, LOOP ;

pad, msave

Tracing

I would never have been able to get this all working without some visibility into the UM-32 in action. To get some tracing I added the following to Luke’s UM-32 implementation (inside his cycle function):

//(* Debugging
let name = function 0 -> "z" | 1 -> "t" | 2 -> "y" | 3 -> "x" | 4 -> "w" | 5 -> "i" | 6 -> "s" | 7 -> "r"
let an, bn, cn, a2n = (name a), (name b), (name c), (name a2)
printf "%05i  " finger
match code with
| 0u  -> printfn "  %s %s %s cmove       %s = %s:%i if %s:%i" an bn cn an bn reg.[b] cn reg.[c]
| 1u  -> printfn "  %s %s %s fetch       %s = M[%s:%i][%s:%i]" an bn cn an bn reg.[b] cn reg.[c]
| 2u  -> printfn "  %s %s %s store       M[%s:%i][%s:%i] = %s:%i" an bn cn an reg.[a] bn reg.[b] cn reg.[c]
| 3u  -> printfn "  %s %s %s add         %s = %s:%i + %s:%i" an bn cn an bn reg.[b] cn reg.[c]
| 4u  -> printfn "  %s %s %s mult        %s = %s:%i * %s:%i" an bn cn an bn reg.[b] cn reg.[c]
| 5u  -> printfn "  %s %s %s div         %s = %s:%i / %s:%i" an bn cn an bn reg.[b] cn reg.[c]
| 6u  -> printfn "  %s %s %s nand        %s = %s:%i ~& %s:%i" an bn cn an bn reg.[b] cn reg.[c]
| 7u  -> printfn "        halt"
| 8u  -> printfn "    %s %s alloc       new(%s:%i) -> %s" bn cn cn reg.[c] bn
| 9u  -> printfn "      %s free        %s:%i" cn cn reg.[c]
| 10u -> printfn "      %s echo        %s:%i" cn cn reg.[c]
| 11u -> printfn "      %s key         %s:%i" cn cn reg.[c]
| 12u -> printfn "    %s %s loadjump    load(%s:%i), jump(%s:%i)" bn cn bn reg.[b] cn reg.[c]
| 13u -> printfn "%5i %s literal     %s = %i" value a2n a2n value
//Console.ReadLine() |> ignore
//*)

Now we can run our image and see all the gloriously gory details!

00000 60 y literal y = 60

00001 z y loadjump load(z:0), jump(y:60)

00060 16383 r literal r = 16383

00061 12287 s literal s = 12287

00062 59 i literal i = 59

00063 42 x literal x = 42

00064 0 t literal t = 0

00065 t t t nand t = t:0 ~& t:0

00066 s t s add s = t:4294967295 + s:12287

00067 z s x store M[z:0][s:12286] = x:42

00068 54 w literal w = 54

00069 54 y literal y = 54

00070 z y loadjump load(z:0), jump(y:54)

00054 2 x literal x = 2

00055 z x loadjump load(z:0), jump(x:2)

00002 0 t literal t = 0

00003 t t t nand t = t:0 ~& t:0

00004 r t r add r = t:4294967295 + r:16383

00005 z r i store M[z:0][r:16382] = i:59

00006 2 t literal t = 2

00007 i w t add i = w:54 + t:2

00008 w z i fetch w = M[z:0][i:56]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:56

00011 z w loadjump load(z:0), jump(w:48)

00048 2 x literal x = 2

00049 z x loadjump load(z:0), jump(x:2)

00002 0 t literal t = 0

00003 t t t nand t = t:0 ~& t:0

00004 r t r add r = t:4294967295 + r:16382

00005 z r i store M[z:0][r:16381] = i:57

00006 2 t literal t = 2

00007 i w t add i = w:48 + t:2

00008 w z i fetch w = M[z:0][i:50]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:50

00011 z w loadjump load(z:0), jump(w:17)

00017 y z i fetch y = M[z:0][i:51]

00018 0 t literal t = 0

00019 t t t nand t = t:0 ~& t:0

00020 s t s add s = t:4294967295 + s:12286

00021 z s y store M[z:0][s:12285] = y:0

00022 1 t literal t = 1

00023 i t i add i = t:1 + i:51

00024 8 x literal x = 8

00025 z x loadjump load(z:0), jump(x:8)

00008 w z i fetch w = M[z:0][i:52]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:52

00011 z w loadjump load(z:0), jump(w:26)

00026 y z s fetch y = M[z:0][s:12285]

00027 1 t literal t = 1

00028 s t s add s = t:1 + s:12285

00029 1 t literal t = 1

00030 x s t cmove x = s:12286 if t:1

00031 x x y add x = x:12286 + y:0

00032 x z x fetch x = M[z:0][x:12286]

00033 0 t literal t = 0

00034 t t t nand t = t:0 ~& t:0

00035 s t s add s = t:4294967295 + s:12286

00036 z s x store M[z:0][s:12285] = x:42

00037 8 x literal x = 8

00038 z x loadjump load(z:0), jump(x:8)

00008 w z i fetch w = M[z:0][i:53]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:53

00011 z w loadjump load(z:0), jump(w:12)

00012 i z r fetch i = M[z:0][r:16381]

00013 1 t literal t = 1

00014 r t r add r = t:1 + r:16381

00015 8 x literal x = 8

00016 z x loadjump load(z:0), jump(x:8)

00008 w z i fetch w = M[z:0][i:57]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:57

00011 z w loadjump load(z:0), jump(w:39)

00039 y z s fetch y = M[z:0][s:12285]

00040 1 t literal t = 1

00041 s t s add s = t:1 + s:12285

00042 x z s fetch x = M[z:0][s:12286]

00043 x x y add x = x:42 + y:42

00044 z s x store M[z:0][s:12286] = x:84

00045 8 x literal x = 8

00046 z x loadjump load(z:0), jump(x:8)

00008 w z i fetch w = M[z:0][i:58]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:58

00011 z w loadjump load(z:0), jump(w:12)

00012 i z r fetch i = M[z:0][r:16382]

00013 1 t literal t = 1

00014 r t r add r = t:1 + r:16382

00015 8 x literal x = 8

00016 z x loadjump load(z:0), jump(x:8)

00008 w z i fetch w = M[z:0][i:59]

00009 1 t literal t = 1

00010 i t i add i = t:1 + i:59

00011 z w loadjump load(z:0), jump(w:47)

00047 halt

And viola! We indeed end up with 84 on the stack. Not a particularly impressive feat, but it shows that all seems to be working as expected.

To be continued…

Next, we’ll work on building an outer interpreter to process Forth source code and get out of this assembly language business. However, we’ll always keep the assembler handy and we’ll always be free to dip down to defining Forth words at this lowest level; for performance and to take advantage of machine-level functionality as needed. This spanning from bare metal all the way up to very high levels of abstraction is a unique beauty of Forth.

Lego KinNXT

Ashley Nathan Feniello — Fri, 23 Dec 2011 21:08:14 GMT

I’ve been having some fun playing with the Kinect SDK and the Lego NXT kit. The protocol to talk to the Lego brick over Bluetooth is pretty straight forward. Below is a little F# module for most of the basic commands. I’ll fill out the full set soon and put it up on GitHub.

Using this along with Kinect skeletal tracking makes for a quick, pretty cool little project with the boys!

The code is just:

open LegoBot
open Microsoft.Research.Kinect.Nui

printfn "Connecting..."
let bot = new LegoBot "COM3"

printfn "Initializing Kinect..."
if Runtime.Kinects.Count = 0 then failwith "Kinect missing"
let kinect = Runtime.Kinects.Item 0
kinect.Initialize(RuntimeOptions.UseDepth ||| RuntimeOptions.UseSkeletalTracking)
kinect.SkeletonEngine.IsEnabled <- true
kinect.SkeletonEngine.TransformSmooth <- true
kinect.SkeletonFrameReady.Add(fun frame ->
    let drive port position =
        let power = position * 2.f * 100.f |> int
        bot.SetOutputState power port OutputMode.MotorOn RegulationMode.Idle 0 RunState.Running 0ul
    let joints = frame.SkeletonFrame.Skeletons.[0].Joints
    let left = joints.[JointID.HandLeft]
    let right = joints.[JointID.HandRight]
    printfn "Left: %A Right %A" left right
    drive 0 left.Position.Y
    drive 2 right.Position.Y)

System.Console.ReadLine() |> ignore

bot.Disconnect()

Given the LegoBot defined below of course. One issue is the latency and the “chattiness” of the protocol. I tried and couldn’t get the “Segway Bot” to work. Next, I’m thinking of doing a Forth to run directly on the brick and use the Lego brick’s message box protocol to communicate back to a PC only as needed.

Here’s the F# module. Have fun with it!

module LegoBot

open System
open System.IO
open System.IO.Ports
open System.Text

type SensorKind =
    | None          = 0x0
    | Switch        = 0x1
    | Temperature   = 0x2
    | Reflection    = 0x3
    | Angle         = 0x4
    | LightActive   = 0x5
    | LightInactive = 0x6
    | SoundDB       = 0x7
    | SoundDBA      = 0x8
    | Custom        = 0x9
    | LowSpeed      = 0xA
    | LowSpeed9V    = 0xB
    | Color         = 0xD

type SensorMode =
    | Raw             = 0x00
    | Boolean         = 0x20
    | TransitionCount = 0x40
    | PeriodCounter   = 0x60
    | PCTFullScale    = 0x80
    | Celsius         = 0xA0
    | Fahrenheit      = 0xC0
    | AngleSteps      = 0xE0
    | SlopeMask       = 0x1F

type InputValue = {
    IsValid      : bool
    IsCalibrated : bool
    Kind         : SensorKind
    Mode         : SensorMode
    Raw          : int
    Normalized   : int
    Scaled       : int
    Calibrated   : int }

[<Flags>]
type OutputMode =
    | None      = 0
    | MotorOn   = 1
    | Brake     = 2
    | Regulated = 4

type RegulationMode =
    | Idle       = 0
    | MotorSpeed = 1
    | MotorSync  = 2

[<Flags>]
type RunState =
    | Idle     = 0x00
    | RampUp   = 0x10
    | Running  = 0x20
    | RampDown = 0x40

type OutputState = {
    Power         : int
    Mode          : OutputMode
    Regulation    : RegulationMode
    Turn          : int
    Run           : RunState
    Limit         : uint32
    TachoCount    : int
    BlockCount    : int
    RotationCount : int }

type DeviceInfo = {
    Name      : string
    BTAddress : byte[]
    Signal    : int32
    Memory    : int32 }

type VersionInfo = {
    Protocol : float
    Firmware : float }

type LegoBot(port : string) =
    let reader, writer =
        let com = new SerialPort(port)
        com.Open()
        com.ReadTimeout <- 1500
        com.WriteTimeout <- 1500
        let stream = com.BaseStream
        new BinaryReader(stream), new BinaryWriter(stream)

    let send (message : byte[]) =
        int16 message.Length |> writer.Write
        writer.Write message
        writer.Flush()

    let expect (bytes : byte[]) =
        let actual = reader.ReadBytes bytes.Length
        if actual <> bytes then failwith "Invalid response"

    let file (name : string) =
        if name.Length > 19 then failwith "Name too long."
        let bytes = (Seq.map byte name |> List.ofSeq)
        bytes @ List.init (20 - bytes.Length) (fun _ -> 0uy)

    let bytesToString bytes =
        let len = Array.findIndex ((=) 0uy) bytes
        Encoding.ASCII.GetString(bytes, 0, len)

    let intToBytes i = [byte i; i >>> 8 |> byte; i >>> 16 |> byte; i >>> 24 |> byte]

    let shortToBytes (s : int16) = [byte s; s >>> 8 |> byte]

    member x.KeepAlive () = send [|0x80uy; 0x80uy; 0x0Duy|]

    member x.GetDeviceInfo () =
        send [|1uy; 0x9Buy|]
        expect [|33uy; 0uy; 2uy; 0x9Buy; 0uy|]
        { Name = Encoding.ASCII.GetString(reader.ReadBytes 15)
          BTAddress = reader.ReadBytes 7
          Signal = reader.ReadInt32()
          Memory = reader.ReadInt32() }

    member x.GetVersion () =
        send [|1uy; 0x88uy|]
        expect [|7uy; 0uy; 2uy; 0x88uy; 0uy|]
        let readMajorMinor () = Double.Parse(sprintf "%i.%i" (reader.ReadByte()) (reader.ReadByte()))
        { Protocol = readMajorMinor (); Firmware = readMajorMinor () }

    member x.GetBatteryLevel () =
        send [|0uy; 0xBuy|]
        expect [|5uy; 0uy; 2uy; 0xBuy; 0uy|]
        (reader.ReadInt16() |> float) / 1000.

    member x.SetBrickName (name : string) =
        let truncated = Seq.map byte name |> Seq.take (min name.Length 15) |> List.ofSeq
        [1uy; 0x98uy] @ truncated @ [byte truncated.Length] |> Array.ofList |> send
        expect [|3uy; 0uy; 2uy; 0x98uy; 0uy|]

    member x.PlayTone frequency (duration : TimeSpan) =
        writer.Write [|6uy; 0uy; 0x80uy; 3uy|]
        int16 frequency |> writer.Write
        int16 duration.TotalMilliseconds |> writer.Write
        writer.Flush()

    member x.SetInputMode port (kind : SensorKind) (mode : SensorMode) =
        send [|0x80uy; 5uy; byte port; byte kind; byte mode|]

    member x.GetInputValues port =
        send [|0uy; 7uy; byte port|]
        expect [|16uy; 0uy; 2uy; 7uy; 0uy|]
        reader.ReadByte() |> ignore
        { IsValid = (reader.ReadByte() = 1uy)
          IsCalibrated = (reader.ReadByte() = 1uy)
          Kind = reader.ReadByte() |> int |> enum
          Mode = reader.ReadByte() |> int |> enum
          Raw = reader.ReadInt16() |> int
          Normalized = reader.ReadInt16() |> int
          Scaled = reader.ReadInt16() |> int
          Calibrated = reader.ReadInt16() |> int }

    member x.ResetInputScaledValue port = send [|0x80uy; 8uy; byte port|]

    member x.SetOutputState port power (mode : OutputMode) (regulation : RegulationMode) turn (run : RunState) (limit : uint32) = // port 0xFF means 'all'
        writer.Write [|12uy; 0uy; 0uy; 4uy; byte port; byte power; byte mode; byte regulation; byte turn; byte run|]
        writer.Write limit
        writer.Flush()
        expect [|3uy; 0uy; 2uy; 4uy; 0uy|]

    member x.GetOutputState port =
        send [|0uy; 6uy; byte port|]
        expect [|25uy; 0uy; 2uy; 6uy; 0uy|]
        reader.ReadByte() |> ignore
        { Power = reader.ReadByte() |> int32
          Mode = reader.ReadByte() |> int32 |> enum
          Regulation = reader.ReadByte() |> int32 |> enum
          Turn = reader.ReadByte() |> int32
          Run = reader.ReadByte() |> int32 |> enum
          Limit = reader.ReadUInt32()
          TachoCount = reader.ReadInt32()
          BlockCount = reader.ReadInt32()
          RotationCount = reader.ReadInt32() }    

    member x.ResetMotorPosition port relative =
        send [|0x80uy; 0xAuy; byte port; (if relative then 1uy else 0uy)|]

    member x.MessageWrite box (message : string) =
        let truncated = Seq.map byte message |> Seq.take (min message.Length 59) |> List.ofSeq
        [0x0uy; 0x09uy; byte box] @ [byte truncated.Length + 1uy] @ truncated @ [0uy] |> Array.ofList |> send
        expect [|3uy; 0uy; 2uy; 0x09uy; 0uy|]

    member x.StartProgram name =
        [0uy; 0uy] @ file name |> Array.ofList |> send
        expect [|3uy; 0uy; 2uy; 0uy; 0uy|]

    member x.StopProgram () =
        send [|0uy; 1uy|]
        expect [|3uy; 0uy; 2uy; 1uy; 0uy|]

    member x.Disconnect () =
        List.iter (fun p -> x.SetInputMode p SensorKind.None SensorMode.Raw) [0..3]
        List.iter (fun p -> x.SetOutputState p 0 OutputMode.MotorOn RegulationMode.Idle 0 RunState.Idle 0ul) [0..2]
        reader.Close()
        writer.Close()

Programming a 2000 Year Old Sandstone Computer

Ashley Nathan Feniello — Mon, 19 Sep 2011 05:27:00 GMT

[The eleventh in a series of posts on the evolution of TransForth]

If you think coding with punch cards is old school, you should try using sandstone tablets! Legend has it that members of the Cult of the Bound Variable designed and may have even constructed a city-sized machine powered by falling sand more than two millennia ago; dwarfing our ENIAC of the last century and beating us to an understanding of computation by thousands of years.

What the heck am I talking about?! Learn more here. Really, go check it out right now! But try not to get so sucked into unlocking the Cult’s mysteries that you spend days without sleep and forget to come back here.

So far the TransForth project has taken a top-down approach; starting with high-level F# and stripping it away until we have a VM and a meta-circular interpreter. Now I want to completely switch gears and build things bottom-up, starting with raw machine code. No kidding. We’re going to build our own assembler, use it to write a Forth inner interpreter, manually pack a dictionary to bootstrap an outer interpreter, and finally again reach the nirvana of meta-circularity. Should be fun!

Bring Your Own VM

The Universal Machine is an extremely simple 32-bit RISC architecture, yet powerful enough to run a UNIX-like operating system. Emulating it on modern hardware (still made of sand by the way) is pretty straightforward. Luke Hoban has posted a very nice 40-line implementation in F# and has a VM running in Silverlight. It’s also been done in tons of other languages. The package from CMU includes a SML compiler (um\humlock) and an assembler (um\whistleock) for it and VMs in Awk, C, C#, Haskell, Java, OCaml, Perl, PostScript, Python, Scheme, SML, Tweif, x86 assembly and in UM machine code itself. I’ve also seen it in JavaScript and Ruby.

I’ve been using Luke’s F# version for my exploration. I won’t repost his code here. You can go grab it from his blog. I did have to make a one-line fix to bring it up to date with current F#:

<! let mem = ResizeArray.create 1 p0AsUInts

!> let mem = new ResizeArray<uint32[]>([|p0AsUInts|])

Bring Your Own Assembler

Running the codex and uncovering all the astoundingly wonderful mysteries within is worth a weekend of your life I assure you, but perhaps more fun will be to write our own codex! The eventual goal is a codex image that, when loaded, is a full Forth.

What we’re going to do is build an assembler for ourselves in TransForth, but targeting the new machine. We’ll assemble in memory and spit out to a file from which the Universal Machine can boot. First, let’s add a couple of utility words to TransForth. We’re going to need left/right bit shifts and also add a word to dump a range of memory to a file with the correct endianness for the UM:

let um () =

use file = File.Open("transforth.um", FileMode.Create)

for i in pop () .. pop () do

let m = mem.[i]

m >>> 24 |> byte |> file.WriteByte

m >>> 16 |> byte |> file.WriteByte

m >>> 8 |> byte |> file.WriteByte

m |> byte |> file.WriteByte

and execute () =

match instruction with

…

| 35 -> dyadic (<<<)

| 36 -> dyadic (>>>)

| 37 -> um ()

primitive "LSH" LSH

primitive "RSH" RSH

primitive "UM" UM

That’s all the F# we’re going to need. Let’s start putting together our little assembler. What we’ll be doing is appending UM machine code in memory and then dumping it out.

\ UM-32 Assembler

: ORIGIN 32768 ;

VARIABLE target

ORIGIN target !

: m, target @ ! target ++! ;

: msave target @ 1- ORIGIN UM ;

So we can use m, to append as we go and msave to spit out the final transforth.um file.

Understanding the UM-32

Between Luke’s F# code and the (purposely somewhat obfuscated) spec, you may have already pieced together how the machine works for yourself.

It’s a 32-bit RISC machine with only 14 instructions, 8 registers, dynamically allocated memory and single byte I/O. Upon booting, it loads memory block 0 from a “codex” file and begins executing at address 0.

Instructions may refer to up to three registers (e.g. the addition instruction, a = b + c). You can see in the spec how they’re packed into 32-bit “sandstone platters”.

For example, 00110000000000000000000001010011 adds (0011) registers 3 (011) and 2 (010), placing the sum in register 1 (001). We can build these by shifting and ORing a set of register numbers (a, b, and c) and an instruction:

: instruction, ( cbai-m ) 22 LSH OR 3 LSH OR 3 LSH OR m, ;

I’m going to start using lowercase names for UM-related words and the trailing comma in the name signifies words that emit instructions to the target area.

The first thirteen instructions follow this format. We can make mnemonic words for these:

: cmove, ( abc-m ) 0 instruction, ; \ c = b if a

: fetch, ( abc-m ) 1 instruction, ; \ c = b[a]

: store, ( abc-m ) 2 instruction, ; \ c[b] = a

: add, ( abc-m ) 3 instruction, ; \ c = b + a

: mult, ( abc-m ) 4 instruction, ; \ c = b * a

: div, ( abc-m ) 5 instruction, ; \ c = b / a

: nand, ( abc-m ) 6 instruction, ; \ c = b ~& a

: halt, ( -m ) 0 0 0 7 instruction, ;

: alloc, ( ab-m ) 0 8 instruction, ; \ new(b) -> a

: free, ( a-m ) 0 0 9 instruction, ;

: echo, ( a-m ) 0 0 10 instruction, ;

: key, ( a-m ) 0 0 11 instruction, ;

: loadjump, ( ab-m ) 0 12 instruction, ; \ load(b), jump(a)

The only operations that index through registers are load and store. All others operate on registers only. Notice however that not all of the instructions make use of all the registers. For unused registers we can embed 0s.

The 14^th instruction is for loading literal values; packing a 25-bit value with a register number. For example, 00110010000000000000000000101010 places 42 (101010) into register 1 (001). We can construct like so:

: literal, ( va -- m ) 13 3 LSH OR 25 LSH OR m, ;

An interesting aspect of the UM is the dynamic memory system with alloc, and free,. These dynamically manipulate the “array of platters.” The loadjump, instruction seems to be meant for loading programs from one array into the zero array and jumping to a particular instruction within. In fact, this instruction is used extremely frequently in the codex to do regular jumps within the zero array. The VM doesn’t clone anything when copying from zero to zero; only updates the “finger.” As the spec says, the zero “shall be the most sublime choice for loading, and shall be handled with the utmost velocity.” We can make a macro for direct jumps within the zero array:

: jump, ( a-m ) 0 loadjump, ; \ jump(a)

Hello World!

Just to make sure everything is functioning, let’s assemble our first UM-32 program. To print “Hello World!” to the console, we’ll have to load a literal, for each character into a register and echo, it. For example, we can print “Hi” by loading and echoing the literal ASCII values (using registers 0 and 1):

72 0 literal, \ 'H'

105 1 literal, \ 'i'

0 echo,

1 echo,

halt,

Hosting our assembler in Forth means that we can use its full power at assembly-time to simplify our lives. How about a helper for dealing with ASCII:

: chr WORD HERE 1+ @ ; IMMEDIATE

This works by parsing the next word and taking the first character (presumably a single character word).

Another advantage of hosting the assembler in Forth is that we can use it as a sort of “macro assembler”; creating words that simplify the generation of common instruction sequences. For example, loading and echoing a literal.

: output, ( a-m ) 0 literal, 0 echo, ;

Now we can simply push a value (perhaps an ASCII character with chr) and echo it with a single word:

chr H output,

chr i output,

halt,

Or we can further factor to:

: cout, ( '-m ) chr output, ;

And:

\ Hello World!

cout, H

cout, e

cout, l

cout, o

SP output,

cout, W

cout, o

cout, r

cout, l

cout, d

cout, !

halt,

msave

Go ahead and run this in TransForth and you end up with a boot image file for the Universal Machine that prints “Hello World!”. Nice, we have the beginnings of a working assembler!

Missing Instructions

The Universal Machine seems to take RISC to a pretty ridiculous extreme. There is no conditional jump, no subtraction, etc. I’m encouraged by the fact that UMIX runs on this thing. Certainly these limitations can be overcome.

Let’s add macros for a few instructions that would be expected. To start with, I think it will be helpful to assign purposes to a few registers. Having zero constant value always handy will simplify things (other constants such as 1 and –1 would be nice too, but I’m afraid we’ll run out of registers when we try to build the inner interpreter later). Let’s just use the 0 register and since all registers are initialized to zero we don’t need to do anything other than to remember not to touch register 0. We’ll define a convent name for it:

: z 0 ; \ Zero constant register
: t 2 ; \ Temp register

There is a conditional move, between registers but no unconditional move. We can build this by embedding our new constant:

: move, ( ab-m ) 1 t literal, t -ROT cmove, ; \ b = a

There’s also no increment instruction. We can build this again by embedding our new constant in an add,.

: inc, ( a-m ) DUP 1 t literal, t SWAP add, ; \ a++

Other notable things missing include bit shifting and bitwise operations other than nand. Everything can be defined in terms of nand just as we did some time ago, but I’d rather do this in Forth-world later. For now, we’ll just need a not, instruction:

: not, ( ab-m ) SWAP DUP ROT nand, ; \ b = ~a

Subtraction doesn’t exist either. In fact, the UM-32 works only with unsigned numbers. After brushing up on our understanding of 2s compliment though we realize that we can represent negative numbers in this unsigned world by flipping the bits and incrementing. We can then define subtraction in terms of addition (with carry overflow) of negatives:

: neg, ( ab-m ) DUP -ROT not, inc, ; \ b = -a

: sub, ( abc-m ) 2 PICK DUP neg, -ROT add, ; \ c = b - a

Decrement can be defined in terms of sub, of course. It will be helpful here and elsewhere to have one of the registers set aside as a temporary:

: t 2 ; \ Temp register

: dec, ( a-m ) 1 t literal, t SWAP DUP sub, ; \ a--

Notice that this expands to four instructions at assembly-time. For example, x dec, expands to:

1 t literal, \ t = 1

t t t nand,

1 t t add, \ t = -1

t x x add, \ x += -1

If we wanted to use up another register to maintain a constant -1 value then we could reduce dec, to a single instruction. I wanted to do this but I believe we’ll later run out of registers when we start building the Forth inner interpreter. Still, if you’d like (assuming say, n contains -1):

: dec, ( a-m ) DUP n SWAP add, ; \ a--

This way the same x dec, for example expands to simply n x x add,.

Thinking more about this, we may realize that there’s no need to treat decrementing as generally as subtracting 1. Rather than four instructions, it can be done in three! This is the kind of micro-optimizations that we can have fun with when working close to the hardware (well, the VM). Negative 1 is just all bits on in two’s compliment which we can produce in two instructions, then add that:

0 t literal, \ t = 0

t t t nand, \ t = -1

t x x add, \ x += -1

Branching

The jump, macro jumps to an address in a given register. If the address is known at assembly-time then it needs to be loaded into a register first. Let’s make a simple macro that jumps to an address from the assembly-time stack:

: branch, ( a-m ) t literal, t jump, ; \ jump to a

We still need a conditional branch with which to build control flow primitives. Having only conditional move at our disposal, we can do this by essentially unconditionally branching, but either to a given address or just to the next address:

: 0branch, ( ab-m ) t literal, address 1+ t cmove, t jump, ; \ if a = 0, jump to b

That reminds me! We don’t have a no-op instruction. We can build this effectively as “branch never”. An old assembler I used to use for the 6809E actually did have a BNE instruction as a silly no-op. We could do it as a 0 0 0 add, or something else but whatever:

: noop, ( -m ) address 1+ t literal, t jump, ; \ skip

Unconditional branch, and conditional 0branch, can be used to create all types of control flow as we built back when we did IF, ELSE and THEN and later when we built BEGIN/UNTIL, WHILE/REPEAT, LEAVE, DO/LOOP.

Labels

So far our assembler give us mnemonics for the UM instruction set, it gives us extremely powerful macros in the form of full Forth at assembly-time, and we’ve built enough up to really get started coding for this machine. The one thing missing that assemblers provide is labeling. All of our branching is to addresses on the assembly-time stack but how do they get there?

We can calculate the current address relative to the origin of the image very easily:

: address target @ ORIGIN - ;

Given this, we can mark positions in the code by pushing the current address to the stack just before emitting the next instruction. We can then proceed with the code; leaving the address for much later use by a branch, or 0branch,. For example infinite looping words could easily be defined:

: loop address ;

: again, branch, ;

If you’d rather, you can store the address in a variable: VARIABLE my-label address my-label !

This all works great for branches back to previous addresses. But what about branches that make forward references to future addresses? We can handle this similar to a single-pass assembler by tracking the forward branch points and later patching the address once it’s known:

: forward target @ 0 ; \ leave target address on stack for later patching

: tohere DUP @ address OR SWAP ! ; \ patch previous forward branch,

Remember that the branch, and 0branch, macros begin with a t literal, representing the address. The phrase forward branch, for example will push the current target address to the stack (notice, not the UM address relative to the image origin, but the actual location of the literal, instruction being assembled) and then will emit a branch (temporarily to zero). The zero is later patched to the real address with tohere which goes back and ORs in the current address at this point.

That’s it; single-pass label resolution for both forward and backward references.

Summary

In 15 lines of F# and 40 lines of Forth we’ve built a pretty much complete single-pass macro assembler for the UM-32. It is very Forth-like; using the stack for anonymous labels (or named variables if you like) and using the full facilities of Forth for assembly-time macros.

Have fun with it!

More to come...

We’ll be using it to build a Forth inner interpreter so that we can move away from this low-level assembly. However, we will always have the ability to define new primitive Forth words in terms of raw assembly. This ability is one of the things that give Forth amazing breadth; abstracting far from the machine while never losing the option of dipping back down to bare metal.

Next >