Permalink
Browse files

first commit

  • Loading branch information...
0 parents commit 463e4304a4c1046a6c8aa6ad220a0917b61c8d26 @GeorgeJahad committed Jun 24, 2010
Showing with 123 additions and 0 deletions.
  1. +6 −0 .gitignore
  2. +15 −0 README
  3. +4 −0 project.clj
  4. +98 −0 src/com/georgejahad/cdt.clj
@@ -0,0 +1,6 @@
+pom-generated.xml
+Manifest.txt
+cdt.jar
+lib
+classes
+*~
15 README
@@ -0,0 +1,15 @@
+# cdt
+
+FIXME: write description
+
+## Usage
+
+FIXME: write
+
+## Installation
+
+FIXME: write
+
+## License
+
+FIXME: write
@@ -0,0 +1,4 @@
+(defproject cdt "1.0.0-SNAPSHOT"
+ :description "Clojure Debug Toolkit"
+ :dependencies [[org.clojure/clojure "1.2.0-master-SNAPSHOT"]
+ [org.clojure/clojure-contrib "1.2.0-SNAPSHOT"]])
@@ -0,0 +1,98 @@
+(ns com.georgejahad.cdt
+ (:require [clojure.contrib.str-utils2 :as str2])
+ (:use clojure.contrib.pprint)
+ (:import java.util.ArrayList))
+
+;; This handles the fact that tools.jar is a global dependency that
+;; can't really be in a repo:
+(with-out-str (add-classpath (format "file://%s/../lib/tools.jar"
+ (System/getProperty "java.home"))))
+(import com.sun.jdi.Bootstrap
+ com.sun.jdi.request.EventRequest)
+
+(use 'alex-and-georges.debug-repl)
+(defn regex-filter [regex seq]
+ (filter #(re-find regex (.name %)) seq))
+
+(def conn
+ (memoize
+ (fn [] (first (regex-filter #"SocketAttach"
+ (.allConnectors
+ (Bootstrap/virtualMachineManager)))))))
+
+(defonce vm-data (atom nil))
+
+(defn vm [] @vm-data)
+
+(defn cdt-attach [port]
+ (let [args (.defaultArguments (conn))]
+ (.setValue (.get args "port") port)
+ (reset! vm-data (.attach (conn) args))))
+
+(defn find-classes [class-regex]
+ (regex-filter class-regex (.allClasses (vm))))
+
+(defn find-methods [class method-regex]
+ (regex-filter method-regex (.methods class)))
+
+(def rt (memoize (fn [] (first (find-classes #"clojure.lang.RT")))))
+
+(def co (memoize (fn [] (first (find-classes #"clojure.lang.Compiler")))))
+
+(def rstring (memoize (fn [] (first (find-methods (rt) #"readString")))))
+
+(def ev (memoize (fn [] (first (find-methods (co) #"eval")))))
+
+(defonce current-thread (atom nil))
+
+(defn set-current-thread [thread]
+ (reset! current-thread thread))
+
+(defn ct [] @current-thread)
+
+(defn list-threads []
+ (.allThreads (vm)))
+
+(defn print-threads []
+ (pprint (seq (list-threads))))
+
+(defrecord BpSpec [sym methods bps])
+
+(defonce bp-list (atom {}))
+
+(defn merge-with-exception [short-name]
+ (partial merge-with
+ #(throw (IllegalArgumentException.
+ (str "bp-list already contains a " short-name)))))
+(defn create-bp [m]
+ (doto (.createBreakpointRequest
+ (.eventRequestManager (vm)) (.location m))
+ (.setSuspendPolicy EventRequest/SUSPEND_EVENT_THREAD)
+ (.setEnabled true)))
+
+(defn gen-class-pattern [sym]
+ (let [s (str2/replace (str sym) "/" "\\$")]
+ (re-pattern (str "^" s "__\\d*$"))))
+
+(defn get-methods [sym]
+ (for [c (find-classes (gen-class-pattern sym))
+ m (regex-filter #"(invoke|doInvoke)" (.methods c))] m))
+
+(defn set-bp-fn [sym short-name]
+ (let [methods (get-methods sym)
+ k (keyword short-name)
+ bps (map create-bp methods)]
+ (swap! bp-list (merge-with-exception k) {k (BpSpec. sym methods bps)})))
+
+(defmacro set-bp
+ ([sym]
+ (let [short-name (symbol (second (seq (.split (str sym) "/"))))]
+ `(set-bp ~sym ~short-name)))
+ ([sym short-name]
+ `(set-bp-fn '~sym '~short-name)))
+
+(defn delete-bp [short-name]
+ (debug-repl)
+ (doseq [bp (:bps (short-name @bp-list))]
+ (.deleteEventRequest (.eventRequestManager (vm)) bp))
+ (swap! bp-list dissoc short-name))

0 comments on commit 463e430

Please sign in to comment.