1"======================================================================
2|
3|   Metaobjects for Java: types, classes, methods, bytecodes
4|
5|
6 ======================================================================"
7
8
9"======================================================================
10|
11| Copyright 2003 Free Software Foundation, Inc.
12| Written by Paolo Bonzini.
13|
14| This file is part of GNU Smalltalk.
15|
16| The GNU Smalltalk class library is free software; you can redistribute it
17| and/or modify it under the terms of the GNU General Public License
18| as published by the Free Software Foundation; either version 2, or (at
19| your option) any later version.
20|
21| The GNU Smalltalk class library is distributed in the hope that it will be
22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
24| Public License for more details.
25|
26| You should have received a copy of the GNU Lesser General Public License
27| along with the GNU Smalltalk class library; see the file COPYING.  If not,
28| write to the Free Software Foundation, 51 Franklin Street, Fifth Floor,
29| Boston, MA 02110-1301, USA.
30|
31 ======================================================================"
32
33Object subclass: #JavaReader
34    instanceVariableNames: 'stream constantPool '
35    classVariableNames: ''
36    poolDictionaries: ''
37    category: 'Java-Class files'!
38
39Java.gnu.smalltalk.JavaReader comment: '
40JavaReader is an abstract superclass for objects that deal with Java
41data: it has methods for handling a constant pool and to read
42big-endian or UTF8 values from a Stream.
43
44Instance Variables:
45    constantPool	<Collection>
46	the constant pool from which to read strings and the like
47    stream	<Stream>
48	the Stream from which to read bytes
49
50'!
51
52
53Object subclass: #JavaProgramElement
54    instanceVariableNames: 'flags name attributes '
55    classVariableNames: 'Final Synthetic Protected FlagsStrings Private
56    	Deprecated Volatile Synchronized Abstract Static Native Public
57	Interface Transient ThreadSafe'
58    poolDictionaries: ''
59    category: 'Java-Metaobjects'!
60
61Java.gnu.smalltalk.JavaProgramElement comment: '
62JavaProgramElement represents a Java class, field or method.  It
63includes several methods to handle attributes and flags.
64
65Subclasses should override #addAttribute: so that the most common
66attributes are stored (more intuitively) in instance variables.
67
68Instance Variables:
69    attributes	<IdentityDictionary of: (Symbol -> JavaAttribute)>
70	the attributes defined for this program element
71    flags	<Integer>
72	the access flags attached to this program element.
73    name	<Symbol>
74	the name of this program element.
75
76'!
77
78
79Object subclass: #JavaExceptionHandler
80    instanceVariableNames: 'startpc length handlerpc type '
81    classVariableNames: ''
82    poolDictionaries: ''
83    category: 'Java-Class files'!
84
85Java.gnu.smalltalk.JavaExceptionHandler comment: '
86JavaExceptionHandler represents one of the exception handlers that are
87active within a method.
88
89Instance Variables:
90    handlerpc	<Integer>
91	the program counter value at which the exception handler starts
92    length	<Integer>
93	the number of bytecodes for which the exception handler stays active.
94    startpc	<Integer>
95	the program counter value at which the exception handler becomes active.
96    type	<JavaType | nil>
97	the type of the exception that is caught, or nil for all exceptions
98
99'!
100
101
102JavaReader subclass: #JavaInstructionInterpreter
103    instanceVariableNames: 'pc wide nPairs '
104    classVariableNames: 'DecoderTable ArrayTypes'
105    poolDictionaries: ''
106    category: 'Java-Metaobjects'!
107
108Java.gnu.smalltalk.JavaInstructionInterpreter comment: '
109JavaInstructionInterpreter knows the format of the bytecodes and
110dispatches them to its own abstract methods.
111
112Subclasses can override #interpret, for example to interpret only a
113few bytecodes (see JavaEdgeCreator), or #dispatch: to execute
114operations before and after the method for the bytecode is executed.
115
116Instance Variables:
117    nPairs	<Integer>
118	used to parse lookupswitch
119    pc	<Integer>
120	the program counter at which the currently dispatched bytecode starts.
121    wide	<Boolean>
122	used to parse the ''wide'' opcode
123
124'!
125
126
127JavaProgramElement subclass: #JavaClass
128    instanceVariableNames: 'fullName package extends implements methods fields constantPool sourceFile '
129    classVariableNames: ''
130    poolDictionaries: ''
131    category: 'Java-Metaobjects'!
132
133Java.gnu.smalltalk.JavaClass comment: '
134This class represent the full information available for a Java class,
135read from a .class file.
136
137Instance Variables:
138    constantPool	<Array>
139	the constant pool of the class, as read from the .class file
140    extends	<JavaClass>
141	the superclass of the class
142    fields	<(Collection of: JavaField)>
143	the list of fields in the class
144    fullName	<String>
145        the cached fully qualified name of the class
146    implements	<(Collection of: JavaClass)>
147	the list of interfaces that the class implements
148    methods	<(Collection of: JavaMethod)>
149	the list of methods that the class defines
150    package	<JavaPackage>
151	the package that holds the class
152    sourceFile	<String>
153	the Java source file in which the class is defined
154
155'!
156
157
158JavaProgramElement subclass: #JavaClassElement
159    instanceVariableNames: 'signature javaClass '
160    classVariableNames: ''
161    poolDictionaries: ''
162    category: 'Java-Metaobjects'!
163
164Java.gnu.smalltalk.JavaClassElement comment: '
165JavaClassElement represents a Java field or method.  These both belong
166to a class, and have a type or signature; however, they differ in the
167set of supported attributes.
168
169Instance Variables:
170    javaClass	<Object>
171	the class in which the field or method belongs.
172    signature	<JavaType>
173	the type or signature of the field or method.
174
175'!
176
177
178JavaClassElement subclass: #JavaMethod
179    instanceVariableNames: 'maxStack maxLocals bytecodes exceptions handlers localVariables lines selector '
180    classVariableNames: ''
181    poolDictionaries: ''
182    category: 'Java-Metaobjects'!
183
184Java.gnu.smalltalk.JavaMethod comment: '
185JavaMethod represents a Java method.
186
187Instance Variables:
188    bytecodes	<ByteArray>
189	see JavaCodeAttribute
190    exceptions	<(Collection of: JavaClass)>
191	see JavaCodeAttribute
192    handlers	<(Collection of: JavaExceptionHandler)>
193	see JavaCodeAttribute
194    lines	<(SequenceableCollection of: Association)>
195	see JavaLineNumberTableAttribute
196    localVariables	<(Collection of: JavaLocalVariable)>
197	see JavaLocalVariableTableAttribute
198    maxLocals	<Integer>
199	see JavaCodeAttribute
200    maxStack	<Integer>
201	see JavaCodeAttribute
202    selector	<Symbol>
203	the selector that is used in Smalltalk bytecodes.
204'!
205
206
207Object subclass: #JavaDescriptor
208    instanceVariableNames: ''
209    classVariableNames: ''
210    poolDictionaries: ''
211    category: 'Java-Metaobjects'!
212
213Java.gnu.smalltalk.JavaDescriptor comment: '
214JavaDescriptor represents the constant-pool entries for names, types
215or references to methods/fields.'!
216
217
218JavaDescriptor subclass: #JavaRef
219    instanceVariableNames: 'javaClass nameAndType '
220    classVariableNames: ''
221    poolDictionaries: ''
222    category: 'Java-Metaobjects'!
223
224Java.gnu.smalltalk.JavaRef comment: '
225JavaRef associates the class which defines it to the name and type of
226a method or field.
227
228Instance Variables:
229    javaClass	<JavaClass>
230	the class which defines the method or field
231    nameAndType	<JavaDescriptor>
232	the name and type of the method or field
233
234'!
235
236
237JavaRef subclass: #JavaFieldRef
238    instanceVariableNames: 'getSelector putSelector'
239    classVariableNames: ''
240    poolDictionaries: ''
241    category: 'Java-Metaobjects'!
242
243Java.gnu.smalltalk.JavaFieldRef comment: '
244JavaFieldRef represents a reference to a Java field made within a method.
245They are shared between methods in the same class, so the get/put
246selectors are cached.
247
248Instance Variables:
249    getSelector		<Symbol>
250        the selector used to do read accesses to the field
251    putSelector		<Symbol>
252        the selector used to do write accesses to the field'!
253
254JavaRef subclass: #JavaMethodRef
255    instanceVariableNames: 'selector'
256    classVariableNames: ''
257    poolDictionaries: ''
258    category: 'Java-Metaobjects'!
259
260Java.gnu.smalltalk.JavaMethodRef comment: '
261JavaMethodRef represents a reference to a Java method made from a
262method invocation bytecode.
263
264Instance Variables:
265    selector		<Symbol>
266        the selector used in the translated bytecodes'!
267
268JavaDescriptor subclass: #JavaType
269    instanceVariableNames: ''
270    classVariableNames: ''
271    poolDictionaries: ''
272    category: 'Java-Metaobjects'!
273
274Java.gnu.smalltalk.JavaType comment: '
275JavaType is an abstract class for Java types or signatures.
276
277Subclasses must implement the following messages:
278    printing
279    	printEncodingOn:		print the encoding of the type as found in .class files
280'!
281
282
283JavaType subclass: #JavaObjectType
284    instanceVariableNames: 'javaClass '
285    classVariableNames: ''
286    poolDictionaries: ''
287    category: 'Java-Metaobjects'!
288
289Java.gnu.smalltalk.JavaObjectType comment: '
290JavaObjectType represents the type of instances of a Java class.
291
292Instance Variables:
293    javaClass	<JavaClass>
294	the class whose type is represented by the object
295
296'!
297
298
299JavaType subclass: #JavaMethodType
300    instanceVariableNames: 'returnType argTypes '
301    classVariableNames: ''
302    poolDictionaries: ''
303    category: 'Java-Metaobjects'!
304
305Java.gnu.smalltalk.JavaMethodType comment: '
306JavaMethodType represent the signature (types of the arguments, and
307returned type) of a Java method.
308
309Instance Variables:
310    argTypes	<(Collection of: JavaType)>
311	the method''s arguments'' type
312    returnType	<JavaType>
313	the method''s return type
314
315'!
316
317
318JavaType subclass: #JavaArrayType
319    instanceVariableNames: 'subType '
320    classVariableNames: ''
321    poolDictionaries: ''
322    category: 'Java-Metaobjects'!
323
324Java.gnu.smalltalk.JavaArrayType comment: '
325JavaArrayType represents Java array types.
326
327Instance Variables:
328    subType	<JavaType>
329	the type of each element of the array.
330
331'!
332
333
334JavaInstructionInterpreter subclass: #JavaInstructionPrinter
335    instanceVariableNames: 'output localVariableTable lineNumberTable '
336    classVariableNames: ''
337    poolDictionaries: ''
338    category: 'Java-Metaobjects'!
339
340Java.gnu.smalltalk.JavaInstructionPrinter comment: '
341JavaInstructionPrinter can print a commented listing of Java bytecodes
342on an output stream.
343
344Instance Variables:
345    output	<Stream>
346	the stream on which to write
347    lineNumberTable	<Stream>
348	a stream on a sorted array of pc->line number pairs
349    localVariableTable	<Array of: (SortedCollection of: JavaLocalVariable)>
350	an array that groups the JavaLocalVariables for the method depending on the slot they refer to
351
352'!
353
354
355JavaDescriptor subclass: #JavaNameAndType
356    instanceVariableNames: 'name type '
357    classVariableNames: ''
358    poolDictionaries: ''
359    category: 'Java-Metaobjects'!
360
361Java.gnu.smalltalk.JavaNameAndType comment: '
362JavaNameAndType associates the name of a field or method to its type.
363
364Instance Variables:
365    name	<Symbol>
366	the name of the field or method
367    type	<JavaType>
368	the type or signature of the field or method
369
370'!
371
372
373JavaType subclass: #JavaPrimitiveType
374    instanceVariableNames: 'id name wordSize zeroValue arrayClass '
375    classVariableNames: 'JavaLong JavaShort JavaFloat JavaInt JavaChar
376	JavaByte JavaVoid PrimitiveTypes JavaDouble JavaBoolean'
377    poolDictionaries: ''
378    category: 'Java-Metaobjects'!
379
380Java.gnu.smalltalk.JavaPrimitiveType comment: '
381JavaPrimitiveType represents one of Java''s primitive types.
382It has a fixed number of instances, all held in class variables.
383
384Instance Variables:
385    id	<Character>
386	the one character representation of the type
387    name	<String>
388	the source code representation of the type (e.g. int)
389
390'!
391
392
393Object subclass: #JavaLocalVariable
394    instanceVariableNames: 'startpc length name type slot '
395    classVariableNames: ''
396    poolDictionaries: ''
397    category: 'Java-Class files'!
398
399Java.gnu.smalltalk.JavaLocalVariable comment: '
400JavaLocalVariable represents a local variable''s single liveness range
401within a Java method.  If a Java compiler performs live range
402splitting, in other words, there might be many JavaLocalVariable
403instances for the same variable.
404
405Instance Variables:
406
407Instance Variables:
408    length	<Integer>
409	the number of bytecodes for which the variable becomes live
410    name	<String>
411	the name of the local variable
412    slot	<Integer>
413	the local variable slot in which the variable is stored
414    startpc	<Integer>
415	the program counter value at which the variable becomes live
416    type	<JavaType>
417	the type of the variable
418'!
419
420
421Object subclass: #JavaPackage
422    instanceVariableNames: 'container contents name '
423    classVariableNames: 'Root'
424    poolDictionaries: ''
425    category: 'Java-Metaobjects'!
426
427Java.gnu.smalltalk.JavaPackage comment: '
428JavaPackage represents a Java package.
429
430Instance Variables:
431    container	<JavaPackage | nil>
432	the package in which this package is contained
433    contents	<Dictionary of: (Symbol -> (JavaPackage | JavaClass))>
434	the contents of the package
435    name	<Symbol>
436	the name of the package
437
438'!
439
440
441JavaClassElement subclass: #JavaField
442    instanceVariableNames: 'constantValue getSelector putSelector'
443    classVariableNames: ''
444    poolDictionaries: ''
445    category: 'Java-Metaobjects'!
446
447Java.gnu.smalltalk.JavaField comment: '
448JavaField represents a Java field within a class.
449
450Instance Variables:
451    constantValue	<Object | nil>
452	the constant value for final fields, or nil
453    getSelector		<Symbol>
454        the selector used to do read accesses to the field
455    putSelector		<Symbol>
456        the selector used to do write accesses to the field'!
457
458
459!JavaReader methodsFor: 'accessing'!
460
461constantPool
462    ^constantPool
463!
464
465constantPool: anObject
466    constantPool := anObject
467!
468
469stream
470    ^stream
471!
472
473stream: anObject
474    stream := anObject.
475! !
476
477!JavaReader methodsFor: 'utility'!
478
479next: n collect: aBlock
480    ^self next: n collect: aBlock into: Array
481!
482
483next: n collect: aBlock into: aClass
484    | result |
485    result := aClass new: n.
486    1 to: n do: [ :i | result at: i put: (aBlock value: result) ].
487    ^result
488! !
489
490!JavaReader methodsFor: 'stream accessing'!
491
492nextByte
493    "Read a 32-bit quantity from the input stream."
494
495    ^stream next asInteger
496!
497
498nextBytes: anInteger
499    "Read a 32-bit quantity from the input stream."
500
501    | ba |
502    ba := ByteArray new: anInteger.
503    1 to: anInteger do: [ :i | ba at: i put: stream next asInteger ].
504    ^ba
505!
506
507nextConstant
508    | index |
509    index := self nextUshort.
510    ^index = 0 ifTrue: [ nil ] ifFalse: [ self constantPool at: index ]
511!
512
513nextDouble
514    "Read a 64-bit floating-point quantity from the input stream."
515
516    | m1 m2 m3 m4 m5 m6 m7 m8 s e m |
517    m1 := stream next asInteger.
518    m2 := stream next asInteger.
519    m3 := stream next asInteger.
520    m4 := stream next asInteger.
521    m5 := stream next asInteger.
522    m6 := stream next asInteger.
523    m7 := stream next asInteger.
524    m8 := stream next asInteger.
525
526    "Extract sign and exponent"
527    s := m1 > 128 ifTrue: [ -1.0d ] ifFalse: [ 1.0d ].
528    e := (m1 bitAnd: 127) * 16 + ((m2 bitAnd: 240) bitShift: -4).
529
530    "Extract mantissa and check for infinity or NaN"
531    m := (((((((m2 bitAnd: 15) bitShift: 8) + m3
532        bitShift: 8) + m4
533        bitShift: 8) + m5
534        bitShift: 8) + m6
535        bitShift: 8) + m7
536        bitShift: 8) + m8.
537
538    e = 16r7FF ifTrue: [
539        ^m = 0
540	    ifTrue: [ 1.0d / (0.0d * s) ]
541	    ifFalse: [ (1.0d / 0.0d) - (1.0d / 0.0d) ].
542    ].
543
544    "Check for zero and denormals, then convert to a floating-point value"
545    e = 0
546        ifTrue: [ e := 1 ]
547        ifFalse: [ m := m + 16r10000000000000 ].
548
549    ^m * s timesTwoPower: e - 1075
550!
551
552nextFloat
553    "Read a 32-bit floating-point quantity from the input stream."
554
555    | m1 m2 m3 m4 s e m |
556    m1 := stream next asInteger.
557    m2 := stream next asInteger.
558    m3 := stream next asInteger.
559    m4 := stream next asInteger.
560
561    "Extract sign and exponent"
562    s := m1 > 128 ifTrue: [ -1.0e ] ifFalse: [ 1.0e ].
563    e := m1 * 2 + ((m2 bitAnd: 128) bitShift: -7).
564
565    "Extract mantissa and check for infinity or NaN"
566    m := (((m2 bitAnd: 127) bitShift: 8) + m3 bitShift: 8) + m4.
567    e = 127 ifTrue: [
568        ^m = 0
569	    ifTrue: [ 1.0e / (0.0e * s) ]
570	    ifFalse: [ (1.0e / 0.0e) - (1.0e / 0.0e) ].
571    ].
572
573    "Check for zero and denormals, then convert to a floating-point value"
574    e = 0
575        ifTrue: [ e := 1 ]
576        ifFalse: [ m := m + 16r800000 ].
577
578    ^m * s timesTwoPower: e - 150
579!
580
581nextInt
582    "Read a 32-bit quantity from the input stream."
583
584    | m1 m2 m3 m4 |
585    m1 := stream next asInteger.
586    m2 := stream next asInteger.
587    m3 := stream next asInteger.
588    m4 := stream next asInteger.
589    m1 >= 128 ifTrue: [m1 := m1 - 256].
590    ^(((m1 bitShift: 8) + m2
591        bitShift: 8) + m3
592        bitShift: 8) + m4
593!
594
595nextLong
596    "Read a 32-bit quantity from the input stream."
597
598    | m1 m2 m3 m4 m5 m6 m7 m8 |
599    m1 := stream next asInteger.
600    m2 := stream next asInteger.
601    m3 := stream next asInteger.
602    m4 := stream next asInteger.
603    m5 := stream next asInteger.
604    m6 := stream next asInteger.
605    m7 := stream next asInteger.
606    m8 := stream next asInteger.
607    m1 >= 128 ifTrue: [m1 := m1 - 256].
608    ^(((((((m1 bitShift: 8) + m2
609    	bitShift: 8) + m3
610    	bitShift: 8) + m4
611    	bitShift: 8) + m5
612    	bitShift: 8) + m6
613    	bitShift: 8) + m7
614    	bitShift: 8) + m8
615!
616
617nextShort
618    "Answer the next two bytes from the receiver as an Integer."
619
620    | high low |
621    high := stream next asInteger.
622    low := stream next asInteger.
623    high >= 128 ifTrue: [ high := high - 256 ].
624    ^(high bitShift: 8) + low
625!
626
627nextSignedByte
628    "Answer the next two bytes from the receiver as an Integer."
629
630    | byte |
631    byte := stream next asInteger.
632    ^byte >= 128 ifTrue: [ byte - 256 ] ifFalse: [ byte ]
633!
634
635nextUint
636    "Read a 32-bit quantity from the input stream."
637
638    | m1 m2 m3 m4 |
639    m1 := stream next asInteger.
640    m2 := stream next asInteger.
641    m3 := stream next asInteger.
642    m4 := stream next asInteger.
643    ^(((((m1 bitShift: 8) + m2) bitShift: 8) + m3) bitShift: 8) + m4
644!
645
646nextUlong
647    "Read a 32-bit quantity from the input stream."
648
649    | m1 m2 m3 m4 m5 m6 m7 m8 |
650    m1 := stream next asInteger.
651    m2 := stream next asInteger.
652    m3 := stream next asInteger.
653    m4 := stream next asInteger.
654    m5 := stream next asInteger.
655    m6 := stream next asInteger.
656    m7 := stream next asInteger.
657    m8 := stream next asInteger.
658    ^(((((((m1 bitShift: 8) + m2
659    	bitShift: 8) + m3
660    	bitShift: 8) + m4
661    	bitShift: 8) + m5
662    	bitShift: 8) + m6
663    	bitShift: 8) + m7
664    	bitShift: 8) + m8
665!
666
667nextUshort
668    "Answer the next two bytes from the receiver as an Integer."
669
670    | high low |
671    high := stream next asInteger.
672    low := stream next asInteger.
673    ^(high bitShift: 8) + low
674!
675
676nextUTF8Char
677    "Read a 32-bit quantity from the input stream."
678
679    ^self nextUTF8Value asCharacter
680!
681
682nextUTF8String
683    "Read a 32-bit quantity from the input stream."
684    | s bytes finalPosition |
685    bytes := self nextUshort.
686    s := (String new: bytes) writeStream.
687    finalPosition := stream position + bytes.
688    [ stream position < finalPosition ] whileTrue: [ s nextPut: self nextUTF8Char ].
689    ^s contents
690!
691
692nextUTF8Value
693    "Read a 32-bit quantity from the input stream."
694
695    | first |
696    first := stream next asInteger.
697    first <= 2r01111111 ifTrue: [ ^first ].
698    first <= 2r11011111 ifTrue: [ ^(first - 2r11000000) * 64 + (stream next asInteger bitAnd: 63) ].
699    first <= 2r11101111 ifTrue: [ ^((first - 2r11100000) * 4096) + ((stream next asInteger bitAnd: 63) * 64) + (stream next asInteger bitAnd: 63) ].
700    self error: 'invalid UTF-8 character'
701! !
702
703!JavaReader class methodsFor: 'instance creation'!
704
705on: aStream
706    ^self new
707    stream: aStream;
708    yourself
709! !
710
711!JavaProgramElement methodsFor: 'initializing'!
712
713initialize
714    self flags: 0.
715! !
716
717!JavaProgramElement methodsFor: 'accessing'!
718
719addAttribute: aJavaAttribute
720    aJavaAttribute class == JavaDeprecatedAttribute
721    ifTrue:
722    [self addDeprecated.
723    ^aJavaAttribute].
724    attributes isNil ifTrue: [attributes := LookupTable new].
725    attributes at: aJavaAttribute attributeName put: aJavaAttribute.
726    ^aJavaAttribute
727!
728
729addFlag: aFlag
730    self flags: (self flags bitOr: aFlag)
731!
732
733attributes
734    ^attributes
735!
736
737attributes: anObject
738    attributes := nil.
739    anObject do: [ :each | self addAttribute: each ]
740!
741
742flags
743    ^flags
744!
745
746flags: allFlags
747    flags := allFlags
748!
749
750is: flag
751    ^(self flags bitAnd: flag) == flag
752!
753
754isAny: flag
755    ^(self flags bitAnd: flag) > 0
756!
757
758name
759    ^name
760!
761
762name: anObject
763    name := anObject asSymbol
764!
765
766removeFlag: aFlag
767    self flags: (self flags bitAnd: aFlag bitInvert)
768! !
769
770!JavaProgramElement methodsFor: 'accessing flags'!
771
772addAbstract
773    self addFlag: Abstract
774!
775
776addDeprecated
777    self addFlag: Deprecated
778!
779
780addFinal
781    self addFlag: Final
782!
783
784addNative
785    self addFlag: Native
786!
787
788addStatic
789    self addFlag: Static
790!
791
792addSynchronized
793    self addFlag: Synchronized
794!
795
796addSynthetic
797    self addFlag: Synthetic
798!
799
800addTransient
801    self addFlag: Transient
802!
803
804addVolatile
805    self addFlag: Volatile
806!
807
808beClass
809    self removeFlag: Interface
810!
811
812beInterface
813    self addFlag: Interface
814!
815
816bePackageVisible
817    self removeFlag: Protected.
818    self removeFlag: Private.
819    self removeFlag: Public
820!
821
822bePrivate
823    self removeFlag: Protected.
824    self removeFlag: Public.
825    self addFlag: Private
826!
827
828beProtected
829    self removeFlag: Private.
830    self removeFlag: Public.
831    self addFlag: Protected
832!
833
834bePublic
835    self removeFlag: Protected.
836    self removeFlag: Private.
837    self addFlag: Public
838!
839
840isAbstract
841    ^self is: Abstract
842!
843
844isDeprecated
845    ^self is: Deprecated
846!
847
848isFinal
849    ^self is: Final
850!
851
852isInterface
853    ^self is: Interface
854!
855
856isNative
857    ^self is: Native
858!
859
860isPackageVisible
861    ^(self isAny: Protected + Private + Public) not
862!
863
864isPrivate
865    ^self is: Private
866!
867
868isProtected
869    ^self is: Protected
870!
871
872isPublic
873    ^self is: Public
874!
875
876isStatic
877    ^self is: Static
878!
879
880isSynchronized
881    ^self is: Synchronized
882!
883
884isSynthetic
885    ^self is: Synthetic
886!
887
888isThreadSafe
889    ^self isAny: ThreadSafe
890!
891
892isTransient
893    ^self is: Transient
894!
895
896isVolatile
897    ^self is: Volatile
898!
899
900removeAbstract
901    self removeFlag: Abstract
902!
903
904removeDeprecated
905    self removeFlag: Deprecated
906!
907
908removeFinal
909    self removeFlag: Final
910!
911
912removeNative
913    self removeFlag: Native
914!
915
916removeStatic
917    self removeFlag: Static
918!
919
920removeSynchronized
921    self removeFlag: Synchronized
922!
923
924removeSynthetic
925    self removeFlag: Synthetic
926!
927
928removeThreadSafe
929    self removeFlag: ThreadSafe
930!
931
932removeTransient
933    self removeFlag: Transient
934!
935
936removeVolatile
937    self removeFlag: Volatile
938! !
939
940!JavaProgramElement methodsFor: 'printing'!
941
942print: flag on: aStream
943    (self is: flag) ifTrue: [
944        aStream
945            nextPutAll: (FlagsStrings at: flag);
946            space
947    ]
948!
949
950printFlagsOn: aStream
951    | bit |
952    bit := 1.
953    [FlagsStrings includesKey: bit] whileTrue:
954    		[self print: bit on: aStream.
955    		bit := bit * 2]
956!
957
958printOn: aStream
959    self printFlagsOn: aStream
960! !
961
962!JavaProgramElement class methodsFor: 'initializing'!
963
964initialize
965    "self initialize"
966    Public := 1.
967    Private := 2.
968    Protected := 4.
969    Static := 8.
970    Final := 16.
971    Synchronized := 32.
972    Volatile := 64.
973    ThreadSafe := 96.
974    Transient := 128.
975    Native := 256.
976    Interface := 512.
977    Abstract := 1024.
978    Synthetic := 2048.
979    Deprecated := 4096.
980    FlagsStrings := LookupTable new.
981    self classPool keysAndValuesDo: [ :k :v |
982        v isInteger
983            ifTrue: [ FlagsStrings at: v put: k asString asLowercase ]
984    ]
985! !
986
987!JavaProgramElement class methodsFor: 'instance creation'!
988
989new
990    ^self basicNew initialize
991! !
992
993!JavaExceptionHandler methodsFor: 'accessing'!
994
995finalpc
996    ^self startpc + self length
997!
998
999finalpc: anObject
1000    length := anObject - self startpc
1001!
1002
1003handlerpc
1004    ^handlerpc
1005!
1006
1007handlerpc: anObject
1008    handlerpc := anObject
1009!
1010
1011includes: pc
1012    ^pc >= self startpc
1013	and: [ pc < (self startpc + self length) ]
1014!
1015
1016isFinallyHandler
1017    ^self type isNil
1018!
1019
1020length
1021    ^length
1022!
1023
1024length: anObject
1025    length := anObject
1026!
1027
1028startpc
1029    ^startpc
1030!
1031
1032startpc: anObject
1033    startpc := anObject
1034!
1035
1036type
1037    ^type
1038!
1039
1040type: anObject
1041    type := anObject
1042! !
1043
1044!JavaExceptionHandler methodsFor: 'printing'!
1045
1046printOn: s
1047    s nextPutAll: 'handler for '.
1048    self type isNil
1049    	ifTrue: [ s nextPutAll: 'all exceptions' ]
1050	ifFalse: [
1051	    self type isClass
1052	    	ifTrue: [ self type storeOn: s ]
1053		ifFalse: [ self type printFullNameOn: s ] ].
1054
1055    s nextPutAll: ' at '; print: self handlerpc.
1056    s nextPutAll: ', active between '; print: self startpc.
1057    s nextPutAll: ' and '; print: self finalpc
1058! !
1059
1060!JavaExceptionHandler class methodsFor: 'instance creation'!
1061
1062startpc: startpc finalpc: finalpc handlerpc: handlerpc type: type
1063    ^self new
1064    startpc: startpc;
1065    length: finalpc - startpc;
1066    handlerpc: handlerpc;
1067    type: type;
1068    yourself
1069! !
1070
1071!JavaInstructionInterpreter methodsFor: 'interpretation'!
1072
1073dispatch
1074    pc := stream position.
1075    self dispatch: self nextByte.
1076!
1077
1078dispatch: insn
1079    | op spec |
1080    spec := DecoderTable at: insn + 1 ifAbsent: [nil].
1081    spec isNil ifTrue: [spec := Array with: #invalid: with: insn].
1082    op := spec first.
1083    spec size = 1
1084    	ifTrue:
1085    		[self perform: op.
1086    		^op].
1087    spec size = 2
1088    	ifTrue:
1089[Smalltalk debug.
1090    		self perform: op with: (self getArg: (spec at: 2)).
1091    		^op].
1092    spec size = 3
1093    	ifTrue:
1094    		[self
1095    			perform: op
1096    			with: (self getArg: (spec at: 2))
1097    			with: (self getArg: (spec at: 3)).
1098    		^op].
1099    spec size = 4
1100    	ifTrue:
1101    		[self
1102    			perform: op
1103    			with: (self getArg: (spec at: 2))
1104    			with: (self getArg: (spec at: 3))
1105    			with: (self getArg: (spec at: 4)).
1106    		^op].
1107    self perform: op
1108    	withArguments: (Array
1109    			with: (self getArg: (spec at: 2))
1110    			with: (self getArg: (spec at: 3))
1111    			with: (self getArg: (spec at: 4))
1112    			with: (self getArg: (spec at: 5))).
1113    ^op
1114!
1115
1116interpret
1117    [stream atEnd] whileFalse: [self dispatch]
1118!
1119
1120nextPC
1121    ^stream position
1122!
1123
1124nextPC: position
1125    stream position: position
1126! !
1127
1128!JavaInstructionInterpreter methodsFor: 'operand decoding'!
1129
1130arrayTypeByte
1131    ^ArrayTypes at: self nextByte ifAbsent: [ #bad ]
1132!
1133
1134constIndexByte
1135    ^self constantPool at: self nextByte
1136!
1137
1138constIndexShort
1139    ^self constantPool at: self nextUshort
1140!
1141
1142defaultSwitchAddress
1143    | newPC |
1144    newPC := pc.
1145
1146    [newPC := newPC + 1.
1147    newPC \\ 4 > 0] whileTrue: [stream next].
1148    ^self nextInt + pc
1149!
1150
1151getArg: n
1152    ^n isSymbol
1153    	ifFalse: [ n ]
1154    	ifTrue: [ self perform: n ]
1155!
1156
1157highValue
1158    | value |
1159    value := self nextInt.
1160    nPairs := value - nPairs + 1.
1161    ^value
1162!
1163
1164localIndexByte
1165    ^wide ifTrue: [ self nextUshort ] ifFalse: [ self nextByte ]
1166!
1167
1168lookupSwitchBytes
1169    nPairs := self nextUint.
1170    ^(1 to: nPairs) collect: [ :each | self nextInt -> (self nextInt + pc) ]
1171!
1172
1173lowValue
1174    ^nPairs := self nextInt
1175!
1176
1177signedBranchShort
1178    ^self nextShort + pc
1179!
1180
1181signedByte
1182    ^wide ifTrue: [ self nextShort ] ifFalse: [ self nextSignedByte ]
1183!
1184
1185tableSwitchBytes
1186    ^(1 to: nPairs) collect: [ :each | self nextInt + pc ]
1187! !
1188
1189!JavaInstructionInterpreter methodsFor: 'bytecodes'!
1190
1191aaload!
1192aastore!
1193aconst: operand!
1194aload: operand!
1195anewarray: operand!
1196areturn!
1197arraylength!
1198astore: operand!
1199athrow!
1200baload!
1201bastore!
1202bipush: operand!
1203caload!
1204castore!
1205checkcast: operand!
1206d2f!
1207d2i!
1208d2l!
1209dadd!
1210daload!
1211dastore!
1212dcmpg!
1213dcmpl!
1214dconst: operand!
1215ddiv!
1216dload: operand!
1217dmul!
1218dneg!
1219drem!
1220dreturn!
1221dstore: operand!
1222dsub!
1223dup!
1224dup2!
1225dup2_x1!
1226dup2_x2!
1227dup_x1!
1228dup_x2!
1229f2d!
1230f2i!
1231f2l!
1232fadd!
1233faload!
1234fastore!
1235fcmpg!
1236fcmpl!
1237fconst: operand!
1238fdiv!
1239fload: operand!
1240fmul!
1241fneg!
1242frem!
1243freturn!
1244fstore: operand!
1245fsub!
1246getfield: operand!
1247getstatic: operand!
1248goto: operand!
1249i2d!
1250i2f!
1251i2l!
1252iadd!
1253iaload!
1254iand!
1255iastore!
1256iconst: operand!
1257idiv!
1258ifeq: operand!
1259ifge: operand!
1260ifgt: operand!
1261ifle: operand!
1262iflt: operand!
1263ifne: operand!
1264ifnonnull: operand!
1265ifnull: operand!
1266if_acmpeq: operand!
1267if_acmpne: operand!
1268if_icmpeq: operand!
1269if_icmpge: operand!
1270if_icmpgt: operand!
1271if_icmple: operand!
1272if_icmplt: operand!
1273if_icmpne: operand!
1274iinc: operand by: amount!
1275iload: operand!
1276imul!
1277ineg!
1278instanceof: operand!
1279int2byte!
1280int2char!
1281int2short!
1282invokeinterface: operand nargs: args reserved: reserved!
1283invokenonvirtual: operand!
1284invokestatic: operand!
1285invokevirtual: operand!
1286ior!
1287irem!
1288ireturn!
1289ishl!
1290ishr!
1291istore: operand!
1292isub!
1293iushr!
1294ixor!
1295jsr: operand!
1296l2d!
1297l2f!
1298l2i!
1299ladd!
1300laload!
1301land!
1302lastore!
1303lcmp!
1304lconst: operand!
1305ldc2: operand!
1306ldc: operand!
1307ldiv!
1308lload: operand!
1309lmul!
1310lneg!
1311lookupswitch: default destinations: dest!
1312lor!
1313lrem!
1314lreturn!
1315lshl!
1316lshr!
1317lstore: operand!
1318lsub!
1319lushr!
1320lxor!
1321monitorenter!
1322monitorexit!
1323multianewarray: operand dimensions: dimensions!
1324new: operand!
1325newarray: operand!
1326nop!
1327pop!
1328pop2!
1329putfield: operand!
1330putstatic: operand!
1331ret: operand!
1332return!
1333saload!
1334sastore!
1335sipush: operand!
1336swap!
1337tableswitch: default low: low high: high destinations: addresses!
1338
1339wide
1340    "Unlike other methods in this protocol, this one need not be overridden by subclasses,
1341     and in fact subclasses should invoke this implementation ('super wide')"
1342    wide := true
1343! !
1344
1345!JavaInstructionInterpreter methodsFor: 'initialization'!
1346
1347initialize
1348    wide := false.
1349    pc := 0.
1350! !
1351
1352!JavaInstructionInterpreter class methodsFor: 'interpreting'!
1353
1354interpret: aJavaMethod
1355    (self onMethod: aJavaMethod) interpret
1356!
1357
1358new
1359    ^super new initialize
1360!
1361
1362onMethod: aJavaMethod
1363    ^(self on: aJavaMethod bytecodes readStream)
1364    	constantPool: aJavaMethod constantPool;
1365    	yourself
1366!
1367
1368onSameMethodAs: aJavaInstructionInterpreter
1369    ^(self on: aJavaInstructionInterpreter stream copy)
1370    	constantPool: aJavaInstructionInterpreter constantPool;
1371    	yourself
1372! !
1373
1374!JavaInstructionInterpreter class methodsFor: 'initializing'!
1375
1376initialize
1377    ArrayTypes := Array new: 11.
1378    ArrayTypes at: 1 put: (JavaType fromString: 'Ljava/lang/Object;').
1379    ArrayTypes at: 4 put: JavaPrimitiveType boolean.
1380    ArrayTypes at: 5 put: JavaPrimitiveType char.
1381    ArrayTypes at: 6 put: JavaPrimitiveType float.
1382    ArrayTypes at: 7 put: JavaPrimitiveType double.
1383    ArrayTypes at: 8 put: JavaPrimitiveType byte.
1384    ArrayTypes at: 9 put: JavaPrimitiveType short.
1385    ArrayTypes at: 10 put: JavaPrimitiveType int.
1386    ArrayTypes at: 11 put: JavaPrimitiveType long.
1387
1388    DecoderTable := #(
1389    (#nop)                                   "0"
1390    (#aconst: nil)                           "1"
1391    (#iconst: -1)                             "2"
1392    (#iconst: 0)                              "3"
1393    (#iconst: 1)                              "4"
1394    (#iconst: 2)                              "5"
1395    (#iconst: 3)                              "6"
1396    (#iconst: 4)                              "7"
1397    (#iconst: 5)                              "8"
1398    (#lconst: 0)                              "9"
1399
1400    (#lconst: 1)                              "10"
1401    (#fconst: 0)                              "11"
1402    (#fconst: 1)                              "12"
1403    (#fconst: 2)                              "13"
1404    (#dconst: 0)                              "14"
1405    (#dconst: 1)                              "15"
1406    (#bipush: #signedByte)                     "16"
1407    (#sipush: #nextShort)                    "17"
1408    (#ldc: #constIndexByte)              "18"
1409    (#ldc: #constIndexShort)             "19"
1410
1411    (#ldc2: #constIndexShort)            "20"
1412    (#iload: #localIndexByte)                  "21"
1413    (#lload: #localIndexByte)                  "22"
1414    (#fload: #localIndexByte)                  "23"
1415    (#dload: #localIndexByte)                  "24"
1416    (#aload: #localIndexByte)                  "25"
1417    (#iload: 0)                               "26"
1418    (#iload: 1)                               "27"
1419    (#iload: 2)                               "28"
1420    (#iload: 3)                               "29"
1421
1422    (#lload: 0)                               "30"
1423    (#lload: 1)                               "31"
1424    (#lload: 2)                               "32"
1425    (#lload: 3)                               "33"
1426    (#fload: 0)                               "34"
1427    (#fload: 1)                               "35"
1428    (#fload: 2)                               "36"
1429    (#fload: 3)                               "37"
1430    (#dload: 0)                               "38"
1431    (#dload: 1)                               "39"
1432
1433    (#dload: 2)                               "40"
1434    (#dload: 3)                               "41"
1435    (#aload: 0)                               "42"
1436    (#aload: 1)                               "43"
1437    (#aload: 2)                               "44"
1438    (#aload: 3)                               "45"
1439    (#iaload)                                "46"
1440    (#laload)                                "47"
1441    (#faload)                                "48"
1442    (#daload)                                "49"
1443
1444    (#aaload)                                "50"
1445    (#baload)                                "51"
1446    (#caload)                                "52"
1447    (#saload)                                "53"
1448    (#istore: #localIndexByte)                 "54"
1449    (#lstore: #localIndexByte)                 "55"
1450    (#fstore: #localIndexByte)                 "56"
1451    (#dstore: #localIndexByte)                 "57"
1452    (#astore: #localIndexByte)                 "58"
1453    (#istore: 0)                              "59"
1454
1455    (#istore: 1)                              "60"
1456    (#istore: 2)                              "61"
1457    (#istore: 3)                              "62"
1458    (#lstore: 0)                              "63"
1459    (#lstore: 1)                              "64"
1460    (#lstore: 2)                              "65"
1461    (#lstore: 3)                              "66"
1462    (#fstore: 0)                              "67"
1463    (#fstore: 1)                              "68"
1464    (#fstore: 2)                              "69"
1465
1466    (#fstore: 3)                              "70"
1467    (#dstore: 0)                              "71"
1468    (#dstore: 1)                              "72"
1469    (#dstore: 2)                              "73"
1470    (#dstore: 3)                              "74"
1471    (#astore: 0)                              "75"
1472    (#astore: 1)                              "76"
1473    (#astore: 2)                              "77"
1474    (#astore: 3)                              "78"
1475    (#iastore)                               "79"
1476
1477    (#lastore)                               "80"
1478    (#fastore)                               "81"
1479    (#dastore)                               "82"
1480    (#aastore)                               "83"
1481    (#bastore)                               "84"
1482    (#castore)                               "85"
1483    (#sastore)                               "86"
1484    (#pop)                                   "87"
1485    (#pop2)                                  "88"
1486    (#dup)                                   "89"
1487
1488    (#dup_x1)                                "90"
1489    (#dup_x2)                                "91"
1490    (#dup2)                                  "92"
1491    (#dup2_x1)                               "93"
1492    (#dup2_x2)                               "94"
1493    (#swap)                                  "95"
1494    (#iadd)                                  "96"
1495    (#ladd)                                  "97"
1496    (#fadd)                                  "98"
1497    (#dadd)                                  "99"
1498
1499    (#isub)                                  "100"
1500    (#lsub)                                  "101"
1501    (#fsub)                                  "102"
1502    (#dsub)                                  "103"
1503    (#imul)                                  "104"
1504    (#lmul)                                  "105"
1505    (#fmul)                                  "106"
1506    (#dmul)                                  "107"
1507    (#idiv)                                  "108"
1508    (#ldiv)                                  "109"
1509
1510    (#fdiv)                                  "110"
1511    (#ddiv)                                  "111"
1512    (#irem)                                  "112"
1513    (#lrem)                                  "113"
1514    (#frem)                                  "114"
1515    (#drem)                                  "115"
1516    (#ineg)                                  "116"
1517    (#lneg)                                  "117"
1518    (#fneg)                                  "118"
1519    (#dneg)                                  "119"
1520
1521    (#ishl)                                  "120"
1522    (#lshl)                                  "121"
1523    (#ishr)                                  "122"
1524    (#lshr)                                  "123"
1525    (#iushr)                                 "124"
1526    (#lushr)                                 "125"
1527    (#iand)                                  "126"
1528    (#land)                                  "127"
1529    (#ior)                                   "128"
1530    (#lor)                                   "129"
1531
1532    (#ixor)                                  "130"
1533    (#lxor)                                  "131"
1534    (#iinc:by: #localIndexByte #signedByte)  "132"
1535    (#i2l)                                   "133"
1536    (#i2f)                                   "134"
1537    (#i2d)                                   "135"
1538    (#l2i)                                   "136"
1539    (#l2f)                                   "137"
1540    (#l2d)                                   "138"
1541    (#f2i)                                   "139"
1542
1543    (#f2l)                                   "140"
1544    (#f2d)                                   "141"
1545    (#d2i)                                   "142"
1546    (#d2l)                                   "143"
1547    (#d2f)                                   "144"
1548    (#int2byte)                              "145"
1549    (#int2char)                              "146"
1550    (#int2short)                             "147"
1551    (#lcmp)                                  "148"
1552    (#fcmpl)                                 "149"
1553
1554    (#fcmpg)                                 "150"
1555    (#dcmpl)                                 "151"
1556    (#dcmpg)                                 "152"
1557    (#ifeq: #signedBranchShort)                "153"
1558    (#ifne: #signedBranchShort)                "154"
1559    (#iflt: #signedBranchShort)                "155"
1560    (#ifge: #signedBranchShort)                "156"
1561    (#ifgt: #signedBranchShort)                "157"
1562    (#ifle: #signedBranchShort)                "158"
1563    (#if_icmpeq: #signedBranchShort)           "159"
1564
1565    (#if_icmpne: #signedBranchShort)           "160"
1566    (#if_icmplt: #signedBranchShort)           "161"
1567    (#if_icmpge: #signedBranchShort)           "162"
1568    (#if_icmpgt: #signedBranchShort)           "163"
1569    (#if_icmple: #signedBranchShort)           "164"
1570    (#if_acmpeq: #signedBranchShort)           "165"
1571    (#if_acmpne: #signedBranchShort)           "166"
1572    (#goto: #signedBranchShort)                "167"
1573    (#jsr: #signedBranchShort)                 "168"
1574    (#ret: #localIndexByte)                    "169"
1575
1576    (#tableswitch:low:high:destinations: #defaultSwitchAddress #lowValue #highValue #tableSwitchBytes)          "170"
1577    (#lookupswitch:destinations: #defaultSwitchAddress #lookupSwitchBytes)        "171"
1578    (#ireturn)                               "172"
1579    (#lreturn)                               "173"
1580    (#freturn)                               "174"
1581    (#dreturn)                               "175"
1582    (#areturn)                               "176"
1583    (#return)                                "177"
1584    (#getstatic: #constIndexShort)               "178"
1585    (#putstatic: #constIndexShort)               "179"
1586
1587    (#getfield: #constIndexShort)                 "180"
1588    (#putfield: #constIndexShort)                 "181"
1589    (#invokevirtual: #constIndexShort)       "182"
1590    (#invokenonvirtual: #constIndexShort) "183"
1591    (#invokestatic: #constIndexShort)         "184"
1592    (#invokeinterface:nargs:reserved: #constIndexShort #nextByte #nextByte)"185"
1593    nil                           "186"
1594    (#new: #constIndexShort)      "187"
1595    (#newarray: #arrayTypeByte)                "188"
1596    (#anewarray: #constIndexShort)             "189"
1597
1598    (#arraylength)                           "190"
1599    (#athrow)                "191"
1600    (#checkcast: #constIndexShort)             "192"
1601    (#instanceof: #constIndexShort)            "193"
1602    (#monitorenter)                          "194"
1603    (#monitorexit)                           "195"
1604    (#wide)                                  "196"
1605    (#multianewarray:dimensions: #constIndexShort #nextByte) "197"
1606    (#ifnull:    #signedBranchShort)           "198"
1607    (#ifnonnull: #signedBranchShort)           "199"
1608
1609    (#goto: #signedBranchLong)            "200"
1610    (#jsr: #signedBranchShort))
1611! !
1612
1613!JavaClass methodsFor: 'printing'!
1614
1615fullName
1616    | stream |
1617    fullName isNil ifTrue: [
1618        stream := WriteStream on: (String new: 20).
1619        self printFullNameOn: stream.
1620        fullName := stream contents ].
1621
1622    ^fullName
1623!
1624
1625printEncodingOn: aStream
1626    self package printEncodingOn: aStream.
1627    aStream nextPut: $/; nextPutAll: self name.
1628    aStream nextPut: $;
1629!
1630
1631printExtendsClauseOn: aStream
1632    self isInterface ifTrue: [ ^nil ].
1633    self extends isNil ifTrue: [ ^nil ].
1634    aStream
1635    	nl;
1636    	nextPutAll: '    extends '.
1637    self extends printFullNameOn: aStream
1638!
1639
1640printFieldsOn: aStream
1641    (self fields isNil or: [self fields isEmpty]) ifTrue: [^self].
1642    aStream nl.
1643    self fields do:
1644    		[:each |
1645    		aStream
1646    			nextPutAll: '    ';
1647    			print: each]
1648!
1649
1650printFullNameOn: aStream
1651    (self package isNil or: [ self package  == JavaPackage root ]) ifFalse: [
1652    self package printOn: aStream.
1653    aStream nextPut: $.
1654    ].
1655    aStream nextPutAll: self name
1656!
1657
1658printImplementsClauseOn: aStream
1659    (self implements isNil or: [self implements isEmpty]) ifTrue: [^self].
1660    aStream nl.
1661    self isInterface
1662    	ifTrue: [aStream nextPutAll: '    extends ']
1663    	ifFalse: [aStream nextPutAll: '    implements '].
1664    self implements do: [:interface | interface printFullNameOn: aStream]
1665    	separatedBy: [aStream nextPutAll: ', ']
1666!
1667
1668printMethodsOn: aStream
1669    (self methods isNil or: [self methods isEmpty]) ifTrue: [^self].
1670    aStream nl.
1671    self methods do:
1672    		[:each |
1673    		aStream
1674    			nextPutAll: '    ';
1675    			print: each].
1676!
1677
1678printOn: aStream
1679    self printFlagsOn: aStream.
1680    self isInterface ifFalse: [aStream nextPutAll: 'class '].
1681    self printFullNameOn: aStream.
1682    self printExtendsClauseOn: aStream.
1683    self printImplementsClauseOn: aStream.
1684    aStream nl; nextPut: ${.
1685    self printFieldsOn: aStream.
1686    self printMethodsOn: aStream.
1687    aStream nextPut: $}
1688! !
1689
1690!JavaClass methodsFor: 'private-accessing'!
1691
1692package: anObject
1693    package := anObject
1694! !
1695
1696!JavaClass methodsFor: 'accessing'!
1697
1698classDefiningField: name
1699    | class |
1700    "Accesses to static fields of implemented interfaces are compiled as
1701     getstatic bytecodes for Intf.field, not for ClassImplementingIntf.field,
1702     so we need the (slower) recursion on the implemented interfaces only
1703     when we are in an interface."
1704    self isInterface ifTrue: [ ^self interfaceDefiningField: name ].
1705
1706    class := self.
1707    [ class isNil or: [ (class definesField: name) ] ] whileFalse: [
1708    	class := class extends ].
1709    ^class
1710!
1711
1712interfaceDefiningField: name
1713    (self definesField: name) ifTrue: [ ^self ].
1714    ^self implements
1715    	detect: [ :each | (each interfaceDefiningField: name) notNil ]
1716	ifNone: [ nil ]
1717!
1718
1719implementsInterface: anInterface
1720    | c |
1721    c := self.
1722    [
1723	(c implements includes: anInterface) ifTrue: [ ^true ].
1724	(c implements anySatisfy: [ :each |
1725	     each implementsInterface: anInterface ]) ifTrue: [ ^true ].
1726
1727	c := c extends.
1728	c isNil
1729    ] whileFalse.
1730    ^false!
1731
1732constantPool
1733    ^constantPool
1734!
1735
1736constantPool: anObject
1737    constantPool := anObject
1738!
1739
1740extends
1741    ^extends
1742!
1743
1744extends: anObject
1745    extends := anObject
1746!
1747
1748fieldAt: aString
1749    ^fields at: aString
1750!
1751
1752fieldAt: aString ifAbsent: aBlock
1753    ^fields at: aString ifAbsent: aBlock
1754!
1755
1756definesField: aString
1757    fields isNil ifTrue: [ ^false ].
1758    ^fields includesKey: aString
1759!
1760
1761fields
1762    ^fields
1763!
1764
1765fields: aJavaFieldCollection
1766    fields := LookupTable new: aJavaFieldCollection size * 3 // 2.
1767    aJavaFieldCollection do: [ :each |
1768    	each javaClass: self.
1769	fields at: each name put: each ]
1770!
1771
1772flags: allFlags
1773    "Reset the ACC_SUPER flag"
1774    flags := allFlags bitAnd: 32 bitInvert
1775!
1776
1777implements
1778    ^implements
1779!
1780
1781implements: anObject
1782    implements := anObject
1783!
1784
1785isJavaClass
1786    ^true
1787!
1788
1789isJavaPackage
1790    ^false
1791!
1792
1793isLoaded
1794    ^constantPool notNil
1795!
1796
1797methodAt: aString
1798    ^methods at: aString
1799!
1800
1801methodAt: aString ifAbsent: aBlock
1802    ^methods at: aString ifAbsent: aBlock
1803!
1804
1805definesMethod: aJavaNameAndType
1806    methods isNil ifTrue: [ ^false ].
1807    ^methods includesKey:
1808    	(JavaMethod
1809	    selectorFor: aJavaNameAndType name
1810	    type: aJavaNameAndType type)
1811!
1812
1813methods
1814    ^methods
1815!
1816
1817methods: aJavaMethodCollection
1818    methods := IdentityDictionary new: aJavaMethodCollection size * 3 // 2.
1819    aJavaMethodCollection do: [ :each |
1820    	each javaClass: self.
1821	methods at: each selector put: each ]
1822!
1823
1824package
1825    ^package
1826!
1827
1828sourceFile
1829    ^sourceFile
1830!
1831
1832sourceFile: anObject
1833    sourceFile := anObject
1834! !
1835
1836!JavaClass class methodsFor: 'instance creation'!
1837
1838fromString: aString
1839    | path symbolName aPackage |
1840    path := aString subStrings: $/.
1841    aPackage := JavaPackage root.
1842    path from: 1 to: path size - 1 do: [ :each |
1843        aPackage := aPackage packageAt: each asSymbol ].
1844
1845    symbolName := path last asSymbol.
1846    ^aPackage classAt: symbolName ifAbsentPut: [self new
1847        package: aPackage;
1848        name: symbolName;
1849        yourself]
1850!
1851
1852package: aPackage name: className
1853    | symbolName |
1854    symbolName := className asSymbol.
1855    ^aPackage at: symbolName put: (self new
1856    package: aPackage;
1857    name: className;
1858    yourself)
1859! !
1860
1861!JavaClassElement methodsFor: 'comparing'!
1862
1863= anObject
1864    ^self class == anObject class and: [
1865	self flags == anObject flags and: [
1866	self javaClass == anObject javaClass and: [
1867	self name = anObject name ]]]
1868!
1869
1870hash
1871    ^self name hash bitXor: self javaClass identityHash
1872! !
1873
1874!JavaClassElement methodsFor: 'printing'!
1875
1876printHeadingOn: aStream
1877    self printFlagsOn: aStream.
1878    self signature printOn: aStream withName: name
1879!
1880
1881printOn: aStream
1882    self printHeadingOn: aStream
1883! !
1884
1885!JavaClassElement methodsFor: 'accessing'!
1886
1887addAttribute: aJavaAttribute
1888    aJavaAttribute class == JavaSyntheticAttribute
1889    ifTrue:
1890	[self addSynthetic.
1891	^aJavaAttribute].
1892    ^super addAttribute: aJavaAttribute
1893!
1894
1895javaClass
1896    ^javaClass
1897!
1898
1899javaClass: anObject
1900    javaClass := anObject
1901!
1902
1903signature
1904    ^signature
1905!
1906
1907signature: anObject
1908    signature := anObject
1909! !
1910
1911!JavaMethod methodsFor: 'accessing'!
1912
1913addAttribute: aJavaAttribute
1914    "This should handle the Code attribute's subattributes as well
1915     (JavaLineNumberTableAttribute and JavaLocalVariableTableAttribute);
1916     see also the #code: method."
1917    aJavaAttribute class == JavaCodeAttribute
1918        ifTrue:
1919            [self code: aJavaAttribute.
1920            ^aJavaAttribute].
1921    aJavaAttribute class == JavaLineNumberTableAttribute
1922        ifTrue:
1923            [self lines: aJavaAttribute lines.
1924            ^aJavaAttribute].
1925    aJavaAttribute class == JavaLocalVariableTableAttribute
1926        ifTrue:
1927            [self localVariables: aJavaAttribute localVariables.
1928            ^aJavaAttribute].
1929    aJavaAttribute class == JavaExceptionsAttribute
1930        ifTrue:
1931            [self exceptions: aJavaAttribute exceptions.
1932            ^aJavaAttribute].
1933    ^super addAttribute: aJavaAttribute
1934!
1935
1936argTypes
1937    ^self signature argTypes
1938!
1939
1940bytecodes
1941    ^bytecodes
1942!
1943
1944bytecodes: anObject
1945    bytecodes := anObject
1946!
1947
1948code: aJavaCodeAttribute
1949    self
1950        maxLocals: aJavaCodeAttribute maxLocals;
1951        maxStack: aJavaCodeAttribute maxStack;
1952        bytecodes: aJavaCodeAttribute bytecodes;
1953        handlers: aJavaCodeAttribute handlers.
1954
1955    aJavaCodeAttribute attributes do: [ :each |
1956        self addAttribute: each ]
1957!
1958
1959constantPool
1960    ^javaClass constantPool
1961!
1962
1963exceptions
1964    ^exceptions
1965!
1966
1967exceptions: anObject
1968    exceptions := anObject
1969!
1970
1971handlers
1972    ^handlers
1973!
1974
1975handlers: anObject
1976    handlers := anObject
1977!
1978
1979lines
1980    ^lines
1981!
1982
1983lines: anObject
1984    lines := anObject
1985!
1986
1987localVariables
1988    ^localVariables
1989!
1990
1991localVariables: anObject
1992    localVariables := anObject
1993!
1994
1995maxLocals
1996    ^maxLocals
1997!
1998
1999maxLocals: anObject
2000    maxLocals := anObject
2001!
2002
2003maxStack
2004    ^maxStack
2005!
2006
2007maxStack: anObject
2008    maxStack := anObject
2009!
2010
2011numArgs
2012    ^self signature numArgs
2013!
2014
2015returnType
2016    ^self signature returnType
2017! !
2018
2019!JavaMethod methodsFor: 'printing'!
2020
2021printBytecodesOn: s
2022    s
2023    	tab;
2024    	nextPutAll: 'bytecodes: ';
2025    	nl.
2026    JavaInstructionPrinter print: self on: s
2027!
2028
2029printHandlersOn: s
2030    (self handlers notNil and: [self handlers notEmpty])
2031    	ifTrue:
2032    		[self handlers do:
2033    				[:each |
2034    				s
2035    					tab;
2036    					print: each;
2037    					nl]]
2038!
2039
2040printHeadingOn: s
2041    super printHeadingOn: s.
2042    self exceptions isNil ifTrue: [^self].
2043    s
2044    	nl;
2045    	tab;
2046    	nextPutAll: 'throws '.
2047    self exceptions do: [:each | each printFullNameOn: s]
2048    	separatedBy: [s nextPutAll: ', ']
2049!
2050
2051printLimitsOn: s
2052    s
2053    	tab;
2054    	nextPutAll: 'maxStack: ';
2055    	print: self maxStack;
2056    	nextPutAll: ' maxLocals:';
2057    	print: self maxLocals;
2058    	nl
2059!
2060
2061printOn: s
2062    self printHeadingOn: s.
2063    self bytecodes isNil
2064    	ifTrue:
2065    		[s nextPut: $;; nl.
2066    		^self].
2067    s
2068    	nextPutAll: ' {';
2069    	nl.
2070    self printLimitsOn: s.
2071    self printHandlersOn: s.
2072    self printBytecodesOn: s.
2073    s
2074    	nextPutAll: '    }';
2075    	nl
2076! !
2077
2078!JavaMethod methodsFor: 'source'!
2079
2080firstLine
2081    ^self lines first value
2082!
2083
2084lastLine
2085    ^self lines inject: 0 into: [ :max :assoc | max max: assoc value ]
2086! !
2087
2088!JavaMethod methodsFor: 'creating'!
2089
2090selector
2091    selector isNil ifTrue: [
2092    	selector := self class selectorFor: self name type: self signature ].
2093    ^selector
2094! !
2095
2096!JavaMethod class methodsFor: 'creating'!
2097
2098selectorFor: name type: type
2099    ^(name, type asString) asSymbol
2100! !
2101
2102!JavaDescriptor methodsFor: 'testing'!
2103
2104isMethodSignature
2105    ^false
2106! !
2107
2108!JavaRef methodsFor: 'accessing'!
2109
2110isMethodSignature
2111    ^nameAndType isMethodSignature
2112!
2113
2114javaClass
2115    ^javaClass
2116!
2117
2118javaClass: anObject
2119    javaClass := anObject
2120!
2121
2122name
2123    ^self nameAndType name
2124!
2125
2126nameAndType
2127    ^nameAndType
2128!
2129
2130nameAndType: anObject
2131    nameAndType := anObject
2132!
2133
2134type
2135    ^self nameAndType type
2136!
2137
2138wordSize
2139    ^self type wordSize
2140! !
2141
2142!JavaRef methodsFor: 'printing'!
2143
2144printOn: aStream
2145    self nameAndType type
2146        printOn: aStream
2147        withName: self javaClass fullName , '.' , self nameAndType name
2148! !
2149
2150!JavaRef class methodsFor: 'instance creation'!
2151
2152javaClass: aJavaClass nameAndType: nameAndType
2153    ^self new
2154        javaClass: aJavaClass;
2155        nameAndType: nameAndType;
2156        yourself
2157! !
2158
2159!JavaFieldRef methodsFor: 'accessing'!
2160
2161getSelector
2162    getSelector isNil ifTrue: [
2163    	getSelector := JavaField
2164	    getSelectorFor: self name
2165	    in: (self javaClass classDefiningField: self name) ].
2166    ^getSelector!
2167
2168putSelector
2169    putSelector isNil ifTrue: [
2170    	putSelector := JavaField
2171	    putSelectorFor: self name
2172	    in: (self javaClass classDefiningField: self name) ].
2173    ^putSelector! !
2174
2175!JavaMethodRef methodsFor: 'accessing'!
2176
2177argTypes
2178    ^self type argTypes
2179!
2180
2181isVoid
2182    ^self returnType isVoid
2183!
2184
2185numArgs
2186    ^self type numArgs
2187!
2188
2189returnType
2190    ^self type returnType
2191!
2192
2193selector
2194    selector isNil ifTrue: [
2195    	selector := JavaMethod selectorFor: self name type: self type ].
2196    ^selector
2197!
2198
2199wordSize
2200    ^self returnType wordSize
2201! !
2202
2203!JavaType methodsFor: 'accessing'!
2204
2205initializationValue
2206    ^nil
2207!
2208
2209isArrayType
2210    ^false
2211!
2212
2213isPrimitiveType
2214    ^false
2215! !
2216
2217!JavaType methodsFor: 'printing'!
2218
2219
2220asString
2221    | stream |
2222    stream := WriteStream on: (String new: 20).
2223    self printEncodingOn: stream.
2224    ^stream contents
2225!
2226
2227fullName
2228    | stream |
2229    stream := WriteStream on: (String new: 20).
2230    self printFullNameOn: stream.
2231    ^stream contents
2232!
2233
2234printEncodingOn: aStream
2235    self subclassResponsibility
2236!
2237
2238printFullNameOn: aStream
2239    self printOn: aStream.
2240!
2241
2242printOn: aStream withName: aString
2243    aStream print: self; space; nextPutAll: aString.
2244!
2245
2246storeOn: aStream
2247    aStream
2248    nextPut: $(;
2249    print: self class;
2250    nextPutAll: ' fromString: ';
2251    store: self asString;
2252    nextPut: $)
2253! !
2254
2255!JavaType methodsFor: 'jvm quirks'!
2256
2257arrayClass
2258    ^Array
2259!
2260
2261wordSize
2262    self subclassResponsibility
2263! !
2264
2265!JavaType methodsFor: 'testing'!
2266
2267isVoid
2268    ^false
2269!
2270
2271isArrayType
2272    ^false
2273! !
2274
2275!JavaType class methodsFor: 'instance creation'!
2276
2277fromString: aString
2278    ^self readFrom: aString readStream
2279!
2280
2281readFrom: aStream
2282    (aStream peek = $() ifTrue: [ ^JavaMethodType readFrom: aStream ].
2283    (aStream peek = $[) ifTrue: [ ^JavaArrayType readFrom: aStream ].
2284    (aStream peek = $L) ifTrue: [ ^JavaObjectType readFrom: aStream ].
2285    ^JavaPrimitiveType readFrom: aStream
2286! !
2287
2288!JavaObjectType methodsFor: 'accessing'!
2289
2290javaClass
2291    ^javaClass
2292!
2293
2294javaClass: anObject
2295    javaClass := anObject
2296! !
2297
2298!JavaObjectType methodsFor: 'printing'!
2299
2300printEncodingOn: aStream
2301    aStream nextPut: $L.
2302    self javaClass printEncodingOn: aStream.
2303!
2304
2305printOn: aStream
2306    self javaClass printFullNameOn: aStream! !
2307
2308!JavaObjectType methodsFor: 'jvm quirks'!
2309
2310wordSize
2311    ^1
2312! !
2313
2314!JavaObjectType class methodsFor: 'instance creation'!
2315
2316javaClass: aJavaClass
2317    ^self new javaClass: aJavaClass
2318!
2319
2320readFrom: aStream
2321    (aStream peekFor: $L) ifFalse: [ self error: 'expected L' ].
2322    ^self javaClass: (JavaClass fromString: (aStream upTo: $;))
2323! !
2324
2325!JavaMethodType methodsFor: 'printing'!
2326
2327printEncodingOn: aStream
2328    aStream nextPut: $(.
2329    self argTypes do: [ :each | each printEncodingOn: aStream ].
2330    aStream nextPut: $).
2331    self returnType printEncodingOn: aStream
2332!
2333
2334printOn: aStream
2335    self printOn: aStream withName: '*'
2336!
2337
2338printOn: aStream withName: aString
2339    aStream
2340    print: self returnType;
2341    space;
2342    nextPutAll: aString;
2343    nextPutAll: ' ('.
2344
2345    self argTypes
2346    do: [ :each | aStream print: each ]
2347    separatedBy: [ aStream nextPutAll: ', ' ].
2348
2349    aStream nextPut: $)
2350! !
2351
2352!JavaMethodType methodsFor: 'accessing'!
2353
2354argTypes
2355    ^argTypes
2356!
2357
2358argTypes: anObject
2359    argTypes := anObject
2360!
2361
2362numArgs
2363    ^argTypes size
2364!
2365
2366returnType
2367    ^returnType
2368!
2369
2370returnType: anObject
2371    returnType := anObject
2372! !
2373
2374!JavaMethodType methodsFor: 'testing'!
2375
2376isMethodSignature
2377    ^true
2378! !
2379
2380!JavaMethodType methodsFor: 'jvm quirks'!
2381
2382wordSize
2383    self shouldNotImplement
2384! !
2385
2386!JavaMethodType class methodsFor: 'instance creation'!
2387
2388readFrom: aStream
2389    | argTypes returnType |
2390    argTypes := OrderedCollection new.
2391    (aStream peekFor: $() ifFalse: [ self error: 'expected (' ].
2392    [ aStream peekFor: $) ] whileFalse: [
2393    argTypes addLast: (JavaType readFrom: aStream) ].
2394
2395    returnType := JavaType readFrom: aStream.
2396    ^self new
2397    argTypes: argTypes asArray;
2398    returnType: returnType;
2399    yourself
2400! !
2401
2402!JavaArrayType methodsFor: 'accessing'!
2403
2404arrayDimensionality
2405    | n t |
2406    n := 1.
2407    t := self subType.
2408    [ t isArrayType ] whileTrue: [
2409	n := n + 1.
2410        t := self subType ].
2411    ^n
2412!
2413
2414isArrayType
2415    ^true
2416!
2417
2418subType
2419    ^subType
2420!
2421
2422subType: anObject
2423    subType := anObject
2424! !
2425
2426!JavaArrayType methodsFor: 'printing'!
2427
2428printEncodingOn: aStream
2429    aStream nextPut: $[.
2430    self subType printEncodingOn: aStream
2431!
2432
2433printOn: aStream
2434    self subType printOn: aStream.
2435    aStream nextPutAll: '[]'
2436!
2437
2438printOn: aStream withName: aString
2439    self subType printOn: aStream withName: aString.
2440    aStream nextPutAll: '[]'
2441! !
2442
2443!JavaArrayType methodsFor: 'jvm quirks'!
2444
2445wordSize
2446    ^1
2447! !
2448
2449!JavaArrayType methodsFor: 'testing'!
2450
2451isArrayType
2452    ^true
2453! !
2454
2455!JavaArrayType class methodsFor: 'instance creation'!
2456
2457readFrom: aStream
2458    (aStream peekFor: $[) ifFalse: [ self error: 'expected [' ].
2459    ^self new subType: (JavaType readFrom: aStream)
2460! !
2461
2462!JavaInstructionPrinter methodsFor: 'accessing'!
2463
2464output
2465    ^output
2466!
2467
2468output: anObject
2469    output := anObject
2470! !
2471
2472!JavaInstructionPrinter methodsFor: 'initialize'!
2473
2474groupLocalVariables: localVariables
2475    localVariables do: [:each || collection |
2476	(collection := localVariableTable at: each slot + 1) isNil
2477    	    ifTrue:
2478    		[collection := SortedCollection sortBlock: [:a :b | a startpc < b startpc].
2479		localVariableTable
2480		    at: each slot + 1
2481    		    put: collection ].
2482	collection add: each]
2483!
2484
2485initialize: aJavaMethod
2486    | sortedLineNumbers |
2487    self
2488    	stream: aJavaMethod bytecodes readStream;
2489    	constantPool: aJavaMethod constantPool.
2490
2491    sortedLineNumbers := aJavaMethod lines isNil
2492    	ifTrue: [#()]
2493    	ifFalse: [(aJavaMethod lines asSortedCollection: [:a :b | a value <= b value]) asArray].
2494    lineNumberTable := sortedLineNumbers readStream.
2495
2496    localVariableTable := Array new: aJavaMethod maxLocals + 1.
2497    aJavaMethod localVariables isNil
2498    	ifFalse: [ self groupLocalVariables: aJavaMethod localVariables ]
2499! !
2500
2501!JavaInstructionPrinter methodsFor: 'bytecodes'!
2502
2503aaload
2504    output nextPutAll: 'aaload'.
2505!
2506
2507aastore
2508    output nextPutAll: 'aastore'.
2509!
2510
2511aconst: operand
2512    output nextPutAll: 'aconst '; print: operand.
2513!
2514
2515aload: operand
2516    output nextPutAll: 'aload '.
2517    self printLocalVariable: operand.
2518!
2519
2520anewarray: operand
2521    output nextPutAll: 'anewarray '.
2522    operand printFullNameOn: output
2523!
2524
2525areturn
2526    output nextPutAll: 'areturn'.
2527!
2528
2529arraylength
2530    output nextPutAll: 'arraylength'.
2531!
2532
2533astore: operand
2534    output nextPutAll: 'astore '.
2535    self printLocalVariable: operand.
2536!
2537
2538athrow
2539    output nextPutAll: 'athrow'.
2540!
2541
2542baload
2543    output nextPutAll: 'baload'.
2544!
2545
2546bastore
2547    output nextPutAll: 'bastore'.
2548!
2549
2550bipush: operand
2551    output nextPutAll: 'bipush '; print: operand
2552!
2553
2554caload
2555    output nextPutAll: 'caload'.
2556!
2557
2558castore
2559    output nextPutAll: 'castore'.
2560!
2561
2562checkcast: operand
2563    output nextPutAll: 'checkcast '.
2564    operand printFullNameOn: output
2565!
2566
2567d2f
2568    output nextPutAll: 'd2f'
2569!
2570
2571d2i
2572    output nextPutAll: 'd2i'
2573!
2574
2575d2l
2576    output nextPutAll: 'd2l'
2577!
2578
2579dadd
2580    output nextPutAll: 'dadd'
2581!
2582
2583daload
2584    output nextPutAll: 'daload'.
2585!
2586
2587dastore
2588    output nextPutAll: 'dastore'.
2589!
2590
2591dcmpg
2592    output nextPutAll: 'dcmpg'
2593!
2594
2595dcmpl
2596    output nextPutAll: 'dcmpl'
2597!
2598
2599dconst: operand
2600    output nextPutAll: 'dconst '; print: operand
2601!
2602
2603ddiv
2604    output nextPutAll: 'ddiv'
2605!
2606
2607dload: operand
2608    output nextPutAll: 'dload '.
2609    self printLocalVariable: operand.
2610!
2611
2612dmul
2613    output nextPutAll: 'dmul'
2614!
2615
2616dneg
2617    output nextPutAll: 'dneg'
2618!
2619
2620drem
2621    output nextPutAll: 'drem'
2622!
2623
2624dreturn
2625    output nextPutAll: 'dreturn'
2626!
2627
2628dstore: operand
2629    output nextPutAll: 'dstore '.
2630    self printLocalVariable: operand.
2631!
2632
2633dsub
2634    output nextPutAll: 'dsub'
2635!
2636
2637dup
2638    output nextPutAll: 'dup'
2639!
2640
2641dup2
2642    output nextPutAll: 'dup2'
2643!
2644
2645dup2_x1
2646    output nextPutAll: 'dup2_x1'
2647!
2648
2649dup2_x2
2650    output nextPutAll: 'dup2_x2'
2651!
2652
2653dup_x1
2654    output nextPutAll: 'dup_x1'
2655!
2656
2657dup_x2
2658    output nextPutAll: 'dup_x2'
2659!
2660
2661f2d
2662    output nextPutAll: 'f2d'
2663!
2664
2665f2i
2666    output nextPutAll: 'f2i'
2667!
2668
2669f2l
2670    output nextPutAll: 'f2l'
2671!
2672
2673fadd
2674    output nextPutAll: 'fadd'
2675!
2676
2677faload
2678    output nextPutAll: 'faload'.
2679!
2680
2681fastore
2682    output nextPutAll: 'fastore'.
2683!
2684
2685fcmpg
2686    output nextPutAll: 'fcmpg'
2687!
2688
2689fcmpl
2690    output nextPutAll: 'fcmpl'
2691!
2692
2693fconst: operand
2694    output nextPutAll: 'fconst '; print: operand
2695!
2696
2697fdiv
2698    output nextPutAll: 'fdiv'
2699!
2700
2701fload: operand
2702    output nextPutAll: 'fload '.
2703    self printLocalVariable: operand.
2704!
2705
2706fmul
2707    output nextPutAll: 'fmul'
2708!
2709
2710fneg
2711    output nextPutAll: 'fneg'
2712!
2713
2714frem
2715    output nextPutAll: 'frem'
2716!
2717
2718freturn
2719    output nextPutAll: 'freturn'
2720!
2721
2722fstore: operand
2723    output nextPutAll: 'fstore '.
2724    self printLocalVariable: operand.
2725!
2726
2727fsub
2728    output nextPutAll: 'fsub'
2729!
2730
2731getfield: operand
2732    output nextPutAll: 'getfield <'; print: operand; nextPut: $>
2733!
2734
2735getstatic: operand
2736    output nextPutAll: 'getstatic <'; print: operand; nextPut: $>
2737!
2738
2739goto: operand
2740    output nextPutAll: 'goto '; print: operand
2741!
2742
2743i2d
2744    output nextPutAll: 'i2d'
2745!
2746
2747i2f
2748    output nextPutAll: 'i2f'
2749!
2750
2751i2l
2752    output nextPutAll: 'i2l'
2753!
2754
2755iadd
2756    output nextPutAll: 'iadd'
2757!
2758
2759iaload
2760    output nextPutAll: 'iaload'.
2761!
2762
2763iand
2764    output nextPutAll: 'iand'
2765!
2766
2767iastore
2768    output nextPutAll: 'iastore'.
2769!
2770
2771iconst: operand
2772    output nextPutAll: 'iconst '; print: operand
2773!
2774
2775idiv
2776    output nextPutAll: 'idiv'
2777!
2778
2779ifeq: operand
2780    output nextPutAll: 'ifeq '; print: operand
2781!
2782
2783ifge: operand
2784    output nextPutAll: 'ifge '; print: operand
2785!
2786
2787ifgt: operand
2788    output nextPutAll: 'ifgt '; print: operand
2789!
2790
2791ifle: operand
2792    output nextPutAll: 'ifle '; print: operand
2793!
2794
2795iflt: operand
2796    output nextPutAll: 'iflt '; print: operand
2797!
2798
2799ifne: operand
2800    output nextPutAll: 'ifne '; print: operand
2801!
2802
2803ifnonnull: operand
2804    output nextPutAll: 'ifnonnull '; print: operand
2805!
2806
2807ifnull: operand
2808    output nextPutAll: 'ifnull '; print: operand
2809!
2810
2811if_acmpeq: operand
2812    output nextPutAll: 'if_acmpeq '; print: operand
2813!
2814
2815if_acmpne: operand
2816    output nextPutAll: 'if_acmpne '; print: operand
2817!
2818
2819if_icmpeq: operand
2820    output nextPutAll: 'if_icmpeq '; print: operand
2821!
2822
2823if_icmpge: operand
2824    output nextPutAll: 'if_icmpge '; print: operand
2825!
2826
2827if_icmpgt: operand
2828    output nextPutAll: 'if_icmpgt '; print: operand
2829!
2830
2831if_icmple: operand
2832    output nextPutAll: 'if_icmple '; print: operand
2833!
2834
2835if_icmplt: operand
2836    output nextPutAll: 'if_icmplt '; print: operand
2837!
2838
2839if_icmpne: operand
2840    output nextPutAll: 'if_icmpne '; print: operand
2841!
2842
2843iinc: operand by: amount
2844    output nextPutAll: 'inc '.
2845    self printLocalVariable: operand.
2846    output nextPutAll: ', '; print: amount
2847!
2848
2849iload: operand
2850    output nextPutAll: 'iload '.
2851    self printLocalVariable: operand.
2852!
2853
2854imul
2855    output nextPutAll: 'imul'
2856!
2857
2858ineg
2859    output nextPutAll: 'ineg'
2860!
2861
2862instanceof: operand
2863    output nextPutAll: 'instanceof '.
2864    operand printFullNameOn: output
2865!
2866
2867int2byte
2868    output nextPutAll: 'int2byte'
2869!
2870
2871int2char
2872    output nextPutAll: 'int2char'
2873!
2874
2875int2short
2876    output nextPutAll: 'int2short'
2877!
2878
2879invokeinterface: operand nargs: args reserved: reserved
2880    output
2881    nextPutAll: 'invokeinterface <';
2882    print: operand;
2883    nextPutAll: '> (';
2884    print: args;
2885    nextPutAll: ' arguments)'
2886!
2887
2888invokenonvirtual: operand
2889    output nextPutAll: 'invokenonvirtual <'; print: operand; nextPut: $>
2890!
2891
2892invokestatic: operand
2893    output nextPutAll: 'invokestatic <'; print: operand; nextPut: $>
2894!
2895
2896invokevirtual: operand
2897    output nextPutAll: 'invokevirtual <'; print: operand; nextPut: $>
2898!
2899
2900ior
2901    output nextPutAll: 'ior'
2902!
2903
2904irem
2905    output nextPutAll: 'irem'
2906!
2907
2908ireturn
2909    output nextPutAll: 'ireturn'
2910!
2911
2912ishl
2913    output nextPutAll: 'ishl'
2914!
2915
2916ishr
2917    output nextPutAll: 'ishr'
2918!
2919
2920istore: operand
2921    output nextPutAll: 'istore '.
2922    self printLocalVariable: operand.
2923!
2924
2925isub
2926    output nextPutAll: 'isub'
2927!
2928
2929iushr
2930    output nextPutAll: 'iushr'
2931!
2932
2933ixor
2934    output nextPutAll: 'ixor'
2935!
2936
2937jsr: operand
2938    output nextPutAll: 'jsr '; print: operand
2939!
2940
2941l2d
2942    output nextPutAll: 'l2d'
2943!
2944
2945l2f
2946    output nextPutAll: 'l2f'
2947!
2948
2949l2i
2950    output nextPutAll: 'l2i'
2951!
2952
2953ladd
2954    output nextPutAll: 'ladd'
2955!
2956
2957laload
2958    output nextPutAll: 'laload'.
2959!
2960
2961land
2962    output nextPutAll: 'land'
2963!
2964
2965lastore
2966    output nextPutAll: 'lastore'.
2967!
2968
2969lcmp
2970    output nextPutAll: 'lcmp'.
2971!
2972
2973lconst: operand
2974    output nextPutAll: 'lconst '; print: operand
2975!
2976
2977ldc2: operand
2978    output nextPutAll: 'ldc2 '; print: operand
2979!
2980
2981ldc: operand
2982    output nextPutAll: 'ldc '; print: operand
2983!
2984
2985ldiv
2986    output nextPutAll: 'ldiv'
2987!
2988
2989lload: operand
2990    output nextPutAll: 'lload '.
2991    self printLocalVariable: operand.
2992!
2993
2994lmul
2995    output nextPutAll: 'lmul'
2996!
2997
2998lneg
2999    output nextPutAll: 'lneg'
3000!
3001
3002lookupswitch: default destinations: dest
3003    output nextPutAll: 'lookupswitch '; print: dest; nextPutAll: ', default '; print: default
3004!
3005
3006lor
3007    output nextPutAll: 'lor'
3008!
3009
3010lrem
3011    output nextPutAll: 'lrem'
3012!
3013
3014lreturn
3015    output nextPutAll: 'lreturn'
3016!
3017
3018lshl
3019    output nextPutAll: 'lshl'
3020!
3021
3022lshr
3023    output nextPutAll: 'lshr'
3024!
3025
3026lstore: operand
3027    output nextPutAll: 'lstore '.
3028    self printLocalVariable: operand.
3029!
3030
3031lsub
3032    output nextPutAll: 'lsub'
3033!
3034
3035lushr
3036    output nextPutAll: 'lushr'
3037!
3038
3039lxor
3040    output nextPutAll: 'lxor'
3041!
3042
3043monitorenter
3044    output nextPutAll: 'monitorenter'
3045!
3046
3047monitorexit
3048    output nextPutAll: 'monitorexit'
3049!
3050
3051multianewarray: operand dimensions: dimensions
3052    output nextPutAll: 'multianewarray '; print: operand; nextPutAll: ', '; print: dimensions
3053!
3054
3055new: operand
3056    output nextPutAll: 'new '.
3057    operand printFullNameOn: output
3058!
3059
3060newarray: operand
3061    output nextPutAll: 'newarray '; print: operand
3062!
3063
3064nop
3065    output nextPutAll: 'nop'
3066!
3067
3068pop
3069    output nextPutAll: 'pop'
3070!
3071
3072pop2
3073    output nextPutAll: 'pop2'
3074!
3075
3076putfield: operand
3077    output nextPutAll: 'putfield <'; print: operand; nextPut: $>
3078!
3079
3080putstatic: operand
3081    output nextPutAll: 'putstatic <'; print: operand; nextPut: $>
3082!
3083
3084ret: operand
3085    output nextPutAll: 'ret '; print: operand
3086!
3087
3088return
3089    output nextPutAll: 'return'.
3090!
3091
3092saload
3093    output nextPutAll: 'saload'.
3094!
3095
3096sastore
3097    output nextPutAll: 'sastore'.
3098!
3099
3100sipush: operand
3101    output nextPutAll: 'sipush '; print: operand
3102!
3103
3104swap
3105    output nextPutAll: 'swap'
3106!
3107
3108tableswitch: default low: low high: high destinations: addresses
3109    ^self lookupswitch: default
3110    	destinations: ((1 to: high - low + 1)
3111    			collect: [:i | low + i - 1 -> (addresses at: i)])
3112! !
3113
3114!JavaInstructionPrinter methodsFor: 'interpretation'!
3115
3116dispatch: insn
3117    output
3118    	tab;
3119    	print: pc;
3120    	tab.
3121    super dispatch: insn.
3122    self printCurrentLine.
3123    output nl
3124!
3125
3126printCurrentLine
3127
3128    lineNumberTable atEnd ifTrue: [^self].
3129    lineNumberTable peek key > pc ifTrue: [ ^self ].
3130    output
3131    	tab;
3132    	nextPutAll: '// source line ';
3133    	print: lineNumberTable next value
3134!
3135
3136printLocalVariable: index
3137    | coll low high mid item |
3138    index printOn: output.
3139    coll := localVariableTable at: index + 1.
3140    low := 1.
3141    high := coll size.
3142
3143    [mid := (low + high) // 2.
3144    low > high ifTrue: [^nil].
3145    item := coll at: mid.
3146    item includes: pc]
3147    		whileFalse:
3148    			[item startpc < pc ifTrue: [low := mid + 1] ifFalse: [high := mid - 1]].
3149
3150    output nextPutAll: ' ('; nextPutAll: item name; nextPut: $)
3151! !
3152
3153!JavaInstructionPrinter class methodsFor: 'printing methods'!
3154
3155print: aJavaMethod on: outputStream
3156    (self on: aJavaMethod bytecodes readStream)
3157    initialize: aJavaMethod;
3158    output: outputStream;
3159    interpret
3160! !
3161
3162!JavaNameAndType methodsFor: 'accessing'!
3163
3164isMethodSignature
3165    ^type isMethodSignature
3166!
3167
3168name
3169    ^name
3170!
3171
3172name: anObject
3173    name := anObject
3174!
3175
3176type
3177    ^type
3178!
3179
3180type: anObject
3181    type := anObject
3182! !
3183
3184!JavaNameAndType methodsFor: 'printing'!
3185
3186printOn: aStream
3187    self type printOn: aStream withName: self name
3188! !
3189
3190!JavaNameAndType class methodsFor: 'instance creation'!
3191
3192name: aSymbol type: aType
3193    ^self new
3194    name: aSymbol;
3195    type: aType;
3196    yourself
3197! !
3198
3199!JavaPrimitiveType methodsFor: 'printing'!
3200
3201printEncodingOn: aStream
3202    aStream nextPut: self id
3203!
3204
3205printOn: aStream
3206    aStream nextPutAll: self name
3207! !
3208
3209!JavaPrimitiveType methodsFor: 'accessing'!
3210
3211arrayClass
3212    ^arrayClass
3213!
3214
3215arrayClass: aClass
3216    arrayClass := aClass
3217!
3218
3219id
3220    ^id
3221!
3222
3223id: anObject
3224    id := anObject
3225!
3226
3227initializationValue
3228    ^zeroValue
3229!
3230
3231isPrimitiveType
3232    ^true
3233!
3234
3235zeroValue: anObject
3236    zeroValue := anObject
3237!
3238
3239name
3240    ^name
3241!
3242
3243name: anObject
3244    name := anObject
3245!
3246
3247wordSize
3248    ^wordSize
3249!
3250
3251wordSize: anObject
3252    wordSize := anObject
3253! !
3254
3255!JavaPrimitiveType methodsFor: 'copying'!
3256
3257copy
3258    ^self
3259!
3260
3261shallowCopy
3262    ^self
3263! !
3264
3265!JavaPrimitiveType methodsFor: 'testing'!
3266
3267isVoid
3268    ^self wordSize == 0
3269! !
3270
3271!JavaPrimitiveType class methodsFor: 'initializing'!
3272
3273initialize
3274    "self initialize"
3275    PrimitiveTypes := IdentityDictionary new: 32.
3276    PrimitiveTypes at: $B put: (JavaByte := self
3277	id: $B name: 'byte' wordSize: 1 arrayClass: JavaByteArray zeroValue: 0).
3278    PrimitiveTypes at: $C put: (JavaChar := self
3279	id: $C name: 'char' wordSize: 1 arrayClass: JavaCharArray zeroValue: 0).
3280    PrimitiveTypes at: $D put: (JavaDouble := self
3281	id: $D name: 'double' wordSize: 2 arrayClass: JavaDoubleArray zeroValue: 0.0d).
3282    PrimitiveTypes at: $F put: (JavaFloat := self
3283	id: $F name: 'float' wordSize: 1 arrayClass: JavaFloatArray zeroValue: 0.0e).
3284    PrimitiveTypes at: $I put: (JavaInt := self
3285	id: $I name: 'int' wordSize: 1 arrayClass: JavaIntArray zeroValue: 0).
3286    PrimitiveTypes at: $J put: (JavaLong := self
3287	id: $J name: 'long' wordSize: 2 arrayClass: JavaLongArray zeroValue: 0).
3288    PrimitiveTypes at: $S put: (JavaShort := self
3289	id: $S name: 'short' wordSize: 1 arrayClass: JavaShortArray zeroValue: 0).
3290    PrimitiveTypes at: $V put: (JavaVoid := self
3291	id: $V name: 'void' wordSize: 0 arrayClass: nil zeroValue: nil).
3292    PrimitiveTypes at: $Z put: (JavaBoolean := self
3293	id: $Z name: 'boolean' wordSize: 1 arrayClass: ByteArray zeroValue: 0)
3294! !
3295
3296!JavaPrimitiveType class methodsFor: 'instance creation'!
3297
3298boolean
3299    ^JavaBoolean
3300!
3301
3302byte
3303    ^JavaByte
3304!
3305
3306char
3307    ^JavaChar
3308!
3309
3310double
3311    ^JavaDouble
3312!
3313
3314float
3315    ^JavaFloat
3316!
3317
3318id: aCharacter name: aString wordSize: anInteger arrayClass: aClass zeroValue: anObject
3319    ^self new
3320        id: aCharacter;
3321        name: aString;
3322        wordSize: anInteger;
3323	arrayClass: aClass;
3324	zeroValue: anObject;
3325        yourself
3326!
3327
3328int
3329    ^JavaInt
3330!
3331
3332long
3333    ^JavaLong
3334!
3335
3336readFrom: aStream
3337    ^PrimitiveTypes at: aStream next
3338!
3339
3340short
3341    ^JavaShort
3342!
3343
3344void
3345    ^JavaVoid
3346! !
3347
3348!JavaLocalVariable methodsFor: 'accessing'!
3349
3350endpc
3351    ^startpc + length
3352!
3353
3354length
3355    ^length
3356!
3357
3358length: anObject
3359    length := anObject
3360!
3361
3362name
3363    ^name
3364!
3365
3366name: anObject
3367    name := anObject
3368!
3369
3370slot
3371    ^slot
3372!
3373
3374slot: anObject
3375    slot := anObject
3376!
3377
3378startpc
3379    ^startpc
3380!
3381
3382startpc: anObject
3383    startpc := anObject
3384!
3385
3386type
3387    ^type
3388!
3389
3390type: anObject
3391    type := anObject
3392! !
3393
3394!JavaLocalVariable methodsFor: 'printing'!
3395
3396printOn: s
3397    self type printOn: s withName: self name.
3398    s
3399    	nextPutAll: ' (start pc: ';
3400    	print: self startpc;
3401    	nextPutAll: ' end pc: ';
3402    	print: self startpc + self length;
3403    	nextPutAll: ' slot: ';
3404    	print: self slot;
3405    	nextPut: $)
3406! !
3407
3408!JavaLocalVariable methodsFor: 'testing'!
3409
3410includes: pc
3411    ^self startpc <= pc and: [ pc < self endpc ]
3412! !
3413
3414!JavaLocalVariable class methodsFor: 'instance creation'!
3415
3416startpc: s length: l name: n type: typ slot: i
3417    ^self new
3418        startpc: s;
3419        length: l;
3420        name: n;
3421        type: typ;
3422        slot: i;
3423        yourself
3424! !
3425
3426!JavaPackage methodsFor: 'printing'!
3427
3428printEncodingOn: aStream
3429    self container isNil ifFalse: [
3430        self container printOn: aStream.
3431        aStream nextPut: $/
3432    ].
3433    aStream nextPutAll: self name
3434!
3435
3436printOn: aStream
3437    (self container isNil or: [ self container == Root ]) ifFalse: [
3438        self container printOn: aStream.
3439        aStream nextPut: $.
3440    ].
3441    aStream nextPutAll: self name
3442! !
3443
3444!JavaPackage methodsFor: 'initializing'!
3445
3446initialize
3447    contents := IdentityDictionary new
3448! !
3449
3450!JavaPackage methodsFor: 'accessing'!
3451
3452at: aSymbol
3453    ^self contents at: aSymbol
3454!
3455
3456at: aSymbol ifAbsentPut: aBlock
3457    ^self contents at: aSymbol ifAbsentPut: aBlock value
3458!
3459
3460at: aSymbol put: anObject
3461    ^self contents at: aSymbol put: anObject
3462!
3463
3464classAt: aSymbol
3465    | value |
3466    value := self contents at: aSymbol.
3467    value isJavaClass ifFalse: [ self error: 'class expected, found package' ].
3468    ^value
3469!
3470
3471classAt: aSymbol ifAbsentPut: aBlock
3472    | value |
3473    value := self contents at: aSymbol ifAbsentPut: aBlock.
3474    value isJavaClass ifFalse: [ self error: 'class expected, found package' ].
3475    ^value
3476!
3477
3478container
3479    ^container
3480!
3481
3482container: anObject
3483    container := anObject
3484!
3485
3486contents
3487    ^contents
3488!
3489
3490isJavaClass
3491    ^false
3492!
3493
3494isJavaPackage
3495    ^true
3496!
3497
3498name
3499    ^name
3500!
3501
3502name: anObject
3503    name := anObject asSymbol
3504!
3505
3506packageAt: aSymbol
3507    | value |
3508    value := self contents at: aSymbol ifAbsentPut: [ self class name: aSymbol container: self ].
3509    value isJavaPackage ifFalse: [ self error: 'package expected, found class' ].
3510    ^value
3511! !
3512
3513!JavaPackage class methodsFor: 'instance creation'!
3514
3515name: aSymbol container: aJavaPackage
3516    ^self new
3517        name: aSymbol;
3518        container: aJavaPackage;
3519        yourself
3520!
3521
3522new
3523    ^self basicNew initialize
3524!
3525
3526root
3527    ^Root
3528! !
3529
3530!JavaPackage class methodsFor: 'initializing'!
3531
3532initialize
3533    "self initialize"
3534    Root := self new.
3535    Root name: 'JAVA'
3536! !
3537
3538!JavaField methodsFor: 'accessing'!
3539
3540addAttribute: aJavaAttribute
3541    aJavaAttribute class == JavaConstantValueAttribute ifTrue:
3542        [self constantValue: aJavaAttribute constant.
3543        ^aJavaAttribute].
3544    ^super addAttribute: aJavaAttribute
3545!
3546
3547constantValue
3548    ^constantValue
3549!
3550
3551constantValue: anObject
3552    constantValue := anObject
3553! !
3554
3555!JavaField methodsFor: 'printing'!
3556
3557printOn: aStream
3558    self printHeadingOn: aStream.
3559    self constantValue notNil ifTrue: [
3560    aStream nextPutAll: ' = '; print: self constantValue ].
3561    aStream nextPut: $;.
3562    aStream nl.
3563! !
3564
3565!JavaField methodsFor: 'compiling'!
3566
3567getSelector
3568    getSelector isNil ifTrue: [
3569    	getSelector := self class getSelectorFor: self name in: self javaClass ].
3570    ^getSelector!
3571
3572putSelector
3573    putSelector isNil ifTrue: [
3574    	putSelector := self class putSelectorFor: self name in: self javaClass ].
3575    ^putSelector! !
3576
3577!JavaField class methodsFor: 'compiling'!
3578
3579getSelectorFor: name in: class
3580    | string className ch |
3581    className := class fullName.
3582    string := String new: className size + 1 + name size.
3583    1 to: className size do: [ :i |
3584        string
3585	    at: i
3586	    put: ((ch := className at: i) = $. ifTrue: [ $$ ] ifFalse: [ ch ]).
3587    ].
3588    string
3589    	at: className size + 1 put: $$.
3590    string
3591    	replaceFrom: className size + 2
3592	to: string size
3593	with: name
3594	startingAt: 1.
3595
3596    ^string asSymbol!
3597
3598putSelectorFor: name in: class
3599    | string className ch |
3600    className := class fullName.
3601    string := String new: className size + 2 + name size.
3602    1 to: className size do: [ :i |
3603        string
3604	    at: i
3605	    put: ((ch := className at: i) = $. ifTrue: [ $$ ] ifFalse: [ ch ]).
3606    ].
3607    string
3608    	at: className size + 1 put: $$.
3609    string
3610    	replaceFrom: className size + 2
3611	to: string size - 1
3612	with: name
3613	startingAt: 1.
3614    string
3615    	at: string size put: $:.
3616
3617    ^string asSymbol! !
3618
3619JavaProgramElement initialize!
3620JavaPrimitiveType initialize!
3621JavaPackage initialize!
3622JavaInstructionInterpreter initialize!
3623