--- a/Character.st Tue Apr 14 06:43:20 2015 +0200
+++ b/Character.st Wed Apr 15 06:04:10 2015 +0200
@@ -48,23 +48,23 @@
Also, the encoding is actually Unicode, of which ascii is a subset and the same encoding value
for the first 128 characters (codePoint 0 to 127 are the same in ascii).
- Some heavily used Characters are kept as singletons; i.e. for every asciiValue (0..N),
+ Some heavily used Characters are kept as singletons; i.e. for every asciiValue (0..N),
there exists exactly one instance of Character, which is shared.
Character value:xxx checks for this, and returns a reference to an existing instance.
For N<=255, this is guaranteed; i.e. in all Smalltalks, the single byte characters are always
handled like this, and you can therefore safely compare them using == (identity compare).
Other characters (i.e. codepoint > N) are not guaranteed to be shared;
- i.e. these my or may not be created as required.
+ i.e. these my or may not be created as required.
Actually, do NOT depend on which characters are and which are not shared.
Always compare using #= if there is any chance of a non-ascii character being involved.
Once again (because beginners sometimes make this mistake):
- This means: you may compare characters using #== ONLY IFF you are certain,
- that the characters ranges is 0..255.
- Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).
- Sorry for this inconvenience, but it is (practically) impossible to keep
- the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.
+ This means: you may compare characters using #== ONLY IFF you are certain,
+ that the characters ranges is 0..255.
+ Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).
+ Sorry for this inconvenience, but it is (practically) impossible to keep
+ the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.
In ST/X, N is (currently) 1024. This means that all the latin characters and some others are
kept as singleton in the CharacterTable class variable (which is also used by the VM when characters
@@ -77,7 +77,7 @@
Some of these have been modified a bit.
WARNING: characters are known by compiler and runtime system -
- do not change the instance layout.
+ do not change the instance layout.
Also, although you can create subclasses of Character, the compiler always
creates instances of Character for literals ...
@@ -86,43 +86,43 @@
Therefore, it may not make sense to create a character-subclass.
Case Mapping in Unicode:
- There are a number of complications to case mappings that occur once the repertoire
- of characters is expanded beyond ASCII.
-
- * Because of the inclusion of certain composite characters for compatibility,
- such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
- which is used where the first letter of a word is to be capitalized
- (e.g. Titlecase, vs. UPPERCASE, or lowercase).
- For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
-
- * Case mappings may produce strings of different length than the original.
- For example, the German character U+00DF small letter sharp s expands when uppercased to
- the sequence of two characters 'SS'.
- This also occurs where there is no precomposed character corresponding to a case mapping.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may also have different case mappings, depending on the context.
- For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
- by another letter, but lowercases to 03C2 small final sigma if it is.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may have case mappings that depend on the locale.
- For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
- *** This is not yet implemented (in 5.2) ***
-
- * Case mappings are not, in general, reversible.
- For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
- the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
+ There are a number of complications to case mappings that occur once the repertoire
+ of characters is expanded beyond ASCII.
+
+ * Because of the inclusion of certain composite characters for compatibility,
+ such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
+ which is used where the first letter of a word is to be capitalized
+ (e.g. Titlecase, vs. UPPERCASE, or lowercase).
+ For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
+
+ * Case mappings may produce strings of different length than the original.
+ For example, the German character U+00DF small letter sharp s expands when uppercased to
+ the sequence of two characters 'SS'.
+ This also occurs where there is no precomposed character corresponding to a case mapping.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may also have different case mappings, depending on the context.
+ For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
+ by another letter, but lowercases to 03C2 small final sigma if it is.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may have case mappings that depend on the locale.
+ For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Case mappings are not, in general, reversible.
+ For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
+ the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
Collation Sequence:
- *** This is not yet implemented (in 5.2) ***
+ *** This is not yet implemented (in 5.2) ***
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- String TwoByteString Unicode16String Unicode32String
- StringCollection Text
+ String TwoByteString Unicode16String Unicode32String
+ StringCollection Text
"
! !
@@ -138,7 +138,14 @@
"return a character with codePoint anInteger"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ {
+ char ch = (char)(context.stArg(0).intValue("[codePoint:]"));
+
+ return context._RETURN(STCharacter._new(ch));
+ }
+ /* NOTREACHED */
+#else
INT __codePoint;
if (__isSmallInteger(anInteger)) {
@@ -149,6 +156,7 @@
RETURN ( __MKUCHARACTER(__codePoint) );
}
}
+#endif
%}.
(anInteger between:0 and:(CharacterTable size - 1)) ifTrue:[
^ CharacterTable at:(anInteger + 1)
@@ -584,13 +592,13 @@
Added for squeak compatibility"
Separators isNil ifTrue:[
- Separators := Array
- with:Character space
- with:Character return
- "/ with:Character cr
- with:Character tab
- with:Character lf
- with:Character ff
+ Separators := Array
+ with:Character space
+ with:Character return
+ "/ with:Character cr
+ with:Character tab
+ with:Character lf
+ with:Character ff
].
^ Separators
@@ -736,10 +744,10 @@
^ asciivalue = aCharacter codePoint
"
- $A = (Character value:65)
- $A = (Character codePoint:65)
- $A = ($B-1)
- $A = 65
+ $A = (Character value:65)
+ $A = (Character codePoint:65)
+ $A = ($B-1)
+ $A = 65
"
!
@@ -832,6 +840,15 @@
(which is more than mozilla does, btw. ;-)"
%{
+#ifdef __JAVA__
+ {
+ char ch = self.charValue("[asLowercase]");
+
+ ch = java.lang.Character.toLowerCase(ch);
+ return context._RETURN(STCharacter._new(ch));
+ }
+ /* NOTREACHED */
+#else
static int __mapping[] = {
/* From To Every Diff */
0x0041, ((0x19 << 8) | 0x01), 0x0020 ,
@@ -992,6 +1009,7 @@
}
RETURN (self);
allocationError: ;
+#endif /* ! __JAVA__ */
%}.
^ ObjectMemory allocationFailureSignal raise.
@@ -1137,6 +1155,15 @@
(which is more than mozilla does, btw. ;-)"
%{
+#ifdef __JAVA__
+ {
+ char ch = self.charValue("[asUppercase]");
+
+ ch = java.lang.Character.toUpperCase(ch);
+ return context._RETURN(STCharacter._new(ch));
+ }
+ /* NOTREACHED */
+#else
static int __mapping[] = {
/* From To Every Diff */
0x0061, ((0x19 << 8) | 0x01), -32 ,
@@ -1309,6 +1336,7 @@
}
RETURN (self);
allocationError: ;
+#endif /* ! __JAVA__ */
%}.
^ ObjectMemory allocationFailureSignal raise.
@@ -1445,31 +1473,31 @@
// fast code for common cases
val = __intVal(__characterVal(self));
if (val <= 0xFF) {
- if (__isCharacter(aStringOrCharacter)) {
- unsigned INT val2 = __intVal(__characterVal(aStringOrCharacter));
-
- if (val2 <= 0xFF) {
- char buffer[2];
-
- buffer[0] = val;
- buffer[1] = val2;
- s = __MKSTRING_L(buffer, 2);
- if (s != nil) {
- RETURN (s);
- }
- }
- } else {
- if (__isString(aStringOrCharacter)) {
- int strSize = __stringSize(aStringOrCharacter);
-
- s = __MKEMPTYSTRING(strSize+1);
- if (s != nil) {
- __StringInstPtr(s)->s_element[0] = val;
- memcpy(__StringInstPtr(s)->s_element+1, __stringVal(aStringOrCharacter), strSize+1); // copies 0-byte too
- RETURN (s);
- }
- }
- }
+ if (__isCharacter(aStringOrCharacter)) {
+ unsigned INT val2 = __intVal(__characterVal(aStringOrCharacter));
+
+ if (val2 <= 0xFF) {
+ char buffer[2];
+
+ buffer[0] = val;
+ buffer[1] = val2;
+ s = __MKSTRING_L(buffer, 2);
+ if (s != nil) {
+ RETURN (s);
+ }
+ }
+ } else {
+ if (__isString(aStringOrCharacter)) {
+ int strSize = __stringSize(aStringOrCharacter);
+
+ s = __MKEMPTYSTRING(strSize+1);
+ if (s != nil) {
+ __StringInstPtr(s)->s_element[0] = val;
+ memcpy(__StringInstPtr(s)->s_element+1, __stringVal(aStringOrCharacter), strSize+1); // copies 0-byte too
+ RETURN (s);
+ }
+ }
+ }
}
%}.
^ self asString , aStringOrCharacter
@@ -1592,7 +1620,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifFalse:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
self storeOn:aGCOrStream.
@@ -2384,8 +2412,8 @@
"return a new character which represents the receiver without diacritics.
This is used with string search and when lists are to be ordered/sorted by base character order.
CAVEAT:
- for now, this method is only correct for unicode characters up to u+2FF,
- i.e. latin languages"
+ for now, this method is only correct for unicode characters up to u+2FF,
+ i.e. latin languages"
%{ /* NOCONTEXT */
@@ -2394,79 +2422,79 @@
/* because used so often, this is open coded, instead of table driven */
val = __intVal(__INST(asciivalue));
switch (val >> 8) {
- case 0x00:
- if (val < 0xC0) { RETURN(self); }
- if (val <= 0xC6) { val = 'A'; break; }
- if (val == 0xC7) { val = 'C'; break; }
- if (val <= 0xCB) { val = 'E'; break; }
- if (val <= 0xCF) { val = 'I'; break; }
- if (val == 0xD0) { val = 'D'; break; }
- if (val == 0xD1) { val = 'N'; break; }
- if (val <= 0xD6) { val = 'O'; break; }
- if (val == 0xD7) { RETURN(self) }
- if (val == 0xD8) { val = 'O'; break; }
- if (val <= 0xDC) { val = 'U'; break; }
- if (val == 0xDD) { val = 'Y'; break; }
-
- if (val < 0xE0) { RETURN(self) }
- if (val <= 0xE6) { val = 'a'; break; }
- if (val == 0xE7) { val = 'c'; break; }
- if (val <= 0xEB) { val = 'e'; break; }
- if (val <= 0xEF) { val = 'i'; break; }
- if (val == 0xF0) { val = 'd'; break; }
- if (val == 0xF1) { val = 'n'; break; }
- if (val <= 0xF6) { val = 'o'; break; }
- if (val == 0xF7) { RETURN(self) }
- if (val == 0xF8) { val = 'o'; break; }
- if (val <= 0xFC) { val = 'u'; break; }
- if (val == 0xFD) { val = 'y'; break; }
- if (val == 0xFF) { val = 'y'; break; }
- RETURN (self);
-
- case 0x01:
- if (val <= 0x105) { val = (val & 1) ? 'a' : 'A'; break; }
- if (val <= 0x10D) { val = (val & 1) ? 'c' : 'C'; break; }
- if (val <= 0x111) { val = (val & 1) ? 'd' : 'D'; break; }
- if (val <= 0x11B) { val = (val & 1) ? 'e' : 'E'; break; }
- if (val <= 0x123) { val = (val & 1) ? 'g' : 'G'; break; }
- if (val <= 0x127) { val = (val & 1) ? 'h' : 'H'; break; }
- if (val <= 0x133) { val = (val & 1) ? 'i' : 'I'; break; }
- if (val <= 0x137) { val = (val & 1) ? 'k' : 'K'; break; }
- if (val == 0x138) { val = 'K'; break; }
- if (val <= 0x142) { val = (val & 1) ? 'L' : 'l'; break; }
- if (val <= 0x148) { val = (val & 1) ? 'N' : 'n'; break; }
- if (val <= 0x14B) { val = (val & 1) ? 'n' : 'N'; break; }
- if (val <= 0x153) { val = (val & 1) ? 'o' : 'O'; break; }
- if (val <= 0x159) { val = (val & 1) ? 'r' : 'R'; break; }
- if (val <= 0x161) { val = (val & 1) ? 's' : 'S'; break; }
- if (val <= 0x167) { val = (val & 1) ? 't' : 'T'; break; }
- if (val <= 0x173) { val = (val & 1) ? 'u' : 'U'; break; }
- if (val <= 0x175) { val = (val & 1) ? 'w' : 'W'; break; }
- if (val <= 0x178) { val = (val & 1) ? 'y' : 'Y'; break; }
- if (val <= 0x17E) { val = (val & 1) ? 'Z' : 'z'; break; }
- RETURN (self);
-
- case 0x02:
- if (val <= 0x203) { val = (val & 1) ? 'a' : 'A'; break; }
- if (val <= 0x207) { val = (val & 1) ? 'e' : 'E'; break; }
- if (val <= 0x20B) { val = (val & 1) ? 'i' : 'I'; break; }
- if (val <= 0x20F) { val = (val & 1) ? 'o' : 'O'; break; }
- if (val <= 0x213) { val = (val & 1) ? 'r' : 'R'; break; }
- if (val <= 0x217) { val = (val & 1) ? 'u' : 'U'; break; }
- if (val <= 0x219) { val = (val & 1) ? 's' : 'S'; break; }
- if (val <= 0x21B) { val = (val & 1) ? 't' : 'T'; break; }
- RETURN (self);
-
- case 0x03:
- // to be done
- RETURN (self);
-
- case 0x04:
- // to be done
- RETURN (self);
+ case 0x00:
+ if (val < 0xC0) { RETURN(self); }
+ if (val <= 0xC6) { val = 'A'; break; }
+ if (val == 0xC7) { val = 'C'; break; }
+ if (val <= 0xCB) { val = 'E'; break; }
+ if (val <= 0xCF) { val = 'I'; break; }
+ if (val == 0xD0) { val = 'D'; break; }
+ if (val == 0xD1) { val = 'N'; break; }
+ if (val <= 0xD6) { val = 'O'; break; }
+ if (val == 0xD7) { RETURN(self) }
+ if (val == 0xD8) { val = 'O'; break; }
+ if (val <= 0xDC) { val = 'U'; break; }
+ if (val == 0xDD) { val = 'Y'; break; }
+
+ if (val < 0xE0) { RETURN(self) }
+ if (val <= 0xE6) { val = 'a'; break; }
+ if (val == 0xE7) { val = 'c'; break; }
+ if (val <= 0xEB) { val = 'e'; break; }
+ if (val <= 0xEF) { val = 'i'; break; }
+ if (val == 0xF0) { val = 'd'; break; }
+ if (val == 0xF1) { val = 'n'; break; }
+ if (val <= 0xF6) { val = 'o'; break; }
+ if (val == 0xF7) { RETURN(self) }
+ if (val == 0xF8) { val = 'o'; break; }
+ if (val <= 0xFC) { val = 'u'; break; }
+ if (val == 0xFD) { val = 'y'; break; }
+ if (val == 0xFF) { val = 'y'; break; }
+ RETURN (self);
+
+ case 0x01:
+ if (val <= 0x105) { val = (val & 1) ? 'a' : 'A'; break; }
+ if (val <= 0x10D) { val = (val & 1) ? 'c' : 'C'; break; }
+ if (val <= 0x111) { val = (val & 1) ? 'd' : 'D'; break; }
+ if (val <= 0x11B) { val = (val & 1) ? 'e' : 'E'; break; }
+ if (val <= 0x123) { val = (val & 1) ? 'g' : 'G'; break; }
+ if (val <= 0x127) { val = (val & 1) ? 'h' : 'H'; break; }
+ if (val <= 0x133) { val = (val & 1) ? 'i' : 'I'; break; }
+ if (val <= 0x137) { val = (val & 1) ? 'k' : 'K'; break; }
+ if (val == 0x138) { val = 'K'; break; }
+ if (val <= 0x142) { val = (val & 1) ? 'L' : 'l'; break; }
+ if (val <= 0x148) { val = (val & 1) ? 'N' : 'n'; break; }
+ if (val <= 0x14B) { val = (val & 1) ? 'n' : 'N'; break; }
+ if (val <= 0x153) { val = (val & 1) ? 'o' : 'O'; break; }
+ if (val <= 0x159) { val = (val & 1) ? 'r' : 'R'; break; }
+ if (val <= 0x161) { val = (val & 1) ? 's' : 'S'; break; }
+ if (val <= 0x167) { val = (val & 1) ? 't' : 'T'; break; }
+ if (val <= 0x173) { val = (val & 1) ? 'u' : 'U'; break; }
+ if (val <= 0x175) { val = (val & 1) ? 'w' : 'W'; break; }
+ if (val <= 0x178) { val = (val & 1) ? 'y' : 'Y'; break; }
+ if (val <= 0x17E) { val = (val & 1) ? 'Z' : 'z'; break; }
+ RETURN (self);
+
+ case 0x02:
+ if (val <= 0x203) { val = (val & 1) ? 'a' : 'A'; break; }
+ if (val <= 0x207) { val = (val & 1) ? 'e' : 'E'; break; }
+ if (val <= 0x20B) { val = (val & 1) ? 'i' : 'I'; break; }
+ if (val <= 0x20F) { val = (val & 1) ? 'o' : 'O'; break; }
+ if (val <= 0x213) { val = (val & 1) ? 'r' : 'R'; break; }
+ if (val <= 0x217) { val = (val & 1) ? 'u' : 'U'; break; }
+ if (val <= 0x219) { val = (val & 1) ? 's' : 'S'; break; }
+ if (val <= 0x21B) { val = (val & 1) ? 't' : 'T'; break; }
+ RETURN (self);
+
+ case 0x03:
+ // to be done
+ RETURN (self);
+
+ case 0x04:
+ // to be done
+ RETURN (self);
}
if (val <= MAX_IMMEDIATE_CHARACTER) {
- RETURN (__MKCHARACTER(val)) ;
+ RETURN (__MKCHARACTER(val)) ;
}
RETURN (__MKUCHARACTER(val)) ;
%}
@@ -3007,10 +3035,10 @@
!Character class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.159 2015-02-07 15:36:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.160 2015-04-15 00:30:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.159 2015-02-07 15:36:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.160 2015-04-15 00:30:56 cg Exp $'
! !
--- a/Object.st Tue Apr 14 06:43:20 2015 +0200
+++ b/Object.st Wed Apr 15 06:04:10 2015 +0200
@@ -796,7 +796,13 @@
This method should NOT be redefined in any subclass (except with great care, for tuning)"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ {
+ int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ return context.RETURN( self.basicAt( idx1Based ));
+ }
+ /* NOTREACHED */
+#else
REGISTER int nbytes, indx;
OBJ myClass;
REGISTER char *pFirst;
@@ -876,14 +882,14 @@
/*
* native doubles
*/
-#ifdef __NEED_DOUBLE_ALIGN
+# ifdef __NEED_DOUBLE_ALIGN
if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
pFirst += delta;
nbytes -= delta;
}
-#endif
+# endif
if ((unsigned)indx < (nbytes / sizeof(double))) {
double *dp;
double d;
@@ -943,17 +949,17 @@
lp = (unsigned int32 *)(pFirst + (indx<<2));
ul = *lp;
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
{
unsigned INT ull = (unsigned INT)ul;
RETURN ( __mkSmallInteger(ull) );
}
-#else
+# else
if (ul <= _MAX_INT) {
RETURN ( __mkSmallInteger(ul) );
}
RETURN ( __MKULARGEINT(ul) );
-#endif
+# endif
}
break;
@@ -970,17 +976,17 @@
slp = (int32 *)(pFirst + (indx<<2));
l = *slp;
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
{
INT ll = (INT)l;
RETURN ( __mkSmallInteger(ll) );
}
-#else
+# else
if (__ISVALIDINTEGER(l)) {
RETURN ( __mkSmallInteger(l) );
}
RETURN ( __MKLARGEINT(l) );
-#endif
+# endif
}
break;
@@ -988,19 +994,19 @@
/*
* signed 64bit longlongs
*/
-#ifdef __NEED_LONGLONG_ALIGN
+# ifdef __NEED_LONGLONG_ALIGN
if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
nbytes -= delta;
}
-#endif
+# endif
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the long/longlong-size of the machine
*/
if ((unsigned)indx < (nbytes>>3)) {
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
INT *slp, ll;
slp = (INT *)(pFirst + (indx<<3));
@@ -1009,12 +1015,12 @@
RETURN ( __mkSmallInteger(ll) );
}
RETURN ( __MKLARGEINT(ll) );
-#else
+# else
__int64__ *llp;
llp = (__int64__ *)(pFirst + (indx<<3));
RETURN (__MKINT64(llp));
-#endif
+# endif
}
break;
@@ -1022,19 +1028,19 @@
/*
* unsigned 64bit longlongs
*/
-#ifdef __NEED_LONGLONG_ALIGN
+# ifdef __NEED_LONGLONG_ALIGN
if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
nbytes -= delta;
}
-#endif
+# endif
/* Notice: the hard coded shifts are by purpose;
* it makes us independent of the long/longlong-size of the machine
*/
if ((unsigned)indx < (nbytes>>3)) {
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
unsigned INT *ulp, ul;
ulp = (unsigned INT *)(pFirst + (indx<<3));
@@ -1043,16 +1049,17 @@
RETURN ( __mkSmallInteger(ul) );
}
RETURN ( __MKULARGEINT(ul) );
-#else
+# else
__uint64__ *llp;
llp = (__uint64__ *)(pFirst + (indx<<3));
RETURN (__MKUINT64(llp));
-#endif
+# endif
}
break;
}
}
+#endif /* ! __JAVA__ */
%}.
^ self indexNotIntegerOrOutOfBounds:index
!
@@ -1065,11 +1072,20 @@
This method should NOT be redefined in any subclass (except with great care, for tuning)"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ {
+ int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ STObject val = context.stArg(1);
+
+ self.basicAt_put_(idx1Based, val );
+ return context.RETURN( val );
+ }
+ /* NOTREACHED */
+#else
register int nbytes, indx;
OBJ myClass;
register char *pFirst;
-/* int nInstBytes, ninstvars, flags; */
+ /* int nInstBytes, ninstvars, flags; */
REGISTER int n;
unsigned int u;
int val;
@@ -1149,14 +1165,14 @@
break;
case __MASKSMALLINT(DOUBLEARRAY):
-#ifdef __NEED_DOUBLE_ALIGN
+# ifdef __NEED_DOUBLE_ALIGN
if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
pFirst += delta;
nbytes -= delta;
}
-#endif
+# endif
if ((unsigned)indx < (nbytes / sizeof(double))) {
double *dp;
@@ -1224,9 +1240,9 @@
* (would be a smallInteger)
*/
if (n) {
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
if ((n >= -0x80000000) && (n < 0x80000000))
-#endif
+# endif
{
*slp = n;
RETURN ( anObject );
@@ -1250,9 +1266,9 @@
* (would be a smallInteger)
*/
if (u) {
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
if (u <= 0xFFFFFFFF)
-#endif
+# endif
{
*lp = u;
RETURN ( anObject );
@@ -1262,21 +1278,21 @@
break;
case __MASKSMALLINT(SLONGLONGARRAY):
-#ifdef __NEED_LONGLONG_ALIGN
+# ifdef __NEED_LONGLONG_ALIGN
if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
nbytes -= delta;
}
-#endif
+# endif
if ((unsigned)indx < (nbytes>>3)) {
__int64__ ll;
__int64__ *sllp;
sllp = (__int64__ *)(pFirst + (indx<<3));
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
if (__isSmallInteger(anObject)) {
*sllp = __intVal(anObject);
RETURN ( anObject );
@@ -1286,7 +1302,7 @@
*sllp = n;
RETURN ( anObject );
}
-#else
+# else
if (anObject == __mkSmallInteger(0)) {
ll.lo = ll.hi = 0;
*sllp = ll;
@@ -1296,25 +1312,25 @@
*sllp = ll;
RETURN ( anObject );
}
-#endif
+# endif
}
break;
case __MASKSMALLINT(LONGLONGARRAY):
-#ifdef __NEED_LONGLONG_ALIGN
+# ifdef __NEED_LONGLONG_ALIGN
if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
pFirst += delta;
nbytes -= delta;
}
-#endif
+# endif
if ((unsigned)indx < (nbytes>>3)) {
__uint64__ ll;
__uint64__ *llp;
llp = (__uint64__ *)(pFirst + (indx<<3));
-#if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
if (__isSmallInteger(anObject)) {
*llp = __intVal(anObject);
RETURN ( anObject );
@@ -1324,7 +1340,7 @@
*llp = ll;
RETURN ( anObject );
}
-#else
+# else
if (anObject == __mkSmallInteger(0)) {
ll.lo = ll.hi = 0;
*llp = ll;
@@ -1334,11 +1350,12 @@
*llp = ll;
RETURN ( anObject );
}
-#endif
+# endif
}
break;
}
}
+#endif /* ! JAVA */
%}.
index isInteger ifFalse:[
"
@@ -1724,7 +1741,7 @@
attrs := self objectAttributes.
attrs size ~~ 0 ifTrue:[
- ^ attrs at:attributeKey ifAbsent:[]
+ ^ attrs at:attributeKey ifAbsent:[]
].
^ nil
@@ -1738,30 +1755,30 @@
"/ must do this save from being reentered, since the attributes collection
"/ is possibly accessed from multiple threads...
ObjectAttributesAccessLock critical:[
- | attrs |
-
- attrs := self objectAttributes.
- "/ only need a WeakIdentityDictionary, if there are any non-symbol keys in
- "/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required.
- "/ Typically, this never happens (but does in the UIPainter!!)
- attrs isEmptyOrNil ifTrue:[
- attributeKey isSymbol ifTrue:[
- attrs := IdentityDictionary new.
- ] ifFalse:[
- attrs := WeakIdentityDictionary new.
- ].
- attrs at:attributeKey put:anObject.
- self objectAttributes:attrs.
- ] ifFalse:[
- attributeKey isSymbol ifFalse:[
- attrs isWeakCollection ifFalse:[
- "first non-symbol attributeKey - convert to WeakIdentityDictionary"
- attrs := WeakIdentityDictionary new declareAllFrom:attrs.
- self objectAttributes:attrs.
- ].
- ].
- attrs at:attributeKey put:anObject.
- ].
+ | attrs |
+
+ attrs := self objectAttributes.
+ "/ only need a WeakIdentityDictionary, if there are any non-symbol keys in
+ "/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required.
+ "/ Typically, this never happens (but does in the UIPainter!!)
+ attrs isEmptyOrNil ifTrue:[
+ attributeKey isSymbol ifTrue:[
+ attrs := IdentityDictionary new.
+ ] ifFalse:[
+ attrs := WeakIdentityDictionary new.
+ ].
+ attrs at:attributeKey put:anObject.
+ self objectAttributes:attrs.
+ ] ifFalse:[
+ attributeKey isSymbol ifFalse:[
+ attrs isWeakCollection ifFalse:[
+ "first non-symbol attributeKey - convert to WeakIdentityDictionary"
+ attrs := WeakIdentityDictionary new declareAllFrom:attrs.
+ self objectAttributes:attrs.
+ ].
+ ].
+ attrs at:attributeKey put:anObject.
+ ].
]
"Attaching additional attributes (slots) to an arbitrary object:
@@ -1802,11 +1819,11 @@
"/ is possibly accessed from multiple threads.
ObjectAttributesAccessLock critical:[
- aCollection isEmptyOrNil ifTrue:[
- ObjectAttributes removeKey:self ifAbsent:nil
- ] ifFalse:[
- ObjectAttributes at:self put:aCollection
- ].
+ aCollection isEmptyOrNil ifTrue:[
+ ObjectAttributes removeKey:self ifAbsent:nil
+ ] ifFalse:[
+ ObjectAttributes at:self put:aCollection
+ ].
]
"Created: / 22.1.1998 / 21:29:35 / av"
@@ -1819,17 +1836,17 @@
"/ must do this save from being reentered, since the attributes collection
"/ is possibly accessed from multiple threads.
ObjectAttributesAccessLock critical:[
- |attrs|
-
- attrs := self objectAttributes.
- attrs notNil ifTrue:[
- attrs size ~~ 0 ifTrue:[
- attrs removeKey:attributeKey ifAbsent:nil.
- ].
- attrs size == 0 ifTrue:[
- self objectAttributes:nil
- ].
- ]
+ |attrs|
+
+ attrs := self objectAttributes.
+ attrs notNil ifTrue:[
+ attrs size ~~ 0 ifTrue:[
+ attrs removeKey:attributeKey ifAbsent:nil.
+ ].
+ attrs size == 0 ifTrue:[
+ self objectAttributes:nil
+ ].
+ ]
]
"Created: / 22.1.1998 / 21:29:39 / av"
@@ -2873,11 +2890,11 @@
"/ could still be a block or false.
(aBooleanOrBlock value) ifFalse:[
- AssertionFailedError
- raiseRequestWith:self
- errorString:('Assertion failed in ',
- thisContext methodHome sender printString,
- '[', thisContext methodHome sender lineNumber printString,']')
+ AssertionFailedError
+ raiseRequestWith:self
+ errorString:('Assertion failed in ',
+ thisContext methodHome sender printString,
+ '[', thisContext methodHome sender lineNumber printString,']')
].
"
@@ -2899,9 +2916,9 @@
"/ could still be a block or false.
(aBooleanOrBlock value) ifFalse:[
- AssertionFailedError
- raiseRequestWith:self
- errorString:(messageIfFailing, ' {',thisContext methodHome sender "methodHome" printString,' }')
+ AssertionFailedError
+ raiseRequestWith:self
+ errorString:(messageIfFailing, ' {',thisContext methodHome sender "methodHome" printString,' }')
].
"
@@ -3242,8 +3259,8 @@
|spec sender message|
Smalltalk isSmalltalkDevelopmentSystem ifFalse:[
- "ignore in production systems"
- ^ self.
+ "ignore in production systems"
+ ^ self.
].
message := messageOrNil ? 'Obsolete method called'.
@@ -3254,28 +3271,28 @@
(' And may not be present in future ST/X versions.') infoPrintCR.
(' called from ' , sender printString) infoPrintCR.
(sender selector startsWith:'perform:') ifTrue:[
- sender := sender sender.
- (sender selector startsWith:'perform:') ifTrue:[
- sender := sender sender.
- ].
- (' called from ' , sender printString) infoPrintCR.
+ sender := sender sender.
+ (sender selector startsWith:'perform:') ifTrue:[
+ sender := sender sender.
+ ].
+ (' called from ' , sender printString) infoPrintCR.
].
message notNil ifTrue:[
- '------> ' infoPrint. message infoPrintCR
+ '------> ' infoPrint. message infoPrintCR
].
"CG: care for standalone non-GUI progs, which have no userPreferences class"
(Smalltalk isInitialized
and:[ UserPreferences notNil
and:[ UserPreferences current haltInObsoleteMethod]]) ifTrue:[
- "/ cg: nice try, stefan, but I don't want halts in system processes (fly by help and others)
- Processor activeProcess isSystemProcess ifTrue:[
- (message , ' - please fix this now (no halt in system process)') infoPrintCR
- ] ifFalse:[
- "/ please check for the sender of the obsoleteMethodWarning,
- "/ and fix the code there.
- self halt:(message , ' - please fix this now!!')
- ].
+ "/ cg: nice try, stefan, but I don't want halts in system processes (fly by help and others)
+ Processor activeProcess isSystemProcess ifTrue:[
+ (message , ' - please fix this now (no halt in system process)') infoPrintCR
+ ] ifFalse:[
+ "/ please check for the sender of the obsoleteMethodWarning,
+ "/ and fix the code there.
+ self halt:(message , ' - please fix this now!!')
+ ].
].
"
@@ -5215,42 +5232,42 @@
action title screen|
thisContext isRecursive ifTrue:[
- 'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR.
- 'Terminating process ' errorPrint. Processor activeProcess errorPrintCR.
+ 'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR.
+ 'Terminating process ' errorPrint. Processor activeProcess errorPrintCR.
"/ GenericException handle:[:ex |
"/ "/ ignore any error during termination
"/ ] do:[
"/ Processor activeProcess terminate.
"/ ].
- Processor activeProcess terminateNoSignal.
+ Processor activeProcess terminateNoSignal.
].
"if there has been an ST-signal installed, use it ..."
sig := OperatingSystem operatingSystemSignal:signalNumber.
sig notNil ifTrue:[
- sig raiseSignalWith:signalNumber.
- ^ self.
+ sig raiseSignalWith:signalNumber.
+ ^ self.
].
"/ if handled, raise OSSignalInterruptSignal
OSSignalInterrupt isHandled ifTrue:[
- OSSignalInterrupt raiseRequestWith:signalNumber.
- ^ self.
+ OSSignalInterrupt raiseRequestWith:signalNumber.
+ ^ self.
].
"
special cases
- - SIGPWR: power failure - write a crash image and continue
- - SIGHUP: hang up - write a crash image and exit
+ - SIGPWR: power failure - write a crash image and continue
+ - SIGHUP: hang up - write a crash image and exit
"
(signalNumber == OperatingSystem sigPWR) ifTrue:[
- SnapshotError ignoreIn:[ObjectMemory writeCrashImage].
- ^ self.
+ SnapshotError ignoreIn:[ObjectMemory writeCrashImage].
+ ^ self.
].
(signalNumber == OperatingSystem sigHUP) ifTrue:[
- SnapshotError ignoreIn:[ObjectMemory writeCrashImage].
- 'Object [info]: exit due to hangup signal.' errorPrintCR.
- Smalltalk exit:1.
+ SnapshotError ignoreIn:[ObjectMemory writeCrashImage].
+ 'Object [info]: exit due to hangup signal.' errorPrintCR.
+ Smalltalk exit:1.
].
name := OperatingSystem nameForSignal:signalNumber.
@@ -5260,7 +5277,7 @@
or:[(screen := Screen current) isNil
or:[(screen := Screen default) isNil
or:[screen isOpen not]]]) ifTrue:[
- ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
+ ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
].
"ungrab - in case it happened in a box/popupview
@@ -5272,117 +5289,117 @@
"there is a screen. use it to bring up a box asking for what to do ..."
Screen currentScreenQuerySignal answer:screen do:[
- "
- SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
- since the system will retry the faulty instruction, which leads to
- another signal - to avoid frustration, better not offer this option.
- "
- fatal := OperatingSystem isFatalSignal:signalNumber.
- fatal ifTrue:[
- (Debugger isNil or:[here isRecursive]) ifTrue:[
- 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
- ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
- ].
- "
- a hard signal - go into debugger immediately
- "
- msg := 'OS-signal: ', name.
-
- "/ the IRQ-PC is passed as low-hi, to avoid the need
- "/ to allocate a LargeInteger in the VM during signal
- "/ time. I know, this is ugly.
-
- InterruptPcLow notNil ifTrue:[
- pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)).
- pc ~~ 0 ifTrue:[
- msg := msg , ' PC=' , (pc printStringRadix:16)
- ].
- ].
- InterruptAddrLow notNil ifTrue:[
- addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)).
- addr ~~ 0 ifTrue:[
- msg := msg , ' ADDR=' , (addr printStringRadix:16)
- ].
- ].
- Debugger enter:here withMessage:msg mayProceed:false.
- "unreachable"
- ^ nil.
- ].
-
- "if possible, open an option box asking the user what do.
- Otherwise, start a debugger"
- Dialog notNil ifTrue:[
- OperatingSystem isOSXlike ifTrue:[
- titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug').
- actions := #(save core gdb exit debug).
- ] ifFalse:[
- titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug').
- actions := #(save core exit debug).
- ].
- action := nil.
- title := 'OS Signal caught (' , name, ')'.
- title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
-
- "/ if caught while in the scheduler or event dispatcher,
- "/ a modal dialog is not possible ...
- "/ (therefore, abort & return does not makes sense)
-
- Processor activeProcess isSystemProcess ifFalse:[
- titles := #('Abort') , titles.
- actions := #(abort), actions.
-
- badContext canReturn ifTrue:[
- titles := #('Return') , titles.
- actions := #(return), actions.
- ].
- ].
-
- fatal ifFalse:[
- titles := titles, #('Ignore').
- actions := actions , #(ignore).
- ].
- action := Dialog choose:title
- labels:titles
- values:actions
- default:(fatal ifTrue:[nil] ifFalse:[#ignore]).
-
- "Dialog may fail (if system process), default action is debug"
- action isEmptyOrNil ifTrue:[action := #debug].
- ] ifFalse:[
- action := #debug.
- ].
-
- action == #save ifTrue:[
- ObjectMemory writeCrashImage
- ].
- action == #gdb ifTrue:[
- |pid|
-
- pid := OperatingSystem getProcessId.
- OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true.
- MiniDebugger enter. "/ to stop, so gdb can show where we are
- AbortOperationRequest raise.
- ].
- action == #core ifTrue:[
- Smalltalk fatalAbort
- ].
- action == #exit ifTrue:[
- Smalltalk exit:10.
- ].
- action == #return ifTrue:[
- badContext return
- ].
- action == #abort ifTrue:[
- AbortOperationRequest raise.
- ].
-
- action == #debug ifTrue:[
- Debugger isNil ifTrue:[
- ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
- ].
- Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true.
- ].
- "action == #ignore"
+ "
+ SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
+ since the system will retry the faulty instruction, which leads to
+ another signal - to avoid frustration, better not offer this option.
+ "
+ fatal := OperatingSystem isFatalSignal:signalNumber.
+ fatal ifTrue:[
+ (Debugger isNil or:[here isRecursive]) ifTrue:[
+ 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
+ ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
+ ].
+ "
+ a hard signal - go into debugger immediately
+ "
+ msg := 'OS-signal: ', name.
+
+ "/ the IRQ-PC is passed as low-hi, to avoid the need
+ "/ to allocate a LargeInteger in the VM during signal
+ "/ time. I know, this is ugly.
+
+ InterruptPcLow notNil ifTrue:[
+ pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)).
+ pc ~~ 0 ifTrue:[
+ msg := msg , ' PC=' , (pc printStringRadix:16)
+ ].
+ ].
+ InterruptAddrLow notNil ifTrue:[
+ addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)).
+ addr ~~ 0 ifTrue:[
+ msg := msg , ' ADDR=' , (addr printStringRadix:16)
+ ].
+ ].
+ Debugger enter:here withMessage:msg mayProceed:false.
+ "unreachable"
+ ^ nil.
+ ].
+
+ "if possible, open an option box asking the user what do.
+ Otherwise, start a debugger"
+ Dialog notNil ifTrue:[
+ OperatingSystem isOSXlike ifTrue:[
+ titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug').
+ actions := #(save core gdb exit debug).
+ ] ifFalse:[
+ titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug').
+ actions := #(save core exit debug).
+ ].
+ action := nil.
+ title := 'OS Signal caught (' , name, ')'.
+ title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
+
+ "/ if caught while in the scheduler or event dispatcher,
+ "/ a modal dialog is not possible ...
+ "/ (therefore, abort & return does not makes sense)
+
+ Processor activeProcess isSystemProcess ifFalse:[
+ titles := #('Abort') , titles.
+ actions := #(abort), actions.
+
+ badContext canReturn ifTrue:[
+ titles := #('Return') , titles.
+ actions := #(return), actions.
+ ].
+ ].
+
+ fatal ifFalse:[
+ titles := titles, #('Ignore').
+ actions := actions , #(ignore).
+ ].
+ action := Dialog choose:title
+ labels:titles
+ values:actions
+ default:(fatal ifTrue:[nil] ifFalse:[#ignore]).
+
+ "Dialog may fail (if system process), default action is debug"
+ action isEmptyOrNil ifTrue:[action := #debug].
+ ] ifFalse:[
+ action := #debug.
+ ].
+
+ action == #save ifTrue:[
+ ObjectMemory writeCrashImage
+ ].
+ action == #gdb ifTrue:[
+ |pid|
+
+ pid := OperatingSystem getProcessId.
+ OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true.
+ MiniDebugger enter. "/ to stop, so gdb can show where we are
+ AbortOperationRequest raise.
+ ].
+ action == #core ifTrue:[
+ Smalltalk fatalAbort
+ ].
+ action == #exit ifTrue:[
+ Smalltalk exit:10.
+ ].
+ action == #return ifTrue:[
+ badContext return
+ ].
+ action == #abort ifTrue:[
+ AbortOperationRequest raise.
+ ].
+
+ action == #debug ifTrue:[
+ Debugger isNil ifTrue:[
+ ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
+ ].
+ Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true.
+ ].
+ "action == #ignore"
].
"Modified: / 15-09-2011 / 16:38:14 / cg"
@@ -5458,7 +5475,7 @@
int hash0;
if (InterruptPending == nil) {
- struct inlineCache *pIlc;
+ struct inlineCache *pIlc;
#define nways 2
#define nilcs 131
@@ -5476,7 +5493,7 @@
#define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l)
- static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
+ static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
#undef SEL_AND_ILC_INIT_1
#undef SEL_AND_ILC_INIT_2
@@ -5492,37 +5509,37 @@
#undef SEL_AND_ILC_INIT_257
#define TRY(n) \
- if (sel == sel_and_ilc[hash0].sel[n]) { \
- pIlc = &sel_and_ilc[hash0].ilc[n]; \
- goto perform0_send_and_return; \
- }
-
- if (__isNonNilObject(sel)) {
- hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
- } else {
- /* sel is either nil or smallint, use its value as hash */
- hash0 = (INT)sel % nilcs;
- }
-
- TRY(0);
- TRY(1);
+ if (sel == sel_and_ilc[hash0].sel[n]) { \
+ pIlc = &sel_and_ilc[hash0].ilc[n]; \
+ goto perform0_send_and_return; \
+ }
+
+ if (__isNonNilObject(sel)) {
+ hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
+ } else {
+ /* sel is either nil or smallint, use its value as hash */
+ hash0 = (INT)sel % nilcs;
+ }
+
+ TRY(0);
+ TRY(1);
#undef TRY
- /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
-
- pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
- sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
- sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
- pIlc->ilc_func = __SEND0ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
+ /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
+
+ pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
+ sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
+ sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
+ pIlc->ilc_func = __SEND0ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
perform0_send_and_return:
- RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
+ RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
} else {
- static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
- RETURN (_SEND0(self, aSelector, nil, &ilc0));
+ static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
+ RETURN (_SEND0(self, aSelector, nil, &ilc0));
}
%}.
^ self perform:aSelector withArguments:#()
@@ -5737,7 +5754,7 @@
int hash0;
if (InterruptPending == nil) {
- struct inlineCache *pIlc;
+ struct inlineCache *pIlc;
#undef nways
#define nways 2
#undef nilcs
@@ -5756,7 +5773,7 @@
#define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l)
- static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
+ static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
#undef SEL_AND_ILC_INIT_1
#undef SEL_AND_ILC_INIT_2
@@ -5772,38 +5789,38 @@
#undef SEL_AND_ILC_INIT_257
#define TRY(n) \
- if (sel == sel_and_ilc[hash0].sel[n]) { \
- pIlc = &sel_and_ilc[hash0].ilc[n]; \
- goto perform1_send_and_return; \
- }
-
- if (__isNonNilObject(sel)) {
- hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
- } else {
- /* sel is either nil or smallint, use its value as hash */
- hash0 = (INT)sel % nilcs;
- }
-
- TRY(0);
- TRY(1);
+ if (sel == sel_and_ilc[hash0].sel[n]) { \
+ pIlc = &sel_and_ilc[hash0].ilc[n]; \
+ goto perform1_send_and_return; \
+ }
+
+ if (__isNonNilObject(sel)) {
+ hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
+ } else {
+ /* sel is either nil or smallint, use its value as hash */
+ hash0 = (INT)sel % nilcs;
+ }
+
+ TRY(0);
+ TRY(1);
#undef TRY
- /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
-
- pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
- sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
- sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
- pIlc->ilc_func = __SEND1ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
+ /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
+
+ pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
+ sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
+ sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
+ pIlc->ilc_func = __SEND1ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
perform1_send_and_return:
- RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
+ RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
} else {
- static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
- RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
+ static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
+ RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
}
%}.
^ self perform:aSelector withArguments:(Array with:arg)
@@ -5836,7 +5853,7 @@
#define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l)
- static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
+ static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
#undef SEL_AND_ILC_INIT_1
#undef SEL_AND_ILC_INIT_2
@@ -5852,38 +5869,38 @@
#undef SEL_AND_ILC_INIT_257
#define TRY(n) \
- if (sel == sel_and_ilc[hash0].sel[n]) { \
- pIlc = &sel_and_ilc[hash0].ilc[n]; \
- goto perform2_send_and_return; \
- }
-
- if (__isNonNilObject(sel)) {
- hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
- } else {
- /* sel is either nil or smallint, use its value as hash */
- hash0 = (INT)sel % nilcs;
- }
-
- TRY(0);
- TRY(1);
+ if (sel == sel_and_ilc[hash0].sel[n]) { \
+ pIlc = &sel_and_ilc[hash0].ilc[n]; \
+ goto perform2_send_and_return; \
+ }
+
+ if (__isNonNilObject(sel)) {
+ hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
+ } else {
+ /* sel is either nil or smallint, use its value as hash */
+ hash0 = (INT)sel % nilcs;
+ }
+
+ TRY(0);
+ TRY(1);
#undef TRY
- /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
-
- pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
- sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
- sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
- pIlc->ilc_func = __SEND2ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
+ /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
+
+ pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
+ sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
+ sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
+ pIlc->ilc_func = __SEND2ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
perform2_send_and_return:
- RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) );
+ RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) );
} else {
- static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
- RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2));
+ static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
+ RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2));
}
%}.
^ self perform:aSelector withArguments:(Array with:arg1 with:arg2)
@@ -7535,12 +7552,12 @@
|myClass hasSemi sz "{ Class: SmallInteger }" |
thisContext isRecursive ifTrue:[
- RecursiveStoreError raiseRequestWith:self.
- 'Object [error]: storeString of self referencing object (' errorPrint.
- self class name errorPrint.
- ')' errorPrintCR.
- aStream nextPutAll:'#("recursive")'.
- ^ self
+ RecursiveStoreError raiseRequestWith:self.
+ 'Object [error]: storeString of self referencing object (' errorPrint.
+ self class name errorPrint.
+ ')' errorPrintCR.
+ aStream nextPutAll:'#("recursive")'.
+ ^ self
].
myClass := self class.
@@ -7549,48 +7566,48 @@
hasSemi := false.
myClass isVariable ifTrue:[
- aStream nextPutAll:' basicNew:'.
- self basicSize printOn:aStream
+ aStream nextPutAll:' basicNew:'.
+ self basicSize printOn:aStream
] ifFalse:[
- aStream nextPutAll:' basicNew'
+ aStream nextPutAll:' basicNew'
].
sz := myClass instSize.
1 to:sz do:[:i |
- |ref|
-
- ref := (self instVarAt:i).
- "/ no need to store nil entries, because the object has been instantiated
- "/ with basicNew just a moment ago (so the fields are already nil)
- ref notNil ifTrue:[
- aStream nextPutAll:' instVarAt:'.
- i printOn:aStream.
- aStream nextPutAll:' put:'.
- ref storeOn:aStream.
- aStream nextPut:$;.
- hasSemi := true
- ].
+ |ref|
+
+ ref := (self instVarAt:i).
+ "/ no need to store nil entries, because the object has been instantiated
+ "/ with basicNew just a moment ago (so the fields are already nil)
+ ref notNil ifTrue:[
+ aStream nextPutAll:' instVarAt:'.
+ i printOn:aStream.
+ aStream nextPutAll:' put:'.
+ ref storeOn:aStream.
+ aStream nextPut:$;.
+ hasSemi := true
+ ].
].
myClass isVariable ifTrue:[
- sz := self basicSize.
- 1 to:sz do:[:i |
- |ref|
-
- ref := (self basicAt:i).
- "/ no need to store nil entries, because the object has been instantiated
- "/ with basicNew just a moment ago (so the fields are already nil)
- ref notNil ifTrue:[
- aStream nextPutAll:' basicAt:'.
- i printOn:aStream.
- aStream nextPutAll:' put:'.
- ref storeOn:aStream.
- aStream nextPut:$;.
- hasSemi := true
- ]
- ]
+ sz := self basicSize.
+ 1 to:sz do:[:i |
+ |ref|
+
+ ref := (self basicAt:i).
+ "/ no need to store nil entries, because the object has been instantiated
+ "/ with basicNew just a moment ago (so the fields are already nil)
+ ref notNil ifTrue:[
+ aStream nextPutAll:' basicAt:'.
+ i printOn:aStream.
+ aStream nextPutAll:' put:'.
+ ref storeOn:aStream.
+ aStream nextPut:$;.
+ hasSemi := true
+ ]
+ ]
].
hasSemi ifTrue:[
- aStream nextPutAll:' yourself'
+ aStream nextPutAll:' yourself'
].
aStream nextPut:$).
@@ -7681,7 +7698,9 @@
This method should NOT be redefined in any subclass (except with great care, for tuning)"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ return context.RETURN( STInteger._new( self.basicSize() ) );
+#else
REGISTER INT nbytes;
REGISTER OBJ myClass;
int nInstBytes;
@@ -7710,9 +7729,9 @@
RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
case __MASKSMALLINT(DOUBLEARRAY):
-#ifdef __NEED_DOUBLE_ALIGN
+# ifdef __NEED_DOUBLE_ALIGN
nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
-#endif
+# endif
nbytes -= nInstBytes;
RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
@@ -7728,12 +7747,13 @@
case __MASKSMALLINT(LONGLONGARRAY):
case __MASKSMALLINT(SLONGLONGARRAY):
-#ifdef __NEED_LONGLONG_ALIGN
+# ifdef __NEED_LONGLONG_ALIGN
nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
-#endif
+# endif
nbytes -= nInstBytes;
RETURN ( __mkSmallInteger(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
}
+#endif
%}.
^ 0
!
@@ -7797,8 +7817,11 @@
"return the receivers class"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ return context._RETURN(self.clazz());
+#else
RETURN ( __Class(self) );
+#endif
%}
!
@@ -7871,11 +7894,11 @@
!Object methodsFor:'secure message sending'!
-?:selector
+?:selector
"try to send a message to the receiver;
if understood, return the value;
if not, return nil."
-
+
^ self perform:selector ifNotUnderstood:nil
"
@@ -8667,78 +8690,78 @@
"check for UndefinedObject/SmallInteger receiver or newClass"
%{
{
- OBJ other = otherClass;
-
- if (__isNonNilObject(self)
- && __isNonNilObject(other)
- && (other != UndefinedObject)
- && (other != SmallInteger)) {
- ok = true;
- } else {
- ok = false;
- }
+ OBJ other = otherClass;
+
+ if (__isNonNilObject(self)
+ && __isNonNilObject(other)
+ && (other != UndefinedObject)
+ && (other != SmallInteger)) {
+ ok = true;
+ } else {
+ ok = false;
+ }
}
%}.
ok ifTrue:[
- ok := false.
- myClass := self class.
- myClass == otherClass ifTrue:[
- "nothing to change"
- ^ self.
- ].
- myClass flags == otherClass flags ifTrue:[
- myClass instSize == otherClass instSize ifTrue:[
- "same instance layout and types: its ok to do it"
- ok := true.
- ] ifFalse:[
- myClass isPointers ifTrue:[
- myClass isVariable ifTrue:[
- ok := true
- ]
- ]
- ]
- ] ifFalse:[
- myClass isPointers ifTrue:[
- "if newClass is a variable class, with instSize <= my instsize,
- we can do it (effectively mapping additional instvars into the
- variable part) - usefulness is questionable, though"
-
- otherClass isPointers ifTrue:[
- otherClass isVariable ifTrue:[
- otherClass instSize <= (myClass instSize + self basicSize)
- ifTrue:[
- ok := true
- ]
- ] ifFalse:[
- otherClass instSize == (myClass instSize + self basicSize)
- ifTrue:[
- ok := true
- ]
- ]
- ] ifFalse:[
- "it does not make sense to convert pointers to bytes ..."
- ]
- ] ifFalse:[
- "does it make sense, to convert bits ?"
- "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
- (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[
- ok := true
- ]
- ]
- ]
+ ok := false.
+ myClass := self class.
+ myClass == otherClass ifTrue:[
+ "nothing to change"
+ ^ self.
+ ].
+ myClass flags == otherClass flags ifTrue:[
+ myClass instSize == otherClass instSize ifTrue:[
+ "same instance layout and types: its ok to do it"
+ ok := true.
+ ] ifFalse:[
+ myClass isPointers ifTrue:[
+ myClass isVariable ifTrue:[
+ ok := true
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ myClass isPointers ifTrue:[
+ "if newClass is a variable class, with instSize <= my instsize,
+ we can do it (effectively mapping additional instvars into the
+ variable part) - usefulness is questionable, though"
+
+ otherClass isPointers ifTrue:[
+ otherClass isVariable ifTrue:[
+ otherClass instSize <= (myClass instSize + self basicSize)
+ ifTrue:[
+ ok := true
+ ]
+ ] ifFalse:[
+ otherClass instSize == (myClass instSize + self basicSize)
+ ifTrue:[
+ ok := true
+ ]
+ ]
+ ] ifFalse:[
+ "it does not make sense to convert pointers to bytes ..."
+ ]
+ ] ifFalse:[
+ "does it make sense, to convert bits ?"
+ "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
+ (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[
+ ok := true
+ ]
+ ]
+ ]
].
ok ifTrue:[
- "now, change the receivers class ..."
+ "now, change the receivers class ..."
%{
- {
- OBJ me = self;
-
- // gcc4.4 does not like this:
- // __qClass(me) = otherClass;
- __objPtr(me)->o_class = (CLASS_OBJ)otherClass;
- __STORE(me, otherClass);
- RETURN (me);
- }
+ {
+ OBJ me = self;
+
+ // gcc4.4 does not like this:
+ // __qClass(me) = otherClass;
+ __objPtr(me)->o_class = (CLASS_OBJ)otherClass;
+ __STORE(me, otherClass);
+ RETURN (me);
+ }
%}.
].
@@ -9953,142 +9976,142 @@
|currentScreen con sender action boxLabels boxValues default s|
Smalltalk isInitialized ifFalse:[
- 'errorNotification: ' print. aString printCR.
- con := aContext ? thisContext methodHome.
- con sender printAllLevels:10.
- ^ nil
+ 'errorNotification: ' print. aString printCR.
+ con := aContext ? thisContext methodHome.
+ con sender printAllLevels:10.
+ ^ nil
].
(Dialog isNil
or:[Screen isNil
or:[(currentScreen := Screen current) isNil
or:[currentScreen isOpen not]]]) ifTrue:[
- "
- on systems without GUI, simply show
- the message on the Transcript and abort.
- "
- Transcript showCR:aString.
- AbortOperationRequest raise.
- "not reached"
- ^ nil
+ "
+ on systems without GUI, simply show
+ the message on the Transcript and abort.
+ "
+ Transcript showCR:aString.
+ AbortOperationRequest raise.
+ "not reached"
+ ^ nil
].
Processor activeProcessIsSystemProcess ifTrue:[
- action := #debug.
- sender := aContext.
- Debugger isNil ifTrue:[
- '****************** Caught Error while in SystemProcess ****************' errorPrintCR.
- aString errorPrintCR.
- Exception handle:[:ex |
- 'Caught recursive error while printing backtrace:' errorPrintCR.
- ex description errorPrintCR.
- ] do:[
- thisContext fullPrintAll.
- ].
- action := #abort.
- ].
+ action := #debug.
+ sender := aContext.
+ Debugger isNil ifTrue:[
+ '****************** Caught Error while in SystemProcess ****************' errorPrintCR.
+ aString errorPrintCR.
+ Exception handle:[:ex |
+ 'Caught recursive error while printing backtrace:' errorPrintCR.
+ ex description errorPrintCR.
+ ] do:[
+ thisContext fullPrintAll.
+ ].
+ action := #abort.
+ ].
] ifFalse:[
- Dialog autoload. "in case it's autoloaded"
-
- Error handle:[:ex |
- "/ a recursive error - quickly enter debugger
- "/ this happened, when I corrupted the Dialog class ...
- ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR.
- action := #debug.
- ex return.
- ] do:[ |s|
- sender := aContext.
- sender isNil ifTrue:[
- sender := thisContext methodHome sender.
- ].
- con := sender.
-
- "/ skip intermediate (signal & exception) contexts
- DebugView notNil ifTrue:[
- con := DebugView interestingContextFrom:sender
- ].
-
- "/ show the first few contexts
-
- s := CharacterWriteStream with:aString.
- s cr; cr.
- s nextPutLine:'Calling Chain:'.
- s nextPutLine:'--------------------------------------------------------------'.
- 1 to:25 do:[:n |
- con notNil ifTrue:[
- con printOn:s.
- s cr.
- con := con sender
- ]
- ].
-
- mayProceed ifTrue:[
- boxLabels := #('Proceed').
- boxValues := #(#proceed).
- default := #proceed.
- ] ifFalse:[
- boxLabels := #().
- boxValues := #().
- ].
-
- AbortOperationRequest isHandled ifTrue:[
- default := #abort.
- boxLabels := boxLabels , #('Abort').
- boxValues := boxValues , #(#abort).
- AbortAllOperationRequest isHandled ifTrue:[
- boxLabels := boxLabels , #('Abort All').
- boxValues := boxValues , #(#abortAll).
- ].
- true "allowDebug" ifTrue:[
- boxLabels := boxLabels , #('Copy Trace and Abort').
- boxValues := boxValues , #(#copyAndAbort).
- ].
- ] ifFalse:[
- mayProceed "and:[allowDebug]" ifTrue:[
- boxLabels := boxLabels , #('Copy Trace and Proceed').
- boxValues := boxValues , #(#copyAndProceed).
- ].
- ].
-
- (allowDebug and:[Debugger notNil]) ifTrue:[
- boxLabels := boxLabels , #('Debug').
- boxValues := boxValues , #(#debug).
- default := #debug.
- ].
-
- action := Dialog
- choose:s contents
- label:('Exception [' , Processor activeProcess nameOrId , ']')
- image:WarningBox errorIconBitmap
- labels:boxLabels
- values:boxValues
- default:default
- onCancel:nil.
- ].
+ Dialog autoload. "in case it's autoloaded"
+
+ Error handle:[:ex |
+ "/ a recursive error - quickly enter debugger
+ "/ this happened, when I corrupted the Dialog class ...
+ ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR.
+ action := #debug.
+ ex return.
+ ] do:[ |s|
+ sender := aContext.
+ sender isNil ifTrue:[
+ sender := thisContext methodHome sender.
+ ].
+ con := sender.
+
+ "/ skip intermediate (signal & exception) contexts
+ DebugView notNil ifTrue:[
+ con := DebugView interestingContextFrom:sender
+ ].
+
+ "/ show the first few contexts
+
+ s := CharacterWriteStream with:aString.
+ s cr; cr.
+ s nextPutLine:'Calling Chain:'.
+ s nextPutLine:'--------------------------------------------------------------'.
+ 1 to:25 do:[:n |
+ con notNil ifTrue:[
+ con printOn:s.
+ s cr.
+ con := con sender
+ ]
+ ].
+
+ mayProceed ifTrue:[
+ boxLabels := #('Proceed').
+ boxValues := #(#proceed).
+ default := #proceed.
+ ] ifFalse:[
+ boxLabels := #().
+ boxValues := #().
+ ].
+
+ AbortOperationRequest isHandled ifTrue:[
+ default := #abort.
+ boxLabels := boxLabels , #('Abort').
+ boxValues := boxValues , #(#abort).
+ AbortAllOperationRequest isHandled ifTrue:[
+ boxLabels := boxLabels , #('Abort All').
+ boxValues := boxValues , #(#abortAll).
+ ].
+ true "allowDebug" ifTrue:[
+ boxLabels := boxLabels , #('Copy Trace and Abort').
+ boxValues := boxValues , #(#copyAndAbort).
+ ].
+ ] ifFalse:[
+ mayProceed "and:[allowDebug]" ifTrue:[
+ boxLabels := boxLabels , #('Copy Trace and Proceed').
+ boxValues := boxValues , #(#copyAndProceed).
+ ].
+ ].
+
+ (allowDebug and:[Debugger notNil]) ifTrue:[
+ boxLabels := boxLabels , #('Debug').
+ boxValues := boxValues , #(#debug).
+ default := #debug.
+ ].
+
+ action := Dialog
+ choose:s contents
+ label:('Exception [' , Processor activeProcess nameOrId , ']')
+ image:WarningBox errorIconBitmap
+ labels:boxLabels
+ values:boxValues
+ default:default
+ onCancel:nil.
+ ].
].
action == #debug ifTrue:[
- ^ Debugger enter:sender withMessage:aString mayProceed:mayProceed
+ ^ Debugger enter:sender withMessage:aString mayProceed:mayProceed
].
action == #proceed ifTrue:[
- ^ nil.
+ ^ nil.
].
(action == #copyAndProceed
or:[action == #copyAndAbort]) ifTrue:[
- s := '' writeStream.
- Exception handle:[:ex |
- 'Caught recursive error while printing backtrace' errorPrintCR.
- ] do:[
- sender fullPrintAllOn:s.
- ].
- currentScreen rootView setClipboardText:s contents.
- action == #copyAndProceed ifTrue:[
- ^ nil
- ].
+ s := '' writeStream.
+ Exception handle:[:ex |
+ 'Caught recursive error while printing backtrace' errorPrintCR.
+ ] do:[
+ sender fullPrintAllOn:s.
+ ].
+ currentScreen rootView setClipboardText:s contents.
+ action == #copyAndProceed ifTrue:[
+ ^ nil
+ ].
].
(action == #abortAll) ifTrue:[
- AbortAllOperationRequest raise
- ].
+ AbortAllOperationRequest raise
+ ].
AbortOperationRequest raise.
"not reached"
@@ -10200,11 +10223,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.795 2015-04-07 10:21:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.796 2015-04-15 00:30:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.795 2015-04-07 10:21:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.796 2015-04-15 00:30:56 cg Exp $'
!
version_SVN
--- a/String.st Tue Apr 14 06:43:20 2015 +0200
+++ b/String.st Wed Apr 15 06:04:10 2015 +0200
@@ -553,7 +553,12 @@
This method is the same as at:."
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ if (context.stArg(0).isSmallInteger()) {
+ int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ return context.RETURN( self.basicAt( idx1Based ));
+ }
+#else
REGISTER int indx;
REGISTER OBJ slf, cls;
@@ -570,6 +575,7 @@
}
}
badIndex: ;
+#endif /* ! __JAVA__ */
%}.
^ self basicAt:index
!
@@ -582,7 +588,15 @@
This method is the same as basicAt:put:."
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ if (context.stArg(0).isSmallInteger()) {
+ int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ STObject val = context.stArg(1);
+
+ self.basicAt_put_(idx1Based, val );
+ return context.RETURN( val );
+ }
+#else
REGISTER int value, indx;
REGISTER OBJ slf;
@@ -601,6 +615,7 @@
}
}
}
+#endif /* ! __JAVA__ */
%}.
^ self basicAt:index put:aCharacter
!
@@ -610,7 +625,12 @@
- reimplemented here since we return characters"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ if (context.stArg(0).isSmallInteger()) {
+ int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ return context.RETURN( self.basicAt( idx1Based ));
+ }
+#else
REGISTER int indx;
REGISTER OBJ slf, cls;
@@ -627,6 +647,7 @@
}
}
badIndex: ;
+#endif
%}.
index isInteger ifFalse:[
^ self indexNotInteger:index
@@ -643,7 +664,15 @@
- reimplemented here since we store characters"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ if (context.stArg(0).isSmallInteger()) {
+ int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ STObject val = context.stArg(1);
+
+ self.basicAt_put_(idx1Based, val );
+ return context.RETURN( val );
+ }
+#else
REGISTER int value, indx;
REGISTER OBJ slf;
REGISTER OBJ cls;
@@ -667,6 +696,7 @@
}
}
badIndex: ;
+#endif
%}.
(aCharacter isMemberOf:Character) ifFalse:[
"
@@ -772,99 +802,99 @@
OBJ cls;
if (__isStringLike(aCollection)) {
- matchP = __stringVal(aCollection);
- cp = __stringVal(self);
- if ((cls = __qClass(self)) != String)
- cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
-
- switch (__stringSize(aCollection)) {
- case 5:
- /* five character search */
- {
- unsigned char c1 = matchP[0];
- unsigned char c2 = matchP[1];
- unsigned char c3 = matchP[2];
- unsigned char c4 = matchP[3];
- unsigned char c5 = matchP[4];
- unsigned char ch;
-
- while (ch = *cp++) {
- if ((ch == c1) || (ch == c2) || (ch == c3) || (ch == c4) || (ch == c5)) {
- RETURN ( true );
- }
- }
- RETURN (false);
- }
-
- case 4:
- /* four character search */
- {
- unsigned char c1 = matchP[0];
- unsigned char c2 = matchP[1];
- unsigned char c3 = matchP[2];
- unsigned char c4 = matchP[3];
- unsigned char ch;
-
- while (ch = *cp++) {
- if ((ch == c1) || (ch == c2) || (ch == c3) || (ch == c4)) {
- RETURN ( true );
- }
- }
- RETURN (false);
- }
-
- case 3:
- /* three character search */
- {
- unsigned char c1 = matchP[0];
- unsigned char c2 = matchP[1];
- unsigned char c3 = matchP[2];
- unsigned char ch;
-
- while (ch = *cp++) {
- if ((ch == c1) || (ch == c2) || (ch == c3)) {
- RETURN ( true );
- }
- }
- RETURN (false);
- }
-
- case 2:
- /* two character search */
- {
- unsigned char c1 = matchP[0];
- unsigned char c2 = matchP[1];
- unsigned char ch;
-
- while (ch = *cp++) {
- if ((ch == c1) || (ch == c2)) {
- RETURN ( true );
- }
- }
- RETURN (false);
- }
-
- case 1:
- /* single character search */
- if (strchr(cp, matchP[0])) {
- RETURN ( true );
- }
- RETURN ( false );
-
- case 0:
- RETURN ( false );
- }
-
- {
- unsigned char ch;
-
- while (ch = *cp++) {
- if (strchr(matchP, ch)) {
- RETURN ( true );
- }
- }
- }
- RETURN ( false );
+ matchP = __stringVal(aCollection);
+ cp = __stringVal(self);
+ if ((cls = __qClass(self)) != String)
+ cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+
+ switch (__stringSize(aCollection)) {
+ case 5:
+ /* five character search */
+ {
+ unsigned char c1 = matchP[0];
+ unsigned char c2 = matchP[1];
+ unsigned char c3 = matchP[2];
+ unsigned char c4 = matchP[3];
+ unsigned char c5 = matchP[4];
+ unsigned char ch;
+
+ while (ch = *cp++) {
+ if ((ch == c1) || (ch == c2) || (ch == c3) || (ch == c4) || (ch == c5)) {
+ RETURN ( true );
+ }
+ }
+ RETURN (false);
+ }
+
+ case 4:
+ /* four character search */
+ {
+ unsigned char c1 = matchP[0];
+ unsigned char c2 = matchP[1];
+ unsigned char c3 = matchP[2];
+ unsigned char c4 = matchP[3];
+ unsigned char ch;
+
+ while (ch = *cp++) {
+ if ((ch == c1) || (ch == c2) || (ch == c3) || (ch == c4)) {
+ RETURN ( true );
+ }
+ }
+ RETURN (false);
+ }
+
+ case 3:
+ /* three character search */
+ {
+ unsigned char c1 = matchP[0];
+ unsigned char c2 = matchP[1];
+ unsigned char c3 = matchP[2];
+ unsigned char ch;
+
+ while (ch = *cp++) {
+ if ((ch == c1) || (ch == c2) || (ch == c3)) {
+ RETURN ( true );
+ }
+ }
+ RETURN (false);
+ }
+
+ case 2:
+ /* two character search */
+ {
+ unsigned char c1 = matchP[0];
+ unsigned char c2 = matchP[1];
+ unsigned char ch;
+
+ while (ch = *cp++) {
+ if ((ch == c1) || (ch == c2)) {
+ RETURN ( true );
+ }
+ }
+ RETURN (false);
+ }
+
+ case 1:
+ /* single character search */
+ if (strchr(cp, matchP[0])) {
+ RETURN ( true );
+ }
+ RETURN ( false );
+
+ case 0:
+ RETURN ( false );
+ }
+
+ {
+ unsigned char ch;
+
+ while (ch = *cp++) {
+ if (strchr(matchP, ch)) {
+ RETURN ( true );
+ }
+ }
+ }
+ RETURN ( false );
}
%}.
^ super includesAny:aCollection
@@ -2869,7 +2899,7 @@
"Return my UTF-8 representation as a new String"
self contains8BitCharacters ifTrue:[
- ^ self basicUtf8Encoded.
+ ^ self basicUtf8Encoded.
].
"speed up common case"
^ self.
@@ -2879,7 +2909,7 @@
"write to aStream in utf8 encoding"
self contains8BitCharacters ifTrue:[
- aStream nextPutAllUtf8:self.
+ aStream nextPutAllUtf8:self.
].
"speed up common case"
aStream nextPutAll:self.
@@ -3289,7 +3319,7 @@
displayString
"return a string used when displaying the receiver in a view."
- ^ super displayString.
+ ^ super displayString.
"/ ^ self storeString.
"
@@ -3355,7 +3385,12 @@
(but only, as long as Stdout is nil, which is set later after startup)."
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ if (Smalltalk.getBindingOrNull(STSymbol._new("Stdout")) == null) {
+ System.out.print(self.toString());
+ return context._RETURN(self);
+ }
+#else
if (@global(Stdout) == nil) {
if (__qIsStringLike(self)) {
console_fprintf(stdout, "%s" , __stringVal(self));
@@ -3363,6 +3398,7 @@
RETURN (self);
}
}
+#endif
%}.
super print
!
@@ -3376,7 +3412,12 @@
(but only, as long as Stdout is nil, which is set later after startup)."
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ if (Smalltalk.getBindingOrNull(STSymbol._new("Stdout")) == null) {
+ System.out.println(self.toString());
+ return context._RETURN(self);
+ }
+#else
if (@global(Stdout) == nil) {
if (__qIsStringLike(self)) {
console_fprintf(stdout, "%s\n" , __stringVal(self));
@@ -3384,6 +3425,7 @@
RETURN (self);
}
}
+#endif
%}.
super printCR
!
@@ -3397,7 +3439,7 @@
Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
%{ /* STACK: 1000 */
-
+#ifndef __JAVA__
char buffer[800];
char *buf = buffer;
int bufsize = sizeof(buffer);
@@ -3448,6 +3490,7 @@
}
}
fail:;
+#endif
%}.
self primitiveFailed
@@ -3488,6 +3531,9 @@
Redefined here to exclude the 0-byte at the end."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ return context.RETURN( STInteger._new( self.basicSize() ) );
+#else
REGISTER OBJ slf, cls;
slf = self;
@@ -3498,6 +3544,7 @@
}
RETURN ( __mkSmallInteger(__stringSize(slf)
- __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars))));
+#endif
%}.
^ super basicSize - 1
@@ -3580,6 +3627,9 @@
Can be used to check for existance of a symbol without creating one"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ return context._RETURN( (STSymbol.asSymbolIfInterned(self.asSTString("[knownAsSymbol]").asString("")) != null) ? True : False );
+#else
OBJ cls;
int indx;
@@ -3590,6 +3640,7 @@
indx = 0;
}
RETURN ( __KNOWNASSYMBOL(__stringVal(self) + indx) );
+#endif /* ! __JAVA__ */
%}.
"/ ^ self asSymbolIfInterned notNil.
self primitiveFailed
@@ -3614,6 +3665,9 @@
This method is the same as basicSize."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ return context.RETURN( STInteger._new( self.basicSize() ) );
+#else
REGISTER OBJ cls, slf;
slf = self;
@@ -3623,6 +3677,7 @@
}
RETURN ( __mkSmallInteger(__stringSize(slf)
- __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars))));
+#endif
%}.
^ self basicSize
!
@@ -3641,7 +3696,7 @@
"Q: is there a need to redefine it here ?"
%{ /* NOCONTEXT */
-
+#ifndef __JAVA__
REGISTER char c;
REGISTER unsigned char *hip, *lowp;
@@ -3657,6 +3712,7 @@
}
RETURN ( self );
}
+ #endif
%}.
^ super reverse
! !
@@ -3669,6 +3725,7 @@
|notFound|
%{ /* STACK:4000 */
+#ifndef __JAVA__
if (__qIsStringLike(self)
&& __isStringLike(aSubString)
&& (caseSensitive == true)
@@ -3777,6 +3834,7 @@
notFound = true;
}
}
+#endif /* ! __JAVA__ */
%}.
notFound == true ifTrue:[
^ exceptionValue value.
@@ -3793,7 +3851,7 @@
If aStringOrChar is an empty string, true is returned"
%{ /* NOCONTEXT */
-
+#ifndef __JAVA__
int len1, len2;
REGISTER unsigned char *src1, *src2;
unsigned char c;
@@ -3827,6 +3885,7 @@
}
RETURN ( false );
}
+#endif /* ! __JAVA__ */
%}.
^ super endsWith:aStringOrChar
@@ -3846,7 +3905,7 @@
Q: should we care for whiteSpace in general here ?"
%{ /* NOCONTEXT */
-
+#ifndef __JAVA__
REGISTER unsigned char *src;
REGISTER unsigned char c;
OBJ cls;
@@ -3873,6 +3932,7 @@
}
}
RETURN ( true );
+#endif /* ! __JAVA__ */
%}.
^ super isBlank
!
@@ -3882,12 +3942,14 @@
Redefined here for performance"
%{ /* NOCONTEXT */
+#ifndef __JAVA__
OBJ cls;
cls = __qClass(self);
if ((cls == String) || (cls == Symbol)) {
RETURN ( (__stringSize(self) == 0) ? true : false);
}
+#endif /* ! __JAVA__ */
%}.
^ self size == 0
!
@@ -3904,7 +3966,7 @@
substitution, case-change, insertion and deletion of a character."
%{ /* STACK: 2000 */
-
+#ifndef __JAVA__
/*
* this is very heavy used when correcting errors
* (all symbols are searched for best match) - therefore it must be fast
@@ -3992,6 +4054,7 @@
RETURN ( __mkSmallInteger(m) );
}
mallocFailed: ;
+#endif /* ! __JAVA__ */
%}.
^ super levenshteinTo:aString
@@ -4015,12 +4078,14 @@
Redefined here for performance"
%{ /* NOCONTEXT */
+#ifndef __JAVA__
OBJ cls;
cls = __qClass(self);
if ((cls == String) || (cls == Symbol)) {
RETURN ( (__stringSize(self) != 0) ? true : false);
}
+#endif /* ! __JAVA__ */
%}.
^ self size ~~ 0
!
@@ -4032,89 +4097,90 @@
which are both inconsistent w.r.t. an empty argument."
%{ /* NOCONTEXT */
-
+#ifndef __JAVA__
int len1, len2;
REGISTER unsigned char *src1, *src2;
unsigned char c;
REGISTER OBJ slf = self;
if (__qIsStringLike(slf) &&__isStringLike(aStringOrChar)) {
- src1 = __stringVal(slf);
- src2 = __stringVal(aStringOrChar);
-
- if (src1[0] != src2[0]) {
- if (__qSize(aStringOrChar) == (OHDR_SIZE+1) /* 1 for the 0-byte */) {
- RETURN (true);
- }
- RETURN ( false );
- }
-
- len1 = __qSize(slf);
- len2 = __qSize(aStringOrChar);
- if (len1 < len2) {
- RETURN ( false );
- }
+ src1 = __stringVal(slf);
+ src2 = __stringVal(aStringOrChar);
+
+ if (src1[0] != src2[0]) {
+ if (__qSize(aStringOrChar) == (OHDR_SIZE+1) /* 1 for the 0-byte */) {
+ RETURN (true);
+ }
+ RETURN ( false );
+ }
+
+ len1 = __qSize(slf);
+ len2 = __qSize(aStringOrChar);
+ if (len1 < len2) {
+ RETURN ( false );
+ }
#ifdef UINT64
- while (len2 > (OHDR_SIZE+sizeof(UINT64))) {
- if ( ((UINT64 *)src1)[0] != ((UINT64 *)src2)[0] ) {
- RETURN (false);
- }
- len2 -= sizeof(UINT64);
- src1 += sizeof(UINT64);
- src2 += sizeof(UINT64);
- }
+ while (len2 > (OHDR_SIZE+sizeof(UINT64))) {
+ if ( ((UINT64 *)src1)[0] != ((UINT64 *)src2)[0] ) {
+ RETURN (false);
+ }
+ len2 -= sizeof(UINT64);
+ src1 += sizeof(UINT64);
+ src2 += sizeof(UINT64);
+ }
#else
# ifdef __UNROLL_LOOPS__
- while (len2 > (OHDR_SIZE+sizeof(INT)*4)) {
- if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
- RETURN (false);
- }
- if ( ((unsigned INT *)src1)[1] != ((unsigned INT *)src2)[1]) {
- RETURN (false);
- }
- if ( ((unsigned INT *)src1)[2] != ((unsigned INT *)src2)[2]) {
- RETURN (false);
- }
- if ( ((unsigned INT *)src1)[3] != ((unsigned INT *)src2)[3]) {
- RETURN (false);
- }
- len2 -= sizeof(INT)*4;
- src1 += sizeof(INT)*4;
- src2 += sizeof(INT)*4;
- }
+ while (len2 > (OHDR_SIZE+sizeof(INT)*4)) {
+ if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
+ RETURN (false);
+ }
+ if ( ((unsigned INT *)src1)[1] != ((unsigned INT *)src2)[1]) {
+ RETURN (false);
+ }
+ if ( ((unsigned INT *)src1)[2] != ((unsigned INT *)src2)[2]) {
+ RETURN (false);
+ }
+ if ( ((unsigned INT *)src1)[3] != ((unsigned INT *)src2)[3]) {
+ RETURN (false);
+ }
+ len2 -= sizeof(INT)*4;
+ src1 += sizeof(INT)*4;
+ src2 += sizeof(INT)*4;
+ }
# endif /* __UNROLL_LOOPS__ */
#endif /* UINT64 */
- while (len2 > (OHDR_SIZE+sizeof(INT))) {
- if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
- RETURN (false);
- }
- len2 -= sizeof(INT);
- src1 += sizeof(INT);
- src2 += sizeof(INT);
- }
-
- while (c = *src2++) {
- if (c != *src1) {
- RETURN ( false );
- }
- src1++;
- }
- RETURN (true);
+ while (len2 > (OHDR_SIZE+sizeof(INT))) {
+ if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
+ RETURN (false);
+ }
+ len2 -= sizeof(INT);
+ src1 += sizeof(INT);
+ src2 += sizeof(INT);
+ }
+
+ while (c = *src2++) {
+ if (c != *src1) {
+ RETURN ( false );
+ }
+ src1++;
+ }
+ RETURN (true);
}
if (__isCharacter(aStringOrChar)) {
- int val;
-
- val = __intVal(__characterVal(aStringOrChar));
- if ((unsigned)val <= 0xFF) {
- len1 = __stringSize(slf);
- if (len1 > 0) {
- RETURN ( (__stringVal(slf)[0] == val) ? true : false);
- }
- }
- RETURN ( false );
+ int val;
+
+ val = __intVal(__characterVal(aStringOrChar));
+ if ((unsigned)val <= 0xFF) {
+ len1 = __stringSize(slf);
+ if (len1 > 0) {
+ RETURN ( (__stringVal(slf)[0] == val) ? true : false);
+ }
+ }
+ RETURN ( false );
}
+#endif /* ! __JAVA__ */
%}.
^ super startsWith:aStringOrChar
@@ -4151,10 +4217,10 @@
!String class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.331 2015-03-25 14:18:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.332 2015-04-15 00:30:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.331 2015-03-25 14:18:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.332 2015-04-15 00:30:56 cg Exp $'
! !