From c01e771b5fa34a0d9f6972c39ba751b3e64fb9e5 Mon Sep 17 00:00:00 2001
From: malc <moosotc@gmail.com>
Date: Wed, 9 Dec 2015 06:27:44 +0300
Subject: [PATCH] Intel gaphics cards and Mesa 3D keep on giving

This particular quirk (if enabled) halves energy consumed by the GPU
when scrolling (if Vince Weavers code and RAPL [1]) is to be believed.

[1] http://web.eece.maine.edu/~vweaver/projects/rapl/
---
 config.ml |  5 +++++
 link.c    | 48 +++++++++++++++++++++++++++++++++++++++++-------
 main.ml   | 12 +++++-------
 utils.ml  |  2 ++
 wsi.ml    | 12 +++++++-----
 wsi.mli   |  4 +++-
 6 files changed, 63 insertions(+), 20 deletions(-)

diff --git a/config.ml b/config.ml
index 6247a0b..b4189e0 100644
--- a/config.ml
+++ b/config.ml
@@ -282,6 +282,7 @@ type conf =
     ; mutable title          : string
     ; mutable lastvisit      : float
     ; mutable annotinline    : bool
+    ; mutable intel_mesa_quirks : intel_mesa_quirks
     }
 and columns =
     | Csingle of singlecolumn
@@ -555,6 +556,7 @@ let defconf =
   ; title          = E.s
   ; lastvisit      = 0.0
   ; annotinline    = true
+  ; intel_mesa_quirks = false
   ; keyhashes      =
       let mk n = (n, Hashtbl.create 1) in
       [ mk "global"
@@ -1088,6 +1090,7 @@ let config_of c attrs =
       | "title" -> { c with title = unentS v }
       | "last-visit" -> { c with lastvisit = float_of_string v }
       | "edit-annotations-inline" -> { c with annotinline = bool_of_string v }
+      | "intel-mesa-quirks" -> { c with intel_mesa_quirks = bool_of_string v }
       | _ -> c
     with exn ->
       dolog "error processing attribute (`%S' = `%S'): %s" k v @@ exntos exn;
@@ -1206,6 +1209,7 @@ let setconf dst src =
   dst.leftscroll     <- src.leftscroll;
   dst.title          <- src.title;
   dst.annotinline    <- src.annotinline;
+  dst.intel_mesa_quirks <- src.intel_mesa_quirks;
   dst.pax            <-
     if src.pax = None
     then None
@@ -1624,6 +1628,7 @@ let add_attrs bb always dc c time =
   then os "title" c.title dc.title;
   oL "last-visit" (Int64.of_float time) 0L;
   ob "edit-annotations-inline" c.annotinline dc.annotinline;
+  ob "intel-mesa-quirks" c.intel_mesa_quirks dc.intel_mesa_quirks;
 ;;
 
 let keymapsbuf always dc c =
diff --git a/link.c b/link.c
index ccac7d1..f724f76 100644
--- a/link.c
+++ b/link.c
@@ -3905,20 +3905,54 @@ static struct {
     Cursor curs[CURS_COUNT];
 } glx;
 
-CAMLprim value ml_glxinit (value display_v, value wid_v, value screen_v)
+CAMLprim value ml_glxinit (value display_v, value wid_v, value screen_v,
+                           value intel_mesa_quirk_v)
 {
-    CAMLparam3 (display_v, wid_v, screen_v);
-    int attribs[] = { GLX_RGBA,  GLX_DOUBLEBUFFER, None };
+    CAMLparam4 (display_v, wid_v, screen_v, intel_mesa_quirk_v);
 
     glx.dpy = XOpenDisplay (String_val (display_v));
     if (!glx.dpy) {
         caml_failwith ("XOpenDisplay");
     }
 
-    glx.visual = glXChooseVisual (glx.dpy, Int_val (screen_v), attribs);
-    if (!glx.visual) {
-        XCloseDisplay (glx.dpy);
-        caml_failwith ("glXChooseVisual");
+    if (Bool_val (intel_mesa_quirk_v)) {
+        int attribs[] = { GLX_RENDER_TYPE, GLX_RGBA_BIT,
+                          GLX_DOUBLEBUFFER, 1,
+                          None };
+        int fbcount;
+        GLXFBConfig *fbc;
+
+        fbc = glXChooseFBConfig (glx.dpy, Int_val (screen_v),
+                                 attribs, &fbcount);
+        if (fbc) {
+            XVisualInfo *visual;
+
+            for (int i = 0; i < fbcount; ++i) {
+                visual = glXGetVisualFromFBConfig (glx.dpy, fbc[i]);
+                if (!glx.visual) {
+                    glx.visual = visual;
+                }
+                else {
+                    if (visual->depth > glx.visual->depth) {
+                        XFree (glx.visual);
+                        glx.visual = visual;
+                    }
+                }
+            }
+        }
+        else {
+            caml_failwith ("glXChooseFBConfig");
+        }
+        XFree (fbc);
+    }
+    else {
+        int attribs[] = { GLX_RGBA,  GLX_DOUBLEBUFFER, None };
+        glx.visual = glXChooseVisual (glx.dpy, Int_val (screen_v), attribs);
+        if (!glx.visual) {
+            XCloseDisplay (glx.dpy);
+            caml_failwith ("glXChooseVisual");
+        }
+
     }
 
     for (size_t n = 0; n < CURS_COUNT; ++n) {
diff --git a/main.ml b/main.ml
index 74d2432..6b73beb 100644
--- a/main.ml
+++ b/main.ml
@@ -3960,6 +3960,9 @@ let enterinfomode =
       src#bool "edit annotations inline"
         (fun () -> conf.annotinline)
         (fun v -> conf.annotinline <- v);
+      src#bool "Quirks for Intel graphics card driven by Mesa 3D"
+        (fun () -> conf.intel_mesa_quirks)
+        (fun v -> conf.intel_mesa_quirks <- v);
     );
 
     sep ();
@@ -6459,7 +6462,7 @@ let () =
     method leave = state.mpos <- (-1, -1)
     method winstate wsl = state.winstate <- wsl
     method quit = raise Quit
-  end) !rootwid conf.cwinw conf.cwinh platform in
+  end) !rootwid conf.cwinw conf.cwinh platform conf.intel_mesa_quirks in
 
   state.wsfd <- wsfd;
 
@@ -6471,12 +6474,7 @@ let () =
   )
   then (dolog "OpenGL does not suppport rectangular textures"; exit 1);
 
