blob: 75bbbd1d340bbb6cacbf39f57eeea86ea40b4856 (
plain) (
tree)
|
|
(load "mu.arc")
(reset)
(add-fns
'((test1
((1 integer) <- copy (23 literal)))))
(run 'test1)
;? (prn memory*)
(if (~is memory*.1 23)
(prn "F - 'copy' writes its lone 'arg' after the instruction name to its lone 'oarg' or output arg before the arrow. After this test, the value 23 is stored in memory address 1."))
;? (quit)
(reset)
(add-fns
'((test1
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
((3 integer) <- add (1 integer) (2 integer)))))
(run 'test1)
(if (~iso memory* (obj 1 1 2 3 3 4))
(prn "F - 'add' operates on two addresses"))
(reset)
(add-fns
'((test1
((3 integer) <- add (1 integer) (2 integer)))
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4))
(prn "F - calling a user-defined function runs its instructions"))
;? (quit)
(reset)
(add-fns
'((test1
((1 integer) <- copy (1 literal)))
(main
(test1))))
(if (~is 2 (run 'main))
(prn "F - calling a user-defined function runs its instructions exactly once"))
;? (quit)
(reset)
(add-fns
'((test1
((3 integer) <- add (1 integer) (2 integer))
(reply)
((4 integer) <- copy (34 literal)))
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4))
(prn "F - 'reply' stops executing the current function"))
;? (quit)
(reset)
(add-fns
`((test1
((3 integer) <- test2))
(test2
(reply (2 integer)))
(main
((2 integer) <- copy (34 literal))
(test1))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 2 34 3 34))
(prn "F - 'reply' stops executing any callers as necessary"))
;? (quit)
(reset)
(add-fns
'((test1
((3 integer) <- add (1 integer) (2 integer))
(reply)
((4 integer) <- copy (34 literal)))
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1))))
(if (~is 4 (run 'main)) ; last reply sometimes not counted. worth fixing?
(prn "F - 'reply' executes instructions exactly once"))
;? (quit)
(reset)
(add-fns
'((test1
((4 integer) <- arg)
((5 integer) <- arg)
((3 integer) <- add (4 integer) (5 integer))
(reply)
((4 integer) <- copy (34 literal)))
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1 (1 integer) (2 integer))
)))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
4 1 5 3))
(prn "F - 'arg' accesses in order the operands of the most recent function call (the caller)"))
;? (quit)
(reset)
(add-fns
'((test1
((5 integer) <- arg 1)
((4 integer) <- arg 0)
((3 integer) <- add (4 integer) (5 integer))
(reply)
((4 integer) <- copy (34 literal))) ; should never run
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1 (1 integer) (2 integer))
)))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
4 1 5 3))
(prn "F - 'arg' with index can access function call arguments out of order"))
;? (quit)
; todo: test that too few args throws an error
; how should errors be handled? will be unclear until we support concurrency and routine trees.
(reset)
(add-fns
'((test1
((4 integer) <- arg)
((5 integer) <- arg)
((6 integer) <- add (4 integer) (5 integer))
(reply (6 integer))
((4 integer) <- copy (34 literal)))
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
((3 integer) <- test1 (1 integer) (2 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
4 1 5 3 6 4))
(prn "F - 'reply' can take aguments that are returned, or written back into output args of caller"))
(reset)
(add-fns
'((test1
((4 integer) <- arg)
((5 integer) <- arg)
((6 integer) <- add (4 integer) (5 integer))
(reply (6 integer) (5 integer))
((4 integer) <- copy (34 literal)))
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
((3 integer) (7 integer) <- test1 (1 integer) (2 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4 7 3
; add-fn's temporaries
4 1 5 3 6 4))
(prn "F - 'reply' permits a function to return multiple values at once"))
(reset)
(add-fns
'((test1
((1 integer) <- add (2 literal) (3 literal)))))
(run 'test1)
(if (~is memory*.1 5)
(prn "F - ops can take 'literal' operands (but not return them)"))
(reset)
(add-fns
'((main
((1 integer) <- sub (1 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 -2)
(prn "F - 'sub' subtracts the value at one address from the value at another"))
(reset)
(add-fns
'((main
((1 integer) <- mul (2 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 6)
(prn "F - 'mul' multiplies like 'add' adds"))
(reset)
(add-fns
'((main
((1 integer) <- div (8 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 (/ real.8 3))
(prn "F - 'div' divides like 'add' adds"))
(reset)
(add-fns
'((main
((1 integer) (2 integer) <- idiv (8 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 2))
(prn "F - 'idiv' performs integer division, returning quotient and remainder"))
(reset)
(add-fns
'((main
((1 boolean) <- and (t literal) (nil literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 nil)
(prn "F - logical 'and' for booleans"))
(reset)
(add-fns
'((main
((1 boolean) <- lt (4 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 nil)
(prn "F - 'lt' is the less-than inequality operator"))
(reset)
(add-fns
'((main
((1 boolean) <- le (4 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 nil)
(prn "F - 'le' is the <= inequality operator"))
(reset)
(add-fns
'((main
((1 boolean) <- le (4 literal) (4 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 t)
(prn "F - 'le' returns true for equal operands"))
(reset)
(add-fns
'((main
((1 boolean) <- le (4 literal) (5 literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 t)
(prn "F - le is the <= inequality operator - 2"))
(reset)
(add-fns
'((main
((1 integer) <- copy (8 literal))
(jmp (1 offset))
((2 integer) <- copy (3 literal)) ; should be skipped
(reply))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8))
(prn "F - 'jmp' skips some instructions"))
(reset)
(add-fns
'((main
((1 integer) <- copy (8 literal))
(jmp (1 offset))
((2 integer) <- copy (3 literal)) ; should be skipped
(reply)
((3 integer) <- copy (34 literal))))) ; never reached
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8))
(prn "F - 'jmp' doesn't skip too many instructions"))
;? (quit)
(reset)
(add-fns
'((main
((2 integer) <- copy (1 literal))
((1 boolean) <- eq (1 literal) (2 integer))
(jif (1 boolean) (1 offset))
((2 integer) <- copy (3 literal))
(reply)
((3 integer) <- copy (34 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 t 2 1))
(prn "F - 'jif' is a conditional 'jmp'"))
(reset)
(add-fns
'((main
((1 boolean) <- eq (1 literal) (2 literal))
(jif (3 boolean) (1 offset))
((2 integer) <- copy (3 literal))
(reply)
((3 integer) <- copy (34 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 nil 2 3))
(prn "F - if 'jif's first arg is false, it doesn't skip any instructions"))
(reset)
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (1 literal))
; loop
((2 integer) <- add (2 integer) (2 integer))
((3 boolean) <- eq (1 integer) (2 integer))
(jif (3 boolean) (-3 offset)) ; to loop
((4 integer) <- copy (3 literal))
(reply)
((3 integer) <- copy (34 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 4 3 nil 4 3))
(prn "F - 'jif' can take a negative offset to make backward jumps"))
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (1 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 34))
(prn "F - 'copy' performs direct addressing"))
(reset)
(add-fns
'((main
((1 integer-address) <- copy (2 literal))
((2 integer) <- copy (34 literal))
((3 integer) <- copy (1 integer-address deref)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 34 3 34))
(prn "F - 'copy' performs indirect addressing"))
(reset)
(add-fns
'((main
((1 integer-address) <- copy (2 literal))
((2 integer) <- copy (34 literal))
((1 integer-address deref) <- add (2 integer) (2 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 36))
(prn "F - instructions can perform indirect addressing on output arg"))
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 boolean) <- copy (nil literal))
((3 boolean) <- get (1 integer-boolean-pair) (1 offset))
((4 integer) <- get (1 integer-boolean-pair) (0 offset)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 nil 4 34))
(prn "F - 'get' accesses fields of records"))
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 boolean) <- copy (nil literal))
((3 integer-boolean-pair-address) <- copy (1 literal))
((4 boolean) <- get (3 integer-boolean-pair-address deref) (1 offset))
((5 integer) <- get (3 integer-boolean-pair-address deref) (0 offset)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 1 4 nil 5 34))
(prn "F - 'get' accesses fields of record address"))
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (35 literal))
((3 integer) <- copy (36 literal))
((4 integer-integer-pair) <- get (1 integer-point-pair) (1 offset)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 35 3 36 4 35 5 36))
(prn "F - 'get' accesses fields spanning multiple locations"))
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (t literal))
((3 boolean-address) <- get-address (1 integer-boolean-pair) (1 offset)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 t 3 2))
(prn "F - 'get-address' returns address of fields of records"))
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (t literal))
((3 integer-boolean-pair-address) <- copy (1 literal))
((4 boolean-address) <- get-address (3 integer-boolean-pair-address deref) (1 offset)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 t 3 1 4 2))
(prn "F - 'get-address' accesses fields of record address"))
(reset)
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (23 literal))
((3 boolean) <- copy (nil literal))
((4 integer) <- copy (24 literal))
((5 boolean) <- copy (t literal))
((6 integer-boolean-pair) <- index (1 integer-boolean-pair-array) (1 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 24 7 t))
(prn "F - 'index' accesses indices of arrays"))
(reset)
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (23 literal))
((3 boolean) <- copy (nil literal))
((4 integer) <- copy (24 literal))
((5 boolean) <- copy (t literal))
((6 integer) <- copy (1 literal))
((7 integer-boolean-pair) <- index (1 integer-boolean-pair-array) (6 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 24 8 t))
(prn "F - 'index' accesses indices of arrays"))
(reset)
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (23 literal))
((3 boolean) <- copy (nil literal))
((4 integer) <- copy (24 literal))
((5 boolean) <- copy (t literal))
((6 integer) <- copy (1 literal))
((7 integer-boolean-pair-address) <- index-address (1 integer-boolean-pair-array) (6 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 4))
(prn "F - 'index-address' returns addresses of indices of arrays"))
(reset)
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (23 literal))
((3 boolean) <- copy (nil literal))
((4 integer) <- copy (24 literal))
((5 boolean) <- copy (t literal))
((6 integer) <- len (1 integer-boolean-pair-array)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 2))
(prn "F - 'len' accesses length of array"))
(reset)
(add-fns
'((main
((1 integer) <- sizeof (integer-boolean-pair type)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 2)
(prn "F - 'sizeof' returns space required by arg"))
(reset)
(add-fns
'((main
((1 integer) <- sizeof (integer-point-pair type)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 3)
(prn "F - 'sizeof' is different from number of elems"))
; todo: test that out-of-bounds access throws an error
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 boolean) <- copy (nil literal))
((4 boolean) <- copy (t literal))
((3 integer-boolean-pair) <- copy (1 integer-boolean-pair)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 34 4 nil))
(prn "F - ops can operate on records spanning multiple locations"))
(reset)
(add-fns
'((test1
((4 type) <- otype 0)
((5 boolean) <- neq (4 type) (integer literal))
(jif (5 boolean) (3 offset))
((6 integer) <- arg)
((7 integer) <- arg)
((8 integer) <- add (6 integer) (7 integer))
(reply (8 integer)))
(main
((1 integer) <- test1 (1 literal) (3 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4
; add-fn's temporaries
4 'integer 5 nil 6 1 7 3 8 4))
(prn "F - an example function that checks that its oarg is an integer"))
;? (quit)
; todo - test that reply increments pc for caller frame after popping current frame
(reset)
(add-fns
'((test-fn
((4 type) <- otype 0)
; integer needed? add args
((5 boolean) <- neq (4 type) (integer literal))
(jif (5 boolean) (4 offset))
((6 integer) <- arg)
((7 integer) <- arg)
((8 integer) <- add (6 integer) (7 integer))
(reply (8 integer))
; boolean needed? 'or' args
((5 boolean) <- neq (4 type) (boolean literal))
(jif (5 boolean) (4 offset))
((6 boolean) <- arg)
((7 boolean) <- arg)
((8 boolean) <- or (6 boolean) (7 boolean))
(reply (8 boolean)))
(main
((1 boolean) <- test-fn (t literal) (t literal)))))
(run 'main)
;? (prn memory*)
(if (~is memory*.1 t)
(prn "F - an example function that can do different things (dispatch) based on the type of its args or oargs"))
(if (~iso memory* (obj 1 t
; add-fn's temporaries
4 'boolean 5 nil 6 t 7 t 8 t))
(prn "F - an example function that can do different things (dispatch) based on the type of its args or oargs (internals)"))
;? (quit)
(reset)
(add-fns
'((test-fn
((4 type) <- otype 0)
((5 boolean) <- neq (4 type) (integer literal))
(jif (5 boolean) (4 offset))
((6 integer) <- arg)
((7 integer) <- arg)
((8 integer) <- add (6 integer) (7 integer))
(reply (8 integer))
((5 boolean) <- neq (4 type) (boolean literal))
(jif (5 boolean) (6 offset))
((6 boolean) <- arg)
((7 boolean) <- arg)
((8 boolean) <- or (6 boolean) (7 boolean))
(reply (8 boolean)))
(main
((1 boolean) <- test-fn (t literal) (t literal))
((2 integer) <- test-fn (3 literal) (4 literal)))))
(run 'main)
;? (prn memory*)
(if (~and (is memory*.1 t) (is memory*.2 7))
(prn "F - different calls can exercise different clauses of the same function"))
(if (~iso memory* (obj ; results of first and second calls to test-fn
1 t 2 7
; temporaries for most recent call to test-fn
4 'integer 5 nil 6 3 7 4 8 7))
(prn "F - different calls can exercise different clauses of the same function (internals)"))
(if (~iso (convert-braces '(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
{ begin ; 'begin' is just a hack because racket turns curlies into parens
((4 boolean) <- neq (1 integer) (3 integer))
(breakif (4 boolean))
((5 integer) <- copy (34 literal))
}
(reply)))
'(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
((4 boolean) <- neq (1 integer) (3 integer))
(jif (4 boolean) (1 offset))
((5 integer) <- copy (34 literal))
(reply)))
(prn "F - convert-braces replaces breakif with a jif to after the next close curly"))
(if (~iso (convert-braces '(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
{ begin
(break)
}
(reply)))
'(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
(jmp (0 offset))
(reply)))
(prn "F - convert-braces works for degenerate blocks"))
(if (~iso (convert-braces '(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
{ begin
((4 boolean) <- neq (1 integer) (3 integer))
(breakif (4 boolean))
{ begin
((5 integer) <- copy (34 literal))
}
}
(reply)))
'(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
((4 boolean) <- neq (1 integer) (3 integer))
(jif (4 boolean) (1 offset))
((5 integer) <- copy (34 literal))
(reply)))
(prn "F - convert-braces balances curlies when converting break"))
(if (~iso (convert-braces '(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
{ begin
((3 integer) <- add (2 integer) (2 integer))
{ begin
((4 boolean) <- neq (1 integer) (3 integer))
}
(continueif (4 boolean))
((5 integer) <- copy (34 literal))
}
(reply)))
'(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
((3 integer) <- add (2 integer) (2 integer))
((4 boolean) <- neq (1 integer) (3 integer))
(jif (4 boolean) (-3 offset))
((5 integer) <- copy (34 literal))
(reply)))
(prn "F - convert-braces balances curlies when converting continue"))
(reset)
(add-fns `((main ,@(convert-braces '(((1 integer) <- copy (4 literal))
((2 integer) <- copy (1 literal))
{ begin
((2 integer) <- add (2 integer) (2 integer))
{ begin
((3 boolean) <- neq (1 integer) (2 integer))
}
(continueif (3 boolean))
((4 integer) <- copy (34 literal))
}
(reply))))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 4 3 nil 4 34))
(prn "F - continue correctly loops"))
(reset)
(add-fns `((main ,@(convert-braces '(((1 integer) <- copy (4 literal))
((2 integer) <- copy (2 literal))
{ begin
((2 integer) <- add (2 integer) (2 integer))
{ begin
((3 boolean) <- neq (1 integer) (2 integer))
}
(continueif (3 boolean))
((4 integer) <- copy (34 literal))
}
(reply))))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 4 3 nil 4 34))
(prn "F - continue might never trigger"))
(reset)
(let before Memory-in-use-until
(add-fns
'((main
((1 integer-address) <- new (integer type)))))
(run 'main)
;? (prn memory*)
(if (~iso memory*.1 before)
(prn "F - 'new' returns current high-water mark"))
(if (~iso Memory-in-use-until (+ before 1))
(prn "F - 'new' on primitive types increments high-water mark by their size")))
(reset)
(let before Memory-in-use-until
(add-fns
'((main
((1 type-array-address) <- new (type-array type) (5 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory*.1 before)
(prn "F - 'new' on array with literal size returns current high-water mark"))
(if (~iso Memory-in-use-until (+ before 5))
(prn "F - 'new' on primitive arrays increments high-water mark by their size")))
(reset)
(let before Memory-in-use-until
(add-fns
'((main
((1 integer) <- copy (5 literal))
((2 type-array-address) <- new (type-array type) (1 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory*.2 before)
(prn "F - 'new' on array with variable size returns current high-water mark"))
(if (~iso Memory-in-use-until (+ before 5))
(prn "F - 'new' on primitive arrays increments high-water mark by their (variable) size")))
(reset)
(add-fns
'((f1
((1 integer) <- copy (3 literal)))
(f2
((2 integer) <- copy (4 literal)))))
(let ninsts (run 'f1 'f2)
(when (~iso 2 ninsts)
(prn "F - scheduler didn't run the right number of instructions: " ninsts)))
(if (~iso memory* (obj 1 3 2 4))
(prn "F - scheduler runs multiple functions: " memory*))
(check-trace-contents "scheduler orders functions correctly"
'(("schedule" "f1")
("schedule" "f2")
))
(check-trace-contents "scheduler orders schedule and run events correctly"
'(("schedule" "f1")
("run" "f1 0")
("schedule" "f2")
("run" "f2 0")
))
|