Get the count of all instances in clojure.

all-instances.clj

(import [com.sun.management HotSpotDiagnosticMXBean]
        [java.lang.management ManagementFactory]
        [java.io DataInputStream EOFException]
        [java.nio ByteBuffer])
(require '[clojure.java.io :as io])

(declare ^:dynamic read-id)
(declare ^:dynamic idsize)

(def names (atom {}))
(def class-names (atom {}))
(def instances (atom {}))

(defn heap-dump-tag [tag-value]
  ({0xFF :root-unknown
    0x01 :root-jni-global
    0x02 :root-jni-local
    0x03 :root-java-frame
    0x04 :root-native-stack
    0x05 :root-sticky-class
    0x06 :root-thread-block
    0x07 :root-monitor-used
    0x08 :root-thread-object
    0x20 :class-dump
    0x21 :instance-dump
    0x22 :object-array-dump
    0x23 :primitive-array-dump} tag-value))

(defmulti read-java-value (fn [t in] t))

;; object
(defmethod read-java-value 2 [t in]
  {:value (read-id in) :len idsize})

;; boolean
(defmethod read-java-value 4 [t in]
  {:value (.readBoolean in) :len 1})

;; char
(defmethod read-java-value 5 [t in]
  {:value (.readChar in) :len 2})

;; float
(defmethod read-java-value 6 [t in]
  {:value (.readFloat in) :len 4})

;; double
(defmethod read-java-value 7 [t in]
  {:value (.readDouble in) :len 8})

;; byte
(defmethod read-java-value 8 [t in]
  {:value (.readByte in) :len 1})

;; short
(defmethod read-java-value 9 [t in]
  {:value (.readShort in) :len 2})

;; int
(defmethod read-java-value 10 [t in]
  {:value (.readInt in) :len 4})

;; long
(defmethod read-java-value 11 [t in]
  {:value (.readLong in) :len 8})

(defn parse-const-pool-entries [in]
  (let [num-entries (.readUnsignedShort in)
        readed (atom 2)]
    (dotimes [n num-entries]
      (let [index (.readUnsignedShort in)
            jtype (.readByte in)
            {v :value len :len} (read-java-value jtype in)]
        (swap! readed #(+ % len 3))))
    @readed))

(defn parse-statics [in]
  (let [num-statics (.readUnsignedShort in)
        readed (atom 2)]
    (dotimes [n num-statics]
      (let [name-id (read-id in)
            jtype (.readByte in)
            {v :value len :len} (read-java-value jtype in)]
        (swap! readed #(+ % len 3))))
    @readed))

(defn parse-fields [in]
  (let [num-fields (.readUnsignedShort in)
        readed (atom 2)]
    (dotimes [n num-fields]
      (let [name-id (read-id in)
            jtype (.readByte in)]
        (swap! readed #(+ % 3))))
    @readed))

(defmulti parse-heap-dump :tag)

;; ROOT UNKNOWN
(defmethod parse-heap-dump :root-unknown [data]
  (read-id (data :stream))
  idsize)

;; ROOT JNI GLOBAL
(defmethod parse-heap-dump :root-jni-global [data]
  (let [oid (read-id (data :stream))
        jni-id (read-id (data :stream))]
    (* idsize 2)))

;; ROOT JNI LOCAL
(defmethod parse-heap-dump :root-jni-local [data]
  (let [oid (read-id (data :stream))
        thread-no (.readInt (data :stream))
        frame-no  (.readInt (data :stream))]
    (+ idsize 8)))

;; ROOT JAVA FRAME
(defmethod parse-heap-dump :root-java-frame [data]
  (let [oid (read-id (data :stream))
        thread-no (.readInt (data :stream))
        frame-no  (.readInt (data :stream))]
    (+ idsize 8)))

;; ROOT NATIVE STACK
(defmethod parse-heap-dump :root-native-stack [data]
  (let [oid (read-id (data :stream))
        thread-no (.readInt (data :stream))]
    (+ idsize 4)))

;; ROOT STICKY CLASS
(defmethod parse-heap-dump :root-sticky-class [data]
  (let [oid (read-id (data :stream))]
    idsize))

;; ROOT THREAD BLOCK
(defmethod parse-heap-dump :root-thread-block [data]
  (let [oid (read-id (data :stream))
        thread-no (.readInt (data :stream))]
    (+ idsize 4)))

;; ROOT MONITOR USED
(defmethod parse-heap-dump :root-monitor-used [data]
  (let [oid (read-id (data :stream))]
    idsize))

;; ROOT THREAD OBJECT
(defmethod parse-heap-dump :root-thread-object [data]
  (let [oid (read-id (data :stream))
        thread-no (.readInt (data :stream))
        stacktrace-no  (.readInt (data :stream))]
    (+ idsize 8)))

;; CLASS DUMP
(defmethod parse-heap-dump :class-dump [data]
  (let [oid (read-id (data :stream))
        stacktrace-no (.readInt (data :stream))
        super-id (read-id (data :stream))
        class-loader-id (read-id (data :stream))
        signers-id (read-id (data :stream))
        prot-domain-id (read-id (data :stream))
        reserved1 (read-id (data :stream))
        reserved2 (read-id (data :stream))
        instance-size (.readInt (data :stream))]
    (+ (* 7 idsize) 8
       (parse-const-pool-entries (data :stream))
       (parse-statics (data :stream))
       (parse-fields (data :stream)))))

;; INSTANCE DUMP
(defmethod parse-heap-dump :instance-dump [data]
  (let [oid (read-id (data :stream))
        stacktrace-no (.readInt (data :stream))
        class-id (read-id (data :stream))
        bytes-following (.readInt (data :stream))]
    (swap! instances update-in
           [(@class-names class-id)]
           #(if % (inc %) 1))
    (.skipBytes (data :stream) bytes-following)
    (+ (* idsize 2) 8 bytes-following)))

(defn primitive-size [id]
  (nth [0 0 4 0 1 2 4 8 1 2 4 8] id))

(defn read-array [in primitive?]
  (let [oid (read-id in)
        stacktrace-no (.readInt in)
        ary-num (.readInt in)
        el-class-id (if primitive?
                      (.readByte in)
                      (read-id in))
        el-size (if primitive? (primitive-size el-class-id) idsize)]
    (swap! instances update-in
           [(if primitive? "(primitive array)" (@class-names el-class-id))]
           #(if % (inc %) 1))
    (.skipBytes in (* ary-num el-size))
    (+ idsize 8 (if primitive? 1 idsize) (* ary-num el-size))))

;; OBJ ARRAY DUMP
(defmethod parse-heap-dump :object-array-dump [data]
  (read-array (data :stream) false))

;; PRIMITIVE ARRAY DUMP
(defmethod parse-heap-dump :primitive-array-dump [data]
  (read-array (data :stream) true))

(defmulti parse-data :tag)

(defmethod parse-data 0x01 [data]
  (let [id (read-id (data :stream))
        buf (make-array Byte/TYPE (- (data :size) idsize))]
    (try
      (.readFully (data :stream) buf)
      (swap! names assoc id (String. buf))
      (catch EOFException ex
        (println (data :size))
        (throw ex)))))

(defmethod parse-data 0x02 [data]
  (let [serizl-no (.readInt (data :stream))
        class-id  (read-id (data :stream))
        stacktrace-no (.readInt (data :stream))
        class-name-id (read-id (data :stream))]
    (swap! class-names assoc
           class-id
           (clojure.string/replace (@names class-name-id) #"/" "."))))

(defmethod parse-data 0x0C [data]
  (loop [tag (.readByte (data :stream))
         bytes-left (data :size)]
    (when (> bytes-left 0)
      (let [readed (parse-heap-dump {:tag (heap-dump-tag tag)
                            :stream (data :stream)})]
        (recur 
         (.readByte (data :stream))
         (- bytes-left 1 readed))))))

(defmethod parse-data :default [data]
  (.skipBytes (data :stream) (data :size)))

(let [dump-heap (.getMethod HotSpotDiagnosticMXBean
                            "dumpHeap" (into-array [String Boolean/TYPE]))
      mx-bean  (ManagementFactory/newPlatformMXBeanProxy
                (ManagementFactory/getPlatformMBeanServer)
                "com.sun.management:type=HotSpotDiagnostic"
                HotSpotDiagnosticMXBean)
      hprof-file (io/file (System/getProperty "java.io.tmpdir")
                          (str "clj" (System/currentTimeMillis) ".hprof"))]
  (.invoke dump-heap mx-bean (to-array [(.getAbsolutePath hprof-file) true]))
  (with-open [in (-> (io/input-stream hprof-file)
                     (DataInputStream.))]
    (loop [x (.readByte in)]
      (if (not= x 0)
        (recur (.readByte in))))

    (def idsize (.readInt in))
    (let [high-tm (.readInt in)
          low-tm  (.readInt in)
          cnt (atom {})]
      (def read-id (fn [is]
                     (if (= idsize 4)
                       (.readInt is) (.readLong is))))

      (try (loop [tag  (.readByte in)
                  tm   (.readInt in)
                  size (.readInt in)]
             (parse-data {:tag tag :timestamp tm
                          :size size :stream in})
             (recur (.readByte in) (.readInt in) (.readInt in)))
        (catch EOFException e)
        (finally 
         (println (take 10 (sort #(> (last %1) (last %2)) @instances)))
         (println (reduce + (vals @instances)))))))
  (io/delete-file hprof-file))