aboutsummaryrefslogtreecommitdiffstats
path: root/test/abi
diff options
context:
space:
mode:
Diffstat (limited to 'test/abi')
-rw-r--r--test/abi/.gitignore11
-rw-r--r--test/abi/Makefile111
-rwxr-xr-xtest/abi/Runtest41
-rw-r--r--test/abi/generator.ml458
-rw-r--r--test/abi/genlayout.ml158
-rw-r--r--test/abi/layout.c59
-rw-r--r--test/abi/staticlayout.c76
7 files changed, 914 insertions, 0 deletions
diff --git a/test/abi/.gitignore b/test/abi/.gitignore
new file mode 100644
index 00000000..5aa03c7c
--- /dev/null
+++ b/test/abi/.gitignore
@@ -0,0 +1,11 @@
+*.exe
+*.c
+*.h
+*.compcert
+*.cc
+*.cc2compcert
+*.compcert2cc
+*.light.c
+*.s
+!layout.c
+!staticlayout.c
diff --git a/test/abi/Makefile b/test/abi/Makefile
new file mode 100644
index 00000000..ef354e06
--- /dev/null
+++ b/test/abi/Makefile
@@ -0,0 +1,111 @@
+include ../../Makefile.config
+
+CCOMP=../../ccomp -stdlib ../../runtime
+CCOMPFLAGS=
+CFLAGS=-O -Wno-overflow -Wno-constant-conversion
+
+TESTS=fixed.compcert fixed.cc2compcert fixed.compcert2cc \
+ vararg.compcert vararg.cc2compcert vararg.compcert2cc \
+ struct.compcert struct.cc2compcert struct.compcert2cc
+
+DIFFTESTS=layout.compcert layout.cc \
+ staticlayout.compcert staticlayout.cc
+
+all: $(TESTS) $(DIFFTESTS)
+
+all_s: fixed_def_compcert.s fixed_use_compcert.s \
+ vararg_def_compcert.s vararg_use_compcert.s \
+ struct_def_compcert.s struct_use_compcert.s
+
+test:
+ @set -e; for t in $(TESTS); do \
+ SIMU='$(SIMU)' ARCH=$(ARCH) MODEL=$(MODEL) ABI=$(ABI) SYSTEM=$(SYSTEM) ./Runtest $$t; \
+ done
+ @set -e; for t in layout staticlayout; do \
+ $(SIMU) ./$$t.compcert > _compcert.log; \
+ $(SIMU) ./$$t.cc > _cc.log; \
+ if diff -a -u _cc.log _compcert.log; \
+ then echo "$$t: CompCert and $CC agree"; rm _*.log; \
+ else echo "$$t: CompCert and $CC DISAGREE"; exit 2; fi; \
+ done
+
+generator.exe: generator.ml
+ ocamlopt -g -o $@ generator.ml
+
+genlayout.exe: genlayout.ml
+ ocamlopt -g -o $@ genlayout.ml
+
+clean::
+ rm -f generator.exe genlayout.exe *.cm[iox]
+
+fixed_decl.h: generator.exe
+ ./generator.exe -rnd 500 -o fixed
+
+fixed_def.c fixed_use.c: fixed_decl.h
+
+clean::
+ rm -f fixed_decl.h fixed_def.c fixed_use.c
+
+vararg_decl.h: generator.exe
+ ./generator.exe -vararg -rnd 500 -o vararg
+
+vararg_def.c vararg_use.c: vararg_decl.h
+
+clean::
+ rm -f vararg_decl.h vararg_def.c vararg_use.c
+
+struct_decl.h: generator.exe
+ ./generator.exe -structs -o struct
+
+struct_def.c struct_use.c: struct_decl.h
+
+clean::
+ rm -f struct_decl.h struct_def.c struct_use.c
+
+ifeq ($(ARCH),arm)
+GENLAYOUT_OPTIONS += -stable
+endif
+ifeq ($(ARCH),aarch64)
+GENLAYOUT_OPTIONS += -stable
+endif
+
+layout.h: genlayout.exe
+ ./genlayout.exe $(GENLAYOUT_OPTIONS) > layout.h
+
+struct%.o: CCOMPFLAGS += -fstruct-passing -dclight
+
+%_compcert.o: %.c
+ $(CCOMP) $(CCOMPFLAGS) -c -o $@ $*.c
+%_cc.o: %.c
+ $(CC) $(CFLAGS) -c -o $@ $*.c
+
+%_compcert.s: %.c
+ $(CCOMP) -S -o $@ $*.c
+%_cc.s: %.c
+ $(CC) $(CFLAGS) -S -o $@ $*.c
+
+layout.compcert: layout.c layout.h
+ $(CCOMP) $(CCOMPFLAGS) -o $@ layout.c
+layout.cc: layout.c layout.h
+ $(CC) $(CFLAGS) -o $@ layout.c
+
+staticlayout.compcert: staticlayout.c layout.h
+ $(CCOMP) $(CCOMPFLAGS) -o $@ staticlayout.c
+staticlayout.cc: staticlayout.c layout.h
+ $(CC) $(CFLAGS) -o $@ staticlayout.c
+
+%.compcert: %_def_compcert.o %_use_compcert.o
+ $(CCOMP) -o $@ $*_def_compcert.o $*_use_compcert.o
+
+%.compcert: %_def_compcert.o %_use_compcert.o
+ $(CCOMP) -o $@ $*_def_compcert.o $*_use_compcert.o
+
+%.cc2compcert: %_def_compcert.o %_use_cc.o
+ $(CCOMP) -o $@ $*_def_compcert.o $*_use_cc.o
+
+%.compcert2cc: %_def_cc.o %_use_compcert.o
+ $(CCOMP) -o $@ $*_def_cc.o $*_use_compcert.o
+
+clean::
+ rm -f *.[os] *.compcert *.cc2compcert *.compcert2cc *.light.c
+
diff --git a/test/abi/Runtest b/test/abi/Runtest
new file mode 100755
index 00000000..7ec63188
--- /dev/null
+++ b/test/abi/Runtest
@@ -0,0 +1,41 @@
+#!/bin/sh
+
+# The name of the test
+name="$1"
+
+# Skip the test if known to fail
+
+skip () {
+ echo "$name: skipped"
+ exit 0
+}
+
+case "$name" in
+ fixed.cc2compcert|fixed.compcert2cc)
+ if [ $ARCH = arm ] && [ $ABI = hardfloat ] ; then skip; fi
+ ;;
+ struct.cc2compcert|struct.compcert2cc)
+ if [ $ARCH = x86 ] && [ $MODEL = 32sse2 ] ; then
+ # works except on Cygwin
+ if [ $SYSTEM = cygwin ] ; then skip; fi
+ elif [ $ARCH = powerpc ] && [ $ABI = linux ] ; then
+ # works
+ :
+ else
+ skip
+ fi
+ ;;
+esac
+
+# Administer the test
+
+if $SIMU ./$name
+then
+ echo "$name: passed"
+ exit 0
+else
+ echo "$name: FAILED"
+ exit 2
+fi
+
+
diff --git a/test/abi/generator.ml b/test/abi/generator.ml
new file mode 100644
index 00000000..529352e0
--- /dev/null
+++ b/test/abi/generator.ml
@@ -0,0 +1,458 @@
+open Printf
+
+type ty =
+ | Int8u | Int8s
+ | Int16u | Int16s
+ | Int32
+ | Int64
+ | Float32
+ | Float64
+ | String
+ | Struct of int * (string * ty) list
+
+type funsig = {
+ args: ty list;
+ varargs: ty list; (* empty list if fixed-argument function *)
+ res: ty option
+ }
+
+type value =
+ | VInt of int
+ | VInt32 of int32
+ | VInt64 of int64
+ | VFloat of float
+ | VString of string
+ | VStruct of value list
+
+(* Print a value. If [norm] is true, re-normalize values of
+ small numerical types. *)
+
+let zero_ext n k =
+ n land ((1 lsl k) - 1)
+
+let sign_ext n k =
+ (n lsl (Sys.int_size - k)) asr (Sys.int_size - k)
+
+let normalize_float32 n =
+ Int32.float_of_bits (Int32.bits_of_float n)
+
+let rec print_value ~norm oc (ty, v) =
+ match (ty, v) with
+ | (Int8u, VInt n) ->
+ fprintf oc "%d" (if norm then zero_ext n 8 else n)
+ | (Int8s, VInt n) ->
+ fprintf oc "%d" (if norm then sign_ext n 8 else n)
+ | (Int16u, VInt n) ->
+ fprintf oc "%d" (if norm then zero_ext n 16 else n)
+ | (Int16s, VInt n) ->
+ fprintf oc "%d" (if norm then sign_ext n 16 else n)
+ | (Int32, VInt32 n) ->
+ fprintf oc "%ld" n
+ | (Int64, VInt64 n) ->
+ fprintf oc "%Ld" n
+ | (Float32, VFloat f) ->
+ if norm
+ then fprintf oc "%hF" (normalize_float32 f)
+ else fprintf oc "%h" f
+ | (Float64, VFloat f) ->
+ fprintf oc "%h" f
+ | (String, VString s) ->
+ fprintf oc "%S" s
+ | (Struct(id, (fld1, ty1) :: members), VStruct (v1 :: vl)) ->
+ fprintf oc "(struct s%d){" id;
+ print_value ~norm oc (ty1, v1);
+ List.iter2
+ (fun (fld, ty) v -> fprintf oc ", %a" (print_value ~norm) (ty, v))
+ members vl;
+ fprintf oc "}"
+ | _, _ ->
+ assert false
+
+(* Generate random values of the given type *)
+
+let random_char () = Char.chr (Char.code 'a' + Random.int 26)
+
+let random_string () =
+ let len = Random.int 3 in
+ String.init len (fun _ -> random_char ())
+
+let random_int () =
+ Random.bits() - (1 lsl 29)
+
+let random_int32 () =
+ Int32.(logxor (of_int (Random.bits()))
+ (shift_left (of_int (Random.bits())) 30))
+
+let random_int64 () =
+ Int64.(logxor (of_int (Random.bits()))
+ (logxor (shift_left (of_int (Random.bits())) 30)
+ (shift_left (of_int (Random.bits())) 60)))
+
+let random_float64 () =
+ Random.float 100.0 -. 50.0
+
+(* Returns a random value. Small numerical types are not normalized. *)
+
+let rec random_value = function
+ | Int8u | Int8s | Int16u | Int16s ->
+ VInt (random_int())
+ | Int32 ->
+ VInt32 (random_int32())
+ | Int64 ->
+ VInt64 (random_int64())
+ | Float32 | Float64 ->
+ VFloat (random_float64())
+ | String ->
+ VString (random_string())
+ | Struct(id, members) ->
+ VStruct (List.map (fun (fld, ty) -> random_value ty) members)
+
+let random_retvalue = function
+ | None -> VInt 0 (* meaningless *)
+ | Some ty -> random_value ty
+
+(* Generate function declaration, definition, and call *)
+
+let string_of_ty = function
+ | Int8u -> "unsigned char"
+ | Int8s -> "signed char"
+ | Int16u -> "unsigned short"
+ | Int16s -> "short"
+ | Int32 -> "int"
+ | Int64 -> "long long"
+ | Float32 -> "float"
+ | Float64 -> "double"
+ | String -> "char *"
+ | Struct(id, _) -> sprintf "struct s%d" id
+
+let string_of_optty = function
+ | None -> "void"
+ | Some t -> string_of_ty t
+
+let declare_struct oc id members =
+ fprintf oc "struct s%d {\n" id;
+ List.iter
+ (fun (fld, ty) -> fprintf oc " %s %s;\n" (string_of_ty ty) fld)
+ members;
+ fprintf oc "};\n"
+
+let declare_function oc name sg =
+ fprintf oc "%s %s(" (string_of_optty sg.res) name;
+ begin match sg.args with
+ | [] -> fprintf oc "void"
+ | t0 :: tl ->
+ fprintf oc "%s x0" (string_of_ty t0);
+ List.iteri (fun n t -> fprintf oc ", %s x%d" (string_of_ty t) (n + 1)) tl;
+ if sg.varargs <> [] then fprintf oc ", ..."
+ end;
+ fprintf oc ")"
+
+let rec compare_value oc variable value ty =
+ match ty with
+ | Struct(id, members) ->
+ begin match value with
+ | VStruct vl ->
+ List.iter2
+ (fun (fld, ty) v ->
+ compare_value oc (sprintf "%s.%s" variable fld) v ty)
+ members vl
+ | _ ->
+ assert false
+ end
+ | String ->
+ fprintf oc " check (strcmp(%s, %a) == 0);\n"
+ variable (print_value ~norm:true) (ty, value)
+ | _ ->
+ fprintf oc " check (%s == %a);\n"
+ variable (print_value ~norm:true) (ty, value)
+
+let define_function oc name sg vargs vres =
+ declare_function oc name sg;
+ fprintf oc "\n{\n";
+ if sg.varargs <> [] then begin
+ fprintf oc " va_list l;\n";
+ fprintf oc " va_start(l, x%d);\n" (List.length sg.args - 1);
+ List.iteri
+ (fun n t ->
+ fprintf oc " %s x%d = va_arg(l, %s);\n"
+ (string_of_ty t) (n + List.length sg.args) (string_of_ty t))
+ sg.varargs;
+ fprintf oc " va_end(l);\n";
+ end;
+ List.iteri
+ (fun n (t, v) -> compare_value oc (sprintf "x%d" n) v t)
+ (List.combine (sg.args @ sg.varargs) vargs);
+ begin match sg.res with
+ | None -> ()
+ | Some tres ->
+ fprintf oc " return %a;\n" (print_value ~norm:false) (tres, vres)
+ end;
+ fprintf oc "}\n\n"
+
+let call_function oc name sg vargs vres =
+ fprintf oc "void call_%s(void)\n" name;
+ fprintf oc "{\n";
+ begin match sg.res with
+ | None -> fprintf oc " %s(" name
+ | Some t -> fprintf oc " %s r = %s(" (string_of_ty t) name
+ end;
+ begin match (sg.args @ sg.varargs), vargs with
+ | [], [] -> ()
+ | ty1 :: tyl, v1 :: vl ->
+ print_value ~norm:false oc (ty1, v1);
+ List.iter2
+ (fun ty v -> fprintf oc ", %a" (print_value ~norm:false) (ty, v))
+ tyl vl
+ | _, _ ->
+ assert false
+ end;
+ fprintf oc ");\n";
+ begin match sg.res with
+ | None -> ()
+ | Some tyres -> compare_value oc "r" vres tyres
+ end;
+ fprintf oc "}\n\n"
+
+let function_counter = ref 0
+
+let generate_one_test oc0 oc1 oc2 sg =
+ incr function_counter;
+ let num = !function_counter in
+ let vargs = List.map random_value (sg.args @ sg.varargs) in
+ let vres = random_retvalue sg.res in
+ let name = "f" ^ string_of_int num in
+ fprintf oc0 "extern ";
+ declare_function oc0 name sg;
+ fprintf oc0 ";\n";
+ define_function oc1 name sg vargs vres;
+ call_function oc2 name sg vargs vres
+
+let call_all_test oc =
+ fprintf oc "int main(void)\n";
+ fprintf oc "{\n";
+ fprintf oc " alarm(60);\n";
+ for i = 1 to !function_counter do
+ fprintf oc " call_f%d();\n" i
+ done;
+ fprintf oc " return failed;\n";
+ fprintf oc "}\n"
+
+(* Generate interesting function signatures *)
+
+let all_ty =
+ [| Int8u; Int8s; Int16u; Int16s; Int32; Int64; Float32; Float64; String |]
+
+let base_ty =
+ [| Int32; Int64; Float32; Float64 |]
+
+let makerun pat len =
+ let rec make i l =
+ if l <= 0
+ then []
+ else pat.(i) :: make ((i + 1) mod (Array.length pat)) (l - 1)
+ in make 0 len
+
+let gen_fixed_sigs f =
+ (* All possible return types *)
+ Array.iter
+ (fun ty -> f { args = []; varargs = []; res = Some ty })
+ all_ty;
+ (* All possible argument types *)
+ Array.iter
+ (fun ty -> f { args = [ty]; varargs = []; res = None })
+ all_ty;
+ (* 2 arguments of base types *)
+ Array.iter
+ (fun ty1 ->
+ Array.iter
+ (fun ty2 -> f { args = [ty1; ty2]; varargs = []; res = None })
+ base_ty)
+ base_ty;
+ (* 3 arguments of base types *)
+ Array.iter
+ (fun ty1 ->
+ Array.iter
+ (fun ty2 ->
+ Array.iter
+ (fun ty3 -> f { args = [ty1; ty2; ty3]; varargs = []; res = None })
+ base_ty)
+ base_ty)
+ base_ty;
+ (* 4 arguments of base types *)
+ Array.iter
+ (fun ty1 ->
+ Array.iter
+ (fun ty2 ->
+ Array.iter
+ (fun ty3 ->
+ Array.iter
+ (fun ty4 ->
+ f { args = [ty1; ty2; ty3; ty4]; varargs = []; res = None })
+ base_ty)
+ base_ty)
+ base_ty)
+ base_ty;
+ (* Runs of 6, 8, 10, 12, 16, 32 arguments of various patterns *)
+ Array.iter
+ (fun pat ->
+ Array.iter
+ (fun len ->
+ f { args = makerun pat len; varargs = []; res = None })
+ [| 6;8;10;12;16;32 |])
+ [| [|Int32|]; [|Int64|]; [|Float32|]; [|Float64|];
+ [|Int32;Int64|]; [|Int32;Float32|]; [|Int32;Float64|];
+ [|Int64;Float32|]; [|Int64;Float64|]; [|Float32;Float64|];
+ [|Int32;Int64;Float32;Float64|]
+ |]
+
+let split_list l n =
+ let rec split l n accu =
+ if n <= 0 then (List.rev accu, l) else
+ match l with
+ | [] -> assert false
+ | h :: t -> split t (n - 1) (h :: accu)
+ in split l n []
+
+let is_vararg_type = function
+ | Int32 | Int64 | Float64 | String -> true
+ | _ -> false
+
+let gen_vararg_sigs f =
+ let make_vararg sg n =
+ if List.length sg.args > n then begin
+ let (fixed, varia) = split_list sg.args n in
+ if List.for_all is_vararg_type varia
+ && is_vararg_type (List.nth fixed (n - 1)) then
+ f { args = fixed; varargs = varia; res = sg.res }
+ end
+ in
+ gen_fixed_sigs
+ (fun sg -> make_vararg sg 2; make_vararg sg 6; make_vararg sg 14)
+
+(* Generate interesting struct types *)
+
+let struct_counter = ref 0
+
+let mkstruct oc members =
+ incr struct_counter;
+ let id = !struct_counter in
+ declare_struct oc id members;
+ Struct(id, members)
+
+let member_ty =
+ [| Int8u; Int16u; Int32; Int64; Float32; Float64 |]
+
+let gen_structs oc f =
+ (* One field of any type *)
+ Array.iter
+ (fun ty -> f (mkstruct oc [("a", ty)]))
+ all_ty;
+ (* Two fields of interesting types *)
+ Array.iter
+ (fun ty1 ->
+ Array.iter
+ (fun ty2 -> f (mkstruct oc [("a", ty1); ("b", ty2)]))
+ member_ty)
+ member_ty;
+ (* 3, 4, 6, 8 fields of identical interesting type *)
+ Array.iter
+ (fun ty ->
+ f (mkstruct oc [("a", ty); ("b", ty); ("c", ty)]);
+ f (mkstruct oc [("a", ty); ("b", ty); ("c", ty); ("d", ty)]);
+ f (mkstruct oc [("a", ty); ("b", ty); ("c", ty); ("d", ty);
+ ("e", ty); ("f", ty)]);
+ f (mkstruct oc [("a", ty); ("b", ty); ("c", ty); ("d", ty);
+ ("e", ty); ("f", ty); ("g", ty); ("h", ty)]))
+ member_ty
+
+let gen_struct_sigs oc f =
+ let make ty =
+ (* Struct return *)
+ f { args = []; varargs = []; res = Some ty };
+ (* Struct passing (once, twice) *)
+ f { args = [ty]; varargs = []; res = None };
+ f { args = [ty;ty]; varargs = []; res = None };
+ (* Struct passing mixed with scalar arguments *)
+ f { args = [Int32;ty]; varargs = []; res = None };
+ f { args = [Float64;ty]; varargs = []; res = None }
+ in
+ gen_structs oc make
+
+(* Random generation *)
+
+let pick arr =
+ arr.(Random.int (Array.length arr))
+
+let big_ty = [| Int32; Int64; Float32; Float64; String |]
+
+let vararg_ty = [| Int32; Int64; Float64; String |]
+
+let random_funsig vararg =
+ let res = if Random.bool() then Some (pick all_ty) else None in
+ let numargs = Random.int 12 in
+ let args = List.init numargs (fun _ -> pick big_ty) in
+ let numvarargs =
+ if vararg && numargs > 0 && is_vararg_type (List.nth args (numargs - 1))
+ then 1 + Random.int 12
+ else 0 in
+ let varargs = List.init numvarargs (fun _ -> pick vararg_ty) in
+ { args; varargs; res }
+
+let header =
+{|#include <stdarg.h>
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+|}
+
+let checking_code = {|
+extern int failed;
+
+static void failure(const char * assertion, const char * file,
+ int line, const char * fn)
+{
+ fprintf(stderr, "%s:%d:%s: assertion %s failed\n", file, line, fn, assertion);
+ failed = 1;
+}
+
+#define check(expr) ((expr) ? (void)0 : failure(#expr,__FILE__,__LINE__,__func__))
+|}
+
+let output_prefix = ref "abifuzz"
+let gen_vararg = ref false
+let gen_struct = ref false
+let num_random = ref 0
+
+let _ =
+ Arg.parse [
+ "-plain", Arg.Unit (fun () -> gen_vararg := false; gen_struct := false),
+ " generate fixed-argument functions without structs";
+ "-vararg", Arg.Set gen_vararg,
+ " generate variable-argument functions";
+ "-structs", Arg.Set gen_struct,
+ " generate functions that exchange structs";
+ "-o", Arg.String (fun s -> output_prefix := s),
+ " <prefix> produce <prefix>.h, <prefix>def.c and <prefix>use.c files";
+ "-rnd", Arg.Int (fun n -> num_random := n),
+ " <num> produce <num> extra functions with random signatures";
+ "-seed", Arg.Int Random.init,
+ " <seed> use the given seed for randomization"
+ ]
+ (fun s -> raise (Arg.Bad ("don't know what to do with " ^ s)))
+ "Usage: generator [options]\n\nOptions are:";
+ let oc0 = open_out (!output_prefix ^ "_decl.h")
+ and oc1 = open_out (!output_prefix ^ "_def.c")
+ and oc2 = open_out (!output_prefix ^ "_use.c") in
+ fprintf oc0 "%s\n%s\n" header checking_code;
+ fprintf oc1 "%s#include \"%s_decl.h\"\n\n" header !output_prefix;
+ fprintf oc2 "%s#include \"%s_decl.h\"\n\nint failed = 0;\n\n"
+ header !output_prefix;
+ let cont = generate_one_test oc0 oc1 oc2 in
+ if !gen_vararg then gen_vararg_sigs cont
+ else if !gen_struct then gen_struct_sigs oc0 cont
+ else gen_fixed_sigs cont;
+ for i = 1 to !num_random do
+ cont (random_funsig !gen_vararg)
+ done;
+ call_all_test oc2;
+ close_out oc0; close_out oc1; close_out oc2
diff --git a/test/abi/genlayout.ml b/test/abi/genlayout.ml
new file mode 100644
index 00000000..5c26ca35
--- /dev/null
+++ b/test/abi/genlayout.ml
@@ -0,0 +1,158 @@
+open Printf
+
+type typ = Bool | Char | Short | Int
+
+type field =
+ | Plain of typ
+ | Bitfield of typ * int
+ | Padding of typ * int
+
+type struct_ = field list
+
+(* Concise description of a struct *)
+
+let print_typ oc = function
+ | Bool -> fprintf oc "b"
+ | Char -> fprintf oc "c"
+ | Short -> fprintf oc "s"
+ | Int -> fprintf oc "i"
+
+let print_padding_typ oc = function
+ | Bool -> fprintf oc "B"
+ | Char -> fprintf oc "C"
+ | Short -> fprintf oc "S"
+ | Int -> fprintf oc "I"
+
+let print_field oc = function
+ | Plain t -> print_typ oc t
+ | Bitfield(t, w) -> fprintf oc "%a%d" print_typ t w
+ | Padding(t, w) -> fprintf oc "%a%d" print_padding_typ t w
+
+let rec print_struct oc = function
+ | [] -> ()
+ | f :: s -> print_field oc f; print_struct oc s
+
+(* Printing a struct in C syntax *)
+
+let c_typ oc = function
+ | Bool -> fprintf oc "_Bool"
+ | Char -> fprintf oc "char"
+ | Short -> fprintf oc "short"
+ | Int -> fprintf oc "int"
+
+let c_name oc n = fprintf oc "%c" (Char.chr (Char.code 'a' + n))
+
+let c_field oc n = function
+ | Plain t ->
+ fprintf oc " %a %a;\n" c_typ t c_name n;
+ n + 1
+ | Bitfield(t, w) ->
+ fprintf oc " %a %a:%d;\n" c_typ t c_name n w;
+ n + 1
+ | Padding(t, w) ->
+ fprintf oc " %a :%d;\n" c_typ t w;
+ n
+
+let c_struct oc s =
+ fprintf oc "struct %a {\n" print_struct s;
+ let rec c_str n = function
+ | [] -> ()
+ | f :: s -> let n' = c_field oc n f in c_str n' s in
+ c_str 0 s;
+ fprintf oc "};\n"
+
+(* Random generation of structs *)
+
+let random_1_8 () =
+ let n1 = Random.bits() in
+ let n2 = n1 lsr 2 in
+ match n1 land 3 with
+ | 0 -> 1
+ | 1 -> 2 + (n2 land 1) (* 2-3 *)
+ | 2 -> 4 + (n2 land 1) (* 4-5 *)
+ | 3 -> 6 + (n2 mod 3) (* 6-8 *)
+ | _ -> assert false
+
+let random_1_16 () =
+ let n1 = Random.bits() in
+ let n2 = n1 lsr 2 in
+ match n1 land 3 with
+ | 0 -> 1 + (n2 land 1) (* 1-2 *)
+ | 1 -> 3 + (n2 mod 3) (* 3-4-5 *)
+ | 2 -> 6 + (n2 land 3) (* 6-7-8-9 *)
+ | 3 -> 10 + (n2 mod 7) (* 10-16 *)
+ | _ -> assert false
+
+let random_1_32 () =
+ let n1 = Random.bits() in
+ let n2 = n1 lsr 2 in
+ match n1 land 3 with
+ | 0 -> 1 + (n2 land 1) (* 1-2 *)
+ | 1 -> 3 + (n2 mod 5) (* 3-4-5-6-7 *)
+ | 2 -> 8 + (n2 mod 8) (* 8-15 *)
+ | 3 -> 16 + (n2 mod 17) (* 16-32 *)
+ | _ -> assert false
+
+let random_field () =
+ let (t, w) =
+ match Random.int 9 with
+ | 0 -> (Bool, 1)
+ | 1|2 -> (Char, random_1_8())
+ | 3|4 -> (Short, random_1_16())
+ | _ -> (Int, random_1_32()) in
+ match Random.int 10 with
+ | 0 -> Padding(t, (if Random.int 3 = 0 then 0 else w))
+ | 1 | 2 -> Plain t
+ | _ -> Bitfield(t, w)
+
+let rec random_struct len =
+ if len <= 0 then [] else begin
+ let f = random_field () in
+ f :: random_struct (match f with Padding _ -> len | _ -> len - 1)
+ end
+
+(* Optional filtering of structs where padding fields can increase alignment.
+ ELF says that padding fields are ignored to determine struct alignment,
+ but ARM does otherwise. *)
+
+let alignof = function Bool -> 1 | Char -> 1 | Short -> 2 | Int -> 4
+
+let unstable_alignment str =
+ let rec alignments al_data al_padding = function
+ | [] ->
+ al_padding > al_data
+ | (Plain t | Bitfield(t, _)) :: l ->
+ alignments (max (alignof t) al_data) al_padding l
+ | Padding(t, _) :: l ->
+ alignments al_data (max (alignof t) al_padding) l
+ in
+ alignments 1 1 str
+
+(* Random testing *)
+
+let structsize = ref 4
+let ntests = ref 1000
+let stable = ref false
+
+let _ =
+ Arg.parse [
+ "-size", Arg.Int (fun n -> structsize := n),
+ " <sz> produce structs with <sz> members (default: 4)";
+ "-n", Arg.Int (fun n -> ntests := n),
+ " <num> produce <num> random structs";
+ "-seed", Arg.Int Random.init,
+ " <seed> use the given seed for randomization";
+ "-stable", Arg.Set stable,
+ " don't generate padding fields that could cause differences in alignment"
+ ]
+ (fun s -> raise (Arg.Bad ("don't know what to do with " ^ s)))
+ "Usage: genlayout [options]\n\nOptions are:";
+ for _i = 1 to !ntests do
+ let s = random_struct !structsize in
+ if not (!stable && unstable_alignment s) then begin
+ printf "{\n";
+ c_struct stdout s;
+ printf "TEST%d(%a)\n" !structsize print_struct s;
+ printf "}\n"
+ end
+ done
diff --git a/test/abi/layout.c b/test/abi/layout.c
new file mode 100644
index 00000000..ebc6a2b2
--- /dev/null
+++ b/test/abi/layout.c
@@ -0,0 +1,59 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "../endian.h"
+
+static inline int bit(void * p, unsigned bitno)
+{
+ unsigned byteno = bitno / 8;
+#ifdef ARCH_BIG_ENDIAN
+ unsigned bit_in_byte = 7 - (bitno & 7);
+#else
+ unsigned bit_in_byte = bitno & 7;
+#endif
+ return (((unsigned char *) p)[byteno] >> bit_in_byte) & 1;
+}
+
+void print_prologue(char * name, size_t al, size_t sz)
+{
+ printf("%s: align %d, sizeof %d, layout", name, (int)al, (int)sz);
+}
+
+void print_next_field(_Bool first, size_t sz, void * p)
+{
+ static unsigned pos;
+
+ if (first) pos = 0;
+ /* Find first bit set, starting with [pos] */
+ while (1) {
+ assert (pos < 8 * sz);
+ if (bit(p, pos)) break;
+ pos += 1;
+ }
+ /* Print this position */
+ printf(" %u", pos);
+ /* Skip over one bits */
+ while (pos < 8 * sz && bit(p, pos)) pos++;
+}
+
+void print_epilogue(void)
+{
+ printf("\n");
+}
+
+#define TEST4(s) \
+ struct s x; \
+ memset(&x, 0, sizeof(x)); \
+ print_prologue(#s, _Alignof(struct s), sizeof(x)); \
+ x.a = -1; print_next_field(1, sizeof(x), &x); \
+ x.b = -1; print_next_field(0, sizeof(x), &x); \
+ x.c = -1; print_next_field(0, sizeof(x), &x); \
+ x.d = -1; print_next_field(0, sizeof(x), &x); \
+ print_epilogue();
+
+int main()
+{
+#include "layout.h"
+ return 0;
+}
diff --git a/test/abi/staticlayout.c b/test/abi/staticlayout.c
new file mode 100644
index 00000000..8a655afc
--- /dev/null
+++ b/test/abi/staticlayout.c
@@ -0,0 +1,76 @@
+#include <stdio.h>
+#include "../endian.h"
+
+static inline int bit(void * p, unsigned bitno)
+{
+ unsigned byteno = bitno / 8;
+#ifdef ARCH_BIG_ENDIAN
+ unsigned bit_in_byte = 7 - (bitno & 7);
+#else
+ unsigned bit_in_byte = bitno & 7;
+#endif
+ return (((unsigned char *) p)[byteno] >> bit_in_byte) & 1;
+}
+
+void print_prologue(char * name, size_t al, size_t sz)
+{
+ printf("%s: align %d, sizeof %d, layout", name, (int)al, (int)sz);
+}
+
+#if 0
+void print_contents(size_t sz, void * p)
+{
+ int last, lastpos;
+ printf(" - ");
+ last = 0; lastpos = 0;
+ for (int i = 0; i < sz; i++) {
+ for (int b = 0; b < 8; b++) {
+ int curr = bit((char *) p + i, b);
+ int currpos = i * 8 + b;
+ if (curr != last) {
+ if (currpos > lastpos) {
+ printf("%d(%d)", last, currpos - lastpos);
+ }
+ last = curr; lastpos = currpos;
+ }
+ }
+ }
+ { int currpos = sz * 8;
+ if (currpos > lastpos) {
+ printf("%d(%d)", last, currpos - lastpos);
+ }
+ }
+}
+#else
+void print_contents(size_t sz, void * p)
+{
+ printf(" - ");
+ for (int i = 0; i < sz; i++) {
+ printf("%02x", ((unsigned char *)p)[i]);
+ }
+}
+#endif
+
+void print_epilogue (void)
+{
+ printf("\n");
+}
+
+
+#define TEST4(s) \
+ static struct s x1 = {-1, 0, 0, 0}; \
+ static struct s x2 = {-1, -1, 0, 0}; \
+ static struct s x3 = {-1, 0, -1, 0}; \
+ static struct s x4 = {-1, -1, -1, -1}; \
+ print_prologue(#s, _Alignof(struct s), sizeof(x1)); \
+ print_contents(sizeof(x1), &x1); \
+ print_contents(sizeof(x2), &x2); \
+ print_contents(sizeof(x3), &x3); \
+ print_contents(sizeof(x4), &x4); \
+ print_epilogue();
+
+int main()
+{
+#include "layout.h"
+ return 0;
+}
generated by cgit (git 2.34.1) at 2024-06-18 11:37:33 +0000