cgit.sxemacs.org Git - packages/blob - xemacs-packages/jde/lisp/jde-parse-class.el

   1 ;; JDE-PARSE-CLASS.EL --- Parse a Java class file.
   2 ;; $Revision: 1.9 $ $Date: 2005/01/20 04:53:21 $
   3 ;;
   4 ;; Copyright (C) 2002, 2004, 2005 Andrew Hyatt
   5 ;;
   6 ;; Author: Andrew Hyatt <andy_jde@thehyatts.net>
   7 ;; Maintainers: Andrew Hyatt and Paul Kinnucan
   8 ;;
   9 ;; Keywords: java, tools
  10 ;;
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; A copy of the GNU General Public License can be obtained from this
  22 ;; program's author (send electronic mail to
  23 ;; ) or from the Free Software
  24 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;; LCD Archive Entry:
  27 ;; jde-parse-class|Andrew Hyatt|
  28 ;; |Parse a Java class file to get xref info for the JDEE.
  29 ;; |$Date: 2005/01/20 04:53:21 $|$Revision: 1.9 $|~/packages/jde-parse-class.el
  30
  31 ;;; Commentary:
  32
  33 ;; This file parses Java .class files to get information about what
  34 ;; methods call what other methods.  On the way there, we happen to
  35 ;; pick up all sorts of useful information. If someone needs the
  36 ;; functionality, contact me and I could easiliy put in more
  37 ;; functionality.
  38 ;;
  39 ;; Also, we could return a semantic-compatible structure, but at the
  40 ;; moment there is no point in doing this.
  41 ;;
  42 ;; There are two public functions, `jde-parse-class', which returns
  43 ;; everything we have parsed about the class. The resultant structures
  44 ;; can be passed to `jde-parse-class-extract-method-calls' which
  45 ;; returns the method calls a particular class uses, and
  46 ;; `jde-parse-class-extract-interfaces' to retrieve the interfaces a
  47 ;; class uses, and `jde-parse-class-extract-classname' to get the
  48 ;; fully qualified classname the class represents.  This is used in
  49 ;; jde-xref.el
  50 ;;
  51 ;; There is one other functions that is generally useful, and one
  52 ;; macro.  The function is `get-bit-flags-for-byte', which, given a
  53 ;; single byte in decimal (0 - 255), and a vector of flags
  54 ;; corresponding to bytes, will return a list of which flags are on.
  55 ;; The macro `do-and-advance-chars' wraps code, and after executing the
  56 ;; code, advances the current point a certain number of chars (here
  57 ;; equivalent to bytes).  This is useful for the kind of parsing we are
  58 ;; doing.
  59
  60 ;; for XEmacs compatibilty
  61 (unless (fboundp 'char-int)
  62   (defalias 'char-int 'identity))
  63 (when jde-xemacsp
  64     (require 'jde-xemacs))
  65
  66 (defmacro do-and-advance-chars (num &rest body)
  67   "Execute BODY, and then advance the point NUM bytes, called like
  68       (do-and-advance-chars 2 ...)"
  69   (let ((result-sym (gensym)))
  70   `(let ((,result-sym (progn ,@body)))
  71      (goto-char (+ (point) ,num))
  72      ,result-sym)))
  73
  74 (defsubst jde-parse-class-get-next-const-val (constants)
  75   (cadr (jde-parse-class-lookup-constant
  76          (jde-parse-class-get-next-2-bytes) constants)))
  77
  78 ;; xemacs without mule can't do utf-8
  79 (setq jde-parse-class-encoding
  80       (if (member 'utf-8 (coding-system-list))
  81           'utf-8 'raw-text))
  82
  83 (defun jde-parse-class-slash-to-dot (string)
  84   (subst-char-in-string ?/ ?. string))
  85
  86 (defun jde-parse-class (class-file)
  87   "Parse the class in CLASS-FILE, and return an alist, with the following
  88 keys: version, this-class, interfaces, fields, and methods."
  89   ;; we must visit the file in such a way as to not use any encoding,
  90   ;; else our parsing could be severely messed up
  91   (unless (file-exists-p class-file)
  92     (error (concat "Class file " class-file " does not exist")))
  93   (let ((buf (find-file-noselect class-file nil t)))
  94     (set-buffer buf)
  95     (let* ((constants (jde-parse-class-get-constants))
  96            (version (jde-parse-class-get-version))
  97            (access (jde-parse-class-get-access-flags))
  98            (this-class
  99              (subst-char-in-string
 100               ?/ ?. (cadr (jde-parse-class-lookup-constant
 101                              (jde-parse-class-get-next-const-val constants)
 102                               constants))))
 103            (superclass (jde-parse-class-slash-to-dot
 104                         (do-and-advance-chars 2
 105                           (let ((val (jde-parse-class-get-const-ref
 106                                       (point) constants)))
 107                             (if (eq (cadr val) 0)
 108                               nil ;; only Object can have no superclass
 109                               (cadr (jde-parse-class-lookup-constant
 110                                      (cadr val) constants)))))))
 111            (interfaces (jde-parse-class-get-interfaces constants))
 112            (fields (jde-parse-class-get-fields constants))
 113            (methods (jde-parse-class-get-methods constants))
 114            (attributes (jde-parse-class-get-attributes constants)))
 115       (kill-buffer buf)
 116       `((version . ,version) (access . ,access)
 117         (this-class . ,this-class) (superclass . ,superclass)
 118         (interfaces . ,interfaces)
 119         (fields . ,fields)
 120         (methods . ,methods)
 121         (attributes . ,attributes)))))
 122
 123 (defun jde-parse-class-extract-caught-exception-types (info)
 124   "Returns a list of a two-element of list of method signatures to
 125   caught exception types for each method"
 126   (mapcar (lambda (method)
 127             (list `(,(cdr (nth 2 info))
 128                       ,(cdr (assoc 'name method))
 129                       ,@(cdr (assoc 'descriptor method)))
 130                   (mapcar (lambda (class) (when class
 131                                             (jde-parse-class-slash-to-dot class)))
 132                           (cdr (assoc
 133                                 'catch-types
 134                                 (cdr
 135                                  (assoc 'code
 136                                         (cdr
 137                                          (assoc 'attributes
 138                                                 method)))))))))
 139           (cdr (assoc 'methods info))))
 140
 141 (defun jde-parse-class-extract-thrown-exception-types (info)
 142   "Returns a two element list of method signatures to thrown exception
 143   types for each method"
 144   (mapcar (lambda (method)
 145             (list `(,(cdr (nth 2 info))
 146                       ,(cdr (assoc 'name method))
 147                       ,@(cdr (assoc 'descriptor method)))
 148                   (cdr
 149                    (assoc 'exceptions
 150                           (cdr
 151                            (assoc 'attributes
 152                                   method))))))
 153           (cdr (assoc 'methods info))))
 154
 155 (defun jde-parse-class-extract-method-calls (info)
 156   "Return a cons of a method signature, and a list of the methods it
 157 calls.  Each method in the list is a list of the calling method or
 158 line number if available, the Class, method, and return value, and
 159 arguments.  INFO is the result of `jde-parse-class'"
 160   (mapcan (lambda (method) (mapcar (lambda (attr)
 161                                      (list
 162                                       `(,(cdr (nth 2 info))
 163                                          ,(cdr (assoc 'name method))
 164                                          ,@(cdr (assoc 'descriptor method))
 165                                          ,(car attr)) (cdr attr)))
 166                                    (cdr (assoc
 167                                          'calls
 168                                          (cdr
 169                                           (assoc 'code
 170                                                  (cdr
 171                                                   (assoc 'attributes
 172                                                          method))))))))
 173           (cdr (assoc 'methods info))))
 174
 175 (defun jde-parse-class-extract-interfaces (info)
 176   "Returns a list of fully qualified interface names that the class
 177   implements.  INFO is the result of `jde-parse-class'"
 178   (mapcar 'jde-parse-class-slash-to-dot
 179           (cdr (assoc 'interfaces info))))
 180
 181 (defun jde-parse-class-extract-superclass (info)
 182   "Returns a list of fully qualified class names that are superclasses
 183   of the parsed class"
 184   (jde-parse-class-slash-to-dot (cdr (assoc 'superclass info))))
 185
 186 (defun jde-parse-class-extract-method-signatures (info)
 187   "Returns a list of method names that the class implements"
 188   (mapcar (lambda (method-info) (cons (cdr (assoc 'name method-info))
 189                                       (cdr (assoc 'descriptor method-info))))
 190           (cdr (assoc 'methods info))))
 191
 192 (defun jde-parse-class-extract-field-signatures (info)
 193   "Return a list of field names that the class defines"
 194   (mapcar (lambda (field-info)
 195             (list (cdr (assoc 'name field-info))
 196                   (cdr (assoc 'descriptor field-info))))
 197           (cdr (assoc 'fields info))))
 198
 199 (defun jde-parse-class-extract-classname (info)
 200   "Returns the fully qualified classname that the class implements.
 201 INFO is the result of `jde-parse-class'"
 202   (cdr (assoc 'this-class info)))
 203
 204 (defun jde-parse-class-extract-sourcefile (info)
 205   (cdr (assoc 'source-file (cdr (assoc 'attributes info)))))
 206
 207 (defun jde-parse-class-get-const-ref (point constants)
 208   "Look at point in the class file and read it as a reference to the array.
 209 Returns the constant information contained at the reference"
 210   ;; we have to subtract one since the array index starts at 1
 211   ;; (according to the class file, not us
 212   (jde-parse-class-lookup-constant (jde-parse-class-get-2byte point)
 213                                    constants))
 214
 215 (defun jde-parse-class-lookup-constant (num constants)
 216   "From an index value, get the constant for that index"
 217   (aref constants (- num 1)))
 218
 219 (defsubst jde-parse-class-get-next-length-val ()
 220   (jde-parse-class-get-next-2-bytes))
 221
 222 (defun jde-parse-class-get-interfaces (constants)
 223   (let ((num (jde-parse-class-get-next-length-val))
 224         (interfaces '()))
 225     (dotimes (i num interfaces)
 226       (add-to-list 'interfaces (cadr (jde-parse-class-lookup-constant
 227                                      (jde-parse-class-get-next-const-val
 228                                       constants) constants))))))
 229
 230 (defun jde-parse-class-get-methods (constants)
 231   (let ((num (jde-parse-class-get-next-length-val))
 232         (methods '()))
 233     (dotimes (i num (nreverse methods))
 234       (add-to-list 'methods (jde-parse-class-get-method constants)))))
 235
 236 (defun jde-parse-class-get-method (constants)
 237   (list (cons 'access-flags (jde-parse-class-get-access-flags))
 238         (cons 'name (jde-parse-class-get-next-const-val constants))
 239         (cons 'descriptor (jde-parse-class-parse-complete-arg-signature
 240                            (jde-parse-class-get-next-const-val constants)))
 241         (cons 'attributes (jde-parse-class-get-attributes constants))))
 242
 243 (defun jde-parse-class-get-fields (constants)
 244   (let ((num (jde-parse-class-get-next-length-val))
 245         (fields '()))
 246     (dotimes (i num (nreverse fields))
 247       (add-to-list 'fields (jde-parse-class-get-field constants)))))
 248
 249 (defun jde-parse-class-get-field (constants)
 250   (list (cons 'access-flags (jde-parse-class-get-access-flags))
 251         (cons 'name (jde-parse-class-get-next-const-val constants))
 252         (cons 'descriptor (car (jde-parse-class-parse-first-arg
 253                            (jde-parse-class-get-next-const-val constants))))
 254         (cons 'attributes (jde-parse-class-get-attributes constants))))
 255
 256 (defun jde-parse-class-get-attributes (constants)
 257   (let ((num (jde-parse-class-get-next-length-val))
 258         (attributes '()))
 259     (dotimes (i num attributes)
 260       (add-to-list 'attributes (jde-parse-class-get-attribute constants)))))
 261
 262 (defun jde-parse-class-get-attribute (constants)
 263   (let ((attribute-type (jde-parse-class-get-next-const-val constants))
 264         (numbytes (jde-parse-class-get-next-4-bytes (point))))
 265     ;; TODO: implement the rest of the common attribute types
 266     (cond ((equal attribute-type "Code")
 267             (cons 'code
 268                   (jde-parse-class-get-code-attribute numbytes constants)))
 269           ((equal attribute-type "LineNumberTable")
 270             (cons 'line-number-table
 271                   (jde-parse-class-get-line-number-attribute)))
 272           ((equal attribute-type "Exceptions")
 273             (cons 'throws
 274                   (jde-parse-class-get-exception-attribute constants)))
 275           ((equal attribute-type "SourceFile")
 276             (cons 'source-file
 277                   (jde-parse-class-get-source-file-attribute constants)))
 278           (t (forward-char numbytes)))))
 279
 280 (defun jde-parse-class-get-source-file-attribute (constants)
 281   (jde-parse-class-get-next-const-val constants))
 282
 283 (defun jde-parse-class-get-exception-attribute (constants)
 284   (let ((num (jde-parse-class-get-next-length-val))
 285         (classes '()))
 286     (dotimes (i num classes)
 287       (add-to-list 'classes
 288                    (cadr (jde-parse-class-lookup-constant
 289                           (jde-parse-class-get-next-const-val constants)
 290                           constants))))))
 291
 292 (defun jde-parse-class-get-line-number-attribute ()
 293   (let ((num (jde-parse-class-get-next-length-val))
 294         (line-number-infos '()))
 295     (dotimes (i num (nreverse line-number-infos))
 296       (add-to-list
 297        'line-number-infos
 298        (cons (jde-parse-class-get-next-2-bytes)
 299              (jde-parse-class-get-next-2-bytes))))))
 300
 301 (defun jde-parse-class-get-code-attribute (numbytes constants)
 302   (goto-char (+ (point) 4)) ;; no one cares about max_stack and max_locals, right?
 303   (let* ((code-numbytes (jde-parse-class-get-next-4-bytes (point)))
 304          (end-point (+ (point) code-numbytes))
 305          (begin-point (point))
 306          (calls '())
 307          (catch-types '()))
 308     (while (< (point) end-point)
 309       (let* ((opcode-info (aref jde-parse-class-opcode-vec
 310                                 (char-int (char-after))))
 311              (opcode-val (car opcode-info))
 312              (opcode-length (cdr opcode-info)))
 313         (forward-char)
 314         (cond ((member opcode-val '(invokevirtual invokestatic invokespecial
 315                                     invokeinterface getstatic putstatic
 316                                     getfield putfield))
 317                 (do-and-advance-chars (- opcode-length 1)
 318                   (add-to-list
 319                    'calls
 320                    (cons (- (point) begin-point)
 321                          (jde-parse-class-parse-method-signature
 322                           (jde-parse-class-lookup-method
 323                            (jde-parse-class-get-const-ref (point) constants)
 324                            constants))))))
 325               ((eq opcode-val 'tableswitch)
 326                 ;; skip padding to go to a multiple of 4 from the begin-point.
 327                 ;; The second mod is to make sure on an offset of 4 we really don't skip anything
 328                 (forward-char (mod (- 4 (mod (- (point) begin-point) 4)) 4))
 329                 (forward-char 4)  ;; we don't care about default
 330                 (let ((low (jde-parse-class-get-next-4-bytes-as-signed))
 331                       (high (jde-parse-class-get-next-4-bytes-as-signed)))
 332                   (forward-char (* 4 (+ (- high low) 1)))))
 333               ((eq opcode-val 'lookupswitch)
 334                 (forward-char (mod (- 4 (mod (- (point) begin-point) 4)) 4))
 335                 (forward-char 4)
 336                 (forward-char (* 8 (jde-parse-class-get-next-4-bytes-as-signed))))
 337               ((eq opcode-val 'wide)
 338                 (let ((opcode2 (char-int (char-after))))
 339                   (if (eq opcode2 'iinc)
 340                     (forward-char 5)
 341                     (forward-char 2))))
 342               (t (forward-char (- opcode-length 1))))))
 343     (let ((num-exceptions (jde-parse-class-get-next-length-val)))
 344       (dotimes (i num-exceptions)
 345         (let ((type (cdr (assoc 'catch-type
 346                                  (jde-parse-class-get-exception-handler
 347                                   constants)))))
 348           (when type
 349             (add-to-list 'catch-types type)))))
 350     (let ((attributes (jde-parse-class-get-attributes constants)))
 351       ;; Get the line numbers if there, if not use -1's to iondicate no line number
 352       (let ((table (when (assoc 'line-number-table attributes)
 353                      (cdr (assoc 'line-number-table attributes)))))
 354         (list (cons
 355                'calls
 356                (mapcar (lambda (call)
 357                   (if table
 358                     ;; The line numbers describe the instruction at
 359                     ;; the start of the line, not every instruction
 360
 361                     ;; Advance in the table when the next byte
 362                     ;; described is higher than the current one
 363                     (progn (while (and (cadr table)
 364                                        (>= (car call) (caadr table)))
 365                              (setq table (cdr table)))
 366                            (cons (cdar table) (cdr call)))
 367                     (cons -1 (cdr call)))) (nreverse calls)))
 368               (cons 'catch-types catch-types))))))
 369
 370 (defun jde-parse-class-get-exception-handler (constants)
 371   (list (cons 'start-pc (jde-parse-class-get-next-2-bytes))
 372     (cons 'end-pc (jde-parse-class-get-next-2-bytes))
 373     (cons 'handler-pc (jde-parse-class-get-next-2-bytes))
 374     (cons 'catch-type (let ((val (jde-parse-class-get-next-2-bytes)))
 375                         (when (> val 0)
 376                           (cadr (jde-parse-class-lookup-constant
 377                                  (cadr (jde-parse-class-lookup-constant val constants))
 378                               constants)))))))
 379
 380 (defun jde-parse-class-parse-first-arg (sig)
 381   (let ((char (char-to-string (string-to-char sig))))
 382     (cond ((equal char "B") `("byte" . 1))
 383           ((equal char "C") `("char" . 1))
 384           ((equal char "D") `("double" . 1))
 385           ((equal char "F") `("float" . 1))
 386           ((equal char "I") `("int" . 1))
 387           ((equal char "J") `("long" . 1))
 388           ((equal char "L") (let ((endpos (string-match ";" sig)))
 389                               (cons (jde-parse-class-slash-to-dot
 390                                      (substring sig 1
 391                                                 endpos))
 392                                     (+ 1 endpos))))
 393           ((equal char "S") `("short" . 1))
 394           ((equal char "Z") `("boolean" . 1))
 395           ((equal char "[") (let ((rest (jde-parse-class-parse-first-arg
 396                                          (substring sig 1))))
 397                               (cons (concat (car rest) "[]") (+ (cdr rest) 1))))
 398             (t (error (concat "Could not find char " char))))))
 399
 400 (defun jde-parse-class-parse-arg-signature (sig)
 401   (when (> (length sig) 0)
 402     (let ((arg (jde-parse-class-parse-first-arg sig)))
 403       (if (> (cdr arg) (length sig))
 404         (list (car arg))
 405         (cons (car arg) (jde-parse-class-parse-arg-signature
 406                          (substring sig (cdr arg))))))))
 407
 408
 409 (defun jde-parse-class-parse-complete-arg-signature (sig)
 410   (let* ((match (string-match "(\\(.*\\))\\(.*\\)" sig)))
 411     (if match
 412       (let ((args (match-string 1 sig))
 413             (return-val (match-string 2 sig)))
 414         (list (unless (equal "V" return-val)
 415                 (car (jde-parse-class-parse-arg-signature return-val)))
 416               (jde-parse-class-parse-arg-signature args)))
 417       (list nil (jde-parse-class-parse-arg-signature sig)))))
 418
 419
 420 (defun jde-parse-class-parse-method-signature (siglist)
 421   `(,(jde-parse-class-slash-to-dot (car siglist))
 422     ,(cadr siglist) ,@(jde-parse-class-parse-complete-arg-signature
 423                       (nth 2 siglist))))
 424
 425 (defun jde-parse-class-lookup-method (method constants)
 426   (list (cadr (jde-parse-class-lookup-constant
 427                (cadr (jde-parse-class-lookup-constant
 428                        (cadr method) constants))
 429                constants))
 430         (cadr (jde-parse-class-lookup-constant
 431                (cadr
 432                 (jde-parse-class-lookup-constant (nth 2 method) constants))
 433                constants))
 434         (cadr (jde-parse-class-lookup-constant
 435                (nth 2
 436                 (jde-parse-class-lookup-constant (nth 2 method) constants))
 437                constants))))
 438
 439 (defun get-bit-flags-for-byte (byte flag-vec)
 440   "Gets the bit flags for BYTE, given the flags that apply to each bit,
 441 a vector of length 8 (one for each bit).  Nulls in the FLAG-VEC are
 442 taken to mean there is no flag for that byte, which causes the byte to be
 443 ignored.
 444
 445 For example: (get-bit-flags-for-byte 6 ['a 'b 'c 'd 'e 'f 'g 'h])
 446 returns ('f 'g)"
 447   (let ((flags '()))
 448     (dotimes (i 8 flags)
 449       (when (and (aref flag-vec (- 7 i))
 450                  (> (logand (expt 2 i)  byte) 0))
 451         (add-to-list 'flags (aref flag-vec (- 7 i)))))))
 452
 453 (defun jde-parse-class-get-access-flags ()
 454   (do-and-advance-chars 2
 455     (let ((raw0 (char-int (char-after (point))))
 456           (raw1 (char-int (char-after (+ (point) 1)))))
 457       (append
 458        (get-bit-flags-for-byte raw0
 459                                [nil nil nil nil 'string 'abstract
 460                                     'interface 'native])
 461        (get-bit-flags-for-byte raw1
 462                                ['transient 'volatile 'synchronized 'final
 463                                            'static 'protected
 464                                            'private 'public])))))
 465
 466 (defun jde-parse-class-get-version ()
 467   "Return a list - (major-version minor-version)"
 468   (list (jde-parse-class-get-2byte 5)
 469                   (jde-parse-class-get-2byte 7)))
 470
 471 (defun jde-parse-class-get-2byte (point)
 472   "Gets the value of two bytes (0 - 65535) as an int"
 473   (let ((b1 (char-int (char-after point)))
 474         (b2 (char-int (char-after (+ 1 point)))))
 475     (+ (* b1 256) b2)))
 476
 477 (defun jde-parse-class-get-next-2-bytes ()
 478   (do-and-advance-chars 2
 479     (jde-parse-class-get-2byte (point))))
 480
 481 (defun jde-parse-class-get-4byte (point &optional ignore-large-val)
 482   (let ((db1 (jde-parse-class-get-2byte point))
 483         (db2 (jde-parse-class-get-2byte (+ 2 point))))
 484     (if (< db1 2047)
 485       ;; don't go over the maxint in elisp (2047, since we have 1 more db1 could be 65536)
 486       (+ (* 65536 db1) db2)
 487       (if ignore-large-val
 488         0
 489         (error "Class file has a larger 4 byte value then emacs can handle")))))
 490
 491 (defun jde-parse-class-get-next-4-bytes-as-signed (&optional ignore-large-val)
 492   (let ((db1 (jde-parse-class-get-next-2-bytes))
 493         (db2 (jde-parse-class-get-next-2-bytes)))
 494     (if (> (logand 32768 db1) 0)  ;; if it's high-bit is set, then it's negative.
 495       (if (> db1 63488)
 496         (- (+ 1 (+ (* (- 65535 db1) 65536) (- 65535 db2))))
 497         (if ignore-large-val
 498           0
 499           (error "Class file has an unsigned int who is smaller than emacs can handle")))
 500       (jde-parse-class-get-4byte (- (point) 4)))))
 501
 502 (defun jde-parse-class-get-next-4-bytes (&optional ignore-large-val)
 503   (do-and-advance-chars 4
 504     (jde-parse-class-get-4byte (point) ignore-large-val)))
 505
 506 (defun jde-parse-class-get-constants ()
 507   "Returns a list of the constant ending location (not inclusive of
 508 of the constants) and a vector of all constants"
 509   (let* ((count (- (jde-parse-class-get-2byte 9) 1))
 510          (const-vec (make-vector count '())))
 511     (goto-char 11) ;; start of constants
 512     (dotimes (i count const-vec)
 513       (let ((const (jde-parse-class-get-next-constant)))
 514         (aset const-vec i const)
 515         ;; doubles and longs take up two places on the const table.
 516         (when (or (eq (car const) 'double)
 517                   (eq (car const) 'long))
 518           (aset const-vec (+ 1 i) nil)
 519           (setq i (+ 1 i)))))))
 520
 521 (defsubst jde-parse-class-get-long-constant (&optional ignore-large-val)
 522   (let ((qb1 (jde-parse-class-get-next-4-bytes ignore-large-val))
 523         (qb2 (jde-parse-class-get-next-4-bytes ignore-large-val)))
 524     (if (> qb2 0)
 525       (if ignore-large-val
 526         0
 527         (error "Class file has a large 8 byte value than emacs can handle"))
 528       qb1)))
 529
 530 (defsubst jde-parse-class-get-double-constant ()
 531   "NOT IMPLEMENTED YET"
 532   (do-and-advance-chars 8
 533     "0.0"))
 534
 535 (defsubst jde-parse-class-get-ref-constant ()
 536   (list (jde-parse-class-get-next-2-bytes) (jde-parse-class-get-next-2-bytes)))
 537
 538 (defsubst jde-parse-class-get-float-constant ()
 539   "NOT IMPLEMENTED YET"
 540   (do-and-advance-chars 4
 541     "0.0"))
 542
 543 (defsubst jde-parse-class-get-nameandtype-constant ()
 544   (list (jde-parse-class-get-next-2-bytes) (jde-parse-class-get-next-2-bytes)))
 545
 546 (defsubst jde-parse-class-get-utf8-constant ()
 547   (let* ((len (jde-parse-class-get-next-2-bytes))
 548          (result (encode-coding-string (buffer-substring (point)
 549                                                         (+ len (point)))
 550                                        jde-parse-class-encoding)))
 551     (goto-char (+ len (point)))
 552     result))
 553
 554 (defun jde-parse-class-get-next-constant ()
 555   (let ((const-type (char-int (char-after (point)))))
 556     (forward-char)
 557     (cond ((eq const-type 7)
 558             `(class ,(jde-parse-class-get-next-2-bytes)))
 559           ((eq const-type 9)
 560             `(field ,@(jde-parse-class-get-ref-constant)))
 561           ((eq const-type 10)
 562             `(method ,@(jde-parse-class-get-ref-constant)))
 563           ((eq const-type 11)
 564             `(interface-method ,@(jde-parse-class-get-ref-constant)))
 565           ((eq const-type 8)
 566             `(string ,(jde-parse-class-get-next-2-bytes)))
 567           ((eq const-type 3)
 568             `(integer ,(jde-parse-class-get-next-4-bytes t)))
 569           ((eq const-type 4)
 570             `(float ,(jde-parse-class-get-float-constant)))
 571           ((eq const-type 5)
 572             `(long ,(jde-parse-class-get-long-constant t)))
 573           ((eq const-type 6)
 574             `(double ,(jde-parse-class-get-double-constant)))
 575           ((eq const-type 12)
 576             `(name-and-type ,@(jde-parse-class-get-nameandtype-constant)))
 577           ((eq const-type 1)
 578             `(utf8 ,(jde-parse-class-get-utf8-constant))))))
 579
 580 (defconst jde-parse-class-opcode-vec
 581   [(nop . 1)  ;; 0
 582    (aconst_null . 1) ;; 1
 583    (iconst_m1 . 1)  ;; 2
 584    (iconst_0 . 1)  ;; 3
 585    (iconst_1 . 1)  ;; 4
 586    (iconst_2 . 1)  ;; 5
 587    (iconst_3 . 1)  ;; 6
 588    (iconst_4 . 1)  ;; 7
 589    (iconst_5 . 1)  ;; 8
 590    (lconst_0 . 1)  ;; 9
 591    (lconst_1 . 1)  ;; 10
 592    (fconst_0 . 1)  ;; 11
 593    (fconst_1 . 1)  ;; 12
 594    (fconst_2 . 1)  ;; 13
 595    (dconst_0 . 1)  ;; 14
 596    (dconst_1 . 1)  ;; 15
 597    (bipush . 2)  ;; 16
 598    (sipush . 3)  ;; 17
 599    (ldc . 2)  ;; 18
 600    (ldc_w . 3)  ;; 19
 601    (ldc2_w . 3)  ;; 20
 602    (iload . 2)  ;; 21
 603    (lload . 2)  ;; 22
 604    (fload . 2)  ;; 23
 605    (dload . 2)  ;; 24
 606    (aload . 2)  ;; 25
 607    (iload_0 . 1)  ;; 26
 608    (iload_1 . 1)  ;; 27
 609    (iload_2 . 1)  ;; 28
 610    (iload_3 . 1)  ;; 29
 611    (lload_0 . 1)  ;; 30
 612    (lload_1 . 1)  ;; 31
 613    (lload_2 . 1)  ;; 32
 614    (lload_3 . 1)  ;; 33
 615    (fload_0 . 1)  ;; 34
 616    (fload_1 . 1)  ;; 35
 617    (fload_2 . 1)  ;; 36
 618    (fload_3 . 1)  ;; 37
 619    (dload_0 . 1)  ;; 38
 620    (dload_1 . 1)  ;; 39
 621    (dload_2 . 1)  ;; 40
 622    (dload_3 . 1)  ;; 41
 623    (aload_0 . 1)  ;; 42
 624    (aload_1 . 1)  ;; 43
 625    (aload_2 . 1)  ;; 44
 626    (aload_3 . 1)  ;; 45
 627    (iaload . 1)  ;; 46
 628    (laload . 1)  ;; 47
 629    (faload . 1)  ;; 48
 630    (daload . 1)  ;; 49
 631    (aaload . 1)  ;; 50
 632    (baload . 1)  ;; 51
 633    (caload . 1)  ;; 52
 634    (saload . 1)  ;; 53
 635    (istore . 2)  ;; 54
 636    (lstore . 2)  ;; 55
 637    (fstore . 2)  ;; 56
 638    (dstore . 2)  ;; 57
 639    (astore . 2)  ;; 58
 640    (istore_0 . 1)  ;; 59
 641    (istore_1 . 1)  ;; 60
 642    (istore_2 . 1)  ;; 61
 643    (istore_3 . 1)  ;; 62
 644    (lstore_0 . 1)  ;; 63
 645    (lstore_1 . 1)  ;; 64
 646    (lstore_2 . 1)  ;; 65
 647    (lstore_3 . 1)  ;; 66
 648    (fstore_0 . 1)  ;; 67
 649    (fstore_1 . 1)  ;; 68
 650    (fstore_2 . 1)  ;; 69
 651    (fstore_3 . 1)  ;; 70
 652    (dstore_0 . 1)  ;; 71
 653    (dstore_1 . 1)  ;; 72
 654    (dstore_2 . 1)  ;; 73
 655    (dstore_3 . 1)  ;; 74
 656    (astore_0 . 1)  ;; 75
 657    (astore_1 . 1)  ;; 76
 658    (astore_2 . 1)  ;; 77
 659    (astore_3 . 1)  ;; 78
 660    (iastore . 1)  ;; 79
 661    (lastore . 1)  ;; 80
 662    (fastore . 1)  ;; 81
 663    (dastore . 1)  ;; 82
 664    (aastore . 1)  ;; 83
 665    (bastore . 1)  ;; 84
 666    (castore . 1)  ;; 85
 667    (sastore . 1)  ;; 86
 668    (pop . 1)  ;; 87
 669    (pop2 . 1)  ;; 88
 670    (dup . 1)  ;; 89
 671    (dup_x1 . 1)  ;; 90
 672    (dup_x2 . 1)  ;; 91
 673    (dup2 . 1)  ;; 92
 674    (dup2_x1 . 1)  ;; 93
 675    (dup2_x2 . 1)  ;; 94
 676    (swap . 1)  ;; 95
 677    (iadd . 1)  ;; 96
 678    (ladd . 1)  ;; 97
 679    (fadd . 1)  ;; 98
 680    (dadd . 1)  ;; 99
 681    (isub . 1)  ;; 100
 682    (lsub . 1)  ;; 101
 683    (fsub . 1)  ;; 102
 684    (dsub . 1)  ;; 103
 685    (imul . 1)  ;; 104
 686    (lmul . 1)  ;; 105
 687    (fmul . 1)  ;; 106
 688    (dmul . 1)  ;; 107
 689    (idiv . 1)  ;; 108
 690    (ldiv . 1)  ;; 109
 691    (fdiv . 1)  ;; 110
 692    (ddiv . 1)  ;; 111
 693    (irem . 1)  ;; 112
 694    (lrem . 1)  ;; 113
 695    (frem . 1)  ;; 114
 696    (drem . 1)  ;; 115
 697    (ineg . 1)  ;; 116
 698    (lneg . 1)  ;; 117
 699    (fneg . 1)  ;; 118
 700    (dneg . 1)  ;; 119
 701    (ishl . 1)  ;; 120
 702    (lshl . 1)  ;; 121
 703    (ishr . 1)  ;; 122
 704    (lshr . 1)  ;; 123
 705    (iushr . 1)  ;; 124
 706    (lushr . 1)  ;; 125
 707    (iand . 1)  ;; 126
 708    (land . 1)  ;; 127
 709    (ior . 1)  ;; 128
 710    (lor . 1)  ;; 129
 711    (ixor . 1)  ;; 130
 712    (lxor . 1)  ;; 131
 713    (iinc . 3)  ;; 132
 714    (i2l . 1)  ;; 133
 715    (i2f . 1)  ;; 134
 716    (i2d . 1)  ;; 135
 717    (l2i . 1)  ;; 136
 718    (l2f . 1)  ;; 137
 719    (l2d . 1)  ;; 138
 720    (f2i . 1)  ;; 139
 721    (f2l . 1)  ;; 140
 722    (f2d . 1)  ;; 141
 723    (d2i . 1)  ;; 142
 724    (d2l . 1)  ;; 143
 725    (d2f . 1)  ;; 144
 726    (i2b . 1)  ;; 145
 727    (i2c . 1)  ;; 146
 728    (i2s . 1)  ;; 147
 729    (lcmp . 1)  ;; 148
 730    (fcmpl . 1)  ;; 149
 731    (fcmpg . 1)  ;; 150
 732    (dcmpl . 1)  ;; 151
 733    (dcmpg . 1)  ;; 152
 734    (ifeq . 3)  ;; 153
 735    (ifne . 3)  ;; 154
 736    (iflt . 3)  ;; 155
 737    (ifge . 3)  ;; 156
 738    (ifgt . 3)  ;; 157
 739    (ifle . 3)  ;; 158
 740    (if_icmpeq . 3)  ;; 159
 741    (if_icmpne . 3)  ;; 160
 742    (if_icmplt . 3)  ;; 161
 743    (if_icmpge . 3)  ;; 162
 744    (if_icmpgt . 3)  ;; 163
 745    (if_icmple . 3)  ;; 164
 746    (if_acmpeq . 3)  ;; 165
 747    (if_acmpne . 3)  ;; 166
 748    (goto . 3)  ;; 167
 749    (jsr . 3)  ;; 168
 750    (ret . 2)  ;; 169
 751    (tableswitch . -1)  ;; 170  - variable length instruction
 752    (lookupswitch . -1)  ;; 171   - variable length instruction
 753    (ireturn . 1)  ;; 172
 754    (lreturn . 1)  ;; 173
 755    (freturn . 1)  ;; 174
 756    (dreturn . 1)  ;; 175
 757    (areturn . 1)  ;; 176
 758    (return . 1)  ;; 177
 759    (getstatic . 3)  ;; 178
 760    (putstatic . 3)  ;; 179
 761    (getfield . 3)  ;; 180
 762    (putfield . 3)  ;; 181
 763    (invokevirtual . 3)  ;; 182
 764    (invokespecial . 3)  ;; 183
 765    (invokestatic . 3)  ;; 184
 766    (invokeinterface . 5)  ;; 185
 767    (unused . -1) ;; 186
 768    (new . 3)  ;; 187
 769    (newarray . 2)  ;; 188
 770    (anewarray . 3)  ;; 189
 771    (arraylength . 1)  ;; 190
 772    (athrow . 1) ;; 191
 773    (checkcast . 3) ;; 192
 774    (instanceof . 3)  ;; 193
 775    (monitorcenter . 1)  ;; 194
 776    (monitorexit . 1)  ;; 195
 777    (wide . -1)  ;; 196   - variable length instruction
 778    (multianewarray . 4)  ;; 197
 779    (ifnull . 3)  ;; 198
 780    (ifnonnull . 3)  ;; 199
 781    (goto_w . 5)  ;; 200
 782    (jsr_w . 5)  ;; 201
 783    ]
 784   "A vector storing the java opcodes.  Each position in the vector is
 785 in the position of it's bytecode number.  For example, if, when
 786 reading a class file we come across bytecode 0, we can just look at
 787 this vector to see both the name of the instruction, and the size of
 788 the operation in bytes.  A few opcodes have variable length, so those
 789 must be calculated at runtime.")
 790
 791 (provide 'jde-parse-class)
 792
 793 ;; $Log: jde-parse-class.el,v $
 794 ;; Revision 1.9  2005/01/20 04:53:21  paulk
 795 ;; Fix bug in jde-parse-class-get-code-attribute that caused it to compute the length of iinc JVM instructions
 796 ;; as 5 bytes when they are in fact 6 bytes long. Thanks to Jack Klebanoff.
 797 ;;
 798 ;; Revision 1.8  2004/07/09 05:17:20  paulk
 799 ;; Eliminated initialization of loop variable i to 0 in
 800 ;; jde-parse-class-get-constants. It does not seem necessssary as dotimes
 801 ;; initializes the variable itself to 0. Further, the initialization
 802 ;; turned i into a free variable, causing a compiler warning. I tested
 803 ;; jde-parse-class-get-constants before and after this change and the
 804 ;; change made no difference.
 805 ;;
 806 ;; Revision 1.7  2003/06/19 17:01:39  ahyatt
 807 ;; Now compatible with emacs and xemacs versions without MULE
 808 ;;
 809 ;; Revision 1.5  2003/03/08 06:32:45  ahyatt
 810 ;; Now parses exception information
 811 ;;
 812 ;; Revision 1.4  2002/12/01 02:39:58  ahyatt
 813 ;; Support for jde-xref's latest improvements, which require more
 814 ;; information from each class.
 815 ;;
 816 ;; Revision 1.3  2002/11/21 04:26:33  ahyatt
 817 ;; Changed my e-mail address to andy_jde@thehyatts.net
 818 ;;
 819 ;; Revision 1.2  2002/11/21 04:03:47  ahyatt
 820 ;; Fixed a bug in jde-parse-class where two functions had the same
 821 ;; definition.  The fix involved renamed a few classes to keep
 822 ;; consistency.  jde-xref had to change as well.
 823 ;;
 824 ;; Removed a (newline) function call in jde-xref and replaced it with a "\n"
 825 ;;
 826 ;; In jde-xref, rewrote the parts of jde-xref-make-db-from-path which
 827 ;; dealt with keeping track of the already parsed classes. Previous
 828 ;; solution was really kludgey, this solution is only somewhat kludgey.
 829 ;; I'm still thinking about this problem.
 830 ;;
 831 ;; Revision 1.1  2002/11/18 07:02:18  paulk
 832 ;; Initial release.
 833 ;;
 834
 835 ;; end of jde-xref.el