1"======================================================================
2|
3|   Java run-time support.  Extensions for base classes & JavaMetaobjects.
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
33!JavaTranslatedExceptionHandlerTable methodsFor: 'finding exception handlers'!
34
35value: context value: signal
36    | pc low high mid first item |
37    signal class == JavaException ifFalse: [ ^nil ].
38
39    pc := context ip.
40    low := 1.
41    high := self size.
42
43    "Do a binary search on the table to find a possible
44     handler"
45    [mid := (low + high) // 2.
46    low > high ifTrue: [^nil].
47    item := self at: mid.
48    item includes: pc] whileFalse:
49	[item startpc < pc ifTrue: [low := mid + 1] ifFalse: [high := mid - 1]].
50
51    "Go back to find the first one"
52    first := mid.
53    [ first > 1 and: [ (self at: first - 1) includes: pc ] ]
54	whileTrue: [ first := first - 1 ].
55
56    "Between the two, we can skip a range check"
57    [
58	item := self at: first.
59	(item type isNil or: [ signal tag isKindOf: item type ])
60	    ifTrue: [
61		context at: self exceptionTemp put: signal tag.
62		signal foundJavaHandler: item in: context.
63		^#found ].
64
65	first < mid
66    ] whileTrue: [
67	first := first + 1
68    ].
69
70    "Then we also have to check if the pc is ok."
71    [
72	first = self size ifTrue: [ ^nil ].
73	first := first + 1.
74	item := self at: first.
75	(item includes: pc) ifFalse: [ ^nil ].
76	(item type isNil or: [ signal tag isKindOf: item type ])
77	    ifTrue: [
78		context at: self exceptionTemp put: signal tag.
79		signal foundJavaHandler: item in: context.
80		^#found ].
81    ] repeat.
82! !
83
84!JavaClass methodsFor: 'translation'!
85
86install
87    | theNamespace theSuperclass |
88    self isLoaded ifFalse: [ self load ].
89
90    theNamespace := self package asSmalltalkPackage.
91    theSuperclass := self extends isNil
92    	ifTrue: [JavaObject]
93    	ifFalse:
94    	    ["Try to reuse the namespace we found for this class, as
95	      superclasses often reside in the same package as subclasses."
96    	    self extends
97    		asSmalltalkClassWithPackage: self package
98    		associatedToNamespace: theNamespace].
99
100    "Transcript show: 'Installing '; show: self fullName; nl."
101    ^theSuperclass createSubclass: self into: theNamespace! !
102
103!JavaClass methodsFor: 'translation'!
104
105asSmalltalkClassWithPackage: knownPackage associatedToNamespace: smalltalkPackage
106    | ourSmalltalkPackage smalltalkClass |
107    ourSmalltalkPackage := package == knownPackage
108        ifTrue: [ smalltalkPackage ]
109        ifFalse: [ package asSmalltalkPackage ].
110
111    smalltalkClass := ourSmalltalkPackage
112	hereAt: self name asSymbol
113	ifAbsent: [ nil ].
114
115    smalltalkClass isNil ifTrue: [
116	smalltalkClass := self install ].
117
118    ^smalltalkClass!
119
120asSmalltalkClass
121    | smalltalkPackage smalltalkClass |
122    smalltalkPackage := package asSmalltalkPackage.
123    smalltalkClass := smalltalkPackage
124	hereAt: self name asSymbol
125	ifAbsent: [ nil ].
126
127    smalltalkClass isNil ifTrue: [
128	smalltalkClass := self install ].
129
130    ^smalltalkClass! !
131
132!JavaPackage methodsFor: 'translation'!
133
134asSmalltalkPackage
135    | containerSmalltalkPackage |
136    self == Root ifTrue: [ ^Java ].
137
138    containerSmalltalkPackage := self container asSmalltalkPackage.
139    ^containerSmalltalkPackage
140        at: self name asSymbol
141        ifAbsent: [
142            containerSmalltalkPackage addSubspace: self name asSymbol.
143            containerSmalltalkPackage at: self name asSymbol ]
144! !
145
146
147!JavaStringPrototype methodsFor: 'bootstrap'!
148
149convertToJavaLangString
150    self makeReadOnly: false.
151    ^self become: self stringValue asJavaString
152! !
153
154!String methodsFor: 'java'!
155
156asJavaString
157    ^Java.java.lang.String new
158        perform: #'<init>([C)V' with: self
159! !
160
161
162!Number methodsFor: 'java conversion'!
163
164javaCmpL: anInteger
165    self = anInteger ifTrue: [ ^0 ].
166    ^self > anInteger ifTrue: [ 1 ] ifFalse: [ -1 ]!
167
168javaCmpG: anInteger
169    self = anInteger ifTrue: [ ^0 ].
170    ^self < anInteger ifTrue: [ -1 ] ifFalse: [ 1 ]!
171
172javaAsByte
173    | i |
174    i := self asInteger bitAnd: 255.
175    ^i < 128 ifTrue: [ i ] ifFalse: [ i - 256 ]!
176
177javaAsShort
178    | i |
179    i := self asInteger bitAnd: 65535.
180    ^i < 32768 ifTrue: [ i ] ifFalse: [ i - 65536 ]!
181
182javaAsInt
183    | i j |
184    j := self asInteger.
185    j size <= 4 ifTrue: [ ^j ].
186    i := (j at: 4) < 128
187	ifTrue: [ LargePositiveInteger new: 4 ]
188	ifFalse: [ LargeNegativeInteger new: 4 ].
189
190    i at: 1 put: (j at: 1).
191    i at: 2 put: (j at: 2).
192    i at: 3 put: (j at: 3).
193    i at: 4 put: (j at: 4).
194    ^i!
195
196javaAsLong
197    | i j |
198    j := self asInteger.
199    j size <= 8 ifTrue: [ ^j ].
200    i := (j at: 8) < 128
201	ifTrue: [ LargePositiveInteger new: 8 ]
202	ifFalse: [ LargeNegativeInteger new: 8 ].
203
204    i at: 1 put: (j at: 1).
205    i at: 2 put: (j at: 2).
206    i at: 3 put: (j at: 3).
207    i at: 4 put: (j at: 4).
208    i at: 5 put: (j at: 5).
209    i at: 6 put: (j at: 6).
210    i at: 7 put: (j at: 7).
211    i at: 8 put: (j at: 8).
212    ^i!
213
214!Integer methodsFor: 'java arithmetic'!
215
216javaCmp: anInteger
217    self = anInteger ifTrue: [ ^0 ].
218    ^self < anInteger ifTrue: [ -1 ] ifFalse: [ 1 ]!
219
220javaAsByte
221    | i |
222    i := self bitAnd: 255.
223    ^i < 128 ifTrue: [ i ] ifFalse: [ i - 256 ]!
224
225javaAsShort
226    | i |
227    i := self bitAnd: 65535.
228    ^i < 32768 ifTrue: [ i ] ifFalse: [ i - 65536 ]!
229
230javaAsInt
231    | i |
232    i := (self at: 4) < 128
233	ifTrue: [ LargePositiveInteger new: 4 ]
234	ifFalse: [ LargeNegativeInteger new: 4 ].
235
236    i at: 1 put: (self at: 1).
237    i at: 2 put: (self at: 2).
238    i at: 3 put: (self at: 3).
239    i at: 4 put: (self at: 4).
240    ^i!
241
242javaAsLong
243    | i |
244    self size <= 8 ifTrue: [ ^self ].
245    i := (self at: 8) < 128
246	ifTrue: [ LargePositiveInteger new: 8 ]
247	ifFalse: [ LargeNegativeInteger new: 8 ].
248
249    i at: 1 put: (self at: 1).
250    i at: 2 put: (self at: 2).
251    i at: 3 put: (self at: 3).
252    i at: 4 put: (self at: 4).
253    i at: 5 put: (self at: 5).
254    i at: 6 put: (self at: 6).
255    i at: 7 put: (self at: 7).
256    i at: 8 put: (self at: 8).
257    ^i!
258
259javaIushr: shift
260    shift <= 0 ifTrue: [ ^self ].
261    self > 0 ifTrue: [ ^self bitShift: 0 - shift ].
262    ^(self bitShift: 0 - shift)
263    	bitAnd: (16rFFFF_FFFF bitShift: 0 - shift)!
264
265javaLushr: shift
266    shift <= 0 ifTrue: [ ^self ].
267    self > 0 ifTrue: [ ^self bitShift: 0 - shift ].
268    ^(self bitShift: 0 - shift)
269    	bitAnd: (16rFFFF_FFFF_FFFF_FFFF bitShift: 0 - shift)!
270
271!SmallInteger methodsFor: 'java arithmetic'!
272
273javaAsInt
274    ^self!
275
276javaAsLong
277    ^self!
278
279javaIushr: shift
280    "Optimize the common case where we can avoid creating a
281     LargeInteger."
282    shift >= 2 ifTrue: [
283        ^(self bitShift: 0 - shift)
284    	    bitAnd: (16r3FFF_FFFF bitShift: 2 - shift) ].
285    shift <= 0 ifTrue: [ ^self ].
286    self > 0 ifTrue: [ ^self bitShift: 0 - shift ].
287    ^(self bitShift: -1) bitAnd: 16r7FFF_FFFF!
288
289javaLushr: shift
290    "Optimize the case where we can avoid creating a LargeInteger."
291    shift >= 34 ifTrue: [
292        ^(self bitShift: 0 - shift)
293    	    bitAnd: (16r3FFF_FFFF bitShift: 34 - shift) ].
294    shift <= 0 ifTrue: [ ^self ].
295    self > 0 ifTrue: [ ^self bitShift: 0 - shift ].
296    ^(self bitShift: 0 - shift)
297    	bitAnd: (16rFFFF_FFFF_FFFF_FFFF bitShift: 0 - shift)! !
298
299!UndefinedObject methodsFor: 'JavaObject interoperability'!
300
301checkCast: anObject
302!
303
304instanceOf: aClass
305    ^0
306! !
307
308!Object class methodsFor: 'java arrays'!
309
310javaNewArray: size
311    <primitive: VMpr_Behavior_basicNewColon>
312    size < 0 ifTrue: [
313	^Java.gnu.smalltalk.JavaVM throw: Java.java.lang.NegativeArraySizeException ].
314    self primitiveFailed!
315
316!JavaType methodsFor: 'java arrays'!
317
318javaMultiNewArray: sizes from: index
319    | array size |
320    (size := sizes at: index) < 0 ifTrue: [
321	^JavaVM throw: Java.java.lang.NegativeArraySizeException ].
322
323    array := self arrayClass new: size.
324    index < sizes size ifTrue: [
325	1 to: size do: [ :i |
326	    array
327		at: i
328		put: (self subType javaMultiNewArray: sizes from: index + 1)]].
329    ^array
330! !
331