# 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 |
Home