ia64/xen-unstable

changeset 5312:861dee4a4782
bitkeeper revision 1.1665.1.3 (42a0c916S8M4GCtph6DmI_QigXvneA)

Merge arcadians.cl.cam.ac.uk:/auto/groups/xeno-xenod/BK/xeno.bk
into arcadians.cl.cam.ac.uk:/auto/anfs/nos1/ach61/debugger
author: ach61@arcadians.cl.cam.ac.uk
date: Fri Jun 03 21:18:14 2005 +0000 (2005-06-03)
parents: 226484ec5fb0 d8ac19a4170e
children: c59632e7ff3e
files: .rootkeys BitKeeper/etc/logging_ok tools/libxc/Makefile tools/libxc/list.h tools/libxc/xc_debug.c tools/libxc/xc_debug.h tools/pdb/Domain.ml tools/pdb/Domain.mli tools/pdb/Intel.ml tools/pdb/Makefile tools/pdb/OCamlMakefile tools/pdb/PDB.ml tools/pdb/Process.ml tools/pdb/Process.mli tools/pdb/Util.ml tools/pdb/debugger.ml tools/pdb/evtchn.ml tools/pdb/evtchn.mli tools/pdb/pdb_caml_xc.c tools/pdb/pdb_xen.c tools/pdb/server.ml xen/Rules.mk xen/include/asm-x86/debugger.h xen/include/public/xen.h
     1.1 --- a/.rootkeys	Fri Jun 03 18:06:52 2005 +0000
     1.2 +++ b/.rootkeys	Fri Jun 03 21:18:14 2005 +0000
     1.3 @@ -681,11 +681,14 @@ 428d0d85d831iQvvCD3LcaOD9rYGkg tools/ioe
     1.4  428f0763_67jCiHbdgfGlgAOJqfg9A tools/ioemu/x86_64.ld
     1.5  3fbba6dbDfYvJSsw9500b4SZyUhxjQ tools/libxc/Makefile
     1.6  41dde8afKYRKxS4XtLv1KUegGQy_bg tools/libxc/linux_boot_params.h
     1.7 +42a0c8d8qbLfvuvDUA0tFB9nHMh-zg tools/libxc/list.h
     1.8  41cc934abX-QLXJXW_clV_wRjM0zYg tools/libxc/plan9a.out.h
     1.9  3fbba6dc1uU7U3IFeF6A-XEOYF2MkQ tools/libxc/rpm.spec
    1.10  3fbba6dcrNxtygEcgJYAJJ1gCQqfsA tools/libxc/xc.h
    1.11  3fbba6dbEVkVMX0JuDFzap9jeaucGA tools/libxc/xc_bvtsched.c
    1.12  4273458dyF2_sKA6CFkNJQYb8eY2dA tools/libxc/xc_core.c
    1.13 +42a0c8d98XtmbhyddBgIyyHllz5WTw tools/libxc/xc_debug.c
    1.14 +42a0c8d9ucRxWO41IHTfYI7xYGoKrw tools/libxc/xc_debug.h
    1.15  3fbba6dbasJQV-MVElDC0DGSHMiL5w tools/libxc/xc_domain.c
    1.16  40278d99BLsfUv3qxv0I8C1sClZ0ow tools/libxc/xc_elf.h
    1.17  403e0977Bjsm_e82pwvl9VvaJxh8Gg tools/libxc/xc_evtchn.c
    1.18 @@ -737,6 +740,21 @@ 40c9c4697z76HDfkCLdMhmaEwzFoNQ tools/mis
    1.19  41adc641dV-0cDLSyzMs5BT8nL7v3Q tools/misc/xenperf.c
    1.20  4056f5155QYZdsk-1fLdjsZPFTnlhg tools/misc/xensymoops
    1.21  40cf2937dqM1jWW87O5OoOYND8leuA tools/misc/xm
    1.22 +42a0c8d9zuGuWoaTux5NW4N3wOw8pg tools/pdb/Domain.ml
    1.23 +42a0c8d9pigEXFFtdut3R99jbf73NA tools/pdb/Domain.mli
    1.24 +42a0c8d93wnR_hcSAa7VHgn8CSrWEA tools/pdb/Intel.ml
    1.25 +42a0c8d95glt-jkgXe8GDOPT6TYN6Q tools/pdb/Makefile
    1.26 +42a0c8d9UueJDF0IRX3OozEvUhSTmw tools/pdb/OCamlMakefile
    1.27 +42a0c8d9PgBvaWPzTHSFb9ngii7c7w tools/pdb/PDB.ml
    1.28 +42a0c8danHHGiNywdeer6j4jzxAc2A tools/pdb/Process.ml
    1.29 +42a0c8dav_08OtySI4kYP1lahlVrpQ tools/pdb/Process.mli
    1.30 +42a0c8da51EqubQT5PJ4sxCKLF3xSw tools/pdb/Util.ml
    1.31 +42a0c8daxftpiXuvLmc9fOOEhdFWiQ tools/pdb/debugger.ml
    1.32 +42a0c8da81tzhpvIAfkx9nZqUNrQvg tools/pdb/evtchn.ml
    1.33 +42a0c8dasiso9c-2sCvHBzP6YVjATA tools/pdb/evtchn.mli
    1.34 +42a0c8daXD_6Y62A_u5-PO_Klrhi0w tools/pdb/pdb_caml_xc.c
    1.35 +42a0c8danJXun9ay5SPBhhkKvuUPfg tools/pdb/pdb_xen.c
    1.36 +42a0c8dbjK6Du89D2SUcxsuAdlUu3w tools/pdb/server.ml
    1.37  4270cc81g3nSNYCZ1ryCMDEbLtMtbQ tools/pygrub/Makefile
    1.38  4270deeccyRsJn6jLnRh9odRtMW9SA tools/pygrub/README
    1.39  4270cc81EIl7NyaS3Av6IPRk2c2a6Q tools/pygrub/setup.py

     2.1 --- a/BitKeeper/etc/logging_ok	Fri Jun 03 18:06:52 2005 +0000
     2.2 +++ b/BitKeeper/etc/logging_ok	Fri Jun 03 21:18:14 2005 +0000
     2.3 @@ -1,3 +1,4 @@
     2.4 +ach61@arcadians.cl.cam.ac.uk
     2.5  ach61@boulderdash.cl.cam.ac.uk
     2.6  ach61@labyrinth.cl.cam.ac.uk
     2.7  ach61@soar.cl.cam.ac.uk

     3.1 --- a/tools/libxc/Makefile	Fri Jun 03 18:06:52 2005 +0000
     3.2 +++ b/tools/libxc/Makefile	Fri Jun 03 21:18:14 2005 +0000
     3.3 @@ -17,6 +17,7 @@ SRCS     += xc_sedf.c
     3.4  SRCS     += xc_bvtsched.c
     3.5  SRCS     += xc_core.c
     3.6  SRCS     += xc_domain.c
     3.7 +SRCS     += xc_debug.c
     3.8  SRCS     += xc_evtchn.c
     3.9  SRCS     += xc_gnttab.c
    3.10  SRCS     += xc_linux_build.c
    3.11 @@ -93,7 +94,7 @@ rpm: build
    3.12  	mv staging/i386/*.rpm .
    3.13  	rm -rf staging
    3.14  
    3.15 -libxc.a: $(LIB_OBJS)
    3.16 +libxc.a: $(OBJS)
    3.17  	$(AR) rc $@ $^
    3.18  
    3.19  libxc.so: libxc.so.$(MAJOR)

     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/tools/libxc/list.h	Fri Jun 03 21:18:14 2005 +0000
     4.3 @@ -0,0 +1,186 @@
     4.4 +#ifndef _LINUX_LIST_H
     4.5 +#define _LINUX_LIST_H
     4.6 +
     4.7 +/*
     4.8 + * Simple doubly linked list implementation.
     4.9 + *
    4.10 + * Some of the internal functions ("__xxx") are useful when
    4.11 + * manipulating whole lists rather than single entries, as
    4.12 + * sometimes we already know the next/prev entries and we can
    4.13 + * generate better code by using them directly rather than
    4.14 + * using the generic single-entry routines.
    4.15 + */
    4.16 +
    4.17 +struct list_head {
    4.18 +	struct list_head *next, *prev;
    4.19 +};
    4.20 +
    4.21 +#define LIST_HEAD_INIT(name) { &(name), &(name) }
    4.22 +
    4.23 +#define LIST_HEAD(name) \
    4.24 +	struct list_head name = LIST_HEAD_INIT(name)
    4.25 +
    4.26 +#define INIT_LIST_HEAD(ptr) do { \
    4.27 +	(ptr)->next = (ptr); (ptr)->prev = (ptr); \
    4.28 +} while (0)
    4.29 +
    4.30 +/*
    4.31 + * Insert a new entry between two known consecutive entries. 
    4.32 + *
    4.33 + * This is only for internal list manipulation where we know
    4.34 + * the prev/next entries already!
    4.35 + */
    4.36 +static __inline__ void __list_add(struct list_head * new,
    4.37 +	struct list_head * prev,
    4.38 +	struct list_head * next)
    4.39 +{
    4.40 +	next->prev = new;
    4.41 +	new->next = next;
    4.42 +	new->prev = prev;
    4.43 +	prev->next = new;
    4.44 +}
    4.45 +
    4.46 +/**
    4.47 + * list_add - add a new entry
    4.48 + * @new: new entry to be added
    4.49 + * @head: list head to add it after
    4.50 + *
    4.51 + * Insert a new entry after the specified head.
    4.52 + * This is good for implementing stacks.
    4.53 + */
    4.54 +static __inline__ void list_add(struct list_head *new, struct list_head *head)
    4.55 +{
    4.56 +	__list_add(new, head, head->next);
    4.57 +}
    4.58 +
    4.59 +/**
    4.60 + * list_add_tail - add a new entry
    4.61 + * @new: new entry to be added
    4.62 + * @head: list head to add it before
    4.63 + *
    4.64 + * Insert a new entry before the specified head.
    4.65 + * This is useful for implementing queues.
    4.66 + */
    4.67 +static __inline__ void list_add_tail(struct list_head *new, struct list_head *head)
    4.68 +{
    4.69 +	__list_add(new, head->prev, head);
    4.70 +}
    4.71 +
    4.72 +/*
    4.73 + * Delete a list entry by making the prev/next entries
    4.74 + * point to each other.
    4.75 + *
    4.76 + * This is only for internal list manipulation where we know
    4.77 + * the prev/next entries already!
    4.78 + */
    4.79 +static __inline__ void __list_del(struct list_head * prev,
    4.80 +				  struct list_head * next)
    4.81 +{
    4.82 +	next->prev = prev;
    4.83 +	prev->next = next;
    4.84 +}
    4.85 +
    4.86 +/**
    4.87 + * list_del - deletes entry from list.
    4.88 + * @entry: the element to delete from the list.
    4.89 + * Note: list_empty on entry does not return true after this, the entry is in an undefined state.
    4.90 + */
    4.91 +static __inline__ void list_del(struct list_head *entry)
    4.92 +{
    4.93 +	__list_del(entry->prev, entry->next);
    4.94 +}
    4.95 +
    4.96 +/**
    4.97 + * list_del_init - deletes entry from list and reinitialize it.
    4.98 + * @entry: the element to delete from the list.
    4.99 + */
   4.100 +static __inline__ void list_del_init(struct list_head *entry)
   4.101 +{
   4.102 +	__list_del(entry->prev, entry->next);
   4.103 +	INIT_LIST_HEAD(entry); 
   4.104 +}
   4.105 +
   4.106 +/**
   4.107 + * list_empty - tests whether a list is empty
   4.108 + * @head: the list to test.
   4.109 + */
   4.110 +static __inline__ int list_empty(struct list_head *head)
   4.111 +{
   4.112 +	return head->next == head;
   4.113 +}
   4.114 +
   4.115 +/**
   4.116 + * list_splice - join two lists
   4.117 + * @list: the new list to add.
   4.118 + * @head: the place to add it in the first list.
   4.119 + */
   4.120 +static __inline__ void list_splice(struct list_head *list, struct list_head *head)
   4.121 +{
   4.122 +	struct list_head *first = list->next;
   4.123 +
   4.124 +	if (first != list) {
   4.125 +		struct list_head *last = list->prev;
   4.126 +		struct list_head *at = head->next;
   4.127 +
   4.128 +		first->prev = head;
   4.129 +		head->next = first;
   4.130 +
   4.131 +		last->next = at;
   4.132 +		at->prev = last;
   4.133 +	}
   4.134 +}
   4.135 +
   4.136 +/**
   4.137 + * list_entry - get the struct for this entry
   4.138 + * @ptr:	the &struct list_head pointer.
   4.139 + * @type:	the type of the struct this is embedded in.
   4.140 + * @member:	the name of the list_struct within the struct.
   4.141 + */
   4.142 +#define list_entry(ptr, type, member) \
   4.143 +	((type *)((char *)(ptr)-(unsigned long)(&((type *)0)->member)))
   4.144 +
   4.145 +/**
   4.146 + * list_for_each	-	iterate over a list
   4.147 + * @pos:	the &struct list_head to use as a loop counter.
   4.148 + * @head:	the head for your list.
   4.149 + */
   4.150 +#define list_for_each(pos, head) \
   4.151 +	for (pos = (head)->next; pos != (head); pos = pos->next)
   4.152 +        	
   4.153 +/**
   4.154 + * list_for_each_safe	-	iterate over a list safe against removal of list entry
   4.155 + * @pos:	the &struct list_head to use as a loop counter.
   4.156 + * @n:		another &struct list_head to use as temporary storage
   4.157 + * @head:	the head for your list.
   4.158 + */
   4.159 +#define list_for_each_safe(pos, n, head) \
   4.160 +	for (pos = (head)->next, n = pos->next; pos != (head); \
   4.161 +		pos = n, n = pos->next)
   4.162 +
   4.163 +/**
   4.164 + * list_for_each_entry	-	iterate over list of given type
   4.165 + * @pos:	the type * to use as a loop counter.
   4.166 + * @head:	the head for your list.
   4.167 + * @member:	the name of the list_struct within the struct.
   4.168 + */
   4.169 +#define list_for_each_entry(pos, head, member)				\
   4.170 +	for (pos = list_entry((head)->next, typeof(*pos), member),	\
   4.171 +		     prefetch(pos->member.next);			\
   4.172 +	     &pos->member != (head); 					\
   4.173 +	     pos = list_entry(pos->member.next, typeof(*pos), member),	\
   4.174 +		     prefetch(pos->member.next))
   4.175 +
   4.176 +/**
   4.177 + * list_for_each_entry_safe - iterate over list of given type safe against removal of list entry
   4.178 + * @pos:	the type * to use as a loop counter.
   4.179 + * @n:		another type * to use as temporary storage
   4.180 + * @head:	the head for your list.
   4.181 + * @member:	the name of the list_struct within the struct.
   4.182 + */
   4.183 +#define list_for_each_entry_safe(pos, n, head, member)			\
   4.184 +	for (pos = list_entry((head)->next, typeof(*pos), member),	\
   4.185 +		n = list_entry(pos->member.next, typeof(*pos), member);	\
   4.186 +	     &pos->member != (head); 					\
   4.187 +	     pos = n, n = list_entry(n->member.next, typeof(*n), member))
   4.188 +#endif /* _LINUX_LIST_H */
   4.189 +

     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/tools/libxc/xc_debug.c	Fri Jun 03 21:18:14 2005 +0000
     5.3 @@ -0,0 +1,580 @@
     5.4 +/*
     5.5 + * xc_debug.c
     5.6 + *
     5.7 + * alex ho
     5.8 + * http://www.cl.cam.ac.uk/netos/pdb
     5.9 + *
    5.10 + * xc_debug_memory_page adapted from xc_ptrace.c
    5.11 + */
    5.12 +
    5.13 +#include "xc_private.h"
    5.14 +#include "list.h"
    5.15 +
    5.16 +/* from xen/include/asm-x86/processor.h */
    5.17 +#define X86_EFLAGS_TF	0x00000100 /* Trap Flag */
    5.18 +
    5.19 +typedef int boolean;
    5.20 +#define true 1
    5.21 +#define false 0
    5.22 +
    5.23 +
    5.24 +typedef struct bwcpoint                           /* break/watch/catch point */
    5.25 +{
    5.26 +    struct list_head list;
    5.27 +    memory_t address;
    5.28 +    u32 domain;
    5.29 +    u16 vcpu;
    5.30 +    u8 old_value;                             /* old value for software bkpt */
    5.31 +} bwcpoint_t, *bwcpoint_p;
    5.32 +
    5.33 +static bwcpoint_t bwcpoint_list;
    5.34 +
    5.35 +
    5.36 +
    5.37 +typedef struct domain_context                 /* local cache of domain state */
    5.38 +{
    5.39 +    struct list_head     list;
    5.40 +    u32                  domid;
    5.41 +    boolean              valid[MAX_VIRT_CPUS];
    5.42 +    vcpu_guest_context_t context[MAX_VIRT_CPUS];
    5.43 +
    5.44 +    long            total_pages;
    5.45 +    unsigned long  *page_array;
    5.46 +
    5.47 +    unsigned long   cr3_phys[MAX_VIRT_CPUS];
    5.48 +    unsigned long  *cr3_virt[MAX_VIRT_CPUS];
    5.49 +    unsigned long   pde_phys[MAX_VIRT_CPUS];     
    5.50 +    unsigned long  *pde_virt[MAX_VIRT_CPUS];
    5.51 +    unsigned long   page_phys[MAX_VIRT_CPUS];     
    5.52 +    unsigned long  *page_virt[MAX_VIRT_CPUS];
    5.53 +    int             page_perm[MAX_VIRT_CPUS];
    5.54 +} domain_context_t, *domain_context_p;
    5.55 +
    5.56 +static domain_context_t domain_context_list;
    5.57 +
    5.58 +/* initialization */
    5.59 +
    5.60 +static boolean xc_debug_initialized = false;
    5.61 +
    5.62 +static __inline__ void
    5.63 +xc_debug_initialize()
    5.64 +{
    5.65 +    if ( !xc_debug_initialized )
    5.66 +    {
    5.67 +        memset((void *) &domain_context_list, 0, sizeof(domain_context_t));
    5.68 +        INIT_LIST_HEAD(&domain_context_list.list);
    5.69 +
    5.70 +        memset((void *) &bwcpoint_list, 0, sizeof(bwcpoint_t));
    5.71 +        INIT_LIST_HEAD(&bwcpoint_list.list);
    5.72 +
    5.73 +        xc_debug_initialized = true;
    5.74 +    }
    5.75 +}
    5.76 +
    5.77 +/**************/
    5.78 +
    5.79 +static domain_context_p
    5.80 +xc_debug_domain_context_search (u32 domid)
    5.81 +{
    5.82 +    struct list_head *entry;
    5.83 +    domain_context_p  ctxt;
    5.84 +
    5.85 +    list_for_each(entry, &domain_context_list.list)
    5.86 +    {
    5.87 +        ctxt = list_entry(entry, domain_context_t, list);
    5.88 +        if ( domid == ctxt->domid )
    5.89 +            return ctxt;
    5.90 +    }
    5.91 +    return (domain_context_p)NULL;
    5.92 +}
    5.93 +
    5.94 +static __inline__ domain_context_p
    5.95 +xc_debug_get_context (int xc_handle, u32 domid, u32 vcpu)
    5.96 +{
    5.97 +    int rc;
    5.98 +    domain_context_p ctxt;
    5.99 +
   5.100 +    xc_debug_initialize();
   5.101 +
   5.102 +    if ( (ctxt = xc_debug_domain_context_search(domid)) == NULL)
   5.103 +        return NULL;
   5.104 +
   5.105 +    if ( !ctxt->valid[vcpu] )
   5.106 +    {
   5.107 +        if ( (rc = xc_domain_get_vcpu_context(xc_handle, domid, vcpu, 
   5.108 +                                              &ctxt->context[vcpu])) )
   5.109 +            return NULL;
   5.110 +
   5.111 +        ctxt->valid[vcpu] = true;
   5.112 +    }
   5.113 +
   5.114 +    return ctxt;
   5.115 +}
   5.116 +
   5.117 +static __inline__ int
   5.118 +xc_debug_set_context (int xc_handle, domain_context_p ctxt, u32 vcpu)
   5.119 +{
   5.120 +    dom0_op_t op;
   5.121 +    int rc;
   5.122 +
   5.123 +    if ( !ctxt->valid[vcpu] )
   5.124 +        return -EINVAL;
   5.125 +
   5.126 +    op.interface_version = DOM0_INTERFACE_VERSION;
   5.127 +    op.cmd = DOM0_SETDOMAININFO;
   5.128 +    op.u.setdomaininfo.domain = ctxt->domid;
   5.129 +    op.u.setdomaininfo.vcpu = vcpu;
   5.130 +    op.u.setdomaininfo.ctxt = &ctxt->context[vcpu];
   5.131 +
   5.132 +    if ( (rc = mlock(&ctxt->context[vcpu], sizeof(vcpu_guest_context_t))) )
   5.133 +        return rc;
   5.134 +
   5.135 +    rc = do_dom0_op(xc_handle, &op);
   5.136 +    (void) munlock(&ctxt->context[vcpu], sizeof(vcpu_guest_context_t));
   5.137 +
   5.138 +    return rc;
   5.139 +}
   5.140 +
   5.141 +/**************/
   5.142 +
   5.143 +int
   5.144 +xc_debug_attach(int xc_handle,
   5.145 +                u32 domid,
   5.146 +                u32 vcpu)
   5.147 +{
   5.148 +    domain_context_p ctxt;
   5.149 +
   5.150 +    xc_debug_initialize();
   5.151 +
   5.152 +    if ( (ctxt = malloc(sizeof(domain_context_t))) == NULL )
   5.153 +        return -1;
   5.154 +    memset(ctxt, 0, sizeof(domain_context_t));
   5.155 +    
   5.156 +    ctxt->domid = domid;
   5.157 +    list_add(&ctxt->list, &domain_context_list.list);
   5.158 +
   5.159 +    return xc_domain_pause(xc_handle, domid);
   5.160 +}
   5.161 +
   5.162 +int
   5.163 +xc_debug_detach(int xc_handle,
   5.164 +                u32 domid,
   5.165 +                u32 vcpu)
   5.166 +{
   5.167 +    domain_context_p ctxt;
   5.168 +    
   5.169 +    xc_debug_initialize();
   5.170 +
   5.171 +    if ( (ctxt = xc_debug_domain_context_search (domid)) == NULL)
   5.172 +        return -EINVAL;
   5.173 +
   5.174 +    list_del(&ctxt->list);
   5.175 +
   5.176 +    if ( ctxt->page_array ) free(ctxt->page_array);
   5.177 +
   5.178 +    free(ctxt);
   5.179 +
   5.180 +    return xc_domain_unpause(xc_handle, domid);
   5.181 +}
   5.182 +
   5.183 +int
   5.184 +xc_debug_read_registers(int xc_handle,
   5.185 +                        u32 domid,
   5.186 +                        u32 vcpu,
   5.187 +                        cpu_user_regs_t **regs)
   5.188 +{
   5.189 +    domain_context_p ctxt;
   5.190 +    int rc = -1;
   5.191 +
   5.192 +    xc_debug_initialize();
   5.193 +
   5.194 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.195 +    if (ctxt)
   5.196 +    {
   5.197 +        *regs = &ctxt->context[vcpu].user_regs;
   5.198 +        rc = 0;
   5.199 +    }
   5.200 +
   5.201 +    return rc;
   5.202 +}
   5.203 +
   5.204 +int
   5.205 +xc_debug_read_fpregisters (int xc_handle,
   5.206 +                           u32 domid,
   5.207 +                           u32 vcpu,
   5.208 +                           char **regs)
   5.209 +{
   5.210 +    domain_context_p ctxt;
   5.211 +    int rc = -1;
   5.212 +
   5.213 +    xc_debug_initialize();
   5.214 +
   5.215 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.216 +    if (ctxt)
   5.217 +    {
   5.218 +        *regs = ctxt->context[vcpu].fpu_ctxt.x;
   5.219 +        rc = 0;
   5.220 +    }
   5.221 +
   5.222 +    return rc;
   5.223 +}
   5.224 +
   5.225 +int
   5.226 +xc_debug_write_registers(int xc_handle,
   5.227 +                         u32 domid,
   5.228 +                         u32 vcpu,
   5.229 +                         cpu_user_regs_t *regs)
   5.230 +{
   5.231 +    domain_context_p ctxt;
   5.232 +    int rc = -1;
   5.233 +
   5.234 +    xc_debug_initialize();
   5.235 +
   5.236 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.237 +    if (ctxt)
   5.238 +    {
   5.239 +        memcpy(&ctxt->context[vcpu].user_regs, regs, sizeof(cpu_user_regs_t));
   5.240 +        rc = xc_debug_set_context(xc_handle, ctxt, vcpu);
   5.241 +    }
   5.242 +    
   5.243 +    return rc;
   5.244 +}
   5.245 +
   5.246 +int
   5.247 +xc_debug_step(int xc_handle,
   5.248 +              u32 domid,
   5.249 +              u32 vcpu)
   5.250 +{
   5.251 +    domain_context_p ctxt;
   5.252 +    int rc;
   5.253 +
   5.254 +    xc_debug_initialize();
   5.255 +
   5.256 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.257 +    if (!ctxt) return -EINVAL;
   5.258 +
   5.259 +    ctxt->context[vcpu].user_regs.eflags |= X86_EFLAGS_TF;
   5.260 +
   5.261 +    if ( (rc = xc_debug_set_context(xc_handle, ctxt, vcpu)) )
   5.262 +        return rc;
   5.263 +
   5.264 +    ctxt->valid[vcpu] = false;
   5.265 +    return xc_domain_unpause(xc_handle, domid);
   5.266 +}
   5.267 +
   5.268 +int
   5.269 +xc_debug_continue(int xc_handle,
   5.270 +                  u32 domid,
   5.271 +                  u32 vcpu)
   5.272 +{
   5.273 +    domain_context_p ctxt;
   5.274 +    int rc;
   5.275 +
   5.276 +    xc_debug_initialize();
   5.277 +
   5.278 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.279 +    if (!ctxt) return -EINVAL;
   5.280 +
   5.281 +    if ( ctxt->context[vcpu].user_regs.eflags & X86_EFLAGS_TF )
   5.282 +    {
   5.283 +        ctxt->context[vcpu].user_regs.eflags &= ~X86_EFLAGS_TF;
   5.284 +        if ( (rc = xc_debug_set_context(xc_handle, ctxt, vcpu)) )
   5.285 +            return rc;
   5.286 +    }
   5.287 +    ctxt->valid[vcpu] = false;
   5.288 +    return xc_domain_unpause(xc_handle, domid);
   5.289 +}
   5.290 +
   5.291 +/*************************************************/
   5.292 +
   5.293 +#define vtopdi(va) ((va) >> L2_PAGETABLE_SHIFT)
   5.294 +#define vtopti(va) (((va) >> PAGE_SHIFT) & 0x3ff)
   5.295 +
   5.296 +/* access to one page */
   5.297 +static int
   5.298 +xc_debug_memory_page (domain_context_p ctxt, int xc_handle, u32 vcpu,
   5.299 +                      int protection, memory_t address, int length, u8 *buffer)
   5.300 +{
   5.301 +    vcpu_guest_context_t *vcpu_ctxt = &ctxt->context[vcpu];
   5.302 +    unsigned long pde, page;
   5.303 +    unsigned long va = (unsigned long)address;
   5.304 +    void *ptr;
   5.305 +    long pages;
   5.306 +
   5.307 +    pages = xc_get_tot_pages(xc_handle, ctxt->domid);
   5.308 +
   5.309 +    if ( ctxt->total_pages != pages )
   5.310 +    {
   5.311 +        if ( ctxt->total_pages > 0 ) free( ctxt->page_array );
   5.312 +        ctxt->total_pages = pages;
   5.313 +
   5.314 +        ctxt->page_array = malloc(pages * sizeof(unsigned long));
   5.315 +        if ( ctxt->page_array == NULL )
   5.316 +        {
   5.317 +            printf("Could not allocate memory\n");
   5.318 +            return 0;
   5.319 +        }
   5.320 +
   5.321 +        if ( xc_get_pfn_list(xc_handle, ctxt->domid, ctxt->page_array,pages) !=
   5.322 +                pages )
   5.323 +        {
   5.324 +            printf("Could not get the page frame list\n");
   5.325 +            return 0;
   5.326 +        }
   5.327 +    }
   5.328 +
   5.329 +    if ( vcpu_ctxt->pt_base != ctxt->cr3_phys[vcpu]) 
   5.330 +    {
   5.331 +        ctxt->cr3_phys[vcpu] = vcpu_ctxt->pt_base;
   5.332 +        if ( ctxt->cr3_virt[vcpu] )
   5.333 +            munmap(ctxt->cr3_virt[vcpu], PAGE_SIZE);
   5.334 +        ctxt->cr3_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid,
   5.335 +                    PAGE_SIZE, PROT_READ, ctxt->cr3_phys[vcpu] >> PAGE_SHIFT);
   5.336 +        if ( ctxt->cr3_virt[vcpu] == NULL )
   5.337 +            return 0;
   5.338 +    } 
   5.339 +
   5.340 +
   5.341 +    if ( (pde = ctxt->cr3_virt[vcpu][vtopdi(va)]) == 0) /* logical address */
   5.342 +        return 0;
   5.343 +    if (ctxt->context[vcpu].flags & VGCF_VMX_GUEST)
   5.344 +        pde = ctxt->page_array[pde >> PAGE_SHIFT] << PAGE_SHIFT;
   5.345 +    if (pde != ctxt->pde_phys[vcpu]) 
   5.346 +    {
   5.347 +        ctxt->pde_phys[vcpu] = pde;
   5.348 +        if ( ctxt->pde_virt[vcpu])
   5.349 +            munmap(ctxt->pde_virt[vcpu], PAGE_SIZE);
   5.350 +        ctxt->pde_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid,
   5.351 +                    PAGE_SIZE, PROT_READ, ctxt->pde_phys[vcpu] >> PAGE_SHIFT);
   5.352 +        if ( ctxt->pde_virt[vcpu] == NULL )
   5.353 +            return 0;
   5.354 +    }
   5.355 +
   5.356 +    if ((page = ctxt->pde_virt[vcpu][vtopti(va)]) == 0) /* logical address */
   5.357 +        return 0;
   5.358 +    if (ctxt->context[vcpu].flags & VGCF_VMX_GUEST)
   5.359 +        page = ctxt->page_array[page >> PAGE_SHIFT] << PAGE_SHIFT;
   5.360 +    if (page != ctxt->page_phys[vcpu] || protection != ctxt->page_perm[vcpu]) 
   5.361 +    {
   5.362 +        ctxt->page_phys[vcpu] = page;
   5.363 +        if (ctxt->page_virt[vcpu])
   5.364 +            munmap(ctxt->page_virt[vcpu], PAGE_SIZE);
   5.365 +        ctxt->page_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid, 
   5.366 +                  PAGE_SIZE, protection, ctxt->page_phys[vcpu] >> PAGE_SHIFT);
   5.367 +        if ( ctxt->page_virt[vcpu] == NULL )
   5.368 +        {
   5.369 +            printf("cr3 %lx pde %lx page %lx pti %lx\n", 
   5.370 +                   vcpu_ctxt->pt_base, pde, page, vtopti(va));
   5.371 +            ctxt->page_phys[vcpu] = 0;
   5.372 +            return 0;
   5.373 +        }
   5.374 +        ctxt->page_perm[vcpu] = protection;
   5.375 +    }	
   5.376 +
   5.377 +    ptr = (void *)( (unsigned long)ctxt->page_virt[vcpu] |
   5.378 +                    (va & ~PAGE_MASK) );
   5.379 +
   5.380 +    if ( protection & PROT_WRITE )
   5.381 +    {
   5.382 +        memcpy(ptr, buffer, length);
   5.383 +    }
   5.384 +    else
   5.385 +    {
   5.386 +        memcpy(buffer, ptr, length);
   5.387 +    }
   5.388 +
   5.389 +    return length;
   5.390 +}
   5.391 +
   5.392 +/* divide a memory operation into accesses to individual pages */
   5.393 +static int
   5.394 +xc_debug_memory_op (domain_context_p ctxt, int xc_handle, u32 vcpu,
   5.395 +                    int protection, memory_t address, int length, u8 *buffer)
   5.396 +{
   5.397 +    int      remain;              /* number of bytes to touch past this page */
   5.398 +    int      bytes   = 0;
   5.399 +
   5.400 +    while ( (remain = (address + length - 1) - (address | (PAGE_SIZE-1))) > 0)
   5.401 +    {
   5.402 +        bytes += xc_debug_memory_page(ctxt, xc_handle, vcpu, protection,
   5.403 +                                      address, length - remain, buffer);
   5.404 +        buffer += (length - remain);
   5.405 +        length = remain;
   5.406 +        address = (address | (PAGE_SIZE - 1)) + 1;
   5.407 +    }
   5.408 +
   5.409 +    bytes += xc_debug_memory_page(ctxt, xc_handle, vcpu, protection,
   5.410 +                                  address, length, buffer);
   5.411 +
   5.412 +    return bytes;
   5.413 +}
   5.414 +
   5.415 +int
   5.416 +xc_debug_read_memory(int xc_handle,
   5.417 +                     u32 domid,
   5.418 +                     u32 vcpu,
   5.419 +                     memory_t address,
   5.420 +                     u32 length,
   5.421 +                     u8 *data)
   5.422 +{
   5.423 +    domain_context_p ctxt;
   5.424 +
   5.425 +    xc_debug_initialize();
   5.426 +
   5.427 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.428 +
   5.429 +    xc_debug_memory_op(ctxt, xc_handle, vcpu, PROT_READ, 
   5.430 +                       address, length, data);
   5.431 +
   5.432 +    return 0;
   5.433 +}
   5.434 +
   5.435 +int
   5.436 +xc_debug_write_memory(int xc_handle,
   5.437 +                      u32 domid,
   5.438 +                      u32 vcpu,
   5.439 +                      memory_t address,
   5.440 +                      u32 length,
   5.441 +                      u8 *data)
   5.442 +{
   5.443 +    domain_context_p ctxt;
   5.444 +
   5.445 +    xc_debug_initialize();
   5.446 +
   5.447 +    ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
   5.448 +    xc_debug_memory_op(ctxt, xc_handle, vcpu, PROT_READ | PROT_WRITE,
   5.449 +
   5.450 +                       address, length, data);
   5.451 +
   5.452 +    return 0;
   5.453 +}
   5.454 +
   5.455 +int
   5.456 +xc_debug_insert_memory_breakpoint(int xc_handle,
   5.457 +                                  u32 domid,
   5.458 +                                  u32 vcpu,
   5.459 +                                  memory_t address,
   5.460 +                                  u32 length)
   5.461 +{
   5.462 +    bwcpoint_p bkpt;
   5.463 +    u8 breakpoint_opcode = 0xcc;
   5.464 +
   5.465 +    printf("insert breakpoint %d:%lx %d\n",
   5.466 +            domid, address, length);
   5.467 +
   5.468 +    xc_debug_initialize();
   5.469 +
   5.470 +    bkpt = malloc(sizeof(bwcpoint_t));
   5.471 +    if ( bkpt == NULL )
   5.472 +    {
   5.473 +        printf("error: breakpoint length should be 1\n");
   5.474 +        return -1;
   5.475 +    }
   5.476 +
   5.477 +    if ( length != 1 )
   5.478 +    {
   5.479 +        printf("error: breakpoint length should be 1\n");
   5.480 +        free(bkpt);
   5.481 +        return -1;
   5.482 +    }
   5.483 +
   5.484 +    bkpt->address = address;
   5.485 +    bkpt->domain  = domid;
   5.486 +
   5.487 +    xc_debug_read_memory(xc_handle, domid, vcpu, address, 1,
   5.488 +                         &bkpt->old_value);
   5.489 +
   5.490 +    xc_debug_write_memory(xc_handle, domid, vcpu, address, 1, 
   5.491 +                          &breakpoint_opcode);
   5.492 +    
   5.493 +    list_add(&bkpt->list, &bwcpoint_list.list);
   5.494 +
   5.495 +    printf("breakpoint_set %d:%lx 0x%x\n",
   5.496 +           domid, address, bkpt->old_value);
   5.497 +
   5.498 +    return 0;
   5.499 +}
   5.500 +
   5.501 +int
   5.502 +xc_debug_remove_memory_breakpoint(int xc_handle,
   5.503 +                                  u32 domid,
   5.504 +                                  u32 vcpu,
   5.505 +                                  memory_t address,
   5.506 +                                  u32 length)
   5.507 +{
   5.508 +    bwcpoint_p bkpt = NULL;
   5.509 +
   5.510 +    printf ("remove breakpoint %d:%lx\n",
   5.511 +            domid, address);
   5.512 +
   5.513 +    struct list_head *entry;
   5.514 +    list_for_each(entry, &bwcpoint_list.list)
   5.515 +    {
   5.516 +        bkpt = list_entry(entry, bwcpoint_t, list);
   5.517 +        if ( domid == bkpt->domain && address == bkpt->address )
   5.518 +            break;
   5.519 +    }
   5.520 +    
   5.521 +    if (bkpt == &bwcpoint_list || bkpt == NULL)
   5.522 +    {
   5.523 +        printf ("error: no breakpoint found\n");
   5.524 +        return -1;
   5.525 +    }
   5.526 +
   5.527 +    list_del(&bkpt->list);
   5.528 +
   5.529 +    xc_debug_write_memory(xc_handle, domid, vcpu, address, 1, 
   5.530 +                          &bkpt->old_value);
   5.531 +
   5.532 +    free(bkpt);
   5.533 +    return 0;
   5.534 +}
   5.535 +
   5.536 +int
   5.537 +xc_debug_query_domain_stop(int xc_handle, int *dom_list, int dom_list_size)
   5.538 +{
   5.539 +    xc_dominfo_t *info;
   5.540 +    u32 first_dom = 0;
   5.541 +    int max_doms = 1024;
   5.542 +    int nr_doms, loop;
   5.543 +    int count = 0;
   5.544 +
   5.545 +    if ( (info = malloc(max_doms * sizeof(xc_dominfo_t))) == NULL )
   5.546 +        return -ENOMEM;
   5.547 +
   5.548 +    nr_doms = xc_domain_getinfo(xc_handle, first_dom, max_doms, info);
   5.549 +
   5.550 +    for (loop = 0; loop < nr_doms; loop++)
   5.551 +    {
   5.552 +        printf ("domid: %d", info[loop].domid);
   5.553 +        printf (" %c%c%c%c%c%c",
   5.554 +                info[loop].dying ? 'D' : '-',
   5.555 +                info[loop].crashed ? 'C' : '-',
   5.556 +                info[loop].shutdown ? 'S' : '-',
   5.557 +                info[loop].paused ? 'P' : '-',
   5.558 +                info[loop].blocked ? 'B' : '-',
   5.559 +                info[loop].running ? 'R' : '-');
   5.560 +        printf (" pages: %ld, vcpus %d", 
   5.561 +                info[loop].nr_pages, info[loop].vcpus);
   5.562 +        printf ("\n");
   5.563 +
   5.564 +        if ( info[loop].paused && count < dom_list_size)
   5.565 +        {
   5.566 +            dom_list[count++] = info[loop].domid;
   5.567 +        }
   5.568 +    }
   5.569 +
   5.570 +    free(info);
   5.571 +
   5.572 +    return count;
   5.573 +}
   5.574 +
   5.575 +/*
   5.576 + * Local variables:
   5.577 + * mode: C
   5.578 + * c-set-style: "BSD"
   5.579 + * c-basic-offset: 4
   5.580 + * tab-width: 4
   5.581 + * indent-tabs-mode: nil
   5.582 + * End:
   5.583 + */

     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/tools/libxc/xc_debug.h	Fri Jun 03 21:18:14 2005 +0000
     6.3 @@ -0,0 +1,76 @@
     6.4 +/*
     6.5 + * xc_debug.h
     6.6 + *
     6.7 + * alex ho
     6.8 + * http://www.cl.cam.ac.uk/netos/pdb
     6.9 + *
    6.10 + */
    6.11 +
    6.12 +#ifndef _XC_DEBUG_H_DEFINED
    6.13 +#define _XC_DEBUG_H_DEFINED
    6.14 +
    6.15 +int xc_debug_attach(int xc_handle,
    6.16 +		    u32 domid,
    6.17 +		    u32 vcpu);
    6.18 +
    6.19 +int xc_debug_detach(int xc_handle,
    6.20 +		    u32 domid,
    6.21 +		    u32 vcpu);
    6.22 +
    6.23 +int xc_debug_read_registers(int xc_handle,
    6.24 +			    u32 domid,
    6.25 +			    u32 vcpu,
    6.26 +			    cpu_user_regs_t **regs);
    6.27 +
    6.28 +int xc_debug_read_fpregisters (int xc_handle,
    6.29 +			       u32 domid,
    6.30 +			       u32 vcpu,
    6.31 +			       char **regs);
    6.32 +
    6.33 +int xc_debug_write_registers(int xc_handle,
    6.34 +			     u32 domid,
    6.35 +			     u32 vcpu,
    6.36 +			     cpu_user_regs_t *regs);
    6.37 +
    6.38 +int xc_debug_step(int xc_handle,
    6.39 +		  u32 domid,
    6.40 +		  u32 vcpu);
    6.41 +
    6.42 +int xc_debug_continue(int xc_handle,
    6.43 +		      u32 domid,
    6.44 +		      u32 vcpu);
    6.45 +
    6.46 +int xc_debug_read_memory(int xc_handle,
    6.47 +			 u32 domid,
    6.48 +			 u32 vcpu,
    6.49 +			 memory_t address,
    6.50 +			 u32 length,
    6.51 +			 u8 *data);
    6.52 +
    6.53 +
    6.54 +int xc_debug_write_memory(int xc_handle,
    6.55 +			  u32 domid,
    6.56 +			  u32 vcpu,
    6.57 +			  memory_t address,
    6.58 +			  u32 length,
    6.59 +			  u8 *data);
    6.60 +
    6.61 +
    6.62 +int xc_debug_insert_memory_breakpoint(int xc_handle,
    6.63 +				      u32 domid,
    6.64 +				      u32 vcpu,
    6.65 +				      memory_t address,
    6.66 +				      u32 length);
    6.67 +
    6.68 +int xc_debug_remove_memory_breakpoint(int xc_handle,
    6.69 +				      u32 domid,
    6.70 +				      u32 vcpu,
    6.71 +				      memory_t address,
    6.72 +				      u32 length);
    6.73 +
    6.74 +int xc_debug_query_domain_stop(int xc_handle,
    6.75 +			       int *dom_list, 
    6.76 +			       int dom_list_size);
    6.77 +
    6.78 +
    6.79 +#endif /* _XC_DEBUG_H_DEFINED */

     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/tools/pdb/Domain.ml	Fri Jun 03 21:18:14 2005 +0000
     7.3 @@ -0,0 +1,63 @@
     7.4 +(** Domain.ml
     7.5 + *
     7.6 + *  domain context implementation
     7.7 + *
     7.8 + *  @author copyright (c) 2005 alex ho
     7.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
    7.10 + *  @version 1
    7.11 + *)
    7.12 +
    7.13 +open Int32
    7.14 +open Intel
    7.15 +
    7.16 +type context_t =
    7.17 +{
    7.18 +  mutable domain : int;
    7.19 +  mutable execution_domain : int
    7.20 +}
    7.21 +
    7.22 +let default_context = { domain = 0; execution_domain = 0 }
    7.23 +
    7.24 +let new_context dom exec_dom = {domain = dom; execution_domain = exec_dom}
    7.25 +
    7.26 +let set_domain ctx value =
    7.27 +  ctx.domain <- value;
    7.28 +  print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain)
    7.29 +
    7.30 +let set_execution_domain ctx value =
    7.31 +  ctx.execution_domain <- value;
    7.32 +  print_endline (Printf.sprintf "ctx.execution_domain <- %d"
    7.33 +		 ctx.execution_domain)
    7.34 +
    7.35 +let get_domain ctx =
    7.36 +  ctx.domain
    7.37 +
    7.38 +let get_execution_domain ctx =
    7.39 +  ctx.execution_domain
    7.40 +
    7.41 +let string_of_context ctx =
    7.42 +      Printf.sprintf "{domain} domain: %d, execution_domain: %d"
    7.43 +                      ctx.domain  ctx.execution_domain
    7.44 +
    7.45 +external read_registers : context_t -> registers = "read_registers"
    7.46 +external write_register : context_t -> register -> int32 -> unit =
    7.47 +  "write_register"
    7.48 +external read_memory : context_t -> int32 -> int -> int list = 
    7.49 +  "read_memory"
    7.50 +external write_memory : context_t -> int32 -> int list -> unit = 
    7.51 +  "write_memory"
    7.52 +	
    7.53 +external continue : context_t -> unit = "continue_target"
    7.54 +external step : context_t -> unit = "step_target"
    7.55 +
    7.56 +external insert_memory_breakpoint : context_t -> int32 -> int -> unit = 
    7.57 +  "insert_memory_breakpoint"
    7.58 +external remove_memory_breakpoint : context_t -> int32 -> int -> unit = 
    7.59 +  "remove_memory_breakpoint"
    7.60 +
    7.61 +external attach_debugger : int -> int -> unit = "attach_debugger"
    7.62 +external detach_debugger : int -> int -> unit = "detach_debugger"
    7.63 +external pause_target : int -> unit = "pause_target"
    7.64 +
    7.65 +let pause ctx =
    7.66 +  pause_target ctx.domain

     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/tools/pdb/Domain.mli	Fri Jun 03 21:18:14 2005 +0000
     8.3 @@ -0,0 +1,38 @@
     8.4 +(** Domain.mli
     8.5 + *
     8.6 + *  domain context interface
     8.7 + *
     8.8 + *  @author copyright (c) 2005 alex ho
     8.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
    8.10 + *  @version 1
    8.11 + *)
    8.12 +
    8.13 +open Int32
    8.14 +open Intel
    8.15 +
    8.16 +type context_t
    8.17 +
    8.18 +val default_context : context_t
    8.19 +val new_context : int -> int -> context_t 
    8.20 +
    8.21 +val set_domain : context_t -> int -> unit
    8.22 +val get_domain : context_t -> int
    8.23 +val set_execution_domain : context_t -> int -> unit
    8.24 +val get_execution_domain : context_t -> int
    8.25 +
    8.26 +val string_of_context : context_t -> string
    8.27 +
    8.28 +val read_registers : context_t -> registers
    8.29 +val write_register : context_t -> register -> int32 -> unit
    8.30 +val read_memory : context_t -> int32 -> int -> int list
    8.31 +val write_memory : context_t -> int32 -> int list -> unit
    8.32 +	
    8.33 +val continue : context_t -> unit
    8.34 +val step : context_t -> unit
    8.35 +
    8.36 +val insert_memory_breakpoint : context_t -> int32 -> int -> unit
    8.37 +val remove_memory_breakpoint : context_t -> int32 -> int -> unit
    8.38 +
    8.39 +val attach_debugger : int -> int -> unit
    8.40 +val detach_debugger : int -> int -> unit
    8.41 +val pause : context_t -> unit

     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/tools/pdb/Intel.ml	Fri Jun 03 21:18:14 2005 +0000
     9.3 @@ -0,0 +1,71 @@
     9.4 +(** Intel.ml
     9.5 + *
     9.6 + *  various sundry Intel x86 definitions
     9.7 + *
     9.8 + *  @author copyright (c) 2005 alex ho
     9.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
    9.10 + *  @version 1
    9.11 + *)
    9.12 +
    9.13 +
    9.14 +type register =
    9.15 +  | EBX
    9.16 +  | ECX
    9.17 +  | EDX
    9.18 +  | ESI
    9.19 +  | EDI
    9.20 +  | EBP
    9.21 +  | EAX
    9.22 +  | Error_code
    9.23 +  | Entry_vector
    9.24 +  | EIP
    9.25 +  | CS
    9.26 +  | EFLAGS
    9.27 +  | ESP
    9.28 +  | SS
    9.29 +  | ES
    9.30 +  | DS
    9.31 +  | FS
    9.32 +  | GS
    9.33 +
    9.34 +type registers =
    9.35 +    { ebx : int32;
    9.36 +      ecx : int32;
    9.37 +      edx : int32;
    9.38 +      esi : int32;
    9.39 +      edi : int32;
    9.40 +      ebp : int32;
    9.41 +      eax : int32;
    9.42 +      error_code : int32;
    9.43 +      entry_vector : int32;
    9.44 +      eip : int32;
    9.45 +      cs : int32;
    9.46 +      eflags : int32;
    9.47 +      esp : int32;
    9.48 +      ss : int32;
    9.49 +      es : int32;
    9.50 +      ds : int32;
    9.51 +      fs : int32;
    9.52 +      gs : int32
    9.53 +    }
    9.54 +
    9.55 +let null_registers =
    9.56 +  { ebx = 0l;
    9.57 +    ecx = 0l;
    9.58 +    edx = 0l;
    9.59 +    esi = 0l;
    9.60 +    edi = 0l;
    9.61 +    ebp = 0l;
    9.62 +    eax = 0l;
    9.63 +    error_code = 0l;
    9.64 +    entry_vector = 0l;
    9.65 +    eip = 0l;
    9.66 +    cs = 0l;
    9.67 +    eflags = 0l;
    9.68 +    esp = 0l;
    9.69 +    ss = 0l;
    9.70 +    es = 0l;
    9.71 +    ds = 0l;
    9.72 +    fs = 0l;
    9.73 +    gs = 0l
    9.74 +  }

    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/tools/pdb/Makefile	Fri Jun 03 21:18:14 2005 +0000
    10.3 @@ -0,0 +1,54 @@
    10.4 +OCAMLMAKEFILE = OCamlMakefile
    10.5 +
    10.6 +XEN_ROOT    = ../..
    10.7 +include $(XEN_ROOT)/tools/Rules.mk
    10.8 +
    10.9 +# overwrite LDFLAGS from xen/tool/Rules.mk
   10.10 +# otherwise, ocamlmktop gets confused.
   10.11 +LDFLAGS     =
   10.12 +
   10.13 +OCAML_ROOT=/usr/local
   10.14 +# force ocaml 3.08
   10.15 +# OCAML_ROOT  = /anfs/nos1/ach61/ocaml
   10.16 +
   10.17 +OCAMLC      = $(OCAML_ROOT)/bin/ocamlc
   10.18 +OCAMLMKTOP  = $(OCAML_ROOT)/bin/ocamlmktop
   10.19 +OCAMLLIBPATH= $(OCAML_ROOT)/lib/ocaml
   10.20 +
   10.21 +INCLUDES   += -I $(XEN_XC)
   10.22 +INCLUDES   += -I $(XEN_LIBXC)
   10.23 +INCLUDES   += -I $(OCAML_ROOT)/lib/ocaml
   10.24 +
   10.25 +CFLAGS     += $(INCLUDES)
   10.26 +CFLAGS     += -Wall
   10.27 +CFLAGS     += -Werror
   10.28 +CFLAGS     += -g
   10.29 +
   10.30 +CLIBS      += xc
   10.31 +CLIBS      += xutil
   10.32 +CLIBS      += pdb
   10.33 +
   10.34 +LIBDIRS    += $(XEN_LIBXC)
   10.35 +LIBDIRS    += $(XEN_LIBXUTIL)
   10.36 +LIBDIRS    += .
   10.37 +
   10.38 +LIBS       += unix str
   10.39 +
   10.40 +PRE_TARGETS = libpdb.a
   10.41 +
   10.42 +all : bc
   10.43 +
   10.44 +libpdb.a : pdb_xen.o
   10.45 +	ar rc $@ $^
   10.46 +	ranlib $@
   10.47 +
   10.48 +SOURCES    += pdb_caml_xc.c pdb_xen.c
   10.49 +SOURCES    += Util.ml Intel.ml 
   10.50 +SOURCES    += evtchn.ml evtchn.mli
   10.51 +SOURCES    += Domain.ml  Process.ml
   10.52 +SOURCES    += Domain.mli Process.mli
   10.53 +SOURCES    += PDB.ml debugger.ml server.ml
   10.54 +RESULT      = pdb
   10.55 +
   10.56 +include $(OCAMLMAKEFILE)
   10.57 +

    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/tools/pdb/OCamlMakefile	Fri Jun 03 21:18:14 2005 +0000
    11.3 @@ -0,0 +1,1149 @@
    11.4 +###########################################################################
    11.5 +#                              OCamlMakefile
    11.6 +#                  Copyright (C) 1999-2004  Markus Mottl
    11.7 +#
    11.8 +#                             For updates see:
    11.9 +#                http://www.oefai.at/~markus/ocaml_sources
   11.10 +#
   11.11 +#        $Id: OCamlMakefile,v 1.1 2005/05/19 09:30:48 root Exp $
   11.12 +#
   11.13 +###########################################################################
   11.14 +
   11.15 +# Modified by damien for .glade.ml compilation
   11.16 +
   11.17 +# Set these variables to the names of the sources to be processed and
   11.18 +# the result variable. Order matters during linkage!
   11.19 +
   11.20 +ifndef SOURCES
   11.21 +  SOURCES := foo.ml
   11.22 +endif
   11.23 +export SOURCES
   11.24 +
   11.25 +ifndef RES_CLIB_SUF
   11.26 +  RES_CLIB_SUF := _stubs
   11.27 +endif
   11.28 +export RES_CLIB_SUF
   11.29 +
   11.30 +ifndef RESULT
   11.31 +  RESULT := foo
   11.32 +endif
   11.33 +export RESULT
   11.34 +
   11.35 +export LIB_PACK_NAME
   11.36 +
   11.37 +ifndef DOC_FILES
   11.38 +  DOC_FILES := $(filter %.mli, $(SOURCES))
   11.39 +endif
   11.40 +export DOC_FILES
   11.41 +
   11.42 +export BCSUFFIX
   11.43 +export NCSUFFIX
   11.44 +
   11.45 +ifndef TOPSUFFIX
   11.46 +  TOPSUFFIX := .top
   11.47 +endif
   11.48 +export TOPSUFFIX
   11.49 +
   11.50 +# Eventually set include- and library-paths, libraries to link,
   11.51 +# additional compilation-, link- and ocamlyacc-flags
   11.52 +# Path- and library information needs not be written with "-I" and such...
   11.53 +# Define THREADS if you need it, otherwise leave it unset (same for
   11.54 +# USE_CAMLP4)!
   11.55 +
   11.56 +export THREADS
   11.57 +export VMTHREADS
   11.58 +export ANNOTATE
   11.59 +export USE_CAMLP4
   11.60 +
   11.61 +export INCDIRS
   11.62 +export LIBDIRS
   11.63 +export EXTLIBDIRS
   11.64 +export RESULTDEPS
   11.65 +export OCAML_DEFAULT_DIRS
   11.66 +
   11.67 +export LIBS
   11.68 +export CLIBS
   11.69 +
   11.70 +export OCAMLFLAGS
   11.71 +export OCAMLNCFLAGS
   11.72 +export OCAMLBCFLAGS
   11.73 +
   11.74 +export OCAMLLDFLAGS
   11.75 +export OCAMLNLDFLAGS
   11.76 +export OCAMLBLDFLAGS
   11.77 +
   11.78 +ifndef OCAMLCPFLAGS
   11.79 +  OCAMLCPFLAGS := a
   11.80 +endif
   11.81 +
   11.82 +export OCAMLCPFLAGS
   11.83 +
   11.84 +export PPFLAGS
   11.85 +
   11.86 +export YFLAGS
   11.87 +export IDLFLAGS
   11.88 +
   11.89 +export OCAMLDOCFLAGS
   11.90 +
   11.91 +export OCAMLFIND_INSTFLAGS
   11.92 +
   11.93 +export DVIPSFLAGS
   11.94 +
   11.95 +export STATIC
   11.96 +
   11.97 +# Add a list of optional trash files that should be deleted by "make clean"
   11.98 +export TRASH
   11.99 +
  11.100 +####################  variables depending on your OCaml-installation
  11.101 +
  11.102 +ifdef MINGW
  11.103 +  export MINGW
  11.104 +  WIN32   := 1
  11.105 +  CFLAGS_WIN32 := -mno-cygwin
  11.106 +endif
  11.107 +ifdef MSVC
  11.108 +  export MSVC
  11.109 +  WIN32   := 1
  11.110 +  ifndef STATIC
  11.111 +    CPPFLAGS_WIN32 := -DCAML_DLL
  11.112 +  endif
  11.113 +  CFLAGS_WIN32 += -nologo
  11.114 +  EXT_OBJ := obj
  11.115 +  EXT_LIB := lib
  11.116 +  ifeq ($(CC),gcc)
  11.117 +    # work around GNU Make default value
  11.118 +    ifdef THREADS
  11.119 +      CC := cl -MT
  11.120 +    else
  11.121 +      CC := cl
  11.122 +    endif
  11.123 +  endif
  11.124 +  ifeq ($(CXX),g++)
  11.125 +    # work around GNU Make default value
  11.126 +    CXX := $(CC)
  11.127 +  endif
  11.128 +  CFLAG_O := -Fo
  11.129 +endif
  11.130 +ifdef WIN32
  11.131 +  EXT_CXX := cpp
  11.132 +  EXE     := .exe
  11.133 +endif
  11.134 +
  11.135 +ifndef EXT_OBJ
  11.136 +  EXT_OBJ := o
  11.137 +endif
  11.138 +ifndef EXT_LIB
  11.139 +  EXT_LIB := a
  11.140 +endif
  11.141 +ifndef EXT_CXX
  11.142 +  EXT_CXX := cc
  11.143 +endif
  11.144 +ifndef EXE
  11.145 +  EXE := # empty
  11.146 +endif
  11.147 +ifndef CFLAG_O
  11.148 +  CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)!
  11.149 +endif
  11.150 +
  11.151 +export CC
  11.152 +export CXX
  11.153 +export CFLAGS
  11.154 +export CXXFLAGS
  11.155 +export LDFLAGS
  11.156 +export CPPFLAGS
  11.157 +
  11.158 +ifndef RPATH_FLAG
  11.159 +  RPATH_FLAG := -R
  11.160 +endif
  11.161 +export RPATH_FLAG
  11.162 +
  11.163 +ifndef MSVC
  11.164 +ifndef PIC_CFLAGS
  11.165 +  PIC_CFLAGS := -fPIC
  11.166 +endif
  11.167 +ifndef PIC_CPPFLAGS
  11.168 +  PIC_CPPFLAGS := -DPIC
  11.169 +endif
  11.170 +endif
  11.171 +
  11.172 +export PIC_CFLAGS
  11.173 +export PIC_CPPFLAGS
  11.174 +
  11.175 +BCRESULT  := $(addsuffix $(BCSUFFIX), $(RESULT))
  11.176 +NCRESULT  := $(addsuffix $(NCSUFFIX), $(RESULT))
  11.177 +TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT))
  11.178 +
  11.179 +ifndef OCAMLFIND
  11.180 +  OCAMLFIND := ocamlfind
  11.181 +endif
  11.182 +export OCAMLFIND
  11.183 +
  11.184 +ifndef OCAMLC
  11.185 +  OCAMLC := ocamlc
  11.186 +endif
  11.187 +export OCAMLC
  11.188 +
  11.189 +ifndef OCAMLOPT
  11.190 +  OCAMLOPT := ocamlopt
  11.191 +endif
  11.192 +export OCAMLOPT
  11.193 +
  11.194 +ifndef OCAMLMKTOP
  11.195 +  OCAMLMKTOP := ocamlmktop
  11.196 +endif
  11.197 +export OCAMLMKTOP
  11.198 +
  11.199 +ifndef OCAMLCP
  11.200 +  OCAMLCP := ocamlcp
  11.201 +endif
  11.202 +export OCAMLCP
  11.203 +
  11.204 +ifndef OCAMLDEP
  11.205 +  OCAMLDEP := ocamldep
  11.206 +endif
  11.207 +export OCAMLDEP
  11.208 +
  11.209 +ifndef OCAMLLEX
  11.210 +  OCAMLLEX := ocamllex
  11.211 +endif
  11.212 +export OCAMLLEX
  11.213 +
  11.214 +ifndef OCAMLYACC
  11.215 +  OCAMLYACC := ocamlyacc
  11.216 +endif
  11.217 +export OCAMLYACC
  11.218 +
  11.219 +ifndef OCAMLMKLIB
  11.220 +  OCAMLMKLIB := ocamlmklib
  11.221 +endif
  11.222 +export OCAMLMKLIB
  11.223 +
  11.224 +ifndef OCAML_GLADECC
  11.225 +  OCAML_GLADECC := lablgladecc2
  11.226 +endif
  11.227 +export OCAML_GLADECC
  11.228 +
  11.229 +ifndef OCAML_GLADECC_FLAGS
  11.230 +  OCAML_GLADECC_FLAGS :=
  11.231 +endif
  11.232 +export OCAML_GLADECC_FLAGS
  11.233 +
  11.234 +ifndef CAMELEON_REPORT
  11.235 +  CAMELEON_REPORT := report
  11.236 +endif
  11.237 +export CAMELEON_REPORT
  11.238 +
  11.239 +ifndef CAMELEON_REPORT_FLAGS
  11.240 +  CAMELEON_REPORT_FLAGS :=
  11.241 +endif
  11.242 +export CAMELEON_REPORT_FLAGS
  11.243 +
  11.244 +ifndef CAMELEON_ZOGGY
  11.245 +  CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo
  11.246 +endif
  11.247 +export CAMELEON_ZOGGY
  11.248 +
  11.249 +ifndef CAMELEON_ZOGGY_FLAGS
  11.250 +  CAMELEON_ZOGGY_FLAGS :=
  11.251 +endif
  11.252 +export CAMELEON_ZOGGY_FLAGS
  11.253 +
  11.254 +ifndef OXRIDL
  11.255 +  OXRIDL := oxridl
  11.256 +endif
  11.257 +export OXRIDL
  11.258 +
  11.259 +ifndef CAMLIDL
  11.260 +  CAMLIDL := camlidl
  11.261 +endif
  11.262 +export CAMLIDL
  11.263 +
  11.264 +ifndef CAMLIDLDLL
  11.265 +  CAMLIDLDLL := camlidldll
  11.266 +endif
  11.267 +export CAMLIDLDLL
  11.268 +
  11.269 +ifndef NOIDLHEADER
  11.270 +  MAYBE_IDL_HEADER := -header
  11.271 +endif
  11.272 +export NOIDLHEADER
  11.273 +
  11.274 +export NO_CUSTOM
  11.275 +
  11.276 +ifndef CAMLP4
  11.277 +  CAMLP4 := camlp4
  11.278 +endif
  11.279 +export CAMLP4
  11.280 +
  11.281 +ifndef REAL_OCAMLFIND
  11.282 +  ifdef PACKS
  11.283 +    ifndef CREATE_LIB
  11.284 +      ifdef THREADS
  11.285 +	PACKS += threads
  11.286 +      endif
  11.287 +    endif
  11.288 +    empty :=
  11.289 +    space := $(empty) $(empty)
  11.290 +    comma := ,
  11.291 +    ifdef PREDS
  11.292 +      PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS))
  11.293 +      PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS))
  11.294 +      OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES)
  11.295 +  #    OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES)
  11.296 +      OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
  11.297 +      OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
  11.298 +    else
  11.299 +      OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS))
  11.300 +      OCAML_DEP_PACKAGES :=
  11.301 +    endif
  11.302 +    OCAML_FIND_LINKPKG := -linkpkg
  11.303 +    REAL_OCAMLFIND := $(OCAMLFIND)
  11.304 +  endif
  11.305 +endif
  11.306 +
  11.307 +export OCAML_FIND_PACKAGES
  11.308 +export OCAML_DEP_PACKAGES
  11.309 +export OCAML_FIND_LINKPKG
  11.310 +export REAL_OCAMLFIND
  11.311 +
  11.312 +ifndef OCAMLDOC
  11.313 +  OCAMLDOC := ocamldoc
  11.314 +endif
  11.315 +export OCAMLDOC
  11.316 +
  11.317 +ifndef LATEX
  11.318 +  LATEX := latex
  11.319 +endif
  11.320 +export LATEX
  11.321 +
  11.322 +ifndef DVIPS
  11.323 +  DVIPS := dvips
  11.324 +endif
  11.325 +export DVIPS
  11.326 +
  11.327 +ifndef PS2PDF
  11.328 +  PS2PDF := ps2pdf
  11.329 +endif
  11.330 +export PS2PDF
  11.331 +
  11.332 +ifndef OCAMLMAKEFILE
  11.333 +  OCAMLMAKEFILE := OCamlMakefile
  11.334 +endif
  11.335 +export OCAMLMAKEFILE
  11.336 +
  11.337 +ifndef OCAMLLIBPATH
  11.338 +  OCAMLLIBPATH := \
  11.339 +    $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml)
  11.340 +endif
  11.341 +export OCAMLLIBPATH
  11.342 +
  11.343 +ifndef OCAML_LIB_INSTALL
  11.344 +  OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib
  11.345 +endif
  11.346 +export OCAML_LIB_INSTALL
  11.347 +
  11.348 +###########################################################################
  11.349 +
  11.350 +####################  change following sections only if
  11.351 +####################    you know what you are doing!
  11.352 +
  11.353 +# delete target files when a build command fails
  11.354 +.PHONY: .DELETE_ON_ERROR
  11.355 +.DELETE_ON_ERROR:
  11.356 +
  11.357 +# for pedants using "--warn-undefined-variables"
  11.358 +export MAYBE_IDL
  11.359 +export REAL_RESULT
  11.360 +export CAMLIDLFLAGS
  11.361 +export THREAD_FLAG
  11.362 +export RES_CLIB
  11.363 +export MAKEDLL
  11.364 +export ANNOT_FLAG
  11.365 +export C_OXRIDL
  11.366 +export SUBPROJS
  11.367 +export CFLAGS_WIN32
  11.368 +export CPPFLAGS_WIN32
  11.369 +
  11.370 +INCFLAGS :=
  11.371 +
  11.372 +SHELL := /bin/sh
  11.373 +
  11.374 +MLDEPDIR := ._d
  11.375 +BCDIDIR  := ._bcdi
  11.376 +NCDIDIR  := ._ncdi
  11.377 +
  11.378 +FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade
  11.379 +
  11.380 +FILTERED     := $(filter $(FILTER_EXTNS), $(SOURCES))
  11.381 +SOURCE_DIRS  := $(filter-out ./, $(sort $(dir $(FILTERED))))
  11.382 +
  11.383 +FILTERED_REP := $(filter %.rep, $(FILTERED))
  11.384 +DEP_REP      := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d)
  11.385 +AUTO_REP     := $(FILTERED_REP:.rep=.ml)
  11.386 +
  11.387 +FILTERED_ZOG := $(filter %.zog, $(FILTERED))
  11.388 +DEP_ZOG      := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d)
  11.389 +AUTO_ZOG     := $(FILTERED_ZOG:.zog=.ml)
  11.390 +
  11.391 +FILTERED_GLADE := $(filter %.glade, $(FILTERED))
  11.392 +DEP_GLADE      := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d)
  11.393 +AUTO_GLADE     := $(FILTERED_GLADE:.glade=.ml)
  11.394 +
  11.395 +FILTERED_ML  := $(filter %.ml, $(FILTERED))
  11.396 +DEP_ML       := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d)
  11.397 +
  11.398 +FILTERED_MLI := $(filter %.mli, $(FILTERED))
  11.399 +DEP_MLI      := $(FILTERED_MLI:.mli=.di)
  11.400 +
  11.401 +FILTERED_MLL := $(filter %.mll, $(FILTERED))
  11.402 +DEP_MLL      := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d)
  11.403 +AUTO_MLL     := $(FILTERED_MLL:.mll=.ml)
  11.404 +
  11.405 +FILTERED_MLY := $(filter %.mly, $(FILTERED))
  11.406 +DEP_MLY      := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di)
  11.407 +AUTO_MLY     := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml)
  11.408 +
  11.409 +FILTERED_IDL := $(filter %.idl, $(FILTERED))
  11.410 +DEP_IDL      := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di)
  11.411 +C_IDL        := $(FILTERED_IDL:%.idl=%_stubs.c)
  11.412 +ifndef NOIDLHEADER
  11.413 + C_IDL += $(FILTERED_IDL:.idl=.h)
  11.414 +endif
  11.415 +OBJ_C_IDL    := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ))
  11.416 +AUTO_IDL     := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL)
  11.417 +
  11.418 +FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED))
  11.419 +DEP_OXRIDL      := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di)
  11.420 +AUTO_OXRIDL     := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL)
  11.421 +
  11.422 +FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED))
  11.423 +OBJ_C_CXX      := $(FILTERED_C_CXX:.c=.$(EXT_OBJ))
  11.424 +OBJ_C_CXX      := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ))
  11.425 +
  11.426 +PRE_TARGETS  += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE)
  11.427 +
  11.428 +ALL_DEPS     := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE)
  11.429 +
  11.430 +MLDEPS       := $(filter %.d, $(ALL_DEPS))
  11.431 +MLIDEPS      := $(filter %.di, $(ALL_DEPS))
  11.432 +BCDEPIS      := $(MLIDEPS:%.di=$(BCDIDIR)/%.di)
  11.433 +NCDEPIS      := $(MLIDEPS:%.di=$(NCDIDIR)/%.di)
  11.434 +
  11.435 +ALLML        := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED))
  11.436 +
  11.437 +IMPLO_INTF   := $(ALLML:%.mli=%.mli.__)
  11.438 +IMPLO_INTF   := $(foreach file, $(IMPLO_INTF), \
  11.439 +                  $(basename $(file)).cmi $(basename $(file)).cmo)
  11.440 +IMPLO_INTF   := $(filter-out %.mli.cmo, $(IMPLO_INTF))
  11.441 +IMPLO_INTF   := $(IMPLO_INTF:%.mli.cmi=%.cmi)
  11.442 +
  11.443 +IMPLX_INTF   := $(IMPLO_INTF:.cmo=.cmx)
  11.444 +
  11.445 +INTF         := $(filter %.cmi, $(IMPLO_INTF))
  11.446 +IMPL_CMO     := $(filter %.cmo, $(IMPLO_INTF))
  11.447 +IMPL_CMX     := $(IMPL_CMO:.cmo=.cmx)
  11.448 +IMPL_ASM     := $(IMPL_CMO:.cmo=.asm)
  11.449 +IMPL_S       := $(IMPL_CMO:.cmo=.s)
  11.450 +
  11.451 +OBJ_LINK     := $(OBJ_C_IDL) $(OBJ_C_CXX)
  11.452 +OBJ_FILES    := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK)
  11.453 +
  11.454 +EXECS        := $(addsuffix $(EXE), \
  11.455 +                            $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT)))
  11.456 +ifdef WIN32
  11.457 +  EXECS      += $(BCRESULT).dll $(NCRESULT).dll
  11.458 +endif
  11.459 +
  11.460 +CLIB_BASE    := $(RESULT)$(RES_CLIB_SUF)
  11.461 +ifneq ($(strip $(OBJ_LINK)),)
  11.462 +  RES_CLIB     := lib$(CLIB_BASE).$(EXT_LIB)
  11.463 +endif
  11.464 +
  11.465 +ifdef WIN32
  11.466 +DLLSONAME := $(CLIB_BASE).dll
  11.467 +else
  11.468 +DLLSONAME := dll$(CLIB_BASE).so
  11.469 +endif
  11.470 +
  11.471 +NONEXECS     := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \
  11.472 +		$(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \
  11.473 +		$(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \
  11.474 +		$(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \
  11.475 +		$(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \
  11.476 +		$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o
  11.477 +
  11.478 +ifndef STATIC
  11.479 +  NONEXECS += $(DLLSONAME)
  11.480 +endif
  11.481 +
  11.482 +ifndef LIBINSTALL_FILES
  11.483 +  LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \
  11.484 +		      $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB)
  11.485 +  ifndef STATIC
  11.486 +    ifneq ($(strip $(OBJ_LINK)),)
  11.487 +      LIBINSTALL_FILES += $(DLLSONAME)
  11.488 +    endif
  11.489 +  endif
  11.490 +endif
  11.491 +
  11.492 +export LIBINSTALL_FILES
  11.493 +
  11.494 +ifdef WIN32
  11.495 +  # some extra stuff is created while linking DLLs
  11.496 +  NONEXECS   += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib
  11.497 +endif
  11.498 +
  11.499 +TARGETS      := $(EXECS) $(NONEXECS)
  11.500 +
  11.501 +# If there are IDL-files
  11.502 +ifneq ($(strip $(FILTERED_IDL)),)
  11.503 +  MAYBE_IDL := -cclib -lcamlidl
  11.504 +endif
  11.505 +
  11.506 +ifdef USE_CAMLP4
  11.507 +  CAMLP4PATH := \
  11.508 +    $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4)
  11.509 +  INCFLAGS := -I $(CAMLP4PATH)
  11.510 +  CINCFLAGS := -I$(CAMLP4PATH)
  11.511 +endif
  11.512 +
  11.513 +DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %)
  11.514 +INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %)
  11.515 +CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%)
  11.516 +
  11.517 +ifndef MSVC
  11.518 +CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \
  11.519 +             $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \
  11.520 +             $(OCAML_DEFAULT_DIRS:%=-L%)
  11.521 +endif
  11.522 +
  11.523 +ifndef PROFILING
  11.524 +  INTF_OCAMLC := $(OCAMLC)
  11.525 +else
  11.526 +  ifndef THREADS
  11.527 +    INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS)
  11.528 +  else
  11.529 +    # OCaml does not support profiling byte code
  11.530 +    # with threads (yet), therefore we force an error.
  11.531 +    ifndef REAL_OCAMLC
  11.532 +      $(error Profiling of multithreaded byte code not yet supported by OCaml)
  11.533 +    endif
  11.534 +    INTF_OCAMLC := $(OCAMLC)
  11.535 +  endif
  11.536 +endif
  11.537 +
  11.538 +ifndef MSVC
  11.539 +COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \
  11.540 +		  $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \
  11.541 +		  $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \
  11.542 +		  $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)
  11.543 +else
  11.544 +COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \
  11.545 +		  $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \
  11.546 +		  $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) "
  11.547 +endif
  11.548 +
  11.549 +CLIBS_OPTS := $(CLIBS:%=-cclib -l%)
  11.550 +ifdef MSVC
  11.551 +  ifndef STATIC
  11.552 +  # MSVC libraries do not have 'lib' prefix
  11.553 +  CLIBS_OPTS := $(CLIBS:%=-cclib %.lib)
  11.554 +  endif
  11.555 +endif
  11.556 +
  11.557 +ifneq ($(strip $(OBJ_LINK)),)
  11.558 +  ifdef CREATE_LIB
  11.559 +    OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL)
  11.560 +  else
  11.561 +    OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL)
  11.562 +  endif
  11.563 +else
  11.564 +  OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL)
  11.565 +endif
  11.566 +
  11.567 +# If we have to make byte-code
  11.568 +ifndef REAL_OCAMLC
  11.569 +  BYTE_OCAML := y
  11.570 +
  11.571 +  # EXTRADEPS is added dependencies we have to insert for all
  11.572 +  # executable files we generate.  Ideally it should be all of the
  11.573 +  # libraries we use, but it's hard to find the ones that get searched on
  11.574 +  # the path since I don't know the paths built into the compiler, so
  11.575 +  # just include the ones with slashes in their names.
  11.576 +  EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
  11.577 +  SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
  11.578 +
  11.579 +  REAL_OCAMLC := $(INTF_OCAMLC)
  11.580 +
  11.581 +  REAL_IMPL := $(IMPL_CMO)
  11.582 +  REAL_IMPL_INTF := $(IMPLO_INTF)
  11.583 +  IMPL_SUF := .cmo
  11.584 +
  11.585 +  DEPFLAGS  :=
  11.586 +  MAKE_DEPS := $(MLDEPS) $(BCDEPIS)
  11.587 +
  11.588 +  ifdef CREATE_LIB
  11.589 +    CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
  11.590 +    CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
  11.591 +    ifndef STATIC
  11.592 +      ifneq ($(strip $(OBJ_LINK)),)
  11.593 +	MAKEDLL := $(DLLSONAME)
  11.594 +	ALL_LDFLAGS := -dllib $(DLLSONAME)
  11.595 +      endif
  11.596 +    endif
  11.597 +  endif
  11.598 +
  11.599 +  ifndef NO_CUSTOM
  11.600 +    ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" ""
  11.601 +      ALL_LDFLAGS += -custom
  11.602 +    endif
  11.603 +  endif
  11.604 +
  11.605 +  ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \
  11.606 +                 $(COMMON_LDFLAGS) $(LIBS:%=%.cma)
  11.607 +  CAMLIDLDLLFLAGS :=
  11.608 +
  11.609 +  ifdef THREADS
  11.610 +    ifdef VMTHREADS
  11.611 +      THREAD_FLAG := -vmthread
  11.612 +    else
  11.613 +      THREAD_FLAG := -thread
  11.614 +    endif
  11.615 +    ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
  11.616 +    ifndef CREATE_LIB
  11.617 +      ifndef REAL_OCAMLFIND
  11.618 +        ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
  11.619 +      endif
  11.620 +    endif
  11.621 +  endif
  11.622 +
  11.623 +# we have to make native-code
  11.624 +else
  11.625 +  EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
  11.626 +  ifndef PROFILING
  11.627 +    SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
  11.628 +    PLDFLAGS :=
  11.629 +  else
  11.630 +    SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS)
  11.631 +    PLDFLAGS := -p
  11.632 +  endif
  11.633 +
  11.634 +  REAL_IMPL := $(IMPL_CMX)
  11.635 +  REAL_IMPL_INTF := $(IMPLX_INTF)
  11.636 +  IMPL_SUF := .cmx
  11.637 +
  11.638 +  CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS)
  11.639 +
  11.640 +  DEPFLAGS  := -native
  11.641 +  MAKE_DEPS := $(MLDEPS) $(NCDEPIS)
  11.642 +
  11.643 +  ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \
  11.644 +                 $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS)
  11.645 +  CAMLIDLDLLFLAGS := -opt
  11.646 +
  11.647 +  ifndef CREATE_LIB
  11.648 +    ALL_LDFLAGS += $(LIBS:%=%.cmxa)
  11.649 +  else
  11.650 +    CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
  11.651 +    CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
  11.652 +  endif
  11.653 +
  11.654 +  ifdef THREADS
  11.655 +    THREAD_FLAG := -thread
  11.656 +    ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
  11.657 +    ifndef CREATE_LIB
  11.658 +      ifndef REAL_OCAMLFIND
  11.659 +        ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
  11.660 +      endif
  11.661 +    endif
  11.662 +  endif
  11.663 +endif
  11.664 +
  11.665 +export MAKE_DEPS
  11.666 +
  11.667 +ifdef ANNOTATE
  11.668 +  ANNOT_FLAG := -dtypes
  11.669 +else
  11.670 +endif
  11.671 +
  11.672 +ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \
  11.673 +                   $(INCFLAGS) $(SPECIAL_OCAMLFLAGS)
  11.674 +
  11.675 +ifdef make_deps
  11.676 +  -include $(MAKE_DEPS)
  11.677 +  PRE_TARGETS :=
  11.678 +endif
  11.679 +
  11.680 +###########################################################################
  11.681 +# USER RULES
  11.682 +
  11.683 +# Call "OCamlMakefile QUIET=" to get rid of all of the @'s.
  11.684 +QUIET=@
  11.685 +
  11.686 +# generates byte-code (default)
  11.687 +byte-code:		$(PRE_TARGETS)
  11.688 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
  11.689 +				REAL_RESULT="$(BCRESULT)" make_deps=yes
  11.690 +bc:	byte-code
  11.691 +
  11.692 +byte-code-nolink:	$(PRE_TARGETS)
  11.693 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
  11.694 +				REAL_RESULT="$(BCRESULT)" make_deps=yes
  11.695 +bcnl:	byte-code-nolink
  11.696 +
  11.697 +top:			$(PRE_TARGETS)
  11.698 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \
  11.699 +				REAL_RESULT="$(BCRESULT)" make_deps=yes
  11.700 +
  11.701 +# generates native-code
  11.702 +
  11.703 +native-code:		$(PRE_TARGETS)
  11.704 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
  11.705 +				REAL_RESULT="$(NCRESULT)" \
  11.706 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.707 +				make_deps=yes
  11.708 +nc:	native-code
  11.709 +
  11.710 +native-code-nolink:	$(PRE_TARGETS)
  11.711 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
  11.712 +				REAL_RESULT="$(NCRESULT)" \
  11.713 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.714 +				make_deps=yes
  11.715 +ncnl:	native-code-nolink
  11.716 +
  11.717 +# generates byte-code libraries
  11.718 +byte-code-library:	$(PRE_TARGETS)
  11.719 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.720 +				$(RES_CLIB) $(BCRESULT).cma \
  11.721 +				REAL_RESULT="$(BCRESULT)" \
  11.722 +				CREATE_LIB=yes \
  11.723 +				make_deps=yes
  11.724 +bcl:	byte-code-library
  11.725 +
  11.726 +# generates native-code libraries
  11.727 +native-code-library:	$(PRE_TARGETS)
  11.728 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.729 +				$(RES_CLIB) $(NCRESULT).cmxa \
  11.730 +				REAL_RESULT="$(NCRESULT)" \
  11.731 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.732 +				CREATE_LIB=yes \
  11.733 +				make_deps=yes
  11.734 +ncl:	native-code-library
  11.735 +
  11.736 +ifdef WIN32
  11.737 +# generates byte-code dll
  11.738 +byte-code-dll:		$(PRE_TARGETS)
  11.739 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.740 +				$(RES_CLIB) $(BCRESULT).dll \
  11.741 +				REAL_RESULT="$(BCRESULT)" \
  11.742 +				make_deps=yes
  11.743 +bcd:	byte-code-dll
  11.744 +
  11.745 +# generates native-code dll
  11.746 +native-code-dll:	$(PRE_TARGETS)
  11.747 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.748 +				$(RES_CLIB) $(NCRESULT).dll \
  11.749 +				REAL_RESULT="$(NCRESULT)" \
  11.750 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.751 +				make_deps=yes
  11.752 +ncd:	native-code-dll
  11.753 +endif
  11.754 +
  11.755 +# generates byte-code with debugging information
  11.756 +debug-code:		$(PRE_TARGETS)
  11.757 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
  11.758 +				REAL_RESULT="$(BCRESULT)" make_deps=yes \
  11.759 +				OCAMLFLAGS="-g $(OCAMLFLAGS)" \
  11.760 +				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
  11.761 +dc:	debug-code
  11.762 +
  11.763 +debug-code-nolink:	$(PRE_TARGETS)
  11.764 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
  11.765 +				REAL_RESULT="$(BCRESULT)" make_deps=yes \
  11.766 +				OCAMLFLAGS="-g $(OCAMLFLAGS)" \
  11.767 +				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
  11.768 +dcnl:	debug-code-nolink
  11.769 +
  11.770 +# generates byte-code libraries with debugging information
  11.771 +debug-code-library:	$(PRE_TARGETS)
  11.772 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.773 +				$(RES_CLIB) $(BCRESULT).cma \
  11.774 +				REAL_RESULT="$(BCRESULT)" make_deps=yes \
  11.775 +				CREATE_LIB=yes \
  11.776 +				OCAMLFLAGS="-g $(OCAMLFLAGS)" \
  11.777 +				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
  11.778 +dcl:	debug-code-library
  11.779 +
  11.780 +# generates byte-code for profiling
  11.781 +profiling-byte-code:		$(PRE_TARGETS)
  11.782 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
  11.783 +				REAL_RESULT="$(BCRESULT)" PROFILING="y" \
  11.784 +				make_deps=yes
  11.785 +pbc:	profiling-byte-code
  11.786 +
  11.787 +# generates native-code
  11.788 +
  11.789 +profiling-native-code:		$(PRE_TARGETS)
  11.790 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
  11.791 +				REAL_RESULT="$(NCRESULT)" \
  11.792 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.793 +				PROFILING="y" \
  11.794 +				make_deps=yes
  11.795 +pnc:	profiling-native-code
  11.796 +
  11.797 +# generates byte-code libraries
  11.798 +profiling-byte-code-library:	$(PRE_TARGETS)
  11.799 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.800 +				$(RES_CLIB) $(BCRESULT).cma \
  11.801 +				REAL_RESULT="$(BCRESULT)" PROFILING="y" \
  11.802 +				CREATE_LIB=yes \
  11.803 +				make_deps=yes
  11.804 +pbcl:	profiling-byte-code-library
  11.805 +
  11.806 +# generates native-code libraries
  11.807 +profiling-native-code-library:	$(PRE_TARGETS)
  11.808 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.809 +				$(RES_CLIB) $(NCRESULT).cmxa \
  11.810 +				REAL_RESULT="$(NCRESULT)" PROFILING="y" \
  11.811 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.812 +				CREATE_LIB=yes \
  11.813 +				make_deps=yes
  11.814 +pncl:	profiling-native-code-library
  11.815 +
  11.816 +# packs byte-code objects
  11.817 +pack-byte-code:			$(PRE_TARGETS)
  11.818 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \
  11.819 +				REAL_RESULT="$(BCRESULT)" \
  11.820 +				PACK_LIB=yes make_deps=yes
  11.821 +pabc:	pack-byte-code
  11.822 +
  11.823 +# packs native-code objects
  11.824 +pack-native-code:		$(PRE_TARGETS)
  11.825 +			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
  11.826 +				$(NCRESULT).cmx $(NCRESULT).o \
  11.827 +				REAL_RESULT="$(NCRESULT)" \
  11.828 +				REAL_OCAMLC="$(OCAMLOPT)" \
  11.829 +				PACK_LIB=yes make_deps=yes
  11.830 +panc:	pack-native-code
  11.831 +
  11.832 +# generates HTML-documentation
  11.833 +htdoc:	doc/$(RESULT)/html
  11.834 +
  11.835 +# generates Latex-documentation
  11.836 +ladoc:	doc/$(RESULT)/latex
  11.837 +
  11.838 +# generates PostScript-documentation
  11.839 +psdoc:	doc/$(RESULT)/latex/doc.ps
  11.840 +
  11.841 +# generates PDF-documentation
  11.842 +pdfdoc:	doc/$(RESULT)/latex/doc.pdf
  11.843 +
  11.844 +# generates all supported forms of documentation
  11.845 +doc: htdoc ladoc psdoc pdfdoc
  11.846 +
  11.847 +###########################################################################
  11.848 +# LOW LEVEL RULES
  11.849 +
  11.850 +$(REAL_RESULT):		$(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS)
  11.851 +			$(REAL_OCAMLFIND) $(REAL_OCAMLC) \
  11.852 +				$(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
  11.853 +				$(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
  11.854 +				$(REAL_IMPL)
  11.855 +
  11.856 +nolink:			$(REAL_IMPL_INTF) $(OBJ_LINK)
  11.857 +
  11.858 +ifdef WIN32
  11.859 +$(REAL_RESULT).dll:	$(REAL_IMPL_INTF) $(OBJ_LINK)
  11.860 +			$(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \
  11.861 +				-o $@ $(REAL_IMPL)
  11.862 +endif
  11.863 +
  11.864 +%$(TOPSUFFIX):		$(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
  11.865 +			$(REAL_OCAMLFIND) $(OCAMLMKTOP) \
  11.866 +				$(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
  11.867 +				$(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
  11.868 +				$(REAL_IMPL)
  11.869 +
  11.870 +.SUFFIXES:		.mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \
  11.871 +                        .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \
  11.872 +                        .rep .zog .glade
  11.873 +
  11.874 +ifndef STATIC
  11.875 +ifdef MINGW
  11.876 +$(DLLSONAME):		$(OBJ_LINK)
  11.877 +			$(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \
  11.878 +			-Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \
  11.879 +			 $(OCAMLLIBPATH)/ocamlrun.a \
  11.880 +			-Wl,--export-all-symbols \
  11.881 +			-Wl,--no-whole-archive
  11.882 +else
  11.883 +ifdef MSVC
  11.884 +$(DLLSONAME):		$(OBJ_LINK)
  11.885 +			link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \
  11.886 +			 $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \
  11.887 +			 $(OCAMLLIBPATH)/ocamlrun.lib
  11.888 +
  11.889 +else
  11.890 +$(DLLSONAME):		$(OBJ_LINK)
  11.891 +			$(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \
  11.892 +				-o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \
  11.893 +				$(OCAMLMKLIB_FLAGS)
  11.894 +endif
  11.895 +endif
  11.896 +endif
  11.897 +
  11.898 +ifndef LIB_PACK_NAME
  11.899 +$(RESULT).cma:		$(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
  11.900 +			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \
  11.901 +				$(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL)
  11.902 +
  11.903 +$(RESULT).cmxa $(RESULT).$(EXT_LIB):	$(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS)
  11.904 +			$(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \
  11.905 +				$(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL)
  11.906 +else
  11.907 +ifdef BYTE_OCAML
  11.908 +$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF)
  11.909 +			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL)
  11.910 +else
  11.911 +$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF)
  11.912 +			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL)
  11.913 +endif
  11.914 +
  11.915 +$(RESULT).cma:		$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
  11.916 +			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \
  11.917 +				$(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo
  11.918 +
  11.919 +$(RESULT).cmxa $(RESULT).$(EXT_LIB):	$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS)
  11.920 +			$(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \
  11.921 +				$(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx
  11.922 +endif
  11.923 +
  11.924 +$(RES_CLIB): 		$(OBJ_LINK)
  11.925 +ifndef MSVC
  11.926 +  ifneq ($(strip $(OBJ_LINK)),)
  11.927 +		      $(AR) rcs $@ $(OBJ_LINK)
  11.928 +  endif
  11.929 +else
  11.930 +  ifneq ($(strip $(OBJ_LINK)),)
  11.931 +			lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK)
  11.932 +  endif
  11.933 +endif
  11.934 +
  11.935 +.mli.cmi: $(EXTRADEPS)
  11.936 +			$(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
  11.937 +			if [ -z "$$pp" ]; then \
  11.938 +			  echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.939 +				-c $(THREAD_FLAG) $(ANNOT_FLAG) \
  11.940 +				$(OCAMLFLAGS) $(INCFLAGS) $<; \
  11.941 +			  $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.942 +				-c $(THREAD_FLAG) $(ANNOT_FLAG) \
  11.943 +				$(OCAMLFLAGS) $(INCFLAGS) $<; \
  11.944 +			else \
  11.945 +			    echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.946 +				-c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \
  11.947 +				$(OCAMLFLAGS) $(INCFLAGS) $<; \
  11.948 +			    $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.949 +				-c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \
  11.950 +				$(OCAMLFLAGS) $(INCFLAGS) $<; \
  11.951 +			fi
  11.952 +
  11.953 +.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS)
  11.954 +			$(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
  11.955 +			if [ -z "$$pp" ]; then \
  11.956 +			  echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.957 +				-c $(ALL_OCAMLCFLAGS) $<; \
  11.958 +			  $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.959 +				-c $(ALL_OCAMLCFLAGS) $<; \
  11.960 +			else \
  11.961 +			  echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.962 +				-c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \
  11.963 +			  $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
  11.964 +				-c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \
  11.965 +			fi
  11.966 +
  11.967 +ifdef PACK_LIB
  11.968 +$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
  11.969 +			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \
  11.970 +				$(OBJS_LIBS) -o $@ $(REAL_IMPL)
  11.971 +endif
  11.972 +
  11.973 +.PRECIOUS:		%.ml
  11.974 +%.ml:			%.mll
  11.975 +			$(OCAMLLEX) $<
  11.976 +
  11.977 +.PRECIOUS:              %.ml %.mli
  11.978 +%.ml %.mli:             %.mly
  11.979 +			$(OCAMLYACC) $(YFLAGS) $<
  11.980 +			$(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \
  11.981 +			if [ ! -z "$$pp" ]; then \
  11.982 +			  mv $*.ml $*.ml.temporary; \
  11.983 +			  echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \
  11.984 +			  cat $*.ml.temporary >> $*.ml; \
  11.985 +			  rm $*.ml.temporary; \
  11.986 +			  mv $*.mli $*.mli.temporary; \
  11.987 +			  echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \
  11.988 +			  cat $*.mli.temporary >> $*.mli; \
  11.989 +			  rm $*.mli.temporary; \
  11.990 +			fi
  11.991 +
  11.992 +
  11.993 +.PRECIOUS:		%.ml
  11.994 +%.ml:			%.rep
  11.995 +			$(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $<
  11.996 +
  11.997 +.PRECIOUS:		%.ml
  11.998 +%.ml:			%.zog
  11.999 +			$(CAMELEON_ZOGGY)  $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@
 11.1000 +
 11.1001 +.PRECIOUS:		%.ml
 11.1002 +%.ml:			%.glade
 11.1003 +			$(OCAML_GLADECC)  $(OCAML_GLADECC_FLAGS) $< > $@
 11.1004 +
 11.1005 +.PRECIOUS:		%.ml %.mli
 11.1006 +%.ml %.mli:		%.oxridl
 11.1007 +			$(OXRIDL) $<
 11.1008 +
 11.1009 +.PRECIOUS:		%.ml %.mli %_stubs.c %.h
 11.1010 +%.ml %.mli %_stubs.c %.h:		%.idl
 11.1011 +			$(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \
 11.1012 +				$(CAMLIDLFLAGS) $<
 11.1013 +			$(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi
 11.1014 +
 11.1015 +.c.$(EXT_OBJ):
 11.1016 +			$(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \
 11.1017 +				$(CPPFLAGS) $(CPPFLAGS_WIN32) \
 11.1018 +				$(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< 
 11.1019 +
 11.1020 +.$(EXT_CXX).$(EXT_OBJ):
 11.1021 +			$(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
 11.1022 +				-I'$(OCAMLLIBPATH)' \
 11.1023 +				$< $(CFLAG_O)$@
 11.1024 +
 11.1025 +$(MLDEPDIR)/%.d:	%.ml
 11.1026 +			$(QUIET)echo making $@ from $<
 11.1027 +			$(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
 11.1028 +			$(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
 11.1029 +			if [ -z "$$pp" ]; then \
 11.1030 +			  $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
 11.1031 +				$(DINCFLAGS) $< > $@; \
 11.1032 +			else \
 11.1033 +			  $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
 11.1034 +				-pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
 11.1035 +			fi
 11.1036 +
 11.1037 +$(BCDIDIR)/%.di $(NCDIDIR)/%.di:	%.mli
 11.1038 +			$(QUIET)echo making $@ from $<
 11.1039 +			$(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
 11.1040 +			$(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
 11.1041 +			if [ -z "$$pp" ]; then \
 11.1042 +			  $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \
 11.1043 +			else \
 11.1044 +			  $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
 11.1045 +			    -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
 11.1046 +			fi
 11.1047 +
 11.1048 +doc/$(RESULT)/html: $(DOC_FILES)
 11.1049 +	rm -rf $@
 11.1050 +	mkdir -p $@
 11.1051 +	$(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
 11.1052 +	if [ -z "$$pp" ]; then \
 11.1053 +	  echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
 11.1054 +	  $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
 11.1055 +	else \
 11.1056 +	  echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \
 11.1057 +	  	$(INCFLAGS) $(DOC_FILES); \
 11.1058 +	  $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \
 11.1059 +	  	$(INCFLAGS) $(DOC_FILES); \
 11.1060 +	fi
 11.1061 +
 11.1062 +doc/$(RESULT)/latex: $(DOC_FILES)
 11.1063 +	rm -rf $@
 11.1064 +	mkdir -p $@
 11.1065 +	$(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
 11.1066 +	if [ -z "$$pp" ]; then \
 11.1067 +	  echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \
 11.1068 +	  	$(DOC_FILES) -o $@/doc.tex; \
 11.1069 +	  $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \
 11.1070 +	  	-o $@/doc.tex; \
 11.1071 +	else \
 11.1072 +	  echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \
 11.1073 +	  	$(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \
 11.1074 +	  $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \
 11.1075 +	  	$(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \
 11.1076 +	fi
 11.1077 +
 11.1078 +doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex
 11.1079 +	cd doc/$(RESULT)/latex && \
 11.1080 +	  $(LATEX) doc.tex && \
 11.1081 +	  $(LATEX) doc.tex && \
 11.1082 +	  $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F)
 11.1083 +
 11.1084 +doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps
 11.1085 +	cd doc/$(RESULT)/latex && $(PS2PDF) $(<F)
 11.1086 +
 11.1087 +define make_subproj
 11.1088 +.PHONY:
 11.1089 +subproj_$(1):
 11.1090 +	$$(eval $$(call PROJ_$(1)))
 11.1091 +	$(QUIET)if [ "$(SUBTARGET)" != "all" ]; then \
 11.1092 +	  $(MAKE) -f $(OCAMLMAKEFILE) $(SUBTARGET); \
 11.1093 +	fi
 11.1094 +endef
 11.1095 +
 11.1096 +$(foreach subproj,$(SUBPROJS),$(eval $(call make_subproj,$(subproj))))
 11.1097 +
 11.1098 +.PHONY:
 11.1099 +subprojs: $(SUBPROJS:%=subproj_%)
 11.1100 +
 11.1101 +###########################################################################
 11.1102 +# (UN)INSTALL RULES FOR LIBRARIES
 11.1103 +
 11.1104 +.PHONY: libinstall
 11.1105 +libinstall:	all
 11.1106 +	$(QUIET)printf "\nInstalling library with ocamlfind\n"
 11.1107 +	$(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META $(LIBINSTALL_FILES)
 11.1108 +	$(QUIET)printf "\nInstallation successful.\n"
 11.1109 +
 11.1110 +.PHONY: libuninstall
 11.1111 +libuninstall:
 11.1112 +	$(QUIET)printf "\nUninstalling library with ocamlfind\n"
 11.1113 +	$(OCAMLFIND) remove $(OCAMLFIND_INSTFLAGS) $(RESULT)
 11.1114 +	$(QUIET)printf "\nUninstallation successful.\n"
 11.1115 +
 11.1116 +.PHONY: rawinstall
 11.1117 +rawinstall:	all
 11.1118 +	$(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n"
 11.1119 +	-install -d $(OCAML_LIB_INSTALL)
 11.1120 +	for i in $(LIBINSTALL_FILES); do \
 11.1121 +	  if [ -f $$i ]; then \
 11.1122 +	    install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \
 11.1123 +	  fi; \
 11.1124 +	done
 11.1125 +	$(QUIET)printf "\nInstallation successful.\n"
 11.1126 +
 11.1127 +.PHONY: rawuninstall
 11.1128 +rawuninstall:
 11.1129 +	$(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n"
 11.1130 +	cd $(OCAML_LIB_INSTALL) && rm $(notdir $(LIBINSTALL_FILES))
 11.1131 +	$(QUIET)printf "\nUninstallation successful.\n"
 11.1132 +
 11.1133 +###########################################################################
 11.1134 +# MAINTAINANCE RULES
 11.1135 +
 11.1136 +.PHONY:	clean
 11.1137 +clean::
 11.1138 +	rm -f $(TARGETS) $(TRASH)
 11.1139 +	rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
 11.1140 +
 11.1141 +.PHONY:	cleanup
 11.1142 +cleanup::
 11.1143 +	rm -f $(NONEXECS) $(TRASH)
 11.1144 +	rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
 11.1145 +
 11.1146 +.PHONY: clean-doc
 11.1147 +clean-doc::
 11.1148 +	rm -rf doc
 11.1149 +
 11.1150 +.PHONY: nobackup
 11.1151 +nobackup:
 11.1152 +	rm -f *.bak *~ *.dup

    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/tools/pdb/PDB.ml	Fri Jun 03 21:18:14 2005 +0000
    12.3 @@ -0,0 +1,180 @@
    12.4 +(** PDB.ml
    12.5 + *
    12.6 + *  Dispatch debugger commands to the appropriate context
    12.7 + *
    12.8 + *  @author copyright (c) 2005 alex ho
    12.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   12.10 + *  @version 1
   12.11 + *)
   12.12 +
   12.13 +exception Unimplemented of string
   12.14 +exception Unknown_context of string
   12.15 +exception Unknown_domain
   12.16 +
   12.17 +type context_t =
   12.18 +  | Void
   12.19 +  | Event_channel
   12.20 +  | Domain of Domain.context_t
   12.21 +  | Process of Process.context_t
   12.22 +
   12.23 +let string_of_context ctx =
   12.24 +  match ctx with
   12.25 +  | Void -> "{void}"
   12.26 +  | Event_channel -> "{event channel}"
   12.27 +  | Domain d  -> Domain.string_of_context d
   12.28 +  | Process p -> Process.string_of_context p
   12.29 +
   12.30 +
   12.31 +
   12.32 +let read_registers ctx =
   12.33 +  match ctx with
   12.34 +  | Domain d  -> Domain.read_registers d 
   12.35 +  | _ -> Intel.null_registers
   12.36 +
   12.37 +let write_register ctx register value =
   12.38 +  match ctx with
   12.39 +  | Domain d  -> Domain.write_register d register value
   12.40 +  | _ -> raise (Unimplemented "write register")
   12.41 +
   12.42 +
   12.43 +let read_memory ctx addr len =
   12.44 +  match ctx with
   12.45 +  | Domain d  -> Domain.read_memory d addr len
   12.46 +  | _ -> raise (Unimplemented "read memory")
   12.47 +
   12.48 +let write_memory ctx addr values =
   12.49 +  match ctx with
   12.50 +  | Domain d  -> Domain.write_memory d addr values
   12.51 +  | _ -> raise (Unimplemented "write memory")
   12.52 +
   12.53 +
   12.54 +let continue ctx =
   12.55 +  match ctx with
   12.56 +  | Domain d  -> Domain.continue d
   12.57 +  | _ -> raise (Unimplemented "continue")
   12.58 +
   12.59 +let step ctx =
   12.60 +  match ctx with
   12.61 +  | Domain d  -> Domain.step d
   12.62 +  | _ -> raise (Unimplemented "step")
   12.63 +
   12.64 +
   12.65 +let insert_memory_breakpoint ctx addr len =
   12.66 +  match ctx with
   12.67 +  | Domain d  -> Domain.insert_memory_breakpoint d addr len
   12.68 +  | _ -> raise (Unimplemented "insert memory breakpoint")
   12.69 +
   12.70 +let remove_memory_breakpoint ctx addr len =
   12.71 +  match ctx with
   12.72 +  | Domain d  -> Domain.remove_memory_breakpoint d addr len
   12.73 +  | _ -> raise (Unimplemented "remove memory breakpoint")
   12.74 +
   12.75 +
   12.76 +let pause ctx =
   12.77 +  match ctx with
   12.78 +  | Domain d  -> Domain.pause d
   12.79 +  | _ -> raise (Unimplemented "pause target")
   12.80 +
   12.81 +
   12.82 +let attach_debugger ctx =
   12.83 +  match ctx with
   12.84 +  | Domain d  -> Domain.attach_debugger (Domain.get_domain d) 
   12.85 +	                                (Domain.get_execution_domain d)
   12.86 +  | _ -> raise (Unimplemented "attach debugger")
   12.87 +
   12.88 +let detach_debugger ctx =
   12.89 +  match ctx with
   12.90 +  | Domain d  -> Domain.detach_debugger (Domain.get_domain d) 
   12.91 +	                                (Domain.get_execution_domain d)
   12.92 +  | _ -> raise (Unimplemented "detach debugger")
   12.93 +
   12.94 +external open_debugger : unit -> unit = "open_context"
   12.95 +external close_debugger : unit -> unit = "close_context"
   12.96 +
   12.97 +(* this is just the domains right now... expand to other contexts later *)
   12.98 +external debugger_status : unit -> unit = "debugger_status"
   12.99 +
  12.100 +
  12.101 +(***********************************************************)
  12.102 +
  12.103 +
  12.104 +let hash = Hashtbl.create 10
  12.105 +
  12.106 +let debug_contexts () =
  12.107 +  print_endline "context list:";
  12.108 +  let print_context key ctx = 
  12.109 +    match ctx with
  12.110 +    | Void -> print_endline (Printf.sprintf "  [%s] {void}" 
  12.111 +			       (Util.get_connection_info key))
  12.112 +    | Event_channel -> print_endline (Printf.sprintf "  [%s] {event_channel}" 
  12.113 +			       (Util.get_connection_info key))
  12.114 +    | Process p -> print_endline (Printf.sprintf "  [%s] %s" 
  12.115 +				    (Util.get_connection_info key)
  12.116 +				    (Process.string_of_context p))
  12.117 +    | Domain d -> print_endline (Printf.sprintf "  [%s] %s" 
  12.118 +				   (Util.get_connection_info key)
  12.119 +				   (Domain.string_of_context d))
  12.120 +  in
  12.121 +  Hashtbl.iter print_context hash
  12.122 +
  12.123 +(** add_context : add a new context to the hash table.
  12.124 + *  if there is an existing context for the same key then it 
  12.125 + *  is first removed implictly by the hash table replace function.
  12.126 + *)
  12.127 +let add_context (key:Unix.file_descr) context params =
  12.128 +  match context with
  12.129 +  | "void" -> Hashtbl.replace hash key Void
  12.130 +  | "event channel" -> Hashtbl.replace hash key Event_channel
  12.131 +  | "domain" -> 
  12.132 +      begin
  12.133 +	match params with
  12.134 +	| dom::exec_dom::_ ->
  12.135 +            let d = Domain(Domain.new_context dom exec_dom) in
  12.136 +	    attach_debugger d;
  12.137 +            Hashtbl.replace hash key d
  12.138 +	| _ -> failwith "bogus parameters to domain context"
  12.139 +      end
  12.140 +  | "process" -> 
  12.141 +      begin
  12.142 +	match params with
  12.143 +	| dom::pid::_ ->
  12.144 +	    let p = Process.new_context dom pid in
  12.145 +	    Hashtbl.replace hash key (Process(p))
  12.146 +	| _ -> failwith "bogus parameters to process context"
  12.147 +      end
  12.148 +  | _ -> raise (Unknown_context context)
  12.149 +
  12.150 +let add_default_context sock =
  12.151 +  add_context sock "void" []
  12.152 +
  12.153 +let find_context key =
  12.154 +  try
  12.155 +    Hashtbl.find hash key
  12.156 +  with
  12.157 +    Not_found ->
  12.158 +      print_endline "error: (find_context) PDB context not found";
  12.159 +      raise Not_found
  12.160 +
  12.161 +let delete_context key =
  12.162 +  Hashtbl.remove hash key
  12.163 +
  12.164 +(** find_domain : Locate the context(s) matching a particular domain 
  12.165 + *  and execution_domain pair.
  12.166 + *)
  12.167 +
  12.168 +let find_domain dom exec_dom =
  12.169 +    let find key ctx list =
  12.170 +      match ctx with
  12.171 +      |	Domain d ->
  12.172 +	  if (((Domain.get_domain d) = dom) &&
  12.173 +	      ((Domain.get_execution_domain d) = exec_dom))
  12.174 +	  then
  12.175 +	    key :: list
  12.176 +	  else
  12.177 +	    list
  12.178 +      | _ -> list
  12.179 +    in
  12.180 +    let sock_list = Hashtbl.fold find hash [] in
  12.181 +    match sock_list with
  12.182 +    | hd::tl -> hd
  12.183 +    | [] -> raise Unknown_domain

    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/tools/pdb/Process.ml	Fri Jun 03 21:18:14 2005 +0000
    13.3 @@ -0,0 +1,39 @@
    13.4 +(** Process.ml
    13.5 + *
    13.6 + *  process context implementation
    13.7 + *
    13.8 + *  @author copyright (c) 2005 alex ho
    13.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   13.10 + *  @version 1
   13.11 + *)
   13.12 +
   13.13 +open Int32
   13.14 +open Intel
   13.15 +
   13.16 +type context_t =
   13.17 +{
   13.18 +  mutable domain : int;
   13.19 +  mutable process : int;
   13.20 +}
   13.21 +
   13.22 +let default_context = { domain = 0; process = 0 }
   13.23 +
   13.24 +let new_context dom proc = { domain = dom; process = proc }
   13.25 +
   13.26 +let string_of_context ctx =
   13.27 +  Printf.sprintf "{process} domain: %d, process: %d"
   13.28 +                 ctx.domain  ctx.process
   13.29 +
   13.30 +let set_domain ctx value =
   13.31 +  ctx.domain <- value;
   13.32 +  print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain)
   13.33 +
   13.34 +let set_process ctx value =
   13.35 +  ctx.process <- value;
   13.36 +  print_endline (Printf.sprintf "ctx.process <- %d" ctx.process)
   13.37 +
   13.38 +let get_domain ctx =
   13.39 +  ctx.domain
   13.40 +
   13.41 +let get_process ctx =
   13.42 +  ctx.process

    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/tools/pdb/Process.mli	Fri Jun 03 21:18:14 2005 +0000
    14.3 @@ -0,0 +1,20 @@
    14.4 +(** Process.mli
    14.5 + *
    14.6 + *  process context interface
    14.7 + *
    14.8 + *  @author copyright (c) 2005 alex ho
    14.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   14.10 + *  @version 1
   14.11 + *)
   14.12 +
   14.13 +type context_t
   14.14 +
   14.15 +val default_context : context_t
   14.16 +val new_context : int -> int -> context_t
   14.17 +
   14.18 +val set_domain : context_t -> int -> unit
   14.19 +val get_domain : context_t -> int
   14.20 +val set_process : context_t -> int -> unit
   14.21 +val get_process : context_t -> int
   14.22 +
   14.23 +val string_of_context : context_t -> string

    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/tools/pdb/Util.ml	Fri Jun 03 21:18:14 2005 +0000
    15.3 @@ -0,0 +1,153 @@
    15.4 +(** Util.ml
    15.5 + *
    15.6 + *  various utility functions
    15.7 + *
    15.8 + *  @author copyright (c) 2005 alex ho
    15.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   15.10 + *  @version 1
   15.11 + *)
   15.12 +
   15.13 +let int_of_hexchar h = 
   15.14 +  let i = int_of_char h in
   15.15 +  match h with
   15.16 +  | '0' .. '9' -> i - (int_of_char '0')
   15.17 +  | 'a' .. 'f' -> i - (int_of_char 'a') + 10
   15.18 +  | 'A' .. 'F' -> i - (int_of_char 'A') + 10
   15.19 +  | _ -> raise (Invalid_argument "unknown hex character")
   15.20 +
   15.21 +let hexchar_of_int i = 
   15.22 +  let hexchars = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
   15.23 +		    '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f' |]
   15.24 +  in
   15.25 +  hexchars.(i)
   15.26 +
   15.27 +
   15.28 +(** flip the bytes of a four byte int 
   15.29 + *)
   15.30 +
   15.31 +let flip_int num =
   15.32 +  let a = num mod 256
   15.33 +  and b = (num / 256) mod 256
   15.34 +  and c = (num / (256 * 256)) mod 256
   15.35 +  and d = (num / (256 * 256 * 256)) in
   15.36 +  (a * 256 * 256 * 256) + (b * 256 * 256) + (c * 256) + d
   15.37 +
   15.38 +    
   15.39 +let flip_int32 num =
   15.40 +  let a = Int32.logand num 0xffl
   15.41 +  and b = Int32.logand (Int32.shift_right_logical num 8)  0xffl
   15.42 +  and c = Int32.logand (Int32.shift_right_logical num 16) 0xffl
   15.43 +  and d =              (Int32.shift_right_logical num 24)       in
   15.44 +  (Int32.logor
   15.45 +     (Int32.logor (Int32.shift_left a 24) (Int32.shift_left b 16))
   15.46 +     (Int32.logor (Int32.shift_left c 8)  d))
   15.47 +
   15.48 +
   15.49 +let int_list_of_string_list list =
   15.50 +  List.map (fun x -> int_of_string x) list
   15.51 +    
   15.52 +let int_list_of_string str len =
   15.53 +  let array_of_string s =
   15.54 +    let int_array = Array.make len 0 in
   15.55 +    for loop = 0 to len - 1 do
   15.56 +      int_array.(loop) <- (Char.code s.[loop]);
   15.57 +    done;
   15.58 +    int_array
   15.59 +  in
   15.60 +  Array.to_list (array_of_string str)
   15.61 +
   15.62 +
   15.63 +(* remove leading and trailing whitespace from a string *)
   15.64 +
   15.65 +let chomp str =
   15.66 +  let head = Str.regexp "^[ \t\r\n]+" in
   15.67 +  let tail = Str.regexp "[ \t\r\n]+$" in
   15.68 +  let str = Str.global_replace head "" str in
   15.69 +  Str.global_replace tail "" str
   15.70 +
   15.71 +(* Stupid little parser for    "<key>=<value>[,<key>=<value>]*"
   15.72 +   It first chops the entire command at each ',', so no ',' in key or value!
   15.73 +   Mucked to return a list of words for "value"
   15.74 + *)
   15.75 +
   15.76 +let list_of_string str =
   15.77 +  let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
   15.78 +  let str_list = Str.split (delim " ") str in
   15.79 +  List.map (fun x -> chomp(x)) str_list
   15.80 +
   15.81 +let little_parser fn str =
   15.82 +  let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
   15.83 +  let str_list = Str.split (delim ",") str in
   15.84 +  let pair s =
   15.85 +    match Str.split (delim "=") s with
   15.86 +    | [key;value] -> fn (chomp key) (list_of_string value)
   15.87 +    | [key] -> fn (chomp key) []
   15.88 +    | _ -> failwith (Printf.sprintf "error: (little_parser) parse error [%s]" str)
   15.89 +  in
   15.90 +  List.iter pair str_list
   15.91 +
   15.92 +(* boolean list membership test *)
   15.93 +let not_list_member the_list element =
   15.94 +  try 
   15.95 +    List.find (fun x -> x = element) the_list;
   15.96 +    false
   15.97 +  with
   15.98 +    Not_found -> true
   15.99 +
  15.100 +(* a very inefficient way to remove the elements of one list from another *)
  15.101 +let list_remove the_list remove_list =
  15.102 +  List.filter (not_list_member remove_list) the_list
  15.103 +
  15.104 +(* get a description of a file descriptor *)
  15.105 +let get_connection_info fd =
  15.106 +  let get_local_info fd =
  15.107 +    let sockname = Unix.getsockname fd in
  15.108 +    match sockname with
  15.109 +    | Unix.ADDR_UNIX(s) -> s
  15.110 +    | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
  15.111 +			      (string_of_int p))
  15.112 +  and get_remote_info fd =
  15.113 +    let sockname = Unix.getpeername fd in 
  15.114 +    match sockname with
  15.115 +    | Unix.ADDR_UNIX(s) -> s
  15.116 +    | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
  15.117 +			      (string_of_int p))
  15.118 +  in
  15.119 +  try
  15.120 +    get_remote_info fd
  15.121 +  with
  15.122 +  | Unix.Unix_error (Unix.ENOTSOCK, s1, s2) -> 
  15.123 +      let s = Unix.fstat fd in
  15.124 +      Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino
  15.125 +  | _ -> get_local_info fd
  15.126 +
  15.127 +
  15.128 +(* really write a string *)
  15.129 +let really_write fd str =
  15.130 +  let strlen = String.length str in
  15.131 +  let sent = ref 0 in
  15.132 +  while (!sent < strlen) do
  15.133 +    sent := !sent + (Unix.write fd str !sent (strlen - !sent))
  15.134 +  done
  15.135 +
  15.136 +let write_character fd ch =
  15.137 +  let str = String.create 1 in
  15.138 +  str.[0] <- ch;
  15.139 +  really_write fd str
  15.140 +
  15.141 +
  15.142 +
  15.143 +let send_reply fd reply =
  15.144 +  let checksum = ref 0 in
  15.145 +  write_character fd '$';
  15.146 +  for loop = 0 to (String.length reply) - 1 do
  15.147 +    write_character fd reply.[loop];
  15.148 +    checksum := !checksum + int_of_char reply.[loop]
  15.149 +  done;
  15.150 +  write_character fd '#';
  15.151 +  write_character fd (hexchar_of_int ((!checksum mod 256) / 16));
  15.152 +  write_character fd (hexchar_of_int ((!checksum mod 256) mod 16))
  15.153 +  (*
  15.154 +   * BUG NEED TO LISTEN FOR REPLY +/- AND POSSIBLY RE-TRANSMIT
  15.155 +   *)
  15.156 +

    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/tools/pdb/debugger.ml	Fri Jun 03 21:18:14 2005 +0000
    16.3 @@ -0,0 +1,315 @@
    16.4 +(** debugger.ml
    16.5 + *
    16.6 + *  main debug functionality
    16.7 + *
    16.8 + *  @author copyright (c) 2005 alex ho
    16.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   16.10 + *  @version 1
   16.11 + *)
   16.12 +
   16.13 +open Intel
   16.14 +open PDB
   16.15 +open Util
   16.16 +open Str
   16.17 +
   16.18 +(** a few debugger commands such as step 's' and continue 'c' do 
   16.19 + *  not immediately return a response to the debugger.  in these 
   16.20 + *  cases we raise No_reply instead. 
   16.21 + *)
   16.22 +exception No_reply
   16.23 +
   16.24 +let initialize_debugger () =
   16.25 +  ()
   16.26 +
   16.27 +let exit_debugger () =
   16.28 +  ()
   16.29 +
   16.30 +
   16.31 +(**
   16.32 +   Detach Command
   16.33 +   Note: response is ignored by gdb.  We leave the context in the
   16.34 +   hash.  It will be cleaned up with the socket is closed.
   16.35 + *)
   16.36 +let gdb_detach ctx =
   16.37 +  PDB.detach_debugger ctx;
   16.38 +  raise No_reply
   16.39 +
   16.40 +(**
   16.41 +   Kill Command
   16.42 +   Note: response is ignored by gdb.  We leave the context in the
   16.43 +   hash.  It will be cleaned up with the socket is closed.
   16.44 + *)
   16.45 +let gdb_kill () =
   16.46 +  ""
   16.47 +
   16.48 +
   16.49 +
   16.50 +(**
   16.51 +   Continue Command.
   16.52 +   resume the target
   16.53 + *)
   16.54 +let gdb_continue ctx =
   16.55 +  PDB.continue ctx;
   16.56 +  raise No_reply
   16.57 +
   16.58 +(**
   16.59 +   Step Command.
   16.60 +   single step the target
   16.61 + *)
   16.62 +let gdb_step ctx =
   16.63 +  PDB.step ctx;
   16.64 +  raise No_reply
   16.65 +
   16.66 +
   16.67 +(**
   16.68 +   Read Registers Command.
   16.69 +   returns 16 4-byte registers in a particular defined by gdb.
   16.70 + *)
   16.71 +let gdb_read_registers ctx =
   16.72 +  let regs = PDB.read_registers ctx in
   16.73 +  let str = 
   16.74 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.eax)) ^
   16.75 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.ecx)) ^
   16.76 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.edx)) ^
   16.77 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebx)) ^
   16.78 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.esp)) ^
   16.79 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebp)) ^
   16.80 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.esi)) ^
   16.81 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.edi)) ^
   16.82 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.eip)) ^
   16.83 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.eflags)) ^
   16.84 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.cs)) ^
   16.85 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.ss)) ^
   16.86 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.ds)) ^
   16.87 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.es)) ^
   16.88 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.fs)) ^
   16.89 +    (Printf.sprintf "%08lx" (Util.flip_int32 regs.gs)) in
   16.90 +  str
   16.91 +      
   16.92 +(**
   16.93 +   Set Thread Command
   16.94 + *)
   16.95 +let gdb_set_thread command =
   16.96 +  "OK"
   16.97 +
   16.98 +
   16.99 +(**
  16.100 +   Read Memory Packets
  16.101 + *)
  16.102 +let gdb_read_memory ctx command =
  16.103 +  let int_list_to_string i str =
  16.104 +    (Printf.sprintf "%02x" i) ^ str
  16.105 +  in
  16.106 +  let read_mem addr len =
  16.107 +    try
  16.108 +      let mem = PDB.read_memory ctx addr len  in
  16.109 +      List.fold_right int_list_to_string mem ""
  16.110 +    with
  16.111 +      Failure s -> "E02"
  16.112 +  in
  16.113 +  Scanf.sscanf command "m%lx,%d" read_mem
  16.114 +
  16.115 +
  16.116 +
  16.117 +(**
  16.118 +   Write Memory Packets
  16.119 + *)
  16.120 +let gdb_write_memory ctx command =
  16.121 +  let write_mem addr len =
  16.122 +    print_endline (Printf.sprintf "  gdb_write_memory %lx %x\n" addr len);
  16.123 +    print_endline (Printf.sprintf "  [[ unimplemented ]]\n")
  16.124 +  in
  16.125 +  Scanf.sscanf command "M%lx,%d" write_mem;
  16.126 +  "OK"
  16.127 +
  16.128 +
  16.129 +
  16.130 +(**
  16.131 +   Write Register Packets
  16.132 + *)
  16.133 +let gdb_write_register ctx command =
  16.134 +  let write_reg reg goofy_val =
  16.135 +    let new_val = Util.flip_int32 goofy_val in
  16.136 +    match reg with
  16.137 +    |  0 -> PDB.write_register ctx EAX new_val
  16.138 +    |  1 -> PDB.write_register ctx ECX new_val
  16.139 +    |  2 -> PDB.write_register ctx EDX new_val
  16.140 +    |  3 -> PDB.write_register ctx EBX new_val
  16.141 +    |  4 -> PDB.write_register ctx ESP new_val
  16.142 +    |  5 -> PDB.write_register ctx EBP new_val
  16.143 +    |  6 -> PDB.write_register ctx ESI new_val
  16.144 +    |  7 -> PDB.write_register ctx EDI new_val
  16.145 +    |  8 -> PDB.write_register ctx EIP new_val
  16.146 +    |  9 -> PDB.write_register ctx EFLAGS new_val
  16.147 +    | 10 -> PDB.write_register ctx CS new_val
  16.148 +    | 11 -> PDB.write_register ctx SS new_val
  16.149 +    | 12 -> PDB.write_register ctx DS new_val
  16.150 +    | 13 -> PDB.write_register ctx ES new_val
  16.151 +    | 14 -> PDB.write_register ctx FS new_val
  16.152 +    | 15 -> PDB.write_register ctx GS new_val
  16.153 +    | _  -> print_endline (Printf.sprintf "write unknown register [%d]" reg)
  16.154 +  in
  16.155 +  Scanf.sscanf command "P%x=%lx" write_reg;
  16.156 +  "OK"
  16.157 +
  16.158 +
  16.159 +(**
  16.160 +   General Query Packets
  16.161 + *)
  16.162 +let gdb_query command =
  16.163 +  match command with
  16.164 +  | "qC" -> ""
  16.165 +  | "qOffsets" -> ""
  16.166 +  | "qSymbol::" -> ""
  16.167 +  | _ -> 
  16.168 +      print_endline (Printf.sprintf "unknown gdb query packet [%s]" command);
  16.169 +      "E01"
  16.170 +
  16.171 +
  16.172 +(**
  16.173 +   Write Memory Binary Packets
  16.174 + *)
  16.175 +let gdb_write_memory_binary ctx command =
  16.176 +  let write_mem addr len =
  16.177 +    let pos = Str.search_forward (Str.regexp ":") command 0 in
  16.178 +    let txt = Str.string_after command (pos + 1) in
  16.179 +    PDB.write_memory ctx addr (int_list_of_string txt len)
  16.180 +  in
  16.181 +  Scanf.sscanf command "X%lx,%d" write_mem;
  16.182 +  "OK"
  16.183 +
  16.184 +
  16.185 +
  16.186 +(**
  16.187 +   Last Signal Command
  16.188 + *)
  16.189 +let gdb_last_signal =
  16.190 +  "S00"
  16.191 +
  16.192 +
  16.193 +
  16.194 +
  16.195 +(**
  16.196 +   Process PDB extensions to the GDB serial protocol.
  16.197 +   Changes the mutable context state.
  16.198 + *)
  16.199 +let pdb_extensions command sock =
  16.200 +  let process_extension key value =
  16.201 +    (* since this command can change the context, we need to grab it each time *)
  16.202 +    let ctx = PDB.find_context sock in
  16.203 +    match key with
  16.204 +    | "status" ->
  16.205 +	print_endline (string_of_context ctx);
  16.206 +	PDB.debug_contexts ();
  16.207 +	debugger_status ()
  16.208 +    | "context" ->
  16.209 +        PDB.add_context sock (List.hd value) 
  16.210 +                             (int_list_of_string_list (List.tl value))
  16.211 +    | _ -> failwith (Printf.sprintf "unknown pdb extension command [%s:%s]" 
  16.212 +		                    key (List.hd value))
  16.213 +  in
  16.214 +  try
  16.215 +    Util.little_parser process_extension 
  16.216 +                       (String.sub command 1 ((String.length command) - 1));
  16.217 +    "OK"
  16.218 +  with
  16.219 +  | Unknown_context s -> 
  16.220 +      print_endline (Printf.sprintf "unknown context [%s]" s);
  16.221 +      "E01"
  16.222 +  | Failure s -> "E01"
  16.223 +
  16.224 +
  16.225 +(**
  16.226 +   Insert Breakpoint or Watchpoint Packet
  16.227 + *)
  16.228 +let gdb_insert_bwcpoint ctx command =
  16.229 +  let insert cmd addr length =
  16.230 +    try
  16.231 +      match cmd with
  16.232 +      | 0 -> PDB.insert_memory_breakpoint ctx addr length; "OK"
  16.233 +      | _ -> ""
  16.234 +    with
  16.235 +      Failure s -> "E03"
  16.236 +  in
  16.237 +  Scanf.sscanf command "Z%d,%lx,%d" insert
  16.238 +
  16.239 +(**
  16.240 +   Remove Breakpoint or Watchpoint Packet
  16.241 + *)
  16.242 +let gdb_remove_bwcpoint ctx command =
  16.243 +  let insert cmd addr length =
  16.244 +    try
  16.245 +      match cmd with
  16.246 +      | 0 -> PDB.remove_memory_breakpoint ctx addr length; "OK"
  16.247 +      | _ -> ""
  16.248 +    with
  16.249 +      Failure s -> "E04"
  16.250 +  in
  16.251 +  Scanf.sscanf command "z%d,%lx,%d" insert
  16.252 +
  16.253 +(**
  16.254 +   Do Work!
  16.255 +
  16.256 +   @param command  char list
  16.257 + *)
  16.258 +
  16.259 +let process_command command sock =
  16.260 +  let ctx = PDB.find_context sock in
  16.261 +  try
  16.262 +    match command.[0] with
  16.263 +    | 'c' -> gdb_continue ctx
  16.264 +    | 'D' -> gdb_detach ctx
  16.265 +    | 'g' -> gdb_read_registers ctx
  16.266 +    | 'H' -> gdb_set_thread command
  16.267 +    | 'k' -> gdb_kill ()
  16.268 +    | 'm' -> gdb_read_memory ctx command
  16.269 +    | 'M' -> gdb_write_memory ctx command
  16.270 +    | 'P' -> gdb_write_register ctx command
  16.271 +    | 'q' -> gdb_query command
  16.272 +    | 's' -> gdb_step ctx
  16.273 +    | 'x' -> pdb_extensions command sock
  16.274 +    | 'X' -> gdb_write_memory_binary ctx command
  16.275 +    | '?' -> gdb_last_signal
  16.276 +    | 'z' -> gdb_remove_bwcpoint ctx command
  16.277 +    | 'Z' -> gdb_insert_bwcpoint ctx command
  16.278 +    | _ -> 
  16.279 +	print_endline (Printf.sprintf "unknown gdb command [%s]" command);
  16.280 +	""
  16.281 +  with
  16.282 +    Unimplemented s ->
  16.283 +      print_endline (Printf.sprintf "loser. unimplemented command [%s][%s]" 
  16.284 +		                    command s);
  16.285 +      ""
  16.286 +
  16.287 +
  16.288 +(**
  16.289 +   process_evtchn  
  16.290 +
  16.291 +   This is called each time a virq_pdb is sent from xen to dom 0.
  16.292 +   It is sent by Xen when a domain hits a breakpoint. 
  16.293 +
  16.294 +   Think of this as the continuation function for a "c" or "s" command.
  16.295 +*)
  16.296 +
  16.297 +external query_domain_stop : unit -> (int * int) list = "query_domain_stop"
  16.298 +(* returns a list of paused domains : () -> (domain, vcpu) list *)
  16.299 +
  16.300 +let process_evtchn fd =
  16.301 +  let channel = Evtchn.read fd in
  16.302 +  let find_pair (dom, vcpu) =
  16.303 +    print_endline (Printf.sprintf "checking %d.%d" dom vcpu);
  16.304 +    try
  16.305 +      let sock = PDB.find_domain dom vcpu in
  16.306 +      true
  16.307 +    with
  16.308 +      Unknown_domain -> false
  16.309 +  in
  16.310 +  let dom_list = query_domain_stop () in
  16.311 +  let (dom, vcpu) = List.find find_pair dom_list in
  16.312 +  let vec = 3 in
  16.313 +  let sock = PDB.find_domain dom vcpu in
  16.314 +  print_endline (Printf.sprintf "handle bkpt d:%d ed:%d v:%d  %s" 
  16.315 +		   dom vcpu vec (Util.get_connection_info sock));
  16.316 +  Util.send_reply sock "S05";
  16.317 +  Evtchn.unmask fd channel                                (* allow next virq *)
  16.318 +  

    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/tools/pdb/evtchn.ml	Fri Jun 03 21:18:14 2005 +0000
    17.3 @@ -0,0 +1,32 @@
    17.4 +(** evtchn.ml
    17.5 + *
    17.6 + *  event channel interface
    17.7 + *
    17.8 + *  @author copyright (c) 2005 alex ho
    17.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   17.10 + *  @version 1
   17.11 + *)
   17.12 +
   17.13 +let dev_name = "/dev/xen/evtchn"                          (* EVTCHN_DEV_NAME *)
   17.14 +let dev_major = 10                                       (* EVTCHN_DEV_MAJOR *)
   17.15 +let dev_minor = 201                                      (* EVTCHN_DEV_MINOR *)
   17.16 +
   17.17 +let virq_pdb = 6                                      (* as defined VIRQ_PDB *)
   17.18 +
   17.19 +external bind_virq : int -> int = "evtchn_bind_virq"
   17.20 +external bind : Unix.file_descr -> int -> unit = "evtchn_bind"
   17.21 +external unbind : Unix.file_descr -> int -> unit = "evtchn_unbind"
   17.22 +external ec_open : string -> int -> int -> Unix.file_descr = "evtchn_open"
   17.23 +external read : Unix.file_descr -> int = "evtchn_read"
   17.24 +external ec_close : Unix.file_descr -> unit = "evtchn_close"
   17.25 +external unmask : Unix.file_descr -> int -> unit = "evtchn_unmask"
   17.26 +
   17.27 +let setup () =
   17.28 +  let port = bind_virq virq_pdb in
   17.29 +  let fd = ec_open dev_name dev_major dev_minor in
   17.30 +  bind fd port;
   17.31 +  fd
   17.32 +
   17.33 +let teardown fd =
   17.34 +  unbind fd virq_pdb;
   17.35 +  ec_close fd

    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/tools/pdb/evtchn.mli	Fri Jun 03 21:18:14 2005 +0000
    18.3 @@ -0,0 +1,14 @@
    18.4 +(** evtchn.mli
    18.5 + *
    18.6 + *  event channel interface
    18.7 + *
    18.8 + *  @author copyright (c) 2005 alex ho
    18.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   18.10 + *  @version 1
   18.11 + *)
   18.12 +
   18.13 +
   18.14 +val setup : unit -> Unix.file_descr
   18.15 +val read : Unix.file_descr -> int
   18.16 +val teardown : Unix.file_descr -> unit
   18.17 +val unmask : Unix.file_descr -> int -> unit

    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/tools/pdb/pdb_caml_xc.c	Fri Jun 03 21:18:14 2005 +0000
    19.3 @@ -0,0 +1,732 @@
    19.4 +/*
    19.5 + * pdb_caml_xc.c
    19.6 + *
    19.7 + * http://www.cl.cam.ac.uk/netos/pdb
    19.8 + *
    19.9 + * OCaml to libxc interface library for PDB
   19.10 + */
   19.11 +
   19.12 +#include <xc.h>
   19.13 +#include <xc_debug.h>
   19.14 +#include <errno.h>
   19.15 +#include <stdio.h>
   19.16 +#include <stdlib.h>
   19.17 +#include <string.h>
   19.18 +#include <sys/mman.h>
   19.19 +#include <caml/alloc.h>
   19.20 +#include <caml/fail.h>
   19.21 +#include <caml/memory.h>
   19.22 +#include <caml/mlvalues.h>
   19.23 +
   19.24 +int pdb_evtchn_bind_virq (int xc_handle, int virq, int *port);
   19.25 +int xen_evtchn_bind (int evtchn_fd, int idx);
   19.26 +int xen_evtchn_unbind (int evtchn_fd, int idx);
   19.27 +
   19.28 +/* this order comes from xen/include/public/arch-x86_32.h */
   19.29 +enum x86_registers { PDB_EBX, PDB_ECX, PDB_EDX, PDB_ESI, PDB_EDI,
   19.30 +                     PDB_EBP, PDB_EAX, PDB_Error_code, PDB_Entry_vector, 
   19.31 +                     PDB_EIP, PDB_CS, PDB_EFLAGS, PDB_ESP, PDB_SS,
   19.32 +                     PDB_ES, PDB_DS, PDB_FS, PDB_GS };
   19.33 +
   19.34 +static void dump_regs (cpu_user_regs_t *ctx);
   19.35 +
   19.36 +static int xc_handle = -1;
   19.37 +
   19.38 +typedef struct
   19.39 +{
   19.40 +    int domain;
   19.41 +    int vcpu;
   19.42 +} context_t;
   19.43 +
   19.44 +#define decode_context(_ctx, _ocaml)   \
   19.45 +{  \
   19.46 +    (_ctx)->domain = Int_val(Field((_ocaml),0));  \
   19.47 +    (_ctx)->vcpu = Int_val(Field((_ocaml),1));  \
   19.48 +}
   19.49 +
   19.50 +#define encode_context(_ctx, _ocaml)  \
   19.51 +{  \
   19.52 +    (_ocaml) = caml_alloc_tuple(2);  \
   19.53 +    Store_field((_ocaml), 0, Val_int((_ctx)->domain));  \
   19.54 +    Store_field((_ocaml), 1, Val_int((_ctx)->vcpu));  \
   19.55 +}
   19.56 +
   19.57 +
   19.58 +/****************************************************************************/
   19.59 +
   19.60 +/*
   19.61 + * open_context : unit -> unit
   19.62 + */
   19.63 +value
   19.64 +open_context (value unit)
   19.65 +{
   19.66 +    CAMLparam1(unit);
   19.67 +
   19.68 +    xc_handle = xc_interface_open();
   19.69 +
   19.70 +    if ( xc_handle < 0 )
   19.71 +    {
   19.72 +        fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n",
   19.73 +                errno, strerror(errno));
   19.74 +    }
   19.75 +
   19.76 +    CAMLreturn(Val_unit);
   19.77 +}
   19.78 +
   19.79 +/*
   19.80 + * close_context : unit -> unit
   19.81 + */
   19.82 +value
   19.83 +close_context (value unit)
   19.84 +{
   19.85 +    CAMLparam1(unit);
   19.86 +    int rc;
   19.87 +    
   19.88 +    if ( (rc = xc_interface_close(xc_handle)) < 0 )
   19.89 +    {
   19.90 +        fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n",
   19.91 +                errno, strerror(errno));
   19.92 +    }
   19.93 +
   19.94 +    CAMLreturn(Val_unit);
   19.95 +}
   19.96 +
   19.97 +/*
   19.98 + * read_registers : context_t -> int32
   19.99 + */
  19.100 +value
  19.101 +read_registers (value context)
  19.102 +{
  19.103 +    CAMLparam1(context);
  19.104 +    CAMLlocal1(result);
  19.105 +
  19.106 +    cpu_user_regs_t *regs;
  19.107 +    context_t ctx;
  19.108 +
  19.109 +    decode_context(&ctx, context);
  19.110 +
  19.111 +    if ( xc_debug_read_registers(xc_handle, ctx.domain, ctx.vcpu, &regs) )
  19.112 +    {
  19.113 +        printf("(pdb) read registers error!\n");  fflush(stdout);
  19.114 +        failwith("read registers error");
  19.115 +    }
  19.116 +
  19.117 +    dump_regs(regs);
  19.118 +
  19.119 +    result = caml_alloc_tuple(18);                                  /* FIXME */
  19.120 +
  19.121 +    Store_field(result,  0, caml_copy_int32(regs->ebx));
  19.122 +    Store_field(result,  1, caml_copy_int32(regs->ecx));
  19.123 +    Store_field(result,  2, caml_copy_int32(regs->edx));
  19.124 +    Store_field(result,  3, caml_copy_int32(regs->esi));
  19.125 +    Store_field(result,  4, caml_copy_int32(regs->edi));
  19.126 +    Store_field(result,  5, caml_copy_int32(regs->ebp));
  19.127 +    Store_field(result,  6, caml_copy_int32(regs->eax));
  19.128 +    Store_field(result,  7, caml_copy_int32(regs->error_code));        /* 16 */
  19.129 +    Store_field(result,  8, caml_copy_int32(regs->entry_vector));      /* 16 */
  19.130 +    Store_field(result,  9, caml_copy_int32(regs->eip));
  19.131 +    Store_field(result, 10, caml_copy_int32(regs->cs));                /* 16 */
  19.132 +    Store_field(result, 11, caml_copy_int32(regs->eflags));
  19.133 +    Store_field(result, 12, caml_copy_int32(regs->esp));
  19.134 +    Store_field(result, 13, caml_copy_int32(regs->ss));                /* 16 */
  19.135 +    Store_field(result, 14, caml_copy_int32(regs->es));                /* 16 */
  19.136 +    Store_field(result, 15, caml_copy_int32(regs->ds));                /* 16 */
  19.137 +    Store_field(result, 16, caml_copy_int32(regs->fs));                /* 16 */
  19.138 +    Store_field(result, 17, caml_copy_int32(regs->gs));                /* 16 */
  19.139 +
  19.140 +    CAMLreturn(result);
  19.141 +}
  19.142 +
  19.143 +
  19.144 +/*
  19.145 + * write_register : context_t -> register -> int32 -> unit
  19.146 + */
  19.147 +value
  19.148 +write_register (value context, value reg, value newval)
  19.149 +{
  19.150 +    CAMLparam3(context, reg, newval);
  19.151 +
  19.152 +    int my_reg = Int_val(reg);
  19.153 +    int val = Int32_val(newval);
  19.154 +
  19.155 +    context_t ctx;
  19.156 +    cpu_user_regs_t *regs;
  19.157 +
  19.158 +    printf("(pdb) write register\n");
  19.159 +
  19.160 +    decode_context(&ctx, context);
  19.161 +
  19.162 +    if ( xc_debug_read_registers(xc_handle, ctx.domain, ctx.vcpu, &regs) )
  19.163 +    {
  19.164 +        printf("(pdb) write register (get) error!\n");  fflush(stdout);
  19.165 +        failwith("write register error");
  19.166 +    }
  19.167 +
  19.168 +    switch (my_reg)
  19.169 +    {
  19.170 +    case PDB_EBX: regs->ebx = val; break;
  19.171 +    case PDB_ECX: regs->ecx = val; break;
  19.172 +    case PDB_EDX: regs->edx = val; break;
  19.173 +    case PDB_ESI: regs->esi = val; break;
  19.174 +    case PDB_EDI: regs->edi = val; break;
  19.175 +
  19.176 +    case PDB_EBP: regs->ebp = val; break;
  19.177 +    case PDB_EAX: regs->eax = val; break;
  19.178 +    case PDB_Error_code: regs->error_code = val; break;
  19.179 +    case PDB_Entry_vector: regs->entry_vector = val; break;
  19.180 + 
  19.181 +    case PDB_EIP: regs->eip = val; break;
  19.182 +    case PDB_CS:  regs->cs  = val; break;
  19.183 +    case PDB_EFLAGS: regs->eflags = val; break;
  19.184 +    case PDB_ESP: regs->esp = val; break;
  19.185 +    case PDB_SS:  regs->ss  = val; break;
  19.186 +    case PDB_ES:  regs->es  = val; break;
  19.187 +    case PDB_DS:  regs->ds  = val; break;
  19.188 +    case PDB_FS:  regs->fs  = val; break;
  19.189 +    case PDB_GS:  regs->gs  = val; break;
  19.190 +    }
  19.191 +
  19.192 +    if ( xc_debug_write_registers(xc_handle, ctx.domain, ctx.vcpu, regs) )
  19.193 +    {
  19.194 +        printf("(pdb) write register (set) error!\n");  fflush(stdout);
  19.195 +        failwith("write register error");
  19.196 +    }
  19.197 +
  19.198 +    CAMLreturn(Val_unit);
  19.199 +}
  19.200 +
  19.201 +/*
  19.202 + * read_memory : context_t -> int32 -> int -> int
  19.203 + */
  19.204 +value
  19.205 +read_memory (value context, value address, value length)
  19.206 +{
  19.207 +    CAMLparam3(context, address, length);
  19.208 +    CAMLlocal2(result, temp);
  19.209 +
  19.210 +    context_t ctx;
  19.211 +    int loop;
  19.212 +    char *buffer;
  19.213 +    memory_t my_address = Int32_val(address);
  19.214 +    u32 my_length = Int_val(length);
  19.215 +
  19.216 +    printf ("(pdb) read memory\n");
  19.217 +
  19.218 +    decode_context(&ctx, context);
  19.219 +
  19.220 +    buffer = malloc(my_length);
  19.221 +    if (buffer == NULL)
  19.222 +    {
  19.223 +        printf("(pdb) read memory: malloc failed.\n");  fflush(stdout);
  19.224 +        failwith("read memory error");
  19.225 +    }
  19.226 +
  19.227 +    if ( xc_debug_read_memory(xc_handle, ctx.domain, ctx.vcpu, 
  19.228 +                              my_address, my_length, buffer) )
  19.229 +    {
  19.230 +        printf("(pdb) read memory error!\n");  fflush(stdout);
  19.231 +        failwith("read memory error");
  19.232 +    }
  19.233 +
  19.234 +    result = caml_alloc(2,0);
  19.235 +    if ( my_length > 0 )                                              /* car */
  19.236 +    {
  19.237 +        Store_field(result, 0, Val_int(buffer[my_length - 1] & 0xff));
  19.238 +    }
  19.239 +    else
  19.240 +
  19.241 +    {
  19.242 +        Store_field(result, 0, Val_int(0));                    
  19.243 +    }
  19.244 +    Store_field(result, 1, Val_int(0));                               /* cdr */
  19.245 +
  19.246 +    for (loop = 1; loop < my_length; loop++)
  19.247 +    {
  19.248 +        temp = result;
  19.249 +        result = caml_alloc(2,0);
  19.250 +        Store_field(result, 0, Val_int(buffer[my_length - loop - 1] & 0xff));
  19.251 +        Store_field(result, 1, temp);
  19.252 +    }
  19.253 +
  19.254 +    CAMLreturn(result);
  19.255 +}
  19.256 +
  19.257 +/*
  19.258 + * write_memory : context_t -> int32 -> int list -> unit
  19.259 + */
  19.260 +value
  19.261 +write_memory (value context, value address, value val_list)
  19.262 +{
  19.263 +    CAMLparam3(context, address, val_list);
  19.264 +    CAMLlocal1(node);
  19.265 +
  19.266 +    context_t ctx;
  19.267 +
  19.268 +    char buffer[4096];  /* a big buffer */
  19.269 +    memory_t  my_address;
  19.270 +    u32 length = 0;
  19.271 +
  19.272 +    printf ("(pdb) write memory\n");
  19.273 +
  19.274 +    decode_context(&ctx, context);
  19.275 +
  19.276 +    node = val_list;
  19.277 +    if ( Int_val(node) == 0 )       /* gdb functionalty test uses empty list */
  19.278 +    {
  19.279 +        CAMLreturn(Val_unit);
  19.280 +    }
  19.281 +
  19.282 +    while ( Int_val(Field(node,1)) != 0 )
  19.283 +    {
  19.284 +        buffer[length++] = Int_val(Field(node, 0));
  19.285 +        node = Field(node,1);
  19.286 +    }
  19.287 +    buffer[length++] = Int_val(Field(node, 0));
  19.288 +
  19.289 +    my_address = (memory_t) Int32_val(address);
  19.290 +
  19.291 +    if ( xc_debug_write_memory(xc_handle, ctx.domain, ctx.vcpu,
  19.292 +                               my_address, length, buffer) )
  19.293 +    {
  19.294 +        printf("(pdb) write memory error!\n");  fflush(stdout);
  19.295 +        failwith("write memory error");
  19.296 +    }
  19.297 +
  19.298 +    CAMLreturn(Val_unit);
  19.299 +}
  19.300 +
  19.301 +
  19.302 +/*********************************************************************/
  19.303 +
  19.304 +void
  19.305 +dump_regs (cpu_user_regs_t *regs)
  19.306 +{
  19.307 +    printf ("   eax: %x\n", regs->eax);
  19.308 +    printf ("   ecx: %x\n", regs->ecx);
  19.309 +    printf ("   edx: %x\n", regs->edx);
  19.310 +    printf ("   ebx: %x\n", regs->ebx);
  19.311 +    printf ("   esp: %x\n", regs->esp);
  19.312 +    printf ("   ebp: %x\n", regs->ebp);
  19.313 +    printf ("   esi: %x\n", regs->esi);
  19.314 +    printf ("   edi: %x\n", regs->edi);
  19.315 +    printf ("   eip: %x\n", regs->eip);
  19.316 +    printf (" flags: %x\n", regs->eflags);
  19.317 +    printf ("    cs: %x\n", regs->cs);
  19.318 +    printf ("    ss: %x\n", regs->ss);
  19.319 +    printf ("    es: %x\n", regs->es);
  19.320 +    printf ("    ds: %x\n", regs->ds);
  19.321 +    printf ("    fs: %x\n", regs->fs);
  19.322 +    printf ("    gs: %x\n", regs->gs);
  19.323 +
  19.324 +    return;
  19.325 +}
  19.326 +
  19.327 +/*
  19.328 + * continue_target : context_t -> unit
  19.329 + */
  19.330 +value
  19.331 +continue_target (value context)
  19.332 +{
  19.333 +    CAMLparam1(context);
  19.334 +
  19.335 +    context_t ctx;
  19.336 +
  19.337 +    decode_context(&ctx, context);
  19.338 +
  19.339 +    if ( xc_debug_continue(xc_handle, ctx.domain, ctx.vcpu) )
  19.340 +    {
  19.341 +        printf("(pdb) continue\n");  fflush(stdout);
  19.342 +        failwith("continue");
  19.343 +    }
  19.344 +
  19.345 +    CAMLreturn(Val_unit);
  19.346 +}
  19.347 +
  19.348 +/*
  19.349 + * step_target : context_t -> unit
  19.350 + */
  19.351 +value
  19.352 +step_target (value context)
  19.353 +{
  19.354 +    CAMLparam1(context);
  19.355 +
  19.356 +    context_t ctx;
  19.357 +
  19.358 +    decode_context(&ctx, context);
  19.359 +
  19.360 +    if ( xc_debug_step(xc_handle, ctx.domain, ctx.vcpu) )
  19.361 +    {
  19.362 +        printf("(pdb) step\n");  fflush(stdout);
  19.363 +        failwith("step");
  19.364 +    }
  19.365 +
  19.366 +    CAMLreturn(Val_unit);
  19.367 +}
  19.368 +
  19.369 +
  19.370 +
  19.371 +/*
  19.372 + * insert_memory_breakpoint : context_t -> int32 -> int list -> unit
  19.373 + */
  19.374 +value
  19.375 +insert_memory_breakpoint (value context, value address, value length)
  19.376 +{
  19.377 +    CAMLparam3(context, address, length);
  19.378 +
  19.379 +    context_t ctx;
  19.380 +    memory_t my_address = (memory_t) Int32_val(address);
  19.381 +    int my_length = Int_val(length);
  19.382 +
  19.383 +    decode_context(&ctx, context);
  19.384 +
  19.385 +    printf ("(pdb) insert memory breakpoint 0x%lx %d\n",
  19.386 +            my_address, my_length);
  19.387 +
  19.388 +    if ( xc_debug_insert_memory_breakpoint(xc_handle, ctx.domain, ctx.vcpu,
  19.389 +                                           my_address, my_length) )
  19.390 +    {
  19.391 +        printf("(pdb) error: insert memory breakpoint\n");  fflush(stdout);
  19.392 +        failwith("insert memory breakpoint");
  19.393 +    }
  19.394 +
  19.395 +
  19.396 +    CAMLreturn(Val_unit);
  19.397 +}
  19.398 +
  19.399 +/*
  19.400 + * remove_memory_breakpoint : context_t -> int32 -> int list -> unit
  19.401 + */
  19.402 +value
  19.403 +remove_memory_breakpoint (value context, value address, value length)
  19.404 +{
  19.405 +    CAMLparam3(context, address, length);
  19.406 +
  19.407 +    context_t ctx;
  19.408 +
  19.409 +    memory_t my_address = (memory_t) Int32_val(address);
  19.410 +    int my_length = Int_val(length);
  19.411 +
  19.412 +    printf ("(pdb) remove memory breakpoint 0x%lx %d\n",
  19.413 +            my_address, my_length);
  19.414 +
  19.415 +    decode_context(&ctx, context);
  19.416 +
  19.417 +    if ( xc_debug_remove_memory_breakpoint(xc_handle, 
  19.418 +                                           ctx.domain, ctx.vcpu,
  19.419 +                                           my_address, my_length) )
  19.420 +    {
  19.421 +        printf("(pdb) error: remove memory breakpoint\n");  fflush(stdout);
  19.422 +        failwith("remove memory breakpoint");
  19.423 +    }
  19.424 +
  19.425 +    CAMLreturn(Val_unit);
  19.426 +}
  19.427 +
  19.428 +/*
  19.429 + * attach_debugger : int -> int -> unit
  19.430 + */
  19.431 +value
  19.432 +attach_debugger (value domain, value vcpu)
  19.433 +{
  19.434 +    CAMLparam2(domain, vcpu);
  19.435 +
  19.436 +    int my_domain = Int_val(domain);
  19.437 +    int my_vcpu = Int_val(vcpu);
  19.438 +
  19.439 +    printf ("(pdb) attach domain [%d.%d]\n", my_domain, my_vcpu);
  19.440 +
  19.441 +    if ( xc_debug_attach(xc_handle, my_domain, my_vcpu) )
  19.442 +    {
  19.443 +        printf("(pdb) attach error!\n");  fflush(stdout);
  19.444 +        failwith("attach error");
  19.445 +    }
  19.446 +
  19.447 +    CAMLreturn(Val_unit);
  19.448 +}
  19.449 +
  19.450 +
  19.451 +/*
  19.452 + * detach_debugger : int -> int -> unit
  19.453 + */
  19.454 +value
  19.455 +detach_debugger (value domain, value vcpu)
  19.456 +{
  19.457 +    CAMLparam2(domain, vcpu);
  19.458 +
  19.459 +    int my_domain = Int_val(domain);
  19.460 +    int my_vcpu = Int_val(vcpu);
  19.461 +
  19.462 +    printf ("(pdb) detach domain [%d.%d]\n", my_domain, my_vcpu);
  19.463 +
  19.464 +    if ( xc_debug_detach(xc_handle, my_domain, my_vcpu) )
  19.465 +    {
  19.466 +        printf("(pdb) detach error!\n");  fflush(stdout);
  19.467 +        failwith("detach error");
  19.468 +    }
  19.469 +
  19.470 +    CAMLreturn(Val_unit);
  19.471 +}
  19.472 +
  19.473 +
  19.474 +/*
  19.475 + * debugger_status : unit -> unit
  19.476 + */
  19.477 +value
  19.478 +debugger_status (value unit)
  19.479 +{
  19.480 +    CAMLparam1(unit);
  19.481 +
  19.482 +    printf ("(pdb) debugger status\n");
  19.483 +
  19.484 +    CAMLreturn(Val_unit);
  19.485 +}
  19.486 +
  19.487 +/*
  19.488 + * pause_target : int -> unit
  19.489 + */
  19.490 +value
  19.491 +pause_target (value domid)
  19.492 +{
  19.493 +    CAMLparam1(domid);
  19.494 +
  19.495 +    int my_domid = Int_val(domid);
  19.496 +
  19.497 +    printf ("(pdb) pause target %d\n", my_domid);
  19.498 +
  19.499 +    xc_domain_pause(xc_handle, my_domid);
  19.500 +
  19.501 +    CAMLreturn(Val_unit);
  19.502 +}
  19.503 +
  19.504 +/****************************************************************************/
  19.505 +/****************************************************************************/
  19.506 +
  19.507 +/*
  19.508 + * query_domain_stop : unit -> (int * int) list
  19.509 + */
  19.510 +value
  19.511 +query_domain_stop (value unit)
  19.512 +{
  19.513 +    CAMLparam1(unit);
  19.514 +    CAMLlocal3(result, temp, node);
  19.515 +
  19.516 +    int max_domains = 20;
  19.517 +    int dom_list[max_domains];
  19.518 +    int loop, count;
  19.519 +
  19.520 +    count = xc_debug_query_domain_stop(xc_handle, dom_list, max_domains);
  19.521 +    if ( count < 0 )
  19.522 +    {
  19.523 +        printf("(pdb) query domain stop!\n");  fflush(stdout);
  19.524 +        failwith("query domain stop");
  19.525 +    }
  19.526 +
  19.527 +    printf ("QDS: %d\n", count);
  19.528 +    for (loop = 0; loop < count; loop ++)
  19.529 +        printf ("  %d %d\n", loop, dom_list[loop]);
  19.530 +
  19.531 +    result = caml_alloc(2,0);
  19.532 +    if ( count > 0 )                                                  /* car */
  19.533 +    {
  19.534 +        node = caml_alloc(2,0);
  19.535 +        Store_field(node, 0, Val_int(dom_list[0]));             /* domain id */
  19.536 +        Store_field(node, 1, Val_int(0));                            /* vcpu */
  19.537 +        Store_field(result, 0, node);
  19.538 +    }
  19.539 +    else
  19.540 +    {
  19.541 +        Store_field(result, 0, Val_int(0));                    
  19.542 +    }
  19.543 +    Store_field(result, 1, Val_int(0));                               /* cdr */
  19.544 +
  19.545 +    for ( loop = 1; loop < count; loop++ )
  19.546 +    {
  19.547 +        temp = result;
  19.548 +        result = caml_alloc(2,0);
  19.549 +        node = caml_alloc(2,0);
  19.550 +        Store_field(node, 0, Val_int(dom_list[loop]));          /* domain id */
  19.551 +        Store_field(node, 1, Val_int(0));                            /* vcpu */
  19.552 +        Store_field(result, 0, node);
  19.553 +        Store_field(result, 1, temp);
  19.554 +    }
  19.555 +
  19.556 +    CAMLreturn(result);
  19.557 +}
  19.558 +
  19.559 +/****************************************************************************/
  19.560 +/****************************************************************************/
  19.561 +
  19.562 +#include <errno.h>
  19.563 +#include <sys/ioctl.h>
  19.564 +#include <sys/stat.h>
  19.565 +#include <fcntl.h>
  19.566 +#include <unistd.h>
  19.567 +
  19.568 +/*
  19.569 + * evtchn_open : string -> int -> int -> Unix.file_descr
  19.570 + *
  19.571 + * OCaml's Unix library doesn't have mknod, so it makes more sense just write
  19.572 + * this in C.  This code is from Keir/Andy.
  19.573 + */
  19.574 +value
  19.575 +evtchn_open (value filename, value major, value minor)
  19.576 +{
  19.577 +    CAMLparam3(filename, major, minor);
  19.578 +
  19.579 +    char *myfilename = String_val(filename);
  19.580 +    int   mymajor = Int_val(major);
  19.581 +    int   myminor = Int_val(minor);
  19.582 +    int   evtchn_fd;
  19.583 +    struct stat st;
  19.584 +    
  19.585 +    /* Make sure any existing device file links to correct device. */
  19.586 +    if ( (lstat(myfilename, &st) != 0) ||
  19.587 +         !S_ISCHR(st.st_mode) ||
  19.588 +         (st.st_rdev != makedev(mymajor, myminor)) )
  19.589 +    {
  19.590 +        (void)unlink(myfilename);
  19.591 +    }
  19.592 +
  19.593 + reopen:
  19.594 +    evtchn_fd = open(myfilename, O_RDWR); 
  19.595 +    if ( evtchn_fd == -1 )
  19.596 +    {
  19.597 +        if ( (errno == ENOENT) &&
  19.598 +             ((mkdir("/dev/xen", 0755) == 0) || (errno == EEXIST)) &&
  19.599 +             (mknod(myfilename, S_IFCHR|0600, makedev(mymajor,myminor)) == 0) )
  19.600 +        {
  19.601 +            goto reopen;
  19.602 +        }
  19.603 +        return -errno;
  19.604 +    }
  19.605 +
  19.606 +    CAMLreturn(Val_int(evtchn_fd));
  19.607 +}
  19.608 +
  19.609 +/*
  19.610 + * evtchn_bind_virq : int -> int
  19.611 + */
  19.612 +value
  19.613 +evtchn_bind_virq (value virq)
  19.614 +{
  19.615 +    CAMLparam1(virq);
  19.616 +
  19.617 +    int port;
  19.618 +
  19.619 +    if ( pdb_evtchn_bind_virq(xc_handle, Int_val(virq), &port) < 0 )
  19.620 +    {
  19.621 +        printf("(pdb) evtchn_bind_virq error!\n");  fflush(stdout);
  19.622 +        failwith("evtchn_bind_virq error");
  19.623 +    }
  19.624 +
  19.625 +    CAMLreturn(Val_int(port));
  19.626 +}
  19.627 +
  19.628 +/*
  19.629 + * evtchn_bind : Unix.file_descr -> int -> unit
  19.630 + */
  19.631 +value
  19.632 +evtchn_bind (value fd, value idx)
  19.633 +{
  19.634 +    CAMLparam2(fd, idx);
  19.635 +
  19.636 +    int myfd = Int_val(fd);
  19.637 +    int myidx = Int_val(idx);
  19.638 +
  19.639 +    if ( xen_evtchn_bind(myfd, myidx) < 0 )
  19.640 +    {
  19.641 +        printf("(pdb) evtchn_bind error!\n");  fflush(stdout);
  19.642 +        failwith("evtchn_bind error");
  19.643 +    }
  19.644 +
  19.645 +    CAMLreturn(Val_unit);
  19.646 +}
  19.647 +
  19.648 +/*
  19.649 + * evtchn_unbind : Unix.file_descr -> int -> unit
  19.650 + */
  19.651 +value
  19.652 +evtchn_unbind (value fd, value idx)
  19.653 +{
  19.654 +    CAMLparam2(fd, idx);
  19.655 +
  19.656 +    int myfd = Int_val(fd);
  19.657 +    int myidx = Int_val(idx);
  19.658 +
  19.659 +    if ( xen_evtchn_unbind(myfd, myidx) < 0 )
  19.660 +    {
  19.661 +        printf("(pdb) evtchn_unbind error!\n");  fflush(stdout);
  19.662 +        failwith("evtchn_unbind error");
  19.663 +    }
  19.664 +
  19.665 +    CAMLreturn(Val_unit);
  19.666 +}
  19.667 +
  19.668 +/*
  19.669 + * evtchn_read : Unix.file_descr -> int
  19.670 + */
  19.671 +value
  19.672 +evtchn_read (value fd)
  19.673 +{
  19.674 +    CAMLparam1(fd);
  19.675 +
  19.676 +    u16 v;
  19.677 +    int bytes;
  19.678 +    int rc = -1;
  19.679 +    int myfd = Int_val(fd);
  19.680 +
  19.681 +    while ( (bytes = read(myfd, &v, sizeof(v))) == -1 )
  19.682 +    {
  19.683 +        if ( errno == EINTR )  continue;
  19.684 +        rc = -errno;
  19.685 +        goto exit;
  19.686 +    }
  19.687 +    
  19.688 +    if ( bytes == sizeof(v) )
  19.689 +        rc = v;
  19.690 +    
  19.691 + exit:
  19.692 +    CAMLreturn(Val_int(rc));
  19.693 +}
  19.694 +
  19.695 +
  19.696 +/*
  19.697 + * evtchn_close : Unix.file_descr -> unit
  19.698 + */
  19.699 +value
  19.700 +evtchn_close (value fd)
  19.701 +{
  19.702 +    CAMLparam1(fd);
  19.703 +    int myfd = Int_val(fd);
  19.704 +
  19.705 +    (void)close(myfd);
  19.706 +
  19.707 +    CAMLreturn(Val_unit);
  19.708 +}
  19.709 +
  19.710 +/*
  19.711 + * evtchn_unmask : Unix.file_descr -> int -> unit
  19.712 + */
  19.713 +value
  19.714 +evtchn_unmask (value fd, value idx)
  19.715 +{
  19.716 +    CAMLparam1(fd);
  19.717 +
  19.718 +    int myfd = Int_val(fd);
  19.719 +    u16 myidx = Int_val(idx);
  19.720 +
  19.721 +    (void)write(myfd, &myidx, sizeof(myidx));
  19.722 +
  19.723 +    CAMLreturn(Val_unit);
  19.724 +}
  19.725 +
  19.726 +/*
  19.727 + * Local variables:
  19.728 + * mode: C
  19.729 + * c-set-style: "BSD"
  19.730 + * c-basic-offset: 4
  19.731 + * tab-width: 4
  19.732 + * indent-tabs-mode: nil
  19.733 + * End:
  19.734 + */
  19.735 +

    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/tools/pdb/pdb_xen.c	Fri Jun 03 21:18:14 2005 +0000
    20.3 @@ -0,0 +1,93 @@
    20.4 +/*
    20.5 + * pdb_xen.c
    20.6 + *
    20.7 + * alex ho
    20.8 + * http://www.cl.cam.ac.uk/netos/pdb
    20.9 + *
   20.10 + * PDB interface library for accessing Xen
   20.11 + */
   20.12 +
   20.13 +#include <xc.h>
   20.14 +#include <stdio.h>
   20.15 +#include <stdlib.h>
   20.16 +#include <errno.h>
   20.17 +#include <string.h>
   20.18 +#include <sys/mman.h>
   20.19 +
   20.20 +int
   20.21 +pdb_open ()
   20.22 +{
   20.23 +    int xc_handle = xc_interface_open();
   20.24 +
   20.25 +    if ( xc_handle < 0 )
   20.26 +    {
   20.27 +        fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n",
   20.28 +                errno, strerror(errno));
   20.29 +    }
   20.30 +    return xc_handle;
   20.31 +}
   20.32 +
   20.33 +int 
   20.34 +pdb_close (int xc_handle)
   20.35 +{
   20.36 +    int rc;
   20.37 +
   20.38 +    
   20.39 +    if ( (rc = xc_interface_close(xc_handle)) < 0 )
   20.40 +    {
   20.41 +        fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n",
   20.42 +                errno, strerror(errno));
   20.43 +    }
   20.44 +    return rc;
   20.45 +}
   20.46 +
   20.47 +
   20.48 +int 
   20.49 +pdb_evtchn_bind_virq (int xc_handle, int virq, int *port)
   20.50 +{
   20.51 +    int rc;
   20.52 +    
   20.53 +    if ( (rc = xc_evtchn_bind_virq(xc_handle, virq, port) < 0 ) )
   20.54 +    {
   20.55 +        fprintf(stderr, "(pdb) error binding virq to event channel: %d (%s)\n",
   20.56 +                errno, strerror(errno));
   20.57 +    }
   20.58 +    return rc;
   20.59 +}
   20.60 +
   20.61 +
   20.62 +#include <sys/ioctl.h>
   20.63 +
   20.64 +/* /dev/xen/evtchn ioctls */
   20.65 +#define EVTCHN_RESET  _IO('E', 1)                   /* clear & reinit buffer */
   20.66 +#define EVTCHN_BIND   _IO('E', 2)                   /* bind to event channel */
   20.67 +#define EVTCHN_UNBIND _IO('E', 3)               /* unbind from event channel */
   20.68 +
   20.69 +int
   20.70 +xen_evtchn_bind (int evtchn_fd, int idx)
   20.71 +{
   20.72 +    if ( ioctl(evtchn_fd, EVTCHN_BIND, idx) != 0 )
   20.73 +        return -errno;
   20.74 +    
   20.75 +    return 0;
   20.76 +}
   20.77 +
   20.78 +int 
   20.79 +xen_evtchn_unbind (int evtchn_fd, int idx)
   20.80 +{
   20.81 +    if ( ioctl(evtchn_fd, EVTCHN_UNBIND, idx) != 0 )
   20.82 +        return -errno;
   20.83 +
   20.84 +    return 0;
   20.85 +}
   20.86 +
   20.87 +
   20.88 +/*
   20.89 + * Local variables:
   20.90 + * mode: C
   20.91 + * c-set-style: "BSD"
   20.92 + * c-basic-offset: 4
   20.93 + * tab-width: 4
   20.94 + * indent-tabs-mode: nil
   20.95 + * End:
   20.96 + */

    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/tools/pdb/server.ml	Fri Jun 03 21:18:14 2005 +0000
    21.3 @@ -0,0 +1,219 @@
    21.4 +(** server.ml
    21.5 + *
    21.6 + *  PDB server main loop
    21.7 + *
    21.8 + *  @author copyright (c) 2005 alex ho
    21.9 + *  @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
   21.10 + *  @version 1
   21.11 + *)
   21.12 +
   21.13 +open Unix
   21.14 +open Buffer
   21.15 +
   21.16 +
   21.17 +(**
   21.18 + * connection_t: The state for each connection.
   21.19 + * buffer & length contains bytes that have been read from the sock
   21.20 + * but not yet parsed / processed.
   21.21 + *)
   21.22 +type connection_t =
   21.23 +{ 
   21.24 +          fd : file_descr;
   21.25 +  mutable buffer : string;
   21.26 +  mutable length : int;
   21.27 +}
   21.28 +
   21.29 +
   21.30 +(**
   21.31 + * validate_checksum:  Compute and compare the checksum of a string
   21.32 + * against the provided checksum using the gdb serial protocol algorithm.
   21.33 + *
   21.34 + *)
   21.35 +let validate_checksum command checksum =
   21.36 +  let c0 = ref 0 in
   21.37 +  for loop = 0 to (String.length command - 1) do
   21.38 +    c0 := !c0 + int_of_char(command.[loop]);
   21.39 +  done;
   21.40 +  if (String.length checksum) = 2 
   21.41 +  then
   21.42 +    let c1 = Util.int_of_hexchar(checksum.[1]) +
   21.43 +	     Util.int_of_hexchar(checksum.[0]) * 16 in
   21.44 +    (!c0 mod 256) = (c1 mod 256)
   21.45 +  else
   21.46 +    false
   21.47 +  
   21.48 +
   21.49 +(**
   21.50 + * process_input: Oh, joy!  Someone sent us a message.  Let's open the
   21.51 + * envelope and see what they have to say.
   21.52 + *
   21.53 + * This function is a paradigm of inefficiency; it performs as many 
   21.54 + * string copies as possible.
   21.55 + *)
   21.56 +let process_input conn sock = 
   21.57 +  let max_buffer_size = 1024 in
   21.58 +  let in_string = String.create max_buffer_size in
   21.59 +
   21.60 +  let length = read sock in_string 0 max_buffer_size in
   21.61 +  conn.buffer <- conn.buffer ^ (String.sub in_string 0 length);
   21.62 +  conn.length <- conn.length + length;
   21.63 +  let re = Str.regexp "[^\\$]*\\$\\([^#]*\\)#\\(..\\)" in
   21.64 +
   21.65 +  begin
   21.66 +    try
   21.67 +      let break = String.index conn.buffer '\003' + 1 in
   21.68 +      print_endline (Printf.sprintf "{{%s}}" (String.escaped conn.buffer));
   21.69 +
   21.70 +      (* discard everything seen before the ctrl-c *)
   21.71 +      conn.buffer <- String.sub conn.buffer break (conn.length - break);
   21.72 +      conn.length <- conn.length - break;
   21.73 +
   21.74 +      (* pause the target *)
   21.75 +      PDB.pause (PDB.find_context sock);
   21.76 +
   21.77 +      (* send a code back to the debugger *)
   21.78 +      Util.send_reply sock "S05"
   21.79 +
   21.80 +    with
   21.81 +      Not_found -> ()
   21.82 +  end;
   21.83 +
   21.84 +  (* with gdb this is unlikely to loop since you ack each packet *)
   21.85 +  while ( Str.string_match re conn.buffer 0 ) do
   21.86 +    let command = Str.matched_group 1 conn.buffer in
   21.87 +    let checksum = Str.matched_group 2 conn.buffer in
   21.88 +    let match_end = Str.group_end 2 in
   21.89 +
   21.90 +    begin
   21.91 +      match validate_checksum command checksum with
   21.92 +      | true -> 
   21.93 +	  begin
   21.94 +	    Util.write_character sock '+';
   21.95 +	    try
   21.96 +	      let reply = Debugger.process_command command sock in
   21.97 +	      print_endline (Printf.sprintf "[%s] %s -> \"%s\"" 
   21.98 +			       (Util.get_connection_info sock)
   21.99 +			       (String.escaped command) 
  21.100 +			       (String.escaped reply));
  21.101 +	      Util.send_reply sock reply
  21.102 +	    with
  21.103 +	      Debugger.No_reply ->
  21.104 +		print_endline (Printf.sprintf "[%s] %s -> null" 
  21.105 +				 (Util.get_connection_info sock)
  21.106 +				 (String.escaped command))
  21.107 +	  end
  21.108 +      | false ->
  21.109 +	  Util.write_character sock '-';
  21.110 +    end;
  21.111 +
  21.112 +    conn.buffer <- String.sub conn.buffer match_end (conn.length - match_end);
  21.113 +    conn.length <- conn.length - match_end;
  21.114 +  done;
  21.115 +  if length = 0 then raise End_of_file
  21.116 +
  21.117 +
  21.118 +
  21.119 +(** main_server_loop.
  21.120 + *
  21.121 + *  connection_hash is a hash (duh!) with one connection_t for each
  21.122 + *  open connection.
  21.123 + * 
  21.124 + *  in_list is a list of active sockets.  it also contains two 
  21.125 + *  magic entries: server_sock for accepting new entries and 
  21.126 + *  event_sock for Xen event channel asynchronous notifications.
  21.127 + *)
  21.128 +let main_server_loop sockaddr =
  21.129 +  let connection_hash = Hashtbl.create 10
  21.130 +  in
  21.131 +  let process_socket svr_sock sockets sock =
  21.132 +    let (new_list, closed_list) = sockets in
  21.133 +    if sock == svr_sock
  21.134 +    then
  21.135 +      begin
  21.136 +	let (new_sock, caller) = accept sock in
  21.137 +	print_endline (Printf.sprintf "[%s] new connection from %s"
  21.138 +			              (Util.get_connection_info sock)
  21.139 +			              (Util.get_connection_info new_sock));
  21.140 +	Hashtbl.add connection_hash new_sock 
  21.141 +	            {fd=new_sock; buffer=""; length = 0};
  21.142 +	PDB.add_default_context new_sock;
  21.143 +	(new_sock :: new_list, closed_list)
  21.144 +      end
  21.145 +    else
  21.146 +      begin
  21.147 +	try
  21.148 +	  match PDB.find_context sock with
  21.149 +	  | PDB.Event_channel ->
  21.150 +	      print_endline (Printf.sprintf "[%s] event channel"
  21.151 +			                    (Util.get_connection_info sock));
  21.152 +	      Debugger.process_evtchn sock;
  21.153 +	      (new_list, closed_list)
  21.154 +	  | _ ->
  21.155 +	      let conn = Hashtbl.find connection_hash sock in
  21.156 +	      process_input conn sock;
  21.157 +	      (new_list, closed_list)
  21.158 +	with
  21.159 +	| Not_found -> 
  21.160 +	    print_endline "error: (main_svr_loop) context not found";
  21.161 +	    PDB.debug_contexts ();
  21.162 +	    raise Not_found
  21.163 +	| End_of_file -> 
  21.164 +	    print_endline (Printf.sprintf "[%s] close connection from %s"
  21.165 +  			                   (Util.get_connection_info sock)
  21.166 +			                   (Util.get_connection_info sock));
  21.167 +	    PDB.delete_context sock;
  21.168 +	    Hashtbl.remove connection_hash sock;
  21.169 +	    close sock;
  21.170 +	    (new_list, sock :: closed_list)
  21.171 +      end
  21.172 +  in
  21.173 +  let rec helper in_list server_sock =
  21.174 +  (*
  21.175 +   * List.iter (fun x->Printf.printf "{%s} " 
  21.176 +   *                                (Util.get_connection_info x)) in_list;   
  21.177 +   * Printf.printf "\n";
  21.178 +   *)
  21.179 +    let (rd_list, _, _) = select in_list [] [] (-1.0) in 
  21.180 +    let (new_list, closed_list) = List.fold_left (process_socket server_sock)
  21.181 +	                                         ([],[]) rd_list  in
  21.182 +    let merge_list = Util.list_remove (new_list @ in_list) closed_list  in
  21.183 +    helper merge_list server_sock
  21.184 +  in
  21.185 +  try
  21.186 +    let server_sock = socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
  21.187 +    setsockopt server_sock SO_REUSEADDR true;
  21.188 +    bind server_sock sockaddr;
  21.189 +    listen server_sock 2;
  21.190 +
  21.191 +    PDB.open_debugger ();
  21.192 +    let event_sock = Evtchn.setup () in
  21.193 +    PDB.add_context event_sock "event channel" [];
  21.194 +    helper [server_sock; event_sock] server_sock
  21.195 +  with
  21.196 +  | Sys.Break ->
  21.197 +      print_endline "break: cleaning up";
  21.198 +      PDB.close_debugger ();
  21.199 +      Hashtbl.iter (fun sock conn -> close sock) connection_hash
  21.200 +  | Unix_error(e,err,param) -> 
  21.201 +      Printf.printf "unix error: [%s][%s][%s]\n" (error_message e) err param
  21.202 +  | Sys_error s -> Printf.printf "sys error: [%s]\n" s
  21.203 +  | Failure s -> Printf.printf "failure: [%s]\n" s
  21.204 +  | End_of_file -> Printf.printf "end of file\n"
  21.205 +
  21.206 +
  21.207 +let get_port () =
  21.208 +  if (Array.length Sys.argv) = 2 
  21.209 +  then
  21.210 +    int_of_string Sys.argv.(1)
  21.211 +  else
  21.212 +    begin
  21.213 +      print_endline (Printf.sprintf "syntax error: %s <port>" Sys.argv.(0));
  21.214 +      exit 1
  21.215 +    end
  21.216 +
  21.217 +
  21.218 +let main =
  21.219 +  let address = inet_addr_any in
  21.220 +  let port = get_port () in
  21.221 +  main_server_loop (ADDR_INET(address, port))
  21.222 +

    22.1 --- a/xen/Rules.mk	Fri Jun 03 18:06:52 2005 +0000
    22.2 +++ b/xen/Rules.mk	Fri Jun 03 21:18:14 2005 +0000
    22.3 @@ -55,6 +55,11 @@ ifeq ($(domu_debug),y)
    22.4  CFLAGS += -DDOMU_DEBUG
    22.5  endif
    22.6  
    22.7 +ifeq ($(pdb),y)
    22.8 +CFLAGS += -g -DPDB_DEBUG
    22.9 +endif
   22.10 +
   22.11 +
   22.12  ifeq ($(crash_debug),y)
   22.13  CFLAGS += -g -DCRASH_DEBUG
   22.14  endif

    23.1 --- a/xen/include/asm-x86/debugger.h	Fri Jun 03 18:06:52 2005 +0000
    23.2 +++ b/xen/include/asm-x86/debugger.h	Fri Jun 03 21:18:14 2005 +0000
    23.3 @@ -80,6 +80,50 @@ static inline int debugger_trap_entry(
    23.4  #define debugger_trap_fatal(_v, _r) (0)
    23.5  #define debugger_trap_immediate()
    23.6  
    23.7 +#elif defined(PDB_DEBUG)
    23.8 +
    23.9 +#include <xen/event.h>
   23.10 +#include <xen/softirq.h>
   23.11 +#include <xen/sched.h>
   23.12 +#include <asm/regs.h>
   23.13 +
   23.14 +static inline int debugger_trap_entry(unsigned int vector,
   23.15 +				      struct cpu_user_regs *regs)
   23.16 +{
   23.17 +    struct vcpu *vcpu = current;
   23.18 +
   23.19 +    if ( !KERNEL_MODE(vcpu, regs) || (vcpu->domain->domain_id == 0) )
   23.20 +        return 0;
   23.21 +    
   23.22 +    switch ( vector )
   23.23 +    {
   23.24 +    case TRAP_debug:
   23.25 +    case TRAP_int3:
   23.26 +    {
   23.27 +        struct vcpu  *ptr;
   23.28 +
   23.29 +        /* suspend the guest domain */
   23.30 +        for_each_vcpu ( vcpu->domain, ptr )
   23.31 +        {
   23.32 +            test_and_set_bit(_VCPUF_ctrl_pause, &ptr->vcpu_flags);
   23.33 +        }
   23.34 +        sync_lazy_execstate_mask(vcpu->domain->cpumask);        /* TLB flush */
   23.35 +        raise_softirq(SCHEDULE_SOFTIRQ);
   23.36 +
   23.37 +        /* notify the debugger */
   23.38 +        send_guest_virq(dom0->vcpu[0], VIRQ_PDB);
   23.39 +
   23.40 +        return 1;
   23.41 +    }
   23.42 +    default:
   23.43 +        break;
   23.44 +    }
   23.45 +
   23.46 +    return 0;
   23.47 +}
   23.48 +
   23.49 +#define debugger_trap_fatal(_v, _r) (0)
   23.50 +#define debugger_trap_immediate()
   23.51  
   23.52  #elif 0
   23.53  

    24.1 --- a/xen/include/public/xen.h	Fri Jun 03 18:06:52 2005 +0000
    24.2 +++ b/xen/include/public/xen.h	Fri Jun 03 21:18:14 2005 +0000
    24.3 @@ -70,6 +70,7 @@
    24.4  #define VIRQ_DOM_EXC    3  /* (DOM0) Exceptional event for some domain.   */
    24.5  #define VIRQ_PARITY_ERR 4  /* (DOM0) NMI parity error.                    */
    24.6  #define VIRQ_IO_ERR     5  /* (DOM0) NMI I/O error.                       */
    24.7 +#define VIRQ_PDB        6  /* (DOM0) PDB                                  */
    24.8  #define NR_VIRQS        7
    24.9  
   24.10  /*
author	ach61@arcadians.cl.cam.ac.uk
date	Fri Jun 03 21:18:14 2005 +0000 (2005-06-03)
parents	226484ec5fb0 d8ac19a4170e
children	c59632e7ff3e
files	.rootkeys BitKeeper/etc/logging_ok tools/libxc/Makefile tools/libxc/list.h tools/libxc/xc_debug.c tools/libxc/xc_debug.h tools/pdb/Domain.ml tools/pdb/Domain.mli tools/pdb/Intel.ml tools/pdb/Makefile tools/pdb/OCamlMakefile tools/pdb/PDB.ml tools/pdb/Process.ml tools/pdb/Process.mli tools/pdb/Util.ml tools/pdb/debugger.ml tools/pdb/evtchn.ml tools/pdb/evtchn.mli tools/pdb/pdb_caml_xc.c tools/pdb/pdb_xen.c tools/pdb/server.ml xen/Rules.mk xen/include/asm-x86/debugger.h xen/include/public/xen.h