--- a/Behavior.st Mon Nov 09 22:34:15 1998 +0100
+++ b/Behavior.st Tue Nov 10 00:24:58 1998 +0100
@@ -487,6 +487,9 @@
if (aSymbol == @symbol(long)) {
RETURN ( __MKSMALLINT(LONGARRAY) );
}
+ if (aSymbol == @symbol(longLong)) {
+ RETURN ( __MKSMALLINT(LONGLONGARRAY) );
+ }
if (aSymbol == @symbol(word)) {
RETURN ( __MKSMALLINT(WORDARRAY) );
}
@@ -496,6 +499,9 @@
if (aSymbol == @symbol(signedLong)) {
RETURN ( __MKSMALLINT(SLONGARRAY) );
}
+ if (aSymbol == @symbol(signedLongLong)) {
+ RETURN ( __MKSMALLINT(SLONGLONGARRAY) );
+ }
if (aSymbol == @symbol(byte)) {
RETURN ( __MKSMALLINT(BYTEARRAY) );
}
@@ -543,6 +549,22 @@
"
!
+flagLongLongs
+ "return the flag code for longlong-valued indexed instances (i.e. 8-byte).
+ The VM masks the flag value with the indexMask (maskIndexType)
+ and compares it to this flag value, when checking for
+ unsigned long valued variable instances."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( __MKSMALLINT(LONGLONGARRAY) );
+%}
+ "
+ Behavior flagLongLongs
+ "
+!
+
flagMethod
"return the flag code which marks Method-like instances.
The VM checks this single bit in the flag value when
@@ -615,6 +637,22 @@
"
!
+flagSignedLongLongs
+ "return the flag code for signed longlong-valued indexed instances (i.e. 8-byte).
+ The VM masks the flag value with the indexMask (maskIndexType)
+ and compares it to this flag value, when checking for
+ signed long valued variable instances."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( __MKSMALLINT(SLONGLONGARRAY) );
+%}
+ "
+ Behavior flagSignedLongLongs
+ "
+!
+
flagSignedWords
"return the flag code for signed word-valued indexed instances (i.e. 2-byte).
The VM masks the flag value with the indexMask (maskIndexType)
@@ -1005,24 +1043,24 @@
"/ full name and answering with Smalltalk to a nameSpace query.
(owner := self owningClass) notNil ifTrue:[
- ns := owner.
- name := self nameWithoutPrefix asSymbol
+ ns := owner.
+ name := self nameWithoutPrefix asSymbol
] ifFalse:[
- ns := Smalltalk.
- name := self name
+ ns := Smalltalk.
+ name := self name
].
Class classRedefinitionSignal answer:#keep do:[
- Class nameSpaceQuerySignal answer:ns
- do:[
- aClass
- perform:(self definitionSelector)
- withArguments:(Array with:name
- with:(self instanceVariableString)
- with:(self classVariableString)
- with:'' "/ pool
- with:(self category)).
- ]
+ Class nameSpaceQuerySignal answer:ns
+ do:[
+ aClass
+ perform:(self definitionSelector)
+ withArguments:(Array with:name
+ with:(self instanceVariableString)
+ with:(self classVariableString)
+ with:'' "/ pool
+ with:(self category)).
+ ]
]
"Modified: / 20.6.1998 / 18:17:37 / cg"
@@ -1309,7 +1347,7 @@
compiler
"return the compiler to use for this class.
OBSOLETE: This is the old ST/X interface, kept for migration.
- Dont use it - it will vanish."
+ Dont use it - it will vanish."
self obsoleteMethodWarning:'use #compilerClass'.
^ self compilerClass
@@ -1430,12 +1468,6 @@
allInstancesDo:aBlock
"evaluate aBlock for all of my instances"
-"/ ObjectMemory allObjectsDo:[:anObject |
-"/ (anObject class == self) ifTrue:[
-"/ aBlock value:anObject
-"/ ]
-"/ ]
-
ObjectMemory allInstancesOf:self do:[:anObject |
aBlock value:anObject
]
@@ -1463,21 +1495,21 @@
"evaluate aBlock for all of my subclasses.
There is no specific order, in which the entries are enumerated.
Warning:
- This will only enumerate globally known classes - for anonymous
- behaviors, you have to walk over all instances of Behavior."
+ This will only enumerate globally known classes - for anonymous
+ behaviors, you have to walk over all instances of Behavior."
self isMeta ifTrue:[
- "/ metaclasses are not found via Smalltalk allBehaviorsDo:
- "/ here, walk over classes and enumerate corresponding metas.
- self soleInstance allSubclassesDo:[:aSubClass |
- aBlock value:(aSubClass class)
- ].
+ "/ metaclasses are not found via Smalltalk allBehaviorsDo:
+ "/ here, walk over classes and enumerate corresponding metas.
+ self soleInstance allSubclassesDo:[:aSubClass |
+ aBlock value:(aSubClass class)
+ ].
] ifFalse:[
- Smalltalk allBehaviorsDo:[:aClass |
- (aClass isSubclassOf:self) ifTrue:[
- aBlock value:aClass
- ]
- ]
+ Smalltalk allBehaviorsDo:[:aClass |
+ (aClass isSubclassOf:self) ifTrue:[
+ aBlock value:aClass
+ ]
+ ]
]
"
@@ -1523,6 +1555,9 @@
!
selectorsAndMethodsDo:aTwoArgBlock
+ "evaluate the argument, aBlock for all selectors,
+ passing the corresponding method as second argument"
+
methodDictionary keysAndValuesDo:aTwoArgBlock
"Created: / 27.10.1997 / 14:09:27 / cg"
@@ -1591,10 +1626,10 @@
Statically compiled classes are initialized by the VM"
(self class implements:#initialize) ifTrue:[
- self initialize.
+ self initialize.
].
self privateClassesSorted do:[:aPrivateClass |
- aPrivateClass initializeWithAllPrivateClasses.
+ aPrivateClass initializeWithAllPrivateClasses.
].
"Created: / 13.5.1998 / 23:33:16 / cg"
@@ -1686,11 +1721,10 @@
op = __InstPtr(newobj)->i_instvars;
-# if !defined(NEGATIVE_ADDRESSES)
/*
* knowing that nil is 0
*/
-# if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
+# if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
if (nInstVars > 8) {
*op++ = nil; /* for alignment */
nInstVars--;
@@ -1707,8 +1741,8 @@
*op++ = 0;
nInstVars--;
}
-# else
-# if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
+# else
+# if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
if (nInstVars > 8) {
*op++ = nil; /* for alignment */
nInstVars--;
@@ -1726,8 +1760,8 @@
nInstVars--;
}
-# else
-# if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
+# else
+# if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
while (nInstVars >= 8) {
*op = nil;
*(op+1) = nil;
@@ -1744,35 +1778,17 @@
*op++ = nil;
nInstVars--;
}
+# else
+# if defined(FAST_MEMSET)
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
-# if defined(FAST_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
-# else
do {
*op++ = nil;
nInstVars--;
} while (nInstVars != 0);
-# endif
# endif
# endif
# endif
-# else /* nil could be ~~ 0 */
- while (nInstVars >= 8) {
- *op = nil;
- *(op+1) = nil;
- *(op+2) = nil;
- *(op+3) = nil;
- *(op+4) = nil;
- *(op+5) = nil;
- *(op+6) = nil;
- *(op+7) = nil;
- op += 8;
- nInstVars -= 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
# endif
#endif
}
@@ -1811,7 +1827,7 @@
unsigned INT instsize, nInstVars;
INT nindexedinstvars;
unsigned INT flags;
-#if ! defined(FAST_ARRAY_MEMSET) || defined(NEGATIVE_ADDRESSES)
+#if ! defined(FAST_ARRAY_MEMSET)
REGISTER char *cp;
short *sp;
long *lp;
@@ -1829,7 +1845,7 @@
case BYTEARRAY:
instsize = OHDR_SIZE + nindexedinstvars;
if (nInstVars == 0) {
- if (__CanDoQuickNew(instsize)) { /* OBJECT ALLOCATION */
+ if (__CanDoQuickNew(instsize)) { /* OBJECT ALLOCATION */
/*
* the most common case
*/
@@ -1840,7 +1856,7 @@
if (nindexedinstvars & 3) nInstVars++;
memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
#else
-# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+# if defined(FAST_ARRAY_MEMSET)
memset(__InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
# else
cp = (char *)__InstPtr(newobj)->i_instvars;
@@ -1859,7 +1875,7 @@
instsize += __OBJS2BYTES__(nInstVars);
}
__PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -1872,7 +1888,7 @@
if (instsize & 3) nInstVars++;
memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
#else
-# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+# if defined(FAST_ARRAY_MEMSET)
/*
* knowing that nil is 0
*/
@@ -1898,9 +1914,9 @@
case SWORDARRAY:
instsize = OHDR_SIZE +
__OBJS2BYTES__(nInstVars) +
- nindexedinstvars * sizeof(short);
+ nindexedinstvars * 2;
__PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -1908,7 +1924,7 @@
__InstPtr(newobj)->o_class = self;
__qSTORE(newobj, self);
-#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+#if defined(FAST_ARRAY_MEMSET)
/*
* knowing that nil is 0
*/
@@ -1928,9 +1944,9 @@
case SLONGARRAY:
instsize = OHDR_SIZE +
__OBJS2BYTES__(nInstVars) +
- nindexedinstvars * sizeof(long);
+ nindexedinstvars * 4;
__PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -1938,17 +1954,17 @@
__InstPtr(newobj)->o_class = self;
__qSTORE(newobj, self);
-#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
+#if defined(memset4)
/*
* knowing that nil is 0
*/
{
int n4 = nInstVars + nindexedinstvars;
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
}
#else
-# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+# if defined(FAST_ARRAY_MEMSET)
/*
* knowing that nil is 0
*/
@@ -1965,13 +1981,43 @@
RETURN ( newobj );
break;
+ case LONGLONGARRAY:
+ case SLONGLONGARRAY:
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+
+#ifdef __NEED_LONGLONG_ALIGN
+ instsize = ((instsize-1) + __LONGLONG_ALIGN) & ~(__LONGLONG_ALIGN-1);
+#endif
+ instsize += nindexedinstvars * 8;
+
+ __PROTECT_CONTEXT__
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+
+#if defined(memset4)
+ {
+ int n4 = (instsize-OHDR_SIZE) / 4;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
+#else
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+#endif
+ RETURN ( newobj );
+ break;
+
case FLOATARRAY:
instsize = sizeof(struct __floatArray) +
__OBJS2BYTES__(nInstVars) +
(nindexedinstvars - 1) * sizeof(float);
__PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -1980,8 +2026,16 @@
__qSTORE(newobj, self);
op = __InstPtr(newobj)->i_instvars;
-#if defined(FLOAT0_IS_INT0) /* knowin that float 0.0 is all-zeros */
+#if defined(__FLOAT0_IS_INT0) /* knowin that float 0.0 is all-zeros */
+# if defined(memset4)
+ {
+ int n4 = (instsize-OHDR_SIZE) / 4;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
+# else
memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# endif
#else
while (nInstVars--)
*op++ = nil;
@@ -1993,12 +2047,14 @@
break;
case DOUBLEARRAY:
- instsize = sizeof(struct __doubleArray) +
- __OBJS2BYTES__(nInstVars) +
- (nindexedinstvars - 1) * sizeof(double);
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+#ifdef __NEED_DOUBLE_ALIGN
+ instsize = ((instsize-1) + sizeof(__DOUBLE_ALIGN)) & ~(__DOUBLE_ALIGN-1)
+#endif
+ instsize += nindexedinstvars * sizeof(double);
__PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -2006,18 +2062,27 @@
__InstPtr(newobj)->o_class = self;
__qSTORE(newobj, self);
+#if defined(__DOUBLE0_IS_INT0) /* knowin that double 0.0 is all-zeros */
+# ifdef memset4
+ {
+ int n4 = (instsize-OHDR_SIZE) / 4;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
+# else
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# endif
+#else
op = __InstPtr(newobj)->i_instvars;
-#if defined(DOUBLE0_IS_INT0) /* knowin that double 0.0 is all-zeros */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
-#else
while (nInstVars--)
*op++ = nil;
-# ifdef NEED_DOUBLE_ALIGN
+
+# ifdef __NEED_DOUBLE_ALIGN
/*
* care for double alignment
* add filler.
*/
- if ((INT)op & (__ALIGN__-1)) {
+ if ((INT)op & (__DOUBLE_ALIGN-1)) {
*op++ = nil;
}
# endif
@@ -2033,7 +2098,7 @@
nInstVars += nindexedinstvars;
instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
__PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -2044,21 +2109,14 @@
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
-# if !defined(NEGATIVE_ADDRESSES)
/*
* knowing that nil is 0
*/
-#ifdef XXmips
-# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
-# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED
-/* seems to be slightly faster */
-# define FAST_ARRAY_MEMSET
-#endif
-#ifdef sparc
-# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
-#endif
-
-# if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
+# ifdef sparc
+# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
+# endif
+
+# if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
op = __InstPtr(newobj)->i_instvars;
if (nInstVars > 8) {
*op++ = nil; /* for alignment */
@@ -2076,8 +2134,8 @@
*op++ = 0;
nInstVars--;
}
-# else
-# if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
+# else
+# if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
op = __InstPtr(newobj)->i_instvars;
if (nInstVars > 8) {
*op++ = nil; /* for alignment */
@@ -2095,20 +2153,15 @@
*op++ = 0;
nInstVars--;
}
+# else
+# if defined(FAST_ARRAY_MEMSET)
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
-# if defined(FAST_ARRAY_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
-# else
op = __InstPtr(newobj)->i_instvars;
while (nInstVars--)
*op++ = nil;
-# endif
# endif
# endif
-# else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars--)
- *op++ = nil;
# endif
#endif
RETURN ( newobj );
@@ -2122,7 +2175,7 @@
if (nindexedinstvars == 0) {
instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
__PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
__UNPROTECT_CONTEXT__
if (newobj == nil) {
break;
@@ -2134,7 +2187,7 @@
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
-# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+# if defined(FAST_MEMSET)
/*
* knowing that nil is 0
*/
@@ -2199,7 +2252,7 @@
"
Rectangle
- decodeFromLiteralArray:#(Rectangle 10 10 100 100)
+ decodeFromLiteralArray:#(Rectangle 10 10 100 100)
"
"Modified: / 28.1.1998 / 17:40:30 / cg"
@@ -2251,8 +2304,8 @@
This is the reverse operation to 'storeOn:'.
WARNING: storeOn: does not handle circular references and multiple
- references to the same object.
- Use #storeBinary:/readBinaryFrom: for this."
+ references to the same object.
+ Use #storeBinary:/readBinaryFrom: for this."
^ self readFrom:aStream onError:[self error:'conversion error for: ' , self name]
@@ -2630,7 +2683,7 @@
coll := self allInstances.
doWeakly ifTrue:[
- coll := WeakArray withAll:coll
+ coll := WeakArray withAll:coll
].
^ coll
@@ -2867,8 +2920,8 @@
dict := self methodDictionary.
dict isNil ifTrue:[
- ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
- ^ exceptionValue value
+ ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
+ ^ exceptionValue value
].
^ dict at:aSelector ifAbsent:exceptionValue
@@ -2895,34 +2948,48 @@
"Modified: 12.6.1996 / 13:33:53 / stefan"
!
-definitionSelector
- "return the selector with which I was (can be) defined in my superclass"
+firstDefinitionSelectorPart
+ "return the first part of the selector with which I was (can be) defined in my superclass"
self isVariable ifFalse:[
- ^ #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'subclass:'
].
self isBytes ifTrue:[
- ^ #'variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableByteSubclass:'
].
self isLongs ifTrue:[
- ^ #'variableLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableLongSubclass:'
].
self isFloats ifTrue:[
- ^ #'variableFloatSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableFloatSubclass:'
].
self isDoubles ifTrue:[
- ^ #'variableDoubleSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableDoubleSubclass:'
].
self isWords ifTrue:[
- ^ #'variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableWordSubclass:'
].
self isSignedWords ifTrue:[
- ^ #'variableSignedWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableSignedWordSubclass:'
].
self isSignedLongs ifTrue:[
- ^ #'variableSignedLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableSignedLongSubclass:'
+ ].
+ self isSignedLongLongs ifTrue:[
+ ^ #'variableSignedLongLongSubclass:'
+ ].
+ self isLongLongs ifTrue:[
+ ^ #'variableLongLongSubclass:'
].
- ^ #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ^ #'variableSubclass:'
+!
+
+definitionSelector
+ "return the selector with which I was (can be) defined in my superclass"
+
+ ^ (self firstDefinitionSelectorPart
+ ,
+ 'instanceVariableNames:classVariableNames:poolDictionaries:category:') asSymbol
"
Object definitionSelector
@@ -2938,31 +3005,9 @@
"return the selector with which I was (can be) defined in my superclass
as a private class"
- self isVariable ifFalse:[
- ^ #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isBytes ifTrue:[
- ^ #'variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isLongs ifTrue:[
- ^ #'variableLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isFloats ifTrue:[
- ^ #'variableFloatSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isDoubles ifTrue:[
- ^ #'variableDoubleSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isWords ifTrue:[
- ^ #'variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isSignedWords ifTrue:[
- ^ #'variableSignedWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- self isSignedLongs ifTrue:[
- ^ #'variableSignedLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- ].
- ^ #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ ^ (self firstDefinitionSelectorPart
+ ,
+ 'instanceVariableNames:classVariableNames:poolDictionaries:privateIn:') asSymbol
"
Array definitionSelector
@@ -3125,15 +3170,15 @@
(i.e. if aSelector is implemented in THIS class - NOT in a superclass).
Hint:
- Dont use this method to check if someone responds to a message -
- use #canUnderstand: on the class or #respondsTo: on the instance
- to do this."
+ Dont use this method to check if someone responds to a message -
+ use #canUnderstand: on the class or #respondsTo: on the instance
+ to do this."
^ (self methodDictionary at:aSelector ifAbsent:nil) notNil
"
- Object includesSelector:#==
- Object includesSelector:#murks
+ Object includesSelector:#==
+ Object includesSelector:#murks
"
"Modified: / 7.6.1996 / 14:27:24 / stefan"
@@ -3329,7 +3374,7 @@
!
isLongs
- "return true, if instances have indexed long instance variables (4 byte ints)"
+ "return true, if instances have indexed long instance variables (4 byte uints)"
%{ /* NOCONTEXT */
@@ -3337,6 +3382,15 @@
%}
!
+isLongLongs
+ "return true, if instances have indexed long-long instance variables (8 byte uints)"
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(LONGLONGARRAY)) ? true : false );
+%}
+!
+
isPointers
"return true, if instances have pointer instance variables
i.e. are either non-indexed or have indexed pointer variables"
@@ -3358,6 +3412,8 @@
case LONGARRAY:
case SWORDARRAY:
case SLONGARRAY:
+ case SLONGLONGARRAY:
+ case LONGLONGARRAY:
case FLOATARRAY:
case DOUBLEARRAY:
RETURN (false );
@@ -3386,6 +3442,15 @@
%}
!
+isSignedLongLongs
+ "return true, if instances have indexed signed long-long instance variables (8 byte ints)"
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(SLONGLONGARRAY)) ? true : false );
+%}
+!
+
isSignedWords
"return true, if instances have indexed signed short instance variables"
@@ -3574,7 +3639,7 @@
case WORDARRAY:
case SWORDARRAY:
- nBytes += nIndex * sizeof(short);
+ nBytes += nIndex * 2;
if (nBytes & (__ALIGN__ - 1)) {
nBytes = (nBytes & ~(__ALIGN__ - 1)) + __ALIGN__;
}
@@ -3582,7 +3647,12 @@
case LONGARRAY:
case SLONGARRAY:
- nBytes += nIndex * sizeof(long);
+ nBytes += nIndex * 4;
+ break;
+
+ case LONGLONGARRAY:
+ case SLONGLONGARRAY:
+ nBytes += nIndex * 8;
break;
case FLOATARRAY:
@@ -3752,9 +3822,9 @@
setOfSelectors := IdentitySet new.
methodDictionary keysAndValuesDo:[:sel :mthd |
- (mthd referencesLiteral:someLiteralConstant) ifTrue:[
- setOfSelectors add:sel
- ].
+ (mthd referencesLiteral:someLiteralConstant) ifTrue:[
+ setOfSelectors add:sel
+ ].
].
^ setOfSelectors
@@ -3824,5 +3894,5 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.137 1998-10-16 13:44:22 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.138 1998-11-09 23:23:58 cg Exp $'
! !
--- a/Class.st Mon Nov 09 22:34:15 1998 +0100
+++ b/Class.st Tue Nov 10 00:24:58 1998 +0100
@@ -324,21 +324,21 @@
|cat app|
DefaultApplicationQuerySignal isHandled ifTrue:[
- app := DefaultApplicationQuerySignal raise.
- app notNil ifTrue:[
- cat := 'Applications-' , app name.
- ] ifFalse:[
- cat := 'V''Age classes'.
- ].
+ app := DefaultApplicationQuerySignal raise.
+ app notNil ifTrue:[
+ cat := 'Applications-' , app name.
+ ] ifFalse:[
+ cat := 'V''Age classes'.
+ ].
] ifFalse:[
- cat := 'ST/V classes'.
+ cat := 'ST/V classes'.
].
^ self subclass:t
- instanceVariableNames:f
- classVariableNames:d
- poolDictionaries:s
- category:cat
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
"Modified: / 15.6.1998 / 21:31:34 / cg"
!
@@ -352,21 +352,21 @@
|cat app|
DefaultApplicationQuerySignal isHandled ifTrue:[
- app := DefaultApplicationQuerySignal raise.
- app notNil ifTrue:[
- cat := 'Applications-' , app name.
- ] ifFalse:[
- cat := 'V''Age classes'.
- ]
+ app := DefaultApplicationQuerySignal raise.
+ app notNil ifTrue:[
+ cat := 'Applications-' , app name.
+ ] ifFalse:[
+ cat := 'V''Age classes'.
+ ]
] ifFalse:[
- cat := 'ST/V classes'.
+ cat := 'ST/V classes'.
].
^ self variableByteSubclass:t
- instanceVariableNames:''
- classVariableNames:d
- poolDictionaries:s
- category:cat
+ instanceVariableNames:''
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
"Modified: / 15.6.1998 / 21:31:38 / cg"
!
@@ -380,21 +380,21 @@
|cat app|
DefaultApplicationQuerySignal isHandled ifTrue:[
- app := DefaultApplicationQuerySignal raise.
- app notNil ifTrue:[
- cat := 'Applications-' , app name.
- ] ifFalse:[
- cat := 'V''Age classes'.
- ]
+ app := DefaultApplicationQuerySignal raise.
+ app notNil ifTrue:[
+ cat := 'Applications-' , app name.
+ ] ifFalse:[
+ cat := 'V''Age classes'.
+ ]
] ifFalse:[
- cat := 'ST/V classes'.
+ cat := 'ST/V classes'.
].
^ self variableSubclass:t
- instanceVariableNames:f
- classVariableNames:d
- poolDictionaries:s
- category:cat
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
"Modified: / 15.6.1998 / 21:31:41 / cg"
! !
@@ -432,15 +432,15 @@
Also writes a change record and notifies dependents."
(self classVarNames includes:aString) ifFalse:[
- self classVariableString:(self classVariableString , ' ' , aString).
- Class withoutUpdatingChangesDo:[
- self withAllSubclasses do:[:cls|
- cls recompileMethodsAccessingAnyClassvarOrGlobal:
- (Array with:aString asSymbol)
- ].
- ].
- self addChangeRecordForClass:self.
- self changed:#definition.
+ self classVariableString:(self classVariableString , ' ' , aString).
+ Class withoutUpdatingChangesDo:[
+ self withAllSubclasses do:[:cls|
+ cls recompileMethodsAccessingAnyClassvarOrGlobal:
+ (Array with:aString asSymbol)
+ ].
+ ].
+ self addChangeRecordForClass:self.
+ self changed:#definition.
]
"Created: / 29.10.1995 / 19:40:51 / cg"
@@ -688,10 +688,10 @@
idx := name lastIndexOf:$:.
idx ~~ 0 ifTrue:[
- (name at:idx-1) == $: ifTrue:[
- nsName := name copyTo:(idx - 2).
- environment := Smalltalk at:nsName asSymbol.
- ]
+ (name at:idx-1) == $: ifTrue:[
+ nsName := name copyTo:(idx - 2).
+ environment := Smalltalk at:nsName asSymbol.
+ ]
].
^ environment
@@ -810,28 +810,28 @@
myNamePrefix := myName , '::'.
Smalltalk allBehaviorsDo:[:aClass |
- |nm owner|
-
- aClass isBehavior ifTrue:[
- (owner := aClass owningClass) notNil ifTrue:[
+ |nm owner|
+
+ aClass isBehavior ifTrue:[
+ (owner := aClass owningClass) notNil ifTrue:[
"/ owner == self ifTrue:[
"/ classes add:aClass.
"/ ].
- nm := aClass name.
- (nm startsWith:myNamePrefix) ifTrue:[
- "/ care for private-privateClasses
- (nm indexOf:$: startingAt:myName size + 3) == 0 ifTrue:[
- "/ care for obsolete privateClasses
- (Smalltalk at:nm) == aClass ifFalse:[
- Transcript showCR:'skipped leftover (obsolete) private class: ' , nm.
- ] ifTrue:[
- classes add:aClass.
- ].
- ]
- ]
- ]
- ]
+ nm := aClass name.
+ (nm startsWith:myNamePrefix) ifTrue:[
+ "/ care for private-privateClasses
+ (nm indexOf:$: startingAt:myName size + 3) == 0 ifTrue:[
+ "/ care for obsolete privateClasses
+ (Smalltalk at:nm) == aClass ifFalse:[
+ Transcript showCR:'skipped leftover (obsolete) private class: ' , nm.
+ ] ifTrue:[
+ classes add:aClass.
+ ].
+ ]
+ ]
+ ]
+ ]
].
^ classes asSortedCollection:[:a :b | a name < b name].
@@ -905,17 +905,17 @@
names := self classVarNames.
(names includes:aString) ifTrue:[
- newNames := ''.
- names do:[:nm | nm ~= aString ifTrue:[newNames := newNames , nm , ' ']].
- self classVariableString:newNames withoutSpaces.
- Class withoutUpdatingChangesDo:[
- self withAllSubclasses do:[:cls|
- cls recompileMethodsAccessingAnyClassvarOrGlobal:
- (Array with:aString asSymbol)
- ].
- ].
- self addChangeRecordForClass:self.
- self changed:#definition.
+ newNames := ''.
+ names do:[:nm | nm ~= aString ifTrue:[newNames := newNames , nm , ' ']].
+ self classVariableString:newNames withoutSpaces.
+ Class withoutUpdatingChangesDo:[
+ self withAllSubclasses do:[:cls|
+ cls recompileMethodsAccessingAnyClassvarOrGlobal:
+ (Array with:aString asSymbol)
+ ].
+ ].
+ self addChangeRecordForClass:self.
+ self changed:#definition.
]
"Created: / 29.10.1995 / 19:42:08 / cg"
@@ -1305,11 +1305,11 @@
owner := self owningClass.
superclass isNil ifTrue:[
- s := nil.
- sig := 0.
+ s := nil.
+ sig := 0.
] ifFalse:[
- s := superclass name.
- sig := superclass signature.
+ s := superclass name.
+ sig := superclass signature.
].
s storeBinaryOn:stream manager:manager.
sig storeBinaryOn:stream manager:manager.
@@ -1317,49 +1317,49 @@
name storeBinaryOn:stream manager:manager.
flags storeBinaryOn:stream manager:manager.
(instvars notNil and:[instvars isEmpty]) ifTrue:[
- s := nil
+ s := nil
] ifFalse:[
- s := instvars isString ifTrue:[instvars] ifFalse:[instvars asStringCollection asString]
+ s := instvars isString ifTrue:[instvars] ifFalse:[instvars asStringCollection asString]
].
s storeBinaryOn:stream manager:manager.
(classvars notNil and:[classvars isEmpty]) ifTrue:[
- s := nil
+ s := nil
] ifFalse:[
- s := classvars isString ifTrue:[classvars] ifFalse:[classvars asStringCollection asString]
+ s := classvars isString ifTrue:[classvars] ifFalse:[classvars asStringCollection asString]
].
s storeBinaryOn:stream manager:manager.
"/ the category
owner notNil ifTrue:[
- nil storeBinaryOn:stream manager:manager.
+ nil storeBinaryOn:stream manager:manager.
] ifFalse:[
- category storeBinaryOn:stream manager:manager.
+ category storeBinaryOn:stream manager:manager.
].
"/ the classInstVarString
s := self class instanceVariableString.
(s notNil and:[s isEmpty]) ifTrue:[
- s := nil
+ s := nil
].
s storeBinaryOn:stream manager:manager.
"/ the comment
s := comment.
manager sourceMode == #discard ifTrue:[
- s := nil
+ s := nil
].
s storeBinaryOn:stream manager:manager.
"/ the revision, package & owner
owner notNil ifTrue:[
- nil storeBinaryOn:stream manager:manager.
- nil storeBinaryOn:stream manager:manager.
- owner name storeBinaryOn:stream manager:manager.
+ nil storeBinaryOn:stream manager:manager.
+ nil storeBinaryOn:stream manager:manager.
+ owner name storeBinaryOn:stream manager:manager.
] ifFalse:[
- package storeBinaryOn:stream manager:manager.
- revision storeBinaryOn:stream manager:manager.
- nil storeBinaryOn:stream manager:manager.
+ package storeBinaryOn:stream manager:manager.
+ revision storeBinaryOn:stream manager:manager.
+ nil storeBinaryOn:stream manager:manager.
].
"/
@@ -1375,9 +1375,9 @@
privateClasses := self privateClassesSorted.
privateClasses size storeBinaryOn:stream manager:manager.
privateClasses size > 0 ifTrue:[
- privateClasses do:[:aClass |
- aClass storeBinaryClassOn:stream manager:manager
- ]
+ privateClasses do:[:aClass |
+ aClass storeBinaryClassOn:stream manager:manager
+ ]
].
"
@@ -1878,40 +1878,7 @@
isVar := (self isVariable and:[superclass isVariable not])
].
- isVar ifTrue:[
- self isBytes ifTrue:[
- s := 'variableByteSubclass:'
- ] ifFalse:[
- self isWords ifTrue:[
- s := 'variableWordSubclass:'
- ] ifFalse:[
- self isLongs ifTrue:[
- s := 'variableLongSubclass:'
- ] ifFalse:[
- self isFloats ifTrue:[
- s := 'variableFloatSubclass:'
- ] ifFalse:[
- self isDoubles ifTrue:[
- s := 'variableDoubleSubclass:'
- ] ifFalse:[
- self isSignedWords ifTrue:[
- s := 'variableSignedWordSubclass:'
- ] ifFalse:[
- self isSignedLongs ifTrue:[
- s := 'variableSignedLongSubclass:'
- ] ifFalse:[
- s := 'variableSubclass:'
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ] ifFalse:[
- s := 'subclass:'
- ].
- aStream nextPutAll:s.
+ aStream nextPutAll:(self firstDefinitionSelectorPart).
"Created: 11.10.1996 / 18:57:29 / cg"
!
@@ -1958,9 +1925,9 @@
"create a file 'class.cls' (in the current projects fileOut-directory),
consisting of all methods in myself in a portable binary format.
The argument controls how sources are to be saved:
- #keep - include the source
- #reference - include a reference to the sourceFile
- #discard - dont save sources.
+ #keep - include the source
+ #reference - include a reference to the sourceFile
+ #discard - dont save sources.
With #reference, the sourceFile needs to be present after reload
in order to be browsable."
@@ -1971,9 +1938,9 @@
fileName := baseName , '.cls'.
Project notNil ifTrue:[
- dirName := Project currentProjectDirectory
+ dirName := Project currentProjectDirectory
] ifFalse:[
- dirName := '.'
+ dirName := '.'
].
fileName := dirName asFilename construct:fileName.
fileName makeLegalFilename.
@@ -1981,9 +1948,9 @@
aStream := FileStream newFileNamed:fileName.
aStream isNil ifTrue:[
- ^ FileOutErrorSignal
- raiseRequestWith:fileName
- errorString:('cannot create file:', fileName)
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileName
+ errorString:('cannot create file:', fileName)
].
aStream binary.
@@ -2011,9 +1978,9 @@
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
- dirName := Project currentProjectDirectory
+ dirName := Project currentProjectDirectory
] ifFalse:[
- dirName := Filename currentDirectory
+ dirName := Filename currentDirectory
].
fileName := (dirName asFilename construct:nm).
fileName makeLegalFilename.
@@ -2096,9 +2063,9 @@
mySourceFileName sameFile s mySourceFileID anySourceRef|
self isLoaded ifFalse:[
- ^ FileOutErrorSignal
- raiseRequestWith:self
- errorString:'will not fileOut unloaded classes'
+ ^ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:'will not fileOut unloaded classes'
].
fileName := fileNameString asFilename.
@@ -2109,101 +2076,101 @@
and, if that worked rename afterwards ...
"
(fileName exists) ifTrue:[
- sameFile := false.
-
- "/ check carefully - maybe, my source does not really come from that
- "/ file (i.e. all of my methods have their source as string)
-
- anySourceRef := false.
- self methodDictionary do:[:m|
- m sourcePosition notNil ifTrue:[
- anySourceRef := true
- ]
- ].
- self class methodDictionary do:[:m|
- m sourcePosition notNil ifTrue:[
- anySourceRef := true
- ]
- ].
-
- anySourceRef ifTrue:[
- s := self sourceStream.
- s notNil ifTrue:[
- mySourceFileID := s pathName asFilename info id.
- sameFile := (fileName info id) == mySourceFileID.
- s close.
- ] ifFalse:[
- classFilename notNil ifTrue:[
- "
- check for overwriting my current source file
- this is not allowed, since it would clobber my methods source
- file ... you have to save it to some other place.
- This happens if you ask for a fileOut into the source-directory
- (from which my methods get their source)
- "
- mySourceFileName := Smalltalk getSourceFileName:classFilename.
- sameFile := (fileNameString = mySourceFileName).
- sameFile ifFalse:[
- mySourceFileName notNil ifTrue:[
- sameFile := (fileName info id) == (mySourceFileName asFilename info id)
- ]
- ].
- ]
- ].
- ].
-
- sameFile ifTrue:[
- ^ FileOutErrorSignal
- raiseRequestWith:fileNameString
- errorString:('may not overwrite sourcefile:', fileNameString)
- ].
-
- savFilename := Filename newTemporary.
- fileName copyTo:savFilename.
- newFileName := fileName withSuffix:'new'.
- needRename := true
+ sameFile := false.
+
+ "/ check carefully - maybe, my source does not really come from that
+ "/ file (i.e. all of my methods have their source as string)
+
+ anySourceRef := false.
+ self methodDictionary do:[:m|
+ m sourcePosition notNil ifTrue:[
+ anySourceRef := true
+ ]
+ ].
+ self class methodDictionary do:[:m|
+ m sourcePosition notNil ifTrue:[
+ anySourceRef := true
+ ]
+ ].
+
+ anySourceRef ifTrue:[
+ s := self sourceStream.
+ s notNil ifTrue:[
+ mySourceFileID := s pathName asFilename info id.
+ sameFile := (fileName info id) == mySourceFileID.
+ s close.
+ ] ifFalse:[
+ classFilename notNil ifTrue:[
+ "
+ check for overwriting my current source file
+ this is not allowed, since it would clobber my methods source
+ file ... you have to save it to some other place.
+ This happens if you ask for a fileOut into the source-directory
+ (from which my methods get their source)
+ "
+ mySourceFileName := Smalltalk getSourceFileName:classFilename.
+ sameFile := (fileNameString = mySourceFileName).
+ sameFile ifFalse:[
+ mySourceFileName notNil ifTrue:[
+ sameFile := (fileName info id) == (mySourceFileName asFilename info id)
+ ]
+ ].
+ ]
+ ].
+ ].
+
+ sameFile ifTrue:[
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileNameString
+ errorString:('may not overwrite sourcefile:', fileNameString)
+ ].
+
+ savFilename := Filename newTemporary.
+ fileName copyTo:savFilename.
+ newFileName := fileName withSuffix:'new'.
+ needRename := true
] ifFalse:[
- "/ another possible trap: if my sourceFileName is
- "/ the same as the written one AND the new files directory
- "/ is along the sourcePath, we also need a temporary file
- "/ first, to avoid accessing the newly written file.
-
- anySourceRef := false.
- self methodDictionary do:[:m|
- |mSrc|
-
- (mSrc := m sourceFilename) notNil ifTrue:[
- mSrc asFilename baseName = fileName baseName ifTrue:[
- anySourceRef := true
- ]
- ]
- ].
- self class methodDictionary do:[:m|
- |mSrc|
-
- (mSrc := m sourceFilename) notNil ifTrue:[
- mSrc asFilename baseName = fileName baseName ifTrue:[
- anySourceRef := true
- ]
- ]
- ].
- anySourceRef ifTrue:[
- newFileName := fileName withSuffix:'new'.
- needRename := true
- ] ifFalse:[
- newFileName := fileName.
- needRename := false
- ]
+ "/ another possible trap: if my sourceFileName is
+ "/ the same as the written one AND the new files directory
+ "/ is along the sourcePath, we also need a temporary file
+ "/ first, to avoid accessing the newly written file.
+
+ anySourceRef := false.
+ self methodDictionary do:[:m|
+ |mSrc|
+
+ (mSrc := m sourceFilename) notNil ifTrue:[
+ mSrc asFilename baseName = fileName baseName ifTrue:[
+ anySourceRef := true
+ ]
+ ]
+ ].
+ self class methodDictionary do:[:m|
+ |mSrc|
+
+ (mSrc := m sourceFilename) notNil ifTrue:[
+ mSrc asFilename baseName = fileName baseName ifTrue:[
+ anySourceRef := true
+ ]
+ ]
+ ].
+ anySourceRef ifTrue:[
+ newFileName := fileName withSuffix:'new'.
+ needRename := true
+ ] ifFalse:[
+ newFileName := fileName.
+ needRename := false
+ ]
].
aStream := newFileName writeStream.
aStream isNil ifTrue:[
- savFilename notNil ifTrue:[
- savFilename delete
- ].
- ^ FileOutErrorSignal
- raiseRequestWith:newFileName
- errorString:('cannot create file:', newFileName name)
+ savFilename notNil ifTrue:[
+ savFilename delete
+ ].
+ ^ FileOutErrorSignal
+ raiseRequestWith:newFileName
+ errorString:('cannot create file:', newFileName name)
].
self fileOutOn:aStream.
aStream close.
@@ -2214,11 +2181,11 @@
we have to do a copy ...
"
needRename ifTrue:[
- newFileName copyTo:fileName.
- newFileName delete
+ newFileName copyTo:fileName.
+ newFileName delete
].
savFilename notNil ifTrue:[
- savFilename delete
+ savFilename delete
].
"
@@ -2246,11 +2213,11 @@
aStream cr; cr; nextPut:(Character doubleQuote); cr.
aStream space;
- nextPutLine:'The following class instance variables are inherited by this class:';
- cr.
+ nextPutLine:'The following class instance variables are inherited by this class:';
+ cr.
self allSuperclassesDo:[:aSuperClass |
- aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
- aStream nextPutLine:(aSuperClass class instanceVariableString).
+ aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
+ aStream nextPutLine:(aSuperClass class instanceVariableString).
].
aStream nextPut:(Character doubleQuote); cr.
@@ -2340,9 +2307,9 @@
meta|
self isLoaded ifFalse:[
- ^ FileOutErrorSignal
- raiseRequestWith:self
- errorString:'will not fileOut unloaded classes'
+ ^ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:'will not fileOut unloaded classes'
].
meta := self class.
@@ -2357,36 +2324,36 @@
code was edited in the browser and filedOut.
"
(copyrightMethod := meta compiledMethodAt:#copyright) notNil ifTrue:[
- "
- get the copyright methods source,
- and insert at beginning.
- "
- copyrightText := copyrightMethod source.
- copyrightText isNil ifTrue:[
- "
- no source available - trigger an error
- "
- FileOutErrorSignal
- raiseRequestWith:'no source for class ' , self name , ' available. Cannot fileOut'.
- ^ self
- ].
- "
- strip off the selector-line
- "
- copyrightText := copyrightText asCollectionOfLines asStringCollection.
- copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
+ "
+ get the copyright methods source,
+ and insert at beginning.
+ "
+ copyrightText := copyrightMethod source.
+ copyrightText isNil ifTrue:[
+ "
+ no source available - trigger an error
+ "
+ FileOutErrorSignal
+ raiseRequestWith:'no source for class ' , self name , ' available. Cannot fileOut'.
+ ^ self
+ ].
+ "
+ strip off the selector-line
+ "
+ copyrightText := copyrightText asCollectionOfLines asStringCollection.
+ copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
"/ copyrightText do:[:line | aStream nextPutAll:line. aStream cr.].
- copyrightText := copyrightText asString.
- aStream nextPutAllAsChunk:copyrightText.
+ copyrightText := copyrightText asString.
+ aStream nextPutAllAsChunk:copyrightText.
].
stampIt ifTrue:[
- "/
- "/ first, a timestamp
- "/
- aStream nextPutAll:(Smalltalk timeStamp).
- aStream nextPutChunkSeparator.
- aStream cr; cr.
+ "/
+ "/ first, a timestamp
+ "/
+ aStream nextPutAll:(Smalltalk timeStamp).
+ aStream nextPutChunkSeparator.
+ aStream cr; cr.
].
"/
@@ -2398,8 +2365,8 @@
"/ a comment - if any
"/
(comment := self comment) notNil ifTrue:[
- self fileOutCommentOn:aStream.
- aStream cr.
+ self fileOutCommentOn:aStream.
+ aStream cr.
].
"/
@@ -2415,41 +2382,41 @@
"/
collectionOfCategories := meta categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
- "/
- "/ documentation first (if any), but not the version method
- "/
- (collectionOfCategories includes:'documentation') ifTrue:[
- versionMethod := meta compiledMethodAt:#version.
- versionMethod notNil ifTrue:[
- skippedMethods := Array with:versionMethod
- ].
- meta fileOutCategory:'documentation' except:skippedMethods only:nil on:aStream.
- aStream cr.
- ].
-
- "/
- "/ initialization next (if any)
- "/
- (collectionOfCategories includes:'initialization') ifTrue:[
- meta fileOutCategory:'initialization' on:aStream.
- aStream cr.
- ].
-
- "/
- "/ instance creation next (if any)
- "/
- (collectionOfCategories includes:'instance creation') ifTrue:[
- meta fileOutCategory:'instance creation' on:aStream.
- aStream cr.
- ].
- collectionOfCategories do:[:aCategory |
- ((aCategory ~= 'documentation')
- and:[(aCategory ~= 'initialization')
- and:[aCategory ~= 'instance creation']]) ifTrue:[
- meta fileOutCategory:aCategory on:aStream.
- aStream cr
- ]
- ]
+ "/
+ "/ documentation first (if any), but not the version method
+ "/
+ (collectionOfCategories includes:'documentation') ifTrue:[
+ versionMethod := meta compiledMethodAt:#version.
+ versionMethod notNil ifTrue:[
+ skippedMethods := Array with:versionMethod
+ ].
+ meta fileOutCategory:'documentation' except:skippedMethods only:nil on:aStream.
+ aStream cr.
+ ].
+
+ "/
+ "/ initialization next (if any)
+ "/
+ (collectionOfCategories includes:'initialization') ifTrue:[
+ meta fileOutCategory:'initialization' on:aStream.
+ aStream cr.
+ ].
+
+ "/
+ "/ instance creation next (if any)
+ "/
+ (collectionOfCategories includes:'instance creation') ifTrue:[
+ meta fileOutCategory:'instance creation' on:aStream.
+ aStream cr.
+ ].
+ collectionOfCategories do:[:aCategory |
+ ((aCategory ~= 'documentation')
+ and:[(aCategory ~= 'initialization')
+ and:[aCategory ~= 'instance creation']]) ifTrue:[
+ meta fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
+ ]
].
"/
@@ -2457,17 +2424,17 @@
"/
collectionOfCategories := self categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
- collectionOfCategories do:[:aCategory |
- self fileOutCategory:aCategory on:aStream.
- aStream cr
- ]
+ collectionOfCategories do:[:aCategory |
+ self fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
].
"/
"/ any private classes' methods
"/
self privateClassesSorted do:[:aClass |
- aClass fileOutAllMethodsOn:aStream
+ aClass fileOutAllMethodsOn:aStream
].
@@ -2475,18 +2442,18 @@
"/ finally, the previously skipped version method
"/
versionMethod notNil ifTrue:[
- meta fileOutCategory:'documentation' except:nil only:skippedMethods on:aStream.
+ meta fileOutCategory:'documentation' except:nil only:skippedMethods on:aStream.
].
initIt ifTrue:[
- "/
- "/ optionally an initialize message
- "/
- (meta implements:#initialize) ifTrue:[
- self printClassNameOn:aStream. aStream nextPutAll:' initialize'.
- aStream nextPutChunkSeparator.
- aStream cr
- ]
+ "/
+ "/ optionally an initialize message
+ "/
+ (meta implements:#initialize) ifTrue:[
+ self printClassNameOn:aStream. aStream nextPutAll:' initialize'.
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ]
]
"Created: / 15.11.1995 / 12:53:06 / cg"
@@ -2917,19 +2884,19 @@
|sel newClass|
self owningClass notNil ifTrue:[
- ^ self
+ ^ self
].
sel := self definitionSelectorPrivate.
newClass := self superclass
- perform:sel
- withArguments:(Array
- with:(self nameWithoutPrefix asSymbol)
- with:(self instanceVariableString)
- with:(self classVariableString)
- with:''
- with:newOwner).
+ perform:sel
+ withArguments:(Array
+ with:(self nameWithoutPrefix asSymbol)
+ with:(self instanceVariableString)
+ with:(self classVariableString)
+ with:''
+ with:newOwner).
"/ copy over methods ...
self class copyInvalidatedMethodsFrom:self class for:newClass class.
@@ -3165,19 +3132,19 @@
"/
fileName := Smalltalk getSourceFileName:sourceFile.
fileName notNil ifTrue:[
- ^ fileName asFilename readStream.
+ ^ fileName asFilename readStream.
].
(package := self package) notNil ifTrue:[
- (package includes:$:) ifTrue:[
- package := package asString copyReplaceAll:$: with:$/
- ] ifFalse:[
- package := 'stx/' , package
- ].
- fileName := Smalltalk getSourceFileName:(package , '/' , sourceFile).
- fileName notNil ifTrue:[
- ^ fileName asFilename readStream.
- ].
+ (package includes:$:) ifTrue:[
+ package := package asString copyReplaceAll:$: with:$/
+ ] ifFalse:[
+ package := 'stx/' , package
+ ].
+ fileName := Smalltalk getSourceFileName:(package , '/' , sourceFile).
+ fileName notNil ifTrue:[
+ ^ fileName asFilename readStream.
+ ].
].
"/
@@ -3186,45 +3153,45 @@
"/ obsolete.
info := self packageSourceCodeInfo.
info notNil ifTrue:[
- module := info at:#module ifAbsent:nil.
- module notNil ifTrue:[
- dir := info at:#directory ifAbsent:nil.
- dir notNil ifTrue:[
- fn := (module asFilename construct:dir) construct:sourceFile.
- fileName := Smalltalk getSourceFileName:(fn name).
- fileName notNil ifTrue:[
- ^ fileName asFilename readStream.
- ].
-
- "/ brand new: look for source/<module>/package.zip
- "/ containing an entry for <filename>
-
- fn := (module asFilename construct:dir) withSuffix:'zip'.
- fileName := Smalltalk getSourceFileName:(fn name).
- fileName notNil ifTrue:[
- zar := ZipArchive oldFileNamed:fileName.
- zar notNil ifTrue:[
- entry := zar extract:sourceFile.
- entry notNil ifTrue:[
- ^ entry asString readStream
- ]
- ]
- ].
-
- "/ and also in source/source.zip ...
-
- fileName := Smalltalk getSourceFileName:'source.zip'.
- fileName notNil ifTrue:[
- zar := ZipArchive oldFileNamed:fileName.
- zar notNil ifTrue:[
- entry := zar extract:sourceFile.
- entry notNil ifTrue:[
- ^ entry asString readStream
- ]
- ]
- ].
- ]
- ]
+ module := info at:#module ifAbsent:nil.
+ module notNil ifTrue:[
+ dir := info at:#directory ifAbsent:nil.
+ dir notNil ifTrue:[
+ fn := (module asFilename construct:dir) construct:sourceFile.
+ fileName := Smalltalk getSourceFileName:(fn name).
+ fileName notNil ifTrue:[
+ ^ fileName asFilename readStream.
+ ].
+
+ "/ brand new: look for source/<module>/package.zip
+ "/ containing an entry for <filename>
+
+ fn := (module asFilename construct:dir) withSuffix:'zip'.
+ fileName := Smalltalk getSourceFileName:(fn name).
+ fileName notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:fileName.
+ zar notNil ifTrue:[
+ entry := zar extract:sourceFile.
+ entry notNil ifTrue:[
+ ^ entry asString readStream
+ ]
+ ]
+ ].
+
+ "/ and also in source/source.zip ...
+
+ fileName := Smalltalk getSourceFileName:'source.zip'.
+ fileName notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:fileName.
+ zar notNil ifTrue:[
+ entry := zar extract:sourceFile.
+ entry notNil ifTrue:[
+ ^ entry asString readStream
+ ]
+ ]
+ ].
+ ]
+ ]
].
^ nil
@@ -3640,84 +3607,84 @@
"/
((mgr := self sourceCodeManager) isNil
or:[TryLocalSourceFirst == true]) ifTrue:[
- aStream := self localSourceStreamFor:source.
+ aStream := self localSourceStreamFor:source.
].
aStream isNil ifTrue:[
- "/
- "/ hard case - there is no source file for this class
- "/ (in the source-dir-path).
- "/
-
- "/
- "/ look if my binary is from a dynamically loaded module,
- "/ and, if so, look in the modules directory for the
- "/ source file.
- "/
- ObjectFileLoader notNil ifTrue:[
- ObjectFileLoader loadedObjectHandlesDo:[:h |
- |f classes|
-
- aStream isNil ifTrue:[
- (classes := h classes) notNil ifTrue:[
- (classes includes:self) ifTrue:[
- f := h pathName.
- f := f asFilename directory.
- f := f construct:source.
- f exists ifTrue:[
- aStream := f readStream.
- ].
- ].
- ].
- ]
- ].
- ].
+ "/
+ "/ hard case - there is no source file for this class
+ "/ (in the source-dir-path).
+ "/
+
+ "/
+ "/ look if my binary is from a dynamically loaded module,
+ "/ and, if so, look in the modules directory for the
+ "/ source file.
+ "/
+ ObjectFileLoader notNil ifTrue:[
+ ObjectFileLoader loadedObjectHandlesDo:[:h |
+ |f classes|
+
+ aStream isNil ifTrue:[
+ (classes := h classes) notNil ifTrue:[
+ (classes includes:self) ifTrue:[
+ f := h pathName.
+ f := f asFilename directory.
+ f := f construct:source.
+ f exists ifTrue:[
+ aStream := f readStream.
+ ].
+ ].
+ ].
+ ]
+ ].
+ ].
].
aStream isNil ifTrue:[
- "/ mhmh - still no source file.
- "/ If there is a SourceCodeManager, ask it to aquire the
- "/ the source for my class, and return an open stream on it.
- "/ if that one does not know about the source, look in
- "/ standard places
-
- mgr notNil ifTrue:[
- aStream := mgr getSourceStreamFor:self.
- aStream notNil ifTrue:[
- (self validateSourceStream:aStream) ifFalse:[
- ('Class [info]: repositories source for `'
- , (self isMeta ifTrue:[self soleInstance name]
- ifFalse:[name])
- , ''' is invalid.') infoPrintCR.
- aStream close.
- aStream := nil
- ] ifTrue:[
- validated := true.
- ].
- ].
-
- aStream isNil ifTrue:[
- aStream := self localSourceStreamFor:source.
- ].
- ].
-
- "/
- "/ final chance: try current directory
- "/
- aStream isNil ifTrue:[
- aStream := source asFilename readStream.
- ].
+ "/ mhmh - still no source file.
+ "/ If there is a SourceCodeManager, ask it to aquire the
+ "/ the source for my class, and return an open stream on it.
+ "/ if that one does not know about the source, look in
+ "/ standard places
+
+ mgr notNil ifTrue:[
+ aStream := mgr getSourceStreamFor:self.
+ aStream notNil ifTrue:[
+ (self validateSourceStream:aStream) ifFalse:[
+ ('Class [info]: repositories source for `'
+ , (self isMeta ifTrue:[self soleInstance name]
+ ifFalse:[name])
+ , ''' is invalid.') infoPrintCR.
+ aStream close.
+ aStream := nil
+ ] ifTrue:[
+ validated := true.
+ ].
+ ].
+
+ aStream isNil ifTrue:[
+ aStream := self localSourceStreamFor:source.
+ ].
+ ].
+
+ "/
+ "/ final chance: try current directory
+ "/
+ aStream isNil ifTrue:[
+ aStream := source asFilename readStream.
+ ].
].
(aStream notNil and:[validated not]) ifTrue:[
- (self validateSourceStream:aStream) ifFalse:[
- (Smalltalk releaseIdentification = 'ST/X_free_demo_vsn') ifTrue:[
+ (self validateSourceStream:aStream) ifFalse:[
+ (Smalltalk releaseIdentification = 'ST/X_free_demo_vsn') ifTrue:[
"/ ('Class [info]: source for ''' , self name , ''' is not available in the demo version.') infoPrintCR
- ] ifFalse:[
- ('Class [warning]: source for ''' , self name , ''' is invalid or stripped. Take care.') errorPrintCR
- ]
- ].
+ ] ifFalse:[
+ ('Class [warning]: source for ''' , self name , ''' is invalid or stripped. Take care.') errorPrintCR
+ ]
+ ].
].
^ aStream
@@ -3786,9 +3753,9 @@
versionFromCode versionFromSource oldPos pos src rev|
self isMeta ifTrue:[
- meta := self. cls := self soleInstance
+ meta := self. cls := self soleInstance
] ifFalse:[
- cls := self. meta := self class
+ cls := self. meta := self class
].
cannotCheckReason := nil.
@@ -3796,20 +3763,20 @@
versionMethod := meta compiledMethodAt:#version.
(versionMethod isNil
or:[versionMethod isExecutable not]) ifTrue:[
- versionMethod := cls compiledMethodAt:#version.
- (versionMethod isNil
- or:[versionMethod isExecutable not]) ifTrue:[
- cannotCheckReason := 'no valid version method'.
- ]
+ versionMethod := cls compiledMethodAt:#version.
+ (versionMethod isNil
+ or:[versionMethod isExecutable not]) ifTrue:[
+ cannotCheckReason := 'no valid version method'.
+ ]
] ifFalse:[
- "/
- "/ if its a method returning the string,
- "/ thats the returned value
- "/
- versionFromCode := cls version.
- versionFromCode isString ifFalse:[
- cannotCheckReason := 'version method does not return a string'
- ].
+ "/
+ "/ if its a method returning the string,
+ "/ thats the returned value
+ "/
+ versionFromCode := cls version.
+ versionFromCode isString ifFalse:[
+ cannotCheckReason := 'version method does not return a string'
+ ].
].
"/
@@ -3820,36 +3787,36 @@
"/ for the source ...
"/
versionMethod notNil ifTrue:[
- pos := versionMethod sourcePosition.
- pos isInteger ifFalse:[
- "/ mhmh - either no version method,
- "/ or updated due to a checkin.
- "/ in any case, this should be a good source.
-
- ^ true.
- "/ cannotCheckReason := 'no source position for version-method'
- ]
+ pos := versionMethod sourcePosition.
+ pos isInteger ifFalse:[
+ "/ mhmh - either no version method,
+ "/ or updated due to a checkin.
+ "/ in any case, this should be a good source.
+
+ ^ true.
+ "/ cannotCheckReason := 'no source position for version-method'
+ ]
].
cannotCheckReason notNil ifTrue:[
- ('Class [warning]: ' , cannotCheckReason) errorPrintCR.
- 'Class [info]: cannot validate source; trusting source' infoPrintCR.
- ^ true
+ ('Class [warning]: ' , cannotCheckReason) errorPrintCR.
+ 'Class [info]: cannot validate source; trusting source' infoPrintCR.
+ ^ true
].
oldPos := aStream position.
Stream positionErrorSignal handle:[:ex |
"/ 'position error' printCR.
- ^ false
+ ^ false
] do:[
- aStream position:pos.
+ aStream position:pos.
].
src := aStream nextChunk.
aStream position:oldPos.
(src isNil or:[src isEmpty]) ifTrue:[
"/ 'empty source for version-method' printCR.
- ^ false
+ ^ false
].
versionFromSource := Class revisionStringFromSource:src.
@@ -3861,8 +3828,8 @@
info := Class revisionInfoFromString:versionFromSource.
info notNil ifTrue:[
- rev := info at:#revision.
- rev = self binaryRevision ifTrue:[^ true].
+ rev := info at:#revision.
+ rev = self binaryRevision ifTrue:[^ true].
].
^ false
@@ -3885,5 +3852,5 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.323 1998-08-27 11:29:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.324 1998-11-09 23:24:58 cg Exp $'
! !