# HG changeset patch
# User kfraser@xxxxxxxxxxxxxxxxxxxxx
# Date 1159524781 -3600
# Node ID 80388aea02a19cf6b43aad8742d3a53ce2cb48c6
# Parent e5cdebf9d8ef6f3d3da97da527e8a87921354dca
Remove dead pdb code from tools directory.
Signed-off-by: Keir Fraser <keir@xxxxxxxxxxxxx>
---
tools/debugger/pdb/Domain.ml | 61
tools/debugger/pdb/Domain.mli | 39
tools/debugger/pdb/Intel.ml | 66 -
tools/debugger/pdb/Makefile | 57
tools/debugger/pdb/OCamlMakefile | 1149 ------------------
tools/debugger/pdb/PDB.ml | 342 -----
tools/debugger/pdb/Process.ml | 79 -
tools/debugger/pdb/Process.mli | 41
tools/debugger/pdb/Util.ml | 165 --
tools/debugger/pdb/Xen_domain.ml | 43
tools/debugger/pdb/Xen_domain.mli | 25
tools/debugger/pdb/debugger.ml | 372 -----
tools/debugger/pdb/evtchn.ml | 40
tools/debugger/pdb/evtchn.mli | 19
tools/debugger/pdb/linux-2.6-module/Makefile | 21
tools/debugger/pdb/linux-2.6-module/debug.c | 851 -------------
tools/debugger/pdb/linux-2.6-module/module.c | 337 -----
tools/debugger/pdb/linux-2.6-module/pdb_debug.h | 47
tools/debugger/pdb/linux-2.6-module/pdb_module.h | 142 --
tools/debugger/pdb/linux-2.6-patches/Makefile | 11
tools/debugger/pdb/linux-2.6-patches/i386_ksyms.patch | 18
tools/debugger/pdb/linux-2.6-patches/kdebug.patch | 10
tools/debugger/pdb/linux-2.6-patches/makefile.patch | 10
tools/debugger/pdb/linux-2.6-patches/ptrace.patch | 10
tools/debugger/pdb/linux-2.6-patches/traps.patch | 19
tools/debugger/pdb/pdb_caml_domain.c | 527 --------
tools/debugger/pdb/pdb_caml_evtchn.c | 186 --
tools/debugger/pdb/pdb_caml_process.c | 587 ---------
tools/debugger/pdb/pdb_caml_xc.c | 170 --
tools/debugger/pdb/pdb_caml_xcs.c | 307 ----
tools/debugger/pdb/pdb_caml_xen.h | 39
tools/debugger/pdb/pdb_xen.c | 75 -
tools/debugger/pdb/readme | 96 -
tools/debugger/pdb/server.ml | 241 ---
tools/debugger/pdb/xcs.ml | 85 -
tools/debugger/pdb/xcs.mli | 13
36 files changed, 6300 deletions(-)
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Domain.ml
--- a/tools/debugger/pdb/Domain.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,61 +0,0 @@
-(** Domain.ml
- *
- * domain context implementation
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Int32
-open Intel
-
-type context_t =
-{
- mutable domain : int;
- mutable vcpu : int
-}
-
-let default_context = { domain = 0; vcpu = 0 }
-
-let new_context new_dom new_vcpu = {domain = new_dom; vcpu = new_vcpu}
-
-let set_domain ctx value =
- ctx.domain <- value
-
-let set_vcpu ctx value =
- ctx.vcpu <- value
-
-let get_domain ctx =
- ctx.domain
-
-let get_vcpu ctx =
- ctx.vcpu
-
-let string_of_context ctx =
- Printf.sprintf "{domain} domain: %d, vcpu: %d"
- ctx.domain ctx.vcpu
-
-external read_register : context_t -> int -> int32 = "dom_read_register"
-external read_registers : context_t -> registers = "dom_read_registers"
-external write_register : context_t -> register -> int32 -> unit =
- "dom_write_register"
-external read_memory : context_t -> int32 -> int -> int list =
- "dom_read_memory"
-external write_memory : context_t -> int32 -> int list -> unit =
- "dom_write_memory"
-
-external continue : context_t -> unit = "dom_continue_target"
-external step : context_t -> unit = "dom_step_target"
-
-external insert_memory_breakpoint : context_t -> int32 -> int -> unit =
- "dom_insert_memory_breakpoint"
-external remove_memory_breakpoint : context_t -> int32 -> int -> unit =
- "dom_remove_memory_breakpoint"
-
-external attach_debugger : int -> int -> unit = "dom_attach_debugger"
-external detach_debugger : int -> int -> unit = "dom_detach_debugger"
-external pause_target : int -> unit = "dom_pause_target"
-
-let pause ctx =
- pause_target ctx.domain
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Domain.mli
--- a/tools/debugger/pdb/Domain.mli Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-(** Domain.mli
- *
- * domain context interface
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Int32
-open Intel
-
-type context_t
-
-val default_context : context_t
-val new_context : int -> int -> context_t
-
-val set_domain : context_t -> int -> unit
-val get_domain : context_t -> int
-val set_vcpu : context_t -> int -> unit
-val get_vcpu : context_t -> int
-
-val string_of_context : context_t -> string
-
-val read_register : context_t -> int -> int32
-val read_registers : context_t -> registers
-val write_register : context_t -> register -> int32 -> unit
-val read_memory : context_t -> int32 -> int -> int list
-val write_memory : context_t -> int32 -> int list -> unit
-
-val continue : context_t -> unit
-val step : context_t -> unit
-
-val insert_memory_breakpoint : context_t -> int32 -> int -> unit
-val remove_memory_breakpoint : context_t -> int32 -> int -> unit
-
-val attach_debugger : int -> int -> unit
-val detach_debugger : int -> int -> unit
-val pause : context_t -> unit
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Intel.ml
--- a/tools/debugger/pdb/Intel.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,66 +0,0 @@
-(** Intel.ml
- *
- * various sundry Intel x86 definitions
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-
-type register =
- | EAX
- | ECX
- | EDX
- | EBX
- | ESP
- | EBP
- | ESI
- | EDI
- | EIP
- | EFL
- | CS
- | SS
- | DS
- | ES
- | FS
- | GS
-
-type registers =
- { eax : int32;
- ecx : int32;
- edx : int32;
- ebx : int32;
- esp : int32;
- ebp : int32;
- esi : int32;
- edi : int32;
- eip : int32;
- efl : int32;
- cs : int32;
- ss : int32;
- ds : int32;
- es : int32;
- fs : int32;
- gs : int32
- }
-
-let null_registers =
- { eax = 0l;
- ecx = 0l;
- edx = 0l;
- ebx = 0l;
- esp = 0l;
- ebp = 0l;
- esi = 0l;
- edi = 0l;
- eip = 0l;
- efl = 0l;
- cs = 0l;
- ss = 0l;
- ds = 0l;
- es = 0l;
- fs = 0l;
- gs = 0l
- }
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Makefile
--- a/tools/debugger/pdb/Makefile Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,57 +0,0 @@
-OCAMLMAKEFILE = OCamlMakefile
-
-XEN_ROOT = ../../..
-include $(XEN_ROOT)/tools/Rules.mk
-
-# overwrite LDFLAGS from xen/tool/Rules.mk
-# otherwise, ocamlmktop gets confused.
-LDFLAGS =
-
-# force ocaml 3.08
-OCAML_ROOT = /usr/local
-OCAMLC = $(OCAML_ROOT)/bin/ocamlc
-OCAMLMKTOP = $(OCAML_ROOT)/bin/ocamlmktop
-OCAMLLIBPATH= $(OCAML_ROOT)/lib/ocaml
-
-INCLUDES += -I $(XEN_XC)
-INCLUDES += -I $(XEN_LIBXC)
-INCLUDES += -I ../libxendebug
-INCLUDES += -I ./linux-2.6-module
-INCLUDES += -I $(OCAML_ROOT)/lib/ocaml
-
-CFLAGS += $(INCLUDES)
-CFLAGS += -Werror
-CFLAGS += -g
-
-CLIBS += xc
-CLIBS += xendebug
-
-LIBDIRS += $(XEN_LIBXC)
-LIBDIRS += ../libxendebug
-
-LIBS += unix str
-
-# bc = byte-code, dc = debug byte-code
-# patches = patch linux domU source code
-.PHONY: all
-all : dc
-
-SOURCES += pdb_caml_xc.c
-SOURCES += pdb_caml_domain.c pdb_caml_process.c
-SOURCES += pdb_caml_evtchn.c pdb_caml_xcs.c pdb_xen.c
-SOURCES += Util.ml Intel.ml
-SOURCES += evtchn.ml evtchn.mli
-SOURCES += xcs.ml xcs.mli
-SOURCES += Xen_domain.ml Xen_domain.mli
-SOURCES += Domain.ml Process.ml
-SOURCES += Domain.mli Process.mli
-SOURCES += PDB.ml debugger.ml server.ml
-
-RESULT = pdb
-
-include $(OCAMLMAKEFILE)
-
-PATCHDIR = ./linux-2.6-patches
-.PHONY: patches
-patches :
- make -C $(PATCHDIR) patches
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/OCamlMakefile
--- a/tools/debugger/pdb/OCamlMakefile Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1149 +0,0 @@
-###########################################################################
-# OCamlMakefile
-# Copyright (C) 1999-2004 Markus Mottl
-#
-# For updates see:
-# http://www.oefai.at/~markus/ocaml_sources
-#
-# $Id: OCamlMakefile,v 1.1 2005/05/19 09:30:48 root Exp $
-#
-###########################################################################
-
-# Modified by damien for .glade.ml compilation
-
-# Set these variables to the names of the sources to be processed and
-# the result variable. Order matters during linkage!
-
-ifndef SOURCES
- SOURCES := foo.ml
-endif
-export SOURCES
-
-ifndef RES_CLIB_SUF
- RES_CLIB_SUF := _stubs
-endif
-export RES_CLIB_SUF
-
-ifndef RESULT
- RESULT := foo
-endif
-export RESULT
-
-export LIB_PACK_NAME
-
-ifndef DOC_FILES
- DOC_FILES := $(filter %.mli, $(SOURCES))
-endif
-export DOC_FILES
-
-export BCSUFFIX
-export NCSUFFIX
-
-ifndef TOPSUFFIX
- TOPSUFFIX := .top
-endif
-export TOPSUFFIX
-
-# Eventually set include- and library-paths, libraries to link,
-# additional compilation-, link- and ocamlyacc-flags
-# Path- and library information needs not be written with "-I" and such...
-# Define THREADS if you need it, otherwise leave it unset (same for
-# USE_CAMLP4)!
-
-export THREADS
-export VMTHREADS
-export ANNOTATE
-export USE_CAMLP4
-
-export INCDIRS
-export LIBDIRS
-export EXTLIBDIRS
-export RESULTDEPS
-export OCAML_DEFAULT_DIRS
-
-export LIBS
-export CLIBS
-
-export OCAMLFLAGS
-export OCAMLNCFLAGS
-export OCAMLBCFLAGS
-
-export OCAMLLDFLAGS
-export OCAMLNLDFLAGS
-export OCAMLBLDFLAGS
-
-ifndef OCAMLCPFLAGS
- OCAMLCPFLAGS := a
-endif
-
-export OCAMLCPFLAGS
-
-export PPFLAGS
-
-export YFLAGS
-export IDLFLAGS
-
-export OCAMLDOCFLAGS
-
-export OCAMLFIND_INSTFLAGS
-
-export DVIPSFLAGS
-
-export STATIC
-
-# Add a list of optional trash files that should be deleted by "make clean"
-export TRASH
-
-#################### variables depending on your OCaml-installation
-
-ifdef MINGW
- export MINGW
- WIN32 := 1
- CFLAGS_WIN32 := -mno-cygwin
-endif
-ifdef MSVC
- export MSVC
- WIN32 := 1
- ifndef STATIC
- CPPFLAGS_WIN32 := -DCAML_DLL
- endif
- CFLAGS_WIN32 += -nologo
- EXT_OBJ := obj
- EXT_LIB := lib
- ifeq ($(CC),gcc)
- # work around GNU Make default value
- ifdef THREADS
- CC := cl -MT
- else
- CC := cl
- endif
- endif
- ifeq ($(CXX),g++)
- # work around GNU Make default value
- CXX := $(CC)
- endif
- CFLAG_O := -Fo
-endif
-ifdef WIN32
- EXT_CXX := cpp
- EXE := .exe
-endif
-
-ifndef EXT_OBJ
- EXT_OBJ := o
-endif
-ifndef EXT_LIB
- EXT_LIB := a
-endif
-ifndef EXT_CXX
- EXT_CXX := cc
-endif
-ifndef EXE
- EXE := # empty
-endif
-ifndef CFLAG_O
- CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)!
-endif
-
-export CC
-export CXX
-export CFLAGS
-export CXXFLAGS
-export LDFLAGS
-export CPPFLAGS
-
-ifndef RPATH_FLAG
- RPATH_FLAG := -R
-endif
-export RPATH_FLAG
-
-ifndef MSVC
-ifndef PIC_CFLAGS
- PIC_CFLAGS := -fPIC
-endif
-ifndef PIC_CPPFLAGS
- PIC_CPPFLAGS := -DPIC
-endif
-endif
-
-export PIC_CFLAGS
-export PIC_CPPFLAGS
-
-BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT))
-NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT))
-TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT))
-
-ifndef OCAMLFIND
- OCAMLFIND := ocamlfind
-endif
-export OCAMLFIND
-
-ifndef OCAMLC
- OCAMLC := ocamlc
-endif
-export OCAMLC
-
-ifndef OCAMLOPT
- OCAMLOPT := ocamlopt
-endif
-export OCAMLOPT
-
-ifndef OCAMLMKTOP
- OCAMLMKTOP := ocamlmktop
-endif
-export OCAMLMKTOP
-
-ifndef OCAMLCP
- OCAMLCP := ocamlcp
-endif
-export OCAMLCP
-
-ifndef OCAMLDEP
- OCAMLDEP := ocamldep
-endif
-export OCAMLDEP
-
-ifndef OCAMLLEX
- OCAMLLEX := ocamllex
-endif
-export OCAMLLEX
-
-ifndef OCAMLYACC
- OCAMLYACC := ocamlyacc
-endif
-export OCAMLYACC
-
-ifndef OCAMLMKLIB
- OCAMLMKLIB := ocamlmklib
-endif
-export OCAMLMKLIB
-
-ifndef OCAML_GLADECC
- OCAML_GLADECC := lablgladecc2
-endif
-export OCAML_GLADECC
-
-ifndef OCAML_GLADECC_FLAGS
- OCAML_GLADECC_FLAGS :=
-endif
-export OCAML_GLADECC_FLAGS
-
-ifndef CAMELEON_REPORT
- CAMELEON_REPORT := report
-endif
-export CAMELEON_REPORT
-
-ifndef CAMELEON_REPORT_FLAGS
- CAMELEON_REPORT_FLAGS :=
-endif
-export CAMELEON_REPORT_FLAGS
-
-ifndef CAMELEON_ZOGGY
- CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo
-endif
-export CAMELEON_ZOGGY
-
-ifndef CAMELEON_ZOGGY_FLAGS
- CAMELEON_ZOGGY_FLAGS :=
-endif
-export CAMELEON_ZOGGY_FLAGS
-
-ifndef OXRIDL
- OXRIDL := oxridl
-endif
-export OXRIDL
-
-ifndef CAMLIDL
- CAMLIDL := camlidl
-endif
-export CAMLIDL
-
-ifndef CAMLIDLDLL
- CAMLIDLDLL := camlidldll
-endif
-export CAMLIDLDLL
-
-ifndef NOIDLHEADER
- MAYBE_IDL_HEADER := -header
-endif
-export NOIDLHEADER
-
-export NO_CUSTOM
-
-ifndef CAMLP4
- CAMLP4 := camlp4
-endif
-export CAMLP4
-
-ifndef REAL_OCAMLFIND
- ifdef PACKS
- ifndef CREATE_LIB
- ifdef THREADS
- PACKS += threads
- endif
- endif
- empty :=
- space := $(empty) $(empty)
- comma := ,
- ifdef PREDS
- PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS))
- PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS))
- OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES)
- # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES)
- OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package
$(PRE_OCAML_FIND_PACKAGES)
- OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package
$(PRE_OCAML_FIND_PACKAGES)
- else
- OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS))
- OCAML_DEP_PACKAGES :=
- endif
- OCAML_FIND_LINKPKG := -linkpkg
- REAL_OCAMLFIND := $(OCAMLFIND)
- endif
-endif
-
-export OCAML_FIND_PACKAGES
-export OCAML_DEP_PACKAGES
-export OCAML_FIND_LINKPKG
-export REAL_OCAMLFIND
-
-ifndef OCAMLDOC
- OCAMLDOC := ocamldoc
-endif
-export OCAMLDOC
-
-ifndef LATEX
- LATEX := latex
-endif
-export LATEX
-
-ifndef DVIPS
- DVIPS := dvips
-endif
-export DVIPS
-
-ifndef PS2PDF
- PS2PDF := ps2pdf
-endif
-export PS2PDF
-
-ifndef OCAMLMAKEFILE
- OCAMLMAKEFILE := OCamlMakefile
-endif
-export OCAMLMAKEFILE
-
-ifndef OCAMLLIBPATH
- OCAMLLIBPATH := \
- $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml)
-endif
-export OCAMLLIBPATH
-
-ifndef OCAML_LIB_INSTALL
- OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib
-endif
-export OCAML_LIB_INSTALL
-
-###########################################################################
-
-#################### change following sections only if
-#################### you know what you are doing!
-
-# delete target files when a build command fails
-.PHONY: .DELETE_ON_ERROR
-.DELETE_ON_ERROR:
-
-# for pedants using "--warn-undefined-variables"
-export MAYBE_IDL
-export REAL_RESULT
-export CAMLIDLFLAGS
-export THREAD_FLAG
-export RES_CLIB
-export MAKEDLL
-export ANNOT_FLAG
-export C_OXRIDL
-export SUBPROJS
-export CFLAGS_WIN32
-export CPPFLAGS_WIN32
-
-INCFLAGS :=
-
-SHELL := /bin/sh
-
-MLDEPDIR := ._d
-BCDIDIR := ._bcdi
-NCDIDIR := ._ncdi
-
-FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep
%.zog %.glade
-
-FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES))
-SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED))))
-
-FILTERED_REP := $(filter %.rep, $(FILTERED))
-DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d)
-AUTO_REP := $(FILTERED_REP:.rep=.ml)
-
-FILTERED_ZOG := $(filter %.zog, $(FILTERED))
-DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d)
-AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml)
-
-FILTERED_GLADE := $(filter %.glade, $(FILTERED))
-DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d)
-AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml)
-
-FILTERED_ML := $(filter %.ml, $(FILTERED))
-DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d)
-
-FILTERED_MLI := $(filter %.mli, $(FILTERED))
-DEP_MLI := $(FILTERED_MLI:.mli=.di)
-
-FILTERED_MLL := $(filter %.mll, $(FILTERED))
-DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d)
-AUTO_MLL := $(FILTERED_MLL:.mll=.ml)
-
-FILTERED_MLY := $(filter %.mly, $(FILTERED))
-DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di)
-AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml)
-
-FILTERED_IDL := $(filter %.idl, $(FILTERED))
-DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di)
-C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c)
-ifndef NOIDLHEADER
- C_IDL += $(FILTERED_IDL:.idl=.h)
-endif
-OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ))
-AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL)
-
-FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED))
-DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d)
$(FILTERED_OXRIDL:.oxridl=.di)
-AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli)
$(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL)
-
-FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED))
-OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ))
-OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ))
-
-PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG)
$(AUTO_REP) $(AUTO_GLADE)
-
-ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL)
$(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE)
-
-MLDEPS := $(filter %.d, $(ALL_DEPS))
-MLIDEPS := $(filter %.di, $(ALL_DEPS))
-BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di)
-NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di)
-
-ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog
%.glade, $(FILTERED))
-
-IMPLO_INTF := $(ALLML:%.mli=%.mli.__)
-IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \
- $(basename $(file)).cmi $(basename $(file)).cmo)
-IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF))
-IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi)
-
-IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx)
-
-INTF := $(filter %.cmi, $(IMPLO_INTF))
-IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF))
-IMPL_CMX := $(IMPL_CMO:.cmo=.cmx)
-IMPL_ASM := $(IMPL_CMO:.cmo=.asm)
-IMPL_S := $(IMPL_CMO:.cmo=.s)
-
-OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX)
-OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK)
-
-EXECS := $(addsuffix $(EXE), \
- $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT)))
-ifdef WIN32
- EXECS += $(BCRESULT).dll $(NCRESULT).dll
-endif
-
-CLIB_BASE := $(RESULT)$(RES_CLIB_SUF)
-ifneq ($(strip $(OBJ_LINK)),)
- RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB)
-endif
-
-ifdef WIN32
-DLLSONAME := $(CLIB_BASE).dll
-else
-DLLSONAME := dll$(CLIB_BASE).so
-endif
-
-NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \
- $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \
- $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \
- $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \
- $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \
- $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx
$(LIB_PACK_NAME).o
-
-ifndef STATIC
- NONEXECS += $(DLLSONAME)
-endif
-
-ifndef LIBINSTALL_FILES
- LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \
- $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB)
- ifndef STATIC
- ifneq ($(strip $(OBJ_LINK)),)
- LIBINSTALL_FILES += $(DLLSONAME)
- endif
- endif
-endif
-
-export LIBINSTALL_FILES
-
-ifdef WIN32
- # some extra stuff is created while linking DLLs
- NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp
$(CLIB_BASE).exp $(CLIB_BASE).lib
-endif
-
-TARGETS := $(EXECS) $(NONEXECS)
-
-# If there are IDL-files
-ifneq ($(strip $(FILTERED_IDL)),)
- MAYBE_IDL := -cclib -lcamlidl
-endif
-
-ifdef USE_CAMLP4
- CAMLP4PATH := \
- $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4)
- INCFLAGS := -I $(CAMLP4PATH)
- CINCFLAGS := -I$(CAMLP4PATH)
-endif
-
-DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %)
-INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %)
-CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%)
-
-ifndef MSVC
-CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \
- $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \
- $(OCAML_DEFAULT_DIRS:%=-L%)
-endif
-
-ifndef PROFILING
- INTF_OCAMLC := $(OCAMLC)
-else
- ifndef THREADS
- INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS)
- else
- # OCaml does not support profiling byte code
- # with threads (yet), therefore we force an error.
- ifndef REAL_OCAMLC
- $(error Profiling of multithreaded byte code not yet supported by OCaml)
- endif
- INTF_OCAMLC := $(OCAMLC)
- endif
-endif
-
-ifndef MSVC
-COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \
- $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \
- $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \
- $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)
-else
-COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%)
$(SOURCE_DIRS:%=-LIBPATH:%) \
- $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \
- $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) "
-endif
-
-CLIBS_OPTS := $(CLIBS:%=-cclib -l%)
-ifdef MSVC
- ifndef STATIC
- # MSVC libraries do not have 'lib' prefix
- CLIBS_OPTS := $(CLIBS:%=-cclib %.lib)
- endif
-endif
-
-ifneq ($(strip $(OBJ_LINK)),)
- ifdef CREATE_LIB
- OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL)
- else
- OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL)
- endif
-else
- OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL)
-endif
-
-# If we have to make byte-code
-ifndef REAL_OCAMLC
- BYTE_OCAML := y
-
- # EXTRADEPS is added dependencies we have to insert for all
- # executable files we generate. Ideally it should be all of the
- # libraries we use, but it's hard to find the ones that get searched on
- # the path since I don't know the paths built into the compiler, so
- # just include the ones with slashes in their names.
- EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring
/,$(i)),$(i))))
- SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
-
- REAL_OCAMLC := $(INTF_OCAMLC)
-
- REAL_IMPL := $(IMPL_CMO)
- REAL_IMPL_INTF := $(IMPLO_INTF)
- IMPL_SUF := .cmo
-
- DEPFLAGS :=
- MAKE_DEPS := $(MLDEPS) $(BCDEPIS)
-
- ifdef CREATE_LIB
- CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
- CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
- ifndef STATIC
- ifneq ($(strip $(OBJ_LINK)),)
- MAKEDLL := $(DLLSONAME)
- ALL_LDFLAGS := -dllib $(DLLSONAME)
- endif
- endif
- endif
-
- ifndef NO_CUSTOM
- ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" ""
- ALL_LDFLAGS += -custom
- endif
- endif
-
- ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \
- $(COMMON_LDFLAGS) $(LIBS:%=%.cma)
- CAMLIDLDLLFLAGS :=
-
- ifdef THREADS
- ifdef VMTHREADS
- THREAD_FLAG := -vmthread
- else
- THREAD_FLAG := -thread
- endif
- ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
- ifndef CREATE_LIB
- ifndef REAL_OCAMLFIND
- ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
- endif
- endif
- endif
-
-# we have to make native-code
-else
- EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring
/,$(i)),$(i))))
- ifndef PROFILING
- SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
- PLDFLAGS :=
- else
- SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS)
- PLDFLAGS := -p
- endif
-
- REAL_IMPL := $(IMPL_CMX)
- REAL_IMPL_INTF := $(IMPLX_INTF)
- IMPL_SUF := .cmx
-
- CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS)
-
- DEPFLAGS := -native
- MAKE_DEPS := $(MLDEPS) $(NCDEPIS)
-
- ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \
- $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS)
- CAMLIDLDLLFLAGS := -opt
-
- ifndef CREATE_LIB
- ALL_LDFLAGS += $(LIBS:%=%.cmxa)
- else
- CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
- CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
- endif
-
- ifdef THREADS
- THREAD_FLAG := -thread
- ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
- ifndef CREATE_LIB
- ifndef REAL_OCAMLFIND
- ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
- endif
- endif
- endif
-endif
-
-export MAKE_DEPS
-
-ifdef ANNOTATE
- ANNOT_FLAG := -dtypes
-else
-endif
-
-ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \
- $(INCFLAGS) $(SPECIAL_OCAMLFLAGS)
-
-ifdef make_deps
- -include $(MAKE_DEPS)
- PRE_TARGETS :=
-endif
-
-###########################################################################
-# USER RULES
-
-# Call "OCamlMakefile QUIET=" to get rid of all of the @'s.
-QUIET=@
-
-# generates byte-code (default)
-byte-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
- REAL_RESULT="$(BCRESULT)" make_deps=yes
-bc: byte-code
-
-byte-code-nolink: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
- REAL_RESULT="$(BCRESULT)" make_deps=yes
-bcnl: byte-code-nolink
-
-top: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \
- REAL_RESULT="$(BCRESULT)" make_deps=yes
-
-# generates native-code
-
-native-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
- REAL_RESULT="$(NCRESULT)" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- make_deps=yes
-nc: native-code
-
-native-code-nolink: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
- REAL_RESULT="$(NCRESULT)" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- make_deps=yes
-ncnl: native-code-nolink
-
-# generates byte-code libraries
-byte-code-library: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(BCRESULT).cma \
- REAL_RESULT="$(BCRESULT)" \
- CREATE_LIB=yes \
- make_deps=yes
-bcl: byte-code-library
-
-# generates native-code libraries
-native-code-library: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(NCRESULT).cmxa \
- REAL_RESULT="$(NCRESULT)" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- CREATE_LIB=yes \
- make_deps=yes
-ncl: native-code-library
-
-ifdef WIN32
-# generates byte-code dll
-byte-code-dll: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(BCRESULT).dll \
- REAL_RESULT="$(BCRESULT)" \
- make_deps=yes
-bcd: byte-code-dll
-
-# generates native-code dll
-native-code-dll: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(NCRESULT).dll \
- REAL_RESULT="$(NCRESULT)" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- make_deps=yes
-ncd: native-code-dll
-endif
-
-# generates byte-code with debugging information
-debug-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
- REAL_RESULT="$(BCRESULT)" make_deps=yes \
- OCAMLFLAGS="-g $(OCAMLFLAGS)" \
- OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
-dc: debug-code
-
-debug-code-nolink: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
- REAL_RESULT="$(BCRESULT)" make_deps=yes \
- OCAMLFLAGS="-g $(OCAMLFLAGS)" \
- OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
-dcnl: debug-code-nolink
-
-# generates byte-code libraries with debugging information
-debug-code-library: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(BCRESULT).cma \
- REAL_RESULT="$(BCRESULT)" make_deps=yes \
- CREATE_LIB=yes \
- OCAMLFLAGS="-g $(OCAMLFLAGS)" \
- OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
-dcl: debug-code-library
-
-# generates byte-code for profiling
-profiling-byte-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
- REAL_RESULT="$(BCRESULT)" PROFILING="y" \
- make_deps=yes
-pbc: profiling-byte-code
-
-# generates native-code
-
-profiling-native-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
- REAL_RESULT="$(NCRESULT)" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- PROFILING="y" \
- make_deps=yes
-pnc: profiling-native-code
-
-# generates byte-code libraries
-profiling-byte-code-library: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(BCRESULT).cma \
- REAL_RESULT="$(BCRESULT)" PROFILING="y" \
- CREATE_LIB=yes \
- make_deps=yes
-pbcl: profiling-byte-code-library
-
-# generates native-code libraries
-profiling-native-code-library: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(RES_CLIB) $(NCRESULT).cmxa \
- REAL_RESULT="$(NCRESULT)" PROFILING="y" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- CREATE_LIB=yes \
- make_deps=yes
-pncl: profiling-native-code-library
-
-# packs byte-code objects
-pack-byte-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \
- REAL_RESULT="$(BCRESULT)" \
- PACK_LIB=yes make_deps=yes
-pabc: pack-byte-code
-
-# packs native-code objects
-pack-native-code: $(PRE_TARGETS)
- $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
- $(NCRESULT).cmx $(NCRESULT).o \
- REAL_RESULT="$(NCRESULT)" \
- REAL_OCAMLC="$(OCAMLOPT)" \
- PACK_LIB=yes make_deps=yes
-panc: pack-native-code
-
-# generates HTML-documentation
-htdoc: doc/$(RESULT)/html
-
-# generates Latex-documentation
-ladoc: doc/$(RESULT)/latex
-
-# generates PostScript-documentation
-psdoc: doc/$(RESULT)/latex/doc.ps
-
-# generates PDF-documentation
-pdfdoc: doc/$(RESULT)/latex/doc.pdf
-
-# generates all supported forms of documentation
-doc: htdoc ladoc psdoc pdfdoc
-
-###########################################################################
-# LOW LEVEL RULES
-
-$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
$(RESULTDEPS)
- $(REAL_OCAMLFIND) $(REAL_OCAMLC) \
- $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
- $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
- $(REAL_IMPL)
-
-nolink: $(REAL_IMPL_INTF) $(OBJ_LINK)
-
-ifdef WIN32
-$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK)
- $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \
- -o $@ $(REAL_IMPL)
-endif
-
-%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
- $(REAL_OCAMLFIND) $(OCAMLMKTOP) \
- $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
- $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
- $(REAL_IMPL)
-
-.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \
- .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX)
.h .so \
- .rep .zog .glade
-
-ifndef STATIC
-ifdef MINGW
-$(DLLSONAME): $(OBJ_LINK)
- $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o
$@ \
- -Wl,--whole-archive $(wildcard $(foreach
dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \
- $(OCAMLLIBPATH)/ocamlrun.a \
- -Wl,--export-all-symbols \
- -Wl,--no-whole-archive
-else
-ifdef MSVC
-$(DLLSONAME): $(OBJ_LINK)
- link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \
- $(wildcard $(foreach
dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \
- $(OCAMLLIBPATH)/ocamlrun.lib
-
-else
-$(DLLSONAME): $(OBJ_LINK)
- $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \
- -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \
- $(OCAMLMKLIB_FLAGS)
-endif
-endif
-endif
-
-ifndef LIB_PACK_NAME
-$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
- $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \
- $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL)
-
-$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS)
$(RESULTDEPS)
- $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS)
$(OBJS_LIBS) \
- $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL)
-else
-ifdef BYTE_OCAML
-$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF)
- $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o
$(LIB_PACK_NAME).cmo $(REAL_IMPL)
-else
-$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF)
- $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o
$(LIB_PACK_NAME).cmx $(REAL_IMPL)
-endif
-
-$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL)
$(EXTRADEPS) $(RESULTDEPS)
- $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \
- $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS)
$(LIB_PACK_NAME).cmo
-
-$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi
$(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS)
- $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS)
$(OBJS_LIBS) \
- $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx
-endif
-
-$(RES_CLIB): $(OBJ_LINK)
-ifndef MSVC
- ifneq ($(strip $(OBJ_LINK)),)
- $(AR) rcs $@ $(OBJ_LINK)
- endif
-else
- ifneq ($(strip $(OBJ_LINK)),)
- lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK)
- endif
-endif
-
-.mli.cmi: $(EXTRADEPS)
- $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\)
\*)/\1/p;q' $<`; \
- if [ -z "$$pp" ]; then \
- echo $(REAL_OCAMLFIND) $(INTF_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c $(THREAD_FLAG) $(ANNOT_FLAG) \
- $(OCAMLFLAGS) $(INCFLAGS) $<; \
- $(REAL_OCAMLFIND) $(INTF_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c $(THREAD_FLAG) $(ANNOT_FLAG) \
- $(OCAMLFLAGS) $(INCFLAGS) $<; \
- else \
- echo $(REAL_OCAMLFIND) $(INTF_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG)
$(ANNOT_FLAG) \
- $(OCAMLFLAGS) $(INCFLAGS) $<; \
- $(REAL_OCAMLFIND) $(INTF_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG)
$(ANNOT_FLAG) \
- $(OCAMLFLAGS) $(INCFLAGS) $<; \
- fi
-
-.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS)
- $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\)
\*)/\1/p;q' $<`; \
- if [ -z "$$pp" ]; then \
- echo $(REAL_OCAMLFIND) $(REAL_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c $(ALL_OCAMLCFLAGS) $<; \
- $(REAL_OCAMLFIND) $(REAL_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c $(ALL_OCAMLCFLAGS) $<; \
- else \
- echo $(REAL_OCAMLFIND) $(REAL_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS)
$<; \
- $(REAL_OCAMLFIND) $(REAL_OCAMLC)
$(OCAML_FIND_PACKAGES) \
- -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<;
\
- fi
-
-ifdef PACK_LIB
-$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF)
$(OBJ_LINK) $(EXTRADEPS)
- $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \
- $(OBJS_LIBS) -o $@ $(REAL_IMPL)
-endif
-
-.PRECIOUS: %.ml
-%.ml: %.mll
- $(OCAMLLEX) $<
-
-.PRECIOUS: %.ml %.mli
-%.ml %.mli: %.mly
- $(OCAMLYACC) $(YFLAGS) $<
- $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\)
\*).*/\1/p;q' $<`; \
- if [ ! -z "$$pp" ]; then \
- mv $*.ml $*.ml.temporary; \
- echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \
- cat $*.ml.temporary >> $*.ml; \
- rm $*.ml.temporary; \
- mv $*.mli $*.mli.temporary; \
- echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \
- cat $*.mli.temporary >> $*.mli; \
- rm $*.mli.temporary; \
- fi
-
-
-.PRECIOUS: %.ml
-%.ml: %.rep
- $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $<
-
-.PRECIOUS: %.ml
-%.ml: %.zog
- $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@
-
-.PRECIOUS: %.ml
-%.ml: %.glade
- $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@
-
-.PRECIOUS: %.ml %.mli
-%.ml %.mli: %.oxridl
- $(OXRIDL) $<
-
-.PRECIOUS: %.ml %.mli %_stubs.c %.h
-%.ml %.mli %_stubs.c %.h: %.idl
- $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \
- $(CAMLIDLFLAGS) $<
- $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi
-
-.c.$(EXT_OBJ):
- $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \
- $(CPPFLAGS) $(CPPFLAGS_WIN32) \
- $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $<
-
-.$(EXT_CXX).$(EXT_OBJ):
- $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
- -I'$(OCAMLLIBPATH)' \
- $< $(CFLAG_O)$@
-
-$(MLDEPDIR)/%.d: %.ml
- $(QUIET)echo making $@ from $<
- $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
- $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\)
\*)/\1/p;q' $<`; \
- if [ -z "$$pp" ]; then \
- $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
- $(DINCFLAGS) $< > $@; \
- else \
- $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
- -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
- fi
-
-$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli
- $(QUIET)echo making $@ from $<
- $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
- $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\)
\*)/\1/p;q' $<`; \
- if [ -z "$$pp" ]; then \
- $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS)
$(DINCFLAGS) $< > $@; \
- else \
- $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
- -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
- fi
-
-doc/$(RESULT)/html: $(DOC_FILES)
- rm -rf $@
- mkdir -p $@
- $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
- if [ -z "$$pp" ]; then \
- echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS)
$(DOC_FILES); \
- $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
- else \
- echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS)
\
- $(INCFLAGS) $(DOC_FILES); \
- $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \
- $(INCFLAGS) $(DOC_FILES); \
- fi
-
-doc/$(RESULT)/latex: $(DOC_FILES)
- rm -rf $@
- mkdir -p $@
- $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
- if [ -z "$$pp" ]; then \
- echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \
- $(DOC_FILES) -o $@/doc.tex; \
- $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \
- -o $@/doc.tex; \
- else \
- echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \
- $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \
- $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \
- $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \
- fi
-
-doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex
- cd doc/$(RESULT)/latex && \
- $(LATEX) doc.tex && \
- $(LATEX) doc.tex && \
- $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F)
-
-doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps
- cd doc/$(RESULT)/latex && $(PS2PDF) $(<F)
-
-define make_subproj
-.PHONY:
-subproj_$(1):
- $$(eval $$(call PROJ_$(1)))
- $(QUIET)if [ "$(SUBTARGET)" != "all" ]; then \
- $(MAKE) -f $(OCAMLMAKEFILE) $(SUBTARGET); \
- fi
-endef
-
-$(foreach subproj,$(SUBPROJS),$(eval $(call make_subproj,$(subproj))))
-
-.PHONY:
-subprojs: $(SUBPROJS:%=subproj_%)
-
-###########################################################################
-# (UN)INSTALL RULES FOR LIBRARIES
-
-.PHONY: libinstall
-libinstall: all
- $(QUIET)printf "\nInstalling library with ocamlfind\n"
- $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META
$(LIBINSTALL_FILES)
- $(QUIET)printf "\nInstallation successful.\n"
-
-.PHONY: libuninstall
-libuninstall:
- $(QUIET)printf "\nUninstalling library with ocamlfind\n"
- $(OCAMLFIND) remove $(OCAMLFIND_INSTFLAGS) $(RESULT)
- $(QUIET)printf "\nUninstallation successful.\n"
-
-.PHONY: rawinstall
-rawinstall: all
- $(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n"
- -install -d $(OCAML_LIB_INSTALL)
- for i in $(LIBINSTALL_FILES); do \
- if [ -f $$i ]; then \
- install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \
- fi; \
- done
- $(QUIET)printf "\nInstallation successful.\n"
-
-.PHONY: rawuninstall
-rawuninstall:
- $(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n"
- cd $(OCAML_LIB_INSTALL) && rm $(notdir $(LIBINSTALL_FILES))
- $(QUIET)printf "\nUninstallation successful.\n"
-
-###########################################################################
-# MAINTAINANCE RULES
-
-.PHONY: clean
-clean::
- rm -f $(TARGETS) $(TRASH)
- rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
-
-.PHONY: cleanup
-cleanup::
- rm -f $(NONEXECS) $(TRASH)
- rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
-
-.PHONY: clean-doc
-clean-doc::
- rm -rf doc
-
-.PHONY: nobackup
-nobackup:
- rm -f *.bak *~ *.dup
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/PDB.ml
--- a/tools/debugger/pdb/PDB.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,342 +0,0 @@
-(** PDB.ml
- *
- * Dispatch debugger commands to the appropriate context
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Util
-
-exception Unimplemented of string
-exception Unknown_context of string
-exception Unknown_domain
-exception Unknown_process
-
-type context_t =
- | Void
- | Xen_virq
- | Xen_xcs
- | Xen_domain of Xen_domain.context_t
- | Domain of Domain.context_t
- | Process of Process.context_t
-
-let string_of_context ctx =
- match ctx with
- | Void -> "{void}"
- | Xen_virq -> "{Xen virq evtchn}"
- | Xen_xcs -> "{Xen xcs socket}"
- | Xen_domain d -> Xen_domain.string_of_context d
- | Domain d -> Domain.string_of_context d
- | Process p -> Process.string_of_context p
-
-
-let hash = Hashtbl.create 10
-
-
-(***************************************************************************)
-
-let find_context key =
- try
- Hashtbl.find hash key
- with
- Not_found ->
- print_endline "error: (find_context) PDB context not found";
- raise Not_found
-
-let delete_context key =
- Hashtbl.remove hash key
-
-
-(**
- find_process : Locate the socket associated with the context(s)
- matching a particular (domain, process id) pair. if there are multiple
- contexts (there shouldn't be), then return the first one.
- *)
-
-let find_process dom pid =
- let find key ctx list =
- match ctx with
- | Process p ->
- if (((Process.get_domain p) = dom) &&
- ((Process.get_process p) = pid))
- then
- key :: list
- else
- list
- | _ -> list
- in
- let sock_list = Hashtbl.fold find hash [] in
- match sock_list with
- | hd::tl -> hd
- | [] -> raise Unknown_process
-
-
-(**
- find_domain : Locate the socket associated with the context(s)
- matching a particular (domain, vcpu) pair. if there are multiple
- contexts (there shouldn't be), then return the first one.
- *)
-
-let find_domain dom vcpu =
- let find key ctx list =
- match ctx with
- | Domain d ->
- if (((Domain.get_domain d) = dom) &&
- ((Domain.get_vcpu d) = vcpu))
- then
- key :: list
- else
- list
- | _ -> list
- in
- let sock_list = Hashtbl.fold find hash [] in
- match sock_list with
- | hd::tl -> hd
- | [] -> raise Unknown_domain
-
-(**
- find_xen_domain_context : fetch the socket associated with the
- xen_domain context for a domain. if there are multiple contexts
- (there shouldn't be), then return the first one.
- *)
-
-let find_xen_domain_context domain =
- let find key ctx list =
- match ctx with
- | Xen_domain d ->
- if ((Xen_domain.get_domain d) = domain)
- then
- key :: list
- else
- list
- | _ -> list
- in
- let sock_list = Hashtbl.fold find hash [] in
- match sock_list with
- | hd::tl -> hd
- | [] -> raise Unknown_domain
-
-let attach_debugger ctx =
- match ctx with
- | Domain d -> Domain.attach_debugger (Domain.get_domain d)
- (Domain.get_vcpu d)
- | Process p ->
- begin
- let xdom_sock = find_xen_domain_context (Process.get_domain p) in
- let xdom_ctx = find_context xdom_sock in
- begin
- match xdom_ctx with
- | Xen_domain d ->
- Process.attach_debugger p d
- | _ -> failwith ("context has wrong xen domain type")
- end;
- raise No_reply
- end
- | _ -> raise (Unimplemented "attach debugger")
-
-let detach_debugger ctx =
- match ctx with
- | Domain d ->
- Domain.detach_debugger (Domain.get_domain d)
- (Domain.get_vcpu d);
- "OK"
- | Process p ->
- Process.detach_debugger p;
- raise No_reply
- | _ -> raise (Unimplemented "detach debugger")
-
-
-let debug_contexts () =
- print_endline "context list:";
- let print_context key ctx =
- match ctx with
- | Void -> print_endline (Printf.sprintf " [%s] {void}"
- (Util.get_connection_info key))
- | Xen_virq -> print_endline (Printf.sprintf " [%s] {xen virq evtchn}"
- (Util.get_connection_info key))
- | Xen_xcs -> print_endline (Printf.sprintf " [%s] {xen xcs socket}"
- (Util.get_connection_info key))
- | Xen_domain d -> print_endline (Printf.sprintf " [%s] %s"
- (Util.get_connection_info key)
- (Xen_domain.string_of_context d))
- | Domain d -> print_endline (Printf.sprintf " [%s] %s"
- (Util.get_connection_info key)
- (Domain.string_of_context d))
- | Process p -> print_endline (Printf.sprintf " [%s] %s"
- (Util.get_connection_info key)
- (Process.string_of_context p))
- in
- Hashtbl.iter print_context hash
-
-(** add_context : add a new context to the hash table.
- * if there is an existing context for the same key then it
- * is first removed implictly by the hash table replace function.
- *)
-let add_context (key:Unix.file_descr) context params =
- match context with
- | "void" -> Hashtbl.replace hash key Void
- | "xen virq" -> Hashtbl.replace hash key Xen_virq
- | "xen xcs" -> Hashtbl.replace hash key Xen_xcs
- | "domain" ->
- begin
- match params with
- | dom::vcpu::_ ->
- let d = Domain(Domain.new_context dom vcpu) in
- attach_debugger d;
- Hashtbl.replace hash key d
- | _ -> failwith "bogus parameters to domain context"
- end
- | "process" ->
- begin
- match params with
- | dom::pid::_ ->
- let p = Process(Process.new_context dom pid) in
- Hashtbl.replace hash key p;
- attach_debugger p
- | _ -> failwith "bogus parameters to process context"
- end
- | "xen domain"
- | _ -> raise (Unknown_context context)
-
-(*
- * this is really bogus. add_xen_domain_context should really
- * be a case within add_context. however, we need to pass in
- * a pointer that can only be represented as an int32.
- * this would require a different type for params... :(
- * 31 bit integers suck.
- *)
-let add_xen_domain_context (key:Unix.file_descr) dom evtchn sring =
- let d = Xen_domain.new_context dom evtchn sring in
- Hashtbl.replace hash key (Xen_domain(d))
-
-
-let add_default_context sock =
- add_context sock "void" []
-
-(***************************************************************************)
-
-(***************************************************************************)
-
-let read_register ctx register = (* register is int32 because of sscanf *)
- match ctx with
- | Void -> 0l (* default for startup *)
- | Domain d -> Domain.read_register d register
- | Process p ->
- begin
- Process.read_register p register;
- raise No_reply
- end
- | _ -> raise (Unimplemented "read registers")
-
-let read_registers ctx =
- match ctx with
- | Void -> Intel.null_registers (* default for startup *)
- | Domain d -> Domain.read_registers d
- | Process p ->
- begin
- Process.read_registers p;
- raise No_reply
- end
- | _ -> raise (Unimplemented "read registers")
-
-let write_register ctx register value =
- match ctx with
- | Domain d -> Domain.write_register d register value
- | Process p ->
- begin
- Process.write_register p register value;
- raise No_reply
- end
- | _ -> raise (Unimplemented "write register")
-
-
-let read_memory ctx addr len =
- match ctx with
- | Domain d -> Domain.read_memory d addr len
- | Process p ->
- begin
- Process.read_memory p addr len;
- raise No_reply
- end
- | _ -> raise (Unimplemented "read memory")
-
-let write_memory ctx addr values =
- match ctx with
- | Domain d -> Domain.write_memory d addr values
- | Process p ->
- begin
- Process.write_memory p addr values;
- raise No_reply
- end
- | _ -> raise (Unimplemented "write memory")
-
-
-let continue ctx =
- match ctx with
- | Domain d -> Domain.continue d
- | Process p -> Process.continue p
- | _ -> raise (Unimplemented "continue")
-
-let step ctx =
- match ctx with
- | Domain d -> Domain.step d
- | Process p -> Process.step p
- | _ -> raise (Unimplemented "step")
-
-
-let insert_memory_breakpoint ctx addr len =
- match ctx with
- | Domain d -> Domain.insert_memory_breakpoint d addr len
- | Process p ->
- begin
- Process.insert_memory_breakpoint p addr len;
- raise No_reply
- end
- | _ -> raise (Unimplemented "insert memory breakpoint")
-
-let remove_memory_breakpoint ctx addr len =
- match ctx with
- | Domain d -> Domain.remove_memory_breakpoint d addr len
- | Process p ->
- begin
- Process.remove_memory_breakpoint p addr len;
- raise No_reply
- end
- | _ -> raise (Unimplemented "remove memory breakpoint")
-
-let insert_watchpoint ctx kind addr len =
- match ctx with
-(* | Domain d -> Domain.insert_watchpoint d kind addr len TODO *)
- | Process p ->
- begin
- Process.insert_watchpoint p kind addr len;
- raise No_reply
- end
- | _ -> raise (Unimplemented "insert watchpoint")
-
-let remove_watchpoint ctx kind addr len =
- match ctx with
-(* | Domain d -> Domain.remove_watchpoint d kind addr len TODO *)
- | Process p ->
- begin
- Process.remove_watchpoint p kind addr len;
- raise No_reply
- end
- | _ -> raise (Unimplemented "remove watchpoint")
-
-
-let pause ctx =
- match ctx with
- | Domain d -> Domain.pause d
- | Process p -> Process.pause p
- | _ -> raise (Unimplemented "pause target")
-
-
-external open_debugger : unit -> unit = "open_context"
-external close_debugger : unit -> unit = "close_context"
-
-(* this is just the domains right now... expand to other contexts later *)
-external debugger_status : unit -> unit = "debugger_status"
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Process.ml
--- a/tools/debugger/pdb/Process.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,79 +0,0 @@
-(** Process.ml
- *
- * process context implementation
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Int32
-open Intel
-
-type context_t =
-{
- mutable domain : int;
- mutable process : int;
- mutable evtchn : int;
- mutable ring : int32;
-}
-
-let default_context = { domain = 0; process = 0; evtchn = 0; ring = 0l }
-
-let new_context dom proc = { domain = dom; process = proc;
- evtchn = 0; ring = 0l }
-
-let string_of_context ctx =
- Printf.sprintf "{process} domain: %d, process: %d"
- ctx.domain ctx.process
-
-let set_domain ctx value =
- ctx.domain <- value;
- print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain)
-
-let set_process ctx value =
- ctx.process <- value;
- print_endline (Printf.sprintf "ctx.process <- %d" ctx.process)
-
-let get_domain ctx =
- ctx.domain
-
-let get_process ctx =
- ctx.process
-
-external _attach_debugger : context_t -> unit = "proc_attach_debugger"
-external detach_debugger : context_t -> unit = "proc_detach_debugger"
-external pause_target : context_t -> unit = "proc_pause_target"
-
-(* save the event channel and ring for the domain for future use *)
-let attach_debugger proc_ctx dom_ctx =
- print_endline (Printf.sprintf "%d %lx"
- (Xen_domain.get_evtchn dom_ctx)
- (Xen_domain.get_ring dom_ctx));
- proc_ctx.evtchn <- Xen_domain.get_evtchn dom_ctx;
- proc_ctx.ring <- Xen_domain.get_ring dom_ctx;
- _attach_debugger proc_ctx
-
-external read_register : context_t -> int -> unit = "proc_read_register"
-external read_registers : context_t -> unit = "proc_read_registers"
-external write_register : context_t -> register -> int32 -> unit =
- "proc_write_register"
-external read_memory : context_t -> int32 -> int -> unit =
- "proc_read_memory"
-external write_memory : context_t -> int32 -> int list -> unit =
- "proc_write_memory"
-
-external continue : context_t -> unit = "proc_continue_target"
-external step : context_t -> unit = "proc_step_target"
-
-external insert_memory_breakpoint : context_t -> int32 -> int -> unit =
- "proc_insert_memory_breakpoint"
-external remove_memory_breakpoint : context_t -> int32 -> int -> unit =
- "proc_remove_memory_breakpoint"
-external insert_watchpoint : context_t -> int -> int32 -> int -> unit =
- "proc_insert_watchpoint"
-external remove_watchpoint : context_t -> int -> int32 -> int -> unit =
- "proc_remove_watchpoint"
-
-let pause ctx =
- pause_target ctx
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Process.mli
--- a/tools/debugger/pdb/Process.mli Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-(** Process.mli
- *
- * process context interface
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Int32
-open Intel
-
-type context_t
-
-val default_context : context_t
-val new_context : int -> int -> context_t
-
-val set_domain : context_t -> int -> unit
-val get_domain : context_t -> int
-val set_process : context_t -> int -> unit
-val get_process : context_t -> int
-
-val string_of_context : context_t -> string
-
-val attach_debugger : context_t -> Xen_domain.context_t -> unit
-val detach_debugger : context_t -> unit
-val pause : context_t -> unit
-
-val read_register : context_t -> int -> unit
-val read_registers : context_t -> unit
-val write_register : context_t -> register -> int32 -> unit
-val read_memory : context_t -> int32 -> int -> unit
-val write_memory : context_t -> int32 -> int list -> unit
-
-val continue : context_t -> unit
-val step : context_t -> unit
-
-val insert_memory_breakpoint : context_t -> int32 -> int -> unit
-val remove_memory_breakpoint : context_t -> int32 -> int -> unit
-val insert_watchpoint : context_t -> int -> int32 -> int -> unit
-val remove_watchpoint : context_t -> int -> int32 -> int -> unit
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Util.ml
--- a/tools/debugger/pdb/Util.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,165 +0,0 @@
-(** Util.ml
- *
- * various utility functions
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-let int_of_hexchar h =
- let i = int_of_char h in
- match h with
- | '0' .. '9' -> i - (int_of_char '0')
- | 'a' .. 'f' -> i - (int_of_char 'a') + 10
- | 'A' .. 'F' -> i - (int_of_char 'A') + 10
- | _ -> raise (Invalid_argument "unknown hex character")
-
-let hexchar_of_int i =
- let hexchars = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
- '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f' |]
- in
- hexchars.(i)
-
-
-(** flip the bytes of a four byte int
- *)
-
-let flip_int num =
- let a = num mod 256
- and b = (num / 256) mod 256
- and c = (num / (256 * 256)) mod 256
- and d = (num / (256 * 256 * 256)) in
- (a * 256 * 256 * 256) + (b * 256 * 256) + (c * 256) + d
-
-
-let flip_int32 num =
- let a = Int32.logand num 0xffl
- and b = Int32.logand (Int32.shift_right_logical num 8) 0xffl
- and c = Int32.logand (Int32.shift_right_logical num 16) 0xffl
- and d = (Int32.shift_right_logical num 24) in
- (Int32.logor
- (Int32.logor (Int32.shift_left a 24) (Int32.shift_left b 16))
- (Int32.logor (Int32.shift_left c 8) d))
-
-
-let int_list_of_string_list list =
- List.map (fun x -> int_of_string x) list
-
-let int_list_of_string str len =
- let array_of_string s =
- let int_array = Array.make len 0 in
- for loop = 0 to len - 1 do
- int_array.(loop) <- (Char.code s.[loop]);
- done;
- int_array
- in
- Array.to_list (array_of_string str)
-
-
-(* remove leading and trailing whitespace from a string *)
-
-let chomp str =
- let head = Str.regexp "^[ \t\r\n]+" in
- let tail = Str.regexp "[ \t\r\n]+$" in
- let str = Str.global_replace head "" str in
- Str.global_replace tail "" str
-
-(* Stupid little parser for "<key>=<value>[,<key>=<value>]*"
- It first chops the entire command at each ',', so no ',' in key or value!
- Mucked to return a list of words for "value"
- *)
-
-let list_of_string str =
- let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
- let str_list = Str.split (delim " ") str in
- List.map (fun x -> chomp(x)) str_list
-
-let little_parser fn str =
- let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
- let str_list = Str.split (delim ",") str in
- let pair s =
- match Str.split (delim "=") s with
- | [key;value] -> fn (chomp key) (list_of_string value)
- | [key] -> fn (chomp key) []
- | _ -> failwith (Printf.sprintf "error: (little_parser) parse error [%s]"
str)
- in
- List.iter pair str_list
-
-(* boolean list membership test *)
-let not_list_member the_list element =
- try
- List.find (fun x -> x = element) the_list;
- false
- with
- Not_found -> true
-
-(* a very inefficient way to remove the elements of one list from another *)
-let list_remove the_list remove_list =
- List.filter (not_list_member remove_list) the_list
-
-(* get a description of a file descriptor *)
-let get_connection_info fd =
- let get_local_info fd =
- let sockname = Unix.getsockname fd in
- match sockname with
- | Unix.ADDR_UNIX(s) -> "unix"
- | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
- (string_of_int p))
- and get_remote_info fd =
- let sockname = Unix.getpeername fd in
- match sockname with
- | Unix.ADDR_UNIX(s) -> s
- | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
- (string_of_int p))
- in
- try
- get_remote_info fd
- with
- | Unix.Unix_error (Unix.ENOTSOCK, s1, s2) ->
- let s = Unix.fstat fd in
- Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino
- | Unix.Unix_error (Unix.EBADF, s1, s2) ->
- let s = Unix.fstat fd in
- Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino
- | _ -> get_local_info fd
-
-
-(* really write a string *)
-let really_write fd str =
- let strlen = String.length str in
- let sent = ref 0 in
- while (!sent < strlen) do
- sent := !sent + (Unix.write fd str !sent (strlen - !sent))
- done
-
-let write_character fd ch =
- let str = String.create 1 in
- str.[0] <- ch;
- really_write fd str
-
-
-
-let send_reply fd reply =
- let checksum = ref 0 in
- write_character fd '$';
- for loop = 0 to (String.length reply) - 1 do
- write_character fd reply.[loop];
- checksum := !checksum + int_of_char reply.[loop]
- done;
- write_character fd '#';
- write_character fd (hexchar_of_int ((!checksum mod 256) / 16));
- write_character fd (hexchar_of_int ((!checksum mod 256) mod 16))
- (*
- * BUG NEED TO LISTEN FOR REPLY +/- AND POSSIBLY RE-TRANSMIT
- *)
-
-
-(** A few debugger commands such as step 's' and continue 'c' do
- * not immediately return a response to the debugger. In these
- * cases we raise No_reply instead.
- * This is also used by some contexts (such as Linux processes)
- * which utilize an asynchronous request / response protocol when
- * communicating with their respective backends.
- *)
-exception No_reply
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Xen_domain.ml
--- a/tools/debugger/pdb/Xen_domain.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,43 +0,0 @@
-(** Xen_domain.ml
- *
- * domain assist for debugging processes
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-type context_t =
-{
- mutable domain : int;
- mutable evtchn : int;
- mutable pdb_front_ring : int32
-}
-
-let default_context = { domain = 0; evtchn = 0; pdb_front_ring = 0l }
-
-let new_context dom evtchn ring =
- {domain = dom; evtchn = evtchn; pdb_front_ring = ring}
-
-let set_domain ctx value =
- ctx.domain <- value
-
-let set_evtchn ctx value =
- ctx.evtchn <- value
-
-let set_ring ctx value =
- ctx.pdb_front_ring <- value
-
-let get_domain ctx =
- ctx.domain
-
-let get_evtchn ctx =
- ctx.evtchn
-
-let get_ring ctx =
- ctx.pdb_front_ring
-
-let string_of_context ctx =
- Printf.sprintf "{xen domain assist} domain: %d" ctx.domain
-
-external process_response : int32 -> int * int * string =
"process_handle_response"
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/Xen_domain.mli
--- a/tools/debugger/pdb/Xen_domain.mli Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,25 +0,0 @@
-(** Xen_domain.ml
- *
- * domain assist for debugging processes
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-type context_t
-
-val default_context : context_t
-val new_context : int -> int -> int32 -> context_t
-
-val set_domain : context_t -> int -> unit
-val get_domain : context_t -> int
-val set_evtchn : context_t -> int -> unit
-val get_evtchn : context_t -> int
-val set_ring : context_t -> int32 -> unit
-val get_ring : context_t -> int32
-
-val string_of_context : context_t -> string
-
-val process_response : int32 -> int * int * string
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/debugger.ml
--- a/tools/debugger/pdb/debugger.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,372 +0,0 @@
-(** debugger.ml
- *
- * main debug functionality
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Intel
-open PDB
-open Util
-open Str
-
-let initialize_debugger () =
- ()
-
-let exit_debugger () =
- ()
-
-
-(**
- Detach Command
- Note: response is ignored by gdb. We leave the context in the
- hash. It will be cleaned up with the socket is closed.
- *)
-let gdb_detach ctx =
- PDB.detach_debugger ctx
-
-(**
- Kill Command
- Note: response is ignored by gdb. We leave the context in the
- hash. It will be cleaned up with the socket is closed.
- *)
-let gdb_kill () =
- ""
-
-
-
-(**
- Continue Command.
- resume the target
- *)
-let gdb_continue ctx =
- PDB.continue ctx;
- raise No_reply
-
-(**
- Step Command.
- single step the target
- *)
-let gdb_step ctx =
- PDB.step ctx;
- raise No_reply
-
-(**
- Read Register Command.
- return register as a 4-byte value.
- *)
-let gdb_read_register ctx command =
- let read_reg register =
- (Printf.sprintf "%08lx" (Util.flip_int32 (PDB.read_register ctx register)))
- in
- Scanf.sscanf command "p%x" read_reg
-
-
-(**
- Read Registers Command.
- returns 16 4-byte registers in a particular format defined by gdb.
- *)
-let gdb_read_registers ctx =
- let regs = PDB.read_registers ctx in
- let str =
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.eax)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.ecx)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.edx)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebx)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.esp)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebp)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.esi)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.edi)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.eip)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.efl)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.cs)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.ss)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.ds)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.es)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.fs)) ^
- (Printf.sprintf "%08lx" (Util.flip_int32 regs.gs)) in
- str
-
-(**
- Set Thread Command
- *)
-let gdb_set_thread command =
- "OK"
-
-
-(**
- Read Memory Packets
- *)
-let gdb_read_memory ctx command =
- let int_list_to_string i str =
- (Printf.sprintf "%02x" i) ^ str
- in
- let read_mem addr len =
- try
- let mem = PDB.read_memory ctx addr len in
- List.fold_right int_list_to_string mem ""
- with
- Failure s -> "E02"
- in
- Scanf.sscanf command "m%lx,%x" read_mem
-
-
-
-(**
- Write Memory Packets
- *)
-let gdb_write_memory ctx command =
- let write_mem addr len =
- print_endline (Printf.sprintf " gdb_write_memory %lx %x\n" addr len);
- print_endline (Printf.sprintf " [[ unimplemented ]]\n")
- in
- Scanf.sscanf command "M%lx,%d" write_mem;
- "OK"
-
-
-
-(**
- Write Register Packets
- *)
-let gdb_write_register ctx command =
- let write_reg reg goofy_val =
- let new_val = Util.flip_int32 goofy_val in
- match reg with
- | 0 -> PDB.write_register ctx EAX new_val
- | 1 -> PDB.write_register ctx ECX new_val
- | 2 -> PDB.write_register ctx EDX new_val
- | 3 -> PDB.write_register ctx EBX new_val
- | 4 -> PDB.write_register ctx ESP new_val
- | 5 -> PDB.write_register ctx EBP new_val
- | 6 -> PDB.write_register ctx ESI new_val
- | 7 -> PDB.write_register ctx EDI new_val
- | 8 -> PDB.write_register ctx EIP new_val
- | 9 -> PDB.write_register ctx EFL new_val
- | 10 -> PDB.write_register ctx CS new_val
- | 11 -> PDB.write_register ctx SS new_val
- | 12 -> PDB.write_register ctx DS new_val
- | 13 -> PDB.write_register ctx ES new_val
- | 14 -> PDB.write_register ctx FS new_val
- | 15 -> PDB.write_register ctx GS new_val
- | _ -> print_endline (Printf.sprintf "write unknown register [%d]" reg)
- in
- Scanf.sscanf command "P%x=%lx" write_reg;
- "OK"
-
-
-(**
- General Query Packets
- *)
-let gdb_query command =
- match command with
- | "qC" -> ""
- | "qOffsets" -> ""
- | "qSymbol::" -> ""
- | _ ->
- print_endline (Printf.sprintf "unknown gdb query packet [%s]" command);
- "E01"
-
-
-(**
- Write Memory Binary Packets
- *)
-let gdb_write_memory_binary ctx command =
- let write_mem addr len =
- let pos = Str.search_forward (Str.regexp ":") command 0 in
- let txt = Str.string_after command (pos + 1) in
- PDB.write_memory ctx addr (int_list_of_string txt len)
- in
- Scanf.sscanf command "X%lx,%d" write_mem;
- "OK"
-
-
-
-(**
- Last Signal Command
- *)
-let gdb_last_signal =
- "S00"
-
-
-
-
-(**
- Process PDB extensions to the GDB serial protocol.
- Changes the mutable context state.
- *)
-let pdb_extensions command sock =
- let process_extension key value =
- (* since this command can change the context,
- we need to grab it again each time *)
- let ctx = PDB.find_context sock in
- match key with
- | "status" ->
- PDB.debug_contexts ();
- (* print_endline ("debugger status");
- debugger_status ()
- *)
- | "context" ->
- PDB.add_context sock (List.hd value)
- (int_list_of_string_list (List.tl value))
- | _ -> failwith (Printf.sprintf "unknown pdb extension command [%s:%s]"
- key (List.hd value))
- in
- try
- Util.little_parser process_extension
- (String.sub command 1 ((String.length command) - 1));
- "OK"
- with
- | Unknown_context s ->
- print_endline (Printf.sprintf "unknown context [%s]" s);
- "E01"
- | Unknown_domain -> "E01"
- | Failure s -> "E01"
-
-
-(**
- Insert Breakpoint or Watchpoint Packet
- *)
-
-let bwc_watch_write = 102 (* from pdb_module.h *)
-let bwc_watch_read = 103
-let bwc_watch_access = 104
-
-let gdb_insert_bwcpoint ctx command =
- let insert cmd addr length =
- try
- match cmd with
- | 0 -> PDB.insert_memory_breakpoint ctx addr length; "OK"
- | 2 -> PDB.insert_watchpoint ctx bwc_watch_write addr length; "OK"
- | 3 -> PDB.insert_watchpoint ctx bwc_watch_read addr length; "OK"
- | 4 -> PDB.insert_watchpoint ctx bwc_watch_access addr length; "OK"
- | _ -> ""
- with
- Failure s -> "E03"
- in
- Scanf.sscanf command "Z%d,%lx,%x" insert
-
-(**
- Remove Breakpoint or Watchpoint Packet
- *)
-let gdb_remove_bwcpoint ctx command =
- let insert cmd addr length =
- try
- match cmd with
- | 0 -> PDB.remove_memory_breakpoint ctx addr length; "OK"
- | 2 -> PDB.remove_watchpoint ctx bwc_watch_write addr length; "OK"
- | 3 -> PDB.remove_watchpoint ctx bwc_watch_read addr length; "OK"
- | 4 -> PDB.remove_watchpoint ctx bwc_watch_access addr length; "OK"
- | _ -> ""
- with
- Failure s -> "E04"
- in
- Scanf.sscanf command "z%d,%lx,%d" insert
-
-(**
- Do Work!
-
- @param command char list
- *)
-
-let process_command command sock =
- let ctx = PDB.find_context sock in
- try
- match command.[0] with
- | 'c' -> gdb_continue ctx
- | 'D' -> gdb_detach ctx
- | 'g' -> gdb_read_registers ctx
- | 'H' -> gdb_set_thread command
- | 'k' -> gdb_kill ()
- | 'm' -> gdb_read_memory ctx command
- | 'M' -> gdb_write_memory ctx command
- | 'p' -> gdb_read_register ctx command
- | 'P' -> gdb_write_register ctx command
- | 'q' -> gdb_query command
- | 's' -> gdb_step ctx
- | 'x' -> pdb_extensions command sock
- | 'X' -> gdb_write_memory_binary ctx command
- | '?' -> gdb_last_signal
- | 'z' -> gdb_remove_bwcpoint ctx command
- | 'Z' -> gdb_insert_bwcpoint ctx command
- | _ ->
- print_endline (Printf.sprintf "unknown gdb command [%s]" command);
- ""
- with
- Unimplemented s ->
- print_endline (Printf.sprintf "loser. unimplemented command [%s][%s]"
- command s);
- "E03"
-
-(**
- process_xen_domain
-
- This is called whenever a domain debug assist responds to a
- pdb packet.
-*)
-
-let process_xen_domain fd =
- let channel = Evtchn.read fd in
- let ctx = find_context fd in
-
- let (dom, pid, str) =
- begin
- match ctx with
- | Xen_domain d -> Xen_domain.process_response (Xen_domain.get_ring d)
- | _ -> failwith ("process_xen_domain called without Xen_domain context")
- end
- in
- let sock = PDB.find_process dom pid in
- print_endline (Printf.sprintf "(linux) dom:%d pid:%d %s %s"
- dom pid str (Util.get_connection_info sock));
- Util.send_reply sock str;
- Evtchn.unmask fd channel (* allow next virq *)
-
-
-(**
- process_xen_virq
-
- This is called each time a virq_pdb is sent from xen to dom 0.
- It is sent by Xen when a domain hits a breakpoint.
-
- Think of this as the continuation function for a "c" or "s" command
- issued to a domain.
-*)
-
-external query_domain_stop : unit -> (int * int) list = "query_domain_stop"
-(* returns a list of paused domains : () -> (domain, vcpu) list *)
-
-let process_xen_virq fd =
- let channel = Evtchn.read fd in
- let find_pair (dom, vcpu) =
- print_endline (Printf.sprintf "checking %d.%d" dom vcpu);
- try
- let sock = PDB.find_domain dom vcpu in
- true
- with
- Unknown_domain -> false
- in
- let dom_list = query_domain_stop () in
- let (dom, vcpu) = List.find find_pair dom_list in
- let vec = 3 in
- let sock = PDB.find_domain dom vcpu in
- print_endline (Printf.sprintf "handle bkpt dom:%d vcpu:%d vec:%d %s"
- dom vcpu vec (Util.get_connection_info sock));
- Util.send_reply sock "S05";
- Evtchn.unmask fd channel (* allow next virq *)
-
-
-(**
- process_xen_xcs
-
- This is called each time the software assist residing in a backend
- domain starts up. The control message includes the address of a
- shared ring page and our end of an event channel (which indicates
- when data is available on the ring).
-*)
-
-let process_xen_xcs xcs_fd =
- let (local_evtchn_fd, evtchn, dom, ring) = Xcs.read xcs_fd in
- add_xen_domain_context local_evtchn_fd dom evtchn ring;
- local_evtchn_fd
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/evtchn.ml
--- a/tools/debugger/pdb/evtchn.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,40 +0,0 @@
-(** evtchn.ml
- *
- * event channel interface
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-let dev_name = "/dev/xen/evtchn" (* EVTCHN_DEV_NAME *)
-let dev_major = 10 (* EVTCHN_DEV_MAJOR *)
-let dev_minor = 201 (* EVTCHN_DEV_MINOR *)
-
-let virq_pdb = 6 (* as defined VIRQ_PDB *)
-
-external bind_virq : int -> int = "evtchn_bind_virq"
-external bind_interdomain : int -> int * int = "evtchn_bind_interdomain"
-external bind : Unix.file_descr -> int -> unit = "evtchn_bind"
-external unbind : Unix.file_descr -> int -> unit = "evtchn_unbind"
-external ec_open : string -> int -> int -> Unix.file_descr = "evtchn_open"
-external read : Unix.file_descr -> int = "evtchn_read"
-external ec_close : Unix.file_descr -> unit = "evtchn_close"
-external unmask : Unix.file_descr -> int -> unit = "evtchn_unmask"
-
-let _setup () =
- let fd = ec_open dev_name dev_major dev_minor in
- fd
-
-let _bind fd port =
- bind fd port
-
-let setup () =
- let port = bind_virq virq_pdb in
- let fd = _setup() in
- _bind fd port;
- fd
-
-let teardown fd =
- unbind fd virq_pdb;
- ec_close fd
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/evtchn.mli
--- a/tools/debugger/pdb/evtchn.mli Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,19 +0,0 @@
-(** evtchn.mli
- *
- * event channel interface
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-val _setup : unit -> Unix.file_descr
-val _bind : Unix.file_descr -> int -> unit
-
-val bind_interdomain : int -> int * int
-
-
-val setup : unit -> Unix.file_descr
-val read : Unix.file_descr -> int
-val teardown : Unix.file_descr -> unit
-val unmask : Unix.file_descr -> int -> unit
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-module/Makefile
--- a/tools/debugger/pdb/linux-2.6-module/Makefile Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-XEN_ROOT = ../../../..
-LINUX_DIR = linux-2.6.12-xenU
-KDIR = $(XEN_ROOT)/$(LINUX_DIR)
-
-obj-m += pdb.o
-pdb-objs += module.o
-pdb-objs += debug.o
-
-CFLAGS += -g
-CFLAGS += -Wall
-CFLAGS += -Werror
-
-.PHONY: module
-module :
-# make KBUILD_VERBOSE=1 ARCH=xen -C $(KDIR) M=$(PWD) modules
- make ARCH=xen -C $(KDIR) M=$(PWD) modules
-
-.PHONY: clean
-clean :
- make -C $(KDIR) M=$(PWD) clean
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/linux-2.6-module/debug.c
--- a/tools/debugger/pdb/linux-2.6-module/debug.c Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,851 +0,0 @@
-/*
- * debug.c
- * pdb debug functionality for processes.
- */
-
-#include <linux/module.h>
-#include <linux/mm.h>
-#include <linux/sched.h>
-#include <asm-i386/kdebug.h>
-#include <asm-i386/mach-xen/asm/processor.h>
-#include <asm-i386/mach-xen/asm/ptrace.h>
-#include <asm-i386/mach-xen/asm/tlbflush.h>
-#include <xen/interface/xen.h>
-#include "pdb_module.h"
-#include "pdb_debug.h"
-
-
-static int pdb_debug_fn (struct pt_regs *regs, long error_code,
- unsigned int condition);
-static int pdb_int3_fn (struct pt_regs *regs, long error_code);
-static int pdb_page_fault_fn (struct pt_regs *regs, long error_code,
- unsigned int condition);
-
-/***********************************************************************/
-
-typedef struct bwcpoint /* break/watch/catch point */
-{
- struct list_head list;
- unsigned long address;
- int length;
-
- uint8_t type; /*
BWC_??? */
- uint8_t mode; /* for BWC_PAGE, the current protection
mode */
- uint32_t process;
- uint8_t error; /* error occured when enabling: don't
disable. */
-
- /* original values */
- uint8_t orig_bkpt; /* single byte
breakpoint */
- pte_t orig_pte;
-
- struct list_head watchpt_read_list; /* read watchpoints on this page */
- struct list_head watchpt_write_list; /* write */
- struct list_head watchpt_access_list; /* access */
- struct list_head watchpt_disabled_list; /* disabled */
-
- struct bwcpoint *parent; /* watchpoint: bwc_watch (the page) */
- struct bwcpoint *watchpoint; /* bwc_watch_step: original watchpoint */
-} bwcpoint_t, *bwcpoint_p;
-
-static struct list_head bwcpoint_list = LIST_HEAD_INIT(bwcpoint_list);
-
-#define _pdb_bwcpoint_alloc(_var) \
-{ \
- if ( (_var = kmalloc(sizeof(bwcpoint_t), GFP_KERNEL)) == NULL ) \
- printk("error: unable to allocate memory %d\n", __LINE__); \
- else { \
- memset(_var, 0, sizeof(bwcpoint_t)); \
- INIT_LIST_HEAD(&_var->watchpt_read_list); \
- INIT_LIST_HEAD(&_var->watchpt_write_list); \
- INIT_LIST_HEAD(&_var->watchpt_access_list); \
- INIT_LIST_HEAD(&_var->watchpt_disabled_list); \
- } \
-}
-
-/***********************************************************************/
-
-static void _pdb_bwc_print_list (struct list_head *, char *, int);
-
-static void
-_pdb_bwc_print (bwcpoint_p bwc, char *label, int level)
-{
- printk("%s%03d 0x%08lx:0x%02x %c\n", label, bwc->type,
- bwc->address, bwc->length, bwc->error ? 'e' : '-');
-
- if ( !list_empty(&bwc->watchpt_read_list) )
- _pdb_bwc_print_list(&bwc->watchpt_read_list, "r", level);
- if ( !list_empty(&bwc->watchpt_write_list) )
- _pdb_bwc_print_list(&bwc->watchpt_write_list, "w", level);
- if ( !list_empty(&bwc->watchpt_access_list) )
- _pdb_bwc_print_list(&bwc->watchpt_access_list, "a", level);
- if ( !list_empty(&bwc->watchpt_disabled_list) )
- _pdb_bwc_print_list(&bwc->watchpt_disabled_list, "d", level);
-}
-
-static void
-_pdb_bwc_print_list (struct list_head *bwc_list, char *label, int level)
-{
- struct list_head *ptr;
- int counter = 0;
-
- list_for_each(ptr, bwc_list)
- {
- bwcpoint_p bwc = list_entry(ptr, bwcpoint_t, list);
- printk(" %s[%02d]%s ", level > 0 ? " " : "", counter++,
- level > 0 ? "" : " ");
- _pdb_bwc_print(bwc, label, level+1);
- }
-
- if (counter == 0)
- {
- printk(" empty list\n");
- }
-}
-
-void
-pdb_bwc_print_list (void)
-{
- _pdb_bwc_print_list(&bwcpoint_list, " ", 0);
-}
-
-bwcpoint_p
-pdb_search_watchpoint (uint32_t process, unsigned long address)
-{
- bwcpoint_p bwc_watch = (bwcpoint_p) 0;
- bwcpoint_p bwc_entry = (bwcpoint_p) 0;
- struct list_head *ptr;
-
- list_for_each(ptr, &bwcpoint_list) /* find bwc page entry */
- {
- bwc_watch = list_entry(ptr, bwcpoint_t, list);
- if (bwc_watch->address == (address & PAGE_MASK)) break;
- }
-
- if ( !bwc_watch )
- {
- return (bwcpoint_p) 0;
- }
-
-#define __pdb_search_watchpoint_list(__list) \
- list_for_each(ptr, (__list)) \
- { \
- bwc_entry = list_entry(ptr, bwcpoint_t, list); \
- if ( bwc_entry->process == process && \
- bwc_entry->address <= address && \
- bwc_entry->address + bwc_entry->length > address ) \
- return bwc_entry; \
- }
-
- __pdb_search_watchpoint_list(&bwc_watch->watchpt_read_list);
- __pdb_search_watchpoint_list(&bwc_watch->watchpt_write_list);
- __pdb_search_watchpoint_list(&bwc_watch->watchpt_access_list);
-
-#undef __pdb_search_watchpoint_list
-
- return (bwcpoint_p) 0;
-}
-
-/*************************************************************/
-
-int
-pdb_suspend (struct task_struct *target)
-{
- uint32_t rc = 0;
-
- force_sig(SIGSTOP, target); /* force_sig_specific ??? */
-
- return rc;
-}
-
-int
-pdb_resume (struct task_struct *target)
-{
- int rc = 0;
-
- wake_up_process(target);
-
- return rc;
-}
-
-/*
- * from linux-2.6.11/arch/i386/kernel/ptrace.c::getreg()
- */
-static unsigned long
-_pdb_get_register (struct task_struct *target, int reg)
-{
- unsigned long result = ~0UL;
- unsigned long offset;
- unsigned char *stack = 0L;
-
- switch (reg)
- {
- case LINUX_FS:
- result = target->thread.fs;
- break;
- case LINUX_GS:
- result = target->thread.gs;
- break;
- case LINUX_DS:
- case LINUX_ES:
- case LINUX_SS:
- case LINUX_CS:
- result = 0xffff;
- /* fall through */
- default:
- if (reg > LINUX_GS)
- reg -= 2;
-
- offset = reg * sizeof(long);
- offset -= sizeof(struct pt_regs);
- stack = (unsigned char *)target->thread.esp0;
- stack += offset;
- result &= *((int *)stack);
- }
-
- return result;
-}
-
-/*
- * from linux-2.6.11/arch/i386/kernel/ptrace.c::putreg()
- */
-static void
-_pdb_set_register (struct task_struct *target, int reg, unsigned long val)
-{
- unsigned long offset;
- unsigned char *stack;
- unsigned long value = val;
-
- switch (reg)
- {
- case LINUX_FS:
- target->thread.fs = value;
- return;
- case LINUX_GS:
- target->thread.gs = value;
- return;
- case LINUX_DS:
- case LINUX_ES:
- value &= 0xffff;
- break;
- case LINUX_SS:
- case LINUX_CS:
- value &= 0xffff;
- break;
- case LINUX_EFL:
- break;
- }
-
- if (reg > LINUX_GS)
- reg -= 2;
- offset = reg * sizeof(long);
- offset -= sizeof(struct pt_regs);
- stack = (unsigned char *)target->thread.esp0;
- stack += offset;
- *(unsigned long *) stack = value;
-
- return;
-}
-
-int
-pdb_read_register (struct task_struct *target, pdb_op_rd_reg_p op)
-{
- int rc = 0;
-
- switch (op->reg)
- {
- case 0: op->value = _pdb_get_register(target, LINUX_EAX); break;
- case 1: op->value = _pdb_get_register(target, LINUX_ECX); break;
- case 2: op->value = _pdb_get_register(target, LINUX_EDX); break;
- case 3: op->value = _pdb_get_register(target, LINUX_EBX); break;
- case 4: op->value = _pdb_get_register(target, LINUX_ESP); break;
- case 5: op->value = _pdb_get_register(target, LINUX_EBP); break;
- case 6: op->value = _pdb_get_register(target, LINUX_ESI); break;
- case 7: op->value = _pdb_get_register(target, LINUX_EDI); break;
- case 8: op->value = _pdb_get_register(target, LINUX_EIP); break;
- case 9: op->value = _pdb_get_register(target, LINUX_EFL); break;
-
- case 10: op->value = _pdb_get_register(target, LINUX_CS); break;
- case 11: op->value = _pdb_get_register(target, LINUX_SS); break;
- case 12: op->value = _pdb_get_register(target, LINUX_DS); break;
- case 13: op->value = _pdb_get_register(target, LINUX_ES); break;
- case 14: op->value = _pdb_get_register(target, LINUX_FS); break;
- case 15: op->value = _pdb_get_register(target, LINUX_GS); break;
- }
-
- return rc;
-}
-
-int
-pdb_read_registers (struct task_struct *target, pdb_op_rd_regs_p op)
-{
- int rc = 0;
-
- op->reg[ 0] = _pdb_get_register(target, LINUX_EAX);
- op->reg[ 1] = _pdb_get_register(target, LINUX_ECX);
- op->reg[ 2] = _pdb_get_register(target, LINUX_EDX);
- op->reg[ 3] = _pdb_get_register(target, LINUX_EBX);
- op->reg[ 4] = _pdb_get_register(target, LINUX_ESP);
- op->reg[ 5] = _pdb_get_register(target, LINUX_EBP);
- op->reg[ 6] = _pdb_get_register(target, LINUX_ESI);
- op->reg[ 7] = _pdb_get_register(target, LINUX_EDI);
- op->reg[ 8] = _pdb_get_register(target, LINUX_EIP);
- op->reg[ 9] = _pdb_get_register(target, LINUX_EFL);
-
- op->reg[10] = _pdb_get_register(target, LINUX_CS);
- op->reg[11] = _pdb_get_register(target, LINUX_SS);
- op->reg[12] = _pdb_get_register(target, LINUX_DS);
- op->reg[13] = _pdb_get_register(target, LINUX_ES);
- op->reg[14] = _pdb_get_register(target, LINUX_FS);
- op->reg[15] = _pdb_get_register(target, LINUX_GS);
-
- return rc;
-}
-
-int
-pdb_write_register (struct task_struct *target, pdb_op_wr_reg_p op)
-{
- int rc = 0;
-
- _pdb_set_register(target, op->reg, op->value);
-
- return rc;
-}
-
-int
-pdb_access_memory (struct task_struct *target, unsigned long address,
- void *buffer, int length, int write)
-{
- int rc = 0;
-
- access_process_vm(target, address, buffer, length, write);
-
- return rc;
-}
-
-int
-pdb_continue (struct task_struct *target)
-{
- int rc = 0;
- unsigned long eflags;
-
- eflags = _pdb_get_register(target, LINUX_EFL);
- eflags &= ~X86_EFLAGS_TF;
- _pdb_set_register(target, LINUX_EFL, eflags);
-
- wake_up_process(target);
-
- return rc;
-}
-
-int
-pdb_step (struct task_struct *target)
-{
- int rc = 0;
- unsigned long eflags;
- bwcpoint_p bkpt;
-
- eflags = _pdb_get_register(target, LINUX_EFL);
- eflags |= X86_EFLAGS_TF;
- _pdb_set_register(target, LINUX_EFL, eflags);
-
- _pdb_bwcpoint_alloc(bkpt);
- if ( bkpt == NULL ) return -1;
-
- bkpt->process = target->pid;
- bkpt->address = 0;
- bkpt->type = BWC_DEBUG;
-
- list_add_tail(&bkpt->list, &bwcpoint_list);
-
- wake_up_process(target);
-
- return rc;
-}
-
-int
-pdb_insert_memory_breakpoint (struct task_struct *target,
- unsigned long address, uint32_t length)
-{
- int rc = 0;
- bwcpoint_p bkpt;
- uint8_t breakpoint_opcode = 0xcc;
-
- printk("insert breakpoint %d:%lx len: %d\n", target->pid, address, length);
-
- if ( length != 1 )
- {
- printk("error: breakpoint length should be 1\n");
- return -1;
- }
-
- _pdb_bwcpoint_alloc(bkpt);
- if ( bkpt == NULL ) return -1;
-
- bkpt->process = target->pid;
- bkpt->address = address;
- bkpt->type = BWC_INT3;
-
- pdb_access_memory(target, address, &bkpt->orig_bkpt, 1, PDB_MEM_READ);
- pdb_access_memory(target, address, &breakpoint_opcode, 1, PDB_MEM_WRITE);
-
- list_add_tail(&bkpt->list, &bwcpoint_list);
-
- printk("breakpoint_set %d:%lx OLD: 0x%x\n",
- target->pid, address, bkpt->orig_bkpt);
- pdb_bwc_print_list();
-
- return rc;
-}
-
-int
-pdb_remove_memory_breakpoint (struct task_struct *target,
- unsigned long address, uint32_t length)
-{
- int rc = 0;
- bwcpoint_p bkpt = NULL;
-
- printk ("remove breakpoint %d:%lx\n", target->pid, address);
-
- struct list_head *entry;
- list_for_each(entry, &bwcpoint_list)
- {
- bkpt = list_entry(entry, bwcpoint_t, list);
- if ( target->pid == bkpt->process &&
- address == bkpt->address &&
- bkpt->type == BWC_INT3 )
- break;
- }
-
- if (entry == &bwcpoint_list)
- {
- printk ("error: no breakpoint found\n");
- return -1;
- }
-
- pdb_access_memory(target, address, &bkpt->orig_bkpt, 1, PDB_MEM_WRITE);
-
- list_del(&bkpt->list);
- kfree(bkpt);
-
- pdb_bwc_print_list();
-
- return rc;
-}
-
-#define PDB_PTE_UPDATE 1
-#define PDB_PTE_RESTORE 2
-
-int
-pdb_change_pte (struct task_struct *target, bwcpoint_p bwc, int mode)
-{
- int rc = 0;
- pgd_t *pgd;
- pud_t *pud;
- pmd_t *pmd;
- pte_t *ptep;
-
- pgd = pgd_offset(target->mm, bwc->address);
- if (pgd_none(*pgd) || unlikely(pgd_bad(*pgd))) return -1;
-
- pud = pud_offset(pgd, bwc->address);
- if (pud_none(*pud) || unlikely(pud_bad(*pud))) return -2;
-
- pmd = pmd_offset(pud, bwc->address);
- if (pmd_none(*pmd) || unlikely(pmd_bad(*pmd))) return -3;
-
- ptep = pte_offset_map(pmd, bwc->address);
- if (!ptep) return -4;
-
- switch ( mode )
- {
- case PDB_PTE_UPDATE: /* added or removed a watchpoint. update pte. */
- {
- pte_t new_pte;
-
- if ( pte_val(bwc->parent->orig_pte) == 0 ) /* new watchpoint page */
- {
- bwc->parent->orig_pte = *ptep;
- }
-
- new_pte = bwc->parent->orig_pte;
-
- if ( !list_empty(&bwc->parent->watchpt_read_list) ||
- !list_empty(&bwc->parent->watchpt_access_list) )
- {
- new_pte = pte_rdprotect(new_pte);
- }
-
- if ( !list_empty(&bwc->parent->watchpt_write_list) ||
- !list_empty(&bwc->parent->watchpt_access_list) )
- {
- new_pte = pte_wrprotect(new_pte);
- }
-
- if ( pte_val(new_pte) != pte_val(*ptep) )
- {
- *ptep = new_pte;
- flush_tlb_mm(target->mm);
- }
- break;
- }
- case PDB_PTE_RESTORE : /* suspend watchpoint by restoring original pte */
- {
- *ptep = bwc->parent->orig_pte;
- flush_tlb_mm(target->mm);
- break;
- }
- default :
- {
- printk("(linux) unknown mode %d %d\n", mode, __LINE__);
- break;
- }
- }
-
- pte_unmap(ptep); /* can i flush the tlb before pte_unmap? */
-
- return rc;
-}
-
-int
-pdb_insert_watchpoint (struct task_struct *target, pdb_op_watchpt_p watchpt)
-{
- int rc = 0;
-
- bwcpoint_p bwc_watch;
- bwcpoint_p bwc_entry;
- struct list_head *ptr;
- unsigned long page = watchpt->address & PAGE_MASK;
- struct list_head *watchpoint_list;
-
- printk("insert watchpoint: %d %x %x\n",
- watchpt->type, watchpt->address, watchpt->length);
-
- list_for_each(ptr, &bwcpoint_list) /* find existing bwc page entry */
- {
- bwc_watch = list_entry(ptr, bwcpoint_t, list);
-
- if (bwc_watch->address == page) goto got_bwc_watch;
- }
-
- _pdb_bwcpoint_alloc(bwc_watch); /* create new bwc:watch */
- if ( bwc_watch == NULL ) return -1;
-
- bwc_watch->type = BWC_WATCH;
- bwc_watch->process = target->pid;
- bwc_watch->address = page;
-
- list_add_tail(&bwc_watch->list, &bwcpoint_list);
-
- got_bwc_watch:
-
- switch (watchpt->type)
- {
- case BWC_WATCH_READ:
- watchpoint_list = &bwc_watch->watchpt_read_list; break;
- case BWC_WATCH_WRITE:
- watchpoint_list = &bwc_watch->watchpt_write_list; break;
- case BWC_WATCH_ACCESS:
- watchpoint_list = &bwc_watch->watchpt_access_list; break;
- default:
- printk("unknown type %d\n", watchpt->type); return -2;
- }
-
- _pdb_bwcpoint_alloc(bwc_entry); /* create new bwc:entry */
- if ( bwc_entry == NULL ) return -1;
-
- bwc_entry->process = target->pid;
- bwc_entry->address = watchpt->address;
- bwc_entry->length = watchpt->length;
- bwc_entry->type = watchpt->type;
- bwc_entry->parent = bwc_watch;
-
- list_add_tail(&bwc_entry->list, watchpoint_list);
- pdb_change_pte(target, bwc_entry, PDB_PTE_UPDATE);
-
- pdb_bwc_print_list();
-
- return rc;
-}
-
-int
-pdb_remove_watchpoint (struct task_struct *target, pdb_op_watchpt_p watchpt)
-{
- int rc = 0;
- bwcpoint_p bwc_watch = (bwcpoint_p) NULL;
- bwcpoint_p bwc_entry = (bwcpoint_p) NULL;
- unsigned long page = watchpt->address & PAGE_MASK;
- struct list_head *ptr;
- struct list_head *watchpoint_list;
-
- printk("remove watchpoint: %d %x %x\n",
- watchpt->type, watchpt->address, watchpt->length);
-
- list_for_each(ptr, &bwcpoint_list) /* find bwc page entry */
- {
- bwc_watch = list_entry(ptr, bwcpoint_t, list);
- if (bwc_watch->address == page) break;
- }
-
- if ( !bwc_watch )
- {
- printk("(linux) delete watchpoint: can't find bwc page 0x%08x\n",
- watchpt->address);
- return -1;
- }
-
- switch (watchpt->type)
- {
- case BWC_WATCH_READ:
- watchpoint_list = &bwc_watch->watchpt_read_list; break;
- case BWC_WATCH_WRITE:
- watchpoint_list = &bwc_watch->watchpt_write_list; break;
- case BWC_WATCH_ACCESS:
- watchpoint_list = &bwc_watch->watchpt_access_list; break;
- default:
- printk("unknown type %d\n", watchpt->type); return -2;
- }
-
- list_for_each(ptr, watchpoint_list) /* find watchpoint */
- {
- bwc_entry = list_entry(ptr, bwcpoint_t, list);
- if ( bwc_entry->address == watchpt->address &&
- bwc_entry->length == watchpt->length ) break;
- }
-
- if ( !bwc_entry ) /* or ptr == watchpoint_list */
- {
- printk("(linux) delete watchpoint: can't find watchpoint 0x%08x\n",
- watchpt->address);
- return -1;
- }
-
- list_del(&bwc_entry->list);
- pdb_change_pte(target, bwc_entry, PDB_PTE_UPDATE);
- kfree(bwc_entry);
-
-
- if ( list_empty(&bwc_watch->watchpt_read_list) &&
- list_empty(&bwc_watch->watchpt_write_list) &&
- list_empty(&bwc_watch->watchpt_access_list) )
- {
- list_del(&bwc_watch->list);
- kfree(bwc_watch);
- }
-
- pdb_bwc_print_list();
-
- return rc;
-}
-
-
-/***************************************************************/
-
-int
-pdb_exceptions_notify (struct notifier_block *self, unsigned long val,
- void *data)
-{
- struct die_args *args = (struct die_args *)data;
-
- switch (val)
- {
- case DIE_DEBUG:
- if ( pdb_debug_fn(args->regs, args->trapnr, args->err) )
- return NOTIFY_STOP;
- break;
- case DIE_TRAP:
- if ( args->trapnr == 3 && pdb_int3_fn(args->regs, args->err) )
- return NOTIFY_STOP;
- break;
- case DIE_INT3: /* without kprobes, we should never see
DIE_INT3 */
- if ( pdb_int3_fn(args->regs, args->err) )
- return NOTIFY_STOP;
- break;
- case DIE_PAGE_FAULT:
- if ( pdb_page_fault_fn(args->regs, args->trapnr, args->err) )
- return NOTIFY_STOP;
- break;
- case DIE_GPF:
- printk("---------------GPF\n");
- break;
- default:
- break;
- }
-
- return NOTIFY_DONE;
-}
-
-
-static int
-pdb_debug_fn (struct pt_regs *regs, long error_code,
- unsigned int condition)
-{
- pdb_response_t resp;
- bwcpoint_p bkpt = NULL;
- struct list_head *entry;
-
- printk("pdb_debug_fn\n");
-
- list_for_each(entry, &bwcpoint_list)
- {
- bkpt = list_entry(entry, bwcpoint_t, list);
- if ( current->pid == bkpt->process &&
- (bkpt->type == BWC_DEBUG || /* single step */
- bkpt->type == BWC_WATCH_STEP)) /* single step over watchpoint */
- break;
- }
-
- if (entry == &bwcpoint_list)
- {
- printk("not my debug 0x%x 0x%lx\n", current->pid, regs->eip);
- return 0;
- }
-
- pdb_suspend(current);
-
- printk("(pdb) %s pid: %d, eip: 0x%08lx\n",
- bkpt->type == BWC_DEBUG ? "debug" : "watch-step",
- current->pid, regs->eip);
-
- regs->eflags &= ~X86_EFLAGS_TF;
- set_tsk_thread_flag(current, TIF_SINGLESTEP);
-
- switch (bkpt->type)
- {
- case BWC_DEBUG:
- resp.operation = PDB_OPCODE_STEP;
- break;
- case BWC_WATCH_STEP:
- {
- struct list_head *watchpoint_list;
- bwcpoint_p watch_page = bkpt->watchpoint->parent;
-
- switch (bkpt->watchpoint->type)
- {
- case BWC_WATCH_READ:
- watchpoint_list = &watch_page->watchpt_read_list; break;
- case BWC_WATCH_WRITE:
- watchpoint_list = &watch_page->watchpt_write_list; break;
- case BWC_WATCH_ACCESS:
- watchpoint_list = &watch_page->watchpt_access_list; break;
- default:
- printk("unknown type %d\n", bkpt->watchpoint->type); return 0;
- }
-
- resp.operation = PDB_OPCODE_WATCHPOINT;
- list_del_init(&bkpt->watchpoint->list);
- list_add_tail(&bkpt->watchpoint->list, watchpoint_list);
- pdb_change_pte(current, bkpt->watchpoint, PDB_PTE_UPDATE);
- pdb_bwc_print_list();
- break;
- }
- default:
- printk("unknown breakpoint type %d %d\n", __LINE__, bkpt->type);
- return 0;
- }
-
- resp.process = current->pid;
- resp.status = PDB_RESPONSE_OKAY;
-
- pdb_send_response(&resp);
-
- list_del(&bkpt->list);
- kfree(bkpt);
-
- return 1;
-}
-
-
-static int
-pdb_int3_fn (struct pt_regs *regs, long error_code)
-{
- pdb_response_t resp;
- bwcpoint_p bkpt = NULL;
- unsigned long address = regs->eip - 1;
-
- struct list_head *entry;
- list_for_each(entry, &bwcpoint_list)
- {
- bkpt = list_entry(entry, bwcpoint_t, list);
- if ( current->pid == bkpt->process &&
- address == bkpt->address &&
- bkpt->type == BWC_INT3 )
- break;
- }
-
- if (entry == &bwcpoint_list)
- {
- printk("not my int3 bkpt 0x%x 0x%lx\n", current->pid, address);
- return 0;
- }
-
- printk("(pdb) int3 pid: %d, eip: 0x%08lx\n", current->pid, address);
-
- pdb_suspend(current);
-
- resp.operation = PDB_OPCODE_CONTINUE;
- resp.process = current->pid;
- resp.status = PDB_RESPONSE_OKAY;
-
- pdb_send_response(&resp);
-
- return 1;
-}
-
-static int
-pdb_page_fault_fn (struct pt_regs *regs, long error_code,
- unsigned int condition)
-{
- unsigned long cr2;
- unsigned long cr3;
- bwcpoint_p bwc;
- bwcpoint_p watchpt;
- bwcpoint_p bkpt;
-
- __asm__ __volatile__ ("movl %%cr3,%0" : "=r" (cr3) : );
- __asm__ __volatile__ ("movl %%cr2,%0" : "=r" (cr2) : );
-
- bwc = pdb_search_watchpoint(current->pid, cr2);
- if ( !bwc )
- {
- return 0; /* not mine */
- }
-
- printk("page_fault cr2:%08lx err:%lx eip:%08lx\n",
- cr2, error_code, regs->eip);
-
- /* disable the watchpoint */
- watchpt = bwc->watchpoint;
- list_del_init(&bwc->list);
- list_add_tail(&bwc->list, &bwc->parent->watchpt_disabled_list);
- pdb_change_pte(current, bwc, PDB_PTE_RESTORE);
-
- /* single step the faulting instruction */
- regs->eflags |= X86_EFLAGS_TF;
-
- /* create a bwcpoint entry so we know what to do once we regain control */
- _pdb_bwcpoint_alloc(bkpt);
- if ( bkpt == NULL ) return -1;
-
- bkpt->process = current->pid;
- bkpt->address = 0;
- bkpt->type = BWC_WATCH_STEP;
- bkpt->watchpoint = bwc;
-
- /* add to head so we see it first the next time we break */
- list_add(&bkpt->list, &bwcpoint_list);
-
- pdb_bwc_print_list();
- return 1;
-}
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-module/module.c
--- a/tools/debugger/pdb/linux-2.6-module/module.c Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,337 +0,0 @@
-
-/*
- * module.c
- *
- * Handles initial registration with pdb when the pdb module starts up
- * and cleanup when the module goes away (sortof :)
- * Also receives each request from pdb in domain 0 and dispatches to the
- * appropriate debugger function.
- */
-
-#include <linux/module.h>
-#include <linux/interrupt.h>
-
-#include <asm-i386/kdebug.h>
-
-#include <xen/evtchn.h>
-#include <xen/ctrl_if.h>
-#include <xen/hypervisor.h>
-#include <xen/interface/io/domain_controller.h>
-#include <xen/interface/xen.h>
-
-#include <xen/interface/io/ring.h>
-
-#include "pdb_module.h"
-#include "pdb_debug.h"
-
-#define PDB_RING_SIZE __RING_SIZE((pdb_sring_t *)0, PAGE_SIZE)
-
-static pdb_back_ring_t pdb_ring;
-static unsigned int pdb_evtchn;
-static unsigned int pdb_irq;
-static unsigned int pdb_domain;
-
-/* work queue */
-static void pdb_work_handler(void *unused);
-static DECLARE_WORK(pdb_deferred_work, pdb_work_handler, NULL);
-
-/*
- * send response to a pdb request
- */
-void
-pdb_send_response (pdb_response_t *response)
-{
- pdb_response_t *resp;
-
- resp = RING_GET_RESPONSE(&pdb_ring, pdb_ring.rsp_prod_pvt);
-
- memcpy(resp, response, sizeof(pdb_response_t));
- resp->domain = pdb_domain;
-
- wmb(); /* Ensure other side can see the response fields. */
- pdb_ring.rsp_prod_pvt++;
- RING_PUSH_RESPONSES(&pdb_ring);
- notify_via_evtchn(pdb_evtchn);
- return;
-}
-
-/*
- * handle a debug command from the front end
- */
-static void
-pdb_process_request (pdb_request_t *request)
-{
- pdb_response_t resp;
- struct task_struct *target;
-
- read_lock(&tasklist_lock);
- target = find_task_by_pid(request->process);
- if (target)
- get_task_struct(target);
- read_unlock(&tasklist_lock);
-
- resp.operation = request->operation;
- resp.process = request->process;
-
- if (!target)
- {
- printk ("(linux) target not found 0x%x\n", request->process);
- resp.status = PDB_RESPONSE_ERROR;
- goto response;
- }
-
- switch (request->operation)
- {
- case PDB_OPCODE_PAUSE :
- pdb_suspend(target);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_ATTACH :
- pdb_suspend(target);
- pdb_domain = request->u.attach.domain;
- printk("(linux) attach dom:0x%x pid:0x%x\n",
- pdb_domain, request->process);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_DETACH :
- pdb_resume(target);
- printk("(linux) detach 0x%x\n", request->process);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_RD_REG :
- resp.u.rd_reg.reg = request->u.rd_reg.reg;
- pdb_read_register(target, &resp.u.rd_reg);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_RD_REGS :
- pdb_read_registers(target, &resp.u.rd_regs);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_WR_REG :
- pdb_write_register(target, &request->u.wr_reg);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_RD_MEM :
- pdb_access_memory(target, request->u.rd_mem.address,
- &resp.u.rd_mem.data, request->u.rd_mem.length,
- PDB_MEM_READ);
- resp.u.rd_mem.address = request->u.rd_mem.address;
- resp.u.rd_mem.length = request->u.rd_mem.length;
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_WR_MEM :
- pdb_access_memory(target, request->u.wr_mem.address,
- &request->u.wr_mem.data, request->u.wr_mem.length,
- PDB_MEM_WRITE);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_CONTINUE :
- pdb_continue(target);
- goto no_response;
- break;
- case PDB_OPCODE_STEP :
- pdb_step(target);
- resp.status = PDB_RESPONSE_OKAY;
- goto no_response;
- break;
- case PDB_OPCODE_SET_BKPT :
- pdb_insert_memory_breakpoint(target, request->u.bkpt.address,
- request->u.bkpt.length);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_CLR_BKPT :
- pdb_remove_memory_breakpoint(target, request->u.bkpt.address,
- request->u.bkpt.length);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_SET_WATCHPT :
- pdb_insert_watchpoint(target, &request->u.watchpt);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- case PDB_OPCODE_CLR_WATCHPT :
- pdb_remove_watchpoint(target, &request->u.watchpt);
- resp.status = PDB_RESPONSE_OKAY;
- break;
- default:
- printk("(pdb) unknown request operation %d\n", request->operation);
- resp.status = PDB_RESPONSE_ERROR;
- }
-
- response:
- pdb_send_response (&resp);
-
- no_response:
- return;
-}
-
-/*
- * work queue
- */
-static void
-pdb_work_handler (void *unused)
-{
- pdb_request_t *req;
- RING_IDX i, rp;
-
- rp = pdb_ring.sring->req_prod;
- rmb();
-
- for ( i = pdb_ring.req_cons;
- (i != rp) && !RING_REQUEST_CONS_OVERFLOW(&pdb_ring, i);
- i++ )
- {
- req = RING_GET_REQUEST(&pdb_ring, i);
- pdb_process_request(req);
-
- }
- pdb_ring.req_cons = i;
-}
-
-/*
- * receive a pdb request
- */
-static irqreturn_t
-pdb_interrupt (int irq, void *dev_id, struct pt_regs *ptregs)
-{
- schedule_work(&pdb_deferred_work);
-
- return IRQ_HANDLED;
-}
-
-static void
-pdb_send_connection_status(int status, unsigned long ring)
-{
- ctrl_msg_t cmsg =
- {
- .type = CMSG_DEBUG,
- .subtype = CMSG_DEBUG_CONNECTION_STATUS,
- .length = sizeof(pdb_connection_t),
- };
- pdb_connection_t *conn = (pdb_connection_t *)cmsg.msg;
-
- conn->status = status;
- conn->ring = ring;
- conn->evtchn = 0;
-
- ctrl_if_send_message_block(&cmsg, NULL, 0, TASK_UNINTERRUPTIBLE);
-}
-
-
-/*
- * this is called each time a message is received on the control channel
- */
-static void
-pdb_ctrlif_rx(ctrl_msg_t *msg, unsigned long id)
-{
- switch (msg->subtype)
- {
- case CMSG_DEBUG_CONNECTION_STATUS:
- /* initialize event channel created by the pdb server */
-
- pdb_evtchn = ((pdb_connection_p) msg->msg)->evtchn;
- pdb_irq = bind_evtchn_to_irq(pdb_evtchn);
-
- if ( request_irq(pdb_irq, pdb_interrupt,
- SA_SAMPLE_RANDOM, "pdb", NULL) )
- {
- printk("(pdb) request irq failed: %d %d\n", pdb_evtchn, pdb_irq);
- }
- break;
-
- default:
- printk ("(pdb) unknown xcs control message: %d\n", msg->subtype);
- break;
- }
-
- return;
-}
-
-
-/********************************************************************/
-
-static struct notifier_block pdb_exceptions_nb =
-{
- .notifier_call = pdb_exceptions_notify,
- .priority = 0x1 /* low priority */
-};
-
-
-static int __init
-pdb_initialize (void)
-{
- int err;
- pdb_sring_t *sring;
-
- printk("----\npdb initialize %s %s\n", __DATE__, __TIME__);
-
- /*
- if ( xen_start_info.flags & SIF_INITDOMAIN )
- return 1;
- */
-
- pdb_evtchn = 0;
- pdb_irq = 0;
- pdb_domain = 0;
-
- (void)ctrl_if_register_receiver(CMSG_DEBUG, pdb_ctrlif_rx,
- CALLBACK_IN_BLOCKING_CONTEXT);
-
- /* rings */
- sring = (pdb_sring_t *)__get_free_page(GFP_KERNEL);
- SHARED_RING_INIT(sring);
- BACK_RING_INIT(&pdb_ring, sring, PAGE_SIZE);
-
- /* notify pdb in dom 0 */
- pdb_send_connection_status(PDB_CONNECTION_STATUS_UP,
- virt_to_machine(pdb_ring.sring) >> PAGE_SHIFT);
-
- /* handler for int1 & int3 */
- err = register_die_notifier(&pdb_exceptions_nb);
-
- return err;
-}
-
-static void __exit
-pdb_terminate(void)
-{
- int err = 0;
-
- printk("pdb cleanup\n");
-
- (void)ctrl_if_unregister_receiver(CMSG_DEBUG, pdb_ctrlif_rx);
-
- if (pdb_irq)
- {
- free_irq(pdb_irq, NULL);
- pdb_irq = 0;
- }
-
- if (pdb_evtchn)
- {
- unbind_evtchn_from_irq(pdb_evtchn);
- pdb_evtchn = 0;
- }
-
- pdb_send_connection_status(PDB_CONNECTION_STATUS_DOWN, 0);
-
- /* handler for int1 & int3 */
- err = unregister_die_notifier(&pdb_exceptions_nb);
-
- return;
-}
-
-
-module_init(pdb_initialize);
-module_exit(pdb_terminate);
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-module/pdb_debug.h
--- a/tools/debugger/pdb/linux-2.6-module/pdb_debug.h Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,47 +0,0 @@
-
-#ifndef __PDB_DEBUG_H_
-#define __PDB_DEBUG_H_
-
-/* debugger.c */
-void pdb_initialize_bwcpoint (void);
-int pdb_suspend (struct task_struct *target);
-int pdb_resume (struct task_struct *target);
-int pdb_read_register (struct task_struct *target, pdb_op_rd_reg_p op);
-int pdb_read_registers (struct task_struct *target, pdb_op_rd_regs_p op);
-int pdb_write_register (struct task_struct *target, pdb_op_wr_reg_p op);
-int pdb_read_memory (struct task_struct *target, pdb_op_rd_mem_req_p req,
- pdb_op_rd_mem_resp_p resp);
-int pdb_write_memory (struct task_struct *target, pdb_op_wr_mem_p op);
-int pdb_access_memory (struct task_struct *target, unsigned long address,
- void *buffer, int length, int write);
-int pdb_continue (struct task_struct *target);
-int pdb_step (struct task_struct *target);
-
-int pdb_insert_memory_breakpoint (struct task_struct *target,
- unsigned long address, uint32_t length);
-int pdb_remove_memory_breakpoint (struct task_struct *target,
- unsigned long address, uint32_t length);
-int pdb_insert_watchpoint (struct task_struct *target,
- pdb_op_watchpt_p watchpt);
-int pdb_remove_watchpoint (struct task_struct *target,
- pdb_op_watchpt_p watchpt);
-
-int pdb_exceptions_notify (struct notifier_block *self, unsigned long val,
- void *data);
-
-/* module.c */
-void pdb_send_response (pdb_response_t *response);
-
-#endif
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-module/pdb_module.h
--- a/tools/debugger/pdb/linux-2.6-module/pdb_module.h Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,142 +0,0 @@
-
-#ifndef __PDB_MODULE_H_
-#define __PDB_MODULE_H_
-
-#include "../pdb_caml_xen.h"
-
-#define PDB_OPCODE_PAUSE 1
-
-#define PDB_OPCODE_ATTACH 2
-typedef struct pdb_op_attach
-{
- uint32_t domain;
-} pdb_op_attach_t, *pdb_op_attach_p;
-
-#define PDB_OPCODE_DETACH 3
-
-#define PDB_OPCODE_RD_REG 4
-typedef struct pdb_op_rd_reg
-{
- uint32_t reg;
- uint32_t value;
-} pdb_op_rd_reg_t, *pdb_op_rd_reg_p;
-
-#define PDB_OPCODE_RD_REGS 5
-typedef struct pdb_op_rd_regs
-{
- uint32_t reg[GDB_REGISTER_FRAME_SIZE];
-} pdb_op_rd_regs_t, *pdb_op_rd_regs_p;
-
-#define PDB_OPCODE_WR_REG 6
-typedef struct pdb_op_wr_reg
-{
- uint32_t reg;
- uint32_t value;
-} pdb_op_wr_reg_t, *pdb_op_wr_reg_p;
-
-#define PDB_OPCODE_RD_MEM 7
-typedef struct pdb_op_rd_mem_req
-{
- uint32_t address;
- uint32_t length;
-} pdb_op_rd_mem_req_t, *pdb_op_rd_mem_req_p;
-
-typedef struct pdb_op_rd_mem_resp
-{
- uint32_t address;
- uint32_t length;
- uint8_t data[1024];
-} pdb_op_rd_mem_resp_t, *pdb_op_rd_mem_resp_p;
-
-#define PDB_OPCODE_WR_MEM 8
-typedef struct pdb_op_wr_mem
-{
- uint32_t address;
- uint32_t length;
- uint8_t data[1024]; /*
arbitrary */
-} pdb_op_wr_mem_t, *pdb_op_wr_mem_p;
-
-#define PDB_OPCODE_CONTINUE 9
-#define PDB_OPCODE_STEP 10
-
-#define PDB_OPCODE_SET_BKPT 11
-#define PDB_OPCODE_CLR_BKPT 12
-typedef struct pdb_op_bkpt
-{
- uint32_t address;
- uint32_t length;
-} pdb_op_bkpt_t, *pdb_op_bkpt_p;
-
-#define PDB_OPCODE_SET_WATCHPT 13
-#define PDB_OPCODE_CLR_WATCHPT 14
-#define PDB_OPCODE_WATCHPOINT 15
-typedef struct pdb_op_watchpt
-{
-#define BWC_DEBUG 1
-#define BWC_INT3 3
-#define BWC_WATCH 100 /* pdb: watchpoint page */
-#define BWC_WATCH_STEP 101 /* pdb: watchpoint single step */
-#define BWC_WATCH_WRITE 102
-#define BWC_WATCH_READ 103
-#define BWC_WATCH_ACCESS 104
- uint32_t type;
- uint32_t address;
- uint32_t length;
-} pdb_op_watchpt_t, *pdb_op_watchpt_p;
-
-
-typedef struct
-{
- uint8_t operation; /* PDB_OPCODE_??? */
- uint32_t process;
- union
- {
- pdb_op_attach_t attach;
- pdb_op_rd_reg_t rd_reg;
- pdb_op_wr_reg_t wr_reg;
- pdb_op_rd_mem_req_t rd_mem;
- pdb_op_wr_mem_t wr_mem;
- pdb_op_bkpt_t bkpt;
- pdb_op_watchpt_t watchpt;
- } u;
-} pdb_request_t, *pdb_request_p;
-
-
-
-#define PDB_RESPONSE_OKAY 0
-#define PDB_RESPONSE_ERROR -1
-
-typedef struct {
- uint8_t operation; /* copied from request */
- uint32_t domain;
- uint32_t process;
- int16_t status; /* PDB_RESPONSE_??? */
- union
- {
- pdb_op_rd_reg_t rd_reg;
- pdb_op_rd_regs_t rd_regs;
- pdb_op_rd_mem_resp_t rd_mem;
- } u;
-} pdb_response_t, *pdb_response_p;
-
-
-DEFINE_RING_TYPES(pdb, pdb_request_t, pdb_response_t);
-
-
-/* from access_process_vm */
-#define PDB_MEM_READ 0
-#define PDB_MEM_WRITE 1
-
-#endif
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-patches/Makefile
--- a/tools/debugger/pdb/linux-2.6-patches/Makefile Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,11 +0,0 @@
-XEN_ROOT = ../../../..
-LINUX_DIR = linux-2.6.12-xenU
-KDIR = $(XEN_ROOT)/$(LINUX_DIR)
-PATCH_DIR = $(CURDIR)
-
-.PHONY: patches
-patches : patches-done
-
-patches-done :
- ( for i in *.patch ; do ( cd $(KDIR) ; patch -p1 < $(PATCH_DIR)/$$i ||
exit 1 ) ; done )
- touch $@
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-patches/i386_ksyms.patch
--- a/tools/debugger/pdb/linux-2.6-patches/i386_ksyms.patch Fri Sep 29
11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,19 +0,0 @@
-diff -u linux-2.6.12/arch/xen/i386/kernel/i386_ksyms.c
linux-2.6.12-pdb/arch/xen/i386/kernel/i386_ksyms.c
---- linux-2.6.12/arch/xen/i386/kernel/i386_ksyms.c 2005-07-31
22:36:50.000000000 +0100
-+++ linux-2.6.12-pdb/arch/xen/i386/kernel/i386_ksyms.c 2005-08-01
10:57:31.000000000 +0100
-@@ -151,6 +151,7 @@
- /* TLB flushing */
- EXPORT_SYMBOL(flush_tlb_page);
- #endif
-+EXPORT_SYMBOL(flush_tlb_mm);
-
- #ifdef CONFIG_X86_IO_APIC
- EXPORT_SYMBOL(IO_APIC_get_PCI_irq_vector);
-@@ -172,6 +173,7 @@
- EXPORT_SYMBOL_GPL(unset_nmi_callback);
-
- EXPORT_SYMBOL(register_die_notifier);
-+EXPORT_SYMBOL(unregister_die_notifier);
- #ifdef CONFIG_HAVE_DEC_LOCK
- EXPORT_SYMBOL(_atomic_dec_and_lock);
- #endif
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-patches/kdebug.patch
--- a/tools/debugger/pdb/linux-2.6-patches/kdebug.patch Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,11 +0,0 @@
-diff -u linux-2.6.12/include/asm-i386/kdebug.h
linux-2.6.12-pdb/include/asm-i386/kdebug.h
---- linux-2.6.12/include/asm-i386/kdebug.h 2005-06-17 20:48:29.000000000
+0100
-+++ linux-2.6.12-pdb/include/asm-i386/kdebug.h 2005-08-01 11:11:53.000000000
+0100
-@@ -21,6 +21,7 @@
- If you really want to do it first unregister - then synchronize_kernel -
then free.
- */
- int register_die_notifier(struct notifier_block *nb);
-+int unregister_die_notifier(struct notifier_block *nb);
- extern struct notifier_block *i386die_chain;
-
-
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-patches/makefile.patch
--- a/tools/debugger/pdb/linux-2.6-patches/makefile.patch Fri Sep 29
11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-diff -Naur linux-2.6.12/Makefile linux-2.6.12-pdb/Makefile
---- linux-2.6.12/Makefile 2005-08-01 01:21:21.000000000 +0100
-+++ linux-2.6.12-pdb/Makefile 2005-08-01 10:28:10.000000000 +0100
-@@ -508,7 +508,7 @@
- ifdef CONFIG_CC_OPTIMIZE_FOR_SIZE
- CFLAGS += -Os
- else
--CFLAGS += -O2
-+CFLAGS += -O
- endif
-
- #Add align options if CONFIG_CC_* is not equal to 0
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-patches/ptrace.patch
--- a/tools/debugger/pdb/linux-2.6-patches/ptrace.patch Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,11 +0,0 @@
-diff -u linux-2.6.12/kernel/ptrace.c linux-2.6.12-pdb/kernel/ptrace.c
---- linux-2.6.12/kernel/ptrace.c 2005-06-17 20:48:29.000000000 +0100
-+++ linux-2.6.12-pdb/kernel/ptrace.c 2005-07-22 13:23:16.000000000 +0100
-@@ -239,6 +239,7 @@
-
- return buf - old_buf;
- }
-+EXPORT_SYMBOL(access_process_vm);
-
- int ptrace_readdata(struct task_struct *tsk, unsigned long src, char __user
*dst, int len)
- {
diff -r e5cdebf9d8ef -r 80388aea02a1
tools/debugger/pdb/linux-2.6-patches/traps.patch
--- a/tools/debugger/pdb/linux-2.6-patches/traps.patch Fri Sep 29 11:11:49
2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-diff -u linux-2.6.12/arch/xen/i386/kernel/traps.c
linux-2.6.12-pdb/arch/xen/i386/kernel/traps.c
---- linux-2.6.12/arch/xen/i386/kernel/traps.c 2005-07-31 22:47:00.000000000
+0100
-+++ linux-2.6.12-pdb/arch/xen/i386/kernel/traps.c 2005-07-31
22:47:32.000000000 +0100
-@@ -102,6 +102,16 @@
- return err;
- }
-
-+int unregister_die_notifier(struct notifier_block *nb)
-+{
-+ int err = 0;
-+ unsigned long flags;
-+ spin_lock_irqsave(&die_notifier_lock, flags);
-+ err = notifier_chain_unregister(&i386die_chain, nb);
-+ spin_unlock_irqrestore(&die_notifier_lock, flags);
-+ return err;
-+}
-+
- static inline int valid_stack_ptr(struct thread_info *tinfo, void *p)
- {
- return p > (void *)tinfo &&
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_caml_domain.c
--- a/tools/debugger/pdb/pdb_caml_domain.c Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,527 +0,0 @@
-/*
- * pdb_caml_xc.c
- *
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * PDB's OCaml interface library for debugging domains
- */
-
-#include <xenctrl.h>
-#include <xendebug.h>
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <sys/mman.h>
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-
-#include "pdb_caml_xen.h"
-
-typedef struct
-{
- int domain;
- int vcpu;
-} context_t;
-
-#define decode_context(_ctx, _ocaml) \
-{ \
- (_ctx)->domain = Int_val(Field((_ocaml),0)); \
- (_ctx)->vcpu = Int_val(Field((_ocaml),1)); \
-}
-
-#define encode_context(_ctx, _ocaml) \
-{ \
- (_ocaml) = caml_alloc_tuple(2); \
- Store_field((_ocaml), 0, Val_int((_ctx)->domain)); \
- Store_field((_ocaml), 1, Val_int((_ctx)->vcpu)); \
-}
-
-
-/****************************************************************************/
-
-/*
- * dom_read_register : context_t -> int -> int32
- */
-value
-dom_read_register (value context, value reg)
-{
- CAMLparam2(context, reg);
- CAMLlocal1(result);
-
- int my_reg = Int_val(reg);
- cpu_user_regs_t *regs;
- context_t ctx;
-
- decode_context(&ctx, context);
-
- if ( xendebug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) )
- {
- printf("(pdb) read registers error!\n"); fflush(stdout);
- failwith("read registers error");
- }
-
- dump_regs(regs);
-
- result = caml_alloc_tuple(16);
-
- switch (my_reg)
- {
- case GDB_EAX: result = caml_copy_int32(regs->eax); break;
- case GDB_ECX: result = caml_copy_int32(regs->ecx); break;
- case GDB_EDX: result = caml_copy_int32(regs->edx); break;
- case GDB_EBX: result = caml_copy_int32(regs->ebx); break;
- case GDB_ESP: result = caml_copy_int32(regs->esp); break;
- case GDB_EBP: result = caml_copy_int32(regs->ebp); break;
- case GDB_ESI: result = caml_copy_int32(regs->esi); break;
- case GDB_EDI: result = caml_copy_int32(regs->edi); break;
- case GDB_EIP: result = caml_copy_int32(regs->eip); break;
- case GDB_EFL: result = caml_copy_int32(regs->eflags); break;
- case GDB_CS: result = caml_copy_int32(regs->cs); break;
- case GDB_SS: result = caml_copy_int32(regs->ss); break;
- case GDB_DS: result = caml_copy_int32(regs->ds); break;
- case GDB_ES: result = caml_copy_int32(regs->es); break;
- case GDB_FS: result = caml_copy_int32(regs->fs); break;
- case GDB_GS: result = caml_copy_int32(regs->gs); break;
- }
-
- CAMLreturn(result);
-}
-
-/*
- * dom_read_registers : context_t -> int32
- */
-value
-dom_read_registers (value context)
-{
- CAMLparam1(context);
- CAMLlocal1(result);
-
- cpu_user_regs_t *regs;
- context_t ctx;
-
- decode_context(&ctx, context);
-
- if ( xendebug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) )
- {
- printf("(pdb) read registers error!\n"); fflush(stdout);
- failwith("read registers error");
- }
-
- dump_regs(regs);
-
- result = caml_alloc_tuple(16);
-
- Store_field(result, 0, caml_copy_int32(regs->eax));
- Store_field(result, 1, caml_copy_int32(regs->ecx));
- Store_field(result, 2, caml_copy_int32(regs->edx));
- Store_field(result, 3, caml_copy_int32(regs->ebx));
- Store_field(result, 4, caml_copy_int32(regs->esp));
- Store_field(result, 5, caml_copy_int32(regs->ebp));
- Store_field(result, 6, caml_copy_int32(regs->esi));
- Store_field(result, 7, caml_copy_int32(regs->edi));
- Store_field(result, 8, caml_copy_int32(regs->eip));
- Store_field(result, 9, caml_copy_int32(regs->eflags));
- Store_field(result, 10, caml_copy_int32(regs->cs)); /* 16 */
- Store_field(result, 11, caml_copy_int32(regs->ss)); /* 16 */
- Store_field(result, 12, caml_copy_int32(regs->ds)); /* 16 */
- Store_field(result, 13, caml_copy_int32(regs->es)); /* 16 */
- Store_field(result, 14, caml_copy_int32(regs->fs)); /* 16 */
- Store_field(result, 15, caml_copy_int32(regs->gs)); /* 16 */
-
- CAMLreturn(result);
-}
-
-
-/*
- * dom_write_register : context_t -> register -> int32 -> unit
- */
-value
-dom_write_register (value context, value reg, value newval)
-{
- CAMLparam3(context, reg, newval);
-
- int my_reg = Int_val(reg);
- int val = Int32_val(newval);
-
- context_t ctx;
- cpu_user_regs_t *regs;
-
- printf("(pdb) write register\n");
-
- decode_context(&ctx, context);
-
- if ( xendebug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) )
- {
- printf("(pdb) write register (get) error!\n"); fflush(stdout);
- failwith("write register error");
- }
-
- switch (my_reg)
- {
- case GDB_EAX: regs->eax = val; break;
- case GDB_ECX: regs->ecx = val; break;
- case GDB_EDX: regs->edx = val; break;
- case GDB_EBX: regs->ebx = val; break;
-
- case GDB_ESP: regs->esp = val; break;
- case GDB_EBP: regs->ebp = val; break;
- case GDB_ESI: regs->esi = val; break;
- case GDB_EDI: regs->edi = val; break;
-
- case GDB_EIP: regs->eip = val; break;
- case GDB_EFL: regs->eflags = val; break;
-
- case GDB_CS: regs->cs = val; break;
- case GDB_SS: regs->ss = val; break;
- case GDB_DS: regs->ds = val; break;
- case GDB_ES: regs->es = val; break;
- case GDB_FS: regs->fs = val; break;
- case GDB_GS: regs->gs = val; break;
- }
-
- if ( xendebug_write_registers(xc_handle, ctx.domain, ctx.vcpu, regs) )
- {
- printf("(pdb) write register (set) error!\n"); fflush(stdout);
- failwith("write register error");
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * dom_read_memory : context_t -> int32 -> int -> int
- */
-value
-dom_read_memory (value context, value address, value length)
-{
- CAMLparam3(context, address, length);
- CAMLlocal2(result, temp);
-
- context_t ctx;
- int loop;
- char *buffer;
- unsigned long my_address = Int32_val(address);
- uint32_t my_length = Int_val(length);
-
- printf ("(pdb) read memory\n");
-
- decode_context(&ctx, context);
-
- buffer = malloc(my_length);
- if ( buffer == NULL )
- {
- printf("(pdb) read memory: malloc failed.\n"); fflush(stdout);
- failwith("read memory error");
- }
-
- if ( xendebug_read_memory(xc_handle, ctx.domain, ctx.vcpu,
- my_address, my_length, buffer) )
- {
- printf("(pdb) read memory error!\n"); fflush(stdout);
- failwith("read memory error");
- }
-
- result = caml_alloc(2,0);
- if ( my_length > 0 ) /* car */
- {
- Store_field(result, 0, Val_int(buffer[my_length - 1] & 0xff));
- }
- else
-
- {
- Store_field(result, 0, Val_int(0));
- }
- Store_field(result, 1, Val_int(0)); /* cdr */
-
- for (loop = 1; loop < my_length; loop++)
- {
- temp = result;
- result = caml_alloc(2,0);
- Store_field(result, 0, Val_int(buffer[my_length - loop - 1] & 0xff));
- Store_field(result, 1, temp);
- }
-
- CAMLreturn(result);
-}
-
-/*
- * dom_write_memory : context_t -> int32 -> int list -> unit
- */
-value
-dom_write_memory (value context, value address, value val_list)
-{
- CAMLparam3(context, address, val_list);
- CAMLlocal1(node);
-
- context_t ctx;
-
- char buffer[4096]; /* a big buffer */
- unsigned long my_address;
- uint32_t length = 0;
-
- printf ("(pdb) write memory\n");
-
- decode_context(&ctx, context);
-
- node = val_list;
- if ( Int_val(node) == 0 ) /* gdb functionalty test uses empty list */
- {
- CAMLreturn(Val_unit);
- }
-
- while ( Int_val(Field(node,1)) != 0 )
- {
- buffer[length++] = Int_val(Field(node, 0));
- node = Field(node,1);
- }
- buffer[length++] = Int_val(Field(node, 0));
-
- my_address = (unsigned long) Int32_val(address);
-
- if ( xendebug_write_memory(xc_handle, ctx.domain, ctx.vcpu,
- my_address, length, buffer) )
- {
- printf("(pdb) write memory error!\n"); fflush(stdout);
- failwith("write memory error");
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * dom_continue_target : context_t -> unit
- */
-value
-dom_continue_target (value context)
-{
- CAMLparam1(context);
-
- context_t ctx;
-
- decode_context(&ctx, context);
-
- if ( xendebug_continue(xc_handle, ctx.domain, ctx.vcpu) )
- {
- printf("(pdb) continue\n"); fflush(stdout);
- failwith("continue");
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * dom_step_target : context_t -> unit
- */
-value
-dom_step_target (value context)
-{
- CAMLparam1(context);
-
- context_t ctx;
-
- decode_context(&ctx, context);
-
- if ( xendebug_step(xc_handle, ctx.domain, ctx.vcpu) )
- {
- printf("(pdb) step\n"); fflush(stdout);
- failwith("step");
- }
-
- CAMLreturn(Val_unit);
-}
-
-
-
-/*
- * dom_insert_memory_breakpoint : context_t -> int32 -> int list -> unit
- */
-value
-dom_insert_memory_breakpoint (value context, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
- unsigned long my_address = (unsigned long) Int32_val(address);
- int my_length = Int_val(length);
-
- decode_context(&ctx, context);
-
- printf ("(pdb) insert memory breakpoint 0x%lx %d\n",
- my_address, my_length);
-
- if ( xendebug_insert_memory_breakpoint(xc_handle, ctx.domain, ctx.vcpu,
- my_address, my_length) )
- {
- printf("(pdb) error: insert memory breakpoint\n"); fflush(stdout);
- failwith("insert memory breakpoint");
- }
-
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * dom_remove_memory_breakpoint : context_t -> int32 -> int list -> unit
- */
-value
-dom_remove_memory_breakpoint (value context, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
-
- unsigned long my_address = (unsigned long) Int32_val(address);
- int my_length = Int_val(length);
-
- printf ("(pdb) remove memory breakpoint 0x%lx %d\n",
- my_address, my_length);
-
- decode_context(&ctx, context);
-
- if ( xendebug_remove_memory_breakpoint(xc_handle,
- ctx.domain, ctx.vcpu,
- my_address, my_length) )
- {
- printf("(pdb) error: remove memory breakpoint\n"); fflush(stdout);
- failwith("remove memory breakpoint");
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * dom_attach_debugger : int -> int -> unit
- */
-value
-dom_attach_debugger (value domain, value vcpu)
-{
- CAMLparam2(domain, vcpu);
-
- int my_domain = Int_val(domain);
- int my_vcpu = Int_val(vcpu);
-
- printf ("(pdb) attach domain [%d.%d]\n", my_domain, my_vcpu);
-
- if ( xendebug_attach(xc_handle, my_domain, my_vcpu) )
- {
- printf("(pdb) attach error!\n"); fflush(stdout);
- failwith("attach error");
- }
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * dom_detach_debugger : int -> int -> unit
- */
-value
-dom_detach_debugger (value domain, value vcpu)
-{
- CAMLparam2(domain, vcpu);
-
- int my_domain = Int_val(domain);
- int my_vcpu = Int_val(vcpu);
-
- printf ("(pdb) detach domain [%d.%d]\n", my_domain, my_vcpu);
-
- if ( xendebug_detach(xc_handle, my_domain, my_vcpu) )
- {
- printf("(pdb) detach error!\n"); fflush(stdout);
- failwith("detach error");
- }
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * dom_pause_target : int -> unit
- */
-value
-dom_pause_target (value domid)
-{
- CAMLparam1(domid);
-
- int my_domid = Int_val(domid);
-
- printf ("(pdb) pause target %d\n", my_domid);
-
- xc_domain_pause(xc_handle, my_domid);
-
- CAMLreturn(Val_unit);
-}
-
-/****************************************************************************/
-/****************************************************************************/
-
-/*
- * query_domain_stop : unit -> (int * int) list
- */
-value
-query_domain_stop (value unit)
-{
- CAMLparam1(unit);
- CAMLlocal3(result, temp, node);
-
- int max_domains = 20;
- int dom_list[max_domains];
- int loop, count;
-
- count = xendebug_query_domain_stop(xc_handle, dom_list, max_domains);
- if ( count < 0 )
- {
- printf("(pdb) query domain stop!\n"); fflush(stdout);
- failwith("query domain stop");
- }
-
- printf ("QDS [%d]: \n", count);
- for (loop = 0; loop < count; loop ++)
- printf (" %d", dom_list[loop]);
- printf ("\n");
-
- result = caml_alloc(2,0);
- if ( count > 0 ) /* car */
- {
- node = caml_alloc(2,0);
- Store_field(node, 0, Val_int(dom_list[0])); /* domain id */
- Store_field(node, 1, Val_int(0)); /* vcpu */
- Store_field(result, 0, node);
- }
- else
- {
- Store_field(result, 0, Val_int(0));
- }
- Store_field(result, 1, Val_int(0)); /* cdr */
-
- for ( loop = 1; loop < count; loop++ )
- {
- temp = result;
- result = caml_alloc(2,0);
- node = caml_alloc(2,0);
- Store_field(node, 0, Val_int(dom_list[loop])); /* domain id */
- Store_field(node, 1, Val_int(0)); /* vcpu */
- Store_field(result, 0, node);
- Store_field(result, 1, temp);
- }
-
- CAMLreturn(result);
-}
-
-/****************************************************************************/
-
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_caml_evtchn.c
--- a/tools/debugger/pdb/pdb_caml_evtchn.c Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,186 +0,0 @@
-/*
- * pdb_caml_evtchn.c
- *
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * PDB's OCaml interface library for event channels
- */
-
-#include <xenctrl.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-
-
-#include <errno.h>
-#include <sys/ioctl.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#include <unistd.h>
-
-int xen_evtchn_bind (int evtchn_fd, int idx);
-int xen_evtchn_unbind (int evtchn_fd, int idx);
-
-int
-__evtchn_open (char *filename, int major, int minor)
-{
- int evtchn_fd;
- struct stat st;
-
- /* Make sure any existing device file links to correct device. */
- if ( (lstat(filename, &st) != 0) ||
- !S_ISCHR(st.st_mode) ||
- (st.st_rdev != makedev(major, minor)) )
- {
- (void)unlink(filename);
- }
-
- reopen:
- evtchn_fd = open(filename, O_RDWR);
- if ( evtchn_fd == -1 )
- {
- if ( (errno == ENOENT) &&
- ((mkdir("/dev/xen", 0755) == 0) || (errno == EEXIST)) &&
- (mknod(filename, S_IFCHR|0600, makedev(major,minor)) == 0) )
- {
- goto reopen;
- }
- return -errno;
- }
-
- return evtchn_fd;
-}
-
-/*
- * evtchn_open : string -> int -> int -> Unix.file_descr
- *
- * OCaml's Unix library doesn't have mknod, so it makes more sense just write
- * this in C. This code is from Keir/Andy.
- */
-value
-evtchn_open (value filename, value major, value minor)
-{
- CAMLparam3(filename, major, minor);
-
- char *myfilename = String_val(filename);
- int mymajor = Int_val(major);
- int myminor = Int_val(minor);
- int evtchn_fd;
-
- evtchn_fd = __evtchn_open(myfilename, mymajor, myminor);
-
- CAMLreturn(Val_int(evtchn_fd));
-}
-
-/*
- * evtchn_bind : Unix.file_descr -> int -> unit
- */
-value
-evtchn_bind (value fd, value idx)
-{
- CAMLparam2(fd, idx);
-
- int myfd = Int_val(fd);
- int myidx = Int_val(idx);
-
- if ( xen_evtchn_bind(myfd, myidx) < 0 )
- {
- printf("(pdb) evtchn_bind error!\n"); fflush(stdout);
- failwith("evtchn_bind error");
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * evtchn_unbind : Unix.file_descr -> int -> unit
- */
-value
-evtchn_unbind (value fd, value idx)
-{
- CAMLparam2(fd, idx);
-
- int myfd = Int_val(fd);
- int myidx = Int_val(idx);
-
- if ( xen_evtchn_unbind(myfd, myidx) < 0 )
- {
- printf("(pdb) evtchn_unbind error!\n"); fflush(stdout);
- failwith("evtchn_unbind error");
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * evtchn_read : Unix.file_descr -> int
- */
-value
-evtchn_read (value fd)
-{
- CAMLparam1(fd);
-
- uint16_t v;
- int bytes;
- int rc = -1;
- int myfd = Int_val(fd);
-
- while ( (bytes = read(myfd, &v, sizeof(v))) == -1 )
- {
- if ( errno == EINTR ) continue;
- rc = -errno;
- goto exit;
- }
-
- if ( bytes == sizeof(v) )
- rc = v;
-
- exit:
- CAMLreturn(Val_int(rc));
-}
-
-
-/*
- * evtchn_close : Unix.file_descr -> unit
- */
-value
-evtchn_close (value fd)
-{
- CAMLparam1(fd);
- int myfd = Int_val(fd);
-
- (void)close(myfd);
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * evtchn_unmask : Unix.file_descr -> int -> unit
- */
-value
-evtchn_unmask (value fd, value idx)
-{
- CAMLparam1(fd);
-
- int myfd = Int_val(fd);
- uint16_t myidx = Int_val(idx);
-
- (void)write(myfd, &myidx, sizeof(myidx));
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_caml_process.c
--- a/tools/debugger/pdb/pdb_caml_process.c Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,587 +0,0 @@
-/*
- * pdb_caml_process.c
- *
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * PDB's OCaml interface library for debugging processes
- */
-
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-
-#include <xenctrl.h>
-#include <xen/xen.h>
-#include <xen/io/domain_controller.h>
-#include "pdb_module.h"
-#include "pdb_caml_xen.h"
-
-typedef struct
-{
- int domain;
- int process;
- int evtchn;
- pdb_front_ring_t *ring;
-} context_t;
-
-#define decode_context(_ctx, _ocaml) \
-{ \
- (_ctx)->domain = Int_val(Field((_ocaml),0)); \
- (_ctx)->process = Int_val(Field((_ocaml),1)); \
- (_ctx)->evtchn = Int_val(Field((_ocaml),2)); \
- (_ctx)->ring = (pdb_front_ring_t *)Int32_val(Field((_ocaml),3)); \
-}
-
-#define encode_context(_ctx, _ocaml) \
-{ \
- (_ocaml) = caml_alloc_tuple(2); \
- Store_field((_ocaml), 0, Val_int((_ctx)->domain)); \
- Store_field((_ocaml), 1, Val_int((_ctx)->process)); \
-}
-
-/*
- * send a request to a pdb domain backend.
- *
- * puts the request on a ring and kicks the backend using an event channel.
- */
-static void
-send_request (pdb_front_ring_t *pdb_ring, int evtchn, pdb_request_t *request)
-{
- pdb_request_t *req;
-
- req = RING_GET_REQUEST(pdb_ring, pdb_ring->req_prod_pvt);
-
- memcpy(req, request, sizeof(pdb_request_t));
-
- pdb_ring->req_prod_pvt++;
-
- RING_PUSH_REQUESTS(pdb_ring);
- xc_evtchn_send(xc_handle, evtchn);
-}
-
-/*
- * process_handle_response : int32 -> int * int * string
- *
- * A backend domain has notified pdb (via an event channel)
- * that a command has finished.
- * We read the result from the channel and formulate a response
- * as a single string. Also return the domain and process.
- */
-
-static inline unsigned int
-_flip (unsigned int orig)
-{
- return (((orig << 24) & 0xff000000) | ((orig << 8) & 0x00ff0000) |
- ((orig >> 8) & 0x0000ff00) | ((orig >> 24) & 0x000000ff));
-}
-
-value
-process_handle_response (value ring)
-{
- CAMLparam1(ring);
- CAMLlocal2(result, str);
-
- RING_IDX rp;
- pdb_response_p resp;
- pdb_front_ring_t *my_ring = (pdb_front_ring_t *)Int32_val(ring);
- char msg[2048];
- int msglen;
-
- memset(msg, 0, sizeof(msg));
-
- rp = my_ring->sring->rsp_prod;
- rmb(); /* Ensure we see queued responses up to 'rp'. */
-
- /* default response is OK unless the command has something
- more interesting to say */
- sprintf(msg, "OK");
-
- if (my_ring->rsp_cons != rp)
- {
- resp = RING_GET_RESPONSE(my_ring, my_ring->rsp_cons);
-
- switch (resp->operation)
- {
- case PDB_OPCODE_PAUSE :
- case PDB_OPCODE_ATTACH :
- case PDB_OPCODE_DETACH :
- break;
-
- case PDB_OPCODE_RD_REG :
- {
- sprintf(&msg[0], "%08x", _flip(resp->u.rd_reg.value));
- break;
- }
-
- case PDB_OPCODE_RD_REGS :
- {
- int loop;
- pdb_op_rd_regs_p regs = &resp->u.rd_regs;
-
- for (loop = 0; loop < GDB_REGISTER_FRAME_SIZE * 8; loop += 8)
- {
- sprintf(&msg[loop], "%08x", _flip(regs->reg[loop >> 3]));
- }
-
- break;
- }
- case PDB_OPCODE_WR_REG :
- {
- /* should check the return status */
- break;
- }
-
- case PDB_OPCODE_RD_MEM :
- {
- int loop;
- pdb_op_rd_mem_resp_p mem = &resp->u.rd_mem;
-
- for (loop = 0; loop < mem->length; loop ++)
- {
- sprintf(&msg[loop * 2], "%02x", mem->data[loop]);
- }
- break;
- }
- case PDB_OPCODE_WR_MEM :
- {
- /* should check the return status */
- break;
- }
-
- /* this is equivalent to process_xen_virq */
- case PDB_OPCODE_CONTINUE :
- {
- sprintf(msg, "S05");
- break;
- }
- case PDB_OPCODE_STEP :
- {
- sprintf(msg, "S05");
- break;
- }
-
- case PDB_OPCODE_SET_BKPT :
- case PDB_OPCODE_CLR_BKPT :
- case PDB_OPCODE_SET_WATCHPT :
- case PDB_OPCODE_CLR_WATCHPT :
- {
- break;
- }
-
- case PDB_OPCODE_WATCHPOINT :
- {
- sprintf(msg, "S05");
- break;
- }
-
- default :
- printf("(linux) UNKNOWN MESSAGE TYPE IN RESPONSE %d\n",
- resp->operation);
- break;
- }
-
- my_ring->rsp_cons++;
- }
-
- msglen = strlen(msg);
- result = caml_alloc(3,0);
- str = alloc_string(msglen);
- memmove(&Byte(str,0), msg, msglen);
-
- Store_field(result, 0, Val_int(resp->domain));
- Store_field(result, 1, Val_int(resp->process));
- Store_field(result, 2, str);
-
- CAMLreturn(result);
-}
-
-/*
- * proc_attach_debugger : context_t -> unit
- */
-value
-proc_attach_debugger (value context)
-{
- CAMLparam1(context);
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_ATTACH;
- req.u.attach.domain = ctx.domain;
- req.process = ctx.process;
-
- send_request (ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_detach_debugger : context_t -> unit
- */
-value
-proc_detach_debugger (value context)
-{
- CAMLparam1(context);
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- printf("(pdb) detach process [%d.%d] %d %p\n", ctx.domain, ctx.process,
- ctx.evtchn, ctx.ring);
- fflush(stdout);
-
- req.operation = PDB_OPCODE_DETACH;
- req.process = ctx.process;
-
- send_request (ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_pause_target : int -> unit
- */
-value
-proc_pause_target (value context)
-{
- CAMLparam1(context);
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- printf("(pdb) pause target %d %d\n", ctx.domain, ctx.process);
- fflush(stdout);
-
- req.operation = PDB_OPCODE_PAUSE;
- req.process = ctx.process;
-
- send_request (ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_read_register : context_t -> int -> unit
- */
-value
-proc_read_register (value context, value reg)
-{
- CAMLparam1(context);
-
- pdb_request_t req;
- context_t ctx;
- int my_reg = Int_val(reg);
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_RD_REG;
- req.process = ctx.process;
- req.u.rd_reg.reg = my_reg;
- req.u.rd_reg.value = 0;
-
- send_request (ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-
-/*
- * proc_read_registers : context_t -> unit
- */
-value
-proc_read_registers (value context)
-{
- CAMLparam1(context);
-
- pdb_request_t req;
- context_t ctx;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_RD_REGS;
- req.process = ctx.process;
-
- send_request (ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_write_register : context_t -> register -> int32 -> unit
- */
-value
-proc_write_register (value context, value reg, value newval)
-{
- CAMLparam3(context, reg, newval);
-
- int my_reg = Int_val(reg);
- unsigned long my_newval = Int32_val(newval);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_WR_REG;
- req.process = ctx.process;
- req.u.wr_reg.value = my_newval;
-
- switch (my_reg)
- {
- case GDB_EAX: req.u.wr_reg.reg = LINUX_EAX; break;
- case GDB_ECX: req.u.wr_reg.reg = LINUX_ECX; break;
- case GDB_EDX: req.u.wr_reg.reg = LINUX_EDX; break;
- case GDB_EBX: req.u.wr_reg.reg = LINUX_EBX; break;
-
- case GDB_ESP: req.u.wr_reg.reg = LINUX_ESP; break;
- case GDB_EBP: req.u.wr_reg.reg = LINUX_EBP; break;
- case GDB_ESI: req.u.wr_reg.reg = LINUX_ESI; break;
- case GDB_EDI: req.u.wr_reg.reg = LINUX_EDI; break;
-
- case GDB_EIP: req.u.wr_reg.reg = LINUX_EIP; break;
- case GDB_EFL: req.u.wr_reg.reg = LINUX_EFL; break;
-
- case GDB_CS: req.u.wr_reg.reg = LINUX_CS; break;
- case GDB_SS: req.u.wr_reg.reg = LINUX_SS; break;
- case GDB_DS: req.u.wr_reg.reg = LINUX_DS; break;
- case GDB_ES: req.u.wr_reg.reg = LINUX_ES; break;
- case GDB_FS: req.u.wr_reg.reg = LINUX_FS; break;
- case GDB_GS: req.u.wr_reg.reg = LINUX_GS; break;
- }
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_read_memory : context_t -> int32 -> int -> unit
- */
-value
-proc_read_memory (value context, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_RD_MEM;
- req.process = ctx.process;
- req.u.rd_mem.address = Int32_val(address);
- req.u.rd_mem.length = Int_val(length);
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_write_memory : context_t -> int32 -> int list -> unit
- */
-value
-proc_write_memory (value context, value address, value val_list)
-{
- CAMLparam3(context, address, val_list);
- CAMLlocal1(node);
-
- context_t ctx;
- pdb_request_t req;
- uint32_t length = 0;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_WR_MEM;
- req.process = ctx.process;
-
- node = val_list;
- if ( Int_val(node) == 0 ) /* gdb functionalty test uses empty list */
- {
- req.u.wr_mem.address = Int32_val(address);
- req.u.wr_mem.length = 0;
- }
- else
- {
- while ( Int_val(Field(node,1)) != 0 )
- {
- req.u.wr_mem.data[length++] = Int_val(Field(node, 0));
- node = Field(node,1);
- }
- req.u.wr_mem.data[length++] = Int_val(Field(node, 0));
-
- req.u.wr_mem.address = Int32_val(address);
- req.u.wr_mem.length = length;
- }
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * proc_continue_target : context_t -> unit
- */
-value
-proc_continue_target (value context)
-{
- CAMLparam1(context);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_CONTINUE;
- req.process = ctx.process;
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * proc_step_target : context_t -> unit
- */
-value
-proc_step_target (value context)
-{
- CAMLparam1(context);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_STEP;
- req.process = ctx.process;
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-
-/*
- * proc_insert_memory_breakpoint : context_t -> int32 -> int -> unit
- */
-value
-proc_insert_memory_breakpoint (value context, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_SET_BKPT;
- req.process = ctx.process;
- req.u.bkpt.address = (unsigned long) Int32_val(address);
- req.u.bkpt.length = Int_val(length);
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * proc_remove_memory_breakpoint : context_t -> int32 -> int -> unit
- */
-value
-proc_remove_memory_breakpoint (value context, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_CLR_BKPT;
- req.process = ctx.process;
- req.u.bkpt.address = (unsigned long) Int32_val(address);
- req.u.bkpt.length = Int_val(length);
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * proc_insert_watchpoint : context_t -> bwcpoint_t -> int32 -> int -> unit
- */
-value
-proc_insert_watchpoint (value context, value kind, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_SET_WATCHPT;
- req.process = ctx.process;
- req.u.watchpt.type = Int_val(kind);
- req.u.watchpt.address = (unsigned long) Int32_val(address);
- req.u.watchpt.length = Int_val(length);
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * proc_remove_watchpoint : context_t -> bwcpoint_t -> int32 -> int -> unit
- */
-value
-proc_remove_watchpoint (value context, value kind, value address, value length)
-{
- CAMLparam3(context, address, length);
-
- context_t ctx;
- pdb_request_t req;
-
- decode_context(&ctx, context);
-
- req.operation = PDB_OPCODE_CLR_WATCHPT;
- req.process = ctx.process;
- req.u.watchpt.type = Int_val(kind);
- req.u.watchpt.address = (unsigned long) Int32_val(address);
- req.u.watchpt.length = Int_val(length);
-
- send_request(ctx.ring, ctx.evtchn, &req);
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_caml_xc.c
--- a/tools/debugger/pdb/pdb_caml_xc.c Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,170 +0,0 @@
-/*
- * pdb_caml_xc.c
- *
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * PDB's OCaml interface library for debugging domains
- */
-
-#include <xenctrl.h>
-#include <xendebug.h>
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <sys/mman.h>
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-
-#include "pdb_caml_xen.h"
-
-int xc_handle = -1;
-
-
-/****************************************************************************/
-
-/*
- * open_context : unit -> unit
- */
-value
-open_context (value unit)
-{
- CAMLparam1(unit);
-
- xc_handle = xc_interface_open();
-
- if ( xc_handle < 0 )
- {
- fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n",
- errno, strerror(errno));
- }
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * close_context : unit -> unit
- */
-value
-close_context (value unit)
-{
- CAMLparam1(unit);
- int rc;
-
- if ( (rc = xc_interface_close(xc_handle)) < 0 )
- {
- fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n",
- errno, strerror(errno));
- }
-
- CAMLreturn(Val_unit);
-}
-
-
-/*********************************************************************/
-
-void
-dump_regs (cpu_user_regs_t *regs)
-{
- printf (" eax: %x\n", regs->eax);
- printf (" ecx: %x\n", regs->ecx);
- printf (" edx: %x\n", regs->edx);
- printf (" ebx: %x\n", regs->ebx);
- printf (" esp: %x\n", regs->esp);
- printf (" ebp: %x\n", regs->ebp);
- printf (" esi: %x\n", regs->esi);
- printf (" edi: %x\n", regs->edi);
- printf (" eip: %x\n", regs->eip);
- printf (" flags: %x\n", regs->eflags);
- printf (" cs: %x\n", regs->cs);
- printf (" ss: %x\n", regs->ss);
- printf (" es: %x\n", regs->es);
- printf (" ds: %x\n", regs->ds);
- printf (" fs: %x\n", regs->fs);
- printf (" gs: %x\n", regs->gs);
-
- return;
-}
-
-/*
- * debugger_status : unit -> unit
- */
-value
-debugger_status (value unit)
-{
- CAMLparam1(unit);
-
- CAMLreturn(Val_unit);
-}
-
-/****************************************************************************/
-/****************************************************************************/
-
-/*
- * evtchn_bind_virq : int -> int
- */
-value
-evtchn_bind_virq (value virq)
-{
- CAMLparam1(virq);
-
- int port;
- int my_virq = Int_val(virq);
-
- if ( xc_evtchn_bind_virq(xc_handle, my_virq, &port) < 0 )
- {
- printf("(pdb) evtchn_bind_virq error!\n"); fflush(stdout);
- failwith("evtchn_bind_virq error");
- }
-
- CAMLreturn(Val_int(port));
-}
-
-/*
- * evtchn_bind_interdomain : int -> int * int
- */
-value
-evtchn_bind_interdomain (value remote_domain)
-{
- CAMLparam1(remote_domain);
- CAMLlocal1(result);
-
- int my_remote_domain = Int_val(remote_domain);
- int local_domain = 0;
- int local_port = 0;
- int remote_port = 0;
-
- if ( xc_evtchn_bind_interdomain(xc_handle, local_domain, my_remote_domain,
- &local_port, &remote_port) < 0 )
- {
- printf("(pdb) evtchn_bind_interdomain error!\n"); fflush(stdout);
- failwith("evtchn_bind_interdomain error");
- }
-
- result = caml_alloc_tuple(2); /* FIXME */
- Store_field(result, 0, Val_int(local_port));
- Store_field(result, 1, Val_int(remote_port));
-
- CAMLreturn(result);
-}
-
-void *
-map_ring(uint32_t dom, unsigned long mfn )
-{
- return xc_map_foreign_range(xc_handle, dom, PAGE_SIZE,
- PROT_READ | PROT_WRITE, mfn);
-}
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_caml_xcs.c
--- a/tools/debugger/pdb/pdb_caml_xcs.c Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,307 +0,0 @@
-/*
- * xcs stuff
- *
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * this is responsible for establishing the initial connection
- * between a backend domain and the pdb server.
- *
- * liberated from xu.c
- *
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <unistd.h>
-#include <sys/un.h>
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <errno.h>
-#include <xenctrl.h>
-
-#include <xen/xen.h>
-#include <xen/io/domain_controller.h>
-
-#include <arpa/inet.h>
-#include <xcs_proto.h>
-
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-
-static int control_fd = -1;
-
-#include "pdb_module.h"
-#include "pdb_caml_xen.h"
-
-void *map_ring(uint32_t dom, unsigned long mfn );
-
-/*
- * xcs_initialize_ring : int -> int32 -> int32
- *
- * initialize a communications ring
- * (probably belongs in a different file :)
- */
-
-value
-xcs_initialize_ring (value domain, value ring)
-{
- CAMLparam2(domain, ring);
- int my_domain = Int_val(domain);
- unsigned long my_ring = Int32_val(ring);
-
- pdb_front_ring_t *front_ring;
- pdb_sring_t *sring;
-
- front_ring = (pdb_front_ring_t *)malloc(sizeof(pdb_front_ring_t));
- if ( front_ring == NULL )
- {
- printf("(pdb) xcs initialize ring: malloc failed.\n"); fflush(stdout);
- failwith("xcs initialize ring: malloc");
- }
-
- sring = map_ring(my_domain, my_ring);
- if ( sring == NULL )
- {
- printf("(pdb) xcs initialize ring: map ring failed.\n");fflush(stdout);
- failwith("xcs initialize ring: map ring");
- }
- FRONT_RING_INIT(front_ring, sring, PAGE_SIZE);
-
- CAMLreturn(caml_copy_int32((unsigned long)front_ring));
-}
-
-
-/*
- * xcs_write_message : Unix.file_descr -> xcs_message -> unit
- *
- * ack a packet
- */
-value
-xcs_write_message (value data_fd, value msg)
-{
- CAMLparam2(data_fd, msg);
- int my_data_fd = Int_val(data_fd);
- xcs_msg_t my_msg;
- pdb_connection_p conn;
-
- my_msg.type = XCS_REQUEST;
- my_msg.u.control.remote_dom = Int_val(Field(msg,0));
- my_msg.u.control.msg.type = CMSG_DEBUG;
- my_msg.u.control.msg.subtype = CMSG_DEBUG_CONNECTION_STATUS;
- my_msg.u.control.msg.id = 0;
- my_msg.u.control.msg.length = sizeof(pdb_connection_t);
-
- conn = (pdb_connection_p)my_msg.u.control.msg.msg;
-
- conn->status = Int_val(Field(msg,1));
- conn->ring = Int32_val(Field(msg,2));
- conn->evtchn = Int_val(Field(msg,3));
-
- send(my_data_fd, &my_msg, sizeof(xcs_msg_t), 0); /* ack */
-
- CAMLreturn(Val_unit);
-}
-
-/*
- * xcs_read_message : Unix.file_descr -> xcs_message
- *
- * read pending data on xcs socket.
- */
-
-value
-xcs_read_message (value data_fd)
-{
- CAMLparam1(data_fd);
- CAMLlocal1(result);
- int my_data_fd = Int_val(data_fd);
- xcs_msg_t msg;
-
- if ( read(my_data_fd, &msg, sizeof(xcs_msg_t)) < 0 )
- {
- perror("read");
- failwith("xcs message: read");
- }
-
- switch (msg.type)
- {
- case XCS_REQUEST :
- {
- pdb_connection_p conn;
-
- if ( msg.u.control.msg.type != CMSG_DEBUG ||
- msg.u.control.msg.subtype != CMSG_DEBUG_CONNECTION_STATUS )
- {
- printf("bogus message type: %d %d\n",
- msg.u.control.msg.type, msg.u.control.msg.subtype);
- failwith("xcs message: invalid message type");
- }
-
- conn = (pdb_connection_p) msg.u.control.msg.msg;
-
- result = caml_alloc_tuple(4); /* FIXME */
- Store_field(result, 0, Val_int(msg.u.control.remote_dom)); /* domain */
- Store_field(result, 1, Val_int(conn->status)); /* status */
- Store_field(result, 2, caml_copy_int32(conn->ring)); /* ring */
- Store_field(result, 3, Val_int(0)); /* OUT: evtchn */
-
- break;
- }
- case XCS_RESPONSE :
- {
- printf("[XCS RESPONSE] type: %d, remote_dom: %d\n",
- msg.type, msg.u.control.remote_dom);
- printf("strange. we never initiate messages, so what is the ");
- printf("domain responding to?\n");
- failwith ("xcs message: resonse");
- break;
- }
- default:
- {
- printf("[XCS IGNORE] type: %d\n", msg.type);
- failwith ("xcs message: unknown");
- break;
- }
- }
-
- CAMLreturn(result);
-}
-
-/*
- * xcs_connect : string -> int -> Unix.file_descr
- */
-
-value
-xcs_connect (value path, value msg_type)
-{
- CAMLparam2(path, msg_type);
- char *my_path = String_val(path);
- int my_msg_type = Int_val(msg_type);
- struct sockaddr_un addr;
- uint32_t session_id = 0;
- int data_fd;
- int ret, len;
- xcs_msg_t msg;
-
- /* setup control channel connection to xcs */
-
- control_fd = socket(AF_UNIX, SOCK_STREAM, 0);
- if ( control_fd < 0 )
- {
- printf("error creating xcs socket!\n");
- goto fail;
- }
-
- addr.sun_family = AF_UNIX;
- strcpy(addr.sun_path, my_path);
- len = sizeof(addr.sun_family) + strlen(addr.sun_path) + 1;
-
- ret = connect(control_fd, (struct sockaddr *)&addr, len);
- if (ret < 0)
- {
- printf("error connecting to xcs (ctrl)! (%d)\n", errno);
- goto ctrl_fd_fail;
- }
-
- msg.type = XCS_CONNECT_CTRL;
- msg.u.connect.session_id = session_id;
- send(control_fd, &msg, sizeof(xcs_msg_t), 0);
- /* bug: this should have a timeout & error! */
- read(control_fd, &msg, sizeof(xcs_msg_t));
-
- if (msg.result != XCS_RSLT_OK)
- {
- printf("error connecting xcs control channel!\n");
- goto ctrl_fd_fail;
- }
- session_id = msg.u.connect.session_id;
-
-
- /* setup data channel connection to xcs */
-
- data_fd = socket(AF_UNIX, SOCK_STREAM, 0);
- if ( data_fd < 0 )
- {
- printf("error creating xcs data socket!\n");
- goto ctrl_fd_fail;
- }
-
- addr.sun_family = AF_UNIX;
- strcpy(addr.sun_path, my_path);
- len = sizeof(addr.sun_family) + strlen(addr.sun_path) + 1;
-
- ret = connect(data_fd, (struct sockaddr *)&addr, len);
- if (ret < 0)
- {
- printf("error connecting to xcs (data)! (%d)\n", errno);
- goto data_fd_fail;
- }
-
- msg.type = XCS_CONNECT_DATA;
- msg.u.connect.session_id = session_id;
- send(data_fd, &msg, sizeof(xcs_msg_t), 0);
- read(data_fd, &msg, sizeof(xcs_msg_t)); /* same bug */
-
- if ( msg.result != XCS_RSLT_OK )
- {
- printf("error connecting xcs control channel!\n");
- goto ctrl_fd_fail;
- }
-
-
-
- /* now request all messages of a particular type */
-
- msg.type = XCS_MSG_BIND;
- msg.u.bind.port = PORT_WILDCARD;
- msg.u.bind.type = my_msg_type;
- send(control_fd, &msg, sizeof(xcs_msg_t), 0);
- read(control_fd, &msg, sizeof(xcs_msg_t)); /* still buggy */
-
- if (msg.result != XCS_RSLT_OK) {
- printf ("error: MSG BIND\n");
- goto bind_fail;
- }
-
- CAMLreturn(Val_int(data_fd));
-
-bind_fail:
-data_fd_fail:
- close(data_fd);
-
-ctrl_fd_fail:
- close(control_fd);
-
-fail:
- failwith("xcs connection error"); /* should be more explicit */
-}
-
-
-/* xcs_disconnect: Unix.file_descr -> unit */
-
-value
-xcs_disconnect (value data_fd)
-{
- CAMLparam1(data_fd);
-
- int my_data_fd = Int_val(data_fd);
-
- close(my_data_fd);
- close(control_fd);
- control_fd = -1;
-
- CAMLreturn(Val_unit);
-}
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_caml_xen.h
--- a/tools/debugger/pdb/pdb_caml_xen.h Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-/*
- * pdb_caml_xen.h
- *
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * generic xen definitions
- *
- */
-
-#ifndef _PDB_CAML_XEN_DEFINED_
-#define _PDB_CAML_XEN_DEFINED_
-
-enum gdb_registers { /* 32 */ GDB_EAX, GDB_ECX, GDB_EDX, GDB_EBX,
- GDB_ESP, GDB_EBP, GDB_ESI, GDB_EDI,
- GDB_EIP, GDB_EFL,
- /* 16 */ GDB_CS, GDB_SS, GDB_DS, GDB_ES,
- GDB_FS, GDB_GS };
-#define GDB_REGISTER_FRAME_SIZE 16
-
-/* this order comes from linux-2.6.11/include/asm-i386/ptrace.h */
-enum x86_registers { LINUX_EBX, LINUX_ECX, LINUX_EDX, LINUX_ESI, LINUX_EDI,
- LINUX_EBP, LINUX_EAX, LINUX_DS, LINUX_ES, LINUX_FS,
- LINUX_GS, LINUX_ORIG_EAX, LINUX_EIP, LINUX_CS, LINUX_EFL,
- LINUX_ESP, LINUX_SS };
-#define REGISTER_FRAME_SIZE 17
-
-
-/* hack: this is also included from the pdb linux module which
- has PAGE_SIZE defined */
-#ifndef PAGE_SIZE
-#define PAGE_SIZE 4096
-#endif
-
-extern int xc_handle;
-
-void dump_regs (cpu_user_regs_t *ctx);
-
-#endif
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/pdb_xen.c
--- a/tools/debugger/pdb/pdb_xen.c Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,75 +0,0 @@
-/*
- * pdb_xen.c
- *
- * alex ho
- * http://www.cl.cam.ac.uk/netos/pdb
- *
- * PDB interface library for accessing Xen
- */
-
-#include <xenctrl.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <string.h>
-#include <sys/mman.h>
-
-int
-pdb_open ()
-{
- int xc_handle = xc_interface_open();
-
- if ( xc_handle < 0 )
- {
- fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n",
- errno, strerror(errno));
- }
- return xc_handle;
-}
-
-int
-pdb_close (int xc_handle)
-{
- int rc;
-
-
- if ( (rc = xc_interface_close(xc_handle)) < 0 )
- {
- fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n",
- errno, strerror(errno));
- }
- return rc;
-}
-
-
-#include <sys/ioctl.h>
-#include <xen/linux/evtchn.h>
-
-int
-xen_evtchn_bind (int evtchn_fd, int idx)
-{
- if ( ioctl(evtchn_fd, EVTCHN_BIND, idx) != 0 )
- return -errno;
-
- return 0;
-}
-
-int
-xen_evtchn_unbind (int evtchn_fd, int idx)
-{
- if ( ioctl(evtchn_fd, EVTCHN_UNBIND, idx) != 0 )
- return -errno;
-
- return 0;
-}
-
-
-/*
- * Local variables:
- * mode: C
- * c-set-style: "BSD"
- * c-basic-offset: 4
- * tab-width: 4
- * indent-tabs-mode: nil
- * End:
- */
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/readme
--- a/tools/debugger/pdb/readme Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,105 +0,0 @@
-
-PDB 0.3.3
-http://www.cl.cam.ac.uk/netos/pdb
-
-Alex Ho
-August 2005
-
-
-This is the latest incarnation of the pervasive debugger.
-PDB is a remote stub for GDB. Running as a user-space
-application in domain 0, it can debug any other domain.
-
-
-+------+ tcp/ip +-------+
-| GDB |--------------| PDB |
-+------+ +-------+ +-------+
- | Dom 0 | | Dom U |
- +-------+---+-------+
- | Xen |
- +-------------------+
-
-Installation
-
-- Install OCaml 3.08 in domain 0.
- http://caml.inria.fr/download.en.html is a good place to start.
-
-- Build Xen with debugger support
- make domu_debug=y xen
-
-- (optional)
- Build the target domains with debugging symbols.
- make CONFIG_DEBUG_INFO=true CONFIG_FRAME_POINTER=false linux-2.6-xenU-build
-
- You can also change linux-2.6.12-xenU/Makefile
- CONFIG_CC_OPTIMIZE_FOR_SIZE from -O2 to -O
-
-- Build PDB
- (cd tools/debugger/libxendebug; make install)
- (cd tools/debugger/pdb; make)
-
-Usage
-
-- PDB does not currently support SMP. Please boot xen with "maxcpus=1"
-
-- Run PDB
- domain-0.xeno# ./pdb <port>
-
-- Run GDB
- hostname% gdb <xeno.bk>/dist/install/boot/vmlinux-syms-2.6.12-xenU
-
- (gdb) target remote domain-0.xeno:<port>
-
- At this point, you'll get an error message such as:
- Remote debugging using domain-0.xeno:5000
- 0x00000000 in ?? ()
- warning: shared library handler failed to enable breakpoint
- Although GDB is connected to PDB, PDB doesn't know which domain
- you'd like to debug, so it's just feeding GDB a bunch of zeros.
-
- (gdb) maint packet x context = domain <domid> <vcpu>
-
- This tells PDB that we'd like to debug a particular domain & vcpu.
- However, since we're sending the command directly to PDB, GDB doesn't
- know that we now have a proper target. We can force GDB to invalidate
- its register cache. This is optional; the next time the program
- stops GDB will query for the registers automatically.
-
- (gdb) flushreg
-
-
- the following gdb commands should work :)
-
- break
- step, stepi
- next, nexti
- continue
- print
-
-Process
-
- PDB can also debug a process running in a Linux 2.6 domain.
- You will need to patch the Linux 2.6 domain U tree to export some
- additional symbols for the pdb module
-
- % make -C linux-2.6-patches
-
- After running PDB in domain 0, insert the pdb module in dom u:
-
- % insmod linux-2.6-module/pdb.ko
-
- Load GDB with the appropriate symbols, and attach with
-
- (gdb) maint packet x context = process <domid> <pid>
-
- Read, write, and access watchpoint should also work for processes,
- use the "rwatch", "watch" and "awatch" gdb commands respectively.
-
- If you are having trouble with GDB 5.3 (i386-redhat-linux-gnu),
- try GDB 6.3 (configured with --target=i386-linux-gnu).
-
-
-To Do
-
-- watchpoints for domains
-- support for SMP
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/server.ml
--- a/tools/debugger/pdb/server.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,241 +0,0 @@
-(** server.ml
- *
- * PDB server main loop
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Unix
-open Buffer
-open Util
-
-(**
- * connection_t: The state for each connection.
- * buffer & length contains bytes that have been read from the sock
- * but not yet parsed / processed.
- *)
-type connection_t =
-{
- fd : file_descr;
- mutable buffer : string;
- mutable length : int;
-}
-
-
-(**
- * validate_checksum: Compute and compare the checksum of a string
- * against the provided checksum using the gdb serial protocol algorithm.
- *
- *)
-let validate_checksum command checksum =
- let c0 = ref 0 in
- for loop = 0 to (String.length command - 1) do
- c0 := !c0 + int_of_char(command.[loop]);
- done;
- if (String.length checksum) = 2
- then
- let c1 = Util.int_of_hexchar(checksum.[1]) +
- Util.int_of_hexchar(checksum.[0]) * 16 in
- (!c0 mod 256) = (c1 mod 256)
- else
- false
-
-
-(**
- * process_input: Oh, joy! Someone sent us a message. Let's open the
- * envelope and see what they have to say.
- *
- * This function is a paradigm of inefficiency; it performs as many
- * string copies as possible.
- *)
-let process_input conn sock =
- let max_buffer_size = 1024 in
- let in_string = String.create max_buffer_size in
-
- let length = read sock in_string 0 max_buffer_size in
- conn.buffer <- conn.buffer ^ (String.sub in_string 0 length);
- conn.length <- conn.length + length;
- let re = Str.regexp "[^\\$]*\\$\\([^#]*\\)#\\(..\\)" in
-
- (* interrupt the target if there was a ctrl-c *)
- begin
- try
- let break = String.index conn.buffer '\003' + 1 in
- print_endline (Printf.sprintf "{{%s}}" (String.escaped conn.buffer));
-
- (* discard everything seen before the ctrl-c *)
- conn.buffer <- String.sub conn.buffer break (conn.length - break);
- conn.length <- conn.length - break;
-
- (* pause the target *)
- PDB.pause (PDB.find_context sock);
-
- (* send a code back to the debugger *)
- Util.send_reply sock "S05"
-
- with
- Not_found -> ()
- end;
-
- (* with gdb this is unlikely to loop since you ack each packet *)
- while ( Str.string_match re conn.buffer 0 ) do
- let command = Str.matched_group 1 conn.buffer in
- let checksum = Str.matched_group 2 conn.buffer in
- let match_end = Str.group_end 2 in
-
- begin
- match validate_checksum command checksum with
- | true ->
- begin
- Util.write_character sock '+';
- try
- let reply = Debugger.process_command command sock in
- print_endline (Printf.sprintf "[%s] %s -> \"%s\""
- (Util.get_connection_info sock)
- (String.escaped command)
- (String.escaped reply));
- Util.send_reply sock reply
- with
- Util.No_reply ->
- print_endline (Printf.sprintf "[%s] %s -> null"
- (Util.get_connection_info sock)
- (String.escaped command))
- end
- | false ->
- Util.write_character sock '-';
- end;
-
- conn.buffer <- String.sub conn.buffer match_end (conn.length - match_end);
- conn.length <- conn.length - match_end;
- done;
- if length = 0 then raise End_of_file
-
-
-
-(** main_server_loop.
- *
- * connection_hash is a hash (duh!) with one connection_t for each
- * open connection.
- *
- * in_list is a list of active sockets. it also contains a number
- * of magic entries:
- * - server_sock for accepting new client connections (e.g. gdb)
- * - xen_virq_sock for Xen virq asynchronous notifications (via evtchn).
- * This is used by context = domain
- * - xcs_sock for xcs messages when a new backend domain registers
- * This is used by context = process
- *)
-let main_server_loop sockaddr =
- let connection_hash = Hashtbl.create 10
- in
- let process_socket svr_sock sockets sock =
- let (new_list, closed_list) = sockets in
- if sock == svr_sock
- then
- begin
- let (new_sock, caller) = accept sock in
- print_endline (Printf.sprintf "[%s] new connection from %s"
- (Util.get_connection_info sock)
- (Util.get_connection_info new_sock));
- Hashtbl.add connection_hash new_sock
- {fd=new_sock; buffer=""; length = 0};
- PDB.add_default_context new_sock;
- (new_sock :: new_list, closed_list)
- end
- else
- begin
- try
- match PDB.find_context sock with
- | PDB.Xen_virq ->
- print_endline (Printf.sprintf "[%s] Xen virq"
- (Util.get_connection_info sock));
- Debugger.process_xen_virq sock;
- (new_list, closed_list)
- | PDB.Xen_xcs ->
- print_endline (Printf.sprintf "[%s] Xen xcs"
- (Util.get_connection_info sock));
- let new_xen_domain = Debugger.process_xen_xcs sock in
- (new_xen_domain :: new_list, closed_list)
- | PDB.Xen_domain d ->
- print_endline (Printf.sprintf "[%s] Xen domain"
- (Util.get_connection_info sock));
- Debugger.process_xen_domain sock;
- (new_list, closed_list)
- | _ ->
- let conn = Hashtbl.find connection_hash sock in
- process_input conn sock;
- (new_list, closed_list)
- with
- | Not_found ->
- print_endline "error: (main_svr_loop) context not found";
- PDB.debug_contexts ();
- raise Not_found
- | End_of_file ->
- print_endline (Printf.sprintf "[%s] close connection from %s"
- (Util.get_connection_info sock)
- (Util.get_connection_info sock));
- PDB.delete_context sock;
- Hashtbl.remove connection_hash sock;
- close sock;
- (new_list, sock :: closed_list)
- end
- in
-
- let rec helper in_list server_sock =
-
- (*
- List.iter (fun x->Printf.printf " {%s}\n"
- (Util.get_connection_info x)) in_list;
- Printf.printf "\n";
- *)
-
- let (rd_list, _, _) = select in_list [] [] (-1.0) in
- let (new_list, closed_list) = List.fold_left (process_socket server_sock)
- ([],[]) rd_list in
- let merge_list = Util.list_remove (new_list @ in_list) closed_list in
- helper merge_list server_sock
- in
-
- try
- let server_sock = socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
- setsockopt server_sock SO_REUSEADDR true;
- bind server_sock sockaddr;
- listen server_sock 2;
-
- PDB.open_debugger ();
- let xen_virq_sock = Evtchn.setup () in
- PDB.add_context xen_virq_sock "xen virq" [];
-
- let xcs_sock = Xcs.setup () in
- PDB.add_context xcs_sock "xen xcs" [];
- helper [server_sock; xen_virq_sock; xcs_sock] server_sock
- with
- | Sys.Break ->
- print_endline "break: cleaning up";
- PDB.close_debugger ();
- Hashtbl.iter (fun sock conn -> close sock) connection_hash
-(* | Unix_error(e,err,param) ->
- Printf.printf "unix error: [%s][%s][%s]\n" (error_message e) err param*)
- | Sys_error s -> Printf.printf "sys error: [%s]\n" s
- | Failure s -> Printf.printf "failure: [%s]\n" s
- | End_of_file -> Printf.printf "end of file\n"
-
-
-let get_port () =
- if (Array.length Sys.argv) = 2
- then
- int_of_string Sys.argv.(1)
- else
- begin
- print_endline (Printf.sprintf "error: %s <port>" Sys.argv.(0));
- exit 1
- end
-
-
-let main =
- let address = inet_addr_any in
- let port = get_port () in
- main_server_loop (ADDR_INET(address, port))
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/xcs.ml
--- a/tools/debugger/pdb/xcs.ml Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,85 +0,0 @@
-(** xcs.ml
- *
- * xen control switch interface
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-open Int32
-
-let xcs_path = "/var/lib/xen/xcs_socket" (* XCS_SUN_PATH *)
-let xcs_type = 11 (* CMSG_DEBUG *)
-
-
-type xcs_message =
- {
- domain : int;
- status : int;
- ring : int32;
- mutable evtchn : int;
- }
-
-external connect : string -> int -> Unix.file_descr = "xcs_connect"
-external disconnect : Unix.file_descr -> unit = "xcs_disconnect"
-external read_message : Unix.file_descr -> xcs_message = "xcs_read_message"
-external write_message : Unix.file_descr -> xcs_message -> unit =
- "xcs_write_message"
-external initialize_ring : int -> int32 -> int32 = "xcs_initialize_ring"
-
-(*
- * initialize xcs stuff
- *)
-let setup () =
- connect xcs_path xcs_type
-
-
-(*
- * adios
- *)
-let teardown fd =
- disconnect fd
-
-
-(*
- * message from a domain backend
- *)
-let read socket =
- let xcs = read_message socket in
- begin
- match xcs.status with
- | 1 -> (* PDB_CONNECTION_STATUS_UP *)
- begin
- print_endline (Printf.sprintf " new backend domain available (%d)"
- xcs.domain);
- let ring = initialize_ring xcs.domain xcs.ring in
-
- let (local_evtchn, remote_evtchn) =
- Evtchn.bind_interdomain xcs.domain in
-
- xcs.evtchn <- remote_evtchn;
- write_message socket xcs;
-
- let evtchn_fd = Evtchn._setup () in
- Evtchn._bind evtchn_fd local_evtchn;
-
- (evtchn_fd, local_evtchn, xcs.domain, ring)
- end
- | 2 -> (* PDB_CONNECTION_STATUS_DOWN *)
- begin
- (* TODO:
- unmap the ring
- unbind event channel xen_evtchn_unbind
- find the evtchn_fd for this domain and close it
- finally, need to failwith something
- *)
- print_endline (Printf.sprintf " close connection from domain %d"
- xcs.domain);
- (socket, 0, 0, 0l)
- end
- | _ ->
- failwith "xcs read: unknown xcs status"
- end
-
-
diff -r e5cdebf9d8ef -r 80388aea02a1 tools/debugger/pdb/xcs.mli
--- a/tools/debugger/pdb/xcs.mli Fri Sep 29 11:11:49 2006 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,13 +0,0 @@
-(** xcs.mli
- *
- * xen control switch interface
- *
- * @author copyright (c) 2005 alex ho
- * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
- * @version 1
- *)
-
-
-val setup : unit -> Unix.file_descr
-val read : Unix.file_descr -> Unix.file_descr * int * int * int32
-val teardown : Unix.file_descr -> unit
_______________________________________________
Xen-changelog mailing list
Xen-changelog@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/xen-changelog
|
Home