Source

jde / lisp / jde-parse-class.el

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
;; JDE-PARSE-CLASS.EL --- Parse a Java class file.
;; $Revision$ $Date$
;;
;; Copyright (C) 2002 Andrew Hyatt
;;
;; Author: Andrew Hyatt <andy_jde@thehyatts.net>
;; Maintainers: Andrew Hyatt and Paul Kinnucan
;;
;; Keywords: java, tools
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to
;; ) or from the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;; LCD Archive Entry:
;; jde-parse-class|Andrew Hyatt|
;; |Parse a Java class file to get xref info for the JDEE.
;; |$Date$|$Revision$|~/packages/jde-parse-class.el

;;; Commentary:

;; This file parses Java .class files to get information about what
;; methods call what other methods.  On the way there, we happen to
;; pick up all sorts of useful information. If someone needs the
;; functionality, contact me and I could easiliy put in more
;; functionality.
;;
;; Also, we could return a semantic-compatible structure, but at the
;; moment there is no point in doing this.
;;
;; There are two public functions, `jde-parse-class', which returns
;; everything we have parsed about the class. The resultant structures
;; can be passed to `jde-parse-class-extract-method-calls' which
;; returns the method calls a particular class uses, and
;; `jde-parse-class-extract-interfaces' to retrieve the interfaces a
;; class uses, and `jde-parse-class-extract-classname' to get the
;; fully qualified classname the class represents.  This is used in
;; jde-xref.el
;;
;; There is one other functions that is generally useful, and one
;; macro.  The function is `get-bit-flags-for-byte', which, given a
;; single byte in decimal (0 - 255), and a vector of flags
;; corresponding to bytes, will return a list of which flags are on.
;; The macro `do-and-advance-chars' wraps code, and after executing the
;; code, advances the current point a certain number of chars (here
;; equivalent to bytes).  This is useful for the kind of parsing we are
;; doing.

