From 02ce84fd959bf67afc6999eaeecef78ccdf57c71 Mon Sep 17 00:00:00 2001
From: Alex Nelson <ajnelson@cs.ucsc.edu>
Date: Tue, 6 Sep 2011 09:27:51 -0700
Subject: [PATCH] generator: Add new return type to ABI: RLenValue

RLenValue is are similar to RLenType, though with one less argument.
This required adding one processing function for OCaml and Python.

Signed-off-by: Alex Nelson <ajnelson@cs.ucsc.edu>
---
 generator/generator.ml |   69 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 69 insertions(+), 0 deletions(-)

diff --git a/generator/generator.ml b/generator/generator.ml
index b6fb8b3..2703023 100755
--- a/generator/generator.ml
+++ b/generator/generator.ml
@@ -51,6 +51,7 @@ and ret =
   | RNodeList                           (* Returns hive_node_h* or NULL. *)
   | RValue                              (* Returns hive_value_h or 0. *)
   | RValueList                          (* Returns hive_value_h* or NULL. *)
+  | RLenValue                           (* See value_struct_length. *)
   | RString                             (* Returns char* or NULL. *)
   | RStringList                         (* Returns char** or NULL. *)
   | RLenType                            (* See hivex_value_type. *)
@@ -890,6 +891,7 @@ and generate_c_prototype ?(extern = false) name style =
    | RValueList -> pr "hive_value_h *"
    | RString -> pr "char *"
    | RStringList -> pr "char **"
+   | RLenValue -> pr "hive_value_h "
    | RLenType -> pr "int "
    | RLenTypeVal -> pr "char *"
    | RInt32 -> pr "int32_t "
@@ -911,6 +913,7 @@ and generate_c_prototype ?(extern = false) name style =
   ) (snd style);
   (match fst style with
    | RLenType | RLenTypeVal -> pr ", hive_type *t, size_t *len"
+   | RLenValue -> pr ", size_t *len"
    | _ -> ()
   );
   pr ");\n"
@@ -1113,6 +1116,10 @@ On error this returns NULL and sets errno.\n\n"
            pr "\
 Returns 0 on success.
 On error this returns -1 and sets errno.\n\n"
+       | RLenValue ->
+           pr "\
+Returns a positive number on success.
+On error this returns 0 and sets errno.\n\n"
        | RLenTypeVal ->
            pr "\
 The value is returned as an array of bytes (of length C<len>).
@@ -1624,6 +1631,7 @@ and generate_ocaml_prototype ?(is_external = false) name style =
    | RString -> pr "string"
    | RStringList -> pr "string array"
    | RLenType -> pr "hive_type * int"
+   | RLenValue -> pr "value"
    | RLenTypeVal -> pr "hive_type * string"
    | RInt32 -> pr "int32"
    | RInt64 -> pr "int64"
@@ -1687,6 +1695,7 @@ static hive_type HiveType_val (value);
 static value Val_hive_type (hive_type);
 static value copy_int_array (size_t *);
 static value copy_type_len (size_t, hive_type);
+static value copy_len (size_t);
 static value copy_type_value (const char *, size_t, hive_type);
 static void raise_error (const char *) Noreturn;
 static void raise_closed (const char *) Noreturn;
@@ -1709,6 +1718,7 @@ static void raise_closed (const char *) Noreturn;
       let c_params =
         match fst style with
         | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
+        | RLenValue -> c_params @ [["&len"]]
         | _ -> c_params in
       let c_params = List.concat c_params in
 
@@ -1781,6 +1791,10 @@ static void raise_closed (const char *) Noreturn;
             pr "  size_t len;\n";
             pr "  hive_type t;\n";
             "-1"
+        | RLenValue ->
+            pr "  int r;\n";
+            pr "  size_t len;\n";
+            "0"
         | RLenTypeVal ->
             pr "  char *r;\n";
             pr "  size_t len;\n";
@@ -1861,6 +1875,7 @@ static void raise_closed (const char *) Noreturn;
            pr "  for (int i = 0; r[i] != NULL; ++i) free (r[i]);\n";
            pr "  free (r);\n"
        | RLenType -> pr "  rv = copy_type_len (len, t);\n"
+       | RLenValue -> pr "  rv = copy_len (len);\n"
        | RLenTypeVal ->
            pr "  rv = copy_type_value (r, len, t);\n";
            pr "  free (r);\n"
@@ -1983,6 +1998,18 @@ copy_type_len (size_t len, hive_type t)
 }
 
 static value
+copy_len (size_t len)
+{
+  CAMLparam0 ();
+  CAMLlocal2 (v, rv);
+
+  rv = caml_alloc (1, 0);
+  v = Val_int (len);
+  Store_field (rv, 0, v);
+  CAMLreturn (rv);
+}
+
+static value
 copy_type_value (const char *r, size_t len, hive_type t)
 {
   CAMLparam0 ();
@@ -2172,6 +2199,7 @@ sub open {
 	 | RString
 	 | RStringList
 	 | RLenType
+	 | RLenValue
 	 | RLenTypeVal
 	 | RInt32
 	 | RInt64 -> ()
@@ -2246,6 +2274,7 @@ and generate_perl_prototype name style =
    | RString -> pr "$string = "
    | RStringList -> pr "@strings = "
    | RLenType -> pr "($type, $len) = "
+   | RLenValue -> pr "($len) = "
    | RLenTypeVal -> pr "($type, $data) = "
    | RInt32 -> pr "$int32 = "
    | RInt64 -> pr "$int64 = "
@@ -2469,6 +2498,7 @@ DESTROY (h)
 	 | RValueList
 	 | RStringList
 	 | RLenType
+	 | RLenValue
 	 | RLenTypeVal -> pr "void\n"
 	 | RInt32 -> pr "SV *\n"
 	 | RInt64 -> pr "SV *\n"
@@ -2641,6 +2671,20 @@ DESTROY (h)
 	     pr "      PUSHs (sv_2mortal (newSViv (type)));\n";
 	     pr "      PUSHs (sv_2mortal (newSViv (len)));\n";
 
+	 | RLenValue ->
+	     pr "PREINIT:\n";
+	     pr "      int r;\n";
+	     pr "      size_t len;\n";
+	     pr " PPCODE:\n";
+             pr "      r = hivex_%s (%s, &len);\n"
+	       name (String.concat ", " c_params);
+	     free_args ();
+             pr "      if (r == 0)\n";
+             pr "        croak (\"%%s: \", \"%s\", strerror (errno));\n"
+	       name;
+	     pr "      EXTEND (SP, 2);\n";
+	     pr "      PUSHs (sv_2mortal (newSViv (len)));\n";
+
 	 | RLenTypeVal ->
 	     pr "PREINIT:\n";
 	     pr "      char *r;\n";
@@ -2879,6 +2923,14 @@ put_len_type (size_t len, hive_type t)
 }
 
 static PyObject *
+put_len (size_t len)
+{
+  PyObject *r = PyTuple_New (1);
+  PyTuple_SetItem (r, 0, PyLong_FromLongLong ((long) len));
+  return r;
+}
+
+static PyObject *
 put_val_type (char *val, size_t len, hive_type t)
 {
   PyObject *r = PyTuple_New (2);
@@ -2918,6 +2970,10 @@ put_val_type (char *val, size_t len, hive_type t)
             pr "  size_t len;\n";
             pr "  hive_type t;\n";
             "-1"
+        | RLenValue ->
+            pr "  int r;\n";
+            pr "  size_t len;\n";
+            "0"
         | RLenTypeVal ->
             pr "  char *r;\n";
             pr "  size_t len;\n";
@@ -2942,6 +2998,7 @@ put_val_type (char *val, size_t len, hive_type t)
       let c_params =
         match fst style with
         | RLenType | RLenTypeVal -> c_params @ ["&t"; "&len"]
+        | RLenValue -> c_params @ ["&len"]
         | _ -> c_params in
 
       List.iter (
@@ -3086,6 +3143,8 @@ put_val_type (char *val, size_t len, hive_type t)
            pr "  free_strings (r);\n"
        | RLenType ->
            pr "  py_r = put_len_type (len, t);\n"
+       | RLenValue ->
+           pr "  py_r = put_len (len);\n"
        | RLenTypeVal ->
            pr "  py_r = put_val_type (r, len, t);\n";
            pr "  free (r);\n"
@@ -3296,6 +3355,7 @@ get_values (VALUE valuesv, size_t *nr_values)
           | RString -> "string"
           | RStringList -> "list"
           | RLenType -> "hash"
+          | RLenValue -> "integer"
           | RLenTypeVal -> "hash"
           | RInt32 -> "integer"
           | RInt64 -> "integer" in
@@ -3394,6 +3454,10 @@ get_values (VALUE valuesv, size_t *nr_values)
             pr "  size_t len;\n";
             pr "  hive_type t;\n";
             "-1"
+        | RLenValue ->
+            pr "  int r;\n";
+            pr "  size_t len;\n";
+            "0"
         | RLenTypeVal ->
             pr "  char *r;\n";
             pr "  size_t len;\n";
@@ -3418,6 +3482,7 @@ get_values (VALUE valuesv, size_t *nr_values)
       let c_params =
         match ret with
         | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
+        | RLenValue -> c_params @ [["&len"]]
         | _ -> c_params in
       let c_params = List.concat c_params in
 
@@ -3499,6 +3564,10 @@ get_values (VALUE valuesv, size_t *nr_values)
         pr "  rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
         pr "  rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
         pr "  return rv;\n"
+      | RLenValue ->
+        pr "  VALUE rv = rb_hash_new ();\n";
+        pr "  rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
+        pr "  return rv;\n"
       | RLenTypeVal ->
         pr "  VALUE rv = rb_hash_new ();\n";
         pr "  rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
-- 
1.7.4.4

