# HG changeset patch
# User Rob Hoes <rob.hoes@xxxxxxxxxx>
CP-1635: Cpuid module to obtain CPU information

This module obtains the vendor/model/family/stepping as well as feature information from the CPU, and determines whether CPU feature masks can be applied.

Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>

diff -r b48ef328a270 .hgignore
--- a/.hgignore	Tue Feb 16 22:47:58 2010 +0000
+++ b/.hgignore	Tue Feb 16 22:59:09 2010 +0000
@@ -14,3 +14,4 @@
 ^config\.log$
 ^config\.status$
 ^configure$
+doc/*
diff -r b48ef328a270 Makefile.in
--- a/Makefile.in	Tue Feb 16 22:47:58 2010 +0000
+++ b/Makefile.in	Tue Feb 16 22:59:09 2010 +0000
@@ -31,6 +31,7 @@
 endif
 	$(MAKE) -C forking_executioner
 	$(MAKE) -C mlvm
+	$(MAKE) -C cpuid
 
 .PHONY: allxen
 allxen:
@@ -67,6 +68,7 @@
 endif
 	$(MAKE) -C forking_executioner install
 	$(MAKE) -C mlvm install
+	$(MAKE) -C cpuid install
 
 installxen:
 ifeq ($(HAVE_XEN),1)
@@ -102,6 +104,7 @@
 endif
 	$(MAKE) -C forking_executioner uninstall
 	$(MAKE) -C mlvm uninstall
+	$(MAKE) -C cpuid uninstall
 
 uninstallxen:
 ifeq ($(HAVE_XEN),1)
@@ -160,6 +163,7 @@
 	$(MAKE) -C mmap doc
 	$(MAKE) -C forking_executioner doc
 	$(MAKE) -C mlvm doc
+	$(MAKE) -C cpuid doc
 
 .PHONY: clean
 clean:
@@ -179,6 +183,7 @@
 	make -C doc clean
 	make -C forking_executioner clean
 	make -C mlvm clean
+	make -C cpuid clean
 
 cleanxen:
 	$(MAKE) -C mmap clean
diff -r b48ef328a270 cpuid/META.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpuid/META.in	Tue Feb 16 22:59:09 2010 +0000
@@ -0,0 +1,5 @@
+version = "@VERSION@"
+description = "Cpuid extension"
+requires = ""
+archive(byte) = "cpuid.cma"
+archive(native) = "cpuid.cmxa"
diff -r b48ef328a270 cpuid/Makefile
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpuid/Makefile	Tue Feb 16 22:59:09 2010 +0000
@@ -0,0 +1,72 @@
+CC = gcc
+CFLAGS = -Wall -fPIC -O2 -I/opt/xensource/lib/ocaml -I$(XEN_ROOT)/usr/include
+OCAMLC = ocamlc -g
+OCAMLOPT = ocamlopt
+INCLUDES = -I ../stdext
+
+LDFLAGS = -cclib -L./
+
+VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0)
+OCAMLOPTFLAGS = -g -dtypes
+
+OCAMLABI := $(shell ocamlc -version)
+OCAMLLIBDIR := $(shell ocamlc -where)
+OCAMLDESTDIR ?= $(OCAMLLIBDIR)
+
+OBJS = cpuid
+INTF = $(foreach obj, $(OBJS),$(obj).cmi)
+LIBS = cpuid.cma cpuid.cmxa
+
+DOCDIR = /myrepos/xen-api-libs.hg/doc
+
+all: $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+cpuid.cmxa: cpuid_stubs.a $(foreach obj,$(OBJS),$(obj).cmx)
+	$(OCAMLOPT) $(OCAMLOPTFLAGS) $(INCLUDES) -a -o $@ -cclib -lcpuid_stubs $(foreach obj,$(OBJS),$(obj).cmx)
+
+cpuid.cma: $(foreach obj,$(OBJS),$(obj).cmo)
+	$(OCAMLC) -a -dllib dllcpuid_stubs.so -cclib -lcpuid_stubs $(INCLUDES) -o $@ $(foreach obj,$(OBJS),$(obj).cmo)
+
+cpuid_stubs.a: cpuid_stubs.o
+	ocamlmklib -o cpuid_stubs $+
+
+libcpuid_stubs.a: cpuid_stubs.o
+	ar rcs $@ $+
+	ocamlmklib -o cpuid_stubs $+
+
+%.cmo: %.ml
+	$(OCAMLC) $(INCLUDES) -c -o $@ $<
+
+%.cmi: %.mli
+	$(OCAMLC) $(INCLUDES) -c -o $@ $<
+
+%.cmx: %.ml
+	$(OCAMLOPT) $(OCAMLOPTFLAGS) $(INCLUDES) -c -o $@ $<
+
+%.o: %.c
+	$(CC) $(CFLAGS) -c -o $@ $<
+
+META: META.in
+	sed 's/@VERSION@/$(VERSION)/g' < $< > $@
+
+.PHONY: install
+install: path = $(DESTDIR)$(shell ocamlfind printconf destdir)
+install: $(LIBS) META
+	mkdir -p $(path)
+	ocamlfind install -destdir $(path) -ldconf ignore cpuid META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+	ocamlfind remove cpuid
+
+.PHONY: doc
+doc: $(INTF)
+	python ../doc/doc.py $(DOCDIR) "cpuid" "package" "$(OBJS)" "." "stdext" ""
+	
+clean:
+	rm -f *.o *.so *.a *.cmo *.cmi *.cma *.cmx *.cmxa *.annot $(LIBS) $(PROGRAMS)
+
diff -r b48ef328a270 cpuid/cpuid.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpuid/cpuid.ml	Tue Feb 16 22:59:09 2010 +0000
@@ -0,0 +1,198 @@
+(*
+ * Copyright (C) 2006-2010 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Int32
+open Printf
+open Stringext
+
+exception InvalidFeatureString of string
+exception MaskingNotSupported of string
+exception ManufacturersDiffer
+
+(* === Types and conversion === *)
+
+type manufacturer = AMD | Intel | Unknown
+and features =
+	{
+		base_ecx: int32;
+		base_edx: int32;
+		ext_ecx: int32;
+		ext_edx: int32;
+	}
+and cpu_info =
+	{
+		manufacturer: manufacturer;
+		family: int32;
+		model: int32;
+		stepping: int32;
+		features: features;
+		physical_features: features;
+		maskable: bool;
+	}
+
+let features_to_string f =
+	sprintf "%8.8lx-%8.8lx-%8.8lx-%8.8lx"
+		f.base_ecx f.base_edx f.ext_ecx f.ext_edx
+		
+let string_to_features s =
+	let digits = String.explode "0123456789abcdef" in
+	let len = String.length s in
+	let buf = Buffer.create len in
+	for i = 0 to len - 1 do
+		match Char.lowercase s.[i] with
+		| ' ' | '-' -> ()
+		| c when List.mem c digits -> Buffer.add_char buf c
+		| _ -> raise (InvalidFeatureString "String contains illegal character")
+	done;
+	let s = Buffer.contents buf in
+	if String.length s <> 32 then raise (InvalidFeatureString "String is not of the right length");
+	{
+		base_ecx = Int32.of_string ("0x" ^ (String.sub s 0 8));
+		base_edx = Int32.of_string ("0x" ^ (String.sub s 8 8));
+		ext_ecx = Int32.of_string ("0x" ^ (String.sub s 16 8));
+		ext_edx = Int32.of_string ("0x" ^ (String.sub s 24 8))
+	}
+	
+(* === Read CPUID information from the hardware === *)
+	
+(* CPUID wrapper: Arguments are leaf and count, *)
+(* return values are %eax, %ebx, %ecx and %edx  *)
+external cpuid: int32 -> int32 -> (int32 * int32 * int32 * int32) = "do_cpuid"
+
+let read_manufacturer () = 
+	match cpuid 0l 0l with
+	| (_, 0x68747541l, 0x444D4163l, 0x69746E65l) -> AMD
+	| (_, 0x756e6547l, 0x6c65746el, 0x49656e69l) -> Intel 
+	| _ -> Unknown
+
+(* Unfold the family/model/stepping numbers from leaf 1 *)
+let read_family () = 
+	match cpuid 1l 0l with (eax, _, _, _) ->
+		let family = (shift_right (logand eax 0x00000f00l) 8) in
+		match family with
+		| 0xfl -> add family (shift_right (logand eax 0x0ff00000l) 20)
+		| _ -> family
+
+let read_model () = 
+	match cpuid 1l 0l with (eax, _, _, _) -> 
+		logor (shift_right (logand eax 0x000000f0l) 4) 
+			(shift_right (logand eax 0x000f0000l) 12)
+
+let read_stepping () = 
+	match cpuid 1l 0l with (eax, _, _, _) -> 
+		logand eax 0xfl		
+
+(* Read the feature flags and extended feature flags *)
+let read_features () = 
+	let base = cpuid 1l 0l in
+	let ext = cpuid 0x80000001l 0l in
+	match (base, ext) with 
+	| ((_, _, base_ecx, base_edx), (_, _, ext_ecx, ext_edx)) -> 
+		{
+			base_ecx = base_ecx;
+			base_edx = base_edx;
+			ext_ecx = ext_ecx;
+			ext_edx = ext_edx
+		} 
+		
+(* Does this Intel CPU support "FlexMigration"? 
+ * It's not sensibly documented, so check by model *)
+let has_flexmigration family model stepping = 
+	family > 0x6l || (model > 0x17l || (model = 0x17l && stepping >= 4l))
+
+(* Does this AMD CPU have Extended Migration Technology? 
+ * Known good on Barcelona and better; did exist on some older CPUs 
+ * but not really documented which ones *)
+let has_emt family = 
+	family >= 0x10l
+	
+let is_maskable manufacturer family model stepping =
+	match manufacturer with 
+	| Unknown -> false
+	| Intel ->
+		if has_flexmigration family model stepping then true
+		else false
+	| AMD ->
+		if has_emt family then true
+		else false
+
+let get_physical_features features =
+	let features_file = "/var/xapi/features" in
+	try
+		let data = Unixext.read_whole_file_to_string features_file in
+		string_to_features data
+	with _ ->
+		let data = features_to_string features in
+		Unixext.write_string_to_file features_file data;
+		features
+
+let read_cpu_info () =
+	let manufacturer = read_manufacturer () in
+	let family = read_family () in
+	let model = read_model () in
+	let features = read_features () in
+	let stepping = read_stepping () in
+	{
+		manufacturer = manufacturer;
+		family = family;
+		model = model;
+		stepping = stepping;
+		features = features;
+		physical_features = get_physical_features features;
+		maskable = is_maskable manufacturer family model stepping;
+	}
+	
+(* === Masking checks === *)
+
+let assert_maskability cpu manufacturer features = 
+	(* Manufacturers need to be the same *)
+	if manufacturer != cpu.manufacturer then 
+		raise ManufacturersDiffer;
+	(* Check whether masking is supported on the CPU *)
+	if not cpu.maskable then 
+		begin match cpu.manufacturer with 
+		| Unknown -> raise (MaskingNotSupported "Unknown CPU manufacturer")
+		| Intel -> raise (MaskingNotSupported "CPU does not have FlexMigration")
+		| AMD -> raise (MaskingNotSupported "CPU does not have Extended Migration Technology")
+		end;
+	(* Check whether the features can be obtained by masking the physical features *)
+	let possible = (logand cpu.physical_features.base_ecx features.base_ecx) = features.base_ecx 
+		&& (logand cpu.physical_features.base_edx features.base_edx) = features.base_edx
+		&& begin match manufacturer with 
+		| Intel ->
+			(* Intel can't mask extented features but doesn't (yet) need to *)
+			cpu.physical_features.ext_ecx = features.ext_ecx
+				&& cpu.physical_features.ext_edx = features.ext_edx
+		| AMD ->
+			(logand cpu.physical_features.ext_ecx features.ext_ecx) = features.ext_ecx 
+				&& (logand cpu.physical_features.ext_edx features.ext_edx) = features.ext_edx
+		| _ -> false
+		end
+	in
+	if not possible then
+		raise (InvalidFeatureString "CPU features cannot be masked to obtain given features")
+
+let xen_masking_string cpu features = 
+	let rec stringify reglist = 
+		match reglist with 
+		| (reg, host, pool) :: rest ->
+			if (host = pool) then stringify rest
+			else ("cpuid_mask_" ^ reg, sprintf "0x%8.8lx" pool) :: stringify rest
+		| [] -> [] 
+	in
+	stringify [("ecx", cpu.physical_features.base_ecx, features.base_ecx);
+		("edx", cpu.physical_features.base_edx, features.base_edx);
+		("ext_ecx", cpu.physical_features.ext_ecx, features.ext_ecx); 
+		("ext_edx", cpu.physical_features.ext_edx, features.ext_edx)]
+
diff -r b48ef328a270 cpuid/cpuid.mli
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpuid/cpuid.mli	Tue Feb 16 22:59:09 2010 +0000
@@ -0,0 +1,75 @@
+(*
+ * Copyright (C) 2006-2010 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+(** Module to read CPUID information and do feature masking checks. *)
+
+(** {2 Types and Conversion} *)
+
+(** Manufacturer of the CPU. *)
+type manufacturer =
+| AMD		(** AMD *)
+| Intel		(** Intel *)
+| Unknown	(** Other manufacturer *)
+
+(** CPU feature bit vector. *)
+and features
+
+(** CPUID information. *)
+and cpu_info =
+	{
+		manufacturer: manufacturer;		(** Manufacturer of the CPU *)
+		family: int32;					(** Family number of the CPU *)
+		model: int32;					(** Model number of the CPU *)
+		stepping: int32;				(** Stepping number of the CPU *)
+		features: features;				(** Feature bit vector of the CPU *)
+		physical_features: features;	(** Physical Feature bit vector of the CPU *)
+		maskable: bool;					(** Boolean indicating whether the CPU supports
+									        Intel FlexMigration or AMD Extended Migration,
+									        or cannot be masked *)
+	}
+	
+(** Convert {!features} into a string of 4 groups of 8 hexadecimal digits, separated by dashes. *)
+val features_to_string : features -> string
+
+(** Convert a feature string into a {!features} value. The string must contain
+ *  32 hexadecimal digits and may have spaces and dashes. *)
+val string_to_features : string -> features
+
+
+(** {2 Reading CPUID Information} *)
+
+(** Read the CPUID information from the hardware. *)
+val read_cpu_info : unit -> cpu_info
+
+
+(** {2 Masking Checks} *)
+
+(** Check that this CPU can be masked to fit the pool. Raises {!CannotMaskCpu} 
+ *  including a reason string if this is not possible. *)
+val assert_maskability : cpu_info -> manufacturer -> features -> unit
+
+(** Return the CPU masking string to add to the Xen command-line, 
+ *  or raise an exception saying why it can't be done. *)
+val xen_masking_string : cpu_info -> features -> (string * string) list
+
+(** Raised by {!string_to_features} if the given string is malformed,
+ *  or by {!assert_maskability} if the CPU features cannot be masked to 
+ *  obtain given features. *)
+exception InvalidFeatureString of string
+
+(** Raised by {!assert_maskability} if the CPU does not support feature masking. *)
+exception MaskingNotSupported of string
+
+(** Raised by {!assert_maskability} if manufacturers are not equal. *)
+exception ManufacturersDiffer
+
diff -r b48ef328a270 cpuid/cpuid_stubs.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpuid/cpuid_stubs.c	Tue Feb 16 22:59:09 2010 +0000
@@ -0,0 +1,43 @@
+/*
+ * Copyright (C) 2006-2010 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <stdint.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+
+CAMLprim value do_cpuid(value leaf, value word)
+{
+    int32_t eax, ebx, ecx, edx, tmp;
+
+    CAMLparam2(leaf, word);
+    CAMLlocal1(rv);
+
+    eax = Int32_val(leaf);
+    ecx = Int32_val(word);
+
+    /* Execute CPUID; the MOVs are because ocamlc uses -fPIC and
+     * 32-bit gcc won't let you just use "=b" to get at %ebx in PIC */
+    asm("mov %%ebx, %4 ; cpuid ; mov %%ebx, %1 ; mov %4, %%ebx " 
+        : "+a" (eax), "=r" (ebx), "+c" (ecx), "=d" (edx), "=r" (tmp));
+    
+    /* Wrap the return value up as an OCaml tuple */
+    rv = caml_alloc_tuple(4);
+    Store_field(rv, 0, caml_copy_int32(eax));
+    Store_field(rv, 1, caml_copy_int32(ebx));
+    Store_field(rv, 2, caml_copy_int32(ecx));
+    Store_field(rv, 3, caml_copy_int32(edx));
+
+    CAMLreturn(rv);
+}