--- /dev/null
+virt_mem_mmap.cmi: virt_mem_utils.cmo
+virt_mem.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi
+virt_mem.cmx: virt_mem_utils.cmx virt_mem_mmap.cmx
+virt_mem_mmap.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi
+virt_mem_mmap.cmx: virt_mem_utils.cmx virt_mem_mmap.cmi
--- /dev/null
+syntax:glob
+Makefile
+*~
+*.opt
+*.annot
+*.cmi
+*.cmo
+*.cmx
+autom4te.cache
+config.h
+config.h.in
+config.log
+config.status
+configure
+gmon.out
+virt-mem
+virt_mem_gettext.ml
--- /dev/null
+# virt-mem
+# @configure_input@
+# Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones
+#
+# This library 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; either
+# version 2 of the License, or (at your option) any later version.
+#
+# This library 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.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+PACKAGE = @PACKAGE_NAME@
+VERSION = @PACKAGE_VERSION@
+
+INSTALL = @INSTALL@
+
+SYNTAX = -pp "camlp4o -I`ocamlc -where`/bitmatch bitmatch.cma pa_bitmatch.cmo"
+
+#OCAMLCPACKAGES = -package unix,bigarray,extlib,bitmatch
+OCAMLCPACKAGES = -package unix,bigarray,extlib -I +bitmatch
+
+ifneq ($(pkg_gettext),no)
+OCAMLCPACKAGES += -package gettext-stub
+endif
+
+OCAMLCFLAGS = @OCAMLCFLAGS@ $(SYNTAX)
+OCAMLCLIBS = -linkpkg bitmatch.cma
+
+OCAMLOPTFLAGS = @OCAMLOPTFLAGS@ $(SYNTAX)
+OCAMLOPTPACKAGES = $(OCAMLCPACKAGES)
+OCAMLOPTLIBS = -linkpkg bitmatch.cmxa
+
+OCAMLDOCFLAGS = -html -stars -sort $(OCAMLCPACKAGES) $(SYNTAX)
+
+TARGETS = virt-mem virt-mem.opt
+
+OBJS = virt_mem_gettext.cmo \
+ virt_mem_utils.cmo \
+ virt_mem_mmap.cmo \
+ virt_mem.cmo
+XOBJS = virt_mem_gettext.cmx \
+ virt_mem_utils.cmx \
+ virt_mem_mmap.cmx \
+ virt_mem.cmx
+
+all: $(TARGETS)
+
+virt-mem: $(OBJS)
+ ocamlfind ocamlc \
+ $(OCAMLCFLAGS) $(OCAMLCPACKAGES) $(OCAMLCLIBS) $^ -o $@
+
+virt-mem.opt: $(XOBJS)
+ ocamlfind ocamlopt \
+ $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) $^ -o $@
+
+# Common rules for building OCaml objects.
+
+.mli.cmi:
+ ocamlfind ocamlc $(OCAMLCFLAGS) $(OCAMLCPACKAGES) -c $<
+.ml.cmo:
+ ocamlfind ocamlc $(OCAMLCFLAGS) $(OCAMLCPACKAGES) -c $<
+.ml.cmx:
+ ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) -c $<
+
+clean:
+ rm -f *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a \
+ *.so *.opt *~ *.dll *.exe *.annot core
+
+# Distribution.
+
+dist:
+ $(MAKE) check-manifest
+ rm -rf $(PACKAGE)-$(VERSION)
+ mkdir $(PACKAGE)-$(VERSION)
+ tar -cf - -T MANIFEST | tar -C $(PACKAGE)-$(VERSION) -xf -
+ $(INSTALL) -m 0755 configure $(PACKAGE)-$(VERSION)/
+ tar zcf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION)
+ rm -rf $(PACKAGE)-$(VERSION)
+ ls -l $(PACKAGE)-$(VERSION).tar.gz
+
+check-manifest:
+ @for d in `find -type d -name CVS | grep -v '^\./debian/'`; \
+ do \
+ b=`dirname $$d`/; \
+ awk -F/ '$$1 != "D" {print $$2}' $$d/Entries | \
+ sed -e "s|^|$$b|" -e "s|^\./||"; \
+ done | sort > .check-manifest; \
+ sort MANIFEST > .orig-manifest; \
+ diff -u .orig-manifest .check-manifest; rv=$$?; \
+ rm -f .orig-manifest .check-manifest; \
+ exit $$rv
+
+#check-manifest:
+# hg manifest | sort > .check-manifest; \
+# sort MANIFEST > .orig-manifest; \
+# diff -u .orig-manifest .check-manifest; rv=$$?; \
+# rm -f .orig-manifest .check-manifest; \
+# exit $$rv
+
+# Developer documentation (in html/ subdirectory).
+
+doc:
+ rm -rf html
+ mkdir html
+ -ocamlfind ocamldoc $(OCAMLDOCFLAGS) -d html *.{ml,mli}
+
+# Dependencies.
+
+depend: .depend
+
+.depend: $(wildcard *.mli) $(wildcard *.ml)
+ rm -f .depend
+ ocamldep $(SYNTAX) $^ > $@
+
+ifeq ($(wildcard .depend),.depend)
+include .depend
+endif
+
+.PHONY: all opt depend install clean distclean configure dist check-manifest \
+ release release_stage_2 release_stage_3 force
+
+.SUFFIXES: .cmo .cmi .cmx .ml .mli
--- /dev/null
+dnl autoconf macros for OCaml
+dnl by Olivier Andrieu
+dnl modified by Richard W.M. Jones
+dnl from a configure.in by Jean-Christophe Filliâtre,
+dnl from a first script by Georges Mariano
+dnl
+dnl defines AC_PROG_OCAML that will check the OCaml compiler
+dnl and set the following variables :
+dnl OCAMLC "ocamlc" if present in the path, or a failure
+dnl or "ocamlc.opt" if present with same version number as ocamlc
+dnl OCAMLOPT "ocamlopt" (or "ocamlopt.opt" if present), or "no"
+dnl OCAMLBEST either "byte" if no native compiler was found,
+dnl or "opt" otherwise
+dnl OCAMLDEP "ocamldep"
+dnl OCAMLLIB the path to the ocaml standard library
+dnl OCAMLVERSION the ocaml version number
+AC_DEFUN(AC_PROG_OCAML,
+[dnl
+# checking for ocamlc
+AC_CHECK_PROG(OCAMLC,ocamlc,ocamlc,AC_MSG_ERROR(Cannot find ocamlc.))
+OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+AC_MSG_RESULT(OCaml version is $OCAMLVERSION)
+OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4`
+AC_MSG_RESULT(OCaml library path is $OCAMLLIB)
+# checking for ocamlopt
+AC_CHECK_PROG(OCAMLOPT,ocamlopt,ocamlopt)
+OCAMLBEST=byte
+if test -z "$OCAMLOPT"; then
+ AC_MSG_WARN(Cannot find ocamlopt; bytecode compilation only.)
+else
+ TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+ if test "$TMPVERSION" != "$OCAMLVERSION" ; then
+ AC_MSG_RESULT(versions differs from ocamlc; ocamlopt discarded.)
+ unset OCAMLOPT
+ else
+ OCAMLBEST=opt
+ fi
+fi
+# checking for ocamlc.opt
+AC_CHECK_PROG(OCAMLCDOTOPT,ocamlc.opt,ocamlc.opt)
+if test -z "$OCAMLCDOTOPT"; then
+ TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+ if test "$TMPVERSION" != "$OCAMLVERSION" ; then
+ AC_MSG_RESULT(versions differs from ocamlc; ocamlc.opt discarded.)
+ else
+ OCAMLC=$OCAMLCDOTOPT
+ fi
+fi
+# checking for ocamlopt.opt
+if test "$OCAMLOPT" ; then
+ AC_CHECK_PROG(OCAMLOPTDOTOPT,ocamlopt.opt,ocamlopt.opt)
+ if test "$OCAMLOPTDOTOPT"; then
+ TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+ if test "$TMPVER" != "$OCAMLVERSION" ; then
+ AC_MSG_RESULT(version differs from ocamlc; ocamlopt.opt discarded.)
+ else
+ OCAMLOPT=$OCAMLOPTDOTOPT
+ fi
+ fi
+fi
+# checking for ocamldep
+AC_CHECK_PROG(OCAMLDEP,ocamldep,ocamldep,AC_MSG_ERROR(Cannot find ocamldep.))
+
+#checking for ocamlmktop
+AC_CHECK_PROG(OCAMLMKTOP,ocamlmktop,ocamlmktop, AC_MSG_WARN(Cannot find ocamlmktop.))
+#checking for ocamlmklib
+AC_CHECK_PROG(OCAMLMKLIB,ocamlmklib,ocamlmklib, AC_MSG_WARN(Cannot find ocamlmklib.))
+# checking for ocamldoc
+AC_CHECK_PROG(OCAMLDOC,ocamldoc,ocamldoc, AC_MSG_WARN(Cannot find ocamldoc.))
+
+
+AC_SUBST(OCAMLC)
+AC_SUBST(OCAMLOPT)
+AC_SUBST(OCAMLDEP)
+AC_SUBST(OCAMLBEST)
+AC_SUBST(OCAMLVERSION)
+AC_SUBST(OCAMLLIB)
+AC_SUBST(OCAMLMKLIB)
+AC_SUBST(OCAMLDOC)
+])
+
+
+dnl macro AC_PROG_OCAML_TOOLS will check OCamllex and OCamlyacc :
+dnl OCAMLLEX "ocamllex" or "ocamllex.opt" if present
+dnl OCAMLYACC "ocamlyac"
+AC_DEFUN(AC_PROG_OCAML_TOOLS,
+[dnl
+# checking for ocamllex and ocamlyacc
+AC_CHECK_PROG(OCAMLLEX,ocamllex,ocamllex)
+if test "$OCAMLLEX"; then
+ AC_CHECK_PROG(OCAMLLEXDOTOPT,ocamllex.opt,ocamllex.opt)
+ if test "$OCAMLLEXDOTOPT"; then
+ OCAMLLEX=$OCAMLLEXDOTOPT
+ fi
+else
+ AC_MSG_ERROR(Cannot find ocamllex.)
+fi
+AC_CHECK_PROG(OCAMLYACC,ocamlyacc,ocamlyacc,AC_MSG_ERROR(Cannot find ocamlyacc.))
+AC_SUBST(OCAMLLEX)
+AC_SUBST(OCAMLYACC)
+])
+
+
+dnl AC_PROG_CAMLP4 checks for Camlp4
+AC_DEFUN(AC_PROG_CAMLP4,
+[dnl
+AC_REQUIRE([AC_PROG_OCAML])
+# checking for camlp4
+AC_CHECK_PROG(CAMLP4,camlp4,camlp4)
+if test "$CAMLP4"; then
+ TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'`
+ if test "$TMPVERSION" != "$OCAMLVERSION" ; then
+ AC_MSG_RESULT(versions differs from ocamlc)
+ fi
+fi
+])
+
+
+dnl macro AC_PROG_FINDLIB will check for the presence of
+dnl ocamlfind
+AC_DEFUN(AC_PROG_FINDLIB,
+[dnl
+# checking for ocamlfind
+AC_CHECK_PROG(OCAMLFIND,ocamlfind,ocamlfind,
+ AC_MSG_WARN([ocamlfind not found]))
+AC_SUBST(OCAMLFIND)
+])
+
+
+dnl AC_CHECK_OCAML_PKG checks wether a findlib package is present
+dnl defines pkg_name to "yes"
+AC_DEFUN(AC_CHECK_OCAML_PKG,
+[dnl
+AC_REQUIRE([AC_PROG_FINDLIB])
+AC_MSG_CHECKING(findlib package $1)
+if $OCAMLFIND query $1 >/dev/null 2>/dev/null; then
+AC_MSG_RESULT(found)
+eval "pkg_`echo $1 | tr - _`=yes"
+else
+AC_MSG_RESULT(not found)
+eval "pkg_`echo $1 | tr - _`=no"
+fi
+])
+
+
+dnl AC_CHECK_OCAML_MODULE looks for a module in a given path
+dnl 1st arg -> name (just for printing messages)
+dnl 2nd arg -> env var name (set to include path, or "no" if not found)
+dnl 3rd arg -> module to check
+dnl 4th arg -> default include dirs to check
+AC_DEFUN([AC_CHECK_OCAML_MODULE],
+[dnl
+AC_MSG_CHECKING(for module $1)
+cat > conftest.ml <<EOF
+open $3
+EOF
+unset found
+for $2 in $$2 $4 ; do
+ if $OCAMLC -c -I "$$2" conftest.ml >&5 2>&5 ; then
+ found=yes
+ break
+ fi
+done
+if test "$found" ; then
+ AC_MSG_RESULT($$2)
+else
+ AC_MSG_RESULT(not found)
+ $2=no
+fi
+AC_SUBST($2)])
+
+
+dnl AC_CHECK_OCAML_WORD_SIZE(var) sets var=32 or var=64
+dnl according to the compiler word size.
+dnl Contributed by Richard W.M. Jones <rjones@redhat.com>
+dnl XXX This completely fails to deal with cross-compiler case.
+AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE],
+[dnl
+AC_MSG_CHECKING(for OCaml compiler word size)
+cat > conftest.ml <<EOF
+print_endline (string_of_int Sys.word_size)
+EOF
+$1=`ocaml conftest.ml`
+AC_MSG_RESULT($$1)
+AC_SUBST($1)])
--- /dev/null
+# virt-mem
+# Copyright (C) 2007-2008 Red Hat Inc., Richard W.M. Jones
+#
+# This library 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; either
+# version 2 of the License, or (at your option) any later version.
+#
+# This library 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.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+dnl Process this file with autoconf to produce a configure script.
+
+AC_INIT(virt-mem,0.2.0)
+
+AC_PROG_INSTALL
+
+dnl Check for basic OCaml environment & findlib.
+AC_PROG_OCAML
+AC_PROG_FINDLIB
+
+if test "x$OCAMLFIND" = "x"; then
+ AC_MSG_ERROR([OCaml findlib is required])
+fi
+
+dnl Use ocamlfind to find the required packages ...
+
+dnl Check for required OCaml packages.
+AC_CHECK_OCAML_PKG(unix)
+if test "x$pkg_unix" != "xyes"; then
+ AC_MSG_ERROR([Cannot find required OCaml package 'unix'])
+fi
+
+AC_CHECK_OCAML_PKG(extlib)
+if test "x$pkg_extlib" != "xyes"; then
+ AC_MSG_ERROR([Cannot find required OCaml package 'extlib'])
+fi
+
+AC_CHECK_OCAML_PKG(libvirt)
+if test "x$pkg_libvirt" != "xyes"; then
+ AC_MSG_ERROR([Cannot find required OCaml package 'libvirt'])
+fi
+
+AC_CHECK_OCAML_PKG(xml-light)
+if test "x$pkg_xml_light" != "xyes"; then
+ AC_MSG_ERROR([Cannot find required OCaml package 'xml-light'])
+fi
+
+AC_CHECK_OCAML_PKG(bitmatch)
+if test "x$pkg_bitmatch" != "xyes"; then
+ AC_MSG_ERROR([Cannot find required OCaml package 'bitmatch'])
+fi
+
+dnl Check for optional OCaml packages.
+AC_CHECK_OCAML_PKG(gettext)
+AC_CHECK_OCAML_PKG(csv)
+
+AC_SUBST(pkg_unix)
+AC_SUBST(pkg_extlib)
+AC_SUBST(pkg_libvirt)
+AC_SUBST(pkg_xml_light)
+AC_SUBST(pkg_bitmatch)
+AC_SUBST(pkg_gettext)
+AC_SUBST(pkg_csv)
+
+dnl Check for optional perldoc (for building manual pages).
+AC_CHECK_PROG(HAVE_PERLDOC,perldoc,perldoc)
+
+dnl Check for recommended ocaml-gettext tool.
+AC_CHECK_PROG(OCAML_GETTEXT,ocaml-gettext,ocaml-gettext)
+
+dnl Write gettext modules for the programs.
+dnl http://www.le-gall.net/sylvain+violaine/documentation/ocaml-gettext/html/reference-manual/ch03s04.html
+for d in virt-mem; do
+ f=`echo $d | tr - _`_gettext.ml
+ AC_MSG_NOTICE([creating $f])
+ rm -f $f
+ echo "(* This file is generated automatically by ./configure. *)" > $f
+ if test "x$pkg_gettext" != "xno"; then
+ # Gettext module is available, so use it.
+ cat <<EOT >>$f
+module Gettext = Gettext.Program (
+ struct
+ let textdomain = "$d"
+ let codeset = None
+ let dir = None
+ let dependencies = [[]]
+ end
+) (GettextStub.Native)
+EOT
+ else
+ # No gettext module is available, so fake the translation functions.
+ cat <<EOT >>$f
+module Gettext = struct
+ external s_ : string -> string = "%identity"
+ external f_ : ('a -> 'b, 'c, 'd) format -> ('a -> 'b, 'c, 'd) format
+ = "%identity"
+ let sn_ : string -> string -> int -> string
+ = fun s p n -> if n = 1 then s else p
+ let fn_ : ('a -> 'b, 'c, 'd) format -> ('a -> 'b, 'c, 'd) format -> int
+ -> ('a -> 'b, 'c, 'd) format
+ = fun s p n -> if n = 1 then s else p
+end
+EOT
+ fi
+done
+
+dnl Enable type annotation files (always, there's no penalty for doing
+dnl this). Use C-c C-t in emacs to print the type of an expression.
+OCAMLCFLAGS="-dtypes -g"
+OCAMLOPTFLAGS=""
+
+dnl Enable profiling support for native code.
+AC_ARG_ENABLE([profiling],
+ [AS_HELP_STRING([--enable-profiling],
+ [enable profiling for native code])],
+ [OCAMLOPTFLAGS="$OCAMLOPTFLAGS -p"])
+
+AC_SUBST(OCAMLCFLAGS)
+AC_SUBST(OCAMLOPTFLAGS)
+
+dnl Summary.
+echo "------------------------------------------------------------"
+echo "Thanks for downloading" $PACKAGE_STRING
+echo "------------------------------------------------------------"
+
+dnl Produce output files.
+AC_CONFIG_HEADERS([config.h])
+AC_CONFIG_FILES([Makefile
+ po/Makefile
+ ])
+AC_OUTPUT
--- /dev/null
+#!/bin/sh
+# install - install a program, script, or datafile
+
+scriptversion=2006-10-14.15
+
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+
+nl='
+'
+IFS=" "" $nl"
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+if test -z "$doit"; then
+ doit_exec=exec
+else
+ doit_exec=$doit
+fi
+
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+posix_glob=
+posix_mkdir=
+
+# Desired mode of installed file.
+mode=0755
+
+chmodcmd=$chmodprog
+chowncmd=
+chgrpcmd=
+stripcmd=
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=
+dst=
+dir_arg=
+dstarg=
+no_target_directory=
+
+usage="Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+ or: $0 [OPTION]... SRCFILES... DIRECTORY
+ or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+ or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+-c (ignored)
+-d create directories instead of installing files.
+-g GROUP $chgrpprog installed files to GROUP.
+-m MODE $chmodprog installed files to MODE.
+-o USER $chownprog installed files to USER.
+-s $stripprog installed files.
+-t DIRECTORY install into DIRECTORY.
+-T report an error if DSTFILE is a directory.
+--help display this help and exit.
+--version display version info and exit.
+
+Environment variables override the default commands:
+ CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG
+"
+
+while test $# -ne 0; do
+ case $1 in
+ -c) shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ --help) echo "$usage"; exit $?;;
+
+ -m) mode=$2
+ shift
+ shift
+ case $mode in
+ *' '* | *' '* | *'
+'* | *'*'* | *'?'* | *'['*)
+ echo "$0: invalid mode: $mode" >&2
+ exit 1;;
+ esac
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd=$stripprog
+ shift
+ continue;;
+
+ -t) dstarg=$2
+ shift
+ shift
+ continue;;
+
+ -T) no_target_directory=true
+ shift
+ continue;;
+
+ --version) echo "$0 $scriptversion"; exit $?;;
+
+ --) shift
+ break;;
+
+ -*) echo "$0: invalid option: $1" >&2
+ exit 1;;
+
+ *) break;;
+ esac
+done
+
+if test $# -ne 0 && test -z "$dir_arg$dstarg"; then
+ # When -d is used, all remaining arguments are directories to create.
+ # When -t is used, the destination is already specified.
+ # Otherwise, the last argument is the destination. Remove it from $@.
+ for arg
+ do
+ if test -n "$dstarg"; then
+ # $@ is not empty: it contains at least $arg.
+ set fnord "$@" "$dstarg"
+ shift # fnord
+ fi
+ shift # arg
+ dstarg=$arg
+ done
+fi
+
+if test $# -eq 0; then
+ if test -z "$dir_arg"; then
+ echo "$0: no input file specified." >&2
+ exit 1
+ fi
+ # It's OK to call `install-sh -d' without argument.
+ # This can happen when creating conditional directories.
+ exit 0
+fi
+
+if test -z "$dir_arg"; then
+ trap '(exit $?); exit' 1 2 13 15
+
+ # Set umask so as not to create temps with too-generous modes.
+ # However, 'strip' requires both read and write access to temps.
+ case $mode in
+ # Optimize common cases.
+ *644) cp_umask=133;;
+ *755) cp_umask=22;;
+
+ *[0-7])
+ if test -z "$stripcmd"; then
+ u_plus_rw=
+ else
+ u_plus_rw='% 200'
+ fi
+ cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+ *)
+ if test -z "$stripcmd"; then
+ u_plus_rw=
+ else
+ u_plus_rw=,u+rw
+ fi
+ cp_umask=$mode$u_plus_rw;;
+ esac
+fi
+
+for src
+do
+ # Protect names starting with `-'.
+ case $src in
+ -*) src=./$src ;;
+ esac
+
+ if test -n "$dir_arg"; then
+ dst=$src
+ dstdir=$dst
+ test -d "$dstdir"
+ dstdir_status=$?
+ else
+
+ # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+ # might cause directories to be created, which would be especially bad
+ # if $src (and thus $dsttmp) contains '*'.
+ if test ! -f "$src" && test ! -d "$src"; then
+ echo "$0: $src does not exist." >&2
+ exit 1
+ fi
+
+ if test -z "$dstarg"; then
+ echo "$0: no destination specified." >&2
+ exit 1
+ fi
+
+ dst=$dstarg
+ # Protect names starting with `-'.
+ case $dst in
+ -*) dst=./$dst ;;
+ esac
+
+ # If destination is a directory, append the input filename; won't work
+ # if double slashes aren't ignored.
+ if test -d "$dst"; then
+ if test -n "$no_target_directory"; then
+ echo "$0: $dstarg: Is a directory" >&2
+ exit 1
+ fi
+ dstdir=$dst
+ dst=$dstdir/`basename "$src"`
+ dstdir_status=0
+ else
+ # Prefer dirname, but fall back on a substitute if dirname fails.
+ dstdir=`
+ (dirname "$dst") 2>/dev/null ||
+ expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$dst" : 'X\(//\)[^/]' \| \
+ X"$dst" : 'X\(//\)$' \| \
+ X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
+ echo X"$dst" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'
+ `
+
+ test -d "$dstdir"
+ dstdir_status=$?
+ fi
+ fi
+
+ obsolete_mkdir_used=false
+
+ if test $dstdir_status != 0; then
+ case $posix_mkdir in
+ '')
+ # Create intermediate dirs using mode 755 as modified by the umask.
+ # This is like FreeBSD 'install' as of 1997-10-28.
+ umask=`umask`
+ case $stripcmd.$umask in
+ # Optimize common cases.
+ *[2367][2367]) mkdir_umask=$umask;;
+ .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
+
+ *[0-7])
+ mkdir_umask=`expr $umask + 22 \
+ - $umask % 100 % 40 + $umask % 20 \
+ - $umask % 10 % 4 + $umask % 2
+ `;;
+ *) mkdir_umask=$umask,go-w;;
+ esac
+
+ # With -d, create the new directory with the user-specified mode.
+ # Otherwise, rely on $mkdir_umask.
+ if test -n "$dir_arg"; then
+ mkdir_mode=-m$mode
+ else
+ mkdir_mode=
+ fi
+
+ posix_mkdir=false
+ case $umask in
+ *[123567][0-7][0-7])
+ # POSIX mkdir -p sets u+wx bits regardless of umask, which
+ # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
+ ;;
+ *)
+ tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+ trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
+
+ if (umask $mkdir_umask &&
+ exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
+ then
+ if test -z "$dir_arg" || {
+ # Check for POSIX incompatibilities with -m.
+ # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+ # other-writeable bit of parent directory when it shouldn't.
+ # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+ ls_ld_tmpdir=`ls -ld "$tmpdir"`
+ case $ls_ld_tmpdir in
+ d????-?r-*) different_mode=700;;
+ d????-?--*) different_mode=755;;
+ *) false;;
+ esac &&
+ $mkdirprog -m$different_mode -p -- "$tmpdir" && {
+ ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
+ test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+ }
+ }
+ then posix_mkdir=:
+ fi
+ rmdir "$tmpdir/d" "$tmpdir"
+ else
+ # Remove any dirs left behind by ancient mkdir implementations.
+ rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
+ fi
+ trap '' 0;;
+ esac;;
+ esac
+
+ if
+ $posix_mkdir && (
+ umask $mkdir_umask &&
+ $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+ )
+ then :
+ else
+
+ # The umask is ridiculous, or mkdir does not conform to POSIX,
+ # or it failed possibly due to a race condition. Create the
+ # directory the slow way, step by step, checking for races as we go.
+
+ case $dstdir in
+ /*) prefix=/ ;;
+ -*) prefix=./ ;;
+ *) prefix= ;;
+ esac
+
+ case $posix_glob in
+ '')
+ if (set -f) 2>/dev/null; then
+ posix_glob=true
+ else
+ posix_glob=false
+ fi ;;
+ esac
+
+ oIFS=$IFS
+ IFS=/
+ $posix_glob && set -f
+ set fnord $dstdir
+ shift
+ $posix_glob && set +f
+ IFS=$oIFS
+
+ prefixes=
+
+ for d
+ do
+ test -z "$d" && continue
+
+ prefix=$prefix$d
+ if test -d "$prefix"; then
+ prefixes=
+ else
+ if $posix_mkdir; then
+ (umask=$mkdir_umask &&
+ $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+ # Don't fail if two instances are running concurrently.
+ test -d "$prefix" || exit 1
+ else
+ case $prefix in
+ *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) qprefix=$prefix;;
+ esac
+ prefixes="$prefixes '$qprefix'"
+ fi
+ fi
+ prefix=$prefix/
+ done
+
+ if test -n "$prefixes"; then
+ # Don't fail if two instances are running concurrently.
+ (umask $mkdir_umask &&
+ eval "\$doit_exec \$mkdirprog $prefixes") ||
+ test -d "$dstdir" || exit 1
+ obsolete_mkdir_used=true
+ fi
+ fi
+ fi
+
+ if test -n "$dir_arg"; then
+ { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+ { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+ { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+ test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+ else
+
+ # Make a couple of temp file names in the proper directory.
+ dsttmp=$dstdir/_inst.$$_
+ rmtmp=$dstdir/_rm.$$_
+
+ # Trap to clean up those temp files at exit.
+ trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
+
+ # Copy the file name to the temp name.
+ (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+
+ # and set any options; do chmod last to preserve setuid bits.
+ #
+ # If any of these fail, we abort the whole thing. If we want to
+ # ignore errors from any of these, just make sure not to ignore
+ # errors from the above "$doit $cpprog $src $dsttmp" command.
+ #
+ { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \
+ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \
+ && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \
+ && { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
+
+ # Now rename the file to the real destination.
+ { $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null \
+ || {
+ # The rename failed, perhaps because mv can't rename something else
+ # to itself, or perhaps because mv is so ancient that it does not
+ # support -f.
+
+ # Now remove or move aside any old file at destination location.
+ # We try this two ways since rm can't unlink itself on some
+ # systems and the destination file might be busy for other
+ # reasons. In this case, the final cleanup might fail but the new
+ # file should still install successfully.
+ {
+ if test -f "$dst"; then
+ $doit $rmcmd -f "$dst" 2>/dev/null \
+ || { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null \
+ && { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }; }\
+ || {
+ echo "$0: cannot unlink or rename $dst" >&2
+ (exit 1); exit 1
+ }
+ else
+ :
+ fi
+ } &&
+
+ # Now rename the file to the real destination.
+ $doit $mvcmd "$dsttmp" "$dst"
+ }
+ } || exit 1
+
+ trap '' 0
+ fi
+done
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-end: "$"
+# End:
--- /dev/null
+Makefile
\ No newline at end of file
--- /dev/null
+# Makefile for po subdirectory.
+# @configure_input@
+#
+# Copyright (C) 2007-2008 Red Hat Inc.
+# Written by Richard W.M. Jones <rjones@redhat.com>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+OCAML_GETTEXT_PACKAGE = virt-df
+LINGUAS = $(shell cat LINGUAS)
+SOURCES = POTFILES
+
+OCAML_GETTEXT = @OCAML_GETTEXT@
+OCAML_GETTEXT_EXTRACT_OPTIONS =
+OCAML_GETTEXT_COMPILE_OPTIONS =
+OCAML_GETTEXT_INSTALL_OPTIONS =
+OCAML_GETTEXT_MERGE_OPTIONS =
+
+PODIR = @prefix@/share/locale
+
+POFILES = $(addsuffix .po,$(LINGUAS))
+MOFILES = $(addsuffix .mo,$(LINGUAS))
+POTFILE = $(OCAML_GETTEXT_PACKAGE).pot
+
+all: $(MOFILES) $(POTFILE)
+
+install: install-po
+
+uninstall: uninstall-po
+
+clean:: clean-po
+
+%.mo: %.po
+ $(OCAML_GETTEXT) --action compile $(OCAML_GETTEXT_COMPILE_OPTIONS) \
+ --compile-output $@ $^
+
+%.pot: $(SOURCES) $(shell cat $(SOURCES))
+ $(OCAML_GETTEXT) --action extract $(OCAML_GETTEXT_EXTRACT_OPTIONS) \
+ --extract-pot $@ $<
+
+# Also includes a fix for incorrectly escaped multi-byte sequences.
+%.po: $(POTFILE)
+ $(OCAML_GETTEXT) --action merge $(OCAML_GETTEXT_MERGE_OPTIONS) \
+ --merge-pot $(POTFILE) $@
+ mv $@ $@.orig
+ perl -wpe 's/\\(\d{3})/pack "C*", $$1/ge' < $@.orig > $@
+
+$(BUILDPO):
+ mkdir -p $(BUILDPO)
+
+.PRECIOUS: $(POTFILE)
+
+install-po: $(MOFILES)
+ $(OCAML_GETTEXT) --action install $(OCAML_GETTEXT_INSTALL_OPTIONS) \
+ --install-textdomain $(OCAML_GETTEXT_PACKAGE) \
+ --install-destdir $(PODIR) $(MOFILES)
+
+uninstall-po:
+ $(OCAML_GETTEXT) --action uninstall $(OCAML_GETTEXT_INSTALL_OPTIONS) \
+ --uninstall-textdomain $(OCAML_GETTEXT_PACKAGE) \
+ --uninstall-orgdir $(PODIR) $(MOFILES)
+
+clean-po:
+ -$(OCAML_GETTEXT) --action uninstall $(OCAML_GETTEXT_INSTALL_OPTIONS) \
+ --uninstall-textdomain $(OCAML_GETTEXT_PACKAGE) \
+ --uninstall-orgdir $(BUILDPO) $(MOFILES)
+ -$(RM) $(MOFILES)
--- /dev/null
+virt_mem.ml
+virt_mem_mmap.ml
+virt_mem_utils.ml
\ No newline at end of file
--- /dev/null
+# SOME DESCRIPTIVE TITLE.
+# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER
+# This file is distributed under the same license as the PACKAGE package.
+# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
+#
+#, fuzzy
+msgid ""
+msgstr ""
+"Project-Id-Version: PACKAGE VERSION\n"
+"Report-Msgid-Bugs-To: \n"
+"POT-Creation-Date: 2008-04-28 12:49+0000\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=CHARSET\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=INTEGER; plural=EXPRESSION;\n"
+
+#: ../virt-df/virt_df_main.ml:83
+msgid "%s: unknown parameter"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:77
+msgid "(Test mode) Display contents of block device or file"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:268
+msgid "1K-blocks"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:269 ../virt-df/virt_df_main.ml:268
+msgid "Available"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:100
+msgid "CSV is not supported in this build of virt-df"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:63 ../virt-df/virt_df_main.ml:61
+msgid "Connect to URI (default: Xen)"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:67 ../diskzip/diskzip.ml:83
+msgid "Debug mode (default: false)"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:79 ../diskzip/diskzip.ml:93
+msgid "Display version and exit"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:273
+msgid "Filesystem"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:85
+msgid "Force compress even if stdout looks like a tty"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:270
+msgid "IFree"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:270
+msgid "IUse"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:270
+msgid "Inodes"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:119
+msgid "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:87
+msgid "Pipe the output/input through bzip2"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:91
+msgid "Pipe the output/input through external program"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:95
+msgid "Pipe the output/input through gzip"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:71 ../virt-df/virt_df_main.ml:69
+msgid "Print sizes in human-readable format"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:89
+msgid "Set the output filename or directory name"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:59 ../virt-df/virt_df_main.ml:57
+msgid "Show all domains (default: only active domains)"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:75 ../virt-df/virt_df_main.ml:73
+msgid "Show inodes instead of blocks"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:269
+msgid "Size"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:273
+msgid "Type"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:81
+msgid "Uncompress (default: depends on executable name)"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:269 ../virt-df/virt_df_main.ml:268
+msgid "Used"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:65
+msgid "Write results in CSV format"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:53
+msgid "diskzip: '-o' option cannot appear more than once"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:119
+msgid "diskzip: '-o' option cannot be used when compressing"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:71
+msgid "diskzip: '-z' or '-j' cannot appear more than once"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:100
+msgid "diskzip: Intelligently compress disk images\n\nSUMMARY\n diskzip [-options] disk.img [disk.img ...] > output.dz\n diskzcat [-options] output.dz > disk.img\n\nOPTIONS"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:127
+msgid "diskzip: compressed data not written to a terminal, use '-f' to force"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:123
+msgid "diskzip: no input"
+msgstr ""
+
+#: ../diskzip/diskzip.ml:40
+msgid "diskzip: unknown executable name '%s', assuming 'diskzip'\\n"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:158
+msgid "get_xml_desc didn't return <domain/>"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:166
+msgid "get_xml_desc returned no <name> node in XML"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:169
+msgid "get_xml_desc returned strange <name> node"
+msgstr ""
+
+#: ../virt-df/virt_df_main.ml:84
+msgid "virt-df : like 'df', shows disk space used in guests\n\nSUMMARY\n virt-df [-options]\n\nOPTIONS"
+msgstr ""
+
--- /dev/null
+(* Memory info command for virtual domains.
+ (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
+ http://libvirt.org/
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+open Unix
+open Printf
+open ExtList
+
+open Virt_mem_utils
+module MMap = Virt_mem_mmap
+
+(* Main program. *)
+let () =
+ (* Verbose messages. *)
+ let verbose = ref false in
+
+ (* Default wordsize. *)
+ let def_wordsize = ref None in
+ let set_wordsize = function
+ | "32" -> def_wordsize := Some W32
+ | "64" -> def_wordsize := Some W64
+ | "auto" -> def_wordsize := None
+ | str -> failwith (sprintf "set_wordsize: %s: unknown wordsize" str)
+ in
+
+ (* Default endianness. *)
+ let def_endian = ref None in
+ let set_endian = function
+ | "auto" -> def_endian := None
+ | "le" | "little" | "littleendian" | "intel" ->
+ def_endian := Some Bitmatch.LittleEndian
+ | "be" | "big" | "bigendian" | "motorola" ->
+ def_endian := Some Bitmatch.BigEndian
+ | str -> failwith (sprintf "set_endian: %s: unknown endianness" str)
+ in
+
+ (* Default architecture. *)
+ let def_architecture = ref None in
+ let set_architecture = function
+ | "auto" -> def_architecture := None
+ | arch ->
+ let arch = architecture_of_string arch in
+ def_architecture := Some arch;
+ def_endian := Some (endian_of_architecture arch);
+ def_wordsize := Some (wordsize_of_architecture arch)
+ in
+
+ (* Default text address. *)
+ let def_text_addr = ref 0L (* 0 = auto-detect *) in
+ let set_text_addr = function
+ | "auto" -> def_text_addr := 0L
+ | "i386" -> def_text_addr := 0xc010_0000_L (* common for x86 *)
+ | "x86-64"|"x86_64" -> def_text_addr := 0xffffffff_81000000_L (* x86-64? *)
+ | str -> def_text_addr := Int64.of_string str
+ in
+
+ (* List of kernel images. *)
+ let images = ref [] in
+
+ let memory_image filename =
+ images :=
+ (!def_wordsize, !def_endian, !def_architecture, !def_text_addr, filename)
+ :: !images
+ in
+
+ let argspec = Arg.align [
+ "-A", Arg.String set_architecture,
+ "arch " ^ "Set kernel architecture, endianness and word size";
+ "-E", Arg.String set_endian,
+ "endian " ^ "Set kernel endianness";
+ "-T", Arg.String set_text_addr,
+ "addr " ^ "Set kernel text address";
+ "-W", Arg.String set_wordsize,
+ "addr " ^ "Set kernel word size";
+ "-t", Arg.String memory_image,
+ "image " ^ "Use saved kernel memory image";
+ "-verbose", Arg.Set verbose,
+ " " ^ "Verbose messages";
+ ] in
+
+ let anon_fun str =
+ raise (Arg.Bad (sprintf "%s: unknown parameter" str)) in
+ let usage_msg = "virt-mem: shows memory information for guests
+
+SUMMARY
+ virt-mem [-options]
+
+OPTIONS" in
+
+ Arg.parse argspec anon_fun usage_msg;
+
+ let images = !images in
+ let verbose = !verbose in
+
+ (* Get the kernel images. *)
+ let images =
+ if images = [] then
+ (* XXX use libvirt to get images *)
+ failwith "libvirt: not yet implemented"
+ else
+ List.map (
+ fun (wordsize, endian, arch, text_addr, filename) ->
+ (* Quite a lot of limitations on the kernel images we can
+ * handle at the moment ...
+ *)
+ (* XXX We could auto-detect wordsize easily. *)
+ let wordsize =
+ match wordsize with
+ | None ->
+ failwith
+ (sprintf "%s: use -W to define word size for this image"
+ filename);
+ | Some ws -> ws in
+ let endian =
+ match endian with
+ | None ->
+ failwith
+ (sprintf "%s: use -E to define endianness for this image"
+ filename);
+ | Some e -> e in
+
+ let arch =
+ match arch with
+ | Some I386 -> I386 | Some X86_64 -> X86_64
+ | _ ->
+ failwith
+ (sprintf "%s: use -A to define architecture (i386/x86-64 only) for this image" filename) in
+
+ if text_addr = 0L then
+ failwith
+ (sprintf "%s: use -T to define kernel load address for this image"
+ filename);
+
+ (* Map the virtual memory. *)
+ let fd = openfile filename [O_RDONLY] 0 in
+ let mem = MMap.of_file fd text_addr in
+
+ (* Force the wordsize and endianness. *)
+ let mem = MMap.set_wordsize mem wordsize in
+ let mem = MMap.set_endian mem endian in
+
+ (filename, (arch, mem))
+ ) images in
+
+ List.iter (
+ fun (name, (arch, mem)) ->
+ (* Look for some common entries in the symbol table and from
+ * that find the symbol table itself. These are just supposed to
+ * be symbols which are very likely to be present in any Linux
+ * kernel, although we only need one of them to be present to
+ * find the symbol table.
+ *
+ * NB. Must not be __initdata.
+ *)
+ let common_ksyms = [
+ "init_task"; (* first task_struct *)
+ "root_mountflags"; (* flags for mounting root fs *)
+ "init_uts_ns"; (* uname strings *)
+ "sys_open"; (* open(2) entry point *)
+ "sys_chdir"; (* chdir(2) entry point *)
+ "sys_chroot"; (* chroot(2) entry point *)
+ "sys_umask"; (* umask(2) entry point *)
+ "schedule"; (* scheduler entry point *)
+ ] in
+ (* Searching for <NUL>string<NUL> *)
+ let common_ksyms = List.map (sprintf "\000%s\000") common_ksyms in
+
+ (* Search for these strings in the memory image. *)
+ let ksym_strings = List.map (MMap.find_all mem) common_ksyms in
+ let ksym_strings = List.concat ksym_strings in
+ (* Adjust found addresses to start of the string (skip <NUL>). *)
+ let ksym_strings = List.map Int64.succ ksym_strings in
+
+ (* For any we found, try to look up the symbol table
+ * base addr and size.
+ *)
+ let ksymtabs = List.map (
+ fun addr ->
+ (* Search for 'addr' appearing in the image. *)
+ let addrs = MMap.find_pointer_all mem addr in
+
+ (* Now consider each of these addresses and search back
+ * until we reach the beginning of the (possible) symbol
+ * table.
+ *
+ * Kernel symbol table struct is:
+ * struct kernel_symbol {
+ * unsigned long value;
+ * const char *name; <-- initial pointer
+ * } symbols[];
+ *)
+ let pred_long2 addr = MMap.pred_long mem (MMap.pred_long mem addr) in
+ let base_addrs = List.map (
+ fun addr ->
+ let rec loop addr =
+ (* '*addr' should point to a C identifier. If it does,
+ * step backwards to the previous symbol table entry.
+ *)
+ let addrp = MMap.follow_pointer mem addr in
+ if MMap.is_C_identifier mem addrp then
+ loop (pred_long2 addr)
+ else
+ MMap.succ_long mem addr
+ in
+ loop addr
+ ) addrs in
+
+ (* Also look for the end of the symbol table and
+ * calculate its size.
+ *)
+ let base_addrs_sizes = List.map (
+ fun base_addr ->
+ let rec loop addr =
+ let addr2 = MMap.succ_long mem addr in
+ let addr2p = MMap.follow_pointer mem addr2 in
+ if MMap.is_C_identifier mem addr2p then
+ loop (MMap.succ_long mem addr2)
+ else
+ addr
+ in
+ let end_addr = loop base_addr in
+ base_addr, end_addr -^ base_addr
+ ) base_addrs in
+
+ base_addrs_sizes
+ ) ksym_strings in
+ let ksymtabs = List.concat ksymtabs in
+
+ (* Simply ignore any symbol table candidates which are too small. *)
+ let ksymtabs = List.filter (fun (_, size) -> size > 64L) ksymtabs in
+
+ if verbose then (
+ printf "name %s:\n" name;
+ List.iter (
+ fun (addr, size) ->
+ printf "\t%Lx\t%Lx\t%!" addr size;
+ printf "first symbol: %s\n%!"
+ (MMap.get_string mem
+ (MMap.follow_pointer mem
+ (MMap.succ_long mem addr)))
+ ) ksymtabs
+ );
+
+ (* Vote for the most popular symbol table candidate. *)
+ let freqs = frequency ksymtabs in
+ match freqs with
+ | [] ->
+ eprintf "%s: cannot find start of kernel symbol table\n" name
+ | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
+ if verbose then
+ printf "%s: Kernel symbol table found at %Lx, size %Lx bytes\n%!"
+ name ksymtab_addr ksymtab_size;
+
+ (* Load the whole symbol table as a bitstring. *)
+ let ksymtab =
+ Bitmatch.bitstring_of_string
+ (MMap.get_bytes mem ksymtab_addr (Int64.to_int ksymtab_size)) in
+
+ (* Function to look up an address in the symbol table. *)
+ let lookup_ksym sym =
+ let bits = bits_of_wordsize (MMap.get_wordsize mem) in
+ let e = MMap.get_endian mem in
+ let rec loop bs =
+ bitmatch bs with
+ | { value : bits : endian(e);
+ name_ptr : bits : endian(e) }
+ when MMap.get_string mem name_ptr = sym ->
+ value
+ | { _ : bits : endian(e);
+ _ : bits : endian(e);
+ bs : -1 : bitstring } ->
+ loop bs
+ | { _ } -> raise Not_found
+ in
+ loop ksymtab
+ in
+
+ if verbose then (
+ (* This just tests looking up kernel symbols. *)
+ printf "init_task = %Lx\n" (lookup_ksym "init_task");
+ printf "schedule = %Lx\n" (lookup_ksym "schedule");
+ printf "system_utsname = %s\n"
+ (try
+ let addr = lookup_ksym "system_utsname" in
+ sprintf "%Lx" addr
+ with Not_found -> "not found");
+ printf "init_uts_ns = %s\n"
+ (try
+ let addr = lookup_ksym "init_uts_ns" in
+ sprintf "%Lx" addr
+ with Not_found -> "not found");
+ );
+
+
+
+
+ ) images
--- /dev/null
+(* Memory info command for virtual domains.
+ (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
+ http://libvirt.org/
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ Functions for making a memory map of a virtual machine from
+ various sources. The memory map will most certainly have holes.
+ *)
+
+open Unix
+open Bigarray
+
+open Virt_mem_utils
+
+(* Simple implementation at the moment: Store a list of mappings,
+ * sorted by start address. We assume that mappings do not overlap.
+ * We can change the implementation later if we need to. In most cases
+ * there will only be a small number of mappings (probably 1).
+ *)
+type ('a,'b) t = {
+ mappings : mapping list;
+ wordsize : wordsize option;
+ endian : Bitmatch.endian option;
+}
+and mapping = {
+ start : addr;
+ size : addr;
+ (* Bigarray mmap(2)'d region with byte addressing: *)
+ arr : (char,int8_unsigned_elt,c_layout) Array1.t;
+}
+
+and addr = int64
+
+let create () = {
+ mappings = [];
+ wordsize = None;
+ endian = None
+}
+
+let set_wordsize t ws = { t with wordsize = Some ws }
+
+let set_endian t e = { t with endian = Some e }
+
+let get_wordsize t = Option.get t.wordsize
+
+let get_endian t = Option.get t.endian
+
+let sort_mappings mappings =
+ let cmp { start = s1 } { start = s2 } = compare s1 s2 in
+ List.sort cmp mappings
+
+let add_file ({ mappings = mappings } as t) fd addr =
+ if addr &^ 7L <> 0L then
+ invalid_arg "add_file: mapping address must be aligned to 8 bytes";
+ let size = (fstat fd).st_size in
+ (* mmap(2) the file using Bigarray module. *)
+ let arr = Array1.map_file fd char c_layout false size in
+ (* Create the mapping entry and keep the mappings sorted by start addr. *)
+ let mappings =
+ { start = addr; size = Int64.of_int size; arr = arr } :: mappings in
+ let mappings = sort_mappings mappings in
+ { t with mappings = mappings }
+
+let of_file fd addr =
+ let t = create () in
+ add_file t fd addr
+
+(* Find in mappings and return first predicate match. *)
+let _find_map { mappings = mappings } pred =
+ let rec loop = function
+ | [] -> None
+ | m :: ms ->
+ match pred m with
+ | Some n -> Some n
+ | None -> loop ms
+ in
+ loop mappings
+
+(* Array+offset = string? *)
+let string_at arr offset str strlen =
+ let j = ref offset in
+ let rec loop i =
+ if i >= strlen then true
+ else
+ if Array1.get arr !j <> str.[i] then false
+ else (
+ incr j;
+ loop (i+1)
+ )
+ in
+ loop 0
+
+(* Find in a single file mapping.
+ * [start] is relative to the mapping and we return an offset relative
+ * to the mapping.
+ *)
+let _find_in start align str arr =
+ let strlen = String.length str in
+ if strlen > 0 then (
+ let j = ref start in
+ let e = Array1.dim arr - strlen in
+ let rec loop () =
+ if !j <= e then (
+ if string_at arr !j str strlen then Some !j
+ else (
+ j := !j + align;
+ loop ()
+ )
+ )
+ else None
+ in
+ loop ()
+ )
+ else Some start
+
+(* Generic find function. *)
+let _find t start align str =
+ _find_map t (
+ fun { start = mstart; size = msize; arr = arr } ->
+ if mstart >= start then (
+ (* Check this mapping from the beginning. *)
+ match _find_in 0 align str arr with
+ | Some offset -> Some (mstart +^ Int64.of_int offset)
+ | None -> None
+ )
+ else if mstart < start && start <= mstart+^msize then (
+ (* Check this mapping from somewhere in the middle. *)
+ let offset = Int64.to_int (start -^ mstart) in
+ match _find_in offset align str arr with
+ | Some offset -> Some (mstart +^ Int64.of_int offset)
+ | None -> None
+ )
+ else None
+ )
+
+let find t ?(start=0L) str =
+ _find t start 1 str
+
+let find_align t ?(start=0L) str =
+ let align = bytes_of_wordsize (get_wordsize t) in
+ _find t start align str
+
+let rec _find_all t start align str =
+ match _find t start align str with
+ | None -> []
+ | Some offset ->
+ offset :: _find_all t (offset +^ Int64.of_int align) align str
+
+let find_all t ?(start=0L) str =
+ _find_all t start 1 str
+
+let find_all_align t ?(start=0L) str =
+ let align = bytes_of_wordsize (get_wordsize t) in
+ _find_all t start align str
+
+(* NB: Phantom types in the interface ensure that these pointer functions
+ * can only be called once endianness and wordsize have both been set.
+ *)
+
+let rec find_pointer t ?start addr =
+ find_align t ?start (string_of_addr t addr)
+
+and find_pointer_all t ?start addr =
+ find_all_align t ?start (string_of_addr t addr)
+
+(*
+and string_of_addr t addr =
+ let bits = bits_of_wordsize (get_wordsize t) in
+ let e = get_endian t in
+ let bs = BITSTRING { addr : bits : endian (e) } in
+ Bitmatch.string_of_bitstring bs
+*)
+(* XXX bitmatch is missing 'construct_int64_le_unsigned' so we
+ * have to force this to 32 bits for the moment.
+ *)
+and string_of_addr t addr =
+ let bits = bits_of_wordsize (get_wordsize t) in
+ assert (bits = 32);
+ let e = get_endian t in
+ let bs = BITSTRING { Int64.to_int32 addr : 32 : endian (e) } in
+ Bitmatch.string_of_bitstring bs
+
+and addr_of_string t str =
+ let bits = bits_of_wordsize (get_wordsize t) in
+ let e = get_endian t in
+ let bs = Bitmatch.bitstring_of_string str in
+ bitmatch bs with
+ | { addr : bits : endian (e) } -> addr
+ | { _ } -> invalid_arg "addr_of_string"
+
+let get_byte { mappings = mappings } addr =
+ let rec loop = function
+ | [] -> invalid_arg "get_byte"
+ | { start = start; size = size; arr = arr } :: _
+ when start <= addr && addr < size ->
+ let offset = Int64.to_int (addr -^ start) in
+ Char.code (Array1.get arr offset)
+ | _ :: ms -> loop ms
+ in
+ loop mappings
+
+(* Take bytes until a condition is not met. This is efficient in that
+ * we stay within the same mapping as long as we can.
+ *)
+let dowhile { mappings = mappings } addr cond =
+ let rec get_next_mapping addr = function
+ | [] -> invalid_arg "dowhile"
+ | { start = start; size = size; arr = arr } :: _
+ when start <= addr && addr < start +^ size ->
+ let offset = Int64.to_int (addr -^ start) in
+ let len = Int64.to_int size - offset in
+ arr, offset, len
+ | _ :: ms -> get_next_mapping addr ms
+ in
+ let rec loop addr =
+ let arr, offset, len = get_next_mapping addr mappings in
+ let rec loop2 i =
+ if i < len then (
+ let c = Array1.get arr (offset+i) in
+ if cond c then loop2 (i+1)
+ ) else
+ loop (addr +^ Int64.of_int len)
+ in
+ loop2 0
+ in
+ loop addr
+
+let get_bytes t addr len =
+ let str = String.create len in
+ let i = ref 0 in
+ try
+ dowhile t addr (
+ fun c ->
+ str.[!i] <- c;
+ incr i;
+ !i < len
+ );
+ str
+ with
+ Invalid_argument _ -> invalid_arg "get_bytes"
+
+let get_string t addr =
+ let chars = ref [] in
+ try
+ dowhile t addr (
+ fun c ->
+ if c <> '\000' then (
+ chars := c :: !chars;
+ true
+ ) else false
+ );
+ let chars = List.rev !chars in
+ let len = List.length chars in
+ let str = String.create len in
+ let i = ref 0 in
+ List.iter (fun c -> str.[!i] <- c; incr i) chars;
+ str
+ with
+ Invalid_argument _ -> invalid_arg "get_string"
+
+let is_string t addr =
+ try dowhile t addr (fun c -> c <> '\000'); true
+ with Invalid_argument _ -> false
+
+let is_C_identifier t addr =
+ let i = ref 0 in
+ let r = ref true in
+ try
+ dowhile t addr (
+ fun c ->
+ let b =
+ if !i = 0 then (
+ c = '_' || c >= 'A' && c <= 'Z' || c >= 'a' && c <= 'z'
+ ) else (
+ if c = '\000' then false
+ else (
+ if c = '_' || c >= 'A' && c <= 'Z' || c >= 'a' && c <= 'z' ||
+ c >= '0' && c <= '9' then
+ true
+ else (
+ r := false;
+ false
+ )
+ )
+ ) in
+ incr i;
+ b
+ );
+ !r
+ with
+ Invalid_argument _ -> false
+
+let follow_pointer t addr =
+ let ws = get_wordsize t in
+ let e = get_endian t in
+ let bits = bits_of_wordsize ws in
+ let str = get_bytes t addr (bytes_of_wordsize ws) in
+ let bs = Bitmatch.bitstring_of_string str in
+ bitmatch bs with
+ | { addr : bits : endian (e) } -> addr
+ | { _ } -> invalid_arg "follow_pointer"
+
+let succ_long t addr =
+ let ws = get_wordsize t in
+ addr +^ Int64.of_int (bytes_of_wordsize ws)
+
+let pred_long t addr =
+ let ws = get_wordsize t in
+ addr -^ Int64.of_int (bytes_of_wordsize ws)
--- /dev/null
+(* Memory info command for virtual domains.
+ (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
+ http://libvirt.org/
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ Functions for making a memory map of a virtual machine from
+ various sources. The memory map will most certainly have holes.
+ *)
+
+type ('a,'b) t
+(** Memory map. *)
+
+type addr = int64
+(** Virtual memory addresses (even on 32 bit machines). *)
+
+val create : unit -> ([`NoWordsize], [`NoEndian]) t
+(** Create a new, empty memory map. *)
+
+val set_wordsize : ([`NoWordsize], 'b) t -> Virt_mem_utils.wordsize ->
+ ([`Wordsize], 'b) t
+(** Set the natural wordsize of the memory map. This is used
+ for matching pointers within the map and can be set only once. *)
+
+val set_endian : ('a, [`NoEndian]) t -> Bitmatch.endian ->
+ ('a, [`Endian]) t
+(** Set the natural endianness of the memory map. This is used
+ for matching pointers within the map and can be set only once. *)
+
+val get_wordsize : ([`Wordsize], 'b) t -> Virt_mem_utils.wordsize
+(** Return the wordsize previously set for this memory map. *)
+
+val get_endian : ('a, [`Endian]) t -> Bitmatch.endian
+(** Return the endianness previously set for this memory map. *)
+
+val of_file : Unix.file_descr -> addr -> ([`NoWordsize], [`NoEndian]) t
+(** Create a new memory map, mapping file [fd] at address [addr]. *)
+
+val add_file : ('a, 'b) t -> Unix.file_descr -> addr -> ('a, 'b) t
+(** Add file [fd] at address [addr] to an existing memory map.
+ Behaviour is undefined if memory mappings overlap. *)
+
+val find : ('a, 'b) t -> ?start:addr -> string -> addr option
+(** Find string in a memory map and return its address (if found).
+ You can pass an optional starting address. Any holes in
+ the memory map are skipped automatically. *)
+
+val find_align : ([`Wordsize], 'b) t -> ?start:addr -> string -> addr option
+(** Find a string aligned to the wordsize in the memory map. *)
+
+val find_all : ('a, 'b) t -> ?start:addr -> string -> addr list
+(** Find all occurrences of a string in a memory map. *)
+
+val find_all_align : ([`Wordsize], 'b) t -> ?start:addr -> string -> addr list
+(** Find all occurrences of a string in a memory map. *)
+
+val find_pointer : ([`Wordsize], [`Endian]) t -> ?start:addr -> addr ->
+ addr option
+(** Find a pointer (address) in the memory map.
+ The pointer must be aligned to a word. *)
+
+val find_pointer_all : ([`Wordsize], [`Endian]) t -> ?start:addr -> addr ->
+ addr list
+(** Find all occurrences of a pointer in the memory map. *)
+
+val get_byte : ('a, 'b) t -> addr -> int
+(** Return the byte at the given address.
+
+ This may raise [Invalid_argument "get_byte"] if the address is
+ not mapped. *)
+
+val get_bytes : ('a, 'b) t -> addr -> int -> string
+(** Return the sequence of bytes starting at the given address.
+
+ This may raise [Invalid_argument "get_bytes"] if the address range
+ is not fully mapped. *)
+
+val get_string : ('a, 'b) t -> addr -> string
+(** Return the sequence of bytes starting at [addr] up to (but not
+ including) the first ASCII NUL character. In other words, this
+ returns a C-style string.
+
+ This may raise [Invalid_argument "get_string"] if we reach an
+ unmapped address before finding the end of the string.
+
+ See also {!is_string} and {!is_C_identifier}. *)
+
+val is_string : ('a, 'b) t -> addr -> bool
+(** Return true or false if the address contains an ASCII NUL-terminated
+ string. *)
+
+val is_C_identifier : ('a, 'b) t -> addr -> bool
+(** Return true or false if the address contains a NUL-terminated
+ C identifier. *)
+
+val follow_pointer : ([`Wordsize], [`Endian]) t -> addr -> addr
+(** Follow (dereference) the pointer at [addr] and return
+ the address pointed to. *)
+
+val succ_long : ([`Wordsize], 'b) t -> addr -> addr
+(** Add wordsize bytes to [addr] and return it. *)
+
+val pred_long : ([`Wordsize], 'b) t -> addr -> addr
+(** Subtract wordsize bytes from [addr] and return it. *)
--- /dev/null
+(* Memory info command for virtual domains.
+ (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
+ http://libvirt.org/
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ Common & utility functions.
+ *)
+
+open Printf
+
+let ( +^ ) = Int64.add
+let ( -^ ) = Int64.sub
+let ( *^ ) = Int64.mul
+let ( /^ ) = Int64.div
+let ( &^ ) = Int64.logand
+let ( |^ ) = Int64.logor
+
+type architecture =
+ | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64
+
+let string_of_architecture = function
+ | I386 -> "i386"
+ | X86_64 -> "x86_64"
+ | IA64 -> "ia64"
+ | PPC -> "ppc"
+ | PPC64 -> "ppc64"
+ | SPARC -> "sparc"
+ | SPARC64 -> "sparc64"
+
+let architecture_of_string = function
+ | str when
+ String.length str = 4 &&
+ (str.[0] = 'i' || str.[0] = 'I') &&
+ (str.[1] >= '3' && str.[1] <= '6') &&
+ str.[2] = '8' && str.[3] = '6' -> I386
+ | "x86_64" | "X86_64" | "x86-64" | "X86-64" -> X86_64
+ | "ia64" | "IA64" -> IA64
+ | "ppc" | "PPC" | "ppc32" | "PPC32" -> PPC
+ | "ppc64" | "PPC64" -> PPC64
+ | "sparc" | "SPARC" | "sparc32" | "SPARC32" -> SPARC
+ | "sparc64" | "SPARC64" -> SPARC64
+ | str ->
+ failwith (sprintf "architecture_of_string: %s: unknown architecture"
+ str)
+
+let endian_of_architecture = function
+ | I386 | X86_64 -> Bitmatch.LittleEndian
+ | IA64 -> Bitmatch.LittleEndian (* XXX usually? *)
+ | PPC | PPC64 | SPARC | SPARC64 -> Bitmatch.BigEndian
+
+type wordsize =
+ | W32 | W64
+
+let wordsize_of_architecture = function
+ | I386 -> W32
+ | X86_64 -> W64
+ | IA64 -> W64
+ | PPC -> W32
+ | PPC64 -> W64
+ | SPARC -> W32
+ | SPARC64 -> W64
+
+let bits_of_wordsize = function
+ | W32 -> 32 | W64 -> 64
+let bytes_of_wordsize = function
+ | W32 -> 4 | W64 -> 8
+
+(* Returns (count, value) in order of highest frequency occurring in the
+ * list.
+ *)
+let frequency xs =
+ let xs = List.sort compare xs in
+ let rec loop = function
+ | [] -> []
+ | [x] -> [1, x]
+ | x :: y :: xs when x = y ->
+ let rest = loop (y :: xs) in
+ let (count, _), rest = List.hd rest, List.tl rest in
+ (count+1, y) :: rest
+ | x :: xs ->
+ (1, x) :: loop xs
+ in
+ let xs = loop xs in
+ List.rev (List.sort compare xs)
git.annexia.org / virt-mem.git / commitdiff