"
Universal Register Machine
By Paul Chapman
paul@igblan.com

For more information visit www.igblan.com/ca
"

"
The macro parameter-order convention is as follows:

	(1) Macros
	(2) Operands
	(3) Results
	(5) Temporaries
	(4) Constants
	(6) Labels
"
"========================================================================
Declare - forces the compiler to assign the next numbered register."

Declare (r) :
[
	goto lx.#
	inc r
lx.#:
]

"========================================================================
Clear r.

	Before	After
r	R	0"

Clear (r) :
[
	dec r and repeat else return
]

"========================================================================
Test r.

	Before	After
r	R	R"

IsZero (r) :
[
	dec r else return true
	inc r and return false
]

"========================================================================
Move/Add r to s.

	Move			Add
	Before	After		Before	After
r	R	0		R	0
s	0	R		S	S + R"

Move (r s) :
[
	dec r else return
	inc s and repeat
]

Add (r s) : [ Move (r s) ]

"========================================================================
Move/Add r to s and t.

	Move			Add
	Before	After		Before	After
r	R	0		R	0
s	0	R		S	S + R
t	0	R		T	T + R"

Move (r s t) :
[
	dec r else return
	inc s
	inc t and repeat
]

Add (r s t) : [ Move (r s t) ]

"========================================================================
Copy/Add r to s nondestructively.

	Copy			AddCopy
	Before	After		Before	After
r	R	R		R	R
s	0	R		S	S + R
a	0	0		0	0"

Copy (r s a) :
[
	Move (r s a)
	Move (a r)
]

"========================================================================
If r >= s then subtract and return true, else return false.

	Before	if r >= s
r	R	R - S
s	S	0
t	0	S"

Subtract (r s t) :
[
	dec s else return true
	dec r else goto lp.#
	inc t and repeat

 lp.#:	inc s
	dec t else return false
	inc r and goto lp.#
]

"========================================================================
Multiply r and s.

	Usual			Precise
	Before	After		Before	After
r	R	0		R	0
s	S	S		S	S + (if R > 0 then A else 0)
t	0	R * S		T	T + (if R > 0 then R * (S + A) - A else 0)
a	0	0		A	if R > 0 then 0 else A"

Multiply (r s t a) :
[
	dec r else return
	Add (s a t)
	Move (a s) and repeat
]

MultiplyInPlace (r s a b) :
[
	Move (r a)
	Multiply (a s r b)
]

"========================================================================
Divide r by s to give quotient and remainder.

	Usual
	Before	After
r	R	R \\ S	remainder
s	S	S
t	0	R // S	quotient
a	0	0"

Divide (r s t a) :
[
	Subtract (r s a) else return
	Move (a s)
	inc t and repeat
]

"========================================================================
Restore registers after Divide (r s t a)."

UndoDivide (r s t a) : [ Multiply (t s r a) ]

"========================================================================
If s divides r then set t to the quotient and return true, else return false.

	Before	if s divides r
r	R	0
s	S	S
t	0	R / S	quotient
a	0	0"

DivideExact (r s t a) :
[
	Divide (r s t a)
	if IsZero (r) return true
	UndoDivide (r s t a) and return false
]

DivideExactInPlace (r s a b) :
[
	DivideExact (r s a b) else return false
	Move (a r) and return true
]

"========================================================================
Extract power of prime s from r.

	Before	After
n	N	N / PRIME^POWER
prime	PRIME	PRIME
power	0	POWER
a	0	0
b	0	0"

ExtractPrimePower (n prime power a b) :
[
	DivideExact (n prime a b) else return
	Move (a n)
	inc power and repeat
]

"========================================================================
UNIVERSAL REGISTER MACHINE."

UniversalRegisterMachine (
	opcodes operands passaddresses failaddresses
	registers base
	opcode exp godel ret
	a b) :
[
	"base is prime number base for instruction"

		"Get operation"

	Copy (opcodes godel a)

 ExtractPrimePowerEntry0:	inc ret
 ExtractPrimePowerEntry1:	inc ret
 ExtractPrimePowerEntry2:

	ExtractPrimePower (godel base exp a b)
	Clear (godel)

	dec ret else goto ExtractPrimePowerReturn2
	dec ret else goto ExtractPrimePowerReturn1

	Move (exp opcode)

		"Check for halt"

	dec opcode else goto haltInstruction

		"Get operand register base"

	Copy (operands godel a)

	goto ExtractPrimePowerEntry1
 ExtractPrimePowerReturn1:

	inc exp
	inc exp

		"Check for increment"

	dec opcode else goto incInstruction

		"Dec instruction"

	if DivideExactInPlace (registers exp a b) goto instructionPassed

		"Instruction failed"

	Copy (failaddresses godel a)
	goto branch

 incInstruction:

		"Inc instruction"

	MultiplyInPlace (registers exp a b)

 instructionPassed:

		"Instruction passed"

	Copy (passaddresses godel a)

 branch:

		"Branch to next instruction"

	Clear (exp)

	goto ExtractPrimePowerEntry2
 ExtractPrimePowerReturn2:

	inc exp
	inc exp
	Clear (base)
	Move (exp base)

	repeat

 haltInstruction:

		"Halt instruction"

	halt
]

"========================================================================
Main program."

Main ( ) :
[
	Declare (registers)
	Declare (opcodes)
	Declare (operands)
	Declare (passaddresses)
	Declare (failaddresses)
	Declare (base)
	Declare (opcode)
	Declare (godel)
	Declare (exp)
	Declare (ret)
	Declare (a)
	Declare (b)

	UniversalRegisterMachine (
		opcodes operands passaddresses failaddresses
		registers base
		opcode exp godel ret
		a b)
]