The “assembler” makes use of string shorthand to read the binary values for the test and application functions. The main function that takes care of this is “ins” or “INStruction” opcode (in fact, it’s the only opcode). It has two parameters, the test pattern and the application pattern. “Assembly” consists of turning instances of this opcode and its parameters into curried function calls. The program itself is composed of a series of these calls stored in a list. The list order is also the application order for the successful test.
The runtime portion of the computer consists of two functions: a single step and a run. The single step uses List.fold to test and apply all the functions. Run runs a program until a halt condition is met. Halt conditions are: 1) depletion of a “safety” counter, 2) a set “halt bit” (the high bit is reserved for this use), or 3) an output value equal to the input value (it will cycle there forever). Note that the exact sequence of operations as implemented differs from the steps listed in the previous post, but the result is functionally equivalent.
The test code demonstrates a program that, beginning at zero, single steps to fifteen.
As always, presented “as-is” and without warranty or implied fitness; use at your own risk. (This technique does not, to my knowledge, infringe on any patents, however, the reader is responsible for making sure that such non-infringement is indeed the case for their particular uses.)
In the next post, I’ll demonstrate a simple addition algorithm.
The library:
module BC32
// Some constants, for syntax.
let internal highReset = System.Int32.MaxValue
let internal highSet = System.Int32.MinValue
let internal allReset = 0
let internal allSet = -1
// Aligns a power of two to the next block.
let rec internal nextBlock (n:int)
(b:int)
(f:int) =
match (n<=b) with
| true -> b
| _ -> nextBlock n (b*f) f
// Align to the next nibble.
let rec internal nextNibble (n:int) =
nextBlock n 16 16
// Reads a string into binary number.
// Character translation is as follows:
// : = Increment counter to next nibble.
// (Default fill is zero.)
// 0 = Sets bit to zero.
// 1 = Sets bit to one.
// = Anything else, skip. This can be used for
// user-defined separators, etc.
let rec internal readBinary0 (s:string)
(i:int)
(p:int)
(n:int) =
match i>=0 with
| false -> n
| true ->
match s.[i] with
| ':' -> readBinary0 s (i-1) (nextNibble p) n
| '0' -> readBinary0 s (i-1) (p*2) n
| '1' -> readBinary0 s (i-1) (p*2) (n|||p)
| _ -> readBinary0 s (i-1) p n
// Syntactic helper for readBinary0.
let readBinary (s:string) =
readBinary0 s (s.Length-1) 1 allReset
// Reads a string into an AXTest parameter pair.
// Character translation is as follows:
// : = Increment counter to next nibble.
// (Default fill is equivalent to '-'.)
// 0 = On test, will match a zero.
// (Stores a one na and a zero nx.)
// 1 = On test, will match a one.
// (Stores a one in both na and nx.)
// - = On test, matches anything.
// (Stores a zero in both na and nx.)
// = Anything else, skip. This can be used for
// user-defined separators, etc.
let rec internal readAXTest0 (s:string)
(i:int)
(p:int)
(na:int)
(nx:int) =
match i>=0 with
| false -> (na,nx)
| true ->
match s.[i] with
| ':' -> readAXTest0 s (i-1) (nextNibble p) na nx
| '0' -> readAXTest0 s (i-1) (p*2) (na|||p) nx
| '1' -> readAXTest0 s (i-1) (p*2) (na|||p) (nx|||p)
| '-' -> readAXTest0 s (i-1) (p*2) na nx
| _ -> readAXTest0 s (i-1) p na nx
// Syntactic helper for readAXTest0.
let internal readAXTest (s:string) =
readAXTest0 s (s.Length-1) 1 allReset allReset
// Reads a string into an AXFunc parameter pair.
// Character translation is as follows:
// : = Increment counter to next nibble.
// (Default fill is equivalent to '-'.)
// 0 = On application, function will store a zero.
// (Stores a zero in both na and nx.)
// 1 = On application, function will store a one.
// (Stores a zero in na, and a one in nx.)
// - = On application, function will leave bit unchanged.
// (Stores a one in na, and a zero in nx.)
// = Anything else, skip. This can be used for
// user-defined separators, etc.
let rec internal readAXFunc0 (s:string)
(i:int)
(p:int)
(na:int)
(nx:int) =
match i>=0 with
| false -> (na,nx)
| true ->
match s.[i] with
| ':' -> readAXFunc0 s (i-1) (nextNibble p) na nx
| '0' -> readAXFunc0 s (i-1) (p*2) (na&&&(~~~p)) nx
| '1' -> readAXFunc0 s (i-1) (p*2) (na&&&(~~~p)) (nx|||p)
| '-' -> readAXFunc0 s (i-1) (p*2) na nx
| _ -> readAXFunc0 s (i-1) p na nx
// Syntactic helper for readAXFunc0.
let internal readAXFunc (s:string) =
readAXFunc0 s (s.Length-1) 1 allSet allReset
// A "assembled" program instruction.
let internal fIns ((ta,tx):int*int)
((fa,fx):int*int)
(nT:int)
(nF:int) =
match ((nT&&&ta)^^^tx)=0 with
| true -> (nF&&&fa)^^^fx
| false -> nF
// An external program instruction.
// Returns the "assembled" function.
let ins (sT:string)
(sF:string) =
fIns
(readAXTest sT)
(readAXFunc sF)
// As an action parameter, will set the halt bit.
let halt = "1-------.--------.--------.--------"
// As a test parameter, will match anything.
let any = "--------.--------.--------.--------"
// Single-step a program.
let step (l:(int->int->int) list)
(nT:int)
(nF:int) =
List.fold (fun s t -> t nT s) nF l
// Run a program count steps or until
// a halt or trap state is encountered.
let rec run (l:(int->int->int) list)
(nF:int)
(count:int) =
// Halt when: 1) count is exhausted.
match count<=0 with
| true -> (count,nF)
| _ ->
// Halt when: 2) halt bit is set.
match (nF&&&highSet)<>0 with
| true -> (count,(nF&&&highReset))
| _ ->
let nF0 = (step l nF nF)
// Halt when: 3) state is trapped.
match nF0=nF with
| true -> (count,nF)
// Otherwise, keep running.
| _ -> run l nF0 (count-1)
The test:
open System
open BC32
let rec testProg0 p i n (f:int list->int list) =
match i>1 with
| false -> f [n]
| _ -> testProg0 p (i-1) (step p n n) (fun n0->f (n::n0))
let testProg l i =
testProg0 l i 0 (fun n0->n0)
let pCountTo15 =
[
(ins "---0" "---1" )
(ins "---1" "---0" )
(ins "--01" "--1-" )
(ins "--11" "--0-" )
(ins "-011" "-1--" )
(ins "-111" "-0--" )
(ins "0111" "1---" )
(ins "1111" "0---" )
]
let result = testProg pCountTo15 18
printfn "Press any key to continue..."
Console.ReadLine() |> ignore
-Neil
No comments:
Post a Comment