mu/mu.arc.t

792 lines
24 KiB
Perl
Raw Normal View History

2014-07-06 07:07:03 +00:00
(load "mu.arc")
2014-08-19 17:31:58 +00:00
(reset)
2014-08-19 18:58:22 +00:00
(add-fns
'((test1
((1 integer) <- copy (23 literal)))))
(run 'test1)
2014-08-19 18:58:22 +00:00
;? (prn memory*)
(if (~iso memory* (obj 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."))
2014-08-29 02:23:38 +00:00
;? (quit)
2014-07-17 15:16:22 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-08-19 18:58:22 +00:00
(add-fns
'((test1
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
2014-08-19 18:58:22 +00:00
((3 integer) <- add (1 integer) (2 integer)))))
(run 'test1)
2014-07-06 07:07:03 +00:00
(if (~iso memory* (obj 1 1 2 3 3 4))
2014-07-17 15:16:22 +00:00
(prn "F - 'add' operates on two addresses"))
2014-07-06 08:53:18 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-06 08:53:18 +00:00
(add-fns
2014-07-17 15:13:52 +00:00
'((test1
((3 integer) <- add (1 integer) (2 integer)))
2014-07-06 08:53:18 +00:00
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
2014-07-17 15:13:52 +00:00
(test1))))
(run 'main)
2014-07-06 08:53:18 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4))
2014-07-17 15:16:22 +00:00
(prn "F - calling a user-defined function runs its instructions"))
2014-08-28 23:40:28 +00:00
;? (quit)
(reset)
(add-fns
'((test1
((1 integer) <- copy (1 literal)))
2014-08-28 23:40:28 +00:00
(main
(test1))))
(if (~iso 2 (run 'main))
(prn "F - calling a user-defined function runs its instructions exactly once"))
;? (quit)
2014-07-06 08:57:47 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-06 08:57:47 +00:00
(add-fns
2014-07-17 15:13:52 +00:00
'((test1
((3 integer) <- add (1 integer) (2 integer))
2014-07-07 03:13:15 +00:00
(reply)
((4 integer) <- copy (34 literal)))
2014-07-06 08:57:47 +00:00
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
2014-07-17 15:13:52 +00:00
(test1))))
(run 'main)
2014-07-06 08:57:47 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4))
2014-07-17 15:16:22 +00:00
(prn "F - 'reply' stops executing the current function"))
;? (quit)
2014-07-06 09:19:32 +00:00
2014-08-28 23:40:28 +00:00
(reset)
(add-fns
`((test1
((3 integer) <- test2))
(test2
(reply (2 integer)))
(main
((2 integer) <- copy (34 literal))
2014-08-28 23:40:28 +00:00
(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)))
2014-08-28 23:40:28 +00:00
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
2014-08-28 23:40:28 +00:00
(test1))))
(if (~iso 4 (run 'main)) ; last reply sometimes not counted. worth fixing?
(prn "F - 'reply' executes instructions exactly once"))
;? (quit)
2014-08-19 17:31:58 +00:00
(reset)
2014-07-06 09:19:32 +00:00
(add-fns
2014-07-17 15:13:52 +00:00
'((test1
((4 integer) <- arg)
((5 integer) <- arg)
((3 integer) <- add (4 integer) (5 integer))
2014-07-07 03:13:15 +00:00
(reply)
((4 integer) <- copy (34 literal)))
2014-07-06 09:19:32 +00:00
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1 (1 integer) (2 integer))
)))
(run 'main)
2014-07-06 09:19:32 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
4 1 5 3))
2014-07-17 15:16:22 +00:00
(prn "F - 'arg' accesses in order the operands of the most recent function call (the caller)"))
2014-07-12 04:53:44 +00:00
;? (quit)
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 04:53:44 +00:00
(add-fns
2014-07-17 15:13:52 +00:00
'((test1
((5 integer) <- arg 1)
((4 integer) <- arg 0)
((3 integer) <- add (4 integer) (5 integer))
2014-07-12 04:53:44 +00:00
(reply)
((4 integer) <- copy (34 literal)))
2014-07-12 04:53:44 +00:00
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
(test1 (1 integer) (2 integer))
2014-07-12 04:53:44 +00:00
)))
(run 'main)
2014-07-12 04:53:44 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4
; add-fn's temporaries
4 1 5 3))
2014-07-17 15:16:22 +00:00
(prn "F - 'arg' with index can access function call arguments out of order"))
2014-07-12 04:53:44 +00:00
;? (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.
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
2014-07-17 15:13:52 +00:00
'((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))
2014-07-17 15:16:22 +00:00
(prn "F - 'reply' can take aguments that are returned, or written back into output args of caller"))
2014-07-06 09:35:45 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-06 09:35:45 +00:00
(add-fns
2014-07-17 15:13:52 +00:00
'((test1
((4 integer) <- arg)
((5 integer) <- arg)
((6 integer) <- add (4 integer) (5 integer))
(reply (6 integer) (5 integer))
((4 integer) <- copy (34 literal)))
2014-07-06 09:35:45 +00:00
(main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
((3 integer) (7 integer) <- test1 (1 integer) (2 integer)))))
(run 'main)
2014-07-06 09:35:45 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 4 7 3
; add-fn's temporaries
4 1 5 3 6 4))
2014-07-17 15:16:22 +00:00
(prn "F - 'reply' permits a function to return multiple values at once"))
2014-07-12 04:04:38 +00:00
(reset)
(add-fns
'((test1
((1 integer) <- add (2 literal) (3 literal)))))
(run 'test1)
(if (~iso memory* (obj 1 5))
(prn "F - ops can take 'literal' operands (but not return them)"))
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 04:04:38 +00:00
(add-fns
'((main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (3 literal))
((3 integer) <- sub (1 integer) (2 integer)))))
(run 'main)
2014-07-12 04:04:38 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 1 2 3 3 -2))
2014-07-17 15:16:22 +00:00
(prn "F - 'sub' subtracts the value at one address from the value at another"))
2014-07-12 04:04:38 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 04:04:38 +00:00
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (3 literal))
((3 integer) <- mul (1 integer) (2 integer)))))
(run 'main)
2014-07-12 04:04:38 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 3 3 6))
2014-07-17 15:16:22 +00:00
(prn "F - 'mul' multiplies like 'add' adds"))
2014-07-12 04:04:38 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 04:04:38 +00:00
(add-fns
'((main
((1 integer) <- copy (8 literal))
((2 integer) <- copy (3 literal))
((3 integer) <- div (1 integer) (2 integer)))))
(run 'main)
2014-07-12 04:04:38 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 8 2 3 3 (/ real.8 3)))
2014-07-17 15:16:22 +00:00
(prn "F - 'div' divides like 'add' adds"))
2014-07-12 04:04:38 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 04:04:38 +00:00
(add-fns
'((main
((1 integer) <- copy (8 literal))
((2 integer) <- copy (3 literal))
((3 integer) (4 integer) <- idiv (1 integer) (2 integer)))))
(run 'main)
2014-07-12 04:04:38 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 8 2 3 3 2 4 2))
2014-07-17 15:16:22 +00:00
(prn "F - 'idiv' performs integer division, returning quotient and remainder"))
2014-07-12 04:22:32 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 05:50:55 +00:00
(add-fns
'((main
((1 boolean) <- copy (t literal))
((2 boolean) <- copy (nil literal))
((3 boolean) <- and (1 boolean) (2 boolean)))))
(run 'main)
2014-07-12 05:50:55 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 t 2 nil 3 nil))
2014-07-17 15:16:22 +00:00
(prn "F - logical 'and' for booleans"))
2014-07-12 05:50:55 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-14 04:27:23 +00:00
(add-fns
'((main
((1 boolean) <- copy (4 literal))
((2 boolean) <- copy (3 literal))
((3 boolean) <- lt (1 boolean) (2 boolean)))))
(run 'main)
2014-07-14 04:27:23 +00:00
;? (prn memory*)
2014-07-17 15:16:22 +00:00
(if (~iso memory* (obj 1 4 2 3 3 nil))
(prn "F - 'lt' is the less-than inequality operator"))
2014-07-14 04:27:23 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-14 04:27:23 +00:00
(add-fns
'((main
((1 boolean) <- copy (4 literal))
((2 boolean) <- copy (3 literal))
((3 boolean) <- le (1 boolean) (2 boolean)))))
(run 'main)
2014-07-14 04:27:23 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 3 3 nil))
2014-07-17 15:16:22 +00:00
(prn "F - 'le' is the <= inequality operator"))
2014-08-19 17:31:58 +00:00
(reset)
2014-07-17 15:16:22 +00:00
(add-fns
'((main
((1 boolean) <- copy (4 literal))
((2 boolean) <- copy (4 literal))
((3 boolean) <- le (1 boolean) (2 boolean)))))
(run 'main)
2014-07-17 15:16:22 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 4 3 t))
(prn "F - 'le' returns true for equal operands"))
2014-07-14 04:27:23 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-14 04:27:23 +00:00
(add-fns
'((main
((1 boolean) <- copy (4 literal))
((2 boolean) <- copy (5 literal))
((3 boolean) <- le (1 boolean) (2 boolean)))))
(run 'main)
2014-07-14 04:27:23 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 4 2 5 3 t))
2014-07-17 15:16:22 +00:00
(prn "F - le is the <= inequality operator - 2"))
2014-07-14 04:27:23 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-12 04:22:32 +00:00
(add-fns
'((main
((1 integer) <- copy (8 literal))
(jmp (1 offset))
((2 integer) <- copy (3 literal))
2014-07-12 04:22:32 +00:00
(reply))))
(run 'main)
2014-07-12 04:22:32 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 8))
2014-07-17 15:16:22 +00:00
(prn "F - 'jmp' skips some instructions"))
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (8 literal))
(jmp (1 offset))
((2 integer) <- copy (3 literal))
(reply)
((3 integer) <- copy (34 literal)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 8))
2014-07-17 15:16:22 +00:00
(prn "F - 'jmp' doesn't skip too many instructions"))
2014-08-28 23:40:28 +00:00
;? (quit)
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (1 literal))
((3 boolean) <- eq (1 integer) (2 integer))
(jif (3 boolean) (1 offset))
((2 integer) <- copy (3 literal))
(reply)
((3 integer) <- copy (34 literal)))))
(run 'main)
;? (prn memory*)
2014-07-12 05:50:55 +00:00
(if (~iso memory* (obj 1 1 2 1 3 t))
2014-07-17 15:16:22 +00:00
(prn "F - 'jif' is a conditional 'jmp'"))
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (1 literal))
((2 integer) <- copy (2 literal))
((3 boolean) <- eq (1 integer) (2 integer))
(jif (3 boolean) (1 offset))
((4 integer) <- copy (3 literal))
(reply)
((3 integer) <- copy (34 literal)))))
(run 'main)
;? (prn memory*)
2014-07-12 05:50:55 +00:00
(if (~iso memory* (obj 1 1 2 2 3 nil 4 3))
2014-07-17 15:16:22 +00:00
(prn "F - if 'jif's first arg is false, it doesn't skip any instructions"))
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (2 literal))
((2 integer) <- copy (1 literal))
((2 integer) <- add (2 integer) (2 integer))
((3 boolean) <- eq (1 integer) (2 integer))
(jif (3 boolean) (-3 offset))
((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"))
2014-08-19 17:31:58 +00:00
(reset)
2014-07-31 09:18:00 +00:00
(add-fns
'((main
((1 integer) <- copy (34 literal))
2014-07-31 09:18:00 +00:00
((2 integer) <- copy (1 integer)))))
(run 'main)
2014-07-31 09:18:00 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 34))
(prn "F - 'copy' performs direct addressing"))
2014-08-19 17:31:58 +00:00
(reset)
2014-07-31 09:18:00 +00:00
(add-fns
'((main
((1 integer-address) <- copy (2 literal))
((2 integer) <- copy (34 literal))
((3 integer) <- copy (1 integer-address deref)))))
(run 'main)
2014-07-31 09:18:00 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 34 3 34))
(prn "F - 'copy' performs indirect addressing"))
2014-07-31 09:18:00 +00:00
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
'((main
((1 integer-address) <- copy (2 literal))
((2 integer) <- copy (34 literal))
((3 integer) <- copy (2 literal))
((1 integer-address deref) <- add (2 integer) (3 integer)))))
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 2 2 36 3 2))
2014-08-22 03:08:22 +00:00
(prn "F - instructions can perform indirect addressing on output arg"))
2014-08-20 04:33:48 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 boolean) <- copy (nil literal))
2014-08-20 04:33:48 +00:00
((3 boolean) <- get (1 integer-boolean-pair) (1 offset))
((4 integer) <- get (1 integer-boolean-pair) (0 offset)))))
(run 'main)
2014-08-20 04:33:48 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 nil 4 34))
(prn "F - 'get' accesses fields of records"))
2014-10-05 22:02:28 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 boolean) <- copy (nil literal))
((3 integer-boolean-pair-address) <- copy (1 literal))
2014-10-05 22:02:28 +00:00
((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"))
2014-08-22 03:08:22 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (35 literal))
((3 integer) <- copy (36 literal))
2014-08-22 03:08:22 +00:00
((4 integer-integer-pair) <- get (1 integer-point-pair) (1 offset)))))
(run 'main)
2014-08-22 03:08:22 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 35 3 36 4 35 5 36))
(prn "F - 'get' accesses fields spanning multiple locations"))
2014-10-05 18:34:23 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (t literal))
2014-10-05 22:05:26 +00:00
((3 boolean-address) <- get-address (1 integer-boolean-pair) (1 offset)))))
2014-10-05 18:34:23 +00:00
(run 'main)
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 t 3 2))
(prn "F - 'get-address' returns address of fields of records"))
2014-10-05 22:10:29 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 integer) <- copy (t literal))
((3 integer-boolean-pair-address) <- copy (1 literal))
2014-10-05 22:10:29 +00:00
((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"))
2014-10-05 22:10:29 +00:00
(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"))
2014-10-05 18:34:23 +00:00
(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)))))
2014-10-05 18:34:23 +00:00
(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"))
2014-10-05 18:34:23 +00:00
(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 (~iso memory* (obj 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 (~iso memory* (obj 1 3))
(prn "F - 'sizeof' is different from number of elems"))
; todo: test that out-of-bounds access throws an error
2014-08-20 06:37:50 +00:00
(reset)
(add-fns
'((main
((1 integer) <- copy (34 literal))
((2 boolean) <- copy (nil literal))
((4 boolean) <- copy (t literal))
2014-08-20 06:37:50 +00:00
((3 integer-boolean-pair) <- copy (1 integer-boolean-pair)))))
(run 'main)
2014-08-20 06:37:50 +00:00
;? (prn memory*)
(if (~iso memory* (obj 1 34 2 nil 3 34 4 nil))
2014-08-22 03:08:22 +00:00
(prn "F - ops can operate on records spanning multiple locations"))
2014-08-20 06:37:50 +00:00
2014-08-19 17:31:58 +00:00
(reset)
(add-fns
2014-07-17 15:13:52 +00:00
'((test1
((4 type) <- otype 0)
((5 type) <- copy (integer literal))
((6 boolean) <- neq (4 type) (5 type))
(jif (6 boolean) (3 offset))
((7 integer) <- arg)
((8 integer) <- arg)
((9 integer) <- add (7 integer) (8 integer))
(reply (9 integer)))
(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 'integer 5 'integer 6 nil 7 1 8 3 9 4))
2014-07-17 15:16:22 +00:00
(prn "F - an example function that checks that its args are integers"))
;? (quit)
; todo - test that reply increments pc for caller frame after popping current frame
2014-07-17 15:16:22 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-17 15:16:22 +00:00
(add-fns
'((add-fn
((4 type) <- otype 0)
((5 type) <- copy (integer literal))
((6 boolean) <- neq (4 type) (5 type))
(jif (6 boolean) (4 offset))
((7 integer) <- arg)
((8 integer) <- arg)
((9 integer) <- add (7 integer) (8 integer))
(reply (9 integer))
((5 type) <- copy (boolean literal))
((6 boolean) <- neq (4 type) (5 type))
(jif (6 boolean) (4 offset))
((7 boolean) <- arg)
((8 boolean) <- arg)
((9 boolean) <- or (7 boolean) (8 boolean))
(reply (9 boolean)))
2014-07-17 15:16:22 +00:00
(main
((1 boolean) <- copy (t literal))
((2 boolean) <- copy (t literal))
((3 boolean) <- add-fn (1 boolean) (2 boolean)))))
(run 'main)
2014-07-17 15:16:22 +00:00
;? (prn memory*)
(if (~iso memory* (obj ; first call to add-fn
1 t 2 t 3 t
; add-fn's temporaries
4 'boolean 5 'boolean 6 nil 7 t 8 t 9 t))
2014-07-17 15:16:22 +00:00
(prn "F - an example function that can do different things (dispatch) based on the type of its args or oargs"))
;? (quit)
2014-07-17 15:16:22 +00:00
2014-08-19 17:31:58 +00:00
(reset)
2014-07-17 15:16:22 +00:00
(add-fns
'((add-fn
((4 type) <- otype 0)
((5 type) <- copy (integer literal))
((6 boolean) <- neq (4 type) (5 type))
(jif (6 boolean) (4 offset))
((7 integer) <- arg)
((8 integer) <- arg)
((9 integer) <- add (7 integer) (8 integer))
(reply (9 integer))
((5 type) <- copy (boolean literal))
((6 boolean) <- neq (4 type) (5 type))
(jif (6 boolean) (6 offset))
((7 boolean) <- arg)
((8 boolean) <- arg)
((9 boolean) <- or (7 boolean) (8 boolean))
(reply (9 boolean)))
2014-07-17 15:16:22 +00:00
(main
((1 boolean) <- copy (t literal))
((2 boolean) <- copy (t literal))
((3 boolean) <- add-fn (1 boolean) (2 boolean))
((10 integer) <- copy (3 literal))
((11 integer) <- copy (4 literal))
((12 integer) <- add-fn (10 integer) (11 integer)))))
(run 'main)
2014-07-17 15:16:22 +00:00
;? (prn memory*)
(if (~iso memory* (obj ; first call to add-fn
1 t 2 t 3 t
; second call to add-fn
10 3 11 4 12 7
; temporaries for most recent call to add-fn
4 'integer 5 'integer 6 nil 7 3 8 4 9 7))
2014-07-17 15:16:22 +00:00
(prn "F - different calls can exercise different clauses of the same function"))
(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)))
2014-07-19 02:04:43 +00:00
(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)))
2014-07-19 02:04:43 +00:00
(prn "F - convert-braces balances curlies when converting continue"))
2014-08-19 17:31:58 +00:00
(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"))
2014-08-19 17:31:58 +00:00
(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)
2014-10-07 05:58:06 +00:00
(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")))
2014-08-29 03:44:16 +00:00
2014-10-07 05:58:06 +00:00
(reset)
(let before Memory-in-use-until
(add-fns
'((main
((1 integer) <- copy (5 literal))
2014-10-07 05:58:06 +00:00
((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")))
2014-08-29 03:44:16 +00:00
(reset)
(add-fns
'((f1
((1 integer) <- copy (3 literal)))
2014-08-29 03:44:16 +00:00
(f2
((2 integer) <- copy (4 literal)))))
2014-08-31 18:27:58 +00:00
(let ninsts (run 'f1 'f2)
2014-08-29 03:44:16 +00:00
(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")
))