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