;; XEmacs doesn't have replace-regexp-in-string so define our own
;; version
(defun jde-replace-regexp-in-string (regexp rep string &optional
					    fixedcase literal subexp start)
  "Replace all matches for REGEXP with REP in STRING.

Return a new string containing the replacements.

Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'.  If START
is non-nil, start replacements at that index in STRING.

REP is either a string used as the NEWTEXT arg of `replace-match' or a
function.  If it is a function it is applied to each match to generate
the replacement passed to `replace-match'; the match-data at this
point are such that match 0 is the function's argument.

To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
  (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
    => \" bar foo\"
"

  ;; To avoid excessive consing from multiple matches in long strings,
  ;; don't just call `replace-match' continually.  Walk down the
  ;; string looking for matches of REGEXP and building up a (reversed)
  ;; list MATCHES.  This comprises segments of STRING which weren't
  ;; matched interspersed with replacements for segments that were.
  ;; [For a `large' number of replacments it's more efficient to
  ;; operate in a temporary buffer; we can't tell from the function's
  ;; args whether to choose the buffer-based implementation, though it
  ;; might be reasonable to do so for long enough STRING.]
  (let ((l (length string))
	(start (or start 0))
	matches str mb me)
    (save-match-data
      (while (and (< start l) (string-match regexp string start))
	(setq mb (match-beginning 0)
	      me (match-end 0))
	;; If we matched the empty string, make sure we advance by one char
	(when (= me mb) (setq me (min l (1+ mb))))
	;; Generate a replacement for the matched substring.
	;; Operate only on the substring to minimize string consing.
	;; Set up match data for the substring for replacement;
	;; presumably this is likely to be faster than munging the
	;; match data directly in Lisp.
	(string-match regexp (setq str (substring string mb me)))
	(setq matches
	      (cons (replace-match (if (stringp rep)
				       rep
				     (funcall rep (match-string 0 str)))
				   fixedcase literal str subexp)
		    (cons (substring string start mb) ; unmatched prefix
			  matches)))
	(setq start me))
      ;; Reconstruct a string from the pieces.
      (setq matches (cons (substring string start l) matches)) ; leftover
      (apply #'concat (nreverse matches)))))

(defmacro do-and-advance-chars (num &rest body)
  "Execute BODY, and then advance the point NUM bytes, called like
      (do-and-advance-chars 2 ...)"
  (let ((result-sym (gensym)))
  `(let ((,result-sym (progn ,@body)))
     (goto-char (+ (point) ,num))
     ,result-sym)))

(defsubst jde-parse-class-get-next-const-val (constants)
  (cadr (jde-parse-class-lookup-constant
         (jde-parse-class-get-next-2-bytes) constants)))

(defun jde-parse-class-slash-to-dot (string)
  (jde-replace-regexp-in-string "/" "." string))

(defun jde-parse-class (class-file)
  "Parse the class in CLASS-FILE, and return an alist, with the following
keys: version, this-class, interfaces, fields, and methods."
  ;; we must visit the file in such a way as to not use any encoding,
  ;; else our parsing could be severely messed up
  (let ((buf (find-file-noselect class-file nil t)))
    (set-buffer buf)
    (let* ((constants (jde-parse-class-get-constants))
           (version (jde-parse-class-get-version))
           (access (jde-parse-class-get-access-flags))
           (this-class
             (jde-replace-regexp-in-string
              "/" "." (cadr (jde-parse-class-lookup-constant
                             (jde-parse-class-get-next-const-val constants)
                              constants))))
           (superclass (jde-parse-class-slash-to-dot
                        (do-and-advance-chars 2
                          (let ((val (jde-parse-class-get-const-ref
                                      (point) constants)))
                            (if (eq (cadr val) 0)
                              nil ;; only Object can have no superclass
                              (cadr (jde-parse-class-lookup-constant
                                     (cadr val) constants)))))))
           (interfaces (jde-parse-class-get-interfaces constants))
           (fields (jde-parse-class-get-fields constants))
           (methods (jde-parse-class-get-methods constants)))
      (kill-buffer buf)
      `((version . ,version) (access . ,access)
        (this-class . ,this-class) (superclass . ,superclass)
        (interfaces . ,interfaces)
        (fields . ,fields)
        (methods . ,methods)))))

(defun jde-parse-class-extract-method-calls (info)
  "Return a cons of a fully qualified classname, and a list of the
methods it calls.  Each method in the list is a list of the calling
method or line number if available, the Class, method, and return
value, and arguments.  INFO is the result of `jde-parse-class'"
  (mapcan (lambda (method) (mapcar (lambda (attr)
                                     (list 
                                      `(,(cdr (nth 2 info))
                                         ,(cdr (assoc 'name method))
                                         ,@(cdr (assoc 'descriptor method)) 
                                         ,(car attr)) (cdr attr))) 
                                   (cdr
                                    (assoc 'code
                                           (cdr
                                            (assoc 'attributes method))))))
          (cdr (assoc 'methods info))))

(defun jde-parse-class-extract-interfaces (info)
  "Returns a list of fully qualified interface names that the class
  implements.  INFO is the result of `jde-parse-class'"
  (mapcar 'jde-parse-class-slash-to-dot
          (cdr (assoc 'interfaces info))))

(defun jde-parse-class-extract-superclass (info)
  "Returns a list of fully qualified class names that are superclasses
  of the parsed class"
  (jde-parse-class-slash-to-dot (cdr (assoc 'superclass info))))

(defun jde-parse-class-extract-method-signatures (info)
  "Returns a list of method names that the class implements"
  (mapcar (lambda (method-info) (cons (cdr (assoc 'name method-info))
                                      (cdr (assoc 'descriptor method-info))))
          (cdr (assoc 'methods info))))

(defun jde-parse-class-extract-field-signatures (info)
  "Return a list of field names that the class defines"
  (mapcar (lambda (field-info)
            (list (cdr (assoc 'name field-info))
                  (cdr (assoc 'descriptor field-info))))
          (cdr (assoc 'fields info))))

(defun jde-parse-class-extract-classname (info)
  "Returns the fully qualified classname that the class implements.
INFO is the result of `jde-parse-class'"
  (cdr (assoc 'this-class info)))

(defun jde-parse-class-get-const-ref (point constants)
  "Look at point in the class file and read it as a reference to the array.
Returns the constant information contained at the reference"
  ;; we have to subtract one since the array index starts at 1
  ;; (according to the class file, not us
  (jde-parse-class-lookup-constant (jde-parse-class-get-2byte point)
                                   constants))

(defun jde-parse-class-lookup-constant (num constants)
  "From an index value, get the constant for that index"
  (aref constants (- num 1)))
  
(defsubst jde-parse-class-get-next-length-val ()
  (jde-parse-class-get-next-2-bytes))

(defun jde-parse-class-get-interfaces (constants)
  (let ((num (jde-parse-class-get-next-length-val))
        (interfaces '()))
    (dotimes (i num interfaces)
      (add-to-list 'interfaces (cadr (jde-parse-class-lookup-constant
                                     (jde-parse-class-get-next-const-val
                                      constants) constants))))))

(defun jde-parse-class-get-methods (constants)
  (let ((num (jde-parse-class-get-next-length-val))
        (methods '()))
    (dotimes (i num (nreverse methods))
      (add-to-list 'methods (jde-parse-class-get-method constants)))))

(defun jde-parse-class-get-method (constants)
  (list (cons 'access-flags (jde-parse-class-get-access-flags))
        (cons 'name (jde-parse-class-get-next-const-val constants))
        (cons 'descriptor (jde-parse-class-parse-complete-arg-signature
                           (jde-parse-class-get-next-const-val constants)))
        (cons 'attributes (jde-parse-class-get-attributes constants))))

(defun jde-parse-class-get-fields (constants)
  (let ((num (jde-parse-class-get-next-length-val))
        (fields '()))
    (dotimes (i num (nreverse fields))
      (add-to-list 'fields (jde-parse-class-get-field constants)))))

(defun jde-parse-class-get-field (constants)
  (list (cons 'access-flags (jde-parse-class-get-access-flags))
        (cons 'name (jde-parse-class-get-next-const-val constants))
        (cons 'descriptor (car (jde-parse-class-parse-first-arg
                           (jde-parse-class-get-next-const-val constants))))
        (cons 'attributes (jde-parse-class-get-attributes constants))))

(defun jde-parse-class-get-attributes (constants)
  (let ((num (jde-parse-class-get-next-length-val))
        (attributes '()))
    (dotimes (i num attributes)
      (add-to-list 'attributes (jde-parse-class-get-attribute constants)))))

(defun jde-parse-class-get-attribute (constants)
  (let ((attribute-type (jde-parse-class-get-next-const-val constants))
        (numbytes (jde-parse-class-get-next-4-bytes (point))))
    ;; TODO: implement the rest of the common attribute types
    (cond ((string= attribute-type "Code")
            (cons 'code
                  (jde-parse-class-get-code-attribute numbytes constants)))
          ((string= attribute-type "LineNumberTable")
            (cons 'line-number-table
                  (jde-parse-class-get-line-number-attribute)))
          (t (do-and-advance-chars numbytes nil)))))

(defun jde-parse-class-get-line-number-attribute ()
  (let ((num (jde-parse-class-get-next-length-val))
        (line-number-infos '()))
    (dotimes (i num (nreverse line-number-infos))
      (add-to-list
       'line-number-infos
       (cons (jde-parse-class-get-next-2-bytes)
             (jde-parse-class-get-next-2-bytes))))))

(defun jde-parse-class-get-code-attribute (numbytes constants)
  (goto-char (+ (point) 4)) ;; no one cares about max_stack and max_locals, right?
  (let* ((code-numbytes (jde-parse-class-get-next-4-bytes (point)))
         (end-point (+ (point) code-numbytes))
         (begin-point (point))
         (calls '()))
    (while (< (point) end-point)
      (let* ((opcode-info (aref jde-parse-class-opcode-vec (char-after)))
             (opcode-val (car opcode-info))
             (opcode-length (cdr opcode-info)))
        (forward-char)
        (cond ((member opcode-val '(invokevirtual invokestatic invokespecial
                                    invokeinterface getstatic putstatic
                                    getfield putfield))
                (do-and-advance-chars (- opcode-length 1)
                  (add-to-list
                   'calls
                   (cons (- (point) begin-point)
                         (jde-parse-class-parse-method-signature
                          (jde-parse-class-lookup-method
                           (jde-parse-class-get-const-ref (point) constants)
                           constants))))))
              ((eq opcode-val 'tableswitch)
                ;; skip padding to go to a multiple of 4 from the begin-point.
                ;; The second mod is to make sure on an offset of 4 we really don't skip anything
                (forward-char (mod (- 4 (mod (- (point) begin-point) 4)) 4))
                (forward-char 4)  ;; we don't care about default
                (let ((low (jde-parse-class-get-next-4-bytes-as-signed))
                      (high (jde-parse-class-get-next-4-bytes-as-signed)))
                  (forward-char (* 4 (+ (- high low) 1)))))
              ((eq opcode-val 'lookupswitch)
                (forward-char (mod (- 4 (mod (- (point) begin-point) 4)) 4))
                (forward-char 4)
                (forward-char (* 8 (jde-parse-class-get-next-4-bytes-as-signed))))
              ((eq opcode-val 'wide)
                (let ((opcode2 (char-after)))
                  (if (eq opcode2 'iinc)
                    (forward-char 4)
                    (forward-char 2))))
              (t (forward-char (- opcode-length 1))))))
      (let ((num-exceptions (jde-parse-class-get-next-length-val)))
        (forward-char (* num-exceptions 8))) ;; skip over exception info (for now)
      (let ((attributes (jde-parse-class-get-attributes constants)))
        ;; Get the line numbers if there, if not use -1's to iondicate no line number
        (let ((table (when (assoc 'line-number-table attributes)
                       (cdr (assoc 'line-number-table attributes)))))
          (mapcar (lambda (call)
                    (if table
                      ;; The line numbers describe the instruction at
                      ;; the start of the line, not every instruction

                      ;; Advance in the table when the next byte
                      ;; described is higher than the current one
                      (progn (while (and (cadr table)
                                         (>= (car call) (caadr table)))
                               (setq table (cdr table)))
                             (cons (cdar table) (cdr call)))
                      (cons -1 (cdr call)))) (nreverse calls))))))

(defun jde-parse-class-parse-first-arg (sig)
  (let ((char (char-to-string (string-to-char sig))))
    (cond ((equal char "B") `("byte" . 1))
          ((equal char "C") `("char" . 1))
          ((equal char "D") `("double" . 1))
          ((equal char "F") `("float" . 1))
          ((equal char "I") `("int" . 1))
          ((equal char "J") `("long" . 1))
          ((equal char "L") (let ((endpos (string-match ";" sig)))
                              (cons (jde-parse-class-slash-to-dot
                                     (substring sig 1
                                                endpos))
                                    (+ 1 endpos))))
          ((equal char "S") `("short" . 1))
          ((equal char "Z") `("boolean" . 1))
          ((equal char "[") (let ((rest (jde-parse-class-parse-first-arg
                                         (substring sig 1))))
                              (cons (concat (car rest) "[]") (+ (cdr rest) 1))))
            (t (error (concat "Could not find char " char))))))

(defun jde-parse-class-parse-arg-signature (sig)
  (when (> (length sig) 0)
    (let ((arg (jde-parse-class-parse-first-arg sig)))
      (if (> (cdr arg) (length sig))
        (list (car arg))
        (cons (car arg) (jde-parse-class-parse-arg-signature
                         (substring sig (cdr arg))))))))
                                    

(defun jde-parse-class-parse-complete-arg-signature (sig)
  (let* ((match (string-match "(\\(.*\\))\\(.*\\)" sig)))
    (if match
      (let ((args (match-string 1 sig))
            (return-val (match-string 2 sig)))
        (list (unless (equal "V" return-val)
                (car (jde-parse-class-parse-arg-signature return-val)))
              (jde-parse-class-parse-arg-signature args)))
      (list nil (jde-parse-class-parse-arg-signature sig)))))
         

(defun jde-parse-class-parse-method-signature (siglist)
  `(,(jde-parse-class-slash-to-dot (car siglist))
    ,(cadr siglist) ,@(jde-parse-class-parse-complete-arg-signature
                      (nth 2 siglist))))

(defun jde-parse-class-lookup-method (method constants)
  (list (cadr (jde-parse-class-lookup-constant
               (cadr (jde-parse-class-lookup-constant
                       (cadr method) constants))
               constants))
        (cadr (jde-parse-class-lookup-constant
               (cadr 
                (jde-parse-class-lookup-constant (nth 2 method) constants))
               constants))
        (cadr (jde-parse-class-lookup-constant
               (nth 2
                (jde-parse-class-lookup-constant (nth 2 method) constants))
               constants))))

(defun get-bit-flags-for-byte (byte flag-vec)
  "Gets the bit flags for BYTE, given the flags that apply to each bit,
a vector of length 8 (one for each bit).  Nulls in the FLAG-VEC are 
taken to mean there is no flag for that byte, which causes the byte to be 
ignored.

For example: (get-bit-flags-for-byte 6 ['a 'b 'c 'd 'e 'f 'g 'h])
returns ('f 'g)"
  (let ((flags '()))
    (dotimes (i 8 flags)
      (when (and (aref flag-vec (- 7 i))
                 (> (logand (expt 2 i)  byte) 0))
        (add-to-list 'flags (aref flag-vec (- 7 i)))))))
          
(defun jde-parse-class-get-access-flags ()
  (do-and-advance-chars 2
    (let ((raw0 (char-after (point)))
          (raw1 (char-after (+ (point) 1))))
      (append
       (get-bit-flags-for-byte raw0
                               [nil nil nil nil 'string 'abstract
                                    'interface 'native])
       (get-bit-flags-for-byte raw1
                               ['transient 'volatile 'synchronized 'final
                                           'static 'protected
                                           'private 'public])))))

(defun jde-parse-class-get-version ()
  "Return a list - (major-version minor-version)"
  (list (jde-parse-class-get-2byte 5)
                  (jde-parse-class-get-2byte 7)))

(defun jde-parse-class-get-2byte (point)
  "Gets the value of two bytes (0 - 65535) as an int" 
  (let ((b1 (char-after point))
        (b2 (char-after (+ 1 point))))
    (+ (* b1 256) b2)))

(defun jde-parse-class-get-next-2-bytes ()
  (do-and-advance-chars 2
    (jde-parse-class-get-2byte (point))))

(defun jde-parse-class-get-4byte (point &optional ignore-large-val)
  (let ((db1 (jde-parse-class-get-2byte point))
        (db2 (jde-parse-class-get-2byte (+ 2 point))))
    (if (< db1 2047)
      ;; don't go over the maxint in elisp (2047, since we have 1 more db1 could be 65536)
      (+ (* 65536 db1) db2)
      (if ignore-large-val
        0
        (error "Class file has a larger 4 byte value then emacs can handle")))))

(defun jde-parse-class-get-next-4-bytes-as-signed (&optional ignore-large-val)
  (let ((db1 (jde-parse-class-get-next-2-bytes))
        (db2 (jde-parse-class-get-next-2-bytes)))
    (if (> (logand 32768 db1) 0)  ;; if it's high-bit is set, then it's negative.
      (if (> db1 63488)
        (- (+ 1 (+ (* (- 65535 db1) 65536) (- 65535 db2))))
        (if ignore-large-val
          0
          (error "Class file has an unsigned int who is smaller than emacs can handle")))
      (jde-parse-class-get-4byte (- (point) 4)))))

(defun jde-parse-class-get-next-4-bytes (&optional ignore-large-val)
  (do-and-advance-chars 4
    (jde-parse-class-get-4byte (point) ignore-large-val)))

(defun jde-parse-class-get-constants ()
  "Returns a list of the constant ending location (not inclusive of
of the constants) and a vector of all constants"
  (let* ((count (- (jde-parse-class-get-2byte 9) 1))
         (const-vec (make-vector count '())))
    (setq i 0)
    (goto-char 11) ;; start of constants
    (dotimes (i count const-vec)
      (let ((const (jde-parse-class-get-next-constant)))
        (aset const-vec i const)
        ;; doubles and longs take up two places on the const table. 
        (when (or (eq (car const) 'double)
                  (eq (car const) 'long))
          (aset const-vec (+ 1 i) nil)
          (setq i (+ 1 i)))))))

(defsubst jde-parse-class-get-long-constant (&optional ignore-large-val)
  (let ((qb1 (jde-parse-class-get-next-4-bytes ignore-large-val))
        (qb2 (jde-parse-class-get-next-4-bytes ignore-large-val)))
    (if (> qb2 0)
      (if ignore-large-val
        0
        (error "Class file has a large 8 byte value than emacs can handle"))
      qb1)))

(defsubst jde-parse-class-get-double-constant ()
  "NOT IMPLEMENTED YET"
  (do-and-advance-chars 8
    "0.0"))

(defsubst jde-parse-class-get-ref-constant ()
  (list (jde-parse-class-get-next-2-bytes) (jde-parse-class-get-next-2-bytes)))

(defsubst jde-parse-class-get-float-constant ()
  "NOT IMPLEMENTED YET"
  (do-and-advance-chars 4
    "0.0"))

(defsubst jde-parse-class-get-nameandtype-constant ()
  (list (jde-parse-class-get-next-2-bytes) (jde-parse-class-get-next-2-bytes)))

(defsubst jde-parse-class-get-utf8-constant ()
  (let* ((len (jde-parse-class-get-next-2-bytes))
         (result (encode-coding-string (buffer-substring (point)
                                                        (+ len (point)))
                                       'utf-8)))
    (goto-char (+ len (point)))
    result))

(defun jde-parse-class-get-next-constant ()
  (let ((const-type (char-after (point))))
    (forward-char)
    (cond ((eq const-type 7)
            `(class ,(jde-parse-class-get-next-2-bytes)))
          ((eq const-type 9)
            `(field ,@(jde-parse-class-get-ref-constant)))
          ((eq const-type 10)
            `(method ,@(jde-parse-class-get-ref-constant)))
          ((eq const-type 11)
            `(interface-method ,@(jde-parse-class-get-ref-constant)))
          ((eq const-type 8)
            `(string ,(jde-parse-class-get-next-2-bytes)))
          ((eq const-type 3)
            `(integer ,(jde-parse-class-get-next-4-bytes t)))
          ((eq const-type 4)
            `(float ,(jde-parse-class-get-float-constant)))
          ((eq const-type 5)
            `(long ,(jde-parse-class-get-long-constant t)))
          ((eq const-type 6)
            `(double ,(jde-parse-class-get-double-constant)))
          ((eq const-type 12)
            `(name-and-type ,@(jde-parse-class-get-nameandtype-constant)))
          ((eq const-type 1)
            `(utf8 ,(jde-parse-class-get-utf8-constant))))))

(defconst jde-parse-class-opcode-vec
  [(nop . 1)  ;; 0
   (aconst_null . 1) ;; 1
   (iconst_m1 . 1)  ;; 2
   (iconst_0 . 1)  ;; 3
   (iconst_1 . 1)  ;; 4
   (iconst_2 . 1)  ;; 5
   (iconst_3 . 1)  ;; 6
   (iconst_4 . 1)  ;; 7
   (iconst_5 . 1)  ;; 8
   (lconst_0 . 1)  ;; 9
   (lconst_1 . 1)  ;; 10
   (fconst_0 . 1)  ;; 11
   (fconst_1 . 1)  ;; 12
   (fconst_2 . 1)  ;; 13
   (dconst_0 . 1)  ;; 14
   (dconst_1 . 1)  ;; 15
   (bipush . 2)  ;; 16
   (sipush . 3)  ;; 17
   (ldc . 2)  ;; 18
   (ldc_w . 3)  ;; 19
   (ldc2_w . 3)  ;; 20
   (iload . 2)  ;; 21
   (lload . 2)  ;; 22
   (fload . 2)  ;; 23
   (dload . 2)  ;; 24
   (aload . 2)  ;; 25
   (iload_0 . 1)  ;; 26
   (iload_1 . 1)  ;; 27
   (iload_2 . 1)  ;; 28
   (iload_3 . 1)  ;; 29
   (lload_0 . 1)  ;; 30
   (lload_1 . 1)  ;; 31
   (lload_2 . 1)  ;; 32
   (lload_3 . 1)  ;; 33
   (fload_0 . 1)  ;; 34
   (fload_1 . 1)  ;; 35
   (fload_2 . 1)  ;; 36
   (fload_3 . 1)  ;; 37
   (dload_0 . 1)  ;; 38
   (dload_1 . 1)  ;; 39
   (dload_2 . 1)  ;; 40
   (dload_3 . 1)  ;; 41
   (aload_0 . 1)  ;; 42
   (aload_1 . 1)  ;; 43
   (aload_2 . 1)  ;; 44
   (aload_3 . 1)  ;; 45
   (iaload . 1)  ;; 46
   (laload . 1)  ;; 47
   (faload . 1)  ;; 48
   (daload . 1)  ;; 49
   (aaload . 1)  ;; 50
   (baload . 1)  ;; 51
   (caload . 1)  ;; 52
   (saload . 1)  ;; 53
   (istore . 2)  ;; 54
   (lstore . 2)  ;; 55
   (fstore . 2)  ;; 56
   (dstore . 2)  ;; 57
   (astore . 2)  ;; 58
   (istore_0 . 1)  ;; 59
   (istore_1 . 1)  ;; 60
   (istore_2 . 1)  ;; 61
   (istore_3 . 1)  ;; 62
   (lstore_0 . 1)  ;; 63
   (lstore_1 . 1)  ;; 64
   (lstore_2 . 1)  ;; 65
   (lstore_3 . 1)  ;; 66
   (fstore_0 . 1)  ;; 67
   (fstore_1 . 1)  ;; 68
   (fstore_2 . 1)  ;; 69
   (fstore_3 . 1)  ;; 70
   (dstore_0 . 1)  ;; 71
   (dstore_1 . 1)  ;; 72
   (dstore_2 . 1)  ;; 73
   (dstore_3 . 1)  ;; 74
   (astore_0 . 1)  ;; 75
   (astore_1 . 1)  ;; 76
   (astore_2 . 1)  ;; 77
   (astore_3 . 1)  ;; 78
   (iastore . 1)  ;; 79
   (lastore . 1)  ;; 80
   (fastore . 1)  ;; 81
   (dastore . 1)  ;; 82
   (aastore . 1)  ;; 83
   (bastore . 1)  ;; 84
   (castore . 1)  ;; 85
   (sastore . 1)  ;; 86
   (pop . 1)  ;; 87
   (pop2 . 1)  ;; 88
   (dup . 1)  ;; 89
   (dup_x1 . 1)  ;; 90
   (dup_x2 . 1)  ;; 91
   (dup2 . 1)  ;; 92
   (dup2_x1 . 1)  ;; 93
   (dup2_x2 . 1)  ;; 94
   (swap . 1)  ;; 95
   (iadd . 1)  ;; 96
   (ladd . 1)  ;; 97
   (fadd . 1)  ;; 98
   (dadd . 1)  ;; 99
   (isub . 1)  ;; 100
   (lsub . 1)  ;; 101
   (fsub . 1)  ;; 102
   (dsub . 1)  ;; 103
   (imul . 1)  ;; 104
   (lmul . 1)  ;; 105
   (fmul . 1)  ;; 106
   (dmul . 1)  ;; 107
   (idiv . 1)  ;; 108
   (ldiv . 1)  ;; 109
   (fdiv . 1)  ;; 110
   (ddiv . 1)  ;; 111
   (irem . 1)  ;; 112
   (lrem . 1)  ;; 113
   (frem . 1)  ;; 114
   (drem . 1)  ;; 115
   (ineg . 1)  ;; 116
   (lneg . 1)  ;; 117
   (fneg . 1)  ;; 118
   (dneg . 1)  ;; 119
   (ishl . 1)  ;; 120
   (lshl . 1)  ;; 121
   (ishr . 1)  ;; 122
   (lshr . 1)  ;; 123
   (iushr . 1)  ;; 124
   (lushr . 1)  ;; 125
   (iand . 1)  ;; 126
   (land . 1)  ;; 127
   (ior . 1)  ;; 128
   (lor . 1)  ;; 129
   (ixor . 1)  ;; 130
   (lxor . 1)  ;; 131
   (iinc . 3)  ;; 132
   (i2l . 1)  ;; 133
   (i2f . 1)  ;; 134
   (i2d . 1)  ;; 135
   (l2i . 1)  ;; 136
   (l2f . 1)  ;; 137
   (l2d . 1)  ;; 138
   (f2i . 1)  ;; 139
   (f2l . 1)  ;; 140
   (f2d . 1)  ;; 141
   (d2i . 1)  ;; 142
   (d2l . 1)  ;; 143
   (d2f . 1)  ;; 144
   (i2b . 1)  ;; 145
   (i2c . 1)  ;; 146
   (i2s . 1)  ;; 147
   (lcmp . 1)  ;; 148
   (fcmpl . 1)  ;; 149
   (fcmpg . 1)  ;; 150
   (dcmpl . 1)  ;; 151
   (dcmpg . 1)  ;; 152
   (ifeq . 3)  ;; 153
   (ifne . 3)  ;; 154
   (iflt . 3)  ;; 155
   (ifge . 3)  ;; 156
   (ifgt . 3)  ;; 157
   (ifle . 3)  ;; 158
   (if_icmpeq . 3)  ;; 159
   (if_icmpne . 3)  ;; 160
   (if_icmplt . 3)  ;; 161
   (if_icmpge . 3)  ;; 162
   (if_icmpgt . 3)  ;; 163
   (if_icmple . 3)  ;; 164
   (if_acmpeq . 3)  ;; 165
   (if_acmpne . 3)  ;; 166
   (goto . 3)  ;; 167
   (jsr . 3)  ;; 168
   (ret . 2)  ;; 169
   (tableswitch . -1)  ;; 170  - variable length instruction
   (lookupswitch . -1)  ;; 171   - variable length instruction
   (ireturn . 1)  ;; 172
   (lreturn . 1)  ;; 173
   (freturn . 1)  ;; 174
   (dreturn . 1)  ;; 175
   (areturn . 1)  ;; 176
   (return . 1)  ;; 177
   (getstatic . 3)  ;; 178
   (putstatic . 3)  ;; 179
   (getfield . 3)  ;; 180
   (putfield . 3)  ;; 181
   (invokevirtual . 3)  ;; 182
   (invokespecial . 3)  ;; 183
   (invokestatic . 3)  ;; 184
   (invokeinterface . 5)  ;; 185
   (unused . -1) ;; 186
   (new . 3)  ;; 187
   (newarray . 2)  ;; 188
   (anewarray . 3)  ;; 189
   (arraylength . 1)  ;; 190
   (athrow . 1) ;; 191
   (checkcast . 3) ;; 192
   (instanceof . 3)  ;; 193
   (monitorcenter . 1)  ;; 194
   (monitorexit . 1)  ;; 195
   (wide . -1)  ;; 196   - variable length instruction
   (multianewarray . 4)  ;; 197
   (ifnull . 3)  ;; 198
   (ifnonnull . 3)  ;; 199
   (goto_w . 5)  ;; 200
   (jsr_w . 5)  ;; 201
   ]
  "A vector storing the java opcodes.  Each position in the vector is
in the position of it's bytecode number.  For example, if, when
reading a class file we come across bytecode 0, we can just look at
this vector to see both the name of the instruction, and the size of
the operation in bytes.  A few opcodes have variable length, so those
must be calculated at runtime.")
    
(provide 'jde-parse-class)

;; $Log$
;; Revision 1.1  2003/01/18 05:48:46  andyp
;; sync to jde 2.3.2
;;
;; Revision 1.4  2002/12/01 02:39:58  ahyatt
;; Support for jde-xref's latest improvements, which require more
;; information from each class.
;;
;; Revision 1.3  2002/11/21 04:26:33  ahyatt
;; Changed my e-mail address to andy_jde@thehyatts.net
;;
;; Revision 1.2  2002/11/21 04:03:47  ahyatt
;; Fixed a bug in jde-parse-class where two functions had the same
;; definition.  The fix involved renamed a few classes to keep
;; consistency.  jde-xref had to change as well.
;;
;; Removed a (newline) function call in jde-xref and replaced it with a "\n"
;;
;; In jde-xref, rewrote the parts of jde-xref-make-db-from-path which
;; dealt with keeping track of the already parsed classes. Previous
;; solution was really kludgey, this solution is only somewhat kludgey.
;; I'm still thinking about this problem.
;;
;; Revision 1.1  2002/11/18 07:02:18  paulk
;; Initial release.
;;

;; end of jde-xref.el