[base] remove C stubs for ioctl in favour of Ctypes

Summary:
C stubs were causing issues with building:
- need OCaml stubs of the C stubs for byte compilation!
- brittle (to remain polite) support in ocamlbuild

Ctypes is awesome, use it instead.

Slight wrinkle on the previous statement:
- ioctl(2) is variable arguments, which is not officially supported by Ctypes but should work in our use-case
- I'm hardcoding the value of a C macro found in system headers

Reviewed By: jberdine

Differential Revision: D4319507

fbshipit-source-id: 352804a

infer/.merlin

@@ -2,6 +2,7 @@ S src/**
 B _build/infer/**
 PKG atdgen
 PKG core
+PKG ctypes
 PKG javalib
 PKG ounit
 PKG ppx_compare

infer/src/Makefile

@@ -50,12 +50,6 @@ OCAMLBUILD_OPTIONS += -quiet
 endif
 
 
-#### Base declaration ####
-
-C_STUBS_SOURCE = stubs/c/stubs.c
-# only one C object for now, the Makefile will need changing if more are added
-C_STUBS_OBJ = $(C_STUBS_SOURCE:.c=.o)
-
 #### Backend declarations ####
 
 INFER_MAIN = backend/infer
@@ -137,10 +131,6 @@ OCAMLBUILD_BASE = rebuild $(OCAMLBUILD_OPTIONS) -j $(NCPU) $(addprefix -I , $(DE
 # ocamlbuild with options necessary to build all targets at once, regardless of configure flags
 OCAMLBUILD_ALL = $(OCAMLBUILD_BASE) $(JAVA_OCAMLBUILD_OPTIONS)
 
-OCAMLBUILD_BYTE_OPTS = -lflags -custom,$(C_STUBS_OBJ) -I stubs/c
-
-OCAMLBUILD_NATIVE_OPTS = -lflags $(C_STUBS_OBJ) -I stubs/c
-
 # list of ocamlbuild targets common to all build targets -- native version
 INFER_BASE_TARGETS = \
   $(C_STUBS_OBJ) \
@@ -174,8 +164,7 @@ all: infer
 
 .PHONY: infer
 infer: init $(STACKTREE_ATDGEN_STUBS) $(INFERPRINT_ATDGEN_STUBS)
-	$(OCAMLBUILD_CONFIG) -build-dir $(INFER_BUILD_DIR) $(OCAMLBUILD_NATIVE_OPTS) \
-	  $(INFER_CONFIG_TARGETS)
+	$(OCAMLBUILD_CONFIG) -build-dir $(INFER_BUILD_DIR) $(INFER_CONFIG_TARGETS)
 	$(INSTALL_PROGRAM) $(INFER_BUILD_DIR)/$(INFER_MAIN).native $(INFER_BIN)
 	$(INSTALL_PROGRAM) $(INFER_BUILD_DIR)/$(INFERANALYZE_MAIN).native $(INFERANALYZE_BIN)
 	$(INSTALL_PROGRAM) $(INFER_BUILD_DIR)/$(INFERPRINT_MAIN).native $(INFERPRINT_BIN)
@@ -194,8 +183,7 @@ endif
 
 .PHONY: byte
 byte: init $(STACKTREE_ATDGEN_STUBS) $(INFERPRINT_ATDGEN_STUBS) $(CLANG_ATDGEN_STUBS) $(INFER_CLANG_FCP_MIRRORED_FILES)
-	$(OCAMLBUILD_ALL) $(OCAMLBUILD_BYTE_OPTS) -build-dir $(INFER_BUILD_DIR) \
-	  $(INFER_ALL_TARGETS:.native=.byte)
+	$(OCAMLBUILD_ALL) -build-dir $(INFER_BUILD_DIR) $(INFER_ALL_TARGETS:.native=.byte)
 
 # to build only the single module <Module> (and its dependencies) with extra flags execute:
 #   make MFLAGS=<flags> M=<Module>.cm{o,x} module
@@ -212,7 +200,7 @@ module: init $(STACKTREE_ATDGEN_STUBS) $(INFERPRINT_ATDGEN_STUBS) $(CLANG_ATDGEN
 
 .PHONY: test_build
 test_build: init $(STACKTREE_ATDGEN_STUBS) $(INFERPRINT_ATDGEN_STUBS) $(CLANG_ATDGEN_STUBS) $(INFER_CLANG_FCP_MIRRORED_FILES)
-	$(OCAMLBUILD_ALL) $(OCAMLBUILD_BYTE_OPTS) -build-dir $(TEST_BUILD_DIR) \
+	$(OCAMLBUILD_ALL) -build-dir $(TEST_BUILD_DIR) \
 	  -cflags -warn-error,$(OCAML_FATAL_WARNINGS) \
 	  $(INFER_ALL_TARGETS:.native=.byte)
 
@@ -234,7 +222,7 @@ rei:
 roots:=Infer InferAnalyzeExe InferClang JMain InferPrintExe StatsAggregator
 clusters:=base clang java IR
 
-ml_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.ml\(i\)*' -not -path facebook/scripts/eradicate_stats.ml -not -path 'stubs/c/*')
+ml_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.ml\(i\)*' -not -path facebook/scripts/eradicate_stats.ml)
 re_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.re\(i\)*')
 inc_flags:=$(foreach dir,$(DEPENDENCIES),-I $(dir))
 root_flags:=$(foreach root,$(roots),-r $(root))
@@ -256,7 +244,7 @@ dsort:
 	@ocamldep.opt -sort $(inc_flags) -ml-synonym .re -mli-synonym .rei $(ml_src_files) -pp refmt $(re_src_files)
 
 roots_grep_regex:=$(foreach root,$(roots),-e $(root)$$)
-dirs_find_regex:=$(foreach dir, $(DEPENDENCIES) stubs/ml,-path "./$(dir)/*" -o)
+dirs_find_regex:=$(foreach dir, $(DEPENDENCIES),-path "./$(dir)/*" -o)
 
 .PHONY: toplevel
 toplevel: init $(STACKTREE_ATDGEN_STUBS) $(INFERPRINT_ATDGEN_STUBS) $(CLANG_ATDGEN_STUBS) $(INFER_CLANG_FCP_MIRRORED_FILES)
@@ -276,7 +264,7 @@ toplevel: init $(STACKTREE_ATDGEN_STUBS) $(INFERPRINT_ATDGEN_STUBS) $(CLANG_ATDG
 	| rev | cut -f 2- -d '.' | rev \
 	| awk 'BEGIN { FS = "/"; OFS = "/" } ; {$$NF=toupper(substr($$NF,1,1))substr($$NF,2); print $$0}' \
 	| grep -v $(roots_grep_regex) > toplevel.mlpack
-	$(OCAMLBUILD_ALL) -I stubs/ml -build-dir $(INFER_BUILD_DIR) toplevel.cmo
+	$(OCAMLBUILD_ALL) -build-dir $(INFER_BUILD_DIR) toplevel.cmo
 
 .PHONY: checkCopyright
 checkCopyright: $(CHECKCOPYRIGHT_BIN)

infer/src/base/CommandLineOption.ml

@@ -144,8 +144,9 @@ let pad_and_xform doc_width left_width desc =
 let align desc_list =
   let min_term_width = 80 in
   let cur_term_width =
-    (* `CStubs.term_width ()` return 0 in case of failure *)
-    max (CStubs.term_width ()) min_term_width in
+    match Lazy.force IOCtl.terminal_width with
+    | Ok width -> width
+    | Error _ -> min_term_width in
   (* 2 blank columns before option + 2 columns of gap between flag and doc *)
   let extra_space = 4 in
   let min_left_width = 15 in

infer/src/base/IOCtl.ml

@@ -0,0 +1,43 @@
+(*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ *)
+
+(** bindings to ioctl(2) that only capture what we need *)
+
+open! IStd
+
+open Ctypes
+
+type winsize
+(* as found in asm-generic/termios.h *)
+let winsize : winsize structure typ = structure "winsize"
+let ws_row = field winsize "ws_row" ushort
+let ws_col = field winsize "ws_col" ushort
+let ws_xpixel = field winsize "ws_xpixel" ushort
+let ws_ypixel = field winsize "ws_ypixel" ushort
+let () = seal winsize
+
+(* as found in asm-generic/ioctls.h *)
+let request_TIOCGWINSZ = Unsigned.ULong.of_int 0x5413
+
+(* ioctl(2) is a variadic function, so cross our fingers that the calling convention works the same
+   as non-variadic functions and define different ioctl_* functions for each need *)
+
+let ioctl_winsize =
+  Foreign.foreign "ioctl"
+    (int @-> ulong @-> ptr winsize @-> returning int)
+
+(** high-level function *)
+let terminal_width = lazy(
+  let winsize = make winsize in
+  let return = ioctl_winsize 0 request_TIOCGWINSZ (addr winsize) in
+  if return >= 0 then
+    Ok (Unsigned.UShort.to_int (getf winsize ws_col))
+  else
+    Error return
+)

infer/src/base/IOCtl.mli

@@ -7,4 +7,8 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-external term_width : unit -> int = "term_width"
+(** bindings to ioctl(2) that only capture what we need *)
+
+open! IStd
+
+val terminal_width : (int, int) Result.t lazy_t

infer/src/stubs/c/CStubs.mli

@@ -1,10 +0,0 @@
-(*
- * Copyright (c) 2016 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-external term_width : unit -> int = "term_width"

infer/src/stubs/c/stubs.c

@@ -1,24 +0,0 @@
-/*
- * Copyright (c) 2016 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- */
-
-#include <sys/ioctl.h>
-#include <caml/mlvalues.h>
-#include <caml/memory.h>
-
-CAMLprim value term_width(value unit) {
-  CAMLparam1(unit);
-
-  struct winsize sz;
-
-  int size = 0;
-  if (ioctl(0, TIOCGWINSZ, &sz) >= 0) {
-    size = sz.ws_col;
-  }
-  CAMLreturn(Val_int(size));
-}

infer/src/stubs/ml/CStubs.ml

@@ -1,15 +0,0 @@
-(*
- * Copyright (c) 2016 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-(** Reimplement C stubs in a simplified way to make it easier to build an Infer toplevel. This is
-    because we don't care about the exact implementation of the C stubs as far as the toplevel
-    goes. *)
-
-
-let term_width () = 80

infer/src/stubs/ml/CStubs.mli

@@ -1,10 +0,0 @@
-(*
- * Copyright (c) 2016 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-val term_width : unit -> int