-  if (
-    let r = GlMisc.get_string `renderer in
-    let p = "Mesa DRI Intel(" in
-    let l = String.length p in
-    String.length r > l && String.sub r 0 l = p
-  )
+  if conf.intel_mesa_quirks
   then (
     defconf.sliceheight <- 1024;
     defconf.texcount <- 32;
diff --git a/utils.ml b/utils.ml
index 76094e4..9051b3d 100644
--- a/utils.ml
+++ b/utils.ml
@@ -1,3 +1,5 @@
+type intel_mesa_quirks = bool;;
+
 module E = struct
   let s = "";;
   let b = Bytes.empty;;
diff --git a/wsi.ml b/wsi.ml
index b90e337..3b2d947 100644
--- a/wsi.ml
+++ b/wsi.ml
@@ -23,8 +23,10 @@ type visiblestate =
 ;;
 
 type wid = int and screenno = int and vid = int and atom = int;;
+type intel_mesa_quirk = bool;;
 
-external glxinit : string -> wid -> screenno -> vid = "ml_glxinit";;
+external glxinit : string -> wid -> screenno -> intel_mesa_quirk -> vid
+  = "ml_glxinit";;
 external glxcompleteinit : unit -> unit = "ml_glxcompleteinit";;
 external swapb : unit -> unit = "ml_swapb";;
 external setcursor : cursor -> unit = "ml_setcursor";;
@@ -726,7 +728,7 @@ let syncsendintern sock secstowait s onlyifexists f =
   syncsendwithrep sock secstowait s f;
 ;;
 
-let setup disp sock rootwid screennum w h =
+let setup disp sock rootwid screennum w h intel_mesa_quirk =
   let s = readstr sock 2 in
   let n = Bytes.length s in
   if n != 2
@@ -806,7 +808,7 @@ let setup disp sock rootwid screennum w h =
       state.wid <- wid;
       state.fid <- fid;
 
-      let vid = glxinit disp wid screennum in
+      let vid = glxinit disp wid screennum intel_mesa_quirk in
       let ndepths = r8 data (pos+39) in
       let rec finddepth n' pos =
         if n' = ndepths
@@ -1105,7 +1107,7 @@ let getauth haddr dnum =
        E.s, E.s
 ;;
 
-let init t rootwid w h platform =
+let init t rootwid w h platform intel_mesa_quirk =
   let d =
     try Sys.getenv "DISPLAY"
     with exn ->
@@ -1191,7 +1193,7 @@ let init t rootwid w h platform =
   w16 s 8 (String.length adata);
   sendstr1 s 0 (Bytes.length s) fd;
   state.sock <- fd;
-  setup d fd rootwid screennum w h;
+  setup d fd rootwid screennum w h intel_mesa_quirk;
   state.t <- t;
   fd, state.w, state.h;
 ;;
diff --git a/wsi.mli b/wsi.mli
index fd400b4..7fdea0b 100644
--- a/wsi.mli
+++ b/wsi.mli
@@ -1,3 +1,5 @@
+type intel_mesa_quirk = bool;;
+
 type cursor =
     | CURSOR_INHERIT
     | CURSOR_INFO
@@ -39,7 +41,7 @@ val settitle : string -> unit;;
 val swapb : unit -> unit;;
 val readresp : Unix.file_descr -> unit;;
 val init : t -> int -> int -> int
-  -> Utils.platform -> Unix.file_descr * int * int;;
+  -> Utils.platform -> Utils.intel_mesa_quirks -> Unix.file_descr * int * int;;
 val fullscreen : unit -> unit;;
 val reshape : int -> int -> unit;;
 val activatewin : unit -> unit;;
-- 
2.11.4.GIT