gen_service: change code generation strategy to avoid big switches

See mirage#106: the gigantic
pattern-matching in the code generated by gen_service.ml hit code
generation bug on ARM backends.

The new code only generate large arrays (these could easily be split
if further issues were reported), and uses dichotomic search on sorted
array to map services to ports and conversely.

On my (x86_64) machine, build time changes from 45s to 4.5s.

config/gen_services.ml

@@ -51,46 +51,53 @@ let _ =
         |"tcp" ->
           List.iter (fun svc ->
             hashtbl_add_list tcp_ports svc port;
-            hashtbl_add_list ports_tcp port ("\""^svc^"\"");
+            hashtbl_add_list ports_tcp port svc;
             Hashtbl.replace tcp_services svc ()
           ) (svc::aliases)
         |"udp" ->
           List.iter (fun svc ->
             hashtbl_add_list udp_ports svc port;
-            hashtbl_add_list ports_udp port ("\""^svc^"\"");
+            hashtbl_add_list ports_udp port svc;
             Hashtbl.replace udp_services svc ();
           ) (svc::aliases)
         |"ddp" | "sctp" | "divert" -> ()
         |x -> failwith ("unknown proto " ^ x)
       )
   done with End_of_file -> ());
+  let print_keys quote ppf table =
+    iter (fun k _v -> fprintf ppf ("%s; ") (quote k)) table in
+  let print_values quote ppf table =
+    iter (fun _k v -> fprintf ppf "[ %s ]; "
+             (String.concat "; " (List.map quote !v))) table in
+  let quote_string s = sprintf "%S" s in
   printf "(* Autogenerated by gen_services.ml, do not edit directly *)\n";
-  printf "let tcp_port_of_service = function\n";
-  iter (fun k v ->
-   printf "  |\"%s\" -> [%s]\n" k (String.concat ";" (List.map string_of_int !v))
-  ) tcp_ports;
-  printf "  |_ -> []\n\n";
-   printf "let udp_port_of_service = function\n";
-  iter (fun k v ->
-   printf "  |\"%s\" -> [%s]\n" k (String.concat ";" (List.map string_of_int !v))
-  ) udp_ports;
-  printf "  |_ -> []\n\n";
-  printf "let service_of_tcp_port = function\n";
-  iter (fun k v ->
-   printf "  |%d -> [%s]\n" k (String.concat ";" !v)
-  ) ports_tcp;
-  printf "  |_ -> []\n\n";
-   printf "let service_of_udp_port = function\n";
-  iter (fun k v ->
-   printf "  |%d -> [%s]\n" k (String.concat ";" !v)
-  ) ports_udp;
-  let tcp_services = Hashtbl.fold (fun k () a -> ("\""^k^"\"") :: a) tcp_services [] in
-  let udp_services = Hashtbl.fold (fun k () a -> ("\""^k^"\"") :: a) udp_services [] in
-  printf "  |_ -> []\n\n";
-  printf "let known_tcp_services =\n";
-  printf "  [ %s ]\n\n" (String.concat ";" tcp_services);
-  printf "let known_udp_services =\n";
-  printf "  [ %s ]\n\n" (String.concat ";" udp_services);
+
+  printf "let tcp_port_of_service_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys quote_string) tcp_ports
+    (print_values string_of_int) tcp_ports;
+
+  printf "let udp_port_of_service_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys quote_string) udp_ports
+    (print_values string_of_int) udp_ports;
+
+  printf "let service_of_tcp_port_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys string_of_int) ports_tcp
+    (print_values quote_string) ports_tcp;
+
+  printf "let service_of_udp_port_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys string_of_int) ports_udp
+    (print_values quote_string) ports_udp;
+
+  let hashset_elems table =
+    Hashtbl.fold (fun k () a -> quote_string k :: a) table []
+    |> List.sort String.compare
+    |> String.concat "; "
+  in
+  printf "let known_tcp_services =\n  [ %s ]\n\n"
+    (hashset_elems tcp_services);
+  printf "let known_udp_services =\n [ %s ]\n\n"
+    (hashset_elems udp_services);
+
   printf "let known_services = [\n";
   printf "  (\"tcp\", known_tcp_services);\n";
   printf "  (\"udp\", known_udp_services) ]\n\n";

etc/uri_services_raw.ml

@@ -1,3 +1,44 @@
+let search_string keys k =
+  let rec loop keys k low high =
+    if low > high then (-1)
+    else begin
+      let mid = (high + low) / 2 in
+      let diff = String.compare k keys.(mid) in
+      if diff < 0 then loop keys k low (mid - 1)
+      else if diff > 0 then loop keys k (mid + 1) high
+      else mid
+    end
+  in loop keys k 0 (Array.length keys - 1)
+
+let search_int keys k =
+  let rec loop keys k low high =
+    if low > high then (-1)
+    else begin
+      let mid = (high + low) / 2 in
+      let diff = k - keys.(mid) in
+      if diff < 0 then loop keys k low (mid - 1)
+      else if diff > 0 then loop keys k (mid + 1) high
+      else mid
+    end
+  in loop keys k 0 (Array.length keys - 1)
+
+let lookup search (keys, values) k =
+  let i = search keys k in
+  if i < 0 then []
+  else values.(i)
+
+let service_of_tcp_port p =
+  lookup search_int service_of_tcp_port_tables p
+
+let service_of_udp_port p =
+  lookup search_int service_of_udp_port_tables p
+
+let tcp_port_of_service s =
+  lookup search_string tcp_port_of_service_tables s
+
+let udp_port_of_service s =
+  lookup search_string udp_port_of_service_tables s
+
 let port_of_uri ?default lookupfn uri =
   match Uri.port uri with
   |Some port as x -> x