diff options
-rw-r--r-- | .rootkeys | 18 | ||||
-rw-r--r-- | BitKeeper/etc/logging_ok | 1 | ||||
-rw-r--r-- | tools/libxc/Makefile | 3 | ||||
-rw-r--r-- | tools/libxc/list.h | 186 | ||||
-rw-r--r-- | tools/libxc/xc_debug.c | 580 | ||||
-rw-r--r-- | tools/libxc/xc_debug.h | 76 | ||||
-rw-r--r-- | tools/pdb/Domain.ml | 63 | ||||
-rw-r--r-- | tools/pdb/Domain.mli | 38 | ||||
-rw-r--r-- | tools/pdb/Intel.ml | 71 | ||||
-rw-r--r-- | tools/pdb/Makefile | 54 | ||||
-rw-r--r-- | tools/pdb/OCamlMakefile | 1149 | ||||
-rw-r--r-- | tools/pdb/PDB.ml | 180 | ||||
-rw-r--r-- | tools/pdb/Process.ml | 39 | ||||
-rw-r--r-- | tools/pdb/Process.mli | 20 | ||||
-rw-r--r-- | tools/pdb/Util.ml | 153 | ||||
-rw-r--r-- | tools/pdb/debugger.ml | 315 | ||||
-rw-r--r-- | tools/pdb/evtchn.ml | 32 | ||||
-rw-r--r-- | tools/pdb/evtchn.mli | 14 | ||||
-rw-r--r-- | tools/pdb/pdb_caml_xc.c | 732 | ||||
-rw-r--r-- | tools/pdb/pdb_xen.c | 93 | ||||
-rw-r--r-- | tools/pdb/server.ml | 219 | ||||
-rw-r--r-- | xen/Rules.mk | 5 | ||||
-rw-r--r-- | xen/include/asm-x86/debugger.h | 44 | ||||
-rw-r--r-- | xen/include/public/xen.h | 1 |
24 files changed, 4085 insertions, 1 deletions
@@ -681,11 +681,14 @@ 428f0763_67jCiHbdgfGlgAOJqfg9A tools/ioemu/x86_64.ld 3fbba6dbDfYvJSsw9500b4SZyUhxjQ tools/libxc/Makefile 41dde8afKYRKxS4XtLv1KUegGQy_bg tools/libxc/linux_boot_params.h +42a0c8d8qbLfvuvDUA0tFB9nHMh-zg tools/libxc/list.h 41cc934abX-QLXJXW_clV_wRjM0zYg tools/libxc/plan9a.out.h 3fbba6dc1uU7U3IFeF6A-XEOYF2MkQ tools/libxc/rpm.spec 3fbba6dcrNxtygEcgJYAJJ1gCQqfsA tools/libxc/xc.h 3fbba6dbEVkVMX0JuDFzap9jeaucGA tools/libxc/xc_bvtsched.c 4273458dyF2_sKA6CFkNJQYb8eY2dA tools/libxc/xc_core.c +42a0c8d98XtmbhyddBgIyyHllz5WTw tools/libxc/xc_debug.c +42a0c8d9ucRxWO41IHTfYI7xYGoKrw tools/libxc/xc_debug.h 3fbba6dbasJQV-MVElDC0DGSHMiL5w tools/libxc/xc_domain.c 40278d99BLsfUv3qxv0I8C1sClZ0ow tools/libxc/xc_elf.h 403e0977Bjsm_e82pwvl9VvaJxh8Gg tools/libxc/xc_evtchn.c @@ -737,6 +740,21 @@ 41adc641dV-0cDLSyzMs5BT8nL7v3Q tools/misc/xenperf.c 4056f5155QYZdsk-1fLdjsZPFTnlhg tools/misc/xensymoops 40cf2937dqM1jWW87O5OoOYND8leuA tools/misc/xm +42a0c8d9zuGuWoaTux5NW4N3wOw8pg tools/pdb/Domain.ml +42a0c8d9pigEXFFtdut3R99jbf73NA tools/pdb/Domain.mli +42a0c8d93wnR_hcSAa7VHgn8CSrWEA tools/pdb/Intel.ml +42a0c8d95glt-jkgXe8GDOPT6TYN6Q tools/pdb/Makefile +42a0c8d9UueJDF0IRX3OozEvUhSTmw tools/pdb/OCamlMakefile +42a0c8d9PgBvaWPzTHSFb9ngii7c7w tools/pdb/PDB.ml +42a0c8danHHGiNywdeer6j4jzxAc2A tools/pdb/Process.ml +42a0c8dav_08OtySI4kYP1lahlVrpQ tools/pdb/Process.mli +42a0c8da51EqubQT5PJ4sxCKLF3xSw tools/pdb/Util.ml +42a0c8daxftpiXuvLmc9fOOEhdFWiQ tools/pdb/debugger.ml +42a0c8da81tzhpvIAfkx9nZqUNrQvg tools/pdb/evtchn.ml +42a0c8dasiso9c-2sCvHBzP6YVjATA tools/pdb/evtchn.mli +42a0c8daXD_6Y62A_u5-PO_Klrhi0w tools/pdb/pdb_caml_xc.c +42a0c8danJXun9ay5SPBhhkKvuUPfg tools/pdb/pdb_xen.c +42a0c8dbjK6Du89D2SUcxsuAdlUu3w tools/pdb/server.ml 4270cc81g3nSNYCZ1ryCMDEbLtMtbQ tools/pygrub/Makefile 4270deeccyRsJn6jLnRh9odRtMW9SA tools/pygrub/README 4270cc81EIl7NyaS3Av6IPRk2c2a6Q tools/pygrub/setup.py diff --git a/BitKeeper/etc/logging_ok b/BitKeeper/etc/logging_ok index 3cdc0126d1..afc6cd647f 100644 --- a/BitKeeper/etc/logging_ok +++ b/BitKeeper/etc/logging_ok @@ -1,3 +1,4 @@ +ach61@arcadians.cl.cam.ac.uk ach61@boulderdash.cl.cam.ac.uk ach61@labyrinth.cl.cam.ac.uk ach61@soar.cl.cam.ac.uk diff --git a/tools/libxc/Makefile b/tools/libxc/Makefile index 598abedb7d..9a95597eed 100644 --- a/tools/libxc/Makefile +++ b/tools/libxc/Makefile @@ -17,6 +17,7 @@ SRCS += xc_sedf.c SRCS += xc_bvtsched.c SRCS += xc_core.c SRCS += xc_domain.c +SRCS += xc_debug.c SRCS += xc_evtchn.c SRCS += xc_gnttab.c SRCS += xc_linux_build.c @@ -93,7 +94,7 @@ rpm: build mv staging/i386/*.rpm . rm -rf staging -libxc.a: $(LIB_OBJS) +libxc.a: $(OBJS) $(AR) rc $@ $^ libxc.so: libxc.so.$(MAJOR) diff --git a/tools/libxc/list.h b/tools/libxc/list.h new file mode 100644 index 0000000000..d2ee720f34 --- /dev/null +++ b/tools/libxc/list.h @@ -0,0 +1,186 @@ +#ifndef _LINUX_LIST_H +#define _LINUX_LIST_H + +/* + * Simple doubly linked list implementation. + * + * Some of the internal functions ("__xxx") are useful when + * manipulating whole lists rather than single entries, as + * sometimes we already know the next/prev entries and we can + * generate better code by using them directly rather than + * using the generic single-entry routines. + */ + +struct list_head { + struct list_head *next, *prev; +}; + +#define LIST_HEAD_INIT(name) { &(name), &(name) } + +#define LIST_HEAD(name) \ + struct list_head name = LIST_HEAD_INIT(name) + +#define INIT_LIST_HEAD(ptr) do { \ + (ptr)->next = (ptr); (ptr)->prev = (ptr); \ +} while (0) + +/* + * Insert a new entry between two known consecutive entries. + * + * This is only for internal list manipulation where we know + * the prev/next entries already! + */ +static __inline__ void __list_add(struct list_head * new, + struct list_head * prev, + struct list_head * next) +{ + next->prev = new; + new->next = next; + new->prev = prev; + prev->next = new; +} + +/** + * list_add - add a new entry + * @new: new entry to be added + * @head: list head to add it after + * + * Insert a new entry after the specified head. + * This is good for implementing stacks. + */ +static __inline__ void list_add(struct list_head *new, struct list_head *head) +{ + __list_add(new, head, head->next); +} + +/** + * list_add_tail - add a new entry + * @new: new entry to be added + * @head: list head to add it before + * + * Insert a new entry before the specified head. + * This is useful for implementing queues. + */ +static __inline__ void list_add_tail(struct list_head *new, struct list_head *head) +{ + __list_add(new, head->prev, head); +} + +/* + * Delete a list entry by making the prev/next entries + * point to each other. + * + * This is only for internal list manipulation where we know + * the prev/next entries already! + */ +static __inline__ void __list_del(struct list_head * prev, + struct list_head * next) +{ + next->prev = prev; + prev->next = next; +} + +/** + * list_del - deletes entry from list. + * @entry: the element to delete from the list. + * Note: list_empty on entry does not return true after this, the entry is in an undefined state. + */ +static __inline__ void list_del(struct list_head *entry) +{ + __list_del(entry->prev, entry->next); +} + +/** + * list_del_init - deletes entry from list and reinitialize it. + * @entry: the element to delete from the list. + */ +static __inline__ void list_del_init(struct list_head *entry) +{ + __list_del(entry->prev, entry->next); + INIT_LIST_HEAD(entry); +} + +/** + * list_empty - tests whether a list is empty + * @head: the list to test. + */ +static __inline__ int list_empty(struct list_head *head) +{ + return head->next == head; +} + +/** + * list_splice - join two lists + * @list: the new list to add. + * @head: the place to add it in the first list. + */ +static __inline__ void list_splice(struct list_head *list, struct list_head *head) +{ + struct list_head *first = list->next; + + if (first != list) { + struct list_head *last = list->prev; + struct list_head *at = head->next; + + first->prev = head; + head->next = first; + + last->next = at; + at->prev = last; + } +} + +/** + * list_entry - get the struct for this entry + * @ptr: the &struct list_head pointer. + * @type: the type of the struct this is embedded in. + * @member: the name of the list_struct within the struct. + */ +#define list_entry(ptr, type, member) \ + ((type *)((char *)(ptr)-(unsigned long)(&((type *)0)->member))) + +/** + * list_for_each - iterate over a list + * @pos: the &struct list_head to use as a loop counter. + * @head: the head for your list. + */ +#define list_for_each(pos, head) \ + for (pos = (head)->next; pos != (head); pos = pos->next) + +/** + * list_for_each_safe - iterate over a list safe against removal of list entry + * @pos: the &struct list_head to use as a loop counter. + * @n: another &struct list_head to use as temporary storage + * @head: the head for your list. + */ +#define list_for_each_safe(pos, n, head) \ + for (pos = (head)->next, n = pos->next; pos != (head); \ + pos = n, n = pos->next) + +/** + * list_for_each_entry - iterate over list of given type + * @pos: the type * to use as a loop counter. + * @head: the head for your list. + * @member: the name of the list_struct within the struct. + */ +#define list_for_each_entry(pos, head, member) \ + for (pos = list_entry((head)->next, typeof(*pos), member), \ + prefetch(pos->member.next); \ + &pos->member != (head); \ + pos = list_entry(pos->member.next, typeof(*pos), member), \ + prefetch(pos->member.next)) + +/** + * list_for_each_entry_safe - iterate over list of given type safe against removal of list entry + * @pos: the type * to use as a loop counter. + * @n: another type * to use as temporary storage + * @head: the head for your list. + * @member: the name of the list_struct within the struct. + */ +#define list_for_each_entry_safe(pos, n, head, member) \ + for (pos = list_entry((head)->next, typeof(*pos), member), \ + n = list_entry(pos->member.next, typeof(*pos), member); \ + &pos->member != (head); \ + pos = n, n = list_entry(n->member.next, typeof(*n), member)) +#endif /* _LINUX_LIST_H */ + diff --git a/tools/libxc/xc_debug.c b/tools/libxc/xc_debug.c new file mode 100644 index 0000000000..4f0943168e --- /dev/null +++ b/tools/libxc/xc_debug.c @@ -0,0 +1,580 @@ +/* + * xc_debug.c + * + * alex ho + * http://www.cl.cam.ac.uk/netos/pdb + * + * xc_debug_memory_page adapted from xc_ptrace.c + */ + +#include "xc_private.h" +#include "list.h" + +/* from xen/include/asm-x86/processor.h */ +#define X86_EFLAGS_TF 0x00000100 /* Trap Flag */ + +typedef int boolean; +#define true 1 +#define false 0 + + +typedef struct bwcpoint /* break/watch/catch point */ +{ + struct list_head list; + memory_t address; + u32 domain; + u16 vcpu; + u8 old_value; /* old value for software bkpt */ +} bwcpoint_t, *bwcpoint_p; + +static bwcpoint_t bwcpoint_list; + + + +typedef struct domain_context /* local cache of domain state */ +{ + struct list_head list; + u32 domid; + boolean valid[MAX_VIRT_CPUS]; + vcpu_guest_context_t context[MAX_VIRT_CPUS]; + + long total_pages; + unsigned long *page_array; + + unsigned long cr3_phys[MAX_VIRT_CPUS]; + unsigned long *cr3_virt[MAX_VIRT_CPUS]; + unsigned long pde_phys[MAX_VIRT_CPUS]; + unsigned long *pde_virt[MAX_VIRT_CPUS]; + unsigned long page_phys[MAX_VIRT_CPUS]; + unsigned long *page_virt[MAX_VIRT_CPUS]; + int page_perm[MAX_VIRT_CPUS]; +} domain_context_t, *domain_context_p; + +static domain_context_t domain_context_list; + +/* initialization */ + +static boolean xc_debug_initialized = false; + +static __inline__ void +xc_debug_initialize() +{ + if ( !xc_debug_initialized ) + { + memset((void *) &domain_context_list, 0, sizeof(domain_context_t)); + INIT_LIST_HEAD(&domain_context_list.list); + + memset((void *) &bwcpoint_list, 0, sizeof(bwcpoint_t)); + INIT_LIST_HEAD(&bwcpoint_list.list); + + xc_debug_initialized = true; + } +} + +/**************/ + +static domain_context_p +xc_debug_domain_context_search (u32 domid) +{ + struct list_head *entry; + domain_context_p ctxt; + + list_for_each(entry, &domain_context_list.list) + { + ctxt = list_entry(entry, domain_context_t, list); + if ( domid == ctxt->domid ) + return ctxt; + } + return (domain_context_p)NULL; +} + +static __inline__ domain_context_p +xc_debug_get_context (int xc_handle, u32 domid, u32 vcpu) +{ + int rc; + domain_context_p ctxt; + + xc_debug_initialize(); + + if ( (ctxt = xc_debug_domain_context_search(domid)) == NULL) + return NULL; + + if ( !ctxt->valid[vcpu] ) + { + if ( (rc = xc_domain_get_vcpu_context(xc_handle, domid, vcpu, + &ctxt->context[vcpu])) ) + return NULL; + + ctxt->valid[vcpu] = true; + } + + return ctxt; +} + +static __inline__ int +xc_debug_set_context (int xc_handle, domain_context_p ctxt, u32 vcpu) +{ + dom0_op_t op; + int rc; + + if ( !ctxt->valid[vcpu] ) + return -EINVAL; + + op.interface_version = DOM0_INTERFACE_VERSION; + op.cmd = DOM0_SETDOMAININFO; + op.u.setdomaininfo.domain = ctxt->domid; + op.u.setdomaininfo.vcpu = vcpu; + op.u.setdomaininfo.ctxt = &ctxt->context[vcpu]; + + if ( (rc = mlock(&ctxt->context[vcpu], sizeof(vcpu_guest_context_t))) ) + return rc; + + rc = do_dom0_op(xc_handle, &op); + (void) munlock(&ctxt->context[vcpu], sizeof(vcpu_guest_context_t)); + + return rc; +} + +/**************/ + +int +xc_debug_attach(int xc_handle, + u32 domid, + u32 vcpu) +{ + domain_context_p ctxt; + + xc_debug_initialize(); + + if ( (ctxt = malloc(sizeof(domain_context_t))) == NULL ) + return -1; + memset(ctxt, 0, sizeof(domain_context_t)); + + ctxt->domid = domid; + list_add(&ctxt->list, &domain_context_list.list); + + return xc_domain_pause(xc_handle, domid); +} + +int +xc_debug_detach(int xc_handle, + u32 domid, + u32 vcpu) +{ + domain_context_p ctxt; + + xc_debug_initialize(); + + if ( (ctxt = xc_debug_domain_context_search (domid)) == NULL) + return -EINVAL; + + list_del(&ctxt->list); + + if ( ctxt->page_array ) free(ctxt->page_array); + + free(ctxt); + + return xc_domain_unpause(xc_handle, domid); +} + +int +xc_debug_read_registers(int xc_handle, + u32 domid, + u32 vcpu, + cpu_user_regs_t **regs) +{ + domain_context_p ctxt; + int rc = -1; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + if (ctxt) + { + *regs = &ctxt->context[vcpu].user_regs; + rc = 0; + } + + return rc; +} + +int +xc_debug_read_fpregisters (int xc_handle, + u32 domid, + u32 vcpu, + char **regs) +{ + domain_context_p ctxt; + int rc = -1; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + if (ctxt) + { + *regs = ctxt->context[vcpu].fpu_ctxt.x; + rc = 0; + } + + return rc; +} + +int +xc_debug_write_registers(int xc_handle, + u32 domid, + u32 vcpu, + cpu_user_regs_t *regs) +{ + domain_context_p ctxt; + int rc = -1; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + if (ctxt) + { + memcpy(&ctxt->context[vcpu].user_regs, regs, sizeof(cpu_user_regs_t)); + rc = xc_debug_set_context(xc_handle, ctxt, vcpu); + } + + return rc; +} + +int +xc_debug_step(int xc_handle, + u32 domid, + u32 vcpu) +{ + domain_context_p ctxt; + int rc; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + if (!ctxt) return -EINVAL; + + ctxt->context[vcpu].user_regs.eflags |= X86_EFLAGS_TF; + + if ( (rc = xc_debug_set_context(xc_handle, ctxt, vcpu)) ) + return rc; + + ctxt->valid[vcpu] = false; + return xc_domain_unpause(xc_handle, domid); +} + +int +xc_debug_continue(int xc_handle, + u32 domid, + u32 vcpu) +{ + domain_context_p ctxt; + int rc; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + if (!ctxt) return -EINVAL; + + if ( ctxt->context[vcpu].user_regs.eflags & X86_EFLAGS_TF ) + { + ctxt->context[vcpu].user_regs.eflags &= ~X86_EFLAGS_TF; + if ( (rc = xc_debug_set_context(xc_handle, ctxt, vcpu)) ) + return rc; + } + ctxt->valid[vcpu] = false; + return xc_domain_unpause(xc_handle, domid); +} + +/*************************************************/ + +#define vtopdi(va) ((va) >> L2_PAGETABLE_SHIFT) +#define vtopti(va) (((va) >> PAGE_SHIFT) & 0x3ff) + +/* access to one page */ +static int +xc_debug_memory_page (domain_context_p ctxt, int xc_handle, u32 vcpu, + int protection, memory_t address, int length, u8 *buffer) +{ + vcpu_guest_context_t *vcpu_ctxt = &ctxt->context[vcpu]; + unsigned long pde, page; + unsigned long va = (unsigned long)address; + void *ptr; + long pages; + + pages = xc_get_tot_pages(xc_handle, ctxt->domid); + + if ( ctxt->total_pages != pages ) + { + if ( ctxt->total_pages > 0 ) free( ctxt->page_array ); + ctxt->total_pages = pages; + + ctxt->page_array = malloc(pages * sizeof(unsigned long)); + if ( ctxt->page_array == NULL ) + { + printf("Could not allocate memory\n"); + return 0; + } + + if ( xc_get_pfn_list(xc_handle, ctxt->domid, ctxt->page_array,pages) != + pages ) + { + printf("Could not get the page frame list\n"); + return 0; + } + } + + if ( vcpu_ctxt->pt_base != ctxt->cr3_phys[vcpu]) + { + ctxt->cr3_phys[vcpu] = vcpu_ctxt->pt_base; + if ( ctxt->cr3_virt[vcpu] ) + munmap(ctxt->cr3_virt[vcpu], PAGE_SIZE); + ctxt->cr3_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid, + PAGE_SIZE, PROT_READ, ctxt->cr3_phys[vcpu] >> PAGE_SHIFT); + if ( ctxt->cr3_virt[vcpu] == NULL ) + return 0; + } + + + if ( (pde = ctxt->cr3_virt[vcpu][vtopdi(va)]) == 0) /* logical address */ + return 0; + if (ctxt->context[vcpu].flags & VGCF_VMX_GUEST) + pde = ctxt->page_array[pde >> PAGE_SHIFT] << PAGE_SHIFT; + if (pde != ctxt->pde_phys[vcpu]) + { + ctxt->pde_phys[vcpu] = pde; + if ( ctxt->pde_virt[vcpu]) + munmap(ctxt->pde_virt[vcpu], PAGE_SIZE); + ctxt->pde_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid, + PAGE_SIZE, PROT_READ, ctxt->pde_phys[vcpu] >> PAGE_SHIFT); + if ( ctxt->pde_virt[vcpu] == NULL ) + return 0; + } + + if ((page = ctxt->pde_virt[vcpu][vtopti(va)]) == 0) /* logical address */ + return 0; + if (ctxt->context[vcpu].flags & VGCF_VMX_GUEST) + page = ctxt->page_array[page >> PAGE_SHIFT] << PAGE_SHIFT; + if (page != ctxt->page_phys[vcpu] || protection != ctxt->page_perm[vcpu]) + { + ctxt->page_phys[vcpu] = page; + if (ctxt->page_virt[vcpu]) + munmap(ctxt->page_virt[vcpu], PAGE_SIZE); + ctxt->page_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid, + PAGE_SIZE, protection, ctxt->page_phys[vcpu] >> PAGE_SHIFT); + if ( ctxt->page_virt[vcpu] == NULL ) + { + printf("cr3 %lx pde %lx page %lx pti %lx\n", + vcpu_ctxt->pt_base, pde, page, vtopti(va)); + ctxt->page_phys[vcpu] = 0; + return 0; + } + ctxt->page_perm[vcpu] = protection; + } + + ptr = (void *)( (unsigned long)ctxt->page_virt[vcpu] | + (va & ~PAGE_MASK) ); + + if ( protection & PROT_WRITE ) + { + memcpy(ptr, buffer, length); + } + else + { + memcpy(buffer, ptr, length); + } + + return length; +} + +/* divide a memory operation into accesses to individual pages */ +static int +xc_debug_memory_op (domain_context_p ctxt, int xc_handle, u32 vcpu, + int protection, memory_t address, int length, u8 *buffer) +{ + int remain; /* number of bytes to touch past this page */ + int bytes = 0; + + while ( (remain = (address + length - 1) - (address | (PAGE_SIZE-1))) > 0) + { + bytes += xc_debug_memory_page(ctxt, xc_handle, vcpu, protection, + address, length - remain, buffer); + buffer += (length - remain); + length = remain; + address = (address | (PAGE_SIZE - 1)) + 1; + } + + bytes += xc_debug_memory_page(ctxt, xc_handle, vcpu, protection, + address, length, buffer); + + return bytes; +} + +int +xc_debug_read_memory(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length, + u8 *data) +{ + domain_context_p ctxt; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + + xc_debug_memory_op(ctxt, xc_handle, vcpu, PROT_READ, + address, length, data); + + return 0; +} + +int +xc_debug_write_memory(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length, + u8 *data) +{ + domain_context_p ctxt; + + xc_debug_initialize(); + + ctxt = xc_debug_get_context(xc_handle, domid, vcpu); + xc_debug_memory_op(ctxt, xc_handle, vcpu, PROT_READ | PROT_WRITE, + + address, length, data); + + return 0; +} + +int +xc_debug_insert_memory_breakpoint(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length) +{ + bwcpoint_p bkpt; + u8 breakpoint_opcode = 0xcc; + + printf("insert breakpoint %d:%lx %d\n", + domid, address, length); + + xc_debug_initialize(); + + bkpt = malloc(sizeof(bwcpoint_t)); + if ( bkpt == NULL ) + { + printf("error: breakpoint length should be 1\n"); + return -1; + } + + if ( length != 1 ) + { + printf("error: breakpoint length should be 1\n"); + free(bkpt); + return -1; + } + + bkpt->address = address; + bkpt->domain = domid; + + xc_debug_read_memory(xc_handle, domid, vcpu, address, 1, + &bkpt->old_value); + + xc_debug_write_memory(xc_handle, domid, vcpu, address, 1, + &breakpoint_opcode); + + list_add(&bkpt->list, &bwcpoint_list.list); + + printf("breakpoint_set %d:%lx 0x%x\n", + domid, address, bkpt->old_value); + + return 0; +} + +int +xc_debug_remove_memory_breakpoint(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length) +{ + bwcpoint_p bkpt = NULL; + + printf ("remove breakpoint %d:%lx\n", + domid, address); + + struct list_head *entry; + list_for_each(entry, &bwcpoint_list.list) + { + bkpt = list_entry(entry, bwcpoint_t, list); + if ( domid == bkpt->domain && address == bkpt->address ) + break; + } + + if (bkpt == &bwcpoint_list || bkpt == NULL) + { + printf ("error: no breakpoint found\n"); + return -1; + } + + list_del(&bkpt->list); + + xc_debug_write_memory(xc_handle, domid, vcpu, address, 1, + &bkpt->old_value); + + free(bkpt); + return 0; +} + +int +xc_debug_query_domain_stop(int xc_handle, int *dom_list, int dom_list_size) +{ + xc_dominfo_t *info; + u32 first_dom = 0; + int max_doms = 1024; + int nr_doms, loop; + int count = 0; + + if ( (info = malloc(max_doms * sizeof(xc_dominfo_t))) == NULL ) + return -ENOMEM; + + nr_doms = xc_domain_getinfo(xc_handle, first_dom, max_doms, info); + + for (loop = 0; loop < nr_doms; loop++) + { + printf ("domid: %d", info[loop].domid); + printf (" %c%c%c%c%c%c", + info[loop].dying ? 'D' : '-', + info[loop].crashed ? 'C' : '-', + info[loop].shutdown ? 'S' : '-', + info[loop].paused ? 'P' : '-', + info[loop].blocked ? 'B' : '-', + info[loop].running ? 'R' : '-'); + printf (" pages: %ld, vcpus %d", + info[loop].nr_pages, info[loop].vcpus); + printf ("\n"); + + if ( info[loop].paused && count < dom_list_size) + { + dom_list[count++] = info[loop].domid; + } + } + + free(info); + + return count; +} + +/* + * Local variables: + * mode: C + * c-set-style: "BSD" + * c-basic-offset: 4 + * tab-width: 4 + * indent-tabs-mode: nil + * End: + */ diff --git a/tools/libxc/xc_debug.h b/tools/libxc/xc_debug.h new file mode 100644 index 0000000000..ffce175f51 --- /dev/null +++ b/tools/libxc/xc_debug.h @@ -0,0 +1,76 @@ +/* + * xc_debug.h + * + * alex ho + * http://www.cl.cam.ac.uk/netos/pdb + * + */ + +#ifndef _XC_DEBUG_H_DEFINED +#define _XC_DEBUG_H_DEFINED + +int xc_debug_attach(int xc_handle, + u32 domid, + u32 vcpu); + +int xc_debug_detach(int xc_handle, + u32 domid, + u32 vcpu); + +int xc_debug_read_registers(int xc_handle, + u32 domid, + u32 vcpu, + cpu_user_regs_t **regs); + +int xc_debug_read_fpregisters (int xc_handle, + u32 domid, + u32 vcpu, + char **regs); + +int xc_debug_write_registers(int xc_handle, + u32 domid, + u32 vcpu, + cpu_user_regs_t *regs); + +int xc_debug_step(int xc_handle, + u32 domid, + u32 vcpu); + +int xc_debug_continue(int xc_handle, + u32 domid, + u32 vcpu); + +int xc_debug_read_memory(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length, + u8 *data); + + +int xc_debug_write_memory(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length, + u8 *data); + + +int xc_debug_insert_memory_breakpoint(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length); + +int xc_debug_remove_memory_breakpoint(int xc_handle, + u32 domid, + u32 vcpu, + memory_t address, + u32 length); + +int xc_debug_query_domain_stop(int xc_handle, + int *dom_list, + int dom_list_size); + + +#endif /* _XC_DEBUG_H_DEFINED */ diff --git a/tools/pdb/Domain.ml b/tools/pdb/Domain.ml new file mode 100644 index 0000000000..700699a958 --- /dev/null +++ b/tools/pdb/Domain.ml @@ -0,0 +1,63 @@ +(** Domain.ml + * + * domain context implementation + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +open Int32 +open Intel + +type context_t = +{ + mutable domain : int; + mutable execution_domain : int +} + +let default_context = { domain = 0; execution_domain = 0 } + +let new_context dom exec_dom = {domain = dom; execution_domain = exec_dom} + +let set_domain ctx value = + ctx.domain <- value; + print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain) + +let set_execution_domain ctx value = + ctx.execution_domain <- value; + print_endline (Printf.sprintf "ctx.execution_domain <- %d" + ctx.execution_domain) + +let get_domain ctx = + ctx.domain + +let get_execution_domain ctx = + ctx.execution_domain + +let string_of_context ctx = + Printf.sprintf "{domain} domain: %d, execution_domain: %d" + ctx.domain ctx.execution_domain + +external read_registers : context_t -> registers = "read_registers" +external write_register : context_t -> register -> int32 -> unit = + "write_register" +external read_memory : context_t -> int32 -> int -> int list = + "read_memory" +external write_memory : context_t -> int32 -> int list -> unit = + "write_memory" + +external continue : context_t -> unit = "continue_target" +external step : context_t -> unit = "step_target" + +external insert_memory_breakpoint : context_t -> int32 -> int -> unit = + "insert_memory_breakpoint" +external remove_memory_breakpoint : context_t -> int32 -> int -> unit = + "remove_memory_breakpoint" + +external attach_debugger : int -> int -> unit = "attach_debugger" +external detach_debugger : int -> int -> unit = "detach_debugger" +external pause_target : int -> unit = "pause_target" + +let pause ctx = + pause_target ctx.domain diff --git a/tools/pdb/Domain.mli b/tools/pdb/Domain.mli new file mode 100644 index 0000000000..456d19489d --- /dev/null +++ b/tools/pdb/Domain.mli @@ -0,0 +1,38 @@ +(** Domain.mli + * + * domain context interface + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +open Int32 +open Intel + +type context_t + +val default_context : context_t +val new_context : int -> int -> context_t + +val set_domain : context_t -> int -> unit +val get_domain : context_t -> int +val set_execution_domain : context_t -> int -> unit +val get_execution_domain : context_t -> int + +val string_of_context : context_t -> string + +val read_registers : context_t -> registers +val write_register : context_t -> register -> int32 -> unit +val read_memory : context_t -> int32 -> int -> int list +val write_memory : context_t -> int32 -> int list -> unit + +val continue : context_t -> unit +val step : context_t -> unit + +val insert_memory_breakpoint : context_t -> int32 -> int -> unit +val remove_memory_breakpoint : context_t -> int32 -> int -> unit + +val attach_debugger : int -> int -> unit +val detach_debugger : int -> int -> unit +val pause : context_t -> unit diff --git a/tools/pdb/Intel.ml b/tools/pdb/Intel.ml new file mode 100644 index 0000000000..d82ef8b527 --- /dev/null +++ b/tools/pdb/Intel.ml @@ -0,0 +1,71 @@ +(** Intel.ml + * + * various sundry Intel x86 definitions + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + + +type register = + | EBX + | ECX + | EDX + | ESI + | EDI + | EBP + | EAX + | Error_code + | Entry_vector + | EIP + | CS + | EFLAGS + | ESP + | SS + | ES + | DS + | FS + | GS + +type registers = + { ebx : int32; + ecx : int32; + edx : int32; + esi : int32; + edi : int32; + ebp : int32; + eax : int32; + error_code : int32; + entry_vector : int32; + eip : int32; + cs : int32; + eflags : int32; + esp : int32; + ss : int32; + es : int32; + ds : int32; + fs : int32; + gs : int32 + } + +let null_registers = + { ebx = 0l; + ecx = 0l; + edx = 0l; + esi = 0l; + edi = 0l; + ebp = 0l; + eax = 0l; + error_code = 0l; + entry_vector = 0l; + eip = 0l; + cs = 0l; + eflags = 0l; + esp = 0l; + ss = 0l; + es = 0l; + ds = 0l; + fs = 0l; + gs = 0l + } diff --git a/tools/pdb/Makefile b/tools/pdb/Makefile new file mode 100644 index 0000000000..562b21ccf6 --- /dev/null +++ b/tools/pdb/Makefile @@ -0,0 +1,54 @@ +OCAMLMAKEFILE = OCamlMakefile + +XEN_ROOT = ../.. +include $(XEN_ROOT)/tools/Rules.mk + +# overwrite LDFLAGS from xen/tool/Rules.mk +# otherwise, ocamlmktop gets confused. +LDFLAGS = + +OCAML_ROOT=/usr/local +# force ocaml 3.08 +# OCAML_ROOT = /anfs/nos1/ach61/ocaml + +OCAMLC = $(OCAML_ROOT)/bin/ocamlc +OCAMLMKTOP = $(OCAML_ROOT)/bin/ocamlmktop +OCAMLLIBPATH= $(OCAML_ROOT)/lib/ocaml + +INCLUDES += -I $(XEN_XC) +INCLUDES += -I $(XEN_LIBXC) +INCLUDES += -I $(OCAML_ROOT)/lib/ocaml + +CFLAGS += $(INCLUDES) +CFLAGS += -Wall +CFLAGS += -Werror +CFLAGS += -g + +CLIBS += xc +CLIBS += xutil +CLIBS += pdb + +LIBDIRS += $(XEN_LIBXC) +LIBDIRS += $(XEN_LIBXUTIL) +LIBDIRS += . + +LIBS += unix str + +PRE_TARGETS = libpdb.a + +all : bc + +libpdb.a : pdb_xen.o + ar rc $@ $^ + ranlib $@ + +SOURCES += pdb_caml_xc.c pdb_xen.c +SOURCES += Util.ml Intel.ml +SOURCES += evtchn.ml evtchn.mli +SOURCES += Domain.ml Process.ml +SOURCES += Domain.mli Process.mli +SOURCES += PDB.ml debugger.ml server.ml +RESULT = pdb + +include $(OCAMLMAKEFILE) + diff --git a/tools/pdb/OCamlMakefile b/tools/pdb/OCamlMakefile new file mode 100644 index 0000000000..0c6d23ab00 --- /dev/null +++ b/tools/pdb/OCamlMakefile @@ -0,0 +1,1149 @@ +########################################################################### +# OCamlMakefile +# Copyright (C) 1999-2004 Markus Mottl +# +# For updates see: +# http://www.oefai.at/~markus/ocaml_sources +# +# $Id: OCamlMakefile,v 1.1 2005/05/19 09:30:48 root Exp $ +# +########################################################################### + +# Modified by damien for .glade.ml compilation + +# Set these variables to the names of the sources to be processed and +# the result variable. Order matters during linkage! + +ifndef SOURCES + SOURCES := foo.ml +endif +export SOURCES + +ifndef RES_CLIB_SUF + RES_CLIB_SUF := _stubs +endif +export RES_CLIB_SUF + +ifndef RESULT + RESULT := foo +endif +export RESULT + +export LIB_PACK_NAME + +ifndef DOC_FILES + DOC_FILES := $(filter %.mli, $(SOURCES)) +endif +export DOC_FILES + +export BCSUFFIX +export NCSUFFIX + +ifndef TOPSUFFIX + TOPSUFFIX := .top +endif +export TOPSUFFIX + +# Eventually set include- and library-paths, libraries to link, +# additional compilation-, link- and ocamlyacc-flags +# Path- and library information needs not be written with "-I" and such... +# Define THREADS if you need it, otherwise leave it unset (same for +# USE_CAMLP4)! + +export THREADS +export VMTHREADS +export ANNOTATE +export USE_CAMLP4 + +export INCDIRS +export LIBDIRS +export EXTLIBDIRS +export RESULTDEPS +export OCAML_DEFAULT_DIRS + +export LIBS +export CLIBS + +export OCAMLFLAGS +export OCAMLNCFLAGS +export OCAMLBCFLAGS + +export OCAMLLDFLAGS +export OCAMLNLDFLAGS +export OCAMLBLDFLAGS + +ifndef OCAMLCPFLAGS + OCAMLCPFLAGS := a +endif + +export OCAMLCPFLAGS + +export PPFLAGS + +export YFLAGS +export IDLFLAGS + +export OCAMLDOCFLAGS + +export OCAMLFIND_INSTFLAGS + +export DVIPSFLAGS + +export STATIC + +# Add a list of optional trash files that should be deleted by "make clean" +export TRASH + +#################### variables depending on your OCaml-installation + +ifdef MINGW + export MINGW + WIN32 := 1 + CFLAGS_WIN32 := -mno-cygwin +endif +ifdef MSVC + export MSVC + WIN32 := 1 + ifndef STATIC + CPPFLAGS_WIN32 := -DCAML_DLL + endif + CFLAGS_WIN32 += -nologo + EXT_OBJ := obj + EXT_LIB := lib + ifeq ($(CC),gcc) + # work around GNU Make default value + ifdef THREADS + CC := cl -MT + else + CC := cl + endif + endif + ifeq ($(CXX),g++) + # work around GNU Make default value + CXX := $(CC) + endif + CFLAG_O := -Fo +endif +ifdef WIN32 + EXT_CXX := cpp + EXE := .exe +endif + +ifndef EXT_OBJ + EXT_OBJ := o +endif +ifndef EXT_LIB + EXT_LIB := a +endif +ifndef EXT_CXX + EXT_CXX := cc +endif +ifndef EXE + EXE := # empty +endif +ifndef CFLAG_O + CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! +endif + +export CC +export CXX +export CFLAGS +export CXXFLAGS +export LDFLAGS +export CPPFLAGS + +ifndef RPATH_FLAG + RPATH_FLAG := -R +endif +export RPATH_FLAG + +ifndef MSVC +ifndef PIC_CFLAGS + PIC_CFLAGS := -fPIC +endif +ifndef PIC_CPPFLAGS + PIC_CPPFLAGS := -DPIC +endif +endif + +export PIC_CFLAGS +export PIC_CPPFLAGS + +BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) +NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) +TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) + +ifndef OCAMLFIND + OCAMLFIND := ocamlfind +endif +export OCAMLFIND + +ifndef OCAMLC + OCAMLC := ocamlc +endif +export OCAMLC + +ifndef OCAMLOPT + OCAMLOPT := ocamlopt +endif +export OCAMLOPT + +ifndef OCAMLMKTOP + OCAMLMKTOP := ocamlmktop +endif +export OCAMLMKTOP + +ifndef OCAMLCP + OCAMLCP := ocamlcp +endif +export OCAMLCP + +ifndef OCAMLDEP + OCAMLDEP := ocamldep +endif +export OCAMLDEP + +ifndef OCAMLLEX + OCAMLLEX := ocamllex +endif +export OCAMLLEX + +ifndef OCAMLYACC + OCAMLYACC := ocamlyacc +endif +export OCAMLYACC + +ifndef OCAMLMKLIB + OCAMLMKLIB := ocamlmklib +endif +export OCAMLMKLIB + +ifndef OCAML_GLADECC + OCAML_GLADECC := lablgladecc2 +endif +export OCAML_GLADECC + +ifndef OCAML_GLADECC_FLAGS + OCAML_GLADECC_FLAGS := +endif +export OCAML_GLADECC_FLAGS + +ifndef CAMELEON_REPORT + CAMELEON_REPORT := report +endif +export CAMELEON_REPORT + +ifndef CAMELEON_REPORT_FLAGS + CAMELEON_REPORT_FLAGS := +endif +export CAMELEON_REPORT_FLAGS + +ifndef CAMELEON_ZOGGY + CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo +endif +export CAMELEON_ZOGGY + +ifndef CAMELEON_ZOGGY_FLAGS + CAMELEON_ZOGGY_FLAGS := +endif +export CAMELEON_ZOGGY_FLAGS + +ifndef OXRIDL + OXRIDL := oxridl +endif +export OXRIDL + +ifndef CAMLIDL + CAMLIDL := camlidl +endif +export CAMLIDL + +ifndef CAMLIDLDLL + CAMLIDLDLL := camlidldll +endif +export CAMLIDLDLL + +ifndef NOIDLHEADER + MAYBE_IDL_HEADER := -header +endif +export NOIDLHEADER + +export NO_CUSTOM + +ifndef CAMLP4 + CAMLP4 := camlp4 +endif +export CAMLP4 + +ifndef REAL_OCAMLFIND + ifdef PACKS + ifndef CREATE_LIB + ifdef THREADS + PACKS += threads + endif + endif + empty := + space := $(empty) $(empty) + comma := , + ifdef PREDS + PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) + PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) + OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) + # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) + OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) + OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) + else + OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) + OCAML_DEP_PACKAGES := + endif + OCAML_FIND_LINKPKG := -linkpkg + REAL_OCAMLFIND := $(OCAMLFIND) + endif +endif + +export OCAML_FIND_PACKAGES +export OCAML_DEP_PACKAGES +export OCAML_FIND_LINKPKG +export REAL_OCAMLFIND + +ifndef OCAMLDOC + OCAMLDOC := ocamldoc +endif +export OCAMLDOC + +ifndef LATEX + LATEX := latex +endif +export LATEX + +ifndef DVIPS + DVIPS := dvips +endif +export DVIPS + +ifndef PS2PDF + PS2PDF := ps2pdf +endif +export PS2PDF + +ifndef OCAMLMAKEFILE + OCAMLMAKEFILE := OCamlMakefile +endif +export OCAMLMAKEFILE + +ifndef OCAMLLIBPATH + OCAMLLIBPATH := \ + $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) +endif +export OCAMLLIBPATH + +ifndef OCAML_LIB_INSTALL + OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib +endif +export OCAML_LIB_INSTALL + +########################################################################### + +#################### change following sections only if +#################### you know what you are doing! + +# delete target files when a build command fails +.PHONY: .DELETE_ON_ERROR +.DELETE_ON_ERROR: + +# for pedants using "--warn-undefined-variables" +export MAYBE_IDL +export REAL_RESULT +export CAMLIDLFLAGS +export THREAD_FLAG +export RES_CLIB +export MAKEDLL +export ANNOT_FLAG +export C_OXRIDL +export SUBPROJS +export CFLAGS_WIN32 +export CPPFLAGS_WIN32 + +INCFLAGS := + +SHELL := /bin/sh + +MLDEPDIR := ._d +BCDIDIR := ._bcdi +NCDIDIR := ._ncdi + +FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade + +FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) +SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) + +FILTERED_REP := $(filter %.rep, $(FILTERED)) +DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) +AUTO_REP := $(FILTERED_REP:.rep=.ml) + +FILTERED_ZOG := $(filter %.zog, $(FILTERED)) +DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) +AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) + +FILTERED_GLADE := $(filter %.glade, $(FILTERED)) +DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) +AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) + +FILTERED_ML := $(filter %.ml, $(FILTERED)) +DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) + +FILTERED_MLI := $(filter %.mli, $(FILTERED)) +DEP_MLI := $(FILTERED_MLI:.mli=.di) + +FILTERED_MLL := $(filter %.mll, $(FILTERED)) +DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) +AUTO_MLL := $(FILTERED_MLL:.mll=.ml) + +FILTERED_MLY := $(filter %.mly, $(FILTERED)) +DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) +AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) + +FILTERED_IDL := $(filter %.idl, $(FILTERED)) +DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) +C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) +ifndef NOIDLHEADER + C_IDL += $(FILTERED_IDL:.idl=.h) +endif +OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) +AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) + +FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) +DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) +AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) + +FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) +OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) +OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) + +PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) + +ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) + +MLDEPS := $(filter %.d, $(ALL_DEPS)) +MLIDEPS := $(filter %.di, $(ALL_DEPS)) +BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) +NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) + +ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) + +IMPLO_INTF := $(ALLML:%.mli=%.mli.__) +IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ + $(basename $(file)).cmi $(basename $(file)).cmo) +IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) +IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) + +IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) + +INTF := $(filter %.cmi, $(IMPLO_INTF)) +IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) +IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) +IMPL_ASM := $(IMPL_CMO:.cmo=.asm) +IMPL_S := $(IMPL_CMO:.cmo=.s) + +OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) +OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) + +EXECS := $(addsuffix $(EXE), \ + $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) +ifdef WIN32 + EXECS += $(BCRESULT).dll $(NCRESULT).dll +endif + +CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) +ifneq ($(strip $(OBJ_LINK)),) + RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) +endif + +ifdef WIN32 +DLLSONAME := $(CLIB_BASE).dll +else +DLLSONAME := dll$(CLIB_BASE).so +endif + +NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ + $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ + $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ + $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ + $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ + $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o + +ifndef STATIC + NONEXECS += $(DLLSONAME) +endif + +ifndef LIBINSTALL_FILES + LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ + $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + LIBINSTALL_FILES += $(DLLSONAME) + endif + endif +endif + +export LIBINSTALL_FILES + +ifdef WIN32 + # some extra stuff is created while linking DLLs + NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib +endif + +TARGETS := $(EXECS) $(NONEXECS) + +# If there are IDL-files +ifneq ($(strip $(FILTERED_IDL)),) + MAYBE_IDL := -cclib -lcamlidl +endif + +ifdef USE_CAMLP4 + CAMLP4PATH := \ + $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) + INCFLAGS := -I $(CAMLP4PATH) + CINCFLAGS := -I$(CAMLP4PATH) +endif + +DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) +INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %) +CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) + +ifndef MSVC +CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ + $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \ + $(OCAML_DEFAULT_DIRS:%=-L%) +endif + +ifndef PROFILING + INTF_OCAMLC := $(OCAMLC) +else + ifndef THREADS + INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) + else + # OCaml does not support profiling byte code + # with threads (yet), therefore we force an error. + ifndef REAL_OCAMLC + $(error Profiling of multithreaded byte code not yet supported by OCaml) + endif + INTF_OCAMLC := $(OCAMLC) + endif +endif + +ifndef MSVC +COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ + $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ + $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \ + $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) +else +COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ + $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ + $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " +endif + +CLIBS_OPTS := $(CLIBS:%=-cclib -l%) +ifdef MSVC + ifndef STATIC + # MSVC libraries do not have 'lib' prefix + CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) + endif +endif + +ifneq ($(strip $(OBJ_LINK)),) + ifdef CREATE_LIB + OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) + else + OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) + endif +else + OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) +endif + +# If we have to make byte-code +ifndef REAL_OCAMLC + BYTE_OCAML := y + + # EXTRADEPS is added dependencies we have to insert for all + # executable files we generate. Ideally it should be all of the + # libraries we use, but it's hard to find the ones that get searched on + # the path since I don't know the paths built into the compiler, so + # just include the ones with slashes in their names. + EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) + + REAL_OCAMLC := $(INTF_OCAMLC) + + REAL_IMPL := $(IMPL_CMO) + REAL_IMPL_INTF := $(IMPLO_INTF) + IMPL_SUF := .cmo + + DEPFLAGS := + MAKE_DEPS := $(MLDEPS) $(BCDEPIS) + + ifdef CREATE_LIB + CFLAGS := $(PIC_CFLAGS) $(CFLAGS) + CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + MAKEDLL := $(DLLSONAME) + ALL_LDFLAGS := -dllib $(DLLSONAME) + endif + endif + endif + + ifndef NO_CUSTOM + ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" + ALL_LDFLAGS += -custom + endif + endif + + ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ + $(COMMON_LDFLAGS) $(LIBS:%=%.cma) + CAMLIDLDLLFLAGS := + + ifdef THREADS + ifdef VMTHREADS + THREAD_FLAG := -vmthread + else + THREAD_FLAG := -thread + endif + ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) + ifndef CREATE_LIB + ifndef REAL_OCAMLFIND + ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) + endif + endif + endif + +# we have to make native-code +else + EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + ifndef PROFILING + SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) + PLDFLAGS := + else + SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) + PLDFLAGS := -p + endif + + REAL_IMPL := $(IMPL_CMX) + REAL_IMPL_INTF := $(IMPLX_INTF) + IMPL_SUF := .cmx + + CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) + + DEPFLAGS := -native + MAKE_DEPS := $(MLDEPS) $(NCDEPIS) + + ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ + $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) + CAMLIDLDLLFLAGS := -opt + + ifndef CREATE_LIB + ALL_LDFLAGS += $(LIBS:%=%.cmxa) + else + CFLAGS := $(PIC_CFLAGS) $(CFLAGS) + CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) + endif + + ifdef THREADS + THREAD_FLAG := -thread + ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) + ifndef CREATE_LIB + ifndef REAL_OCAMLFIND + ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) + endif + endif + endif +endif + +export MAKE_DEPS + +ifdef ANNOTATE + ANNOT_FLAG := -dtypes +else +endif + +ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) + +ifdef make_deps + -include $(MAKE_DEPS) + PRE_TARGETS := +endif + +########################################################################### +# USER RULES + +# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. +QUIET=@ + +# generates byte-code (default) +byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bc: byte-code + +byte-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bcnl: byte-code-nolink + +top: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes + +# generates native-code + +native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +nc: native-code + +native-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncnl: native-code-nolink + +# generates byte-code libraries +byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" \ + CREATE_LIB=yes \ + make_deps=yes +bcl: byte-code-library + +# generates native-code libraries +native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +ncl: native-code-library + +ifdef WIN32 +# generates byte-code dll +byte-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).dll \ + REAL_RESULT="$(BCRESULT)" \ + make_deps=yes +bcd: byte-code-dll + +# generates native-code dll +native-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).dll \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncd: native-code-dll +endif + +# generates byte-code with debugging information +debug-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dc: debug-code + +debug-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcnl: debug-code-nolink + +# generates byte-code libraries with debugging information +debug-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + CREATE_LIB=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcl: debug-code-library + +# generates byte-code for profiling +profiling-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + make_deps=yes +pbc: profiling-byte-code + +# generates native-code + +profiling-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PROFILING="y" \ + make_deps=yes +pnc: profiling-native-code + +# generates byte-code libraries +profiling-byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + CREATE_LIB=yes \ + make_deps=yes +pbcl: profiling-byte-code-library + +# generates native-code libraries +profiling-native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" PROFILING="y" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +pncl: profiling-native-code-library + +# packs byte-code objects +pack-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ + REAL_RESULT="$(BCRESULT)" \ + PACK_LIB=yes make_deps=yes +pabc: pack-byte-code + +# packs native-code objects +pack-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(NCRESULT).cmx $(NCRESULT).o \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PACK_LIB=yes make_deps=yes +panc: pack-native-code + +# generates HTML-documentation +htdoc: doc/$(RESULT)/html + +# generates Latex-documentation +ladoc: doc/$(RESULT)/latex + +# generates PostScript-documentation +psdoc: doc/$(RESULT)/latex/doc.ps + +# generates PDF-documentation +pdfdoc: doc/$(RESULT)/latex/doc.pdf + +# generates all supported forms of documentation +doc: htdoc ladoc psdoc pdfdoc + +########################################################################### +# LOW LEVEL RULES + +$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ + $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ + $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) + +nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) + +ifdef WIN32 +$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) + $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ + -o $@ $(REAL_IMPL) +endif + +%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ + $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ + $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) + +.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ + .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \ + .rep .zog .glade + +ifndef STATIC +ifdef MINGW +$(DLLSONAME): $(OBJ_LINK) + $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ + -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ + $(OCAMLLIBPATH)/ocamlrun.a \ + -Wl,--export-all-symbols \ + -Wl,--no-whole-archive +else +ifdef MSVC +$(DLLSONAME): $(OBJ_LINK) + link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ + $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ + $(OCAMLLIBPATH)/ocamlrun.lib + +else +$(DLLSONAME): $(OBJ_LINK) + $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ + -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ + $(OCAMLMKLIB_FLAGS) +endif +endif +endif + +ifndef LIB_PACK_NAME +$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ + $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) +else +ifdef BYTE_OCAML +$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL) +else +$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL) +endif + +$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ + $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx +endif + +$(RES_CLIB): $(OBJ_LINK) +ifndef MSVC + ifneq ($(strip $(OBJ_LINK)),) + $(AR) rcs $@ $(OBJ_LINK) + endif +else + ifneq ($(strip $(OBJ_LINK)),) + lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) + endif +endif + +.mli.cmi: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + else \ + echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + fi + +.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(ALL_OCAMLCFLAGS) $<; \ + else \ + echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ + fi + +ifdef PACK_LIB +$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(REAL_IMPL) +endif + +.PRECIOUS: %.ml +%.ml: %.mll + $(OCAMLLEX) $< + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.mly + $(OCAMLYACC) $(YFLAGS) $< + $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ + if [ ! -z "$$pp" ]; then \ + mv $*.ml $*.ml.temporary; \ + echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ + cat $*.ml.temporary >> $*.ml; \ + rm $*.ml.temporary; \ + mv $*.mli $*.mli.temporary; \ + echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ + cat $*.mli.temporary >> $*.mli; \ + rm $*.mli.temporary; \ + fi + + +.PRECIOUS: %.ml +%.ml: %.rep + $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< + +.PRECIOUS: %.ml +%.ml: %.zog + $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ + +.PRECIOUS: %.ml +%.ml: %.glade + $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.oxridl + $(OXRIDL) $< + +.PRECIOUS: %.ml %.mli %_stubs.c %.h +%.ml %.mli %_stubs.c %.h: %.idl + $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ + $(CAMLIDLFLAGS) $< + $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi + +.c.$(EXT_OBJ): + $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ + $(CPPFLAGS) $(CPPFLAGS_WIN32) \ + $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< + +.$(EXT_CXX).$(EXT_OBJ): + $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ + -I'$(OCAMLLIBPATH)' \ + $< $(CFLAG_O)$@ + +$(MLDEPDIR)/%.d: %.ml + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ + $(DINCFLAGS) $< > $@; \ + else \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ + -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ + fi + +$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \ + else \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ + -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ + fi + +doc/$(RESULT)/html: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ + $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ + else \ + echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \ + $(INCFLAGS) $(DOC_FILES); \ + $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \ + $(INCFLAGS) $(DOC_FILES); \ + fi + +doc/$(RESULT)/latex: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \ + $(DOC_FILES) -o $@/doc.tex; \ + $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \ + -o $@/doc.tex; \ + else \ + echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \ + $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ + $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \ + $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ + fi + +doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex + cd doc/$(RESULT)/latex && \ + $(LATEX) doc.tex && \ + $(LATEX) doc.tex && \ + $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) + +doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps + cd doc/$(RESULT)/latex && $(PS2PDF) $(<F) + +define make_subproj +.PHONY: +subproj_$(1): + $$(eval $$(call PROJ_$(1))) + $(QUIET)if [ "$(SUBTARGET)" != "all" ]; then \ + $(MAKE) -f $(OCAMLMAKEFILE) $(SUBTARGET); \ + fi +endef + +$(foreach subproj,$(SUBPROJS),$(eval $(call make_subproj,$(subproj)))) + +.PHONY: +subprojs: $(SUBPROJS:%=subproj_%) + +########################################################################### +# (UN)INSTALL RULES FOR LIBRARIES + +.PHONY: libinstall +libinstall: all + $(QUIET)printf "\nInstalling library with ocamlfind\n" + $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META $(LIBINSTALL_FILES) + $(QUIET)printf "\nInstallation successful.\n" + +.PHONY: libuninstall +libuninstall: + $(QUIET)printf "\nUninstalling library with ocamlfind\n" + $(OCAMLFIND) remove $(OCAMLFIND_INSTFLAGS) $(RESULT) + $(QUIET)printf "\nUninstallation successful.\n" + +.PHONY: rawinstall +rawinstall: all + $(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n" + -install -d $(OCAML_LIB_INSTALL) + for i in $(LIBINSTALL_FILES); do \ + if [ -f $$i ]; then \ + install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \ + fi; \ + done + $(QUIET)printf "\nInstallation successful.\n" + +.PHONY: rawuninstall +rawuninstall: + $(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n" + cd $(OCAML_LIB_INSTALL) && rm $(notdir $(LIBINSTALL_FILES)) + $(QUIET)printf "\nUninstallation successful.\n" + +########################################################################### +# MAINTAINANCE RULES + +.PHONY: clean +clean:: + rm -f $(TARGETS) $(TRASH) + rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR) + +.PHONY: cleanup +cleanup:: + rm -f $(NONEXECS) $(TRASH) + rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR) + +.PHONY: clean-doc +clean-doc:: + rm -rf doc + +.PHONY: nobackup +nobackup: + rm -f *.bak *~ *.dup diff --git a/tools/pdb/PDB.ml b/tools/pdb/PDB.ml new file mode 100644 index 0000000000..0ed121b7aa --- /dev/null +++ b/tools/pdb/PDB.ml @@ -0,0 +1,180 @@ +(** PDB.ml + * + * Dispatch debugger commands to the appropriate context + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +exception Unimplemented of string +exception Unknown_context of string +exception Unknown_domain + +type context_t = + | Void + | Event_channel + | Domain of Domain.context_t + | Process of Process.context_t + +let string_of_context ctx = + match ctx with + | Void -> "{void}" + | Event_channel -> "{event channel}" + | Domain d -> Domain.string_of_context d + | Process p -> Process.string_of_context p + + + +let read_registers ctx = + match ctx with + | Domain d -> Domain.read_registers d + | _ -> Intel.null_registers + +let write_register ctx register value = + match ctx with + | Domain d -> Domain.write_register d register value + | _ -> raise (Unimplemented "write register") + + +let read_memory ctx addr len = + match ctx with + | Domain d -> Domain.read_memory d addr len + | _ -> raise (Unimplemented "read memory") + +let write_memory ctx addr values = + match ctx with + | Domain d -> Domain.write_memory d addr values + | _ -> raise (Unimplemented "write memory") + + +let continue ctx = + match ctx with + | Domain d -> Domain.continue d + | _ -> raise (Unimplemented "continue") + +let step ctx = + match ctx with + | Domain d -> Domain.step d + | _ -> raise (Unimplemented "step") + + +let insert_memory_breakpoint ctx addr len = + match ctx with + | Domain d -> Domain.insert_memory_breakpoint d addr len + | _ -> raise (Unimplemented "insert memory breakpoint") + +let remove_memory_breakpoint ctx addr len = + match ctx with + | Domain d -> Domain.remove_memory_breakpoint d addr len + | _ -> raise (Unimplemented "remove memory breakpoint") + + +let pause ctx = + match ctx with + | Domain d -> Domain.pause d + | _ -> raise (Unimplemented "pause target") + + +let attach_debugger ctx = + match ctx with + | Domain d -> Domain.attach_debugger (Domain.get_domain d) + (Domain.get_execution_domain d) + | _ -> raise (Unimplemented "attach debugger") + +let detach_debugger ctx = + match ctx with + | Domain d -> Domain.detach_debugger (Domain.get_domain d) + (Domain.get_execution_domain d) + | _ -> raise (Unimplemented "detach debugger") + +external open_debugger : unit -> unit = "open_context" +external close_debugger : unit -> unit = "close_context" + +(* this is just the domains right now... expand to other contexts later *) +external debugger_status : unit -> unit = "debugger_status" + + +(***********************************************************) + + +let hash = Hashtbl.create 10 + +let debug_contexts () = + print_endline "context list:"; + let print_context key ctx = + match ctx with + | Void -> print_endline (Printf.sprintf " [%s] {void}" + (Util.get_connection_info key)) + | Event_channel -> print_endline (Printf.sprintf " [%s] {event_channel}" + (Util.get_connection_info key)) + | Process p -> print_endline (Printf.sprintf " [%s] %s" + (Util.get_connection_info key) + (Process.string_of_context p)) + | Domain d -> print_endline (Printf.sprintf " [%s] %s" + (Util.get_connection_info key) + (Domain.string_of_context d)) + in + Hashtbl.iter print_context hash + +(** add_context : add a new context to the hash table. + * if there is an existing context for the same key then it + * is first removed implictly by the hash table replace function. + *) +let add_context (key:Unix.file_descr) context params = + match context with + | "void" -> Hashtbl.replace hash key Void + | "event channel" -> Hashtbl.replace hash key Event_channel + | "domain" -> + begin + match params with + | dom::exec_dom::_ -> + let d = Domain(Domain.new_context dom exec_dom) in + attach_debugger d; + Hashtbl.replace hash key d + | _ -> failwith "bogus parameters to domain context" + end + | "process" -> + begin + match params with + | dom::pid::_ -> + let p = Process.new_context dom pid in + Hashtbl.replace hash key (Process(p)) + | _ -> failwith "bogus parameters to process context" + end + | _ -> raise (Unknown_context context) + +let add_default_context sock = + add_context sock "void" [] + +let find_context key = + try + Hashtbl.find hash key + with + Not_found -> + print_endline "error: (find_context) PDB context not found"; + raise Not_found + +let delete_context key = + Hashtbl.remove hash key + +(** find_domain : Locate the context(s) matching a particular domain + * and execution_domain pair. + *) + +let find_domain dom exec_dom = + let find key ctx list = + match ctx with + | Domain d -> + if (((Domain.get_domain d) = dom) && + ((Domain.get_execution_domain d) = exec_dom)) + then + key :: list + else + list + | _ -> list + in + let sock_list = Hashtbl.fold find hash [] in + match sock_list with + | hd::tl -> hd + | [] -> raise Unknown_domain diff --git a/tools/pdb/Process.ml b/tools/pdb/Process.ml new file mode 100644 index 0000000000..79632b3298 --- /dev/null +++ b/tools/pdb/Process.ml @@ -0,0 +1,39 @@ +(** Process.ml + * + * process context implementation + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +open Int32 +open Intel + +type context_t = +{ + mutable domain : int; + mutable process : int; +} + +let default_context = { domain = 0; process = 0 } + +let new_context dom proc = { domain = dom; process = proc } + +let string_of_context ctx = + Printf.sprintf "{process} domain: %d, process: %d" + ctx.domain ctx.process + +let set_domain ctx value = + ctx.domain <- value; + print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain) + +let set_process ctx value = + ctx.process <- value; + print_endline (Printf.sprintf "ctx.process <- %d" ctx.process) + +let get_domain ctx = + ctx.domain + +let get_process ctx = + ctx.process diff --git a/tools/pdb/Process.mli b/tools/pdb/Process.mli new file mode 100644 index 0000000000..39b6221892 --- /dev/null +++ b/tools/pdb/Process.mli @@ -0,0 +1,20 @@ +(** Process.mli + * + * process context interface + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +type context_t + +val default_context : context_t +val new_context : int -> int -> context_t + +val set_domain : context_t -> int -> unit +val get_domain : context_t -> int +val set_process : context_t -> int -> unit +val get_process : context_t -> int + +val string_of_context : context_t -> string diff --git a/tools/pdb/Util.ml b/tools/pdb/Util.ml new file mode 100644 index 0000000000..a5722242db --- /dev/null +++ b/tools/pdb/Util.ml @@ -0,0 +1,153 @@ +(** Util.ml + * + * various utility functions + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +let int_of_hexchar h = + let i = int_of_char h in + match h with + | '0' .. '9' -> i - (int_of_char '0') + | 'a' .. 'f' -> i - (int_of_char 'a') + 10 + | 'A' .. 'F' -> i - (int_of_char 'A') + 10 + | _ -> raise (Invalid_argument "unknown hex character") + +let hexchar_of_int i = + let hexchars = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; + '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f' |] + in + hexchars.(i) + + +(** flip the bytes of a four byte int + *) + +let flip_int num = + let a = num mod 256 + and b = (num / 256) mod 256 + and c = (num / (256 * 256)) mod 256 + and d = (num / (256 * 256 * 256)) in + (a * 256 * 256 * 256) + (b * 256 * 256) + (c * 256) + d + + +let flip_int32 num = + let a = Int32.logand num 0xffl + and b = Int32.logand (Int32.shift_right_logical num 8) 0xffl + and c = Int32.logand (Int32.shift_right_logical num 16) 0xffl + and d = (Int32.shift_right_logical num 24) in + (Int32.logor + (Int32.logor (Int32.shift_left a 24) (Int32.shift_left b 16)) + (Int32.logor (Int32.shift_left c 8) d)) + + +let int_list_of_string_list list = + List.map (fun x -> int_of_string x) list + +let int_list_of_string str len = + let array_of_string s = + let int_array = Array.make len 0 in + for loop = 0 to len - 1 do + int_array.(loop) <- (Char.code s.[loop]); + done; + int_array + in + Array.to_list (array_of_string str) + + +(* remove leading and trailing whitespace from a string *) + +let chomp str = + let head = Str.regexp "^[ \t\r\n]+" in + let tail = Str.regexp "[ \t\r\n]+$" in + let str = Str.global_replace head "" str in + Str.global_replace tail "" str + +(* Stupid little parser for "<key>=<value>[,<key>=<value>]*" + It first chops the entire command at each ',', so no ',' in key or value! + Mucked to return a list of words for "value" + *) + +let list_of_string str = + let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in + let str_list = Str.split (delim " ") str in + List.map (fun x -> chomp(x)) str_list + +let little_parser fn str = + let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in + let str_list = Str.split (delim ",") str in + let pair s = + match Str.split (delim "=") s with + | [key;value] -> fn (chomp key) (list_of_string value) + | [key] -> fn (chomp key) [] + | _ -> failwith (Printf.sprintf "error: (little_parser) parse error [%s]" str) + in + List.iter pair str_list + +(* boolean list membership test *) +let not_list_member the_list element = + try + List.find (fun x -> x = element) the_list; + false + with + Not_found -> true + +(* a very inefficient way to remove the elements of one list from another *) +let list_remove the_list remove_list = + List.filter (not_list_member remove_list) the_list + +(* get a description of a file descriptor *) +let get_connection_info fd = + let get_local_info fd = + let sockname = Unix.getsockname fd in + match sockname with + | Unix.ADDR_UNIX(s) -> s + | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^ + (string_of_int p)) + and get_remote_info fd = + let sockname = Unix.getpeername fd in + match sockname with + | Unix.ADDR_UNIX(s) -> s + | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^ + (string_of_int p)) + in + try + get_remote_info fd + with + | Unix.Unix_error (Unix.ENOTSOCK, s1, s2) -> + let s = Unix.fstat fd in + Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino + | _ -> get_local_info fd + + +(* really write a string *) +let really_write fd str = + let strlen = String.length str in + let sent = ref 0 in + while (!sent < strlen) do + sent := !sent + (Unix.write fd str !sent (strlen - !sent)) + done + +let write_character fd ch = + let str = String.create 1 in + str.[0] <- ch; + really_write fd str + + + +let send_reply fd reply = + let checksum = ref 0 in + write_character fd '$'; + for loop = 0 to (String.length reply) - 1 do + write_character fd reply.[loop]; + checksum := !checksum + int_of_char reply.[loop] + done; + write_character fd '#'; + write_character fd (hexchar_of_int ((!checksum mod 256) / 16)); + write_character fd (hexchar_of_int ((!checksum mod 256) mod 16)) + (* + * BUG NEED TO LISTEN FOR REPLY +/- AND POSSIBLY RE-TRANSMIT + *) + diff --git a/tools/pdb/debugger.ml b/tools/pdb/debugger.ml new file mode 100644 index 0000000000..5a3002470b --- /dev/null +++ b/tools/pdb/debugger.ml @@ -0,0 +1,315 @@ +(** debugger.ml + * + * main debug functionality + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +open Intel +open PDB +open Util +open Str + +(** a few debugger commands such as step 's' and continue 'c' do + * not immediately return a response to the debugger. in these + * cases we raise No_reply instead. + *) +exception No_reply + +let initialize_debugger () = + () + +let exit_debugger () = + () + + +(** + Detach Command + Note: response is ignored by gdb. We leave the context in the + hash. It will be cleaned up with the socket is closed. + *) +let gdb_detach ctx = + PDB.detach_debugger ctx; + raise No_reply + +(** + Kill Command + Note: response is ignored by gdb. We leave the context in the + hash. It will be cleaned up with the socket is closed. + *) +let gdb_kill () = + "" + + + +(** + Continue Command. + resume the target + *) +let gdb_continue ctx = + PDB.continue ctx; + raise No_reply + +(** + Step Command. + single step the target + *) +let gdb_step ctx = + PDB.step ctx; + raise No_reply + + +(** + Read Registers Command. + returns 16 4-byte registers in a particular defined by gdb. + *) +let gdb_read_registers ctx = + let regs = PDB.read_registers ctx in + let str = + (Printf.sprintf "%08lx" (Util.flip_int32 regs.eax)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.ecx)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.edx)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebx)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.esp)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebp)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.esi)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.edi)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.eip)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.eflags)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.cs)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.ss)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.ds)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.es)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.fs)) ^ + (Printf.sprintf "%08lx" (Util.flip_int32 regs.gs)) in + str + +(** + Set Thread Command + *) +let gdb_set_thread command = + "OK" + + +(** + Read Memory Packets + *) +let gdb_read_memory ctx command = + let int_list_to_string i str = + (Printf.sprintf "%02x" i) ^ str + in + let read_mem addr len = + try + let mem = PDB.read_memory ctx addr len in + List.fold_right int_list_to_string mem "" + with + Failure s -> "E02" + in + Scanf.sscanf command "m%lx,%d" read_mem + + + +(** + Write Memory Packets + *) +let gdb_write_memory ctx command = + let write_mem addr len = + print_endline (Printf.sprintf " gdb_write_memory %lx %x\n" addr len); + print_endline (Printf.sprintf " [[ unimplemented ]]\n") + in + Scanf.sscanf command "M%lx,%d" write_mem; + "OK" + + + +(** + Write Register Packets + *) +let gdb_write_register ctx command = + let write_reg reg goofy_val = + let new_val = Util.flip_int32 goofy_val in + match reg with + | 0 -> PDB.write_register ctx EAX new_val + | 1 -> PDB.write_register ctx ECX new_val + | 2 -> PDB.write_register ctx EDX new_val + | 3 -> PDB.write_register ctx EBX new_val + | 4 -> PDB.write_register ctx ESP new_val + | 5 -> PDB.write_register ctx EBP new_val + | 6 -> PDB.write_register ctx ESI new_val + | 7 -> PDB.write_register ctx EDI new_val + | 8 -> PDB.write_register ctx EIP new_val + | 9 -> PDB.write_register ctx EFLAGS new_val + | 10 -> PDB.write_register ctx CS new_val + | 11 -> PDB.write_register ctx SS new_val + | 12 -> PDB.write_register ctx DS new_val + | 13 -> PDB.write_register ctx ES new_val + | 14 -> PDB.write_register ctx FS new_val + | 15 -> PDB.write_register ctx GS new_val + | _ -> print_endline (Printf.sprintf "write unknown register [%d]" reg) + in + Scanf.sscanf command "P%x=%lx" write_reg; + "OK" + + +(** + General Query Packets + *) +let gdb_query command = + match command with + | "qC" -> "" + | "qOffsets" -> "" + | "qSymbol::" -> "" + | _ -> + print_endline (Printf.sprintf "unknown gdb query packet [%s]" command); + "E01" + + +(** + Write Memory Binary Packets + *) +let gdb_write_memory_binary ctx command = + let write_mem addr len = + let pos = Str.search_forward (Str.regexp ":") command 0 in + let txt = Str.string_after command (pos + 1) in + PDB.write_memory ctx addr (int_list_of_string txt len) + in + Scanf.sscanf command "X%lx,%d" write_mem; + "OK" + + + +(** + Last Signal Command + *) +let gdb_last_signal = + "S00" + + + + +(** + Process PDB extensions to the GDB serial protocol. + Changes the mutable context state. + *) +let pdb_extensions command sock = + let process_extension key value = + (* since this command can change the context, we need to grab it each time *) + let ctx = PDB.find_context sock in + match key with + | "status" -> + print_endline (string_of_context ctx); + PDB.debug_contexts (); + debugger_status () + | "context" -> + PDB.add_context sock (List.hd value) + (int_list_of_string_list (List.tl value)) + | _ -> failwith (Printf.sprintf "unknown pdb extension command [%s:%s]" + key (List.hd value)) + in + try + Util.little_parser process_extension + (String.sub command 1 ((String.length command) - 1)); + "OK" + with + | Unknown_context s -> + print_endline (Printf.sprintf "unknown context [%s]" s); + "E01" + | Failure s -> "E01" + + +(** + Insert Breakpoint or Watchpoint Packet + *) +let gdb_insert_bwcpoint ctx command = + let insert cmd addr length = + try + match cmd with + | 0 -> PDB.insert_memory_breakpoint ctx addr length; "OK" + | _ -> "" + with + Failure s -> "E03" + in + Scanf.sscanf command "Z%d,%lx,%d" insert + +(** + Remove Breakpoint or Watchpoint Packet + *) +let gdb_remove_bwcpoint ctx command = + let insert cmd addr length = + try + match cmd with + | 0 -> PDB.remove_memory_breakpoint ctx addr length; "OK" + | _ -> "" + with + Failure s -> "E04" + in + Scanf.sscanf command "z%d,%lx,%d" insert + +(** + Do Work! + + @param command char list + *) + +let process_command command sock = + let ctx = PDB.find_context sock in + try + match command.[0] with + | 'c' -> gdb_continue ctx + | 'D' -> gdb_detach ctx + | 'g' -> gdb_read_registers ctx + | 'H' -> gdb_set_thread command + | 'k' -> gdb_kill () + | 'm' -> gdb_read_memory ctx command + | 'M' -> gdb_write_memory ctx command + | 'P' -> gdb_write_register ctx command + | 'q' -> gdb_query command + | 's' -> gdb_step ctx + | 'x' -> pdb_extensions command sock + | 'X' -> gdb_write_memory_binary ctx command + | '?' -> gdb_last_signal + | 'z' -> gdb_remove_bwcpoint ctx command + | 'Z' -> gdb_insert_bwcpoint ctx command + | _ -> + print_endline (Printf.sprintf "unknown gdb command [%s]" command); + "" + with + Unimplemented s -> + print_endline (Printf.sprintf "loser. unimplemented command [%s][%s]" + command s); + "" + + +(** + process_evtchn + + This is called each time a virq_pdb is sent from xen to dom 0. + It is sent by Xen when a domain hits a breakpoint. + + Think of this as the continuation function for a "c" or "s" command. +*) + +external query_domain_stop : unit -> (int * int) list = "query_domain_stop" +(* returns a list of paused domains : () -> (domain, vcpu) list *) + +let process_evtchn fd = + let channel = Evtchn.read fd in + let find_pair (dom, vcpu) = + print_endline (Printf.sprintf "checking %d.%d" dom vcpu); + try + let sock = PDB.find_domain dom vcpu in + true + with + Unknown_domain -> false + in + let dom_list = query_domain_stop () in + let (dom, vcpu) = List.find find_pair dom_list in + let vec = 3 in + let sock = PDB.find_domain dom vcpu in + print_endline (Printf.sprintf "handle bkpt d:%d ed:%d v:%d %s" + dom vcpu vec (Util.get_connection_info sock)); + Util.send_reply sock "S05"; + Evtchn.unmask fd channel (* allow next virq *) + diff --git a/tools/pdb/evtchn.ml b/tools/pdb/evtchn.ml new file mode 100644 index 0000000000..5443accd9b --- /dev/null +++ b/tools/pdb/evtchn.ml @@ -0,0 +1,32 @@ +(** evtchn.ml + * + * event channel interface + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +let dev_name = "/dev/xen/evtchn" (* EVTCHN_DEV_NAME *) +let dev_major = 10 (* EVTCHN_DEV_MAJOR *) +let dev_minor = 201 (* EVTCHN_DEV_MINOR *) + +let virq_pdb = 6 (* as defined VIRQ_PDB *) + +external bind_virq : int -> int = "evtchn_bind_virq" +external bind : Unix.file_descr -> int -> unit = "evtchn_bind" +external unbind : Unix.file_descr -> int -> unit = "evtchn_unbind" +external ec_open : string -> int -> int -> Unix.file_descr = "evtchn_open" +external read : Unix.file_descr -> int = "evtchn_read" +external ec_close : Unix.file_descr -> unit = "evtchn_close" +external unmask : Unix.file_descr -> int -> unit = "evtchn_unmask" + +let setup () = + let port = bind_virq virq_pdb in + let fd = ec_open dev_name dev_major dev_minor in + bind fd port; + fd + +let teardown fd = + unbind fd virq_pdb; + ec_close fd diff --git a/tools/pdb/evtchn.mli b/tools/pdb/evtchn.mli new file mode 100644 index 0000000000..18b3ed667b --- /dev/null +++ b/tools/pdb/evtchn.mli @@ -0,0 +1,14 @@ +(** evtchn.mli + * + * event channel interface + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + + +val setup : unit -> Unix.file_descr +val read : Unix.file_descr -> int +val teardown : Unix.file_descr -> unit +val unmask : Unix.file_descr -> int -> unit diff --git a/tools/pdb/pdb_caml_xc.c b/tools/pdb/pdb_caml_xc.c new file mode 100644 index 0000000000..b25f528c65 --- /dev/null +++ b/tools/pdb/pdb_caml_xc.c @@ -0,0 +1,732 @@ +/* + * pdb_caml_xc.c + * + * http://www.cl.cam.ac.uk/netos/pdb + * + * OCaml to libxc interface library for PDB + */ + +#include <xc.h> +#include <xc_debug.h> +#include <errno.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <sys/mman.h> +#include <caml/alloc.h> +#include <caml/fail.h> +#include <caml/memory.h> +#include <caml/mlvalues.h> + +int pdb_evtchn_bind_virq (int xc_handle, int virq, int *port); +int xen_evtchn_bind (int evtchn_fd, int idx); +int xen_evtchn_unbind (int evtchn_fd, int idx); + +/* this order comes from xen/include/public/arch-x86_32.h */ +enum x86_registers { PDB_EBX, PDB_ECX, PDB_EDX, PDB_ESI, PDB_EDI, + PDB_EBP, PDB_EAX, PDB_Error_code, PDB_Entry_vector, + PDB_EIP, PDB_CS, PDB_EFLAGS, PDB_ESP, PDB_SS, + PDB_ES, PDB_DS, PDB_FS, PDB_GS }; + +static void dump_regs (cpu_user_regs_t *ctx); + +static int xc_handle = -1; + +typedef struct +{ + int domain; + int vcpu; +} context_t; + +#define decode_context(_ctx, _ocaml) \ +{ \ + (_ctx)->domain = Int_val(Field((_ocaml),0)); \ + (_ctx)->vcpu = Int_val(Field((_ocaml),1)); \ +} + +#define encode_context(_ctx, _ocaml) \ +{ \ + (_ocaml) = caml_alloc_tuple(2); \ + Store_field((_ocaml), 0, Val_int((_ctx)->domain)); \ + Store_field((_ocaml), 1, Val_int((_ctx)->vcpu)); \ +} + + +/****************************************************************************/ + +/* + * open_context : unit -> unit + */ +value +open_context (value unit) +{ + CAMLparam1(unit); + + xc_handle = xc_interface_open(); + + if ( xc_handle < 0 ) + { + fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n", + errno, strerror(errno)); + } + + CAMLreturn(Val_unit); +} + +/* + * close_context : unit -> unit + */ +value +close_context (value unit) +{ + CAMLparam1(unit); + int rc; + + if ( (rc = xc_interface_close(xc_handle)) < 0 ) + { + fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n", + errno, strerror(errno)); + } + + CAMLreturn(Val_unit); +} + +/* + * read_registers : context_t -> int32 + */ +value +read_registers (value context) +{ + CAMLparam1(context); + CAMLlocal1(result); + + cpu_user_regs_t *regs; + context_t ctx; + + decode_context(&ctx, context); + + if ( xc_debug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) ) + { + printf("(pdb) read registers error!\n"); fflush(stdout); + failwith("read registers error"); + } + + dump_regs(regs); + + result = caml_alloc_tuple(18); /* FIXME */ + + Store_field(result, 0, caml_copy_int32(regs->ebx)); + Store_field(result, 1, caml_copy_int32(regs->ecx)); + Store_field(result, 2, caml_copy_int32(regs->edx)); + Store_field(result, 3, caml_copy_int32(regs->esi)); + Store_field(result, 4, caml_copy_int32(regs->edi)); + Store_field(result, 5, caml_copy_int32(regs->ebp)); + Store_field(result, 6, caml_copy_int32(regs->eax)); + Store_field(result, 7, caml_copy_int32(regs->error_code)); /* 16 */ + Store_field(result, 8, caml_copy_int32(regs->entry_vector)); /* 16 */ + Store_field(result, 9, caml_copy_int32(regs->eip)); + Store_field(result, 10, caml_copy_int32(regs->cs)); /* 16 */ + Store_field(result, 11, caml_copy_int32(regs->eflags)); + Store_field(result, 12, caml_copy_int32(regs->esp)); + Store_field(result, 13, caml_copy_int32(regs->ss)); /* 16 */ + Store_field(result, 14, caml_copy_int32(regs->es)); /* 16 */ + Store_field(result, 15, caml_copy_int32(regs->ds)); /* 16 */ + Store_field(result, 16, caml_copy_int32(regs->fs)); /* 16 */ + Store_field(result, 17, caml_copy_int32(regs->gs)); /* 16 */ + + CAMLreturn(result); +} + + +/* + * write_register : context_t -> register -> int32 -> unit + */ +value +write_register (value context, value reg, value newval) +{ + CAMLparam3(context, reg, newval); + + int my_reg = Int_val(reg); + int val = Int32_val(newval); + + context_t ctx; + cpu_user_regs_t *regs; + + printf("(pdb) write register\n"); + + decode_context(&ctx, context); + + if ( xc_debug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) ) + { + printf("(pdb) write register (get) error!\n"); fflush(stdout); + failwith("write register error"); + } + + switch (my_reg) + { + case PDB_EBX: regs->ebx = val; break; + case PDB_ECX: regs->ecx = val; break; + case PDB_EDX: regs->edx = val; break; + case PDB_ESI: regs->esi = val; break; + case PDB_EDI: regs->edi = val; break; + + case PDB_EBP: regs->ebp = val; break; + case PDB_EAX: regs->eax = val; break; + case PDB_Error_code: regs->error_code = val; break; + case PDB_Entry_vector: regs->entry_vector = val; break; + + case PDB_EIP: regs->eip = val; break; + case PDB_CS: regs->cs = val; break; + case PDB_EFLAGS: regs->eflags = val; break; + case PDB_ESP: regs->esp = val; break; + case PDB_SS: regs->ss = val; break; + case PDB_ES: regs->es = val; break; + case PDB_DS: regs->ds = val; break; + case PDB_FS: regs->fs = val; break; + case PDB_GS: regs->gs = val; break; + } + + if ( xc_debug_write_registers(xc_handle, ctx.domain, ctx.vcpu, regs) ) + { + printf("(pdb) write register (set) error!\n"); fflush(stdout); + failwith("write register error"); + } + + CAMLreturn(Val_unit); +} + +/* + * read_memory : context_t -> int32 -> int -> int + */ +value +read_memory (value context, value address, value length) +{ + CAMLparam3(context, address, length); + CAMLlocal2(result, temp); + + context_t ctx; + int loop; + char *buffer; + memory_t my_address = Int32_val(address); + u32 my_length = Int_val(length); + + printf ("(pdb) read memory\n"); + + decode_context(&ctx, context); + + buffer = malloc(my_length); + if (buffer == NULL) + { + printf("(pdb) read memory: malloc failed.\n"); fflush(stdout); + failwith("read memory error"); + } + + if ( xc_debug_read_memory(xc_handle, ctx.domain, ctx.vcpu, + my_address, my_length, buffer) ) + { + printf("(pdb) read memory error!\n"); fflush(stdout); + failwith("read memory error"); + } + + result = caml_alloc(2,0); + if ( my_length > 0 ) /* car */ + { + Store_field(result, 0, Val_int(buffer[my_length - 1] & 0xff)); + } + else + + { + Store_field(result, 0, Val_int(0)); + } + Store_field(result, 1, Val_int(0)); /* cdr */ + + for (loop = 1; loop < my_length; loop++) + { + temp = result; + result = caml_alloc(2,0); + Store_field(result, 0, Val_int(buffer[my_length - loop - 1] & 0xff)); + Store_field(result, 1, temp); + } + + CAMLreturn(result); +} + +/* + * write_memory : context_t -> int32 -> int list -> unit + */ +value +write_memory (value context, value address, value val_list) +{ + CAMLparam3(context, address, val_list); + CAMLlocal1(node); + + context_t ctx; + + char buffer[4096]; /* a big buffer */ + memory_t my_address; + u32 length = 0; + + printf ("(pdb) write memory\n"); + + decode_context(&ctx, context); + + node = val_list; + if ( Int_val(node) == 0 ) /* gdb functionalty test uses empty list */ + { + CAMLreturn(Val_unit); + } + + while ( Int_val(Field(node,1)) != 0 ) + { + buffer[length++] = Int_val(Field(node, 0)); + node = Field(node,1); + } + buffer[length++] = Int_val(Field(node, 0)); + + my_address = (memory_t) Int32_val(address); + + if ( xc_debug_write_memory(xc_handle, ctx.domain, ctx.vcpu, + my_address, length, buffer) ) + { + printf("(pdb) write memory error!\n"); fflush(stdout); + failwith("write memory error"); + } + + CAMLreturn(Val_unit); +} + + +/*********************************************************************/ + +void +dump_regs (cpu_user_regs_t *regs) +{ + printf (" eax: %x\n", regs->eax); + printf (" ecx: %x\n", regs->ecx); + printf (" edx: %x\n", regs->edx); + printf (" ebx: %x\n", regs->ebx); + printf (" esp: %x\n", regs->esp); + printf (" ebp: %x\n", regs->ebp); + printf (" esi: %x\n", regs->esi); + printf (" edi: %x\n", regs->edi); + printf (" eip: %x\n", regs->eip); + printf (" flags: %x\n", regs->eflags); + printf (" cs: %x\n", regs->cs); + printf (" ss: %x\n", regs->ss); + printf (" es: %x\n", regs->es); + printf (" ds: %x\n", regs->ds); + printf (" fs: %x\n", regs->fs); + printf (" gs: %x\n", regs->gs); + + return; +} + +/* + * continue_target : context_t -> unit + */ +value +continue_target (value context) +{ + CAMLparam1(context); + + context_t ctx; + + decode_context(&ctx, context); + + if ( xc_debug_continue(xc_handle, ctx.domain, ctx.vcpu) ) + { + printf("(pdb) continue\n"); fflush(stdout); + failwith("continue"); + } + + CAMLreturn(Val_unit); +} + +/* + * step_target : context_t -> unit + */ +value +step_target (value context) +{ + CAMLparam1(context); + + context_t ctx; + + decode_context(&ctx, context); + + if ( xc_debug_step(xc_handle, ctx.domain, ctx.vcpu) ) + { + printf("(pdb) step\n"); fflush(stdout); + failwith("step"); + } + + CAMLreturn(Val_unit); +} + + + +/* + * insert_memory_breakpoint : context_t -> int32 -> int list -> unit + */ +value +insert_memory_breakpoint (value context, value address, value length) +{ + CAMLparam3(context, address, length); + + context_t ctx; + memory_t my_address = (memory_t) Int32_val(address); + int my_length = Int_val(length); + + decode_context(&ctx, context); + + printf ("(pdb) insert memory breakpoint 0x%lx %d\n", + my_address, my_length); + + if ( xc_debug_insert_memory_breakpoint(xc_handle, ctx.domain, ctx.vcpu, + my_address, my_length) ) + { + printf("(pdb) error: insert memory breakpoint\n"); fflush(stdout); + failwith("insert memory breakpoint"); + } + + + CAMLreturn(Val_unit); +} + +/* + * remove_memory_breakpoint : context_t -> int32 -> int list -> unit + */ +value +remove_memory_breakpoint (value context, value address, value length) +{ + CAMLparam3(context, address, length); + + context_t ctx; + + memory_t my_address = (memory_t) Int32_val(address); + int my_length = Int_val(length); + + printf ("(pdb) remove memory breakpoint 0x%lx %d\n", + my_address, my_length); + + decode_context(&ctx, context); + + if ( xc_debug_remove_memory_breakpoint(xc_handle, + ctx.domain, ctx.vcpu, + my_address, my_length) ) + { + printf("(pdb) error: remove memory breakpoint\n"); fflush(stdout); + failwith("remove memory breakpoint"); + } + + CAMLreturn(Val_unit); +} + +/* + * attach_debugger : int -> int -> unit + */ +value +attach_debugger (value domain, value vcpu) +{ + CAMLparam2(domain, vcpu); + + int my_domain = Int_val(domain); + int my_vcpu = Int_val(vcpu); + + printf ("(pdb) attach domain [%d.%d]\n", my_domain, my_vcpu); + + if ( xc_debug_attach(xc_handle, my_domain, my_vcpu) ) + { + printf("(pdb) attach error!\n"); fflush(stdout); + failwith("attach error"); + } + + CAMLreturn(Val_unit); +} + + +/* + * detach_debugger : int -> int -> unit + */ +value +detach_debugger (value domain, value vcpu) +{ + CAMLparam2(domain, vcpu); + + int my_domain = Int_val(domain); + int my_vcpu = Int_val(vcpu); + + printf ("(pdb) detach domain [%d.%d]\n", my_domain, my_vcpu); + + if ( xc_debug_detach(xc_handle, my_domain, my_vcpu) ) + { + printf("(pdb) detach error!\n"); fflush(stdout); + failwith("detach error"); + } + + CAMLreturn(Val_unit); +} + + +/* + * debugger_status : unit -> unit + */ +value +debugger_status (value unit) +{ + CAMLparam1(unit); + + printf ("(pdb) debugger status\n"); + + CAMLreturn(Val_unit); +} + +/* + * pause_target : int -> unit + */ +value +pause_target (value domid) +{ + CAMLparam1(domid); + + int my_domid = Int_val(domid); + + printf ("(pdb) pause target %d\n", my_domid); + + xc_domain_pause(xc_handle, my_domid); + + CAMLreturn(Val_unit); +} + +/****************************************************************************/ +/****************************************************************************/ + +/* + * query_domain_stop : unit -> (int * int) list + */ +value +query_domain_stop (value unit) +{ + CAMLparam1(unit); + CAMLlocal3(result, temp, node); + + int max_domains = 20; + int dom_list[max_domains]; + int loop, count; + + count = xc_debug_query_domain_stop(xc_handle, dom_list, max_domains); + if ( count < 0 ) + { + printf("(pdb) query domain stop!\n"); fflush(stdout); + failwith("query domain stop"); + } + + printf ("QDS: %d\n", count); + for (loop = 0; loop < count; loop ++) + printf (" %d %d\n", loop, dom_list[loop]); + + result = caml_alloc(2,0); + if ( count > 0 ) /* car */ + { + node = caml_alloc(2,0); + Store_field(node, 0, Val_int(dom_list[0])); /* domain id */ + Store_field(node, 1, Val_int(0)); /* vcpu */ + Store_field(result, 0, node); + } + else + { + Store_field(result, 0, Val_int(0)); + } + Store_field(result, 1, Val_int(0)); /* cdr */ + + for ( loop = 1; loop < count; loop++ ) + { + temp = result; + result = caml_alloc(2,0); + node = caml_alloc(2,0); + Store_field(node, 0, Val_int(dom_list[loop])); /* domain id */ + Store_field(node, 1, Val_int(0)); /* vcpu */ + Store_field(result, 0, node); + Store_field(result, 1, temp); + } + + CAMLreturn(result); +} + +/****************************************************************************/ +/****************************************************************************/ + +#include <errno.h> +#include <sys/ioctl.h> +#include <sys/stat.h> +#include <fcntl.h> +#include <unistd.h> + +/* + * evtchn_open : string -> int -> int -> Unix.file_descr + * + * OCaml's Unix library doesn't have mknod, so it makes more sense just write + * this in C. This code is from Keir/Andy. + */ +value +evtchn_open (value filename, value major, value minor) +{ + CAMLparam3(filename, major, minor); + + char *myfilename = String_val(filename); + int mymajor = Int_val(major); + int myminor = Int_val(minor); + int evtchn_fd; + struct stat st; + + /* Make sure any existing device file links to correct device. */ + if ( (lstat(myfilename, &st) != 0) || + !S_ISCHR(st.st_mode) || + (st.st_rdev != makedev(mymajor, myminor)) ) + { + (void)unlink(myfilename); + } + + reopen: + evtchn_fd = open(myfilename, O_RDWR); + if ( evtchn_fd == -1 ) + { + if ( (errno == ENOENT) && + ((mkdir("/dev/xen", 0755) == 0) || (errno == EEXIST)) && + (mknod(myfilename, S_IFCHR|0600, makedev(mymajor,myminor)) == 0) ) + { + goto reopen; + } + return -errno; + } + + CAMLreturn(Val_int(evtchn_fd)); +} + +/* + * evtchn_bind_virq : int -> int + */ +value +evtchn_bind_virq (value virq) +{ + CAMLparam1(virq); + + int port; + + if ( pdb_evtchn_bind_virq(xc_handle, Int_val(virq), &port) < 0 ) + { + printf("(pdb) evtchn_bind_virq error!\n"); fflush(stdout); + failwith("evtchn_bind_virq error"); + } + + CAMLreturn(Val_int(port)); +} + +/* + * evtchn_bind : Unix.file_descr -> int -> unit + */ +value +evtchn_bind (value fd, value idx) +{ + CAMLparam2(fd, idx); + + int myfd = Int_val(fd); + int myidx = Int_val(idx); + + if ( xen_evtchn_bind(myfd, myidx) < 0 ) + { + printf("(pdb) evtchn_bind error!\n"); fflush(stdout); + failwith("evtchn_bind error"); + } + + CAMLreturn(Val_unit); +} + +/* + * evtchn_unbind : Unix.file_descr -> int -> unit + */ +value +evtchn_unbind (value fd, value idx) +{ + CAMLparam2(fd, idx); + + int myfd = Int_val(fd); + int myidx = Int_val(idx); + + if ( xen_evtchn_unbind(myfd, myidx) < 0 ) + { + printf("(pdb) evtchn_unbind error!\n"); fflush(stdout); + failwith("evtchn_unbind error"); + } + + CAMLreturn(Val_unit); +} + +/* + * evtchn_read : Unix.file_descr -> int + */ +value +evtchn_read (value fd) +{ + CAMLparam1(fd); + + u16 v; + int bytes; + int rc = -1; + int myfd = Int_val(fd); + + while ( (bytes = read(myfd, &v, sizeof(v))) == -1 ) + { + if ( errno == EINTR ) continue; + rc = -errno; + goto exit; + } + + if ( bytes == sizeof(v) ) + rc = v; + + exit: + CAMLreturn(Val_int(rc)); +} + + +/* + * evtchn_close : Unix.file_descr -> unit + */ +value +evtchn_close (value fd) +{ + CAMLparam1(fd); + int myfd = Int_val(fd); + + (void)close(myfd); + + CAMLreturn(Val_unit); +} + +/* + * evtchn_unmask : Unix.file_descr -> int -> unit + */ +value +evtchn_unmask (value fd, value idx) +{ + CAMLparam1(fd); + + int myfd = Int_val(fd); + u16 myidx = Int_val(idx); + + (void)write(myfd, &myidx, sizeof(myidx)); + + CAMLreturn(Val_unit); +} + +/* + * Local variables: + * mode: C + * c-set-style: "BSD" + * c-basic-offset: 4 + * tab-width: 4 + * indent-tabs-mode: nil + * End: + */ + diff --git a/tools/pdb/pdb_xen.c b/tools/pdb/pdb_xen.c new file mode 100644 index 0000000000..36671dacc0 --- /dev/null +++ b/tools/pdb/pdb_xen.c @@ -0,0 +1,93 @@ +/* + * pdb_xen.c + * + * alex ho + * http://www.cl.cam.ac.uk/netos/pdb + * + * PDB interface library for accessing Xen + */ + +#include <xc.h> +#include <stdio.h> +#include <stdlib.h> +#include <errno.h> +#include <string.h> +#include <sys/mman.h> + +int +pdb_open () +{ + int xc_handle = xc_interface_open(); + + if ( xc_handle < 0 ) + { + fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n", + errno, strerror(errno)); + } + return xc_handle; +} + +int +pdb_close (int xc_handle) +{ + int rc; + + + if ( (rc = xc_interface_close(xc_handle)) < 0 ) + { + fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n", + errno, strerror(errno)); + } + return rc; +} + + +int +pdb_evtchn_bind_virq (int xc_handle, int virq, int *port) +{ + int rc; + + if ( (rc = xc_evtchn_bind_virq(xc_handle, virq, port) < 0 ) ) + { + fprintf(stderr, "(pdb) error binding virq to event channel: %d (%s)\n", + errno, strerror(errno)); + } + return rc; +} + + +#include <sys/ioctl.h> + +/* /dev/xen/evtchn ioctls */ +#define EVTCHN_RESET _IO('E', 1) /* clear & reinit buffer */ +#define EVTCHN_BIND _IO('E', 2) /* bind to event channel */ +#define EVTCHN_UNBIND _IO('E', 3) /* unbind from event channel */ + +int +xen_evtchn_bind (int evtchn_fd, int idx) +{ + if ( ioctl(evtchn_fd, EVTCHN_BIND, idx) != 0 ) + return -errno; + + return 0; +} + +int +xen_evtchn_unbind (int evtchn_fd, int idx) +{ + if ( ioctl(evtchn_fd, EVTCHN_UNBIND, idx) != 0 ) + return -errno; + + return 0; +} + + +/* + * Local variables: + * mode: C + * c-set-style: "BSD" + * c-basic-offset: 4 + * tab-width: 4 + * indent-tabs-mode: nil + * End: + */ diff --git a/tools/pdb/server.ml b/tools/pdb/server.ml new file mode 100644 index 0000000000..2d3a3c7c86 --- /dev/null +++ b/tools/pdb/server.ml @@ -0,0 +1,219 @@ +(** server.ml + * + * PDB server main loop + * + * @author copyright (c) 2005 alex ho + * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger + * @version 1 + *) + +open Unix +open Buffer + + +(** + * connection_t: The state for each connection. + * buffer & length contains bytes that have been read from the sock + * but not yet parsed / processed. + *) +type connection_t = +{ + fd : file_descr; + mutable buffer : string; + mutable length : int; +} + + +(** + * validate_checksum: Compute and compare the checksum of a string + * against the provided checksum using the gdb serial protocol algorithm. + * + *) +let validate_checksum command checksum = + let c0 = ref 0 in + for loop = 0 to (String.length command - 1) do + c0 := !c0 + int_of_char(command.[loop]); + done; + if (String.length checksum) = 2 + then + let c1 = Util.int_of_hexchar(checksum.[1]) + + Util.int_of_hexchar(checksum.[0]) * 16 in + (!c0 mod 256) = (c1 mod 256) + else + false + + +(** + * process_input: Oh, joy! Someone sent us a message. Let's open the + * envelope and see what they have to say. + * + * This function is a paradigm of inefficiency; it performs as many + * string copies as possible. + *) +let process_input conn sock = + let max_buffer_size = 1024 in + let in_string = String.create max_buffer_size in + + let length = read sock in_string 0 max_buffer_size in + conn.buffer <- conn.buffer ^ (String.sub in_string 0 length); + conn.length <- conn.length + length; + let re = Str.regexp "[^\\$]*\\$\\([^#]*\\)#\\(..\\)" in + + begin + try + let break = String.index conn.buffer '\003' + 1 in + print_endline (Printf.sprintf "{{%s}}" (String.escaped conn.buffer)); + + (* discard everything seen before the ctrl-c *) + conn.buffer <- String.sub conn.buffer break (conn.length - break); + conn.length <- conn.length - break; + + (* pause the target *) + PDB.pause (PDB.find_context sock); + + (* send a code back to the debugger *) + Util.send_reply sock "S05" + + with + Not_found -> () + end; + + (* with gdb this is unlikely to loop since you ack each packet *) + while ( Str.string_match re conn.buffer 0 ) do + let command = Str.matched_group 1 conn.buffer in + let checksum = Str.matched_group 2 conn.buffer in + let match_end = Str.group_end 2 in + + begin + match validate_checksum command checksum with + | true -> + begin + Util.write_character sock '+'; + try + let reply = Debugger.process_command command sock in + print_endline (Printf.sprintf "[%s] %s -> \"%s\"" + (Util.get_connection_info sock) + (String.escaped command) + (String.escaped reply)); + Util.send_reply sock reply + with + Debugger.No_reply -> + print_endline (Printf.sprintf "[%s] %s -> null" + (Util.get_connection_info sock) + (String.escaped command)) + end + | false -> + Util.write_character sock '-'; + end; + + conn.buffer <- String.sub conn.buffer match_end (conn.length - match_end); + conn.length <- conn.length - match_end; + done; + if length = 0 then raise End_of_file + + + +(** main_server_loop. + * + * connection_hash is a hash (duh!) with one connection_t for each + * open connection. + * + * in_list is a list of active sockets. it also contains two + * magic entries: server_sock for accepting new entries and + * event_sock for Xen event channel asynchronous notifications. + *) +let main_server_loop sockaddr = + let connection_hash = Hashtbl.create 10 + in + let process_socket svr_sock sockets sock = + let (new_list, closed_list) = sockets in + if sock == svr_sock + then + begin + let (new_sock, caller) = accept sock in + print_endline (Printf.sprintf "[%s] new connection from %s" + (Util.get_connection_info sock) + (Util.get_connection_info new_sock)); + Hashtbl.add connection_hash new_sock + {fd=new_sock; buffer=""; length = 0}; + PDB.add_default_context new_sock; + (new_sock :: new_list, closed_list) + end + else + begin + try + match PDB.find_context sock with + | PDB.Event_channel -> + print_endline (Printf.sprintf "[%s] event channel" + (Util.get_connection_info sock)); + Debugger.process_evtchn sock; + (new_list, closed_list) + | _ -> + let conn = Hashtbl.find connection_hash sock in + process_input conn sock; + (new_list, closed_list) + with + | Not_found -> + print_endline "error: (main_svr_loop) context not found"; + PDB.debug_contexts (); + raise Not_found + | End_of_file -> + print_endline (Printf.sprintf "[%s] close connection from %s" + (Util.get_connection_info sock) + (Util.get_connection_info sock)); + PDB.delete_context sock; + Hashtbl.remove connection_hash sock; + close sock; + (new_list, sock :: closed_list) + end + in + let rec helper in_list server_sock = + (* + * List.iter (fun x->Printf.printf "{%s} " + * (Util.get_connection_info x)) in_list; + * Printf.printf "\n"; + *) + let (rd_list, _, _) = select in_list [] [] (-1.0) in + let (new_list, closed_list) = List.fold_left (process_socket server_sock) + ([],[]) rd_list in + let merge_list = Util.list_remove (new_list @ in_list) closed_list in + helper merge_list server_sock + in + try + let server_sock = socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in + setsockopt server_sock SO_REUSEADDR true; + bind server_sock sockaddr; + listen server_sock 2; + + PDB.open_debugger (); + let event_sock = Evtchn.setup () in + PDB.add_context event_sock "event channel" []; + helper [server_sock; event_sock] server_sock + with + | Sys.Break -> + print_endline "break: cleaning up"; + PDB.close_debugger (); + Hashtbl.iter (fun sock conn -> close sock) connection_hash + | Unix_error(e,err,param) -> + Printf.printf "unix error: [%s][%s][%s]\n" (error_message e) err param + | Sys_error s -> Printf.printf "sys error: [%s]\n" s + | Failure s -> Printf.printf "failure: [%s]\n" s + | End_of_file -> Printf.printf "end of file\n" + + +let get_port () = + if (Array.length Sys.argv) = 2 + then + int_of_string Sys.argv.(1) + else + begin + print_endline (Printf.sprintf "syntax error: %s <port>" Sys.argv.(0)); + exit 1 + end + + +let main = + let address = inet_addr_any in + let port = get_port () in + main_server_loop (ADDR_INET(address, port)) + diff --git a/xen/Rules.mk b/xen/Rules.mk index 221882814a..9fef534a8b 100644 --- a/xen/Rules.mk +++ b/xen/Rules.mk @@ -55,6 +55,11 @@ ifeq ($(domu_debug),y) CFLAGS += -DDOMU_DEBUG endif +ifeq ($(pdb),y) +CFLAGS += -g -DPDB_DEBUG +endif + + ifeq ($(crash_debug),y) CFLAGS += -g -DCRASH_DEBUG endif diff --git a/xen/include/asm-x86/debugger.h b/xen/include/asm-x86/debugger.h index 34ff5bdddc..bb5fea1720 100644 --- a/xen/include/asm-x86/debugger.h +++ b/xen/include/asm-x86/debugger.h @@ -80,6 +80,50 @@ static inline int debugger_trap_entry( #define debugger_trap_fatal(_v, _r) (0) #define debugger_trap_immediate() +#elif defined(PDB_DEBUG) + +#include <xen/event.h> +#include <xen/softirq.h> +#include <xen/sched.h> +#include <asm/regs.h> + +static inline int debugger_trap_entry(unsigned int vector, + struct cpu_user_regs *regs) +{ + struct vcpu *vcpu = current; + + if ( !KERNEL_MODE(vcpu, regs) || (vcpu->domain->domain_id == 0) ) + return 0; + + switch ( vector ) + { + case TRAP_debug: + case TRAP_int3: + { + struct vcpu *ptr; + + /* suspend the guest domain */ + for_each_vcpu ( vcpu->domain, ptr ) + { + test_and_set_bit(_VCPUF_ctrl_pause, &ptr->vcpu_flags); + } + sync_lazy_execstate_mask(vcpu->domain->cpumask); /* TLB flush */ + raise_softirq(SCHEDULE_SOFTIRQ); + + /* notify the debugger */ + send_guest_virq(dom0->vcpu[0], VIRQ_PDB); + + return 1; + } + default: + break; + } + + return 0; +} + +#define debugger_trap_fatal(_v, _r) (0) +#define debugger_trap_immediate() #elif 0 diff --git a/xen/include/public/xen.h b/xen/include/public/xen.h index 11f82823a7..624ed65510 100644 --- a/xen/include/public/xen.h +++ b/xen/include/public/xen.h @@ -70,6 +70,7 @@ #define VIRQ_DOM_EXC 3 /* (DOM0) Exceptional event for some domain. */ #define VIRQ_PARITY_ERR 4 /* (DOM0) NMI parity error. */ #define VIRQ_IO_ERR 5 /* (DOM0) NMI I/O error. */ +#define VIRQ_PDB 6 /* (DOM0) PDB */ #define NR_VIRQS 7 /* |