swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

27
unikernel/duniverse/eqaf/test/dune Normal file
View file

@ -0,0 +1,27 @@
(executable
(name test)
(modules test)
(libraries alcotest eqaf))
(rule
(alias runtest)
(locks singleton)
(package eqaf)
(deps
(:test test.exe))
(action
(run %{test} --color=always)))
(executable
(name test_branch)
(modules test_branch)
(libraries clock unix eqaf))
(rule
(alias runtest)
(locks singleton)
(package eqaf)
(deps
(:test test_branch.exe))
(action
(run %{test})))

209
unikernel/duniverse/eqaf/test/test.ml Normal file
View file

@ -0,0 +1,209 @@
type r = Neg | Pos | Zero
let equal w a b = match w with
| Zero -> a = 0 && b = 0
| Neg -> a < 0 && b < 0
| Pos -> a > 0 && b > 0
let of_expected = function
| 0 -> Zero | n -> if n < 0 then Neg else Pos
let value w = Alcotest.testable Fmt.int (equal w)
let be a b expected =
let title = Fmt.str "be %S %S = %d" a b expected in
Alcotest.test_case title `Quick @@ fun () ->
let expected' = String.compare a b in
Alcotest.(check (value (of_expected expected))) "result" (Eqaf.compare_be a b) expected ;
Alcotest.(check (value (of_expected expected'))) "string.compare" (Eqaf.compare_be a b) expected'
let le a b expected =
let title = Fmt.str "le %S %S = %d" a b expected in
Alcotest.test_case title `Quick @@ fun () ->
Alcotest.(check (value (of_expected expected))) "result" (Eqaf.compare_le a b) expected
let exists str chr exists =
Alcotest.test_case (Fmt.str "contains %S %c = %b" str chr exists) `Quick @@ fun () ->
let res = Eqaf.exists_uint8 ~f:((=) (Char.code chr)) str in
Alcotest.(check bool) "result" res exists
let find str chr index =
Alcotest.test_case (Fmt.str "index %S %c = %d" str chr index) `Quick @@ fun () ->
let res = Eqaf.find_uint8 ~f:((=) (Char.code chr)) str in
Alcotest.(check int) "result" res index
let int_of_bool bool expect =
Alcotest.test_case
(Fmt.str
"int_of_bool %B = %d" bool expect
) `Quick @@ fun ()->
Alcotest.(check int) "result" expect (Eqaf.int_of_bool bool)
let bool_of_int desc n expect =
Alcotest.test_case
(Fmt.str
"int_of_bool %s = %B" desc expect
) `Quick @@ fun ()->
Alcotest.(check bool) "result" expect (Eqaf.bool_of_int n)
let select_a_if_in_range (low,high) n a b expect =
Alcotest.test_case
(Fmt.str
"select_a_if_in_range (%d,%d) ~n:%d %d %d"
low high n a b
) `Quick @@ fun ()->
let choice = Eqaf.select_a_if_in_range ~low ~high ~n a b in
Alcotest.(check int) "selected" expect choice
let a_uint32 = Alcotest.testable Fmt.uint32 (=)
let divmod str x m q r =
(* (x / m = q) and (x mod m = r) *)
Alcotest.test_case
(Fmt.str
"divmod %s %lu / %lu = %lu, %lu mod %lu = %lu"
str x m q x m r
) `Quick @@ fun ()->
let eq_quot, eq_rem = Eqaf.divmod ~x ~m in
Alcotest.(check (pair a_uint32 a_uint32)) "q,r" (q,r) (eq_quot,eq_rem)
let ascii_of_int32 str digits n expect =
Alcotest.test_case
(Fmt.str
"ascii_of_string %s %d %lu %S"
str digits n expect
) `Quick @@ fun ()->
try
let ascii = Eqaf.ascii_of_int32 ~digits n in
Alcotest.(check string) str expect ascii
with Invalid_argument x when x = "digits < 0" -> ()
let string_of_hex str hex expect =
Alcotest.test_case
(Fmt.str
" %s %S %S"
str hex expect
) `Quick @@ fun ()->
let enc = Eqaf.string_of_hex hex in
Alcotest.(check @@ pair string int) str (expect,0) enc
let hex_of_string str raw expect =
Alcotest.test_case
(Fmt.str
" %s %S %S"
str raw expect
) `Quick @@ fun ()->
let enc = Eqaf.hex_of_string raw in
Alcotest.(check string) str expect enc
let () =
Alcotest.run "eqaf"
[ "be", [ be "a" "a" 0
; be "a" "b" (-1)
; be "b" "a" 1
; be "aa" "ab" (-1)
; be "aaa" "aba" (-1)
; be "bbb" "abc" 1
; be "bbb" "bbc" (-1)
; be "bbb" "abb" 1
; be "\x00\x34\x12" "\x00\x33\x12" 1
; be "\x00\x34\x12" "\x00\x33\x99" 1 ]
; "le", [ le "a" "a" 0
; le "a" "b" (-1)
; le "b" "a" 1
; le "aa" "ab" (-1)
; le "aaa" "aba" (-1)
; le "bbb" "abc" (-1)
; le "bbb" "bbc" (-1)
; le "bbb" "abb" 1
; le "\x00\x34\x12" "\x00\x33\x12" 1
; le "\x00\x34\x12" "\x00\x33\x99" (-1) ]
; "exists", [ exists "a" 'a' true
; exists "a" 'b' false
; exists "abc" 'c' true
; exists "abc" 'a' true
; exists "abc" 'b' true
; exists "abc" 'd' false ]
; "find", [ find "a" 'a' 0
; find "a" 'b' (-1)
; find "aaaa" 'a' 0
; find "bbbb" 'a' (-1)
; find "aabb" 'b' 2
; find "aabb" 'a' 0
; find "aaab" 'b' 3 ]
; "int_of_bool", [ int_of_bool false 0 (* exhaustive :-) *)
; int_of_bool true 1]
; "bool_of_int", [ bool_of_int "0" 0 false
; bool_of_int "-1" ~-1 true
; bool_of_int "2" 2 true
; bool_of_int "max_int" max_int true
; bool_of_int "min_int" min_int true
; bool_of_int "1" 1 true ]
; "select_a_if_in_range",
[ select_a_if_in_range (0,3) 0 22 30 22
; select_a_if_in_range (0,3) 1 22 30 22
; select_a_if_in_range (0,3) 2 22 30 22
; select_a_if_in_range (0,3) 3 22 30 22
; select_a_if_in_range (0,3) 4 22 30 30
; select_a_if_in_range (0,3) ~-1 22 30 30
; select_a_if_in_range (0,0) 0 1 2 1
; select_a_if_in_range (1,1) 0 3 4 4
; select_a_if_in_range (1,1) 1 5 6 5
; select_a_if_in_range (1,1) 2 7 8 8
; select_a_if_in_range (0,0) 0 7904 0 7904
; select_a_if_in_range (0,3) min_int 22 30 30
; select_a_if_in_range (0,3) max_int 22 30 30
; select_a_if_in_range (1,max_int-1) max_int 1 2 2
; select_a_if_in_range (1,max_int-1) min_int 1 2 2
; select_a_if_in_range (1,max_int-1) ~-1 3 4 4
; select_a_if_in_range (1,max_int-1) 0 5 6 6
; select_a_if_in_range (1,max_int) max_int 1 2 1
; select_a_if_in_range (1,max_int) min_int 1 2 2
; select_a_if_in_range (1,max_int) ~-1 3 4 4
; select_a_if_in_range (1,max_int) 0 5 6 6
; select_a_if_in_range (1,max_int) 1 5 6 5
; select_a_if_in_range (0,max_int) max_int 1 2 1
; select_a_if_in_range (0,max_int) min_int 1 2 2
; select_a_if_in_range (0,max_int) ~-1 3 4 4
; select_a_if_in_range (0,max_int) 0 5 6 5
]
; "divmod", [ divmod "" 1l 2l 0l 1l
; divmod "" 123l 1l 123l 0l
; divmod "" 1l 3l 0l 1l
; divmod "" 2l 3l 0l 2l
; divmod "" 3l 2l 1l 1l
; divmod "" 10l 6l 1l 4l
; divmod "" 10l 4l 2l 2l
; divmod "" 1l 2l 0l 1l
; divmod "" 30l 7l 4l 2l
; divmod "" 4l 2l 2l 0l
; divmod "" 1234567l 1l 1234567l 0l
; divmod "" 1234567l 10l 123456l 7l
; divmod "" 1234567l 100l 12345l 67l
; divmod "" 1234567l 1000l 1234l 567l
; divmod "" 1234567l 10000l 123l 4567l
; divmod "" 12345l 100l 123l 45l
; divmod "" 0xffff1234l 1_000_l 4294906l 420l
; divmod "" 1123456789l 10_000_l 112345l 6789l ]
; "ascii_of_int32", [ ascii_of_int32 "" 6 12345678l "345678"
; ascii_of_int32 "" ~-1 1234l "001234"
; ascii_of_int32 "" 1 9876l "6"
; ascii_of_int32 "" 4 0l "0000"
; ascii_of_int32 "" 6 1234l "001234"
; ascii_of_int32 "" 0 1234l ""]
; "string_of_hex", [ string_of_hex "" "2d2d486924" "--Hi$"
; string_of_hex "" "2D2d486924" "--Hi$"
; string_of_hex "" "1234" "\x12\x34"
; string_of_hex "" "ff80" "\xff\x80"
; string_of_hex "" "b7DDdd" "\xb7\xdd\xdd"
; string_of_hex "" "808888Fd" "\x80\x88\x88\xfd"
; string_of_hex "" "E0EE8eEEEE" "\xe0\xee\x8e\xee\xee"
; string_of_hex "empty" "" ""]
; "hex_of_string", [ hex_of_string "" "--Hi$" "2d2d486924"
; hex_of_string "" "\x12\x34" "1234"
; hex_of_string "" "\xff\x80" "ff80"
; hex_of_string "" "\xb7\xff\x20" "b7ff20"
; hex_of_string "" "\x00\x01\x00" "000100"
; hex_of_string "empty" "" ""]
]

140
unikernel/duniverse/eqaf/test/test_branch.ml Normal file
View file

@ -0,0 +1,140 @@
let exit_success = 0
let exit_failure = 1
(* First computation wants to count operations needed by
- one_if_not_zero
- zero_if_not_zero
- select_int
For each /assembly instructions/, we update a counter. This way is not
totally true. Even if we check by hands that bitwise operations don't
emit branches, this is our only assumption! *)
let operation = ref 0
let logical_shift_right a b = incr operation ; a lsr b
let logical_or a b = incr operation ; a lor b
let shift_right a b = incr operation ; a asr b
let logical_and a b = incr operation ; a land b
let logical_not a = incr operation ; lnot a
let minus a = incr operation ; (- a)
let sub a b = incr operation ; a - b
let[@inline always] minus_one_or_less n =
logical_shift_right n (sub Sys.int_size 1)
let[@inline always] one_if_not_zero n = minus_one_or_less (logical_or (minus n) n)
let[@inline always] zero_if_not_zero n = sub (one_if_not_zero n) 1
let[@inline always] select_int choose_b a b =
let mask = shift_right (logical_or (minus choose_b) choose_b) Sys.int_size in
logical_or (logical_and a (logical_not mask)) (logical_and b mask)
let one_if_not_zero_ops =
let _ = one_if_not_zero 0x7eadbeef in
Format.printf "[one_if_not_zero]: %d operation(s).\n%!" !operation ;
!operation
let () = operation := 0
let zero_if_not_zero_ops =
let _ = zero_if_not_zero 0x7eadbeef in
Format.printf "[zero_if_not_zero]: %d operation(s).\n%!" !operation ;
!operation
let () = operation := 0
let select_int_ops =
let _ = select_int 0 1 2 in
Format.printf "[select_int]: %d operation(s).\n%!" !operation ;
!operation
let eqaf_sleep () = Unix.sleep 1
let logical_shift_right a b = eqaf_sleep () ; a lsr b
let logical_or a b = eqaf_sleep () ; a lor b
let shift_right a b = eqaf_sleep () ; a asr b
let logical_and a b = eqaf_sleep () ; a land b
let logical_not a = eqaf_sleep () ; lnot a
let minus a = eqaf_sleep () ; (- a)
let sub a b = eqaf_sleep () ; a - b
let[@inline always] minus_one_or_less n =
logical_shift_right n (sub Sys.int_size 1)
let[@inline always] one_if_not_zero n = minus_one_or_less (logical_or (minus n) n)
let[@inline always] zero_if_not_zero n = sub (one_if_not_zero n) 1
let[@inline always] select_int choose_b a b =
let mask = shift_right (logical_or (minus choose_b) choose_b) Sys.int_size in
logical_or (logical_and a (logical_not mask)) (logical_and b mask)
(* Finally, we count how many time we spend when we call our
functions. [eqaf_sleep] spends 1 second, so our bitwise operators
should spend 1 second + some nanosecond. At the end, execution of
them should be closely equal to our operation counter where:
1 operation ~= 1 second
To be able to count time, we use [caml_time] which is available only
on Linux and for a native compilation (see [@unboxed]). Because bitwise
operation spend at least 1 second, we finally [floor] our results to
delete noise.
NOTE: [check/check] does a linear regression to delete noise and really
get how long is our functions. We think that for our functions:
- zero_if_not_zero
- one_if_not_zero
- select_int
[check/check] is too huge. *)
let time () = Clock.now ()
let fdiv a b = a /. b
let () =
let t0 = time () in
let _ = one_if_not_zero 0x7eadbeef in
let t1 = time () in
let v0 = Int64.(floor (fdiv (to_float (sub t1 t0)) 1000000000.)) in
Format.printf "[one_if_not_zero 0x7eadbeef]: %fs.\n%!" v0 ;
let t0 = time () in
let _ = one_if_not_zero 0x0 in
let t1 = time () in
let v1 = Int64.(floor (fdiv (to_float (sub t1 t0)) 1000000000.)) in
Format.printf "[one_if_not_zero 0x0]: %fs.\n%!" v0 ;
if v0 = v1
&& int_of_float v0 = one_if_not_zero_ops
&& int_of_float v1 = one_if_not_zero_ops
then () else exit exit_failure
let () =
let t0 = time () in
let _ = zero_if_not_zero 0x7eadbeef in
let t1 = time () in
let v0 = Int64.(floor (fdiv (to_float (sub t1 t0)) 1000000000.)) in
Format.printf "[zero_if_not_zero 0x7eadbeef]: %fs.\n%!" v0 ;
let t0 = time () in
let _ = zero_if_not_zero 0x0 in
let t1 = time () in
let v1 = Int64.(floor (fdiv (to_float (sub t1 t0)) 1000000000.)) in
Format.printf "[zero_if_not_zero 0x0]: %fs.\n%!" v0 ;
if v0 = v1
&& int_of_float v0 = zero_if_not_zero_ops
&& int_of_float v1 = zero_if_not_zero_ops
then () else exit exit_failure
let () =
let t0 = time () in
let _ = select_int 0 1 2 in
let t1 = time () in
let v0 = Int64.(floor (fdiv (to_float (sub t1 t0)) 1000000000.)) in
Format.printf "[select_int 0 1 2]: %fs.\n%!" v0 ;
let t0 = time () in
let _ = select_int 2 1 0 in
let t1 = time () in
let v1 = Int64.(floor (fdiv (to_float (sub t1 t0)) 1000000000.)) in
Format.printf "[select_int 2 1 0]: %fs.\n%!" v1 ;
if v0 = v1
&& int_of_float v0 = select_int_ops
&& int_of_float v1 = select_int_ops
then () else exit exit_failure
;;