--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,23 @@
+syntax: glob
+*.chg
+*~
+*.orig
+*.o
+*.so
+*.sc
+*Init.c
+*.H
+*.STH
+*/makefile
+*/docs/output/*
+*/docs/*.xml.profiled
+
+*/objbc
+*/objvc
+*.res
+*-Test.xml
+*.base
+*.orig
+*.local
+*.other
+makefile
--- a/AbortOperationRequest.st Sun Feb 02 00:13:55 2014 +0100
+++ b/AbortOperationRequest.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
AbortAllOperationRequest subclass:#AbortOperationRequest
@@ -64,7 +63,14 @@
!AbortOperationRequest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AbortOperationRequest.st,v 1.5 2005-01-11 17:04:57 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbortOperationRequest.st,v 1.5 2005/01/11 17:04:57 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: AbortOperationRequest.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
AbortOperationRequest initialize!
+
+
+
--- a/ActivityNotification.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ActivityNotification.st Sun Feb 02 14:16:24 2014 +0000
@@ -74,7 +74,14 @@
!ActivityNotification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ActivityNotification.st,v 1.4 2008-10-04 08:42:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ActivityNotification.st,v 1.4 2008/10/04 08:42:14 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ActivityNotification.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
ActivityNotification initialize!
+
+
+
--- a/AllocationFailure.st Sun Feb 02 00:13:55 2014 +0100
+++ b/AllocationFailure.st Sun Feb 02 14:16:24 2014 +0000
@@ -40,9 +40,14 @@
"
! !
+
!AllocationFailure class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/AllocationFailure.st,v 1.6 2013-03-13 23:47:13 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: AllocationFailure.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/ApplicationDefinition.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ApplicationDefinition.st Sun Feb 02 14:16:24 2014 +0000
@@ -163,7 +163,8 @@
#(
(applicationIconFileName applicationIconFileName_code 'description - project information')
- (subProjects subProjects_code 'description')
+ "/ Not needed, done in ProjectDefinition>>forEachMethodsCodeToCompileDo:ignoreOldDefinition:
+ "/ (subProjects subProjects_code 'description')
(productInstallDirBaseName productInstallDirBaseName_code 'description - project information')
(startupClassName startupClassName_code 'description - startup')
(startupSelector startupSelector_code 'description - startup')
@@ -177,6 +178,7 @@
"Created: / 10-08-2006 / 16:35:47 / cg"
"Modified: / 30-08-2006 / 19:03:48 / cg"
+ "Modified: / 25-11-2013 / 13:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
startupClassName_code
@@ -1983,7 +1985,7 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
%(DEPENDENCIES)
# ENDMAKEDEPEND --- do not remove this line
-'.
+%(ADDITIONAL_RULES_HG)'.
"Modified: / 22-11-2012 / 17:18:28 / cg"
!
@@ -2441,6 +2443,8 @@
%(ADDITIONAL_RULES_SVN)
+%(ADDITIONAL_RULES_HG)
+
%(ADDITIONAL_HEADERRULES)
clean::
@@ -2458,6 +2462,7 @@
"Created: / 29-09-2006 / 23:47:07 / cg"
"Modified: / 24-06-2009 / 21:40:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 26-07-2012 / 00:57:07 / cg"
+ "Modified: / 28-11-2012 / 10:18:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
make_dot_proto_app_source_rules
@@ -3116,6 +3121,11 @@
^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.253 2013-12-17 20:57:10 stefan Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: ApplicationDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
--- a/ArgumentError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ArgumentError.st Sun Feb 02 14:16:24 2014 +0000
@@ -50,6 +50,10 @@
version
^ '$Header: /cvs/stx/stx/libbasic/ArgumentError.st,v 1.4 2013-12-16 13:36:35 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ArgumentError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/ArithmeticError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ArithmeticError.st Sun Feb 02 14:16:24 2014 +0000
@@ -40,9 +40,14 @@
"
! !
+
!ArithmeticError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ArithmeticError.st,v 1.8 2013-03-13 23:44:07 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ArithmeticError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/AspectVisitor.st Sun Feb 02 00:13:55 2014 +0100
+++ b/AspectVisitor.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Visitor subclass:#AspectVisitor
@@ -131,5 +130,12 @@
!AspectVisitor class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AspectVisitor.st,v 1.1 2004-06-11 17:55:26 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AspectVisitor.st,v 1.1 2004/06/11 17:55:26 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: AspectVisitor.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/AssertionFailedError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/AssertionFailedError.st Sun Feb 02 14:16:24 2014 +0000
@@ -43,5 +43,12 @@
!AssertionFailedError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AssertionFailedError.st,v 1.3 2008-09-30 18:09:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AssertionFailedError.st,v 1.3 2008/09/30 18:09:46 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: AssertionFailedError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/BadLiteralsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/BadLiteralsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
InvalidCodeError subclass:#BadLiteralsError
@@ -50,7 +49,14 @@
!BadLiteralsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BadLiteralsError.st,v 1.4 2003-09-05 10:27:45 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BadLiteralsError.st,v 1.4 2003/09/05 10:27:45 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: BadLiteralsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
BadLiteralsError initialize!
+
+
+
--- a/BadRomanNumberFormatError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/BadRomanNumberFormatError.st Sun Feb 02 14:16:24 2014 +0000
@@ -43,5 +43,8 @@
!BadRomanNumberFormatError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BadRomanNumberFormatError.st,v 1.3 2008-08-06 09:52:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BadRomanNumberFormatError.st,v 1.3 2008/08/06 09:52:59 cg Exp $'
! !
+
+
+
--- a/Behavior.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Behavior.st Sun Feb 02 14:16:24 2014 +0000
@@ -339,6 +339,16 @@
!Behavior class methodsFor:'flag bit constants'!
+flagAlien
+ "Return the flag code for Alien objects for Translucent Object implementation"
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( __mkSmallInteger(ALIENPOINTERS) );
+%}
+!
+
flagBehavior
"return the flag code which marks Behavior-like instances.
Inline C-code and the VM check this single bit in the flag value when
@@ -560,6 +570,18 @@
"Modified: / 07-06-2007 / 11:57:44 / cg"
!
+flagJavaArray
+ "return the flag code which marks Java array-like instances.
+ The VM checks this single bit in the flag value when
+ checking for a java arrays."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( __mkSmallInteger(JARRAY_INSTS) );
+%}
+!
+
flagJavaClass
"return the flag code which marks JavaClass-like instances.
The VM checks this single bit in the flag value when
@@ -1074,7 +1096,6 @@
"Created: / 01-06-2012 / 20:37:46 / cg"
! !
-
!Behavior methodsFor:'Compatibility-Dolphin'!
allSubinstances
@@ -1229,8 +1250,6 @@
^ self nameWithoutPrefix
! !
-
-
!Behavior methodsFor:'accessing'!
addSelector:newSelector withMethod:newMethod
@@ -1398,9 +1417,9 @@
lookupObject == anObject ifTrue:[^ self ].
anObject isNil ifTrue:[^self setLookupObject: anObject].
- (anObject respondsTo: #lookupMethodForSelector:directedTo:for:withArguments:from:)
+ (anObject respondsTo: #lookupMethodForSelector:directedTo:for:withArguments:from:ilc:)
ifFalse:[
- self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:'
+ self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:ilc'
].
(anObject respondsTo:#superLookupObject:)
ifTrue:[
@@ -1409,7 +1428,7 @@
self setLookupObject: anObject.
"Created: / 26-04-2010 / 13:35:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 26-04-2010 / 21:05:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-10-2011 / 13:00:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodDictionary
@@ -1498,7 +1517,6 @@
"Created: 16.4.1996 / 16:27:16 / cg"
! !
-
!Behavior methodsFor:'cleanup'!
lowSpaceCleanup
@@ -1611,10 +1629,10 @@
Returns the new method or nil (on failure)."
^ self compilerClass
- compile:code
- forClass:self
- inCategory:methodCategory
- notifying:nil
+ compile:code
+ forClass:self
+ inCategory:methodCategory
+ notifying:nil
!
compile:code categorized:methodCategory notifying:requestor
@@ -1623,10 +1641,10 @@
Returns the new method or nil (on failure)."
^ self compilerClass
- compile:code
- forClass:self
- inCategory:methodCategory
- notifying:requestor
+ compile:code
+ forClass:self
+ inCategory:methodCategory
+ notifying:requestor
!
compile:code notifying:requestor
@@ -1869,11 +1887,11 @@
"evaluate aBlock for all of my subclasses.
The subclasses are enumerated breath first (i.e. all of a classes superclasses
come before a class, which comes before any of its subclasses).
- However, within one inheritance level, there is no specific order,
+ However, within one inheritance level, 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."
|meta toDo cls|
@@ -1882,13 +1900,13 @@
toDo := OrderedCollection new.
toDo addAll:self theNonMetaclass subclasses.
[toDo notEmpty] whileTrue:[
- cls := toDo removeFirst.
- toDo addAll:cls subclasses.
- meta ifTrue:[
- aBlock value:cls class.
- ] ifFalse:[
- aBlock value:cls.
- ]
+ cls := toDo removeFirst.
+ toDo addAll:cls subclasses.
+ meta ifTrue:[
+ aBlock value:cls class.
+ ] ifFalse:[
+ aBlock value:cls.
+ ]
].
"/ self isMeta ifTrue:[
@@ -2106,7 +2124,6 @@
^ self
! !
-
!Behavior methodsFor:'instance creation'!
basicNew
@@ -4023,6 +4040,14 @@
!
+isAlienBehavior
+ "Returns true iff I'm an alien behavior."
+%{
+ RETURN( ( (INT)(__INST(flags)) & __MASKSMALLINT(ALIENPOINTERS)) ? true : false )
+%}.
+
+!
+
isBits
"return true, if instances have indexed byte or short instance variables.
Ignore long, float and double arrays, since ST-80 code using isBits are probably
@@ -4584,27 +4609,28 @@
"JV @ 2010-08-22: Rewritten to respect lookup object."
(l := self lookupObject) notNil ifTrue:[
- ^ (l
- lookupMethodForSelector:aSelector
- directedTo:self
- for: nil "Fake receiver"
- withArguments: nil "Fake arguments"
- from: thisContext methodHome sender)
+ ^ (l
+ lookupMethodForSelector:aSelector
+ directedTo:self
+ for: nil "Fake receiver"
+ withArguments: nil "Fake arguments"
+ from: thisContext methodHome sender
+ ilc: nil "fake ilc")
].
cls := self.
[
- m := cls compiledMethodAt:aSelector.
- m notNil ifTrue:[^ m].
- cls hasMultipleSuperclasses ifTrue:[
- cls superclasses do:[:aSuperClass |
- m := aSuperClass lookupMethodFor:aSelector.
- m notNil ifTrue:[^ m].
- ].
- ^ nil
- ] ifFalse:[
- cls := cls superclass
- ]
+ m := cls compiledMethodAt:aSelector.
+ m notNil ifTrue:[^ m].
+ cls hasMultipleSuperclasses ifTrue:[
+ cls superclasses do:[:aSuperClass |
+ m := aSuperClass lookupMethodFor:aSelector.
+ m notNil ifTrue:[^ m].
+ ].
+ ^ nil
+ ] ifFalse:[
+ cls := cls superclass
+ ]
] doWhile:[cls notNil].
^ nil
!
@@ -4791,12 +4817,12 @@
superclass := self superclass.
superclass isNil ifTrue:[
- superInsts := 0
+ superInsts := 0
] ifFalse:[
- superInsts := superclass instSize
+ superInsts := superclass instSize
].
^ (superInsts+1 to:self instSize)
- collect:[:index | self instVarNameForIndex:index]
+ collect:[:index | self instVarNameForIndex:index]
"Modified: / 17-07-2006 / 00:28:40 / cg"
!
@@ -4997,4 +5023,3 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.351 2013-12-09 11:19:24 cg Exp $'
! !
-
--- a/BreakPointInterrupt.st Sun Feb 02 00:13:55 2014 +0100
+++ b/BreakPointInterrupt.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
HaltInterrupt subclass:#BreakPointInterrupt
@@ -45,5 +44,12 @@
!BreakPointInterrupt class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BreakPointInterrupt.st,v 1.3 2003-08-29 19:18:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BreakPointInterrupt.st,v 1.3 2003/08/29 19:18:16 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: BreakPointInterrupt.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/CachingRegistry.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CachingRegistry.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,7 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
+"{ Package: 'stx:libbasic' }"
Registry subclass:#CachingRegistry
instanceVariableNames:'keptReferences cacheSize'
@@ -92,5 +92,12 @@
!CachingRegistry class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CachingRegistry.st,v 1.1 1999-07-22 23:17:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CachingRegistry.st,v 1.1 1999/07/22 23:17:43 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CachingRegistry.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/CannotResumeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CannotResumeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -51,5 +51,9 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/CannotResumeError.st,v 1.6 2013-12-24 10:39:51 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CannotResumeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/CannotReturnError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CannotReturnError.st Sun Feb 02 14:16:24 2014 +0000
@@ -51,5 +51,9 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/CannotReturnError.st,v 1.6 2013-12-24 10:39:59 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CannotReturnError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/CharacterArray.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterArray.st Sun Feb 02 14:16:24 2014 +0000
@@ -11,7 +11,7 @@
"
"{ Package: 'stx:libbasic' }"
-UninterpretedBytes variableByteSubclass:#CharacterArray
+UninterpretedBytes subclass:#CharacterArray
instanceVariableNames:''
classVariableNames:'PreviousMatch DecoderTables EncoderTables DecodingFailedSignal
EncodingFailedSignal'
@@ -1617,7 +1617,6 @@
! !
-
!CharacterArray methodsFor:'character searching'!
includesMatchCharacters
@@ -3926,8 +3925,8 @@
^ CharacterEncoder encodeString:self from:oldEncoding into:newEncoding
"
- '' encodeFrom:#iso8859 into:#utf8
- ('' encodeFrom:#iso8859 into:#utf8) encodeFrom:#utf8 into:#unicode
+ '' encodeFrom:#iso8859 into:#utf8
+ ('' encodeFrom:#iso8859 into:#utf8) encodeFrom:#utf8 into:#unicode
"
!
@@ -3983,7 +3982,7 @@
"
'abcde1234' utf16Encoded
- 'abcde' utf16Encoded
+ 'abcde' utf16Encoded
"
"Modified: / 11-05-2010 / 19:12:37 / cg"
@@ -4070,7 +4069,7 @@
"
'abcde1234' utf8Encoded
- 'abcde' utf8Encoded
+ 'abcde' utf8Encoded
"
"Modified: / 11-05-2010 / 19:12:37 / cg"
@@ -4078,7 +4077,6 @@
-
!CharacterArray methodsFor:'matching - glob expressions'!
compoundMatch:aString
@@ -4762,7 +4760,6 @@
! !
-
!CharacterArray methodsFor:'padded copying'!
centerPaddedTo:newSize
@@ -5094,7 +5091,6 @@
].
! !
-
!CharacterArray methodsFor:'queries'!
bitsPerCharacter
@@ -6927,6 +6923,11 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.521 2014-01-27 22:59:16 cg Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/CharacterEncoder.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoder.st Sun Feb 02 14:16:24 2014 +0000
@@ -563,7 +563,7 @@
"/ className decoded-name array-of-encodingNames
#(
- (ASCII unicode ( ascii 'us-ascii' 'iso-ir-6' 'ibm-367' 'ms-cp367' 'cp367' 'iso646-us' 'ibm-cp367' ))
+ (ASCII unicode ( ascii 'us-ascii' 'iso-ir-6' 'ibm-367' 'ms-cp367' 'cp367' 'iso646-us' 'ibm-cp367' 'ansi_x3.4-1968' ))
(BIG5 unicode ( big5 ))
@@ -706,11 +706,17 @@
].
].
+ OperatingSystem isUNIXlike ifTrue:[
+ "/Initialize OS system encoder
+ OperatingSystem getCodesetEncoder.
+ ].
+
"
self initialize
"
"Modified: / 01-04-2011 / 14:30:06 / cg"
+ "Modified (format): / 23-01-2013 / 09:56:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterEncoder class methodsFor:'constants'!
@@ -1682,6 +1688,11 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoder.st,v 1.123 2013-08-10 11:13:37 stefan Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/CharacterEncoderError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderError.st Sun Feb 02 14:16:24 2014 +0000
@@ -65,5 +65,12 @@
!CharacterEncoderError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderError.st,v 1.9 2008-10-30 19:54:05 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderError.st,v 1.9 2008/10/30 19:54:05 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/CharacterEncoderImplementations__ASCII.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__ASCII.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -241,5 +240,12 @@
!ASCII class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ASCII.st,v 1.4 2005-03-31 18:12:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ASCII.st,v 1.4 2005/03/31 18:12:07 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__ASCII.st 10807 2012-05-05 21:58:24Z vranyj1 $'
! !
+
+
+
--- a/CharacterEncoderImplementations__BIG5.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__BIG5.st Sun Feb 02 14:16:24 2014 +0000
@@ -52,5 +52,8 @@
!BIG5 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__BIG5.st,v 1.3 2004-03-09 21:59:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__BIG5.st,v 1.3 2004/03/09 21:59:35 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__CNS11643.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__CNS11643.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!CNS11643 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__CNS11643.st,v 1.3 2004-03-09 21:59:27 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__CNS11643.st,v 1.3 2004/03/09 21:59:27 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__CP437.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__CP437.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -933,5 +932,9 @@
!CP437 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__CP437.st,v 1.4 2005-03-31 18:12:18 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__CP437.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__CP437.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__GB2313_1980.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__GB2313_1980.st Sun Feb 02 14:16:24 2014 +0000
@@ -52,5 +52,8 @@
!GB2313_1980 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__GB2313_1980.st,v 1.3 2004-03-09 21:57:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__GB2313_1980.st,v 1.3 2004/03/09 21:57:26 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__HANGUL.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__HANGUL.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!HANGUL class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__HANGUL.st,v 1.3 2004-03-09 21:57:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__HANGUL.st,v 1.3 2004/03/09 21:57:59 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__ISO10646_1.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__ISO10646_1.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -64,5 +63,12 @@
!ISO10646_1 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO10646_1.st,v 1.4 2004-03-09 22:00:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO10646_1.st,v 1.4 2004/03/09 22:00:08 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__ISO10646_1.st 10807 2012-05-05 21:58:24Z vranyj1 $'
! !
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CharacterEncoderImplementations__ISO10646_to_JavaText.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,153 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: CharacterEncoderImplementations }"
+
+TwoByteEncoder subclass:#ISO10646_to_JavaText
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Text-Encodings'
+!
+
+!ISO10646_to_JavaText class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ Translates \uXXXX-escapes in the text
+"
+! !
+
+!ISO10646_to_JavaText methodsFor:'encoding & decoding'!
+
+decode:aCode
+ self shouldNotImplement "/ no single byte conversion possible
+!
+
+decodeString:aStringOrByteCollection
+ "given a string in JavaText encoding (i.e. with \uXXXX escaped characters),
+ return a new string containing the same characters, in 16bit (or more) encoding.
+ Returns either a normal String, a TwoByteString or a FourByteString instance.
+ Only useful, when reading Java property and resource files.
+ This only handles up-to 30bit characters."
+
+ |nBits ch
+ in out codePoint t|
+
+ nBits := 8.
+ in := aStringOrByteCollection readStream.
+ out := WriteStream on:(String new:10).
+ [in atEnd] whileFalse:[
+ ch := in next.
+ ch == $\ ifTrue:[
+ in peekOrNil == $u ifTrue:[
+ in next.
+ codePoint := 0.
+ 4 timesRepeat:[
+ ch := in peekOrNil.
+ codePoint := (codePoint * 16) + ch digitValue.
+ in next.
+ ].
+ codePoint > 16rFF ifTrue:[
+ codePoint > 16rFFFF ifTrue:[
+ nBits < 32 ifTrue:[
+ t := out contents.
+ out := WriteStream on:(Unicode32String fromString:t).
+ out position:t size.
+ nBits := 32.
+ ]
+ ] ifFalse:[
+ nBits < 16 ifTrue:[
+ t := out contents.
+ out := WriteStream on:(Unicode16String fromString:t).
+ out position:t size.
+ nBits := 16.
+ ]
+ ]
+ ].
+ out nextPut:(Character value:codePoint).
+ ] ifFalse:[
+ out nextPut:ch
+ ]
+ ] ifFalse:[
+ out nextPut:ch
+ ].
+ ].
+ ^ out contents
+
+ "
+ CharacterEncoderImplementations::ISO10646_to_JavaText
+ decodeString:'AB\u1234CD'
+ "
+
+ "Modified: / 23-10-2006 / 13:23:18 / cg"
+!
+
+encode:aCode
+ self shouldNotImplement "/ no single byte conversion possible
+!
+
+encodeString:aUnicodeString
+ "return the JavaText representation of aUnicodeString.
+ The resulting string is only useful to be stored on some external file,
+ not for being used inside ST/X."
+
+ |ch in out codePoint|
+
+ in := aUnicodeString readStream.
+ out := WriteStream on:(String new:10).
+ [in atEnd] whileFalse:[
+ ch := in next.
+ codePoint := ch codePoint.
+ (codePoint between:16r20 and:16r7F) ifTrue:[
+ out nextPut:ch.
+ ] ifFalse:[
+ out nextPutAll:'\u'.
+ out nextPutAll:((codePoint printStringRadix:16) leftPaddedTo:4 with:$0).
+ ].
+ ].
+ ^ out contents
+
+ "
+ CharacterEncoderImplementations::ISO10646_to_JavaText
+ encodeString:'hello '
+
+ CharacterEncoderImplementations::ISO10646_to_JavaText
+ decodeString:(CharacterEncoderImplementations::ISO10646_to_JavaText encodeString:'hello ')
+ "
+
+ "Modified: / 23-10-2006 / 13:25:03 / cg"
+! !
+
+!ISO10646_to_JavaText class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JavaText.st,v 1.1 2006/10/23 11:25:58 cg Exp $'
+! !
+
+
+
--- a/CharacterEncoderImplementations__ISO10646_to_SGML.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__ISO10646_to_SGML.st Sun Feb 02 14:16:24 2014 +0000
@@ -145,7 +145,7 @@
"
CharacterEncoderImplementations::ISO10646_to_SGML
- encodeString:'hello '
+ encodeString:'hello '
"
"Modified: / 23-10-2006 / 13:25:27 / cg"
@@ -154,5 +154,8 @@
!ISO10646_to_SGML class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO10646_to_SGML.st,v 1.3 2006-10-23 11:25:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO10646_to_SGML.st,v 1.3 2006/10/23 11:25:11 cg Exp $'
! !
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CharacterEncoderImplementations__ISO10646_to_XMLUTF8.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,190 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: CharacterEncoderImplementations }"
+
+ISO10646_to_UTF8 subclass:#ISO10646_to_XMLUTF8
+ instanceVariableNames:''
+ classVariableNames:'ReplacementCharacter'
+ poolDictionaries:''
+ category:'Collections-Text-Encodings'
+!
+
+!ISO10646_to_XMLUTF8 class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ This encoder encodes characters into utf8 characters that may
+ occur in XML document.
+
+ Not all UTF characters are valid in XML, whatever encoding
+ is used. For a reference, see
+
+ http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char
+
+ Invalid characters are replaced by ReplacementCharacter
+ with $? as default.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+ http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char
+
+"
+! !
+
+!ISO10646_to_XMLUTF8 class methodsFor:'initialization'!
+
+initialize
+ "Invoked at system start or when the class is dynamically loaded."
+
+ ReplacementCharacter := $?.
+
+ "Modified: / 30-06-2012 / 19:55:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ISO10646_to_XMLUTF8 methodsFor:'encoding & decoding'!
+
+encodeString:aUnicodeString
+ "return the UTF-8 representation of a aUnicodeString.
+ The resulting string contains only valid XML unicode
+ characters. Invalid characters are replaced by a
+ ReplacementCharacter. For details, please see
+
+ http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char
+
+ "
+
+ |s|
+
+ "Copy-paste of superclass's method and tweaked. Not ideal, but
+ but avoids 1 string copy"
+
+ s := WriteStream on:(String uninitializedNew:aUnicodeString size).
+ aUnicodeString do:[:eachCharacter |
+ |codePoint b1 b2 b3 b4 b5 v "{Class: SmallInteger }"|
+
+ codePoint := eachCharacter codePoint.
+ (self isValidXMLunicode: codePoint) ifFalse:[
+ codePoint := ReplacementCharacter codePoint.
+ ].
+
+ codePoint <= 16r7F ifTrue:[
+ s nextPut:(Character value:codePoint).
+ ] ifFalse:[
+ b1 := Character value:((codePoint bitAnd:16r3F) bitOr:2r10000000).
+ v := codePoint bitShift:-6.
+ v <= 16r1F ifTrue:[
+ s nextPut:(Character value:(v bitOr:2r11000000)).
+ s nextPut:b1.
+ ] ifFalse:[
+ b2 := Character value:((v bitAnd:16r3F) bitOr:2r10000000).
+ v := v bitShift:-6.
+ v <= 16r0F ifTrue:[
+ s nextPut:(Character value:(v bitOr:2r11100000)).
+ s nextPut:b2; nextPut:b1.
+ ] ifFalse:[
+ b3 := Character value:((v bitAnd:16r3F) bitOr:2r10000000).
+ v := v bitShift:-6.
+ v <= 16r07 ifTrue:[
+ s nextPut:(Character value:(v bitOr:2r11110000)).
+ s nextPut:b3; nextPut:b2; nextPut:b1.
+ ] ifFalse:[
+ b4 := Character value:((v bitAnd:16r3F) bitOr:2r10000000).
+ v := v bitShift:-6.
+ v <= 16r03 ifTrue:[
+ s nextPut:(Character value:(v bitOr:2r11111000)).
+ s nextPut:b4; nextPut:b3; nextPut:b2; nextPut:b1.
+ ] ifFalse:[
+ b5 := Character value:((v bitAnd:16r3F) bitOr:2r10000000).
+ v := v bitShift:-6.
+ v <= 16r01 ifTrue:[
+ s nextPut:(Character value:(v bitOr:2r11111100)).
+ s nextPut:b5; nextPut:b4; nextPut:b3; nextPut:b2; nextPut:b1.
+ ] ifFalse:[
+ "/ cannot happen - we only support up to 30 bit characters
+ self error:'ascii value > 31bit in utf8Encode'.
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ ^ s contents
+
+ "
+ (self encodeString:'hello') asByteArray #[104 101 108 108 111]
+ (self encodeString:(Character value:16r40) asString) asByteArray #[64]
+ (self encodeString:(Character value:16r7F) asString) asByteArray #[127]
+ (self encodeString:(Character value:16r80) asString) asByteArray #[194 128]
+ (self encodeString:(Character value:16rFF) asString) asByteArray #[195 191]
+ (self encodeString:(Character value:16r100) asString) asByteArray #[196 128]
+ (self encodeString:(Character value:16r200) asString) asByteArray #[200 128]
+ (self encodeString:(Character value:16r400) asString) asByteArray #[208 128]
+ (self encodeString:(Character value:16r800) asString) asByteArray #[224 160 128]
+ (self encodeString:(Character value:16r1000) asString) asByteArray #[225 128 128]
+ (self encodeString:(Character value:16r2000) asString) asByteArray #[226 128 128]
+ (self encodeString:(Character value:16r4000) asString) asByteArray #[228 128 128]
+ (self encodeString:(Character value:16r8000) asString) asByteArray #[232 128 128]
+ (self encodeString:(Character value:16rFFFF) asString) asByteArray #[239 191 191]
+ "
+
+ "Created: / 30-06-2012 / 20:07:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ISO10646_to_XMLUTF8 methodsFor:'queries'!
+
+isValidXMLunicode: codePoint
+ "Returns true, if given codePoint (Integer!!!!!!) is
+ valid XML unicode."
+
+ codePoint == 16r0009 ifTrue:[ ^ true ].
+ codePoint == 16r000A ifTrue:[ ^ true ].
+ codePoint == 16r000D ifTrue:[ ^ true ].
+ (codePoint between: 16r0020 and: 16rD7FF ) ifTrue:[ ^ true ].
+ (codePoint between: 16rE000 and: 16rFFFD ) ifTrue:[ ^ true ].
+ (codePoint between: 16r10000 and: 16r10FFFF) ifTrue:[ ^ true ].
+
+ ^false.
+
+ "Created: / 30-06-2012 / 20:11:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ISO10646_to_XMLUTF8 class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id:: $'
+! !
+
+ISO10646_to_XMLUTF8 initialize!
--- a/CharacterEncoderImplementations__ISO8859_11.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__ISO8859_11.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -596,5 +595,9 @@
!ISO8859_11 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO8859_11.st,v 1.4 2005-03-31 18:12:32 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__ISO8859_11.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__ISO8859_11.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__ISO8859_2.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__ISO8859_2.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -766,5 +765,12 @@
!ISO8859_2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO8859_2.st,v 1.4 2005-03-31 18:12:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__ISO8859_2.st,v 1.4 2005/03/31 18:12:47 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__ISO8859_2.st 10807 2012-05-05 21:58:24Z vranyj1 $'
! !
+
+
+
--- a/CharacterEncoderImplementations__JIS0201.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__JIS0201.st Sun Feb 02 14:16:24 2014 +0000
@@ -558,5 +558,8 @@
!JIS0201 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0201.st,v 1.3 2004-03-09 21:59:06 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0201.st,v 1.3 2004/03/09 21:59:06 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__JIS0208.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__JIS0208.st Sun Feb 02 14:16:24 2014 +0000
@@ -28646,5 +28646,8 @@
!JIS0208 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208.st,v 1.4 2008-10-30 19:54:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208.st,v 1.4 2008/10/30 19:54:58 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__JIS0208_to_EUC.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__JIS0208_to_EUC.st Sun Feb 02 14:16:24 2014 +0000
@@ -332,5 +332,8 @@
!JIS0208_to_EUC class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208_to_EUC.st,v 1.4 2005-07-08 17:15:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208_to_EUC.st,v 1.4 2005/07/08 17:15:01 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__JIS0208_to_JIS7.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__JIS0208_to_JIS7.st Sun Feb 02 14:16:24 2014 +0000
@@ -372,5 +372,8 @@
!JIS0208_to_JIS7 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208_to_JIS7.st,v 1.7 2004-03-12 09:15:11 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208_to_JIS7.st,v 1.7 2004/03/12 09:15:11 ca Exp $'
! !
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CharacterEncoderImplementations__JIS0208_to_SJIS.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,354 @@
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: CharacterEncoderImplementations }"
+
+TwoByteEncoder subclass:#JIS0208_to_SJIS
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Text-Encodings'
+!
+
+!JIS0208_to_SJIS class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!JIS0208_to_SJIS class methodsFor:'mapping'!
+
+mapFileURL1_relativePathName
+ ^ 'OBSOLETE/EASTASIA/JIS/SHIFTJIS.TXT'
+! !
+
+!JIS0208_to_SJIS class methodsFor:'queries'!
+
+nameOfDecodedCode
+ "I encode sjis into jis"
+
+ ^ #'jis0208'
+! !
+
+!JIS0208_to_SJIS methodsFor:'encoding & decoding'!
+
+decodeString:aString
+ "return a new JIS-Encoded-String containing the characters from aString,
+ which are interpreted as Shift-JIS encoded singleByte chars.
+ Shift-JIS is a leadyByte code, with a variable-length encoding."
+
+ |newString char1 char2
+ sz "{ Class: SmallInteger }"
+ dstIdx "{ Class: SmallInteger }"
+ srcIdx "{ Class: SmallInteger }"
+ b1 "{ Class: SmallInteger }"
+ b2 "{ Class: SmallInteger }"
+ val "{ Class: SmallInteger }"
+ any16bit romans|
+
+ sz := aString size.
+ sz == 0 ifTrue:[^ aString].
+
+ newString := TwoByteString new:sz.
+ any16bit := false.
+ dstIdx := 1.
+ srcIdx := 1.
+
+ romans := CharacterEncoderImplementations::JIS0208 romanTable.
+
+%{
+ if (__isStringLike(aString)
+ && (__Class(newString) == @global(TwoByteString))) {
+ INT _dstIdx = 0, _srcIdx = 0;
+ int _sz = __intVal(sz);
+ unsigned char *_cp = __stringVal(aString);
+ unsigned char _c1, _c2;
+ unsigned short *_jcp = (unsigned short *)__stringVal(newString);
+
+ while (_srcIdx < _sz) {
+ int _val;
+
+ _c1 = _cp[_srcIdx];
+ _srcIdx++;
+
+ if ((_srcIdx < _sz)
+ && (((_c1 >= 129) && (_c1 <= 159))
+ || ((_c1 >= 224) && (_c1 <= 239)))) {
+ _c2 = _cp[_srcIdx];
+ _srcIdx++;
+ if ((_c2 >= 64) && (_c2 <= 252)) {
+ int _adjust, _rowOffs, _cellOffs;
+ int _b1, _b2;
+
+ _adjust = (_c2 < 159) ? 1 : 0;
+ _rowOffs = (_c1 < 160) ? 112 : 176;
+ if (_adjust) {
+ _cellOffs = 31 + ((_c2 > 127) ? 1 : 0);
+ } else {
+ _cellOffs = 126;
+ }
+ _b1 = ((_c1 - _rowOffs) << 1) - _adjust;
+ _b2 = (_c2 - _cellOffs);
+ _val = (_b1<<8) + _b2;
+ if (_val <= 0) {
+ /* decoder error - let smalltalk handle that */
+ _srcIdx -= 2;
+ goto getOutOfHere;
+ }
+ if (_val > 0xFF) any16bit = true;
+ _jcp[_dstIdx] = _val;
+ } else {
+ /* mhmh - append untranslated */
+
+ _jcp[_dstIdx] = _c1;
+ _dstIdx++;
+ _jcp[_dstIdx] = _c2;
+ }
+ } else {
+ if ((_c1 >= 0xA1 /* 161 */) && (_c1 <= 0xDF /* 223 */)) {
+ /* HALFWIDTH KATAKANA
+ * map half-width katakana to 8E:xx
+ */
+ _val = _c1 - 128;
+ _val = _val + 0x8E00;
+ any16bit = true;
+ _jcp[_dstIdx] = _val;
+ } else {
+ /* roman characters are translated as per romanTable */
+ _jcp[_dstIdx] = _c1;
+ if ((romans != nil)
+ && (__isArray(romans))
+ && ((_c1 - 0x20) < __arraySize(romans))) {
+ any16bit = true;
+ _jcp[_dstIdx] = __intVal(__ArrayInstPtr(romans)->a_element[(_c1 - 0x20)]);
+ }
+ }
+ }
+ _dstIdx++;
+ }
+ getOutOfHere: ;
+ dstIdx = __mkSmallInteger(_dstIdx+1);
+ srcIdx = __mkSmallInteger(_srcIdx+1);
+ }
+%}.
+
+ [srcIdx <= sz] whileTrue:[
+ "/
+ "/ scan for next character in 129..159 or 224..239
+ "/
+ char1 := aString at:srcIdx.
+ srcIdx := srcIdx + 1.
+ b1 := char1 codePoint.
+
+ ((srcIdx <= sz)
+ and:[(b1 >= 16r81"129" and:[b1 <= 16r9F"159"]) "/ SJIS1 81 .. 9F
+ or:[b1 >= 16rE0"224" and:[b1 <= 16rEF"239"]]]) ifTrue:[ "/ E0 .. EF
+ char2 := aString at:srcIdx.
+ srcIdx := srcIdx + 1.
+ b2 := char2 codePoint.
+ (b2 >= 16r40"64" and:[b2 <= 16rFC"252"]) ifTrue:[ "/ SJIS2 40 .. FC
+ |adjust rowOffs cellOffs|
+
+ adjust := (b2 < 16r9F"159") ifTrue:[1] ifFalse:[0].
+ rowOffs := b1 < 16rA0"160" ifTrue:[112] ifFalse:[176].
+ adjust == 1 ifTrue:[
+ cellOffs := 31 + (b2 > 127 ifTrue:[1] ifFalse:[0]).
+ ] ifFalse:[
+ cellOffs := 126.
+ ].
+ b1 := ((b1 - rowOffs) bitShift:1) - adjust.
+ b2 := (b2 - cellOffs).
+ val := (b1 bitShift:8) + b2.
+ val <= 0 ifTrue:[
+ DecodingError
+ raiseWith:aString
+ errorString:'SJIS decoding failed (not SJIS encoded ?)'.
+ newString at:dstIdx put:char1.
+ dstIdx := dstIdx + 1.
+ newString at:dstIdx put:char2.
+ ] ifFalse:[
+ val > 16rFF ifTrue:[any16bit := true].
+ newString at:dstIdx put:(Character value:val).
+ ]
+ ] ifFalse:[
+ "/ mhmh - append untranslated
+
+ newString at:dstIdx put:char1.
+ dstIdx := dstIdx + 1.
+ newString at:dstIdx put:char2.
+ ]
+ ] ifFalse:[
+ (b1 >= 16rA1 "161" and:[b1 <= 16rDF "223"]) ifTrue:[ "/ HALFWIDTH KATAKANA
+ "/ map half-width katakan to 8E:xx
+ val := b1 - 128.
+ val := val + (16r8E"142" bitShift:8).
+ any16bit := true.
+ newString at:dstIdx put:(Character value:val).
+ ] ifFalse:[
+ "/ roman characters translated as per romanTable
+ newString at:dstIdx put:char1
+ romans isArray ifTrue:[
+ char1 codePoint < romans size ifTrue:[
+ any16bit := true.
+ newString at:dstIdx put:(Character value:(romans at:char1 codePoint-32+1)).
+ ]
+ ]
+ ]
+ ].
+ dstIdx := dstIdx + 1.
+ ].
+ any16bit ifFalse:[
+ newString := String fromString:newString
+ ].
+
+ (dstIdx-1) ~~ sz ifTrue:[
+ newString := newString copyTo:dstIdx - 1.
+ ].
+
+ ^ newString
+
+ "simple:
+
+ CharacterEncoderImplementations::JIS0208_to_SJIS decodeString:'hello'
+ (CharacterEncoder encoderFor:#sjis) decodeString:'hello'
+
+ CharacterEncoderImplementations::JIS0208_to_SJIS decodeString:('../../doc/online/japanese/TOP.html' asFilename contents asString)
+
+ '../../doc/online/japanese/TOP.html' asFilename contents asString
+ decodeFrom:#sjis
+ "
+!
+
+encodeString:aJISString
+ "return a new string with aJISStrings characters as SJIS encoded 8bit string.
+ The resulting string is only useful to be stored on some external file,
+ not for being displayed in an ST/X view."
+
+ |sz "{ Class: SmallInteger }"
+ rval "{ Class: SmallInteger }"
+ val "{ Class: SmallInteger }"
+ romans c out isSJIS|
+
+ romans := JIS0208 romanTable.
+
+ sz := aJISString size.
+ sz == 0 ifTrue:[^ ''].
+
+ out := WriteStream on:(String new:(sz * 2)).
+
+ 1 to:sz do:[:srcIndex |
+ val := (c := aJISString at:srcIndex) codePoint.
+ (val <= 128) ifTrue:[
+ "/ a control or ascii character
+ out nextPut:c.
+ ] ifFalse:[
+ (val == 16rFFFF "invalid-char") ifTrue:[
+ out nextPut:Character space.
+ ] ifFalse:[
+ (val > 150 and:[val < 224]) ifTrue:[
+ "/ ascii subset
+ out nextPut:c.
+ ] ifFalse:[
+ "/ should not happen ...
+ val <= 255 ifTrue:[
+ out nextPut:c.
+ ] ifFalse:[
+ isSJIS := true.
+
+ "/ check for HALFWIDTH KATAKANA
+ "/ 8E:xx
+ "/ NO: halfwidth katakana no longer generated
+ "/ remains there as full-width katakana
+
+"/ (val bitAnd:16rFF00) == 16r8E00 ifTrue:[
+"/ |b|
+"/
+"/ b := (val bitAnd:16rFF) + 128.
+"/ (b >= 16rA1 "161" and:[b <= 16rDF "223"]) ifTrue:[
+"/ out nextPut:(Character value:b).
+"/ isSJIS := false.
+"/ ].
+"/ ].
+
+ isSJIS ifTrue:[
+ "/ check for a roman character
+ (val between:"romanTable min" 16r2121 and:"romanTable max" 16r2573) ifTrue:[
+ rval := romans indexOf:val.
+ rval ~~ 0 ifTrue:[
+ rval := rval - 1 + 32.
+ rval <= 16r7F ifTrue:[ "/ do not translate halfwidth katakana
+ out nextPut:(Character value:rval).
+ isSJIS := false.
+ ]
+ ].
+ ].
+ ].
+
+ isSJIS ifTrue:[
+ |b1 b2 rowOffset cellOffset|
+
+ b1 := (val bitShift:-8).
+ b2 := (val bitAnd:16rFF).
+ rowOffset := (b1 < 95) ifTrue:[112] ifFalse:[176].
+ cellOffset := b1 odd ifTrue:[(b2 > 95) ifTrue:[32] ifFalse:[31]]
+ ifFalse:[126].
+
+ out nextPut:(Character value:(((b1 + 1) bitShift:-1) + rowOffset)).
+ out nextPut:(Character value:b2 + cellOffset).
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+ ^ out contents
+! !
+
+!JIS0208_to_SJIS methodsFor:'private'!
+
+newString:size
+ ^ JISEncodedString new:size
+! !
+
+!JIS0208_to_SJIS methodsFor:'queries'!
+
+nameOfEncoding
+ ^ #'sjis'
+! !
+
+!JIS0208_to_SJIS class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__SJIS.st,v 1.12 2009/11/05 16:26:27 stefan Exp $'
+!
+
+version_CVS
+ ^ 'Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__SJIS.st,v 1.12 2009/11/05 16:26:27 stefan Exp '
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__JIS0208_to_SJIS.st 10807 2012-05-05 21:58:24Z vranyj1 $'
+! !
+
+
+
--- a/CharacterEncoderImplementations__JIS0212.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__JIS0212.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!JIS0212 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0212.st,v 1.3 2004-03-09 21:58:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0212.st,v 1.3 2004/03/09 21:58:52 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__JOHAB.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__JOHAB.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!JOHAB class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JOHAB.st,v 1.3 2004-03-09 21:57:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JOHAB.st,v 1.3 2004/03/09 21:57:37 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__JavaText.st Sun Feb 02 00:13:55 2014 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,150 +0,0 @@
-"
- COPYRIGHT (c) 2006 by eXept Software AG
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-"{ Package: 'stx:libbasic' }"
-
-"{ NameSpace: CharacterEncoderImplementations }"
-
-TwoByteEncoder subclass:#ISO10646_to_JavaText
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Collections-Text-Encodings'
-!
-
-!ISO10646_to_JavaText class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 2006 by eXept Software AG
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- Translates \uXXXX-escapes in the text
-"
-! !
-
-!ISO10646_to_JavaText methodsFor:'encoding & decoding'!
-
-decode:aCode
- self shouldNotImplement "/ no single byte conversion possible
-!
-
-decodeString:aStringOrByteCollection
- "given a string in JavaText encoding (i.e. with \uXXXX escaped characters),
- return a new string containing the same characters, in 16bit (or more) encoding.
- Returns either a normal String, a TwoByteString or a FourByteString instance.
- Only useful, when reading Java property and resource files.
- This only handles up-to 30bit characters."
-
- |nBits ch
- in out codePoint t|
-
- nBits := 8.
- in := aStringOrByteCollection readStream.
- out := WriteStream on:(String new:10).
- [in atEnd] whileFalse:[
- ch := in next.
- ch == $\ ifTrue:[
- in peekOrNil == $u ifTrue:[
- in next.
- codePoint := 0.
- 4 timesRepeat:[
- ch := in peekOrNil.
- codePoint := (codePoint * 16) + ch digitValue.
- in next.
- ].
- codePoint > 16rFF ifTrue:[
- codePoint > 16rFFFF ifTrue:[
- nBits < 32 ifTrue:[
- t := out contents.
- out := WriteStream on:(Unicode32String fromString:t).
- out position:t size.
- nBits := 32.
- ]
- ] ifFalse:[
- nBits < 16 ifTrue:[
- t := out contents.
- out := WriteStream on:(Unicode16String fromString:t).
- out position:t size.
- nBits := 16.
- ]
- ]
- ].
- out nextPut:(Character value:codePoint).
- ] ifFalse:[
- out nextPut:ch
- ]
- ] ifFalse:[
- out nextPut:ch
- ].
- ].
- ^ out contents
-
- "
- CharacterEncoderImplementations::ISO10646_to_JavaText
- decodeString:'AB\u1234CD'
- "
-
- "Modified: / 23-10-2006 / 13:23:18 / cg"
-!
-
-encode:aCode
- self shouldNotImplement "/ no single byte conversion possible
-!
-
-encodeString:aUnicodeString
- "return the JavaText representation of aUnicodeString.
- The resulting string is only useful to be stored on some external file,
- not for being used inside ST/X."
-
- |ch in out codePoint|
-
- in := aUnicodeString readStream.
- out := WriteStream on:(String new:10).
- [in atEnd] whileFalse:[
- ch := in next.
- codePoint := ch codePoint.
- (codePoint between:16r20 and:16r7F) ifTrue:[
- out nextPut:ch.
- ] ifFalse:[
- out nextPutAll:'\u'.
- out nextPutAll:((codePoint printStringRadix:16) leftPaddedTo:4 with:$0).
- ].
- ].
- ^ out contents
-
- "
- CharacterEncoderImplementations::ISO10646_to_JavaText
- encodeString:'hello '
-
- CharacterEncoderImplementations::ISO10646_to_JavaText
- decodeString:(CharacterEncoderImplementations::ISO10646_to_JavaText encodeString:'hello ')
- "
-
- "Modified: / 23-10-2006 / 13:25:03 / cg"
-! !
-
-!ISO10646_to_JavaText class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JavaText.st,v 1.1 2006-10-23 11:25:58 cg Exp $'
-! !
--- a/CharacterEncoderImplementations__KSC5601.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__KSC5601.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!KSC5601 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__KSC5601.st,v 1.3 2004-03-09 21:58:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__KSC5601.st,v 1.3 2004/03/09 21:58:35 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Arabic.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Arabic.st Sun Feb 02 14:16:24 2014 +0000
@@ -584,5 +584,8 @@
!MAC_Arabic class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Arabic.st,v 1.3 2004-03-09 21:59:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Arabic.st,v 1.3 2004/03/09 21:59:43 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_CentralEuropean.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_CentralEuropean.st Sun Feb 02 14:16:24 2014 +0000
@@ -373,5 +373,8 @@
!MAC_CentralEuropean class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_CentralEuropean.st,v 1.3 2004-03-09 21:57:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_CentralEuropean.st,v 1.3 2004/03/09 21:57:41 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Croatian.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Croatian.st Sun Feb 02 14:16:24 2014 +0000
@@ -399,5 +399,8 @@
!MAC_Croatian class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Croatian.st,v 1.3 2004-03-09 22:00:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Croatian.st,v 1.3 2004/03/09 22:00:00 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Cyrillic.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Cyrillic.st Sun Feb 02 14:16:24 2014 +0000
@@ -398,5 +398,8 @@
!MAC_Cyrillic class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Cyrillic.st,v 1.3 2004-03-09 21:57:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Cyrillic.st,v 1.3 2004/03/09 21:57:56 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Dingbats.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Dingbats.st Sun Feb 02 14:16:24 2014 +0000
@@ -375,5 +375,8 @@
!MAC_Dingbats class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Dingbats.st,v 1.3 2004-03-09 22:01:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Dingbats.st,v 1.3 2004/03/09 22:01:02 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Farsi.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Farsi.st Sun Feb 02 14:16:24 2014 +0000
@@ -569,5 +569,8 @@
!MAC_Farsi class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Farsi.st,v 1.3 2004-03-09 22:00:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Farsi.st,v 1.3 2004/03/09 22:00:02 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Greek.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Greek.st Sun Feb 02 14:16:24 2014 +0000
@@ -847,5 +847,8 @@
!MAC_Greek class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Greek.st,v 1.3 2004-03-09 21:59:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Greek.st,v 1.3 2004/03/09 21:59:52 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Hebrew.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Hebrew.st Sun Feb 02 14:16:24 2014 +0000
@@ -611,5 +611,8 @@
!MAC_Hebrew class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Hebrew.st,v 1.3 2004-03-09 22:01:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Hebrew.st,v 1.3 2004/03/09 22:01:14 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Iceland.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Iceland.st Sun Feb 02 14:16:24 2014 +0000
@@ -417,5 +417,8 @@
!MAC_Iceland class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Iceland.st,v 1.3 2004-03-09 21:59:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Iceland.st,v 1.3 2004/03/09 21:59:24 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Japanese.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Japanese.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!MAC_Japanese class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Japanese.st,v 1.3 2004-03-09 21:59:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Japanese.st,v 1.3 2004/03/09 21:59:58 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Korean.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Korean.st Sun Feb 02 14:16:24 2014 +0000
@@ -46,5 +46,8 @@
!MAC_Korean class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Korean.st,v 1.3 2004-03-09 21:58:29 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Korean.st,v 1.3 2004/03/09 21:58:29 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Romanian.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Romanian.st Sun Feb 02 14:16:24 2014 +0000
@@ -414,5 +414,8 @@
!MAC_Romanian class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Romanian.st,v 1.3 2004-03-09 21:58:05 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Romanian.st,v 1.3 2004/03/09 21:58:05 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Symbol.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Symbol.st Sun Feb 02 14:16:24 2014 +0000
@@ -445,5 +445,8 @@
!MAC_Symbol class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Symbol.st,v 1.3 2004-03-09 21:57:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Symbol.st,v 1.3 2004/03/09 21:57:44 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Thai.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Thai.st Sun Feb 02 14:16:24 2014 +0000
@@ -432,5 +432,8 @@
!MAC_Thai class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Thai.st,v 1.3 2004-03-09 21:59:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Thai.st,v 1.3 2004/03/09 21:59:00 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MAC_Turkish.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MAC_Turkish.st Sun Feb 02 14:16:24 2014 +0000
@@ -389,5 +389,8 @@
!MAC_Turkish class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Turkish.st,v 1.3 2004-03-09 21:59:55 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MAC_Turkish.st,v 1.3 2004/03/09 21:59:55 cg Exp $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MS_Arabic.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Arabic.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -839,5 +838,9 @@
!MS_Arabic class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Arabic.st,v 1.4 2005-03-31 18:48:44 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__MS_Arabic.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__MS_Arabic.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__MS_Baltic.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Baltic.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -852,5 +851,12 @@
!MS_Baltic class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Baltic.st,v 1.4 2005-03-31 18:48:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Baltic.st,v 1.4 2005/03/31 18:48:58 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__MS_Baltic.st 10807 2012-05-05 21:58:24Z vranyj1 $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MS_Cyrillic.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Cyrillic.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -718,5 +717,12 @@
!MS_Cyrillic class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Cyrillic.st,v 1.4 2005-03-31 18:48:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Cyrillic.st,v 1.4 2005/03/31 18:48:53 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__MS_Cyrillic.st 10807 2012-05-05 21:58:24Z vranyj1 $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MS_EastEuropean.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_EastEuropean.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -813,5 +812,9 @@
!MS_EastEuropean class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_EastEuropean.st,v 1.4 2005-03-31 18:48:47 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__MS_EastEuropean.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__MS_EastEuropean.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__MS_Greek.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Greek.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -671,5 +670,12 @@
!MS_Greek class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Greek.st,v 1.4 2005-03-31 18:49:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Greek.st,v 1.4 2005/03/31 18:49:01 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterEncoderImplementations__MS_Greek.st 10807 2012-05-05 21:58:24Z vranyj1 $'
! !
+
+
+
--- a/CharacterEncoderImplementations__MS_Hebrew.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Hebrew.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -607,5 +606,9 @@
!MS_Hebrew class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Hebrew.st,v 1.4 2005-03-31 18:48:50 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__MS_Hebrew.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__MS_Hebrew.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__MS_Symbol.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Symbol.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -88,5 +87,9 @@
!MS_Symbol class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Symbol.st,v 1.5 2005-03-31 18:48:55 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__MS_Symbol.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__MS_Symbol.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__MS_Turkish.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__MS_Turkish.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
"{ NameSpace: CharacterEncoderImplementations }"
@@ -819,5 +818,9 @@
!MS_Turkish class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__MS_Turkish.st,v 1.5 2005-03-31 18:49:37 cg Exp $'
+ ^ '$Id: CharacterEncoderImplementations__MS_Turkish.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id:: CharacterEncoderImplementations__MS_Turkish.st 10842 2012-09-07 10:49:18Z vranyj1 $'
! !
--- a/CharacterEncoderImplementations__NEXT.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterEncoderImplementations__NEXT.st Sun Feb 02 14:16:24 2014 +0000
@@ -313,5 +313,8 @@
!NEXT class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__NEXT.st,v 1.3 2004-03-09 22:00:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__NEXT.st,v 1.3 2004/03/09 22:00:52 cg Exp $'
! !
+
+
+
--- a/CharacterRangeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CharacterRangeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
DecodingError subclass:#CharacterRangeError
@@ -38,5 +37,12 @@
!CharacterRangeError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterRangeError.st,v 1.2 2004-03-09 21:58:39 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterRangeError.st,v 1.2 2004/03/09 21:58:39 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CharacterRangeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/CheapBlock.st Sun Feb 02 00:13:55 2014 +0100
+++ b/CheapBlock.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Block variableSubclass:#CheapBlock
@@ -182,5 +181,12 @@
!CheapBlock class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CheapBlock.st,v 1.20 2000-04-01 13:05:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CheapBlock.st,v 1.20 2000/04/01 13:05:54 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: CheapBlock.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/Class.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Class.st Sun Feb 02 14:16:24 2014 +0000
@@ -21,7 +21,7 @@
category:'Kernel-Classes'
!
-Array variableSubclass:#ArrayWithSequenceNumberValidation
+Array subclass:#ArrayWithSequenceNumberValidation
instanceVariableNames:'sequenceNumber'
classVariableNames:''
poolDictionaries:''
@@ -151,7 +151,10 @@
the meantime. You have been warned - better leave it false (the sourceCodemanager will
fill its cache and eventually be just as fast...)"
- ^ TryLocalSourceFirst
+ "JV: When smalltalk is not yet initialized, do use local sources
+ because before that, SCM support may not be loaded and configured
+ properly, leading to funny errors."
+ ^ Smalltalk isInitialized not or:[TryLocalSourceFirst == true].
"Created: 24.1.1996 / 19:55:35 / cg"
!
@@ -308,10 +311,10 @@
idx := name lastIndexOf:$:.
[idx > 1 and:[ (name at:(idx-1)) ~~ $: ]] whileTrue:[
- idx := name lastIndexOf:$: startingAt:idx-2.
+ idx := name lastIndexOf:$: startingAt:idx-2.
].
idx == 0 ifTrue:[
- ^ name
+ ^ name
].
^ name copyFrom:idx+1.
@@ -344,10 +347,10 @@
"/ care for standAlone apps which have no CVS (libbasic3) included
"/
mgr isNil ifTrue:[
- AbstractSourceCodeManager notNil ifTrue:[
- ^ CVSVersionInfo fromRCSString:aString
- ].
- ^ nil
+ AbstractSourceCodeManager notNil ifTrue:[
+ ^ CVSVersionInfo fromRCSString:aString
+ ].
+ ^ nil
].
^ mgr revisionInfoFromString:aString.
@@ -364,25 +367,30 @@
lines := aMethodSourceString asCollectionOfLines.
lines do:[:l |
- |i|
-
- i := l indexOfSubCollection:'$Header: '.
- "JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"
- i == 0 ifTrue:[
- i := l indexOfSubCollection:'$Id: '].
- i ~~ 0 ifTrue:[
- line := l copyFrom:i.
- i := line lastIndexOf:$$.
- i > 1 ifTrue:[
- line := line copyTo:i.
- ].
- ^ line
- ]
+ |i|
+
+ i := l indexOfSubCollection:'$Header: '.
+ "JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"
+ i == 0 ifTrue:[
+ i := l indexOfSubCollection:'$Id: '].
+ "JV @ 2013-07-18: Also search for '$Changeset: ' (because of Mercurial-only classes)"
+ i == 0 ifTrue:[
+ i := l indexOfSubCollection:'$Changeset: '].
+
+ i ~~ 0 ifTrue:[
+ line := l copyFrom:i.
+ i := line lastIndexOf:$$.
+ i > 1 ifTrue:[
+ line := line copyTo:i.
+ ].
+ ^ line
+ ]
].
^ nil
"Created: / 15-10-1996 / 18:57:57 / cg"
"Modified: / 22-10-2008 / 20:29:50 / cg"
+ "Modified: / 19-07-2013 / 23:32:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Class class methodsFor:'misc'!
@@ -425,7 +433,7 @@
This is private protocol"
aClass notNil ifTrue:[
- aClass flushSubclasses
+ aClass flushSubclasses
].
"
@@ -447,7 +455,6 @@
"Modified: 23.4.1996 / 15:56:58 / cg"
! !
-
!Class methodsFor:'Compatibility-Dolphin'!
defaultCategoryForDolphinClasses
@@ -508,14 +515,14 @@
|cat app|
DefaultApplicationQuerySignal isHandled ifTrue:[
- app := DefaultApplicationQuerySignal query.
- app notNil ifTrue:[
- cat := "'Applications-' ," app nameWithoutPrefix.
- ] ifFalse:[
- cat := DefaultCategoryForVAGE ? 'V''Age classes'.
- ].
+ app := DefaultApplicationQuerySignal query.
+ app notNil ifTrue:[
+ cat := "'Applications-' ," app nameWithoutPrefix.
+ ] ifFalse:[
+ cat := DefaultCategoryForVAGE ? 'V''Age classes'.
+ ].
] ifFalse:[
- cat := DefaultCategoryForSTV ? 'ST/V classes'.
+ cat := DefaultCategoryForSTV ? 'ST/V classes'.
].
^ cat
@@ -529,12 +536,12 @@
"this method allows fileIn of ST/V and V'Age classes"
^ self
- subclass:nm
- instanceVariableNames:iV
- classVariableNames:cV
- poolDictionaries:p
- category:(self defaultCategoryForSTVorVAGEClasses)
- classInstanceVariableNames:cIV
+ subclass:nm
+ instanceVariableNames:iV
+ classVariableNames:cV
+ poolDictionaries:p
+ category:(self defaultCategoryForSTVorVAGEClasses)
+ classInstanceVariableNames:cIV
!
subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s
@@ -962,7 +969,7 @@
"/ (e at:self nameWithoutNamespacePrefix ifAbsent:nil)
"/ or
(Smalltalk at:name ifAbsent:nil) == self ifFalse:[
- ^ nil
+ ^ nil
].
^ e
!
@@ -1039,21 +1046,21 @@
"/ cached in environment
environment isNil ifTrue:[
- e := Smalltalk. "/ default
-
- name notNil ifTrue:[
- "/ due to the implementation, extract this from my name
- "/ (physically, all classes are found in Smalltalk)
-
- idx := name lastIndexOf:$:.
- idx ~~ 0 ifTrue:[
- (name at:idx-1) == $: ifTrue:[
- nsName := name copyTo:(idx - 2).
- e := Smalltalk at:nsName asSymbol.
- ]
- ].
- ].
- environment := e.
+ e := Smalltalk. "/ default
+
+ name notNil ifTrue:[
+ "/ due to the implementation, extract this from my name
+ "/ (physically, all classes are found in Smalltalk)
+
+ idx := name lastIndexOf:$:.
+ idx ~~ 0 ifTrue:[
+ (name at:idx-1) == $: ifTrue:[
+ nsName := name copyTo:(idx - 2).
+ e := Smalltalk at:nsName asSymbol.
+ ]
+ ].
+ ].
+ environment := e.
].
^ environment
@@ -1082,16 +1089,16 @@
|newPackage oldPackage|
aSymbol == PackageId noProjectID ifTrue:[
- newPackage := nil
+ newPackage := nil
] ifFalse:[
- newPackage := aSymbol
+ newPackage := aSymbol
].
package ~= newPackage ifTrue:[
- oldPackage := package.
- package := newPackage.
-
- self changed:#package.
- Smalltalk changed:#projectOrganization with:(Array with:self with:oldPackage).
+ oldPackage := package.
+ package := newPackage.
+
+ self changed:#package.
+ Smalltalk changed:#projectOrganization with:(Array with:self with:oldPackage).
].
"Modified: / 09-08-2006 / 17:58:53 / fm"
@@ -1355,25 +1362,25 @@
classes := self privateClasses.
classes notEmpty ifTrue:[
- classes := classes asOrderedCollection.
- classes sort:[:a :b | a name < b name].
-
- pivateClassesOf := IdentityDictionary new.
- classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
-
- classes topologicalSort:[:a :b |
- "/ a must come before b iff:
- "/ b is a subclass of a
- "/ b has a private class which is a subclass of a
-
- |mustComeBefore pivateClassesOfB|
- mustComeBefore := b isSubclassOf:a.
- pivateClassesOfB := pivateClassesOf at:b.
- pivateClassesOfB do:[:eachClassInB |
- mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
- ].
- mustComeBefore
- ].
+ classes := classes asOrderedCollection.
+ classes sort:[:a :b | a name < b name].
+
+ pivateClassesOf := IdentityDictionary new.
+ classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
+
+ classes topologicalSort:[:a :b |
+ "/ a must come before b iff:
+ "/ b is a subclass of a
+ "/ b has a private class which is a subclass of a
+
+ |mustComeBefore pivateClassesOfB|
+ mustComeBefore := b isSubclassOf:a.
+ pivateClassesOfB := pivateClassesOf at:b.
+ pivateClassesOfB do:[:eachClassInB |
+ mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
+ ].
+ mustComeBefore
+ ].
].
^ classes.
@@ -1422,14 +1429,14 @@
poolNames := self sharedPoolNames.
(ns := self topNameSpace) notNil ifTrue:[
- ^ poolNames
- collect:[:nm |
- |p|
- (p := ns at:nm asSymbol) notNil ifTrue:[
- p name
- ] ifFalse:[
- nm
- ]].
+ ^ poolNames
+ collect:[:nm |
+ |p|
+ (p := ns at:nm asSymbol) notNil ifTrue:[
+ p name
+ ] ifFalse:[
+ nm
+ ]].
].
^ poolNames
@@ -1732,15 +1739,79 @@
"Modified: / 05-12-2006 / 22:04:26 / cg"
!
+sourceCodeManagerFromBinaryRevision
+
+ "Returns the source code manager that should be used for
+ source code access based in class's binary revision.
+ If not binary revision is available, then configured source
+ code manager is returned. If source code management
+ is disabled or particular source code manager is not enabled,
+ return nil.
+
+ Source code manager for source access may differ from
+ configured source code manager:
+
+ - #sourceCodeManager returns the manager use has configured for
+ this class using preferences
+
+ - #sourceCodeManagerForSourceAccess is the manager used when asking
+ for class source code. It compares version_XXX methods with
+ class's binary revision and. When method_XXX matches the
+ binary revision string, XXX source code manager is returned,
+ as this class has been likely compiled from a source checked out
+ using returned source code manager
+
+ CAVEAT: Now, the code expects that the revision string is in
+ format '$revision ident$SCM'. It won't work for managers that
+ does not use dollar expansion. For, only CVS, SVN and Perforce
+ are used so this code should work
+ "
+
+
+
+
+ revision ifNil:[^self sourceCodeManager].
+
+ AbstractSourceCodeManager availableManagers do:[:mgr|
+ (revision endsWith: mgr managerTypeNameShort) ifTrue:[
+ ^mgr
+ ]
+ ].
+
+ "binary revision is not nil and we haven't found source code manager.
+ This may happen when (i) given source code manager is not available
+ or (ii) source version methods are somehow corrupted.
+
+ Let's be strict about it for now and throw and error. More relaxed
+ version may simply return nil"
+
+"/ self error:'Cannot find source code manager for source access ' ,
+"/ '(manager yet not loaded or binary revision corrupted)'
+"/ mayProceed: true.
+
+ ^nil
+
+
+ "
+ Object sourceCodeManager
+ Object sourceCodeManagerForSourceAccess
+
+ JavaVM sourceCodeManager
+ JavaVM sourceCodeManagerForSourceAccess
+ "
+
+ "Created: / 06-10-2011 / 09:33:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
subclasses
"return a collection of the direct subclasses of the receiver"
"/ use cached information (avoid class hierarchy search), if possible
- (subclasses isNil
+ (subclasses isNil
or:[ subclasses sequenceNumber ~= SubclassCacheSequenceNumber ]) ifTrue:[
- self updateAllCachedSubclasses.
- "subclasses may still be nil - obsolete classes may not be updated"
- ^ subclasses ? #().
+ self updateAllCachedSubclasses.
+ "subclasses may still be nil - obsolete classes may not be updated"
+ ^ subclasses ? #().
].
^ subclasses.
@@ -1895,7 +1966,6 @@
"Modified: 4.6.1997 / 14:48:02 / cg"
! !
-
!Class methodsFor:'changes management'!
addChangeRecordForChangeCategory
@@ -1904,14 +1974,14 @@
"add a category change"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
+ self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addClassDefinitionChangeFor:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addClassDefinitionChangeFor:self
+ ]
]
!
@@ -2611,9 +2681,9 @@
self printClassNameOn:aStream.
aStream nextPutAll:' comment:'.
(comment := self comment) isNil ifTrue:[
- s := ''''''
+ s := ''''''
] ifFalse:[
- s := comment storeString
+ s := comment storeString
].
aStream nextPutAllAsChunk:s.
aStream nextPutChunkSeparator.
@@ -2804,13 +2874,13 @@
primitive functions - if any
"
(s := self primitiveFunctionsString) notNil ifTrue:[
- aStream nextPutChunkSeparator.
- self printClassNameOn:aStream.
- aStream nextPutAll:' primitiveFunctions';
- nextPutChunkSeparator;
- cr.
- aStream nextPutAll:s.
- aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
+ aStream nextPutChunkSeparator.
+ self printClassNameOn:aStream.
+ aStream nextPutAll:' primitiveFunctions';
+ nextPutChunkSeparator;
+ cr.
+ aStream nextPutAll:s.
+ aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
].
!
@@ -2827,7 +2897,7 @@
primitive functions - if any
"
(s := self primitiveFunctionsString) notNil ifTrue:[
- self fileOutPrimitiveFunctionsOn:aStream
+ self fileOutPrimitiveFunctionsOn:aStream
].
"Modified: 8.1.1997 / 17:45:51 / cg"
@@ -3065,26 +3135,26 @@
aStream nextPutAll:' <inst-vars>'.
varNames := self instVarNames.
varNames size > 0 ifTrue:[
- aStream cr.
- varNames do:[:nm |
- aStream nextPutAll:' <name>'.
- aStream nextPutAll:nm.
- aStream nextPutLine:'</name>'.
- ].
- aStream nextPutAll:' '.
+ aStream cr.
+ varNames do:[:nm |
+ aStream nextPutAll:' <name>'.
+ aStream nextPutAll:nm.
+ aStream nextPutLine:'</name>'.
+ ].
+ aStream nextPutAll:' '.
].
aStream nextPutLine:'</inst-vars>'.
aStream nextPutAll:' <class-inst-vars>'.
varNames := self class instVarNames.
varNames size > 0 ifTrue:[
- aStream cr.
- varNames do:[:nm |
- aStream nextPutAll:' <name>'.
- aStream nextPutAll:nm.
- aStream nextPutLine:'</name>'.
- ].
- aStream nextPutAll:' '.
+ aStream cr.
+ varNames do:[:nm |
+ aStream nextPutAll:' <name>'.
+ aStream nextPutAll:nm.
+ aStream nextPutLine:'</name>'.
+ ].
+ aStream nextPutAll:' '.
].
aStream nextPutLine:'</class-inst-vars>'.
@@ -3099,14 +3169,14 @@
aStream nextPutLine:'</class>'.
self classVarNames do:[:nm |
- aStream nextPutLine:'<static>'.
- aStream nextPutAll:' <name>'.
- aStream nextPutAll:nm.
- aStream nextPutLine:'</name>'.
- aStream nextPutAll:' <environment>'.
- aStream nextPutAll:self name.
- aStream nextPutLine:'</environment>'.
- aStream nextPutLine:'</static>'.
+ aStream nextPutLine:'<static>'.
+ aStream nextPutAll:' <name>'.
+ aStream nextPutAll:nm.
+ aStream nextPutLine:'</name>'.
+ aStream nextPutAll:' <environment>'.
+ aStream nextPutAll:self name.
+ aStream nextPutLine:'</environment>'.
+ aStream nextPutLine:'</static>'.
].
!
@@ -3274,7 +3344,6 @@
"
! !
-
!Class methodsFor:'printOut'!
htmlDocumentation
@@ -3562,25 +3631,25 @@
subclassesPerClass := Dictionary new.
Smalltalk allClassesDo:[:each |
- |cls superclass|
-
- cls := each theNonMetaclass.
- (superclass := each superclass) notNil ifTrue:[
- (subclassesPerClass at:superclass ifAbsentPut:makeNewSet) add:cls
- ].
- subclassesPerClass at:cls ifAbsentPut:makeNewSet.
+ |cls superclass|
+
+ cls := each theNonMetaclass.
+ (superclass := each superclass) notNil ifTrue:[
+ (subclassesPerClass at:superclass ifAbsentPut:makeNewSet) add:cls
+ ].
+ subclassesPerClass at:cls ifAbsentPut:makeNewSet.
].
SubclassCacheSequenceNumber isNil ifTrue:[
- SubclassCacheSequenceNumber := 0.
+ SubclassCacheSequenceNumber := 0.
].
seqNr := SubclassCacheSequenceNumber.
subclassesPerClass keysAndValuesDo:[:cls :subclasses |
- |coll|
-
- coll := ArrayWithSequenceNumberValidation withAll:subclasses.
- coll sequenceNumber:seqNr.
- cls setSubclasses:coll.
+ |coll|
+
+ coll := ArrayWithSequenceNumberValidation withAll:subclasses.
+ coll sequenceNumber:seqNr.
+ cls setSubclasses:coll.
].
"
@@ -3645,10 +3714,10 @@
"append a class-remove-record to aStream"
- aStream
- nextPutAll:'Smalltalk removeClass:';
- nextPutAll:oldClass name;
- nextPutChunkSeparator.
+ aStream
+ nextPutAll:'Smalltalk removeClass:';
+ nextPutAll:oldClass name;
+ nextPutChunkSeparator.
!
addChangeRecordForClassRename:oldName to:newName to:aStream
@@ -3656,13 +3725,13 @@
"append a class-rename-record to aStream"
- aStream
- nextPutAll:'Smalltalk renameClass:';
- nextPutAll:oldName;
- nextPutAll:' to:''';
- nextPutAll:newName;
- nextPutAll:'''';
- nextPutChunkSeparator.
+ aStream
+ nextPutAll:'Smalltalk renameClass:';
+ nextPutAll:oldName;
+ nextPutAll:' to:''';
+ nextPutAll:newName;
+ nextPutAll:'''';
+ nextPutChunkSeparator.
"Modified: / 01-06-2012 / 09:44:04 / cg"
!
@@ -3811,15 +3880,15 @@
aPackageID = clsPkg ifTrue:[^ false].
self instAndClassMethodsDo:[:mthd |
- mthd package = aPackageID ifTrue:[ ^ true].
+ mthd package = aPackageID ifTrue:[ ^ true].
].
^ false
"
Smalltalk allClasses
- select:[:each | each hasExtensionsFrom:'stx:goodies/refactyBrowser']
+ select:[:each | each hasExtensionsFrom:'stx:goodies/refactyBrowser']
Smalltalk allClasses
- select:[:each | each hasExtensionsFrom:'stx:libboss']
+ select:[:each | each hasExtensionsFrom:'stx:libboss']
"
"Modified: / 06-03-2007 / 11:55:39 / cg"
@@ -4233,20 +4302,23 @@
If a classes binary is up-to-date w.r.t. the source repository,
the returned string is the same as the one returned by #revision."
- |owner info c|
+ |owner manager info c|
(owner := self owningClass) notNil ifTrue:[^ owner binaryRevision].
revision notNil ifTrue:[
- c := revision first.
- c == $$ ifTrue:[
- info := Class revisionInfoFromString:revision.
- info isNil ifTrue:[^ '0'].
- ^ (info revision) ? '0'.
- ].
- c isDigit ifFalse:[
- ^ '0'
- ].
+ c := revision first.
+ c == $$ ifTrue:[
+ manager := self sourceCodeManagerFromBinaryRevision.
+ manager notNil ifTrue:[
+ info := manager revisionInfoFromString:revision.
+ ].
+ info isNil ifTrue:[^ '0'].
+ ^ (info revision) ? '0'.
+ ].
+ c isDigit ifFalse:[
+ ^ '0'
+ ].
].
^ revision
@@ -4262,13 +4334,14 @@
|classes|
classes := Smalltalk allClasses
- select:[:cls | cls binaryRevision notNil and:[cls binaryRevision ~= cls revision]].
+ select:[:cls | cls binaryRevision notNil and:[cls binaryRevision ~= cls revision]].
SystemBrowser browseClasses:classes title:'classes which are not up-to-date'
"
"Created: / 07-12-1995 / 10:58:47 / cg"
"Modified: / 01-04-1997 / 23:33:01 / stefan"
"Modified: / 22-10-2008 / 20:37:05 / cg"
+ "Modified: / 23-01-2012 / 19:38:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
binaryRevisionString
@@ -4324,11 +4397,11 @@
|owner|
(owner := self owningClass) notNil ifTrue:[^ owner findVersionMethod].
- ^ self findVersionMethodOfManager:self sourceCodeManager
+ ^ self findVersionMethodOfManager:self sourceCodeManagerFromBinaryRevision
"
Smalltalk allClassesDo:[:cls |
- Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
+ Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
].
Number findVersionMethod
@@ -4338,6 +4411,7 @@
"
"Modified: / 19-04-2011 / 13:30:42 / cg"
+ "Modified: / 19-07-2013 / 22:11:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
findVersionMethodOfManager:aSourceCodemanagerOrNil
@@ -4352,41 +4426,41 @@
(owner := self owningClass) notNil ifTrue:[^ owner findVersionMethodOfManager:aSourceCodemanagerOrNil].
tryVersionFromVersionMethod :=
- [:versionMethodsName |
- |aVersionMethod val|
-
- aVersionMethod := meta compiledMethodAt:versionMethodsName.
- (aVersionMethod notNil and:[aVersionMethod isExecutable]) ifTrue:[
- "/
- "/ if it's a method returning the version string,
- "/ that's the returned value
- "/
- val := cls perform:versionMethodsName.
- val isString ifTrue:[^ aVersionMethod].
- ].
- ].
+ [:versionMethodsName |
+ |aVersionMethod val|
+
+ aVersionMethod := meta compiledMethodAt:versionMethodsName.
+ (aVersionMethod notNil and:[aVersionMethod isExecutable]) ifTrue:[
+ "/
+ "/ if it's a method returning the version string,
+ "/ that's the returned value
+ "/
+ val := cls perform:versionMethodsName.
+ val isString ifTrue:[^ aVersionMethod].
+ ].
+ ].
meta := self theMetaclass.
cls := self theNonMetaclass.
- prefixOfVersionMethodSelector :=
- AbstractSourceCodeManager notNil
- ifTrue: [AbstractSourceCodeManager prefixOfVersionMethodSelector ]
- ifFalse:[ 'version_' ]. "/ sigh - for standalone apps without libbasic3
+ prefixOfVersionMethodSelector :=
+ AbstractSourceCodeManager notNil
+ ifTrue: [AbstractSourceCodeManager prefixOfVersionMethodSelector ]
+ ifFalse:[ 'version_' ]. "/ sigh - for standalone apps without libbasic3
allVersionMethodNames := meta methodDictionary keys select:[:sel | sel startsWith:prefixOfVersionMethodSelector].
aSourceCodemanagerOrNil notNil ifTrue:[
- nameOfVersionMethodForManager := aSourceCodemanagerOrNil nameOfVersionMethodInClasses.
- (allVersionMethodNames includes:nameOfVersionMethodForManager) ifTrue:[
- tryVersionFromVersionMethod value:nameOfVersionMethodForManager
- ].
-
- "/ only trust the oldVersion method, iff there is no other scv-version
- "/ (i.e. do not misuse an svn-checked-in #version as a version_cvs)
- (allVersionMethodNames copyWithout:nameOfVersionMethodForManager) notEmpty ifTrue:[
- ^ nil
- ].
+ nameOfVersionMethodForManager := aSourceCodemanagerOrNil nameOfVersionMethodInClasses.
+ (allVersionMethodNames includes:nameOfVersionMethodForManager) ifTrue:[
+ tryVersionFromVersionMethod value:nameOfVersionMethodForManager
+ ].
+
+ "/ only trust the oldVersion method, iff there is no other scv-version
+ "/ (i.e. do not misuse an svn-checked-in #version as a version_cvs)
+ (allVersionMethodNames copyWithout:nameOfVersionMethodForManager) notEmpty ifTrue:[
+ ^ nil
+ ].
].
nameOfOldVersionMethod := self nameOfOldVersionMethod.
@@ -4396,7 +4470,7 @@
"
Smalltalk allClassesDo:[:cls |
- Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
+ Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
].
Number findVersionMethod
@@ -4798,7 +4872,7 @@
repositoryPath - the classes source container
"
- ^ self revisionInfoOfManager:self sourceCodeManager
+ ^ self revisionInfoOfManager:self sourceCodeManagerFromBinaryRevision
"
Object revisionString
@@ -5051,100 +5125,116 @@
"/ or TryLocalSourceFirst is true,
"/ look in standard places first
"/
- ((sourceCodeManager := self sourceCodeManager) isNil
- or:[TryLocalSourceFirst == true]) ifTrue:[
- sourceStream := self localSourceStreamFor:source.
+ "JV@2011-12-08:
+ (i) first check TryLocalSourceFirst, this avoids useless call to
+ #sourceCodeManagerFromBinaryRevision when TryLocalSourceFirst is
+ set (for whatever reason)
+ (ii) do NOT ask source code manager during system startup - source code
+ managers are not configured anyway!! Also, avoids hangups during
+ startup when CVSROOT is set but server is unreacheable.
+ CAVEAT: When somebody modifies the code after compilation and methods
+ are recompiled during startup (for whatever reason), a bad code may
+ used, compilation may fail. However, it may happen anyway as SCM's
+ are not yet configured so the system may use wrong one. Moreover,
+ the source from which the class is compiled may not be the one in
+ repository. I (JV) think this is a good, less confusing compromise.
+ "
+ (TryLocalSourceFirst == true
+ or:[Smalltalk isInitialized not
+ or: [(sourceCodeManager := self sourceCodeManagerFromBinaryRevision) isNil]])
+ ifTrue:[
+ sourceStream := self localSourceStreamFor:source.
+ ].
+
+ sourceStream 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
+
+ sourceCodeManager notNil ifTrue:[
+ classFilename ~= source ifTrue:[
+ package notNil ifTrue:[
+ sep := package indexOfAny:'/\:'.
+ sep ~~ 0 ifTrue:[
+ mod := package copyTo:sep - 1.
+ dir := package copyFrom:sep + 1.
+ sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
+ ]
+ ].
+ ].
+ sourceStream isNil ifTrue:[
+ classFilename isNil ifTrue:[
+ guessedFileName := (Smalltalk fileNameForClass:self) , '.st'.
+ ].
+ source asFilename baseName = (classFilename ? guessedFileName) asFilename baseName ifTrue:[
+ sourceStream := sourceCodeManager getSourceStreamFor:self.
+ ]
+ ].
+ sourceStream notNil ifTrue:[
+ (self validateSourceStream:sourceStream) ifFalse:[
+ ('Class [info]: repositories source for "%1" is invalid.' bindWith:self theNonMetaclass name) errorPrintCR.
+ sourceStream close.
+ sourceStream := nil
+ ] ifTrue:[
+ validated := true.
+ ].
+ ].
+ ]
].
sourceStream 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
-
- sourceCodeManager notNil ifTrue:[
- classFilename ~= source ifTrue:[
- package notNil ifTrue:[
- sep := package indexOfAny:'/\:'.
- sep ~~ 0 ifTrue:[
- mod := package copyTo:sep - 1.
- dir := package copyFrom:sep + 1.
- sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
- ]
- ].
- ].
- sourceStream isNil ifTrue:[
- classFilename isNil ifTrue:[
- guessedFileName := (Smalltalk fileNameForClass:self) , '.st'.
- ].
- source asFilename baseName = (classFilename ? guessedFileName) asFilename baseName ifTrue:[
- sourceStream := sourceCodeManager getSourceStreamFor:self.
- ]
- ].
- sourceStream notNil ifTrue:[
- (self validateSourceStream:sourceStream) ifFalse:[
- ('Class [info]: repositories source for "%1" is invalid.' bindWith:self theNonMetaclass name) errorPrintCR.
- sourceStream close.
- sourceStream := nil
- ] ifTrue:[
- validated := true.
- ].
- ].
- ]
- ].
-
- sourceStream 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|
-
- sourceStream isNil ifTrue:[
- (classes := h classes) notEmptyOrNil ifTrue:[
- (classes includes:self) ifTrue:[
- f := h pathName.
- f := f asFilename directory.
- f := f construct:source.
- f exists ifTrue:[
- sourceStream := f readStreamOrNil.
- ].
- ].
- ].
- ]
- ].
- ].
+ "/
+ "/ 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|
+
+ sourceStream isNil ifTrue:[
+ (classes := h classes) notEmptyOrNil ifTrue:[
+ (classes includes:self) ifTrue:[
+ f := h pathName.
+ f := f asFilename directory.
+ f := f construct:source.
+ f exists ifTrue:[
+ sourceStream := f readStreamOrNil.
+ ].
+ ].
+ ].
+ ]
+ ].
+ ].
].
"/
"/ try along sourcePath
"/
sourceStream isNil ifTrue:[
- sourceStream := self localSourceStreamFor:source.
+ sourceStream := self localSourceStreamFor:source.
].
"/
"/ final chance: try current directory
"/
sourceStream isNil ifTrue:[
- sourceStream := source asFilename readStreamOrNil.
+ sourceStream := source asFilename readStreamOrNil.
].
(sourceStream notNil and:[validated not]) ifTrue:[
- (self validateSourceStream:sourceStream) ifFalse:[
- ('Class [warning]: source for "%1" is invalid or stripped. Take care.' bindWith:self theNonMetaclass name) errorPrintCR.
- sourceStream close.
- sourceStream := nil
- ].
+ (self validateSourceStream:sourceStream) ifFalse:[
+ ('Class [warning]: source for "%1" is invalid or stripped. Take care.' bindWith:self theNonMetaclass name) errorPrintCR.
+ sourceStream close.
+ sourceStream := nil
+ ].
].
"/ (sourceStream notNil and:[sourceStream isFileStream]) ifTrue:[
"/ guessedFileName notNil ifTrue:[
@@ -5159,9 +5249,10 @@
Autoload sourceStream
"
- "Created: / 10.11.1995 / 21:05:13 / cg"
- "Modified: / 22.4.1998 / 19:20:50 / ca"
- "Modified: / 5.11.2001 / 16:36:30 / cg"
+ "Created: / 10-11-1995 / 21:05:13 / cg"
+ "Modified: / 22-04-1998 / 19:20:50 / ca"
+ "Modified: / 05-11-2001 / 16:36:30 / cg"
+ "Modified: / 08-12-2011 / 19:16:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateVersionMethodFor:newRevisionString
@@ -5560,6 +5651,11 @@
^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.632 2013-11-21 15:02:57 stefan Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: Class.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
--- a/ClassDescription.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ClassDescription.st Sun Feb 02 14:16:24 2014 +0000
@@ -697,9 +697,27 @@
!ClassDescription methodsFor:'Compatibility-ST80'!
addInstVarName:anotherInstVar
- |sel newClass args newNames|
-
- newNames := self instanceVariableString , ' ' , anotherInstVar.
+ ^ self addInstVarName:anotherInstVar afterIndex: nil
+
+ "Modified: / 25-02-2009 / 14:51:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 18-01-2011 / 17:57:23 / cg"
+ "Modified: / 31-01-2014 / 02:00:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addInstVarName:anotherInstVar afterIndex: indexOrNil
+ |newClass newNames|
+
+ indexOrNil notNil ifTrue:[
+ | oldNames |
+
+ oldNames := self instVarNames asOrderedCollection.
+ oldNames := oldNames add: anotherInstVar afterIndex: (indexOrNil min: oldNames size).
+ newNames := oldNames asStringWith:' '.
+ ] ifFalse:[
+ newNames := self instanceVariableString , ' ' , anotherInstVar.
+ ].
+
+
self isMeta ifTrue:[
^ self instanceVariableNames:newNames.
@@ -759,8 +777,7 @@
^ newClass
"
- "Modified: / 25-02-2009 / 14:51:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 18-01-2011 / 17:57:23 / cg"
+ "Created: / 31-01-2014 / 01:51:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
organization
@@ -4301,6 +4318,11 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.249 2013-12-12 11:00:17 cg Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/Context.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Context.st Sun Feb 02 14:16:24 2014 +0000
@@ -1776,12 +1776,8 @@
receiverClass := receiver class.
- (receiverClass == SmallInteger or:[receiverClass == Float]) ifTrue:[
- aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '.
- ].
-
- receiverClass isJavaClass ifTrue:[
- receiverClass displayOn:aStream
+ receiverClass theNonMetaclass isJavaClass ifTrue:[
+ receiverClass theNonMetaclass displayOn:aStream
] ifFalse:[
"/ (receiverClass isBehavior
"/ and:[receiverClass isMeta
@@ -1791,6 +1787,7 @@
"/ ] ifFalse:[
"/ receiverClassName := receiverClass name.
"/ ].
+"/
(receiverClass name ? '????') printOn:aStream.
].
@@ -1822,14 +1819,25 @@
implementorClass notNil ifTrue: [
(implementorClass ~~ receiverClass) ifTrue: [
- aStream nextPut:$(.
- (implementorClass name ? '???') printOn:aStream.
+ aStream nextPut:$(.
+ implementorClass isJavaClass ifTrue:[
+ implementorClass displayOn: aStream
+ ] ifFalse:[
+ (implementorClass name ? '???') printOn:aStream.
+ ].
aStream nextPut:$).
]
] ifFalse:[
- self searchClass ~~ receiverClass ifTrue:[
+ | srchClass |
+
+ srchClass := self searchClass.
+ srchClass ~~ receiverClass ifTrue:[
aStream nextPut:$(.
- (self searchClass name ? '???') printOn:aStream.
+ srchClass isJavaClass ifTrue:[
+ srchClass displayOn:aStream.
+ ] ifFalse:[
+ (srchClass name ? '???') printOn:aStream.
+ ].
aStream nextPut:$).
].
"
@@ -1851,7 +1859,7 @@
]
].
- "Modified: / 13-06-2012 / 14:49:33 / cg"
+ "Created: / 23-10-2013 / 11:13:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
receiverPrintString
--- a/ContextError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ContextError.st Sun Feb 02 14:16:24 2014 +0000
@@ -44,5 +44,9 @@
version
^ '$Header: /cvs/stx/stx/libbasic/ContextError.st,v 1.5 2013-12-24 10:39:33 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ContextError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/Continuation.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Continuation.st Sun Feb 02 14:16:24 2014 +0000
@@ -192,5 +192,9 @@
version
^ '$Header: /cvs/stx/stx/libbasic/Continuation.st,v 1.16 2013-07-25 09:37:35 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: Continuation.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/ControlInterrupt.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ControlInterrupt.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
GenericException subclass:#ControlInterrupt
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Control'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Control'
!
!ControlInterrupt class methodsFor:'documentation'!
@@ -40,6 +40,7 @@
"
! !
+
!ControlInterrupt class methodsFor:'initialization'!
initialize
@@ -50,6 +51,7 @@
"
! !
+
!ControlInterrupt class methodsFor:'testing'!
isControlInterrupt
@@ -58,10 +60,15 @@
"Created: / 16.11.2001 / 16:11:11 / cg"
! !
+
!ControlInterrupt class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ControlInterrupt.st,v 1.8 2013-04-27 10:13:40 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ControlInterrupt.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/ControlRequest.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ControlRequest.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Exception subclass:#ControlRequest
@@ -44,5 +43,12 @@
!ControlRequest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ControlRequest.st,v 1.4 2003-10-07 13:25:12 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ControlRequest.st,v 1.4 2003/10/07 13:25:12 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: ControlRequest.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/ConversionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ConversionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#ConversionError
@@ -51,7 +50,14 @@
!ConversionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ConversionError.st,v 1.6 2004-08-22 17:47:16 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ConversionError.st,v 1.6 2004/08/22 17:47:16 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: ConversionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
ConversionError initialize!
+
+
+
--- a/DateConversionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/DateConversionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -43,7 +43,14 @@
!DateConversionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/DateConversionError.st,v 1.1 2008-08-06 09:23:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/DateConversionError.st,v 1.1 2008/08/06 09:23:17 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: DateConversionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
DateConversionError initialize!
+
+
+
--- a/DecodingError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/DecodingError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
CharacterEncoderError subclass:#DecodingError
@@ -38,5 +37,12 @@
!DecodingError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/DecodingError.st,v 1.2 2004-03-09 21:59:09 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/DecodingError.st,v 1.2 2004/03/09 21:59:09 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: DecodingError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/DeepCopyError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/DeepCopyError.st Sun Feb 02 14:16:24 2014 +0000
@@ -50,6 +50,10 @@
version
^ '$Header: /cvs/stx/stx/libbasic/DeepCopyError.st,v 1.2 2013-12-24 10:39:41 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: DeepCopyError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/Dictionary.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Dictionary.st Sun Feb 02 14:16:24 2014 +0000
@@ -1692,7 +1692,6 @@
^ self do:aBlock
! !
-
!Dictionary methodsFor:'printing & storing'!
printElementsDo:aBlock
--- a/DomainError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/DomainError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ArithmeticError subclass:#DomainError
@@ -55,7 +54,14 @@
!DomainError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/DomainError.st,v 1.4 2003-08-29 19:14:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/DomainError.st,v 1.4 2003/08/29 19:14:53 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: DomainError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
DomainError initialize!
+
+
+
--- a/ElementBoundsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ElementBoundsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Error subclass:#ElementBoundsError
@@ -54,7 +53,14 @@
!ElementBoundsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ElementBoundsError.st,v 1.1 2004-04-23 11:16:20 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ElementBoundsError.st,v 1.1 2004/04/23 11:16:20 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: ElementBoundsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
ElementBoundsError initialize!
+
+
+
--- a/EncodedStream.st Sun Feb 02 00:13:55 2014 +0100
+++ b/EncodedStream.st Sun Feb 02 14:16:24 2014 +0000
@@ -15,7 +15,7 @@
instanceVariableNames:'encoder stream'
classVariableNames:''
poolDictionaries:''
- category:'Streams-Misc'
+ category:'Collections-Text-Encodings'
!
!EncodedStream class methodsFor:'documentation'!
@@ -61,13 +61,15 @@
aStream inputStream isPositionable ifTrue:[
encodingSymbol := CharacterEncoder guessEncodingOfStream:aStream inputStream.
- decoder := self encoderFor:encodingSymbol.
+ decoder := CharacterEncoder encoderFor:encodingSymbol.
decoder isNil ifTrue:[
"/ ascii or iso8895-1
^ aStream
].
decodedStream := self stream:aStream encoder:decoder.
- decodedStream skipEncodingChunk.
+ "JV@2012-03-27: NO, DO NOT CHANGE POSITION!! Caller might be interested
+ in all data!!!!!!"
+ "/decodedStream skipEncodingChunk.
] ifFalse:[
"/ setup for no-encoding;
"/ switch to a real encoder later,
@@ -75,15 +77,8 @@
decodedStream := self stream:aStream encoder:CharacterEncoder nullEncoderInstance.
].
^ decodedStream
-!
-encoderFor:anEncodingSymbol
- (anEncodingSymbol isNil
- or:[ anEncodingSymbol = #'iso8859-1'
- or:[ anEncodingSymbol = #'ascii' ]]) ifTrue:[
- ^ nil
- ].
- ^ CharacterEncoder encoderFor:anEncodingSymbol.
+ "Modified: / 23-08-2013 / 17:30:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!EncodedStream methodsFor:'accessing'!
@@ -136,6 +131,163 @@
stream := something.
! !
+!EncodedStream methodsFor:'private fileIn'!
+
+basicFileInNotifying:someone passChunk:passChunk
+ "central method to file in from the receiver, i.e. read chunks and evaluate them -
+ return the value of the last chunk.
+ Someone (which is usually some codeView) is notified of errors."
+
+ |lastValue pkg nameSpace usedNameSpaces
+ packageQuerySignal nameSpaceQuerySignal usedNameSpaceQuerySignal
+ changeDefaultApplicationNotificationSignal
+ defaultApplicationQuerySignal defaultApplication
+ confirmationQuerySignal handledSignals passedSignals askSomeoneForPackage outerContext askForVariableTypeOfUndeclaredQuery|
+
+ self skipSeparators.
+ lastValue := self peek.
+ lastValue == $< ifTrue:[
+ "/ assume, it's an xml file
+ ^ self fileInXMLNotifying:someone passChunk:passChunk.
+ ].
+ lastValue == $# ifTrue:[
+ "assume unix interpreter name:
+ '#!!stx -e' or something like this"
+ self nextPeek == $!! ifTrue:[
+ "skip the unix command line"
+ self nextLine
+ ] ifFalse:[
+ self error:'Invalid chunk start'
+ ]
+ ].
+
+ Smalltalk::Compiler isNil ifTrue:[
+ self isFileStream ifTrue:[
+ Transcript show:('[' , self pathName , '] ').
+ ].
+ Transcript showCR:'cannot fileIn (no compiler).'.
+ ^ nil.
+ ].
+
+ "/ support for V'Age applications
+ defaultApplicationQuerySignal := Class defaultApplicationQuerySignal.
+ changeDefaultApplicationNotificationSignal := Class changeDefaultApplicationNotificationSignal.
+
+ "/ support for ST/X's nameSpaces & packages
+ packageQuerySignal := Class packageQuerySignal.
+ nameSpaceQuerySignal := Class nameSpaceQuerySignal.
+ usedNameSpaceQuerySignal := Class usedNameSpaceQuerySignal.
+
+ (someone respondsTo:#packageToInstall) ifTrue:[
+ pkg := someone packageToInstall.
+ askSomeoneForPackage := true.
+ ] ifFalse:[
+ pkg := packageQuerySignal query.
+ askSomeoneForPackage := false.
+ ].
+ (someone respondsTo:#currentNameSpace) ifTrue:[
+ nameSpace := someone currentNameSpace
+ ] ifFalse:[
+ nameSpace := nameSpaceQuerySignal query.
+ ].
+ (someone respondsTo:#usedNameSpaces) ifTrue:[
+ usedNameSpaces := someone usedNameSpaces
+ ] ifFalse:[
+ usedNameSpaces := usedNameSpaceQuerySignal query.
+ ].
+ (someone respondsTo:#defaultApplication) ifTrue:[
+ defaultApplication := someone defaultApplication
+ ] ifFalse:[
+ defaultApplication := defaultApplicationQuerySignal query.
+ ].
+
+ confirmationQuerySignal := Metaclass confirmationQuerySignal.
+
+ handledSignals := SignalSet new.
+ passedSignals := IdentitySet new.
+
+ handledSignals add:changeDefaultApplicationNotificationSignal.
+ passedSignals add:changeDefaultApplicationNotificationSignal.
+ handledSignals add:defaultApplicationQuerySignal.
+ passedSignals add:defaultApplicationQuerySignal.
+
+ handledSignals add:packageQuerySignal.
+ handledSignals add:usedNameSpaceQuerySignal.
+ handledSignals add:nameSpaceQuerySignal.
+ handledSignals add:confirmationQuerySignal.
+ passedSignals add:confirmationQuerySignal.
+ Parser notNil ifTrue:[
+ "only if libcomp is present"
+ "Also catch a 'Parser askForVariableTypeOfUndeclaredQuery' and proceed with nil.
+ Imagine somebody has autodefine workspace variables on and then
+ evaluate Smalltalk loadPackage:'xyz' that loads code from source (using file-in),
+ certainly we don't want to compile workspace variable access for every
+ not-yet-loaded class in some namespace.
+ This is demonstrated by Regression::CompilerTests2>>test_01
+ and this change actually fixes this test."
+ askForVariableTypeOfUndeclaredQuery := Parser askForVariableTypeOfUndeclaredQuery.
+ handledSignals add:askForVariableTypeOfUndeclaredQuery.
+ ].
+
+
+ outerContext := thisContext.
+
+ handledSignals handle:[:ex |
+ |sig|
+
+ sig := ex creator.
+ ((passedSignals includes:sig) and:[sig isHandledIn:outerContext]) ifTrue:[
+ ex reject
+ ].
+
+ sig == changeDefaultApplicationNotificationSignal ifTrue:[
+ "/ invoked via #becomeDefault to set the defaultApp and the package.
+ "/ (only when filing in V'Age code)
+ defaultApplication := ex parameter.
+ pkg := defaultApplication name asSymbol.
+ ex proceedWith:nil
+ ].
+ sig == defaultApplicationQuerySignal ifTrue:[
+ "/ query for the application to add classes & methods into
+ "/ (only when filing in V'Age code)
+ ex proceedWith:defaultApplication
+ ].
+ sig == packageQuerySignal ifTrue:[
+ "answer the package to use for classes & methods"
+ askSomeoneForPackage ifTrue:[
+ ex proceedWith:someone packageToInstall
+ ] ifFalse:[
+ ex proceedWith:pkg
+ ]
+ ].
+ sig == usedNameSpaceQuerySignal ifTrue:[
+ "answer the nameSpaces to be searched when encountering globals"
+ ex proceedWith:usedNameSpaces
+ ].
+ sig == nameSpaceQuerySignal ifTrue:[
+ "answer the nameSpace to install new classes in"
+ ex proceedWith:nameSpace
+ ].
+ sig == confirmationQuerySignal ifTrue:[
+ "don't pop up dialogs"
+ ex proceedWith:false
+ ].
+ sig == askForVariableTypeOfUndeclaredQuery ifTrue:[
+ "no autodefined variables or so"
+ ex proceedWith:nil.
+ ].
+ ] do:[
+ [self atEnd] whileFalse:[
+ lastValue := self fileInNextChunkNotifying:someone passChunk:passChunk
+ ]
+ ].
+ ^ lastValue
+
+ "Modified: / 10.9.1999 / 16:54:01 / stefan"
+ "Modified: / 16.11.2001 / 16:21:28 / cg"
+ "Modified: / 18-03-2013 / 17:45:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!EncodedStream methodsFor:'stream protocol'!
atEnd
@@ -318,10 +470,6 @@
!EncodedStream methodsFor:'testing'!
-isEncodedStream
- ^ true
-!
-
isReadable
^ stream isReadable
!
@@ -379,6 +527,11 @@
^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.34 2013-08-21 14:07:18 stefan Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: EncodedStream.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
--- a/EncodingError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/EncodingError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
CharacterEncoderError subclass:#EncodingError
@@ -38,5 +37,12 @@
!EncodingError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/EncodingError.st,v 1.2 2004-03-09 21:57:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/EncodingError.st,v 1.2 2004/03/09 21:57:20 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: EncodingError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/EndOfStreamError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/EndOfStreamError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#EndOfStreamError
@@ -64,7 +63,14 @@
!EndOfStreamError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/EndOfStreamError.st,v 1.1 2005-11-16 08:45:55 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/EndOfStreamError.st,v 1.1 2005/11/16 08:45:55 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: EndOfStreamError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
EndOfStreamError initialize!
+
+
+
--- a/EndOfStreamNotification.st Sun Feb 02 00:13:55 2014 +0100
+++ b/EndOfStreamNotification.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Notification subclass:#EndOfStreamNotification
@@ -58,5 +57,12 @@
!EndOfStreamNotification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/EndOfStreamNotification.st,v 1.3 2005-11-16 08:44:41 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/EndOfStreamNotification.st,v 1.3 2005/11/16 08:44:41 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: EndOfStreamNotification.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/Exception.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Exception.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
GenericException subclass:#Exception
@@ -62,6 +61,13 @@
!Exception class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Exception.st,v 1.82 2003-10-07 13:25:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Exception.st,v 1.82 2003/10/07 13:25:24 stefan Exp $'
+
+!
+version_SVN
+ ^ '$Id: Exception.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/ExceptionHandlerSet.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ExceptionHandlerSet.st Sun Feb 02 14:16:24 2014 +0000
@@ -110,6 +110,7 @@
"
! !
+
!ExceptionHandlerSet methodsFor:'Compatibility-VW5.4'!
on:aSignalOrException handle:aHandler
@@ -120,6 +121,7 @@
"Created: / 26.7.1999 / 09:51:37 / stefan"
! !
+
!ExceptionHandlerSet methodsFor:'adding'!
on:anExceptionHandler do:aHandlerBlock
@@ -135,6 +137,7 @@
self at:anExceptionHandler put:aHandlerBlock
! !
+
!ExceptionHandlerSet methodsFor:'queries'!
accepts:anExceptionHandler
@@ -218,6 +221,7 @@
^ false
! !
+
!ExceptionHandlerSet methodsFor:'save evaluation'!
handleDo:aBlock
@@ -316,6 +320,7 @@
"Modified: / 26.7.1999 / 11:36:47 / stefan"
! !
+
!ExceptionHandlerSet methodsFor:'testing'!
isExceptionHandler
@@ -325,9 +330,14 @@
^ true
! !
+
!ExceptionHandlerSet class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ExceptionHandlerSet.st,v 1.18 2013-04-04 09:37:41 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: ExceptionHandlerSet.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/ExecutionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ExecutionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#ExecutionError
@@ -50,7 +49,14 @@
!ExecutionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExecutionError.st,v 1.4 2003-09-05 10:26:58 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExecutionError.st,v 1.4 2003/09/05 10:26:58 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: ExecutionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
ExecutionError initialize!
+
+
+
--- a/ExternalStructure.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ExternalStructure.st Sun Feb 02 14:16:24 2014 +0000
@@ -66,6 +66,7 @@
"
! !
+
!ExternalStructure class methodsFor:'instance creation'!
fromExternalAddress:anExternalAddress
@@ -107,6 +108,7 @@
^ super unprotectedNew:(self sizeof)
! !
+
!ExternalStructure class methodsFor:'queries'!
cType
@@ -122,12 +124,14 @@
self subclassResponsibility
! !
+
!ExternalStructure methodsFor:'private'!
fromExternalAddress:anExternalAddress
self setAddress:(anExternalAddress address) size:(anExternalAddress size).
! !
+
!ExternalStructure class methodsFor:'documentation'!
version
@@ -136,5 +140,9 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/ExternalStructure.st,v 1.5 2013-01-28 18:04:13 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ExternalStructure.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/GenericException.st Sun Feb 02 00:13:55 2014 +0100
+++ b/GenericException.st Sun Feb 02 14:16:24 2014 +0000
@@ -200,8 +200,7 @@
"Modified: / 24.7.1999 / 13:21:25 / stefan"
! !
-
-!GenericException class methodsFor:'Compatibility-ANSI'!
+!GenericException class methodsFor:'Compatibility-Squeak'!
signal
"raise a signal proceedable or nonproceedable (whichever is right).
@@ -210,16 +209,6 @@
^ self raiseSignal
"Created: / 20-11-2006 / 14:00:09 / cg"
-!
-
-signalWith:messageText
- "raise a signal proceedable or nonproceedable (whichever is right).
- The argument is used as messageText.
- ANSI compatibility."
-
- <resource: #skipInDebuggersWalkBack>
-
- self raiseErrorString:messageText
! !
!GenericException class methodsFor:'accessing'!
@@ -865,6 +854,16 @@
raiseWith:aParameter in:aContext
"Modified: / 10-08-2010 / 09:52:38 / cg"
+!
+
+signalWith:messageText
+ "raise a signal proceedable or nonproceedable (whichever is right).
+ The argument is used as messageText.
+ ANSI compatibility."
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self raiseErrorString:messageText
! !
!GenericException class methodsFor:'save evaluation'!
@@ -1097,7 +1096,6 @@
"Modified: / 23.7.1999 / 14:50:11 / stefan"
! !
-
!GenericException methodsFor:'Compatibility-ANSI'!
pass
@@ -2235,6 +2233,8 @@
"actually raise an exception (whatever the proceedability is)."
<context: #return>
+ <resource: #skipInDebuggersWalkBack>
+
raiseContext := thisContext.
suspendedContext isNil ifTrue:[
@@ -2242,6 +2242,8 @@
].
proceedable := self mayProceed.
^ self doRaise
+
+ "Modified: / 19-04-2013 / 09:37:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
raiseWith:aParameter errorString:aString
@@ -2360,6 +2362,11 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.147 2013-08-24 12:24:21 cg Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/Geometric.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Geometric.st Sun Feb 02 14:16:24 2014 +0000
@@ -653,6 +653,10 @@
version
^ '$Header: /cvs/stx/stx/libbasic/Geometric.st,v 1.32 2013-08-31 11:46:29 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: Geometric.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/HaltInterrupt.st Sun Feb 02 00:13:55 2014 +0100
+++ b/HaltInterrupt.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
ControlInterrupt subclass:#HaltInterrupt
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Control'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Control'
!
!HaltInterrupt class methodsFor:'documentation'!
@@ -41,6 +41,7 @@
"
! !
+
!HaltInterrupt class methodsFor:'initialization'!
initialize
@@ -51,10 +52,15 @@
"
! !
+
!HaltInterrupt class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/HaltInterrupt.st,v 1.4 2013-04-27 10:12:51 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: HaltInterrupt.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/HandleRegistry.st Sun Feb 02 00:13:55 2014 +0100
+++ b/HandleRegistry.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Registry subclass:#HandleRegistry
@@ -73,5 +72,12 @@
!HandleRegistry class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/HandleRegistry.st,v 1.9 2002-03-04 19:15:09 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/HandleRegistry.st,v 1.9 2002/03/04 19:15:09 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: HandleRegistry.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/IdentityDictionary.st Sun Feb 02 00:13:55 2014 +0100
+++ b/IdentityDictionary.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Dictionary subclass:#IdentityDictionary
@@ -163,6 +162,7 @@
"Created: 19.3.1997 / 15:03:36 / cg"
! !
+
!IdentityDictionary methodsFor:'testing'!
includesValue:aValue
@@ -191,5 +191,12 @@
!IdentityDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/IdentityDictionary.st,v 1.30 2002-11-29 11:08:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/IdentityDictionary.st,v 1.30 2002/11/29 11:08:54 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: IdentityDictionary.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/ImaginaryResultError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ImaginaryResultError.st Sun Feb 02 14:16:24 2014 +0000
@@ -55,7 +55,10 @@
!ImaginaryResultError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ImaginaryResultError.st,v 1.2 2003-08-29 19:15:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ImaginaryResultError.st,v 1.2 2003/08/29 19:15:11 cg Exp $'
! !
ImaginaryResultError initialize!
+
+
+
--- a/IncompleteNextCountError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/IncompleteNextCountError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#IncompleteNextCountError
@@ -64,7 +63,14 @@
!IncompleteNextCountError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/IncompleteNextCountError.st,v 1.2 2003-08-29 19:14:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/IncompleteNextCountError.st,v 1.2 2003/08/29 19:14:43 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: IncompleteNextCountError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
IncompleteNextCountError initialize!
+
+
+
--- a/IndexNotFoundError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/IndexNotFoundError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
NotFoundError subclass:#IndexNotFoundError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!IndexNotFoundError class methodsFor:'documentation'!
@@ -40,6 +40,7 @@
"
! !
+
!IndexNotFoundError class methodsFor:'initialization'!
initialize
@@ -50,10 +51,15 @@
"
! !
+
!IndexNotFoundError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/IndexNotFoundError.st,v 1.4 2013-04-27 10:06:42 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: IndexNotFoundError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/InvalidByteCodeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidByteCodeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
InvalidCodeError subclass:#InvalidByteCodeError
@@ -50,7 +49,14 @@
!InvalidByteCodeError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidByteCodeError.st,v 1.4 2003-09-05 10:28:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidByteCodeError.st,v 1.4 2003/09/05 10:28:30 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidByteCodeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
InvalidByteCodeError initialize!
+
+
+
--- a/InvalidCodeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidCodeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ExecutionError subclass:#InvalidCodeError
@@ -50,7 +49,14 @@
!InvalidCodeError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidCodeError.st,v 1.4 2003-09-05 10:27:13 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidCodeError.st,v 1.4 2003/09/05 10:27:13 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidCodeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
InvalidCodeError initialize!
+
+
+
--- a/InvalidEncodingError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidEncodingError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
DecodingError subclass:#InvalidEncodingError
@@ -44,5 +43,12 @@
!InvalidEncodingError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidEncodingError.st,v 1.3 2004-03-09 22:00:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidEncodingError.st,v 1.3 2004/03/09 22:00:59 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidEncodingError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/InvalidInstructionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidInstructionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
InvalidCodeError subclass:#InvalidInstructionError
@@ -50,7 +49,14 @@
!InvalidInstructionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidInstructionError.st,v 1.4 2003-09-05 10:27:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidInstructionError.st,v 1.4 2003/09/05 10:27:30 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidInstructionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
InvalidInstructionError initialize!
+
+
+
--- a/InvalidModeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidModeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#InvalidModeError
@@ -38,5 +37,12 @@
!InvalidModeError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidModeError.st,v 1.2 2005-02-02 10:59:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidModeError.st,v 1.2 2005/02/02 10:59:58 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidModeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/InvalidOperationError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidOperationError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#InvalidOperationError
@@ -38,5 +37,12 @@
!InvalidOperationError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidOperationError.st,v 1.2 2005-02-02 11:02:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidOperationError.st,v 1.2 2005/02/02 11:02:30 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidOperationError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/InvalidReadError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidReadError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ReadError subclass:#InvalidReadError
@@ -44,5 +43,12 @@
!InvalidReadError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidReadError.st,v 1.3 2005-02-02 11:02:06 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidReadError.st,v 1.3 2005/02/02 11:02:06 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidReadError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/InvalidWriteError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/InvalidWriteError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
WriteError subclass:#InvalidWriteError
@@ -44,5 +43,12 @@
!InvalidWriteError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InvalidWriteError.st,v 1.3 2005-02-02 11:03:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InvalidWriteError.st,v 1.3 2005/02/02 11:03:13 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: InvalidWriteError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/KeyNotFoundError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/KeyNotFoundError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
NotFoundError subclass:#KeyNotFoundError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!KeyNotFoundError class methodsFor:'documentation'!
@@ -40,6 +40,7 @@
"
! !
+
!KeyNotFoundError class methodsFor:'initialization'!
initialize
@@ -50,10 +51,15 @@
"
! !
+
!KeyNotFoundError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/KeyNotFoundError.st,v 1.2 2013-04-27 10:08:37 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: KeyNotFoundError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/LargeFloat.st Sun Feb 02 00:13:55 2014 +0100
+++ b/LargeFloat.st Sun Feb 02 14:16:24 2014 +0000
@@ -735,7 +735,10 @@
!LargeFloat class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LargeFloat.st,v 1.7 2004-11-12 12:23:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LargeFloat.st,v 1.7 2004/11/12 12:23:46 cg Exp $'
! !
LargeFloat initialize!
+
+
+
--- a/LibraryDefinition.st Sun Feb 02 00:13:55 2014 +0100
+++ b/LibraryDefinition.st Sun Feb 02 14:16:24 2014 +0000
@@ -34,6 +34,12 @@
"
! !
+
+!LibraryDefinition class methodsFor:'code generation'!
+
+ !
+
+
!LibraryDefinition class methodsFor:'description - compilation'!
primaryTarget
@@ -42,6 +48,7 @@
^ 'classLibRule'
! !
+
!LibraryDefinition class methodsFor:'description - project information'!
description
@@ -73,6 +80,7 @@
"Created: / 21-12-2010 / 09:28:59 / cg"
! !
+
!LibraryDefinition class methodsFor:'file generation'!
basicFileNamesToGenerate
@@ -116,6 +124,7 @@
"Modified: / 19-09-2006 / 22:41:40 / cg"
! !
+
!LibraryDefinition class methodsFor:'file mappings'!
bc_dot_mak_mappings
@@ -185,6 +194,7 @@
"Modified: / 14-09-2006 / 18:58:07 / cg"
! !
+
!LibraryDefinition class methodsFor:'file mappings support'!
commonSymbolsFlag
@@ -230,6 +240,7 @@
"Modified: / 14-09-2006 / 14:19:59 / cg"
! !
+
!LibraryDefinition class methodsFor:'file templates'!
bc_dot_def
@@ -323,19 +334,26 @@
%(ADDITIONAL_RULES)
+
%(ADDITIONAL_HEADERRULES)
+test: $(TOP)\goodies\builder\reports\NUL
+ pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
+ $(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
+
clean::
del *.$(CSUFFIX)
+
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
%(DEPENDENCIES)
# ENDMAKEDEPEND --- do not remove this line
-'
+%(ADDITIONAL_RULES_HG)'
"Created: / 09-08-2006 / 11:44:20 / fm"
"Modified: / 09-08-2006 / 19:59:32 / fm"
"Modified: / 26-07-2012 / 00:57:20 / cg"
+ "Modified: / 28-11-2012 / 10:18:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionLine_libInit_dot_cc
@@ -463,8 +481,17 @@
%(ADDITIONAL_RULES_SVN)
+%(ADDITIONAL_RULES_HG)
+
%(ADDITIONAL_HEADERRULES)
+# run default testsuite for this package
+test: $(TOP)/goodies/builder/reports
+ $(MAKE) -C $(TOP)/goodies/builder/reports
+ $(TOP)/goodies/builder/reports/report-runner.sh -D . -r Builder::TestReport -p $(PACKAGE)
+
+
+
# add more install actions here
install::
@@ -526,6 +553,7 @@
"Modified: / 09-08-2006 / 16:50:23 / fm"
"Modified: / 24-06-2009 / 21:39:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 26-07-2012 / 00:57:29 / cg"
+ "Modified: / 28-11-2012 / 10:19:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
vc_dot_def
@@ -560,6 +588,7 @@
"Modified: / 08-08-2006 / 19:33:14 / fm"
! !
+
!LibraryDefinition class methodsFor:'misc ui support'!
iconInBrowserSymbol
@@ -575,6 +604,7 @@
"/ ].
! !
+
!LibraryDefinition class methodsFor:'obsolete'!
lib_dot_rc
@@ -630,12 +660,14 @@
"Modified: / 24-01-2012 / 18:35:45 / cg"
! !
+
!LibraryDefinition class methodsFor:'queries'!
projectType
^ LibraryType
! !
+
!LibraryDefinition class methodsFor:'sanity checks'!
searchForInconsistencies
@@ -666,6 +698,7 @@
"Created: / 09-08-2006 / 16:31:54 / fm"
! !
+
!LibraryDefinition class methodsFor:'testing'!
isAbstract
@@ -684,6 +717,7 @@
"Created: / 23-08-2006 / 15:17:50 / cg"
! !
+
!LibraryDefinition class methodsFor:'documentation'!
version
--- a/Link.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Link.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,6 +9,7 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+"{ Package: 'stx:libbasic' }"
Object subclass:#Link
instanceVariableNames:'nextLink'
@@ -62,5 +63,12 @@
!Link class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Link.st,v 1.12 1996-04-25 16:16:29 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Link.st,v 1.12 1996/04/25 16:16:29 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: Link.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/Lookup.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Lookup.st Sun Feb 02 14:16:24 2014 +0000
@@ -106,6 +106,15 @@
!
lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext
+
+ <resource: #obsolete>
+
+ "
+ This method is no longer sent by the VM as it nows pass
+ inline/poly cache object.
+ "
+
+
"invoked by the VM to ask me for a method to call.
The arguments are: the selector, receiver and arguments,
the class to start the search in (for here-, super and directed sends)
@@ -128,6 +137,44 @@
directedTo: initialSearchClass
+!
+
+lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext ilc: ilcCache
+
+ "Invoked by the VM to ask me for a method to call.
+ The arguments are: the selector, receiver and arguments,
+ the class to start the search in (for here-, super and directed sends)
+ the sending context and the inline/poly cache (instance of
+ PolymorphicInlineCache).
+
+ The returned method object will NOT be put into the inline- and
+ polyCache bu default. To update the call site's cache, you have to
+ call ilcCache bindTo: method forClass: initialSearch class. If you
+ dont call it, inline/poly cache won't be updated and next call
+ won't be cached (therefore it will be relatively slow.
+
+ If I return nil, a doesNotUnderstand: will be send."
+
+
+ | method |
+
+ "Following C code is just a performance optimization.
+ It is not neccessary, however it speeds up UI code,
+ since it heavily uses perform:"
+
+%{
+ method = __lookup(initialSearchClass, selector);
+ if ( method ) {
+ __ilcBind(ilcCache, initialSearchClass, method, selector);
+ }
+ RETURN (method);
+%}.
+
+ method := self lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext.
+ ilcCache bindTo: method forClass: initialSearchClass.
+ ^ method.
+
+ "Created: / 01-10-2011 / 13:18:40 / Jan Kurs <kursjan@fit.cvut.cz>"
! !
!Lookup class methodsFor:'documentation'!
@@ -137,7 +184,7 @@
!
version_SVN
- ^ 'Id: Lookup.st,v 1.1 2011/06/28 10:51:38 vrany Exp '
+ ^ '$Id: Lookup.st 10722 2011-10-13 15:42:52Z vranyj1 $'
! !
Lookup initialize!
--- a/MacFilename.st Sun Feb 02 00:13:55 2014 +0100
+++ b/MacFilename.st Sun Feb 02 14:16:24 2014 +0000
@@ -64,5 +64,8 @@
!MacFilename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MacFilename.st,v 1.1 1997-09-17 17:43:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MacFilename.st,v 1.1 1997/09/17 17:43:58 cg Exp $'
! !
+
+
+
--- a/Make.proto Sun Feb 02 00:13:55 2014 +0100
+++ b/Make.proto Sun Feb 02 14:16:24 2014 +0000
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.266 2013-08-24 12:29:07 cg Exp $
+# $Header$
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libbasic.
@@ -92,6 +92,22 @@
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+ifneq (**NOHG**, $(shell hg root 2> /dev/null || echo -n '**NOHG**'))
+stx_libbasic.$(O): $(shell hg root)/.hg/dirstate
+endif
+
+
+
+
+# run default testsuite for this package
+test: $(TOP)/goodies/builder/reports
+ $(MAKE) -C $(TOP)/goodies/builder/reports
+ $(TOP)/goodies/builder/reports/report-runner.sh -D . -r Builder::TestReport -p $(PACKAGE)
+
+
# add more install actions here
install::
@@ -162,6 +178,7 @@
$(OUTDIR)OSProcess.$(O) OSProcess.$(H): OSProcess.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ObjectMemory.$(O) ObjectMemory.$(H): ObjectMemory.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PackageId.$(O) PackageId.$(H): PackageId.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PolymorphicInlineCache.$(O) PolymorphicInlineCache.$(H): PolymorphicInlineCache.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ProcessorScheduler.$(O) ProcessorScheduler.$(H): ProcessorScheduler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ProgrammingLanguage.$(O) ProgrammingLanguage.$(H): ProgrammingLanguage.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)Project.$(O) Project.$(H): Project.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -349,7 +366,7 @@
$(OUTDIR)ByteArray.$(O) ByteArray.$(H): ByteArray.st $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)CharacterArray.$(O) CharacterArray.$(H): CharacterArray.st $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)CharacterWriteStream.$(O) CharacterWriteStream.$(H): CharacterWriteStream.st $(INCLUDE_TOP)/stx/libbasic/WriteStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)Class.$(O) Class.$(H): Class.st $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Array.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Association.$(H) $(INCLUDE_TOP)/stx/libbasic/LookupKey.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(STCHDR)
+$(OUTDIR)Class.$(O) Class.$(H): Class.st $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Association.$(H) $(INCLUDE_TOP)/stx/libbasic/LookupKey.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Array.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(STCHDR)
$(OUTDIR)ContextError.$(O) ContextError.$(H): ContextError.st $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ConversionError.$(O) ConversionError.$(H): ConversionError.st $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)DeepCopyError.$(O) DeepCopyError.$(H): DeepCopyError.st $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
--- a/Make.spec Sun Feb 02 00:13:55 2014 +0100
+++ b/Make.spec Sun Feb 02 14:16:24 2014 +0000
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/Make.spec,v 1.147 2013-08-24 12:29:04 cg Exp $
+# $Header$
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libbasic.
@@ -97,6 +97,7 @@
OSProcess \
ObjectMemory \
PackageId \
+ PolymorphicInlineCache \
ProcessorScheduler \
ProgrammingLanguage \
Project \
@@ -447,6 +448,7 @@
$(OUTDIR_SLASH)OSProcess.$(O) \
$(OUTDIR_SLASH)ObjectMemory.$(O) \
$(OUTDIR_SLASH)PackageId.$(O) \
+ $(OUTDIR_SLASH)PolymorphicInlineCache.$(O) \
$(OUTDIR_SLASH)ProcessorScheduler.$(O) \
$(OUTDIR_SLASH)ProgrammingLanguage.$(O) \
$(OUTDIR_SLASH)Project.$(O) \
--- a/MallocFailure.st Sun Feb 02 00:13:55 2014 +0100
+++ b/MallocFailure.st Sun Feb 02 14:16:24 2014 +0000
@@ -41,9 +41,14 @@
"
! !
+
!MallocFailure class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/MallocFailure.st,v 1.3 2013-03-13 23:47:08 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: MallocFailure.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/MappedExternalBytes.st Sun Feb 02 00:13:55 2014 +0100
+++ b/MappedExternalBytes.st Sun Feb 02 14:16:24 2014 +0000
@@ -83,5 +83,8 @@
!MappedExternalBytes class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MappedExternalBytes.st,v 1.3 2007-02-22 15:27:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MappedExternalBytes.st,v 1.3 2007/02/22 15:27:19 cg Exp $'
! !
+
+
+
--- a/MetaNumber.st Sun Feb 02 00:13:55 2014 +0100
+++ b/MetaNumber.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Number subclass:#MetaNumber
@@ -119,5 +118,12 @@
!MetaNumber class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MetaNumber.st,v 1.1 2003-06-21 10:12:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MetaNumber.st,v 1.1 2003/06/21 10:12:21 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: MetaNumber.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/Metaclass.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Metaclass.st Sun Feb 02 14:16:24 2014 +0000
@@ -876,6 +876,14 @@
"Created: / 01-07-2011 / 10:55:39 / cg"
!
+sourceCodeManagerFromBinaryRevision
+
+ ^ myClass sourceCodeManagerFromBinaryRevision
+
+ "Modified: / 01-04-1997 / 14:36:31 / stefan"
+ "Created: / 06-10-2011 / 09:34:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
sourceFileSuffix
^ self programmingLanguage sourceFileSuffix
--- a/Method.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Method.st Sun Feb 02 14:16:24 2014 +0000
@@ -11,7 +11,7 @@
"
"{ Package: 'stx:libbasic' }"
-CompiledCode variableSubclass:#Method
+CompiledCode subclass:#Method
instanceVariableNames:'source sourcePosition category package mclass lookupObject
annotations'
classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName
@@ -219,7 +219,6 @@
^ PrivateMethodSignal
! !
-
!Method class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -396,7 +395,6 @@
^ self sends:aSelectorSymbol
! !
-
!Method methodsFor:'accessing'!
category
@@ -588,17 +586,39 @@
!
overriddenMethod
+ <resource: #obsolete>
+
+ self obsoleteMethodWarning: 'Use overwrittenMethod instead, stupid naming'.
+ ^self overwrittenMethod
+
+ "Created: / 17-06-2009 / 19:09:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified (format): / 18-11-2011 / 14:48:07 / cg"
+ "Modified: / 05-07-2012 / 10:51:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+overriddenMethod: aMethod
+ <resource: #obsolete>
+
+ self obsoleteMethodWarning: 'Use overwrittenMethod: instead, stupid naming'.
+ self overwrittenMethod: aMethod
+
+ "Created: / 17-06-2009 / 19:09:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 22-08-2009 / 10:47:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 18-11-2011 / 14:48:26 / cg"
+ "Modified: / 05-07-2012 / 10:51:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+overwrittenMethod
"Answers overridden method or nil."
Overrides isNil ifTrue:[^ nil].
^ (Overrides includesKey: self)
ifTrue:[Overrides at: self]
- "Created: / 17-06-2009 / 19:09:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified (format): / 18-11-2011 / 14:48:07 / cg"
+ "Created: / 05-07-2012 / 10:49:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-overriddenMethod: aMethod
+overwrittenMethod: aMethod
"Set overridden method to aMethod"
@@ -606,9 +626,7 @@
aMethod notNil ifTrue:[aMethod makeLocalStringSource].
Overrides at: self put: aMethod
- "Created: / 17-06-2009 / 19:09:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 22-08-2009 / 10:47:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 18-11-2011 / 14:48:26 / cg"
+ "Created: / 05-07-2012 / 10:50:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
package
@@ -650,17 +668,29 @@
self makeLocalStringSource.
package := newPackage.
- (cls := self mclass) notNil ifTrue:[
- "/ nil for wrapped methods
- self changed:#package. "/ will vanish
- cls changed:#methodPackage with:self selector. "/ will vanish
-
- Smalltalk changed:#projectOrganization with:(Array with:cls with:self with:oldPackage).
- cls addChangeRecordForMethodPackage:self package:newPackage.
- ]
+ cls := self mclass.
+ "JV@2011-01-27: BUG FIX: method may be wrapped (breakpoint on it).
+ Search for the wrapper, if none is found, return immediately
+ (avoids DNU)"
+ cls isNil ifTrue:[
+ | wrapper |
+
+ wrapper := self wrapper.
+ wrapper isNil ifTrue:[ ^ self ].
+ cls := wrapper mclass.
+ cls isNil ifTrue:[ ^ self ].
+ ].
+
+ self changed:#package. "/ will vanish
+ cls changed:#methodPackage with:self selector. "/ will vanish
+
+ Smalltalk changed:#projectOrganization with:(Array with:cls with:self with:oldPackage).
+ cls addChangeRecordForMethodPackage:self package:newPackage.
]
"Modified: / 23-11-2006 / 17:01:02 / cg"
+ "Modified: / 27-01-2012 / 17:15:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-01-2012 / 21:22:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setAnnotations: anObject
@@ -749,7 +779,11 @@
"Cache the source of recently used methods"
chunk notNil ifTrue:[
- UserPreferences current keepMethodSourceCode ifTrue:[
+ "JV@2013-08-19: Don't consult UserPreferences if the system is initilizing. This may
+ lead in funny side-effect as #initializeDefaultPreferences is called which tries to
+ initialize some colors. But Color itsels is likely not yet initialized, so DNU is
+ thrown."
+ (Smalltalk isInitialized and:[UserPreferences current keepMethodSourceCode]) ifTrue:[
source := chunk.
sourcePosition := nil.
^ source.
@@ -1035,9 +1069,7 @@
#endif
%}.
^ false
-! !
-
-!Method privateMethodsFor:'accessing-visibility'!
+!
primSetPrivacy:aSymbol
"set the methods access rights (privacy) from a symbol;
@@ -1080,9 +1112,7 @@
^ true
"Modified: 27.8.1995 / 22:58:08 / claus"
-! !
-
-!Method methodsFor:'accessing-visibility'!
+!
privacy
"return a symbol describing the methods access rights (privacy);
@@ -1831,7 +1861,6 @@
"Modified: 4.11.1996 / 22:58:28 / cg"
! !
-
!Method methodsFor:'printing & storing'!
printOn:aStream
@@ -2027,7 +2056,7 @@
You have to close the stream, if usingCacheBoolean is false, and should not close it
if usingCacheBoolean is true."
- |aStream fileName who myClass mgr className classNameSymbol dir mod|
+ |aStream fileName who myClass mgr className classNameSymbol dir mod pkgDef |
"
if sourcePosition is nonNil, its the fileName and
@@ -2089,7 +2118,21 @@
"/
"/ if there is no SourceManager, look in local standard places first
"/
- (Class tryLocalSourceFirst or:[(mgr := Smalltalk at:#SourceCodeManager) isNil]) ifTrue:[
+ (mclass notNil and:[package == mclass package]) ifTrue:[
+ mgr := mclass sourceCodeManagerFromBinaryRevision
+ ] ifFalse:[
+ "I'm an extension and we don't have binary revision info (!!)
+ for extensions, try tp guess here"
+ pkgDef := ProjectDefinition definitionClassForPackage: package.
+ pkgDef notNil ifTrue:[
+ mgr := pkgDef sourceCodeManagerFromBinaryRevision
+ ] ifFalse:[
+ "OK, trust the configuration"
+ mgr := AbstractSourceCodeManager managerForPackage: package
+ ]
+ ].
+
+ (Class tryLocalSourceFirst or:[mgr isNil]) ifTrue:[
aStream := self localSourceStream.
aStream notNil ifTrue:[
usingCacheBoolean ifTrue:[
@@ -2919,15 +2962,25 @@
!
overrides: aMethod
+ <resource: #obsolete>
+
+ self obsoleteMethodWarning: 'Use overwrites: instead, stupid naming'.
+ self overwrites: aMethod.
+
+ "Modified: / 18-06-2009 / 12:15:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 05-07-2012 / 10:52:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+overwrites: aMethod
| mth |
- mth := self overriddenMethod.
+ mth := self overwrittenMethod.
[ mth notNil ] whileTrue:
[mth == aMethod ifTrue:[^true].
- mth := mth overriddenMethod].
+ mth := mth overwrittenMethod].
^false
- "Modified: / 18-06-2009 / 12:15:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 05-07-2012 / 10:52:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parse:parseSelector return:accessSelector or:valueIfNoSource
@@ -3808,6 +3861,11 @@
^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.426 2013-10-18 20:57:03 cg Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: Method.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MethodOverrideTests.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,61 @@
+'From Smalltalk/X, Version:6.1.1 on 02-07-2010 at 08:40:49 AM' !
+
+"{ Package: 'stx:libbasic' }"
+
+TestCase subclass:#MethodOverrideTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Tests'
+!
+
+
+!MethodOverrideTests methodsFor:'initialization & release'!
+
+tearDown
+
+ #(methodToBeOverriden_1) do:
+ [:sel|
+ (self respondsTo: sel) ifTrue:
+ [self class removeSelector: sel]].
+
+ "Created: / 17-06-2009 / 19:36:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!MethodOverrideTests methodsFor:'tests'!
+
+test_01
+
+ | oldMethod newMethod |
+ '"{ Package: ''stx:libbasic'' }"
+ !!
+ !!MethodOverridesTest methodsFor:''mock methods''!!
+
+ methodToBeOverriden_1
+ ^0
+ !! !!' readStream fileIn.
+ oldMethod := self class compiledMethodAt:#methodToBeOverriden_1.
+ self assert: self methodToBeOverriden_1 = 0.
+
+
+ '"{ Package: ''stx:goodies/sunit'' }"
+ !!
+ !!MethodOverridesTest methodsFor:''mock methods''!!
+
+ methodToBeOverriden_1
+ ^1
+ !! !!' readStream fileIn.
+
+ self assert: self methodToBeOverriden_1 = 1.
+ newMethod := self class compiledMethodAt:#methodToBeOverriden_1.
+
+ self assert: newMethod overridenMethod == oldMethod.
+
+ "Created: / 17-06-2009 / 19:27:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!MethodOverrideTests class methodsFor:'documentation'!
+
+version
+ ^'$Id: MethodOverrideTests.st 10717 2011-10-11 15:53:59Z vranyj1 $'
+! !
--- a/MiniInspector.st Sun Feb 02 00:13:55 2014 +0100
+++ b/MiniInspector.st Sun Feb 02 14:16:24 2014 +0000
@@ -44,6 +44,7 @@
"
! !
+
!MiniInspector class methodsFor:'instance creation'!
openOn:anObject
@@ -54,6 +55,7 @@
^ anInspector
! !
+
!MiniInspector methodsFor:'private'!
commandLoop
@@ -259,9 +261,14 @@
"Modified: 20.5.1996 / 10:27:45 / cg"
! !
+
!MiniInspector class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/MiniInspector.st,v 1.28 2014-01-23 16:11:52 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: MiniInspector.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/MiniLogger.st Sun Feb 02 00:13:55 2014 +0100
+++ b/MiniLogger.st Sun Feb 02 14:16:24 2014 +0000
@@ -34,6 +34,7 @@
"
! !
+
!MiniLogger class methodsFor:'instance creation'!
instance
@@ -52,6 +53,7 @@
"Created: / 14-09-2011 / 21:27:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!MiniLogger class methodsFor:'class initialization'!
initialize
@@ -61,6 +63,7 @@
"Created: / 01-09-2011 / 12:26:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!MiniLogger methodsFor:'logging'!
facilityOf: originator
@@ -165,6 +168,7 @@
"Modified: / 15-03-2013 / 11:20:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!MiniLogger class methodsFor:'documentation'!
version
--- a/NaiveRomanNumberFormatNotification.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NaiveRomanNumberFormatNotification.st Sun Feb 02 14:16:24 2014 +0000
@@ -49,5 +49,8 @@
!NaiveRomanNumberFormatNotification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NaiveRomanNumberFormatNotification.st,v 1.3 2008-08-06 09:53:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NaiveRomanNumberFormatNotification.st,v 1.3 2008/08/06 09:53:07 cg Exp $'
! !
+
+
+
--- a/NoByteCodeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NoByteCodeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
InvalidCodeError subclass:#NoByteCodeError
@@ -50,7 +49,14 @@
!NoByteCodeError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NoByteCodeError.st,v 1.4 2003-09-05 10:27:06 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NoByteCodeError.st,v 1.4 2003/09/05 10:27:06 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: NoByteCodeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
NoByteCodeError initialize!
+
+
+
--- a/NonBooleanReceiverError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NonBooleanReceiverError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ExecutionError subclass:#NonBooleanReceiverError
@@ -50,7 +49,14 @@
!NonBooleanReceiverError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NonBooleanReceiverError.st,v 1.4 2003-09-05 10:27:38 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NonBooleanReceiverError.st,v 1.4 2003/09/05 10:27:38 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: NonBooleanReceiverError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
NonBooleanReceiverError initialize!
+
+
+
--- a/NonIntegerIndexError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NonIntegerIndexError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
IndexNotFoundError subclass:#NonIntegerIndexError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!NonIntegerIndexError class methodsFor:'documentation'!
@@ -41,6 +41,7 @@
"
! !
+
!NonIntegerIndexError class methodsFor:'initialization'!
initialize
@@ -51,10 +52,15 @@
"
! !
+
!NonIntegerIndexError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/NonIntegerIndexError.st,v 1.4 2013-04-27 10:04:41 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: NonIntegerIndexError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/NotANumber.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NotANumber.st Sun Feb 02 14:16:24 2014 +0000
@@ -157,7 +157,10 @@
!NotANumber class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NotANumber.st,v 1.2 2003-07-02 09:52:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NotANumber.st,v 1.2 2003/07/02 09:52:32 cg Exp $'
! !
NotANumber initialize!
+
+
+
--- a/NotFoundError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NotFoundError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#NotFoundError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!NotFoundError class methodsFor:'documentation'!
@@ -40,6 +40,7 @@
"
! !
+
!NotFoundError class methodsFor:'initialization'!
initialize
@@ -50,10 +51,15 @@
"
! !
+
!NotFoundError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/NotFoundError.st,v 1.5 2013-04-27 10:05:48 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: NotFoundError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/Number.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Number.st Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
ArithmeticValue subclass:#Number
- instanceVariableNames:''
- classVariableNames:'DecimalPointCharacter DecimalPointCharacterForPrinting
+ instanceVariableNames: ''
+ classVariableNames: 'DecimalPointCharacter DecimalPointCharacterForPrinting
DecimalPointCharacters DecimalPointCharactersForReading'
- poolDictionaries:''
- category:'Magnitude-Numbers'
+ poolDictionaries: ''
+ category: 'Magnitude-Numbers'
!
!Number class methodsFor:'documentation'!
@@ -24,7 +24,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -53,6 +53,7 @@
"
! !
+
!Number class methodsFor:'instance creation'!
fastFromString:aString
@@ -308,9 +309,6 @@
Number readFrom:'16rAAAAFFFFAAAAFFFF'
Number readFrom:'0.000001'
'+00000123.45' asNumber
- Number readFrom:'(1/3)'
- Number readFrom:'(-1/3)'
- Number readFrom:'(-1/3'
Number readFrom:'99s'
Number readFrom:'99.00s'
Number readFrom:'99.0000000s'
@@ -581,6 +579,7 @@
^ self subclassResponsibility
! !
+
!Number class methodsFor:'error reporting'!
raise:aSignalSymbolOrErrorClass receiver:someNumber selector:sel arg:arg errorString:text
@@ -732,6 +731,7 @@
"Modified: / 14.4.1998 / 18:47:47 / cg"
! !
+
!Number class methodsFor:'queries'!
isAbstract
@@ -745,14 +745,15 @@
!Number methodsFor:'*StateSpecs-Specs'!
isEqual: aNumber within: accuracy
- ^(self - aNumber) abs < accuracy
+ ^(self - aNumber) abs < accuracy
! !
+
!Number methodsFor:'*grease-core'!
greaseInteger
- "Answer an integer of the receiver, in our case we simply truncate the number."
- ^ self truncated
+ "Answer an integer of the receiver, in our case we simply truncate the number."
+ ^ self truncated
! !
!Number methodsFor:'Compatibility-Squeak'!
@@ -878,7 +879,7 @@
!
newTileMorphRepresentative
- ^ TileMorph new addArrows; setLiteral: self; addSuffixIfCan
+ ^ TileMorph new addArrows; setLiteral: self; addSuffixIfCan
!
rounded:n
@@ -919,6 +920,7 @@
"
! !
+
!Number methodsFor:'converting'!
% aNumber
@@ -1077,6 +1079,7 @@
"
! !
+
!Number methodsFor:'converting-times'!
days
@@ -1154,6 +1157,7 @@
"Created: / 05-09-2011 / 11:17:59 / cg"
! !
+
!Number methodsFor:'intervals'!
downTo:stop
@@ -1202,6 +1206,7 @@
"
! !
+
!Number methodsFor:'iteration'!
timesRepeat:aBlock
@@ -1211,11 +1216,12 @@
count := self.
[count > 0] whileTrue:[
- aBlock value.
- count := count - 1
+ aBlock value.
+ count := count - 1
]
! !
+
!Number methodsFor:'mathematical functions'!
conjugated
@@ -1359,6 +1365,7 @@
"
! !
+
!Number methodsFor:'measurement values'!
maxValue
@@ -1375,6 +1382,7 @@
^ self
! !
+
!Number methodsFor:'printing & storing'!
printOn:aStream paddedWith:padCharacter to:size base:radix
@@ -1549,6 +1557,7 @@
^ self printString
! !
+
!Number methodsFor:'taylor series'!
arcSin_withAccuracy:epsilon
@@ -2082,6 +2091,7 @@
"
! !
+
!Number methodsFor:'testing'!
isDivisibleBy:aNumber
@@ -2130,6 +2140,7 @@
"Modified: 18.7.1996 / 12:40:49 / cg"
! !
+
!Number methodsFor:'tracing'!
traceInto:aRequestor level:level from:referrer
@@ -2140,6 +2151,7 @@
! !
+
!Number methodsFor:'trigonometric'!
arcCos
@@ -2294,6 +2306,7 @@
"/ ^ (exp - nexp) / (exp + nexp)
! !
+
!Number methodsFor:'truncation & rounding'!
detentBy: detent atMultiplesOf: grid snap: snap
@@ -2312,8 +2325,8 @@
snap ifTrue: [^ self]. "...or return self"
r2 := self < r1 "Nearest end of dead zone"
- ifTrue: [r1 - (detent asFloat/2)]
- ifFalse: [r1 + (detent asFloat/2)].
+ ifTrue: [r1 - (detent asFloat/2)]
+ ifFalse: [r1 + (detent asFloat/2)].
"Scale values between dead zones to fill range between multiples"
^ r1 + ((self - r2) * grid asFloat / (grid - detent))
--- a/NumberConversionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NumberConversionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -37,5 +37,9 @@
!NumberConversionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NumberConversionError.st,v 1.4 2008-08-06 09:53:01 cg Exp $'
+ ^ '$Id: NumberConversionError.st 10808 2012-05-09 15:04:12Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id: NumberConversionError.st 10808 2012-05-09 15:04:12Z vranyj1 $'
! !
--- a/NumberFormatError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/NumberFormatError.st Sun Feb 02 14:16:24 2014 +0000
@@ -37,5 +37,9 @@
!NumberFormatError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/NumberFormatError.st,v 1.3 2008-08-06 09:52:56 cg Exp $'
+ ^ '$Id: NumberFormatError.st 10808 2012-05-09 15:04:12Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id: NumberFormatError.st 10808 2012-05-09 15:04:12Z vranyj1 $'
! !
--- a/OSFileHandle.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OSFileHandle.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OSHandle subclass:#OSFileHandle
@@ -131,7 +130,14 @@
!OSFileHandle class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OSFileHandle.st,v 1.7 2006-02-08 18:27:09 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OSFileHandle.st,v 1.7 2006/02/08 18:27:09 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OSFileHandle.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
OSFileHandle initialize!
+
+
+
--- a/OSHandle.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OSHandle.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ExternalAddress subclass:#OSHandle
@@ -102,7 +101,14 @@
!OSHandle class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OSHandle.st,v 1.11 2006-02-08 18:27:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OSHandle.st,v 1.11 2006/02/08 18:27:36 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OSHandle.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
OSHandle initialize!
+
+
+
--- a/OSSignalInterrupt.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OSSignalInterrupt.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#OSSignalInterrupt
@@ -62,7 +61,14 @@
!OSSignalInterrupt class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OSSignalInterrupt.st,v 1.4 2005-04-11 08:53:28 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OSSignalInterrupt.st,v 1.4 2005/04/11 08:53:28 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: OSSignalInterrupt.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
OSSignalInterrupt initialize!
+
+
+
--- a/Object.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Object.st Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -33,7 +33,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -117,52 +117,52 @@
[Class variables:]
- ErrorSignal <Signal> Signal raised for error/error: messages
- also, parent of all other signals.
-
- HaltSignal <Signal> Signal raised for halt/halt: messages
-
- MessageNotUnderstoodSignal Signals raised for various error conditions
- UserInterruptSignal
- RecursionInterruptSignal
- ExceptionInterruptSignal
- SubscriptOutOfBoundsSignal
- NonIntegerIndexSignal
- NotFoundSignal
- KeyNotFoundSignal
- ElementOutOfBoundsSignal
- InformationSignal
- WarningSignal
- DeepCopyErrorSignal
- InternalErrorSignal
-
- AbortSignal <Signal> Signal raised by debugger, to abort a computation
- BUT, the debugger will only raise it if it is handled.
- By handling the abortSignal, you can control where the
- debuggers abort-function resumes execution in case of
- an error.
-
- ErrorRecursion <Boolean> controls behavior when recursive errors occur (i.e.
- an error while handling an error).
-
- Dependencies <WeakDependencyDictionary>
- keeps track of object dependencies.
-
- InfoPrinting <Boolean> controls weather informational messages
- are printed.
-
- ActivityNotificationSignal <QuerySignal>
- raised on #activityNotification:
-
- NonWeakDependencies <Dictionary> keeps track of object dependencies.
- Dependents stay alive.
-
- SynchronizationSemaphores <WeakIdentityDictionary>
- Semaphores for per-object-monitor.
+ ErrorSignal <Signal> Signal raised for error/error: messages
+ also, parent of all other signals.
+
+ HaltSignal <Signal> Signal raised for halt/halt: messages
+
+ MessageNotUnderstoodSignal Signals raised for various error conditions
+ UserInterruptSignal
+ RecursionInterruptSignal
+ ExceptionInterruptSignal
+ SubscriptOutOfBoundsSignal
+ NonIntegerIndexSignal
+ NotFoundSignal
+ KeyNotFoundSignal
+ ElementOutOfBoundsSignal
+ InformationSignal
+ WarningSignal
+ DeepCopyErrorSignal
+ InternalErrorSignal
+
+ AbortSignal <Signal> Signal raised by debugger, to abort a computation
+ BUT, the debugger will only raise it if it is handled.
+ By handling the abortSignal, you can control where the
+ debuggers abort-function resumes execution in case of
+ an error.
+
+ ErrorRecursion <Boolean> controls behavior when recursive errors occur (i.e.
+ an error while handling an error).
+
+ Dependencies <WeakDependencyDictionary>
+ keeps track of object dependencies.
+
+ InfoPrinting <Boolean> controls weather informational messages
+ are printed.
+
+ ActivityNotificationSignal <QuerySignal>
+ raised on #activityNotification:
+
+ NonWeakDependencies <Dictionary> keeps track of object dependencies.
+ Dependents stay alive.
+
+ SynchronizationSemaphores <WeakIdentityDictionary>
+ Semaphores for per-object-monitor.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -176,7 +176,7 @@
"/ when errors where signal-instance, not class based.
"/ then, signal instances where created here and kept as class vars,
"/ to be fetched from the class var or via signal-getter methods.
- "/ Nowadays, we use class based exceptions, where the exception class
+ "/ Nowadays, we use class based exceptions, where the exception class
"/ is directly referenced.
"/ the classvars here are kept for backward compatibility, but they now
"/ simply alias the corresponding exception class.
@@ -221,24 +221,24 @@
"called only once - initialize signals"
ErrorSignal isNil ifTrue:[
- self initSignals.
- ErrorRecursion := true.
+ self initSignals.
+ ErrorRecursion := true.
].
ObjectAttributes isNil ifTrue:[
- ObjectAttributes := WeakIdentityDictionary new.
+ ObjectAttributes := WeakIdentityDictionary new.
].
Dependencies isNil ifTrue:[
- Dependencies := WeakDependencyDictionary new.
+ Dependencies := WeakDependencyDictionary new.
].
NonWeakDependencies isNil ifTrue:[
- NonWeakDependencies := IdentityDictionary new.
+ NonWeakDependencies := IdentityDictionary new.
].
SynchronizationSemaphores isNil ifTrue:[
- SynchronizationSemaphores := WeakIdentityDictionary new.
+ SynchronizationSemaphores := WeakIdentityDictionary new.
].
FinalizationLobby isNil ifTrue:[
- FinalizationLobby := Registry new.
+ FinalizationLobby := Registry new.
].
"/ initialize InfoPrinting to the VM's infoPrint setting
@@ -418,13 +418,13 @@
"
RecursiveStoreError handle:[:ex |
- self halt
+ self halt
] do:[
- |a|
-
- a := Array new:1.
- a at:1 put:a.
- a storeOn:Transcript
+ |a|
+
+ a := Array new:1.
+ a at:1 put:a.
+ a storeOn:Transcript
]
"
@@ -490,7 +490,6 @@
InfoPrinting := aBoolean
! !
-
!Object class methodsFor:'queries'!
isAbstract
@@ -514,9 +513,6 @@
-
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -602,7 +598,7 @@
explore
(self confirm:'The Squeak explorer has not yet been ported to ST/X\\Inspect instead ?' withCRs)
ifTrue:[
- self inspect
+ self inspect
]
!
@@ -619,13 +615,13 @@
!
stringForReadout
- ^ self stringRepresentation
+ ^ self stringRepresentation
!
stringRepresentation
- "Answer a string that represents the receiver. For most objects this is simply its printString, but for strings themselves, it's themselves. 6/12/96 sw"
-
- ^ self printString
+ "Answer a string that represents the receiver. For most objects this is simply its printString, but for strings themselves, it's themselves. 6/12/96 sw"
+
+ ^ self printString
!
valueWithPossibleArguments:argArray
@@ -673,7 +669,6 @@
! !
-
!Object methodsFor:'accessing'!
_at:index
@@ -681,9 +676,9 @@
this is a synthetic selector, generated by the compiler,
if a construct of the form expr[idx...] is parsed.
I.e.
- v[n]
+ v[n]
generates
- v _at: n
+ v _at: n
"
^ self at:index
@@ -696,9 +691,9 @@
this is a synthetic selector, generated by the compiler,
if a construct of the form expr[idx...] is parsed.
I.e.
- v[n]
+ v[n]
generates
- v _at: n
+ v _at: n
"
^ self at:index put:value
@@ -717,20 +712,20 @@
anonCls := self perform:classGetter ifNotUnderstood:nil.
anonCls isNil ifTrue:[
- anonCls := myClass
- subclass:(myClass name,'+',slotName) asSymbol
- instanceVariableNames:slotName
- classVariableNames:''
- poolDictionaries:'' category:nil
- inEnvironment:nil.
- anonCls compile:('%1 ^ %1' bindWith:slotName).
- anonCls compile:('%1:v %1 := v' bindWith:slotName).
- Class withoutUpdatingChangesDo:[
- |m|
- m := Compiler compile:('__get_',slotName,' ^ #fooBar' bindWith:slotName) forClass:myClass install:false.
- m literalAt:(m literals indexOf:#fooBar) put:anonCls.
- myClass addSelector:classGetter withMethod:m.
- ].
+ anonCls := myClass
+ subclass:(myClass name,'+',slotName) asSymbol
+ instanceVariableNames:slotName
+ classVariableNames:''
+ poolDictionaries:'' category:nil
+ inEnvironment:nil.
+ anonCls compile:('%1 ^ %1' bindWith:slotName).
+ anonCls compile:('%1:v %1 := v' bindWith:slotName).
+ Class withoutUpdatingChangesDo:[
+ |m|
+ m := Compiler compile:('__get_',slotName,' ^ #fooBar' bindWith:slotName) forClass:myClass install:false.
+ m literalAt:(m literals indexOf:#fooBar) put:anonCls.
+ myClass addSelector:classGetter withMethod:m.
+ ].
].
newObj := anonCls cloneFrom:self.
self become:newObj.
@@ -797,239 +792,239 @@
* and SmallInteger
*/
if (__isSmallInteger(index)) {
- myClass = __qClass(self);
- indx = __intVal(index) - 1;
- n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
- n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
- nbytes = __qSize(self) - n /* nInstBytes */;
- pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
-
- switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
- case __MASKSMALLINT(POINTERARRAY):
- case __MASKSMALLINT(WKPOINTERARRAY):
- /*
- * pointers
- */
- if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
- OBJ *op;
-
- op = (OBJ *)pFirst + indx;
- RETURN ( *op );
- }
- break;
-
- case __MASKSMALLINT(BYTEARRAY):
- /*
- * (unsigned) bytes
- */
- if ((unsigned)indx < nbytes) {
- unsigned char *cp;
-
- cp = (unsigned char *)pFirst + indx;
- RETURN ( __mkSmallInteger( (*cp & 0xFF)) );
- }
- break;
-
- case __MASKSMALLINT(FLOATARRAY):
- /*
- * native floats
- */
- if ((unsigned)indx < (nbytes / sizeof(float))) {
- float *fp;
- float f;
- OBJ v;
-
- fp = (float *)pFirst + indx;
- f = *fp;
- if (f == 0.0) {
- v = __float0;
- } else {
- __qMKSFLOAT(v, f);
- }
- RETURN (v);
- }
- break;
-
- case __MASKSMALLINT(DOUBLEARRAY):
- /*
- * native doubles
- */
+ myClass = __qClass(self);
+ indx = __intVal(index) - 1;
+ n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
+ n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
+ nbytes = __qSize(self) - n /* nInstBytes */;
+ pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
+
+ switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
+ case __MASKSMALLINT(POINTERARRAY):
+ case __MASKSMALLINT(WKPOINTERARRAY):
+ /*
+ * pointers
+ */
+ if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
+ OBJ *op;
+
+ op = (OBJ *)pFirst + indx;
+ RETURN ( *op );
+ }
+ break;
+
+ case __MASKSMALLINT(BYTEARRAY):
+ /*
+ * (unsigned) bytes
+ */
+ if ((unsigned)indx < nbytes) {
+ unsigned char *cp;
+
+ cp = (unsigned char *)pFirst + indx;
+ RETURN ( __mkSmallInteger( (*cp & 0xFF)) );
+ }
+ break;
+
+ case __MASKSMALLINT(FLOATARRAY):
+ /*
+ * native floats
+ */
+ if ((unsigned)indx < (nbytes / sizeof(float))) {
+ float *fp;
+ float f;
+ OBJ v;
+
+ fp = (float *)pFirst + indx;
+ f = *fp;
+ if (f == 0.0) {
+ v = __float0;
+ } else {
+ __qMKSFLOAT(v, f);
+ }
+ RETURN (v);
+ }
+ break;
+
+ case __MASKSMALLINT(DOUBLEARRAY):
+ /*
+ * native doubles
+ */
#ifdef __NEED_DOUBLE_ALIGN
- if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
- int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
-
- pFirst += delta;
- nbytes -= delta;
- }
+ if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
+ int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
+
+ pFirst += delta;
+ nbytes -= delta;
+ }
#endif
- if ((unsigned)indx < (nbytes / sizeof(double))) {
- double *dp;
- double d;
- OBJ v;
-
- dp = (double *)pFirst + indx;
- d = *dp;
- if (d == 0.0) {
- v = __float0;
- } else {
- __qMKFLOAT(v, d);
- }
- RETURN (v);
- }
- break;
-
- case __MASKSMALLINT(WORDARRAY):
- /*
- * unsigned 16bit ints
- */
- /* Notice: the hard coded shifts are by purpose;
- * it makes us independent of the short-size of the machine
- */
- if ((unsigned)indx < (nbytes>>1)) {
- unsigned short *sp;
-
- sp = (unsigned short *)(pFirst + (indx<<1));
- RETURN ( __mkSmallInteger( (*sp & 0xFFFF)) );
- }
- break;
-
- case __MASKSMALLINT(SWORDARRAY):
- /*
- * signed 16bit ints
- */
- /* Notice: the hard coded shifts are by purpose;
- * it makes us independent of the short-size of the machine
- */
- if ((unsigned)indx < (nbytes>>1)) {
- short *ssp;
-
- ssp = (short *)(pFirst + (indx<<1));
- RETURN ( __mkSmallInteger( (*ssp) ));
- }
- break;
-
- case __MASKSMALLINT(LONGARRAY):
- /*
- * unsigned 32bit ints
- */
- /* Notice: the hard coded shifts are by purpose;
- * it makes us independent of the int-size of the machine
- */
- if ((unsigned)indx < (nbytes>>2)) {
- unsigned int32 ul;
- unsigned int32 *lp;
-
- lp = (unsigned int32 *)(pFirst + (indx<<2));
- ul = *lp;
+ if ((unsigned)indx < (nbytes / sizeof(double))) {
+ double *dp;
+ double d;
+ OBJ v;
+
+ dp = (double *)pFirst + indx;
+ d = *dp;
+ if (d == 0.0) {
+ v = __float0;
+ } else {
+ __qMKFLOAT(v, d);
+ }
+ RETURN (v);
+ }
+ break;
+
+ case __MASKSMALLINT(WORDARRAY):
+ /*
+ * unsigned 16bit ints
+ */
+ /* Notice: the hard coded shifts are by purpose;
+ * it makes us independent of the short-size of the machine
+ */
+ if ((unsigned)indx < (nbytes>>1)) {
+ unsigned short *sp;
+
+ sp = (unsigned short *)(pFirst + (indx<<1));
+ RETURN ( __mkSmallInteger( (*sp & 0xFFFF)) );
+ }
+ break;
+
+ case __MASKSMALLINT(SWORDARRAY):
+ /*
+ * signed 16bit ints
+ */
+ /* Notice: the hard coded shifts are by purpose;
+ * it makes us independent of the short-size of the machine
+ */
+ if ((unsigned)indx < (nbytes>>1)) {
+ short *ssp;
+
+ ssp = (short *)(pFirst + (indx<<1));
+ RETURN ( __mkSmallInteger( (*ssp) ));
+ }
+ break;
+
+ case __MASKSMALLINT(LONGARRAY):
+ /*
+ * unsigned 32bit ints
+ */
+ /* Notice: the hard coded shifts are by purpose;
+ * it makes us independent of the int-size of the machine
+ */
+ if ((unsigned)indx < (nbytes>>2)) {
+ unsigned int32 ul;
+ unsigned int32 *lp;
+
+ lp = (unsigned int32 *)(pFirst + (indx<<2));
+ ul = *lp;
#if __POINTER_SIZE__ == 8
- {
- unsigned INT ull = (unsigned INT)ul;
- RETURN ( __mkSmallInteger(ull) );
- }
+ {
+ unsigned INT ull = (unsigned INT)ul;
+ RETURN ( __mkSmallInteger(ull) );
+ }
#else
- if (ul <= _MAX_INT) {
- RETURN ( __mkSmallInteger(ul) );
- }
- RETURN ( __MKULARGEINT(ul) );
+ if (ul <= _MAX_INT) {
+ RETURN ( __mkSmallInteger(ul) );
+ }
+ RETURN ( __MKULARGEINT(ul) );
#endif
- }
- break;
-
- case __MASKSMALLINT(SLONGARRAY):
- /*
- * signed 32bit ints
- */
- /* Notice: the hard coded shifts are by purpose;
- * it makes us independent of the int-size of the machine
- */
- if ((unsigned)indx < (nbytes>>2)) {
- int32 *slp;
- int32 l;
-
- slp = (int32 *)(pFirst + (indx<<2));
- l = *slp;
+ }
+ break;
+
+ case __MASKSMALLINT(SLONGARRAY):
+ /*
+ * signed 32bit ints
+ */
+ /* Notice: the hard coded shifts are by purpose;
+ * it makes us independent of the int-size of the machine
+ */
+ if ((unsigned)indx < (nbytes>>2)) {
+ int32 *slp;
+ int32 l;
+
+ slp = (int32 *)(pFirst + (indx<<2));
+ l = *slp;
#if __POINTER_SIZE__ == 8
- {
- INT ll = (INT)l;
- RETURN ( __mkSmallInteger(ll) );
- }
+ {
+ INT ll = (INT)l;
+ RETURN ( __mkSmallInteger(ll) );
+ }
#else
- if (__ISVALIDINTEGER(l)) {
- RETURN ( __mkSmallInteger(l) );
- }
- RETURN ( __MKLARGEINT(l) );
+ if (__ISVALIDINTEGER(l)) {
+ RETURN ( __mkSmallInteger(l) );
+ }
+ RETURN ( __MKLARGEINT(l) );
#endif
- }
- break;
-
- case __MASKSMALLINT(SLONGLONGARRAY):
- /*
- * signed 64bit longlongs
- */
+ }
+ break;
+
+ case __MASKSMALLINT(SLONGLONGARRAY):
+ /*
+ * signed 64bit longlongs
+ */
#ifdef __NEED_LONGLONG_ALIGN
- if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
- int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
-
- pFirst += delta;
- nbytes -= delta;
- }
+ if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
+ int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
+
+ pFirst += delta;
+ nbytes -= delta;
+ }
#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)) {
+ /* 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
- INT *slp, ll;
-
- slp = (INT *)(pFirst + (indx<<3));
- ll = *slp;
- if (__ISVALIDINTEGER(ll)) {
- RETURN ( __mkSmallInteger(ll) );
- }
- RETURN ( __MKLARGEINT(ll) );
+ INT *slp, ll;
+
+ slp = (INT *)(pFirst + (indx<<3));
+ ll = *slp;
+ if (__ISVALIDINTEGER(ll)) {
+ RETURN ( __mkSmallInteger(ll) );
+ }
+ RETURN ( __MKLARGEINT(ll) );
#else
- __int64__ *llp;
-
- llp = (__int64__ *)(pFirst + (indx<<3));
- RETURN (__MKINT64(llp));
+ __int64__ *llp;
+
+ llp = (__int64__ *)(pFirst + (indx<<3));
+ RETURN (__MKINT64(llp));
#endif
- }
- break;
-
- case __MASKSMALLINT(LONGLONGARRAY):
- /*
- * unsigned 64bit longlongs
- */
+ }
+ break;
+
+ case __MASKSMALLINT(LONGLONGARRAY):
+ /*
+ * unsigned 64bit longlongs
+ */
#ifdef __NEED_LONGLONG_ALIGN
- if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
- int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
-
- pFirst += delta;
- nbytes -= delta;
- }
+ if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
+ int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
+
+ pFirst += delta;
+ nbytes -= delta;
+ }
#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)) {
+ /* 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
- unsigned INT *ulp, ul;
-
- ulp = (unsigned INT *)(pFirst + (indx<<3));
- ul = *ulp;
- if (ul <= _MAX_INT) {
- RETURN ( __mkSmallInteger(ul) );
- }
- RETURN ( __MKULARGEINT(ul) );
+ unsigned INT *ulp, ul;
+
+ ulp = (unsigned INT *)(pFirst + (indx<<3));
+ ul = *ulp;
+ if (ul <= _MAX_INT) {
+ RETURN ( __mkSmallInteger(ul) );
+ }
+ RETURN ( __MKULARGEINT(ul) );
#else
- __uint64__ *llp;
-
- llp = (__uint64__ *)(pFirst + (indx<<3));
- RETURN (__MKUINT64(llp));
+ __uint64__ *llp;
+
+ llp = (__uint64__ *)(pFirst + (indx<<3));
+ RETURN (__MKUINT64(llp));
#endif
- }
- break;
- }
+ }
+ break;
+ }
}
%}.
^ self indexNotIntegerOrOutOfBounds:index
@@ -1057,280 +1052,280 @@
and SmallInteger */
if (__isSmallInteger(index)) {
- indx = __intVal(index) - 1;
- myClass = __qClass(self);
- n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
- n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
- nbytes = __qSize(self) - n /* nInstBytes */;
- pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
-
- switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
- case __MASKSMALLINT(POINTERARRAY):
- case __MASKSMALLINT(WKPOINTERARRAY):
- if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
- OBJ *op;
-
- op = (OBJ *)pFirst + indx;
- *op = anObject;
- __STORE(self, anObject);
- RETURN ( anObject );
- }
- break;
-
- case __MASKSMALLINT(BYTEARRAY):
- if (__isSmallInteger(anObject)) {
- val = __intVal(anObject);
- if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
- if ((unsigned)indx < nbytes) {
- char *cp;
-
- cp = pFirst + indx;
- *cp = val;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(FLOATARRAY):
- if ((unsigned)indx < (nbytes / sizeof(float))) {
- float *fp;
-
- fp = (float *)pFirst + indx;
- if (anObject != nil) {
- if (! __isSmallInteger(anObject)) {
- if (__qIsFloatLike(anObject)) {
- *fp = (float)(__floatVal(anObject));
- RETURN ( anObject );
- }
- if (__qIsShortFloat(anObject)) {
- *fp = __shortFloatVal(anObject);
- RETURN ( anObject );
- }
- } else {
- *fp = (float) __intVal(anObject);
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(DOUBLEARRAY):
+ indx = __intVal(index) - 1;
+ myClass = __qClass(self);
+ n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
+ n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
+ nbytes = __qSize(self) - n /* nInstBytes */;
+ pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
+
+ switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
+ case __MASKSMALLINT(POINTERARRAY):
+ case __MASKSMALLINT(WKPOINTERARRAY):
+ if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
+ OBJ *op;
+
+ op = (OBJ *)pFirst + indx;
+ *op = anObject;
+ __STORE(self, anObject);
+ RETURN ( anObject );
+ }
+ break;
+
+ case __MASKSMALLINT(BYTEARRAY):
+ if (__isSmallInteger(anObject)) {
+ val = __intVal(anObject);
+ if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
+ if ((unsigned)indx < nbytes) {
+ char *cp;
+
+ cp = pFirst + indx;
+ *cp = val;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(FLOATARRAY):
+ if ((unsigned)indx < (nbytes / sizeof(float))) {
+ float *fp;
+
+ fp = (float *)pFirst + indx;
+ if (anObject != nil) {
+ if (! __isSmallInteger(anObject)) {
+ if (__qIsFloatLike(anObject)) {
+ *fp = (float)(__floatVal(anObject));
+ RETURN ( anObject );
+ }
+ if (__qIsShortFloat(anObject)) {
+ *fp = __shortFloatVal(anObject);
+ RETURN ( anObject );
+ }
+ } else {
+ *fp = (float) __intVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(DOUBLEARRAY):
#ifdef __NEED_DOUBLE_ALIGN
- if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
- int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
-
- pFirst += delta;
- nbytes -= delta;
- }
+ if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
+ int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
+
+ pFirst += delta;
+ nbytes -= delta;
+ }
#endif
- if ((unsigned)indx < (nbytes / sizeof(double))) {
- double *dp;
-
- dp = (double *)pFirst + indx;
- if (anObject != nil) {
- if (! __isSmallInteger(anObject)) {
- if (__qIsFloatLike(anObject)) {
- *dp = __floatVal(anObject);
- RETURN ( anObject );
- }
- if (__qIsShortFloat(anObject)) {
- *dp = (double)__shortFloatVal(anObject);
- RETURN ( anObject );
- }
- } else {
- *dp = (double) __intVal(anObject);
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(WORDARRAY):
- if (__isSmallInteger(anObject)) {
- val = __intVal(anObject);
- if ((unsigned)val <= 0xFFFF) {
- if ((unsigned)indx < (nbytes>>1)) {
- unsigned short *sp;
-
- sp = (unsigned short *)(pFirst + (indx<<1));
- *sp = val;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(SWORDARRAY):
- if (__isSmallInteger(anObject)) {
- val = __intVal(anObject);
- if ((val >= -32768) && (val < 32768)) {
- if ((unsigned)indx < (nbytes>>1)) {
- short *ssp;
-
- ssp = (short *)(pFirst + (indx<<1));
- *ssp = val;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(SLONGARRAY):
- if ((unsigned)indx < (nbytes>>2)) {
- int32 *slp;
-
- slp = (int32 *)(pFirst + (indx<<2));
- if (__isSmallInteger(anObject)) {
- *slp = __intVal(anObject);
- RETURN ( anObject );
- }
- n = __signedLongIntVal(anObject);
- /*
- * zero means failure for an int larger than INT-size bytes
- * (would be a smallInteger)
- */
- if (n) {
+ if ((unsigned)indx < (nbytes / sizeof(double))) {
+ double *dp;
+
+ dp = (double *)pFirst + indx;
+ if (anObject != nil) {
+ if (! __isSmallInteger(anObject)) {
+ if (__qIsFloatLike(anObject)) {
+ *dp = __floatVal(anObject);
+ RETURN ( anObject );
+ }
+ if (__qIsShortFloat(anObject)) {
+ *dp = (double)__shortFloatVal(anObject);
+ RETURN ( anObject );
+ }
+ } else {
+ *dp = (double) __intVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(WORDARRAY):
+ if (__isSmallInteger(anObject)) {
+ val = __intVal(anObject);
+ if ((unsigned)val <= 0xFFFF) {
+ if ((unsigned)indx < (nbytes>>1)) {
+ unsigned short *sp;
+
+ sp = (unsigned short *)(pFirst + (indx<<1));
+ *sp = val;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(SWORDARRAY):
+ if (__isSmallInteger(anObject)) {
+ val = __intVal(anObject);
+ if ((val >= -32768) && (val < 32768)) {
+ if ((unsigned)indx < (nbytes>>1)) {
+ short *ssp;
+
+ ssp = (short *)(pFirst + (indx<<1));
+ *ssp = val;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(SLONGARRAY):
+ if ((unsigned)indx < (nbytes>>2)) {
+ int32 *slp;
+
+ slp = (int32 *)(pFirst + (indx<<2));
+ if (__isSmallInteger(anObject)) {
+ *slp = __intVal(anObject);
+ RETURN ( anObject );
+ }
+ n = __signedLongIntVal(anObject);
+ /*
+ * zero means failure for an int larger than INT-size bytes
+ * (would be a smallInteger)
+ */
+ if (n) {
#if __POINTER_SIZE__ == 8
- if ((n >= -0x80000000) && (n < 0x80000000))
+ if ((n >= -0x80000000) && (n < 0x80000000))
#endif
- {
- *slp = n;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(LONGARRAY):
- if ((unsigned)indx < (nbytes>>2)) {
- unsigned int32 *lp;
-
- lp = (unsigned int32 *)(pFirst + (indx<<2));
- if (anObject == __mkSmallInteger(0)) {
- *lp = 0;
- RETURN ( anObject );
- }
- u = __longIntVal(anObject);
- /*
- * zero means failure for an int larger than 4 bytes
- * (would be a smallInteger)
- */
- if (u) {
+ {
+ *slp = n;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(LONGARRAY):
+ if ((unsigned)indx < (nbytes>>2)) {
+ unsigned int32 *lp;
+
+ lp = (unsigned int32 *)(pFirst + (indx<<2));
+ if (anObject == __mkSmallInteger(0)) {
+ *lp = 0;
+ RETURN ( anObject );
+ }
+ u = __longIntVal(anObject);
+ /*
+ * zero means failure for an int larger than 4 bytes
+ * (would be a smallInteger)
+ */
+ if (u) {
#if __POINTER_SIZE__ == 8
- if (u <= 0xFFFFFFFF)
+ if (u <= 0xFFFFFFFF)
#endif
- {
- *lp = u;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case __MASKSMALLINT(SLONGLONGARRAY):
+ {
+ *lp = u;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case __MASKSMALLINT(SLONGLONGARRAY):
#ifdef __NEED_LONGLONG_ALIGN
- if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
- int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
-
- pFirst += delta;
- nbytes -= delta;
- }
+ if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
+ int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
+
+ pFirst += delta;
+ nbytes -= delta;
+ }
#endif
- if ((unsigned)indx < (nbytes>>3)) {
- __int64__ ll;
- __int64__ *sllp;
-
- sllp = (__int64__ *)(pFirst + (indx<<3));
+ if ((unsigned)indx < (nbytes>>3)) {
+ __int64__ ll;
+ __int64__ *sllp;
+
+ sllp = (__int64__ *)(pFirst + (indx<<3));
#if __POINTER_SIZE__ == 8
- if (__isSmallInteger(anObject)) {
- *sllp = __intVal(anObject);
- RETURN ( anObject );
- }
- n = __signedLongIntVal(anObject);
- if (n) {
- *sllp = n;
- RETURN ( anObject );
- }
+ if (__isSmallInteger(anObject)) {
+ *sllp = __intVal(anObject);
+ RETURN ( anObject );
+ }
+ n = __signedLongIntVal(anObject);
+ if (n) {
+ *sllp = n;
+ RETURN ( anObject );
+ }
#else
- if (anObject == __mkSmallInteger(0)) {
- ll.lo = ll.hi = 0;
- *sllp = ll;
- RETURN ( anObject );
- }
- if (__signedLong64IntVal(anObject, &ll)) {
- *sllp = ll;
- RETURN ( anObject );
- }
+ if (anObject == __mkSmallInteger(0)) {
+ ll.lo = ll.hi = 0;
+ *sllp = ll;
+ RETURN ( anObject );
+ }
+ if (__signedLong64IntVal(anObject, &ll)) {
+ *sllp = ll;
+ RETURN ( anObject );
+ }
#endif
- }
- break;
-
- case __MASKSMALLINT(LONGLONGARRAY):
+ }
+ break;
+
+ case __MASKSMALLINT(LONGLONGARRAY):
#ifdef __NEED_LONGLONG_ALIGN
- if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
- int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
-
- pFirst += delta;
- nbytes -= delta;
- }
+ if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
+ int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
+
+ pFirst += delta;
+ nbytes -= delta;
+ }
#endif
- if ((unsigned)indx < (nbytes>>3)) {
- __uint64__ ll;
- __uint64__ *llp;
-
- llp = (__uint64__ *)(pFirst + (indx<<3));
+ if ((unsigned)indx < (nbytes>>3)) {
+ __uint64__ ll;
+ __uint64__ *llp;
+
+ llp = (__uint64__ *)(pFirst + (indx<<3));
#if __POINTER_SIZE__ == 8
- if (__isSmallInteger(anObject)) {
- *llp = __intVal(anObject);
- RETURN ( anObject );
- }
- ll = __longIntVal(anObject);
- if (ll) {
- *llp = ll;
- RETURN ( anObject );
- }
+ if (__isSmallInteger(anObject)) {
+ *llp = __intVal(anObject);
+ RETURN ( anObject );
+ }
+ ll = __longIntVal(anObject);
+ if (ll) {
+ *llp = ll;
+ RETURN ( anObject );
+ }
#else
- if (anObject == __mkSmallInteger(0)) {
- ll.lo = ll.hi = 0;
- *llp = ll;
- RETURN ( anObject );
- }
- if (__unsignedLong64IntVal(anObject, &ll)) {
- *llp = ll;
- RETURN ( anObject );
- }
+ if (anObject == __mkSmallInteger(0)) {
+ ll.lo = ll.hi = 0;
+ *llp = ll;
+ RETURN ( anObject );
+ }
+ if (__unsignedLong64IntVal(anObject, &ll)) {
+ *llp = ll;
+ RETURN ( anObject );
+ }
#endif
- }
- break;
- }
+ }
+ break;
+ }
}
%}.
index isInteger ifFalse:[
- "
- the index should be an integer number
- "
- ^ self indexNotInteger:index
+ "
+ the index should be an integer number
+ "
+ ^ self indexNotInteger:index
].
(index between:1 and:self size) ifFalse:[
- "
- the index is less than 1 or greater than the size of the
- receiver collection
- "
- ^ self subscriptBoundsError:index
+ "
+ the index is less than 1 or greater than the size of the
+ receiver collection
+ "
+ ^ self subscriptBoundsError:index
].
(self class isFloatsOrDoubles) ifTrue:[
- anObject isNumber ifTrue:[
- ^ self basicAt:index put:(anObject asFloat)
- ]
+ anObject isNumber ifTrue:[
+ ^ self basicAt:index put:(anObject asFloat)
+ ]
].
anObject isInteger ifFalse:[
- "
- the object to put into the receiver collection
- should be an integer number
- "
- ^ self elementNotInteger
+ "
+ the object to put into the receiver collection
+ should be an integer number
+ "
+ ^ self elementNotInteger
].
"
the object to put into the receiver collection
@@ -1358,56 +1353,56 @@
REGISTER OBJ cls;
if (__isSmallInteger(index)) {
- slf = self;
- if (__isNonNilObject(slf)) {
- unsigned char *pFirst;
- int nIndex;
-
- cls = __qClass(slf);
-
- pFirst = __byteArrayVal(slf);
- pFirst += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- nIndex = __byteArraySize(slf);
- indx = __intVal(index) - 1;
-
- switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
- case __MASKSMALLINT(DOUBLEARRAY):
+ slf = self;
+ if (__isNonNilObject(slf)) {
+ unsigned char *pFirst;
+ int nIndex;
+
+ cls = __qClass(slf);
+
+ pFirst = __byteArrayVal(slf);
+ pFirst += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ nIndex = __byteArraySize(slf);
+ indx = __intVal(index) - 1;
+
+ switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
+ case __MASKSMALLINT(DOUBLEARRAY):
#ifdef __NEED_DOUBLE_ALIGN
- if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
- int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
-
- pFirst += delta;
- nIndex -= delta;
- }
+ if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
+ int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
+
+ pFirst += delta;
+ nIndex -= delta;
+ }
#endif
- /* fall into */
- case __MASKSMALLINT(BYTEARRAY):
- case __MASKSMALLINT(WORDARRAY):
- case __MASKSMALLINT(LONGARRAY):
- case __MASKSMALLINT(SWORDARRAY):
- case __MASKSMALLINT(SLONGARRAY):
- case __MASKSMALLINT(FLOATARRAY):
- if ((unsigned)indx < (unsigned)nIndex) {
- RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
- }
- break;
-
- case __MASKSMALLINT(LONGLONGARRAY):
- case __MASKSMALLINT(SLONGLONGARRAY):
+ /* fall into */
+ case __MASKSMALLINT(BYTEARRAY):
+ case __MASKSMALLINT(WORDARRAY):
+ case __MASKSMALLINT(LONGARRAY):
+ case __MASKSMALLINT(SWORDARRAY):
+ case __MASKSMALLINT(SLONGARRAY):
+ case __MASKSMALLINT(FLOATARRAY):
+ if ((unsigned)indx < (unsigned)nIndex) {
+ RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
+ }
+ break;
+
+ case __MASKSMALLINT(LONGLONGARRAY):
+ case __MASKSMALLINT(SLONGLONGARRAY):
#ifdef __NEED_LONGLONG_ALIGN
- if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
- int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
-
- pFirst += delta;
- nIndex -= delta;
- }
+ if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
+ int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
+
+ pFirst += delta;
+ nIndex -= delta;
+ }
#endif
- if ((unsigned)indx < (unsigned)nIndex) {
- RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
- }
- break;
- }
- }
+ if ((unsigned)indx < (unsigned)nIndex) {
+ RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
+ }
+ break;
+ }
+ }
}
%}.
"/ index not integer or index out of range
@@ -1440,33 +1435,33 @@
REGISTER OBJ cls;
if (__bothSmallInteger(index, byteValue)) {
- val = __intVal(byteValue);
- if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
- slf = self;
- if (__isNonNilObject(slf)) {
- cls = __qClass(slf);
-
- indx = __intVal(index) - 1;
- switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
- case __MASKSMALLINT(BYTEARRAY):
- case __MASKSMALLINT(WORDARRAY):
- case __MASKSMALLINT(LONGARRAY):
- case __MASKSMALLINT(SWORDARRAY):
- case __MASKSMALLINT(SLONGARRAY):
- case __MASKSMALLINT(LONGLONGARRAY):
- case __MASKSMALLINT(SLONGLONGARRAY):
- case __MASKSMALLINT(FLOATARRAY):
- case __MASKSMALLINT(DOUBLEARRAY):
- indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- nIndex = __byteArraySize(slf);
- if ((unsigned)indx < (unsigned)nIndex) {
- __ByteArrayInstPtr(slf)->ba_element[indx] = val;
- RETURN ( byteValue );
- }
- break;
- }
- }
- }
+ val = __intVal(byteValue);
+ if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
+ slf = self;
+ if (__isNonNilObject(slf)) {
+ cls = __qClass(slf);
+
+ indx = __intVal(index) - 1;
+ switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
+ case __MASKSMALLINT(BYTEARRAY):
+ case __MASKSMALLINT(WORDARRAY):
+ case __MASKSMALLINT(LONGARRAY):
+ case __MASKSMALLINT(SWORDARRAY):
+ case __MASKSMALLINT(SLONGARRAY):
+ case __MASKSMALLINT(LONGLONGARRAY):
+ case __MASKSMALLINT(SLONGLONGARRAY):
+ case __MASKSMALLINT(FLOATARRAY):
+ case __MASKSMALLINT(DOUBLEARRAY):
+ indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ nIndex = __byteArraySize(slf);
+ if ((unsigned)indx < (unsigned)nIndex) {
+ __ByteArrayInstPtr(slf)->ba_element[indx] = val;
+ RETURN ( byteValue );
+ }
+ break;
+ }
+ }
+ }
}
%}.
"/ index not integer or index out of range
@@ -1491,22 +1486,22 @@
int idx, ninstvars;
if (__isSmallInteger(index)) {
- myClass = __Class(self);
- idx = __intVal(index) - 1;
- /*
- * do not allow returning of non-object fields.
- * if subclass did not make provisions for that,
- * we won't do so here ...
- */
- if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
- if (idx == 0) {
- RETURN ( nil )
- }
- }
- ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
- if ((idx >= 0) && (idx < ninstvars)) {
- RETURN ( __InstPtr(self)->i_instvars[idx] );
- }
+ myClass = __Class(self);
+ idx = __intVal(index) - 1;
+ /*
+ * do not allow returning of non-object fields.
+ * if subclass did not make provisions for that,
+ * we won't do so here ...
+ */
+ if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
+ if (idx == 0) {
+ RETURN ( nil )
+ }
+ }
+ ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
+ if ((idx >= 0) && (idx < ninstvars)) {
+ RETURN ( __InstPtr(self)->i_instvars[idx] );
+ }
}
%}.
^ self indexNotIntegerOrOutOfBounds:index
@@ -1523,24 +1518,24 @@
int idx, ninstvars;
if (__isSmallInteger(index)) {
- myClass = __Class(self);
- idx = __intVal(index) - 1;
- ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
- /*
- * do not allow setting of non-object fields.
- * if subclass did not make provisions for that,
- * we won't do so here ...
- */
- if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
- if (idx == 0) {
- RETURN ( nil )
- }
- }
- if ((idx >= 0) && (idx < ninstvars)) {
- __InstPtr(self)->i_instvars[idx] = value;
- __STORE(self, value);
- RETURN ( value );
- }
+ myClass = __Class(self);
+ idx = __intVal(index) - 1;
+ ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
+ /*
+ * do not allow setting of non-object fields.
+ * if subclass did not make provisions for that,
+ * we won't do so here ...
+ */
+ if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
+ if (idx == 0) {
+ RETURN ( nil )
+ }
+ }
+ if ((idx >= 0) && (idx < ninstvars)) {
+ __InstPtr(self)->i_instvars[idx] = value;
+ __STORE(self, value);
+ RETURN ( value );
+ }
}
%}.
^ self indexNotIntegerOrOutOfBounds:index
@@ -1557,7 +1552,7 @@
idx := self class instVarIndexFor:name.
idx isNil ifTrue:[
- ^ self errorKeyNotFound:name.
+ ^ self errorKeyNotFound:name.
].
^ self instVarAt:idx.
@@ -1609,7 +1604,7 @@
idx := self class instVarIndexFor:name.
idx isNil ifTrue:[
- ^ self errorKeyNotFound:name.
+ ^ self errorKeyNotFound:name.
].
^ self instVarAt:idx put:value.
@@ -1652,7 +1647,6 @@
"Modified: 6.7.1996 / 23:03:41 / cg"
! !
-
!Object methodsFor:'attributes access'!
objectAttributeAt:attributeKey
@@ -1662,7 +1656,7 @@
attrs := self objectAttributes.
(attrs notNil and:[attrs size > 0]) ifTrue:[
- ^ attrs at:attributeKey ifAbsent:[]
+ ^ attrs at:attributeKey ifAbsent:[]
].
^ nil
@@ -1676,29 +1670,29 @@
"/ must do this save from interrupts, since the attributes collection
"/ is possibly accessed from multiple threads ...
[
- | 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 isNil or:[attrs size == 0]) ifTrue:[
- attributeKey isSymbol ifTrue:[
- attrs := IdentityDictionary new.
- ] ifFalse:[
- attrs := WeakIdentityDictionary new.
- ].
- attrs at:attributeKey put:anObject.
- self objectAttributes:attrs.
- ] ifFalse:[
- attributeKey isSymbol ifFalse:[
- attrs class == WeakIdentityDictionary ifFalse:[
- 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 isNil or:[attrs size == 0]) ifTrue:[
+ attributeKey isSymbol ifTrue:[
+ attrs := IdentityDictionary new.
+ ] ifFalse:[
+ attrs := WeakIdentityDictionary new.
+ ].
+ attrs at:attributeKey put:anObject.
+ self objectAttributes:attrs.
+ ] ifFalse:[
+ attributeKey isSymbol ifFalse:[
+ attrs class == WeakIdentityDictionary ifFalse:[
+ attrs := WeakIdentityDictionary new declareAllFrom:attrs.
+ self objectAttributes:attrs.
+ ].
+ ].
+ attrs at:attributeKey put:anObject.
+ ].
] valueUninterruptably
"Attaching additional attributes (slots) to an arbitrary object:
@@ -1739,24 +1733,24 @@
"/ is possibly accessed from multiple threads.
(OperatingSystem blockInterrupts) ifTrue:[
- "/ the common case - already blocked
-
- (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
- ObjectAttributes removeKey:self ifAbsent:nil
- ] ifFalse:[
- ObjectAttributes at:self put:aCollection
- ].
- ^ self
+ "/ the common case - already blocked
+
+ (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
+ ObjectAttributes removeKey:self ifAbsent:nil
+ ] ifFalse:[
+ ObjectAttributes at:self put:aCollection
+ ].
+ ^ self
].
[
- (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
- ObjectAttributes removeKey:self ifAbsent:nil
- ] ifFalse:[
- ObjectAttributes at:self put:aCollection
- ].
+ (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
+ ObjectAttributes removeKey:self ifAbsent:nil
+ ] ifFalse:[
+ ObjectAttributes at:self put:aCollection
+ ].
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
]
"Created: / 22.1.1998 / 21:29:35 / av"
@@ -1769,34 +1763,32 @@
"/ must do this save from interrupts, since the attributes collection
"/ is possibly accessed from multiple threads.
[
- |attrs n a|
-
- attrs := self objectAttributes.
- attrs notNil ifTrue:[
- attrs size == 0 ifTrue:[
- self objectAttributes:nil
- ] ifFalse:[
- attrs removeKey:attributeKey ifAbsent:nil.
- attrs size == 0 ifTrue:[
- self objectAttributes:nil
- ]
- ]
- ]
+ |attrs n a|
+
+ attrs := self objectAttributes.
+ attrs notNil ifTrue:[
+ attrs size == 0 ifTrue:[
+ self objectAttributes:nil
+ ] ifFalse:[
+ attrs removeKey:attributeKey ifAbsent:nil.
+ attrs size == 0 ifTrue:[
+ self objectAttributes:nil
+ ]
+ ]
+ ]
] valueUninterruptably
"Created: / 22.1.1998 / 21:29:39 / av"
"Modified: / 18.2.2000 / 11:32:19 / cg"
! !
-
-
!Object methodsFor:'change & update'!
broadcast:aSelectorSymbol
"send a message with selector aSelectorSymbol to all my dependents"
self dependentsDo:[:dependent |
- dependent perform:aSelectorSymbol
+ dependent perform:aSelectorSymbol
]
!
@@ -1805,7 +1797,7 @@
argument anArgument to all my dependents."
self dependentsDo:[:dependent |
- dependent perform:aSelectorSymbol with:anArgument
+ dependent perform:aSelectorSymbol with:anArgument
]
!
@@ -1814,7 +1806,7 @@
grant the request, and return true if so"
self dependentsDo:[:dependent |
- dependent updateRequest ifFalse:[^ false].
+ dependent updateRequest ifFalse:[^ false].
].
^ true
!
@@ -1824,7 +1816,7 @@
grant the request, and return true if so"
self dependentsDo:[:dependent |
- (dependent updateRequest:aSymbol) ifFalse:[^ false].
+ (dependent updateRequest:aSymbol) ifFalse:[^ false].
].
^ true
!
@@ -1852,9 +1844,9 @@
about to send the change request."
self dependentsDo:[:dependent |
- dependent == anObject ifFalse:[
- (dependent updateRequest:aSymbol with:aParameter from:anObject) ifFalse:[^ false].
- ]
+ dependent == anObject ifFalse:[
+ (dependent updateRequest:aSymbol with:aParameter from:anObject) ifFalse:[^ false].
+ ]
].
^ true
!
@@ -1866,9 +1858,9 @@
about to send the change request."
self dependentsDo:[:dependent |
- dependent == anObject ifFalse:[
- (dependent updateRequest) ifFalse:[^ false].
- ]
+ dependent == anObject ifFalse:[
+ (dependent updateRequest) ifFalse:[^ false].
+ ]
].
^ true
!
@@ -1895,7 +1887,7 @@
and anArgument as arguments."
self dependentsDo:[:dependent |
- dependent update:aParameter with:anArgument from:self
+ dependent update:aParameter with:anArgument from:self
]
!
@@ -1964,21 +1956,20 @@
(self dependents includesIdentical:someone)
ifFalse:[
- ^ aBlock value.
+ ^ aBlock value.
].
self removeDependent:someone.
^ aBlock ensure:[ self addDependent:someone ]
! !
-
!Object methodsFor:'comparing'!
= anObject
"return true, if the receiver and the arg have the same structure.
Notice:
- This method is partially open coded (inlined) by the compiler(s)
- identical objects are always considered equal.
- redefining it may not work as expected."
+ This method is partially open coded (inlined) by the compiler(s)
+ identical objects are always considered equal.
+ redefining it may not work as expected."
^ self == anObject
!
@@ -1987,8 +1978,8 @@
"return true, if the receiver and the arg are the same object.
Never redefine this in any class.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
%{ /* NOCONTEXT */
@@ -2006,28 +1997,28 @@
myClass := self class.
myClass isVariable ifTrue:[
- sz := self basicSize.
-
- "compare the indexed variables"
- 1 to:sz do:[:i |
- val := self basicAt:i.
- val isLiteral ifTrue:[
- val = (anObject basicAt:i) ifFalse:[^ false].
- ] ifFalse:[
- (val deepSameContentsAs:(anObject basicAt:i)) ifFalse:[^ false].
- ]
- ]
+ sz := self basicSize.
+
+ "compare the indexed variables"
+ 1 to:sz do:[:i |
+ val := self basicAt:i.
+ val isLiteral ifTrue:[
+ val = (anObject basicAt:i) ifFalse:[^ false].
+ ] ifFalse:[
+ (val deepSameContentsAs:(anObject basicAt:i)) ifFalse:[^ false].
+ ]
+ ]
].
"compare the instance variables"
sz := myClass instSize.
1 to:sz do:[:i |
- val := self instVarAt:i.
- val isLiteral ifTrue:[
- val = (anObject instVarAt:i) ifFalse:[^ false].
- ] ifFalse:[
- (val deepSameContentsAs:(anObject instVarAt:i)) ifFalse:[^ false].
- ]
+ val := self instVarAt:i.
+ val isLiteral ifTrue:[
+ val = (anObject instVarAt:i) ifFalse:[^ false].
+ ] ifFalse:[
+ (val deepSameContentsAs:(anObject instVarAt:i)) ifFalse:[^ false].
+ ]
].
^ true
@@ -2066,25 +2057,25 @@
static unsigned nextHash = 0;
if (__isNonNilObject(self)) {
- hash = __GET_HASH(self);
- if (hash == 0) {
- /* has no hash yet */
-
- if (++nextHash > __MAX_HASH__) {
- nextHash = 1;
- }
- hash = nextHash;
- __SET_HASH(self, hash);
- }
-
- /*
- * now, we got 11 bits for hashing;
- * make it as large as possible; since most hashers use the returned
- * key and take it modulo some prime number, this will allow for
- * better distribution (i.e. bigger empty spaces) in hashed collection.
- */
- hash = __MAKE_HASH__(hash);
- RETURN ( __mkSmallInteger(hash) );
+ hash = __GET_HASH(self);
+ if (hash == 0) {
+ /* has no hash yet */
+
+ if (++nextHash > __MAX_HASH__) {
+ nextHash = 1;
+ }
+ hash = nextHash;
+ __SET_HASH(self, hash);
+ }
+
+ /*
+ * now, we got 11 bits for hashing;
+ * make it as large as possible; since most hashers use the returned
+ * key and take it modulo some prime number, this will allow for
+ * better distribution (i.e. bigger empty spaces) in hashed collection.
+ */
+ hash = __MAKE_HASH__(hash);
+ RETURN ( __mkSmallInteger(hash) );
}
%}.
^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
@@ -2104,53 +2095,53 @@
static unsigned INT nextClassHash = 0;
if (__isNonNilObject(self)) {
- /*
- * my own identityHash
- */
- hash1 = __GET_HASH(self);
- if (hash1 == 0) {
- /* has no hash yet */
-
- if (++nextHash > __MAX_HASH__) {
- nextHash = 1;
- }
- hash1 = nextHash;
- __SET_HASH(self, hash1);
- }
- /*
- * my classes identityHash
- */
- o = __qClass(self);
- hash2 = __GET_HASH(o);
- if (hash2 == 0) {
- /* has no hash yet */
-
- if (++nextClassHash > __MAX_HASH__) {
- nextClassHash = 1;
- }
- hash2 = nextClassHash;
- __SET_HASH(o, hash2);
- }
-
- /*
- * some bits of my size
- */
- sz = __qSize(self);
-
- /*
- * now, we got 11 + 11 + 8 bits for hashing;
- * make it as large as possible; since most hashers use the returned
- * key and take it modulo some prime number, this will allow for
- * better distribution (i.e. bigger empty spaces) in hashed collection.
- */
- hash = (hash1 << 11) | hash2; /* 22 bits */
- hash = (hash << 8) | (sz & 0xFC); /* 30 bits */
-
- while ((hash & 0x20000000) == 0) {
- hash <<= 1;
- }
-
- RETURN ( __mkSmallInteger(hash) );
+ /*
+ * my own identityHash
+ */
+ hash1 = __GET_HASH(self);
+ if (hash1 == 0) {
+ /* has no hash yet */
+
+ if (++nextHash > __MAX_HASH__) {
+ nextHash = 1;
+ }
+ hash1 = nextHash;
+ __SET_HASH(self, hash1);
+ }
+ /*
+ * my classes identityHash
+ */
+ o = __qClass(self);
+ hash2 = __GET_HASH(o);
+ if (hash2 == 0) {
+ /* has no hash yet */
+
+ if (++nextClassHash > __MAX_HASH__) {
+ nextClassHash = 1;
+ }
+ hash2 = nextClassHash;
+ __SET_HASH(o, hash2);
+ }
+
+ /*
+ * some bits of my size
+ */
+ sz = __qSize(self);
+
+ /*
+ * now, we got 11 + 11 + 8 bits for hashing;
+ * make it as large as possible; since most hashers use the returned
+ * key and take it modulo some prime number, this will allow for
+ * better distribution (i.e. bigger empty spaces) in hashed collection.
+ */
+ hash = (hash1 << 11) | hash2; /* 22 bits */
+ hash = (hash << 8) | (sz & 0xFC); /* 30 bits */
+
+ while ((hash & 0x20000000) == 0) {
+ hash <<= 1;
+ }
+
+ RETURN ( __mkSmallInteger(hash) );
}
%}.
"never reached, since UndefinedObject and SmallInteger are not hashed upon in binary storage"
@@ -2169,13 +2160,13 @@
myClass := self class.
myClass isVariable ifTrue:[
- sz := self basicSize.
- anObject basicSize >= sz ifFalse:[^ false].
-
- "compare the indexed variables"
- 1 to:sz do:[:i |
- (self basicAt:i) == (anObject basicAt:i) ifFalse:[^ false].
- ]
+ sz := self basicSize.
+ anObject basicSize >= sz ifFalse:[^ false].
+
+ "compare the indexed variables"
+ 1 to:sz do:[:i |
+ (self basicAt:i) == (anObject basicAt:i) ifFalse:[^ false].
+ ]
].
"compare the instance variables"
@@ -2183,7 +2174,7 @@
anObject class instSize >= sz ifFalse:[^ false].
1 to:sz do:[:i |
- (self instVarAt:i) == (anObject instVarAt:i) ifFalse:[^ false].
+ (self instVarAt:i) == (anObject instVarAt:i) ifFalse:[^ false].
].
^ true
@@ -2200,9 +2191,9 @@
~= anObject
"return true, if the receiver and the arg do not have the same structure.
Notice:
- This method is partially open coded (inlined) by the compiler(s)
- identical objects are never considered unequal.
- redefining it may not work as expected."
+ This method is partially open coded (inlined) by the compiler(s)
+ identical objects are never considered unequal.
+ redefining it may not work as expected."
^ (self = anObject) not
!
@@ -2211,8 +2202,8 @@
"return true, if the receiver and the arg are not the same object.
Never redefine this in any class.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
%{ /* NOCONTEXT */
RETURN ( (self == anObject) ? false : true );
@@ -2299,24 +2290,24 @@
"process the named instance variables"
sz := myClass instSize.
1 to:sz do:[:i |
- t := anObject instVarAt:i.
- aSymbol ~~ #yourself ifTrue:[
- t := t perform:aSymbol
- ].
- self instVarAt:i put:t
+ t := anObject instVarAt:i.
+ aSymbol ~~ #yourself ifTrue:[
+ t := t perform:aSymbol
+ ].
+ self instVarAt:i put:t
].
myClass isVariable ifTrue:[
- sz := self basicSize.
-
- "process the indexed instance variables"
- 1 to:sz do:[:i |
- t := anObject basicAt:i.
- aSymbol ~~ #yourself ifTrue:[
- t := t perform:aSymbol.
- ].
- self basicAt:i put:t.
- ]
+ sz := self basicSize.
+
+ "process the indexed instance variables"
+ 1 to:sz do:[:i |
+ t := anObject basicAt:i.
+ aSymbol ~~ #yourself ifTrue:[
+ t := t perform:aSymbol.
+ ].
+ self basicAt:i put:t.
+ ]
].
!
@@ -2334,51 +2325,51 @@
prototypesClass := aPrototype class.
(myClass == prototypesClass
or:[ myClass isSubclassOf:prototypesClass ]) ifTrue:[
- "/ can do better, if my class is a subclass of the prototype's class
- 1 to: prototypesClass instSize do:[:index |
- self instVarAt:index put:(aPrototype instVarAt:index)
- ]
+ "/ can do better, if my class is a subclass of the prototype's class
+ 1 to: prototypesClass instSize do:[:index |
+ self instVarAt:index put:(aPrototype instVarAt:index)
+ ]
] ifFalse:[
- "/ map instvars by name
- myInfo := myClass instanceVariableOffsets.
- prototypesInfo := prototypesClass instanceVariableOffsets.
- myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
- varIndexAssoc := prototypesInfo at:name ifAbsent:[].
- varIndexAssoc notNil ifTrue:[
- self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
- ]
- ]
+ "/ map instvars by name
+ myInfo := myClass instanceVariableOffsets.
+ prototypesInfo := prototypesClass instanceVariableOffsets.
+ myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
+ varIndexAssoc := prototypesInfo at:name ifAbsent:[].
+ varIndexAssoc notNil ifTrue:[
+ self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
+ ]
+ ]
].
myClass isVariable ifTrue:[
- prototypesClass isVariable ifTrue:[
- 1 to:(self basicSize min:aPrototype basicSize) do:[:index |
- self basicAt:index put:(aPrototype basicAt:index)
- ].
- ].
+ prototypesClass isVariable ifTrue:[
+ 1 to:(self basicSize min:aPrototype basicSize) do:[:index |
+ self basicAt:index put:(aPrototype basicAt:index)
+ ].
+ ].
].
"
Class withoutUpdatingChangesDo:[
- |point3D|
-
- point3D := Point subclass:#Point3D
- instanceVariableNames:'z'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'
- inEnvironment:nil.
- (point3D new cloneInstanceVariablesFrom:1@2) inspect.
+ |point3D|
+
+ point3D := Point subclass:#Point3D
+ instanceVariableNames:'z'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'
+ inEnvironment:nil.
+ (point3D new cloneInstanceVariablesFrom:1@2) inspect.
]
"
"
Class withoutUpdatingChangesDo:[
- Point variableSubclass:#Point3D_test
- instanceVariableNames:'z'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (((Smalltalk at:#Point3D_test) new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
+ Point variableSubclass:#Point3D_test
+ instanceVariableNames:'z'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (((Smalltalk at:#Point3D_test) new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
]
"
@@ -2386,19 +2377,19 @@
|someObject|
Class withoutUpdatingChangesDo:[
- Object subclass:#TestClass1
- instanceVariableNames:'foo bar'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- someObject := TestClass1 new.
- someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
- Object subclass:#TestClass2
- instanceVariableNames:'bar foo'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
+ Object subclass:#TestClass1
+ instanceVariableNames:'foo bar'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ someObject := TestClass1 new.
+ someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
+ Object subclass:#TestClass2
+ instanceVariableNames:'bar foo'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
]
"
@@ -2428,8 +2419,8 @@
copyToLevel:level
"a controlled deepCopy, where the number of levels can be specified.
Notice:
- This method DOES NOT handle cycles/self-refs and does NOT preserve object identity;
- i.e. identical references in the source are copied multiple times into the copy."
+ This method DOES NOT handle cycles/self-refs and does NOT preserve object identity;
+ i.e. identical references in the source are copied multiple times into the copy."
|newObject newLevel class sz "{Class: SmallInteger}" newInst|
@@ -2443,22 +2434,22 @@
"process the named instance variables"
sz := class instSize.
1 to:sz do:[:i |
- newInst := newObject instVarAt:i.
- newInst notNil ifTrue:[
- newObject instVarAt:i put:(newInst copyToLevel:newLevel).
- ].
+ newInst := newObject instVarAt:i.
+ newInst notNil ifTrue:[
+ newObject instVarAt:i put:(newInst copyToLevel:newLevel).
+ ].
].
class isVariable ifTrue:[
- sz := newObject basicSize.
-
- "process the indexed instance variables"
- 1 to:sz do:[:i |
- newInst := newObject basicAt:i.
- newInst notNil ifTrue:[
- newObject basicAt:i put:(newInst copyToLevel:newLevel).
- ].
- ]
+ sz := newObject basicSize.
+
+ "process the indexed instance variables"
+ 1 to:sz do:[:i |
+ newInst := newObject basicAt:i.
+ newInst notNil ifTrue:[
+ newObject basicAt:i put:(newInst copyToLevel:newLevel).
+ ].
+ ]
].
^ newObject
@@ -2466,24 +2457,24 @@
|a b|
a := #(
- '1.1'
- '1.2'
- '1.3'
- (
- '1.41'
- '1.42'
- '1.43'
- (
- '1.441'
- '1.442'
- '1.443'
- ( '1.4441' '1.4442' '1.4443' )
- '1.445'
- )
- '1.45'
- )
- '1.5'
- ).
+ '1.1'
+ '1.2'
+ '1.3'
+ (
+ '1.41'
+ '1.42'
+ '1.43'
+ (
+ '1.441'
+ '1.442'
+ '1.443'
+ ( '1.4441' '1.4442' '1.4443' )
+ '1.445'
+ )
+ '1.45'
+ )
+ '1.5'
+ ).
b := a copyToLevel:1.
self assert: ( (a at:1) == (b at:1) ).
@@ -2580,11 +2571,11 @@
myClass := self class.
myClass isVariable ifTrue:[
- basicSize := self basicSize.
- aCopy := myClass basicNew:basicSize.
+ basicSize := self basicSize.
+ aCopy := myClass basicNew:basicSize.
] ifFalse:[
- basicSize := 0.
- aCopy := myClass basicNew
+ basicSize := 0.
+ aCopy := myClass basicNew
].
aCopy setHashFrom:self.
aDictionary at:self put:aCopy.
@@ -2594,40 +2585,40 @@
"
instSize := myClass instSize.
1 to:instSize do:[:i |
- (self skipInstvarIndexInDeepCopy:i) ifFalse:[
- iOrig := self instVarAt:i.
- iOrig notNil ifTrue:[
- iCopy := aDictionary at:iOrig ifAbsent:nil.
- iCopy isNil ifTrue:[
- iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
- ].
- aCopy instVarAt:i put:iCopy
- ]
- ]
+ (self skipInstvarIndexInDeepCopy:i) ifFalse:[
+ iOrig := self instVarAt:i.
+ iOrig notNil ifTrue:[
+ iCopy := aDictionary at:iOrig ifAbsent:nil.
+ iCopy isNil ifTrue:[
+ iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
+ ].
+ aCopy instVarAt:i put:iCopy
+ ]
+ ]
].
"
copy indexed instvars - if any
"
basicSize ~~ 0 ifTrue:[
- myClass isBits ifTrue:[
- "block-copy indexed instvars"
- aCopy replaceFrom:1 to:basicSize with:self startingAt:1
- ] ifFalse:[
- "individual deep copy the indexed variables"
- 1 to:basicSize do:[:i |
- iOrig := self basicAt:i.
- iOrig notNil ifTrue:[
- "/ used to be dict-includesKey-ifTrue[dict-at:],
- "/ changed to use dict-at:ifAbsent:, to avoid double lookup in dictionary
- iCopy := aDictionary at:iOrig ifAbsent:nil.
- iCopy isNil ifTrue:[
- iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
- ].
- aCopy basicAt:i put:iCopy
- ]
- ]
- ]
+ myClass isBits ifTrue:[
+ "block-copy indexed instvars"
+ aCopy replaceFrom:1 to:basicSize with:self startingAt:1
+ ] ifFalse:[
+ "individual deep copy the indexed variables"
+ 1 to:basicSize do:[:i |
+ iOrig := self basicAt:i.
+ iOrig notNil ifTrue:[
+ "/ used to be dict-includesKey-ifTrue[dict-at:],
+ "/ changed to use dict-at:ifAbsent:, to avoid double lookup in dictionary
+ iCopy := aDictionary at:iOrig ifAbsent:nil.
+ iCopy isNil ifTrue:[
+ iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
+ ].
+ aCopy basicAt:i put:iCopy
+ ]
+ ]
+ ]
].
aCopy perform:postCopySelector withOptionalArgument:self and:aDictionary.
@@ -2666,9 +2657,9 @@
REGISTER unsigned h;
if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
- h = __GET_HASH(anObject);
- __SET_HASH(self, h);
- RETURN (self);
+ h = __GET_HASH(anObject);
+ __SET_HASH(self, h);
+ RETURN (self);
}
%}.
self primitiveFailed "neither receiver not arg may be nil or SmallInteger"
@@ -2693,54 +2684,54 @@
*/
if (((flags & ~ARRAYMASK) == 0)
&& ((flags & ARRAYMASK) != WKPOINTERARRAY)) {
- sz = __qSize(self);
- __PROTECT__(self);
- __qNew(theCopy, sz); /* OBJECT ALLOCATION */
- __UNPROTECT__(self);
- if (theCopy) {
- cls = __qClass(self);
- spc = __qSpace(theCopy);
-
- theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
-
- sz = sz - OHDR_SIZE;
- if (sz) {
- char *src, *dst;
-
- src = (char *)(__InstPtr(self)->i_instvars);
- dst = (char *)(__InstPtr(theCopy)->i_instvars);
+ sz = __qSize(self);
+ __PROTECT__(self);
+ __qNew(theCopy, sz); /* OBJECT ALLOCATION */
+ __UNPROTECT__(self);
+ if (theCopy) {
+ cls = __qClass(self);
+ spc = __qSpace(theCopy);
+
+ theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
+
+ sz = sz - OHDR_SIZE;
+ if (sz) {
+ char *src, *dst;
+
+ src = (char *)(__InstPtr(self)->i_instvars);
+ dst = (char *)(__InstPtr(theCopy)->i_instvars);
#ifdef bcopy4
- {
- /* care for odd-number of longs */
- int nW = sz >> 2;
-
- if (sz & 3) {
- nW++;
- }
-
- bcopy4(src, dst, nW);
- }
+ {
+ /* care for odd-number of longs */
+ int nW = sz >> 2;
+
+ if (sz & 3) {
+ nW++;
+ }
+
+ bcopy4(src, dst, nW);
+ }
#else
- bcopy(src, dst, sz);
+ bcopy(src, dst, sz);
#endif
- flags &= ARRAYMASK;
- if (flags == POINTERARRAY) {
- ninsts = __BYTES2OBJS__(sz);
- } else {
- ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
- }
- if (ninsts) {
- do {
- OBJ el;
-
- el = __InstPtr(theCopy)->i_instvars[ninsts-1];
- __STORE_SPC(theCopy, el, spc);
- } while (--ninsts);
- }
- }
- RETURN (theCopy);
- }
+ flags &= ARRAYMASK;
+ if (flags == POINTERARRAY) {
+ ninsts = __BYTES2OBJS__(sz);
+ } else {
+ ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
+ }
+ if (ninsts) {
+ do {
+ OBJ el;
+
+ el = __InstPtr(theCopy)->i_instvars[ninsts-1];
+ __STORE_SPC(theCopy, el, spc);
+ } while (--ninsts);
+ }
+ }
+ RETURN (theCopy);
+ }
}
%}.
"/ fallBack for special objects & memoryAllocation failure case
@@ -2760,9 +2751,9 @@
|myClass aCopy|
(myClass := self class) isVariable ifTrue:[
- aCopy := myClass basicNew:(self basicSize).
+ aCopy := myClass basicNew:(self basicSize).
] ifFalse:[
- aCopy := myClass basicNew
+ aCopy := myClass basicNew
].
"copy the instance variables"
@@ -2795,9 +2786,9 @@
|myClass aCopy|
(myClass := self class) isVariable ifTrue:[
- aCopy := myClass basicNew:(self basicSize).
+ aCopy := myClass basicNew:(self basicSize).
] ifFalse:[
- aCopy := myClass basicNew
+ aCopy := myClass basicNew
].
"copy the instance variables"
@@ -2819,11 +2810,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,']')
].
"
@@ -2844,9 +2835,9 @@
(Smalltalk at:#IgnoreAssertion ifAbsent:false) == true ifTrue:[^ self].
(aBooleanOrBlock value) ifFalse:[
- AssertionFailedError
- raiseRequestWith:self
- errorString:(messageIfFailing, ' {',thisContext methodHome sender "methodHome" printString,' }')
+ AssertionFailedError
+ raiseRequestWith:self
+ errorString:(messageIfFailing, ' {',thisContext methodHome sender "methodHome" printString,' }')
].
"
@@ -2863,12 +2854,12 @@
this method should NOT be redefined in subclasses."
Inspector isNil ifTrue:[
- "
- for systems without GUI
- "
- self warn:'No Inspector defined (Inspector is nil).'
+ "
+ for systems without GUI
+ "
+ self warn:'No Inspector defined (Inspector is nil).'
] ifFalse:[
- Inspector openOn:self
+ Inspector openOn:self
]
"Modified: 18.5.1996 / 15:43:25 / cg"
@@ -2888,9 +2879,9 @@
"/ dont send #breakPoint:info: here - ask cg why.
(self isBreakPointEnabled:someKey) ifTrue:[
- ^ HaltSignal
- raiseRequestWith:someKey
- errorString:('Breakpoint encountered: %1' bindWith:someKey)
+ ^ HaltSignal
+ raiseRequestWith:someKey
+ errorString:('Breakpoint encountered: %1' bindWith:someKey)
].
"
@@ -2918,9 +2909,9 @@
<resource: #skipInDebuggersWalkBack>
(self isBreakPointEnabled:someKey) ifTrue:[
- ^ HaltSignal
- raiseRequestWith:someKey
- errorString:(infoString bindWith:someKey)
+ ^ HaltSignal
+ raiseRequestWith:someKey
+ errorString:(infoString bindWith:someKey)
].
!
@@ -2950,7 +2941,7 @@
<resource: #skipInDebuggersWalkBack>
(self isBreakPointEnabled:someKey) ifTrue:[
- aBlock value
+ aBlock value
].
"
@@ -2986,8 +2977,8 @@
"{ Pragma: +optSpace }"
EnabledBreakPoints notNil ifTrue:[
- EnabledBreakPoints remove:someKey ifAbsent:[].
- EnabledBreakPoints := EnabledBreakPoints asNilIfEmpty.
+ EnabledBreakPoints remove:someKey ifAbsent:[].
+ EnabledBreakPoints := EnabledBreakPoints asNilIfEmpty.
].
"
@@ -3006,7 +2997,7 @@
"{ Pragma: +optSpace }"
EnabledBreakPoints isNil ifTrue:[
- EnabledBreakPoints := Set new.
+ EnabledBreakPoints := Set new.
].
EnabledBreakPoints add:someKey.
@@ -3034,7 +3025,7 @@
^ self
"
- (3 halt * 5)
+ (3 halt * 5)
"
"Modified: / 02-08-1999 / 17:00:29 / stefan"
@@ -3064,7 +3055,7 @@
"/ something = OperatingSystem getLoginName ifTrue:[^ true].
"/ something = 'testThis' ifTrue:[^ true].
EncounteredBreakPoints notNil ifTrue:[
- EncounteredBreakPoints add:someKey
+ EncounteredBreakPoints add:someKey
].
^ (EnabledBreakPoints notNil and:[ EnabledBreakPoints includes:someKey ])
@@ -3095,18 +3086,18 @@
"for compatibility & debugging support:
check if the receiver isKindOf:aClass and raise an error if not.
Notice:
- it is VERY questionable, if it makes sense to add manual
- type checks to a dynamically typed language like smalltalk.
- It will, at least, slow down performance,
- make your code less reusable and clutter your code with stupid sends
- of this selector. Also, read the comment in isKindOf:, regarding the
- use of isXXX check methods.
+ it is VERY questionable, if it makes sense to add manual
+ type checks to a dynamically typed language like smalltalk.
+ It will, at least, slow down performance,
+ make your code less reusable and clutter your code with stupid sends
+ of this selector. Also, read the comment in isKindOf:, regarding the
+ use of isXXX check methods.
You see: The author does not like this at all ..."
<resource: #skipInDebuggersWalkBack>
(self isKindOf:aClass) ifFalse:[
- self error:'argument is not of expected type'
+ self error:'argument is not of expected type'
]
!
@@ -3154,7 +3145,7 @@
(' called from ' , sender sender printString) infoPrintCR.
].
message notNil ifTrue:[
- '------> ' infoPrint. message infoPrintCR
+ '------> ' infoPrint. message infoPrintCR
]
"
@@ -3240,9 +3231,9 @@
"
example:
- ...
- self todo.
- ...
+ ...
+ self todo.
+ ...
"
!
@@ -3257,11 +3248,11 @@
"
example:
- ...
- self todo:[
- code which needs more work ...
- ].
- ...
+ ...
+ self todo:[
+ code which needs more work ...
+ ].
+ ...
"
"Created: / 25-05-2007 / 21:34:39 / cg"
@@ -3338,35 +3329,35 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps dep|
-
- deps := self dependents.
-
- "/ to save a fair amount of memory in case of
- "/ many dependencies, we store a single dependent in
- "/ a WeakArray, and switch to a WeakSet if more dependents are
- "/ added.
-
- (deps isNil or:[deps size == 0]) ifTrue:[
- self dependents:(WeakArray with:anObject)
- ] ifFalse:[
- deps class == WeakArray ifTrue:[
- dep := deps at:1.
- dep ~~ anObject ifTrue:[
- (dep isNil or:[dep == 0]) ifTrue:[
- deps at:1 put:anObject
- ] ifFalse:[
- self dependents:(WeakIdentitySet with:dep with:anObject)
- ]
- ]
- ] ifFalse:[
- deps add:anObject
- ]
- ]
+ |deps dep|
+
+ deps := self dependents.
+
+ "/ to save a fair amount of memory in case of
+ "/ many dependencies, we store a single dependent in
+ "/ a WeakArray, and switch to a WeakSet if more dependents are
+ "/ added.
+
+ (deps isNil or:[deps size == 0]) ifTrue:[
+ self dependents:(WeakArray with:anObject)
+ ] ifFalse:[
+ deps class == WeakArray ifTrue:[
+ dep := deps at:1.
+ dep ~~ anObject ifTrue:[
+ (dep isNil or:[dep == 0]) ifTrue:[
+ deps at:1 put:anObject
+ ] ifFalse:[
+ self dependents:(WeakIdentitySet with:dep with:anObject)
+ ]
+ ]
+ ] ifFalse:[
+ deps add:anObject
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
"Modified: / 27.10.1997 / 19:35:52 / cg"
@@ -3388,10 +3379,10 @@
self breakDependents.
1 to:self class instSize do:[:idx |
- (self instVarAt:idx) breakDependentsRecursively.
+ (self instVarAt:idx) breakDependentsRecursively.
].
1 to:self basicSize do:[:idx |
- (self basicAt:idx) breakDependentsRecursively.
+ (self basicAt:idx) breakDependentsRecursively.
]
!
@@ -3406,7 +3397,7 @@
|deps|
(deps := Dependencies at:self ifAbsent:nil) isNil ifTrue:[
- ^ #().
+ ^ #().
].
^ deps
@@ -3425,24 +3416,24 @@
"/ faster execution (and to avoid creation of garbage blocks).
(OperatingSystem blockInterrupts) ifTrue:[
- "/ the common case - already blocked
-
- (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
- Dependencies removeKey:self ifAbsent:nil
- ] ifFalse:[
- Dependencies at:self put:aCollection
- ].
- ^ self
+ "/ the common case - already blocked
+
+ (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
+ Dependencies removeKey:self ifAbsent:nil
+ ] ifFalse:[
+ Dependencies at:self put:aCollection
+ ].
+ ^ self
].
[
- (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
- Dependencies removeKey:self ifAbsent:nil
- ] ifFalse:[
- Dependencies at:self put:aCollection
- ].
+ (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
+ Dependencies removeKey:self ifAbsent:nil
+ ] ifFalse:[
+ Dependencies at:self put:aCollection
+ ].
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
]
"Modified: 30.1.1997 / 21:22:10 / cg"
@@ -3455,15 +3446,15 @@
deps := self dependents.
deps size ~~ 0 ifTrue:[
- deps do:[:d |
- (d notNil and:[d ~~ 0]) ifTrue:[
- aBlock value:d
- ]
- ]
+ deps do:[:d |
+ (d notNil and:[d ~~ 0]) ifTrue:[
+ aBlock value:d
+ ]
+ ]
].
nwDeps := self nonWeakDependents.
(nwDeps ~~ deps and:[nwDeps size ~~ 0]) ifTrue:[
- nwDeps do:aBlock
+ nwDeps do:aBlock
].
"Modified: / 30.1.1998 / 14:03:40 / cg"
@@ -3496,43 +3487,43 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps n d|
-
- deps := self dependents.
- deps size ~~ 0 ifTrue:[
-
- "/ to save a fair amount of memory in case of
- "/ many dependencies, we store a single dependent in
- "/ a WeakArray, and switch to a WeakSet if more dependents are
- "/ added. Here we have to do the inverse ...
-
- ((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
- ((d := deps at:1) == anObject
- or:[d isNil
- or:[d == 0]]) ifTrue:[
- self dependents:nil
- ]
- ] ifFalse:[
- deps remove:anObject ifAbsent:[].
- (n := deps size) == 0 ifTrue:[
- self dependents:nil
- ] ifFalse:[
- n == 1 ifTrue:[
- d := deps firstIfEmpty:nil.
- d notNil ifTrue:[
- deps := (deps isWeakCollection ifTrue:[WeakArray] ifFalse:[Array]) with:d
- ] ifFalse:[
- deps := nil
- ].
- self dependents:deps.
- ]
- ]
- ]
- ]
+ |deps n d|
+
+ deps := self dependents.
+ deps size ~~ 0 ifTrue:[
+
+ "/ to save a fair amount of memory in case of
+ "/ many dependencies, we store a single dependent in
+ "/ a WeakArray, and switch to a WeakSet if more dependents are
+ "/ added. Here we have to do the inverse ...
+
+ ((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
+ ((d := deps at:1) == anObject
+ or:[d isNil
+ or:[d == 0]]) ifTrue:[
+ self dependents:nil
+ ]
+ ] ifFalse:[
+ deps remove:anObject ifAbsent:[].
+ (n := deps size) == 0 ifTrue:[
+ self dependents:nil
+ ] ifFalse:[
+ n == 1 ifTrue:[
+ d := deps firstIfEmpty:nil.
+ d notNil ifTrue:[
+ deps := (deps isWeakCollection ifTrue:[WeakArray] ifFalse:[Array]) with:d
+ ] ifFalse:[
+ deps := nil
+ ].
+ self dependents:deps.
+ ]
+ ]
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
"Modified: / 05-07-2011 / 22:49:31 / cg"
@@ -3555,37 +3546,37 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps dep|
-
- deps := self nonWeakDependents.
-
- "/ to save a fair amount of memory in case of
- "/ many dependencies, we store a single dependent in
- "/ an Array, and switch to a Set if more dependents are
- "/ added.
-
- deps size == 0 ifTrue:[
- anObject notNil ifTrue:[
- self nonWeakDependents:(Array with:anObject).
- ] ifFalse:[
- "adding nil causes problems when adding the next one
- (see below: trying to add nil to IdentitySet)"
+ |deps dep|
+
+ deps := self nonWeakDependents.
+
+ "/ to save a fair amount of memory in case of
+ "/ many dependencies, we store a single dependent in
+ "/ an Array, and switch to a Set if more dependents are
+ "/ added.
+
+ deps size == 0 ifTrue:[
+ anObject notNil ifTrue:[
+ self nonWeakDependents:(Array with:anObject).
+ ] ifFalse:[
+ "adding nil causes problems when adding the next one
+ (see below: trying to add nil to IdentitySet)"
"/ self halt:'try to add nil to list of dependents'.
- ].
- ] ifFalse:[
- deps class == Array ifTrue:[
- dep := deps at:1.
- dep ~~ anObject ifTrue:[
- self nonWeakDependents:(IdentitySet with:dep with:anObject)
- ]
- ] ifFalse:[
- deps add:anObject
- ]
- ]
+ ].
+ ] ifFalse:[
+ deps class == Array ifTrue:[
+ dep := deps at:1.
+ dep ~~ anObject ifTrue:[
+ self nonWeakDependents:(IdentitySet with:dep with:anObject)
+ ]
+ ] ifFalse:[
+ deps add:anObject
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
"Created: / 19.4.1996 / 10:54:08 / cg"
@@ -3608,11 +3599,11 @@
This is a private helper for directed dependencies."
[
- (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
- NonWeakDependencies removeKey:self ifAbsent:nil
- ] ifFalse:[
- NonWeakDependencies at:self put:aCollection
- ]
+ (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
+ NonWeakDependencies removeKey:self ifAbsent:nil
+ ] ifFalse:[
+ NonWeakDependencies at:self put:aCollection
+ ]
] valueUninterruptably
"Created: 19.4.1996 / 11:07:47 / cg"
@@ -3631,37 +3622,35 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps n|
-
- deps := self nonWeakDependents.
- deps size ~~ 0 ifTrue:[
- deps class == Array ifTrue:[
- (deps at:1) == anObject ifTrue:[
- self nonWeakDependents:nil
- ]
- ] ifFalse:[
- deps remove:anObject ifAbsent:[].
- (n := deps size) == 0 ifTrue:[
- self nonWeakDependents:nil
- ] ifFalse:[
- n == 1 ifTrue:[
- self nonWeakDependents:(Array with:(deps first))
- ]
- ]
- ]
- ]
+ |deps n|
+
+ deps := self nonWeakDependents.
+ deps size ~~ 0 ifTrue:[
+ deps class == Array ifTrue:[
+ (deps at:1) == anObject ifTrue:[
+ self nonWeakDependents:nil
+ ]
+ ] ifFalse:[
+ deps remove:anObject ifAbsent:[].
+ (n := deps size) == 0 ifTrue:[
+ self nonWeakDependents:nil
+ ] ifFalse:[
+ n == 1 ifTrue:[
+ self nonWeakDependents:(Array with:(deps first))
+ ]
+ ]
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
"Created: / 19.4.1996 / 11:44:44 / cg"
"Modified: / 30.1.1998 / 14:04:01 / cg"
! !
-
-
!Object methodsFor:'displaying'!
ascentOn:aGC
@@ -3686,8 +3675,8 @@
"/ 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 ifTrue:[
- self printOn:aGCOrStream.
- ^ self
+ self printOn:aGCOrStream.
+ ^ self
].
^ self displayOn:aGCOrStream x:0 y:0.
@@ -3723,9 +3712,9 @@
s := self isString ifTrue:[self] ifFalse:[self displayString].
yBaseline := y "+ aGc font ascent".
opaque ifTrue:[
- aGc displayOpaqueString:s x:x y:yBaseline.
+ aGc displayOpaqueString:s x:x y:yBaseline.
] ifFalse:[
- aGc displayString:s x:x y:yBaseline.
+ aGc displayString:s x:x y:yBaseline.
].
"Modified: 29.5.1996 / 16:29:38 / cg"
@@ -3909,22 +3898,22 @@
stop := aSpecArray size.
2 to:stop by:2 do:[:i|
- sel := aSpecArray at:i.
- litVal := aSpecArray at:i + 1.
-
- (self respondsTo:sel) ifTrue:[
- val := litVal decodeAsLiteralArray.
- self perform:sel with:val
- ] ifFalse:[
- Transcript show:self class name; show:': unhandled literalArrayEncoding attribute: '.
- Transcript showCR:sel.
-
- "/ thats a debug halt,
- "/ it should probably be removed (to simply ignore unhandled attributes)...
- "/ for now, it is left in, in order to easily find incompatibilities between
- "/ VW and ST/X.
- self breakPoint:#cg.
- ]
+ sel := aSpecArray at:i.
+ litVal := aSpecArray at:i + 1.
+
+ (self respondsTo:sel) ifTrue:[
+ val := litVal decodeAsLiteralArray.
+ self perform:sel with:val
+ ] ifFalse:[
+ Transcript show:self class name; show:': unhandled literalArrayEncoding attribute: '.
+ Transcript showCR:sel.
+
+ "/ thats a debug halt,
+ "/ it should probably be removed (to simply ignore unhandled attributes)...
+ "/ for now, it is left in, in order to easily find incompatibilities between
+ "/ VW and ST/X.
+ self breakPoint:#cg.
+ ]
]
!
@@ -3937,7 +3926,7 @@
|names encoding cls skipped slots|
self isLiteral ifTrue:[
- ^ self
+ ^ self
].
slots := self literalArrayEncodingSlotOrder.
@@ -3948,22 +3937,22 @@
encoding add:cls name.
slots do:[:instSlot |
- |value nm|
-
- nm := names at:instSlot.
- (skipped includes:nm) ifFalse:[
- (value := self instVarAt:instSlot) notNil ifTrue:[
- encoding add:(nm , ':') asSymbol.
- encoding add:value literalArrayEncoding
- ]
- ]
+ |value nm|
+
+ nm := names at:instSlot.
+ (skipped includes:nm) ifFalse:[
+ (value := self instVarAt:instSlot) notNil ifTrue:[
+ encoding add:(nm , ':') asSymbol.
+ encoding add:value literalArrayEncoding
+ ]
+ ]
].
^ encoding asArray
"
- (1 -> 2) literalArrayEncoding
- DebugView menuSpec decodeAsLiteralArray literalArrayEncoding =
- DebugView menuSpec
+ (1 -> 2) literalArrayEncoding
+ DebugView menuSpec decodeAsLiteralArray literalArrayEncoding =
+ DebugView menuSpec
"
!
@@ -4020,34 +4009,34 @@
(Processor isNil
or:[Processor activeProcessIsSystemProcess
or:[Smalltalk isInitialized not]]) ifTrue:[
- ^ MiniDebugger
+ ^ MiniDebugger
].
(Screen isNil or:[Screen default isNil or:[Screen default isOpen not]]) ifTrue:[
- Debugger isNil ifTrue:[^ nil].
- ^ MiniDebugger
+ Debugger isNil ifTrue:[^ nil].
+ ^ MiniDebugger
].
context := thisContext.
context := context findNextContextWithSelector:aSelector or:nil or:nil.
[context notNil] whileTrue:[
- ((context receiver class == Debugger)
- and:[context selector == aSelector]) ifTrue:[
- "we are already in some Debugger"
- (Debugger == MiniDebugger) ifTrue:[
- "we are already in the MiniDebugger"
- ErrorRecursion ifFalse:[
- Smalltalk fatalAbort:'recursive error ...'
- ]
- ].
- MiniDebugger isNil ifTrue:[
- Smalltalk fatalAbort:'no debugger'
- ].
-
- "ok, an error occured while in the graphical debugger;
- lets try MiniDebugger"
- ^ MiniDebugger
- ].
- context := context findNextContextWithSelector:aSelector or:nil or:nil.
+ ((context receiver class == Debugger)
+ and:[context selector == aSelector]) ifTrue:[
+ "we are already in some Debugger"
+ (Debugger == MiniDebugger) ifTrue:[
+ "we are already in the MiniDebugger"
+ ErrorRecursion ifFalse:[
+ Smalltalk fatalAbort:'recursive error ...'
+ ]
+ ].
+ MiniDebugger isNil ifTrue:[
+ Smalltalk fatalAbort:'no debugger'
+ ].
+
+ "ok, an error occured while in the graphical debugger;
+ lets try MiniDebugger"
+ ^ MiniDebugger
+ ].
+ context := context findNextContextWithSelector:aSelector or:nil or:nil.
].
"not within Debugger - no problem"
^ Debugger
@@ -4064,8 +4053,8 @@
<resource: #skipInDebuggersWalkBack>
^ VMInternalError
- raiseWith:someReceiver
- errorString:('bad class in send of #' , aMessage selector)
+ raiseWith:someReceiver
+ errorString:('bad class in send of #' , aMessage selector)
"Modified: 23.1.1997 / 00:05:39 / cg"
!
@@ -4202,7 +4191,7 @@
<resource: #skipInDebuggersWalkBack>
mayProceed ifTrue:[
- ^ ProceedableError raiseRequestWith:#error: errorString:aString
+ ^ ProceedableError raiseRequestWith:#error: errorString:aString
].
Error raiseWith:#error: errorString:aString
@@ -4331,7 +4320,7 @@
<resource: #skipInDebuggersWalkBack>
index isInteger ifFalse:[
- ^ self indexNotInteger:index
+ ^ self indexNotInteger:index
].
^ self subscriptBoundsError:index
!
@@ -4346,9 +4335,9 @@
"/ ^ self error:'bad assign of ' , self printString ,
"/ ' (' , self class name , ') to integer-typed variable'
^ InvalidTypeError
- raiseRequestErrorString:(
- 'bad assign of ' , self printString ,
- ' (' , self class name , ') to integer-typed variable')
+ raiseRequestErrorString:(
+ 'bad assign of ' , self printString ,
+ ' (' , self class name , ') to integer-typed variable')
"Modified: / 02-11-2012 / 10:25:36 / cg"
!
@@ -4362,7 +4351,7 @@
"/ self error:'not an executable code object'
^ ExecutionError
- raiseRequestErrorString:'not an executable code object'
+ raiseRequestErrorString:'not an executable code object'
"Created: / 01-08-1997 / 00:16:44 / cg"
!
@@ -4388,7 +4377,7 @@
"/ ^ self error:'argument must be a Rectangle'
^ InvalidTypeError
- raiseRequestErrorString:'argument must be a Rectangle'
+ raiseRequestErrorString:'argument must be a Rectangle'
"Modified: / 02-11-2012 / 10:24:53 / cg"
!
@@ -4402,7 +4391,7 @@
"/ ^ self error:'argument must be a String'
^ InvalidTypeError
- raiseRequestErrorString:'argument must be a String'
+ raiseRequestErrorString:'argument must be a String'
"Modified: / 02-11-2012 / 10:24:35 / cg"
!
@@ -4417,7 +4406,7 @@
<resource: #skipInDebuggersWalkBack>
^ SubscriptOutOfBoundsError
- raiseRequestErrorString:'receiver has no indexed variables'
+ raiseRequestErrorString:'receiver has no indexed variables'
"
1234 at:4
@@ -4459,96 +4448,96 @@
ignore will raise an AbortOperationRequest.
"
Debugger isNil ifTrue:[
- msgString := 'Error: ' , msgString.
-
- thisContext isRecursive ifTrue:[
- msgString errorPrintCR.
- Smalltalk fatalAbort:'recursive unhandled exception'
- ].
-
- Smalltalk isStandAloneApp ifTrue:[
- (ex creator == NoHandlerError and:[HaltInterrupt handles:ex exception]) ifTrue:[
- "/ 'Halt ignored' infoPrintCR.
- ^ nil
- ].
- "don't output the message, if the exception is a UserInterrupt (CTRL-C)"
- (ex creator == NoHandlerError
- and:[ex exception creator == UserInterrupt]) ifTrue:[
- ex description errorPrintCR.
- OperatingSystem exit:130.
- ].
- ].
-
- (Dialog notNil and:[Screen default notNil]) ifTrue:[
+ msgString := 'Error: ' , msgString.
+
+ thisContext isRecursive ifTrue:[
+ msgString errorPrintCR.
+ Smalltalk fatalAbort:'recursive unhandled exception'
+ ].
+
+ Smalltalk isStandAloneApp ifTrue:[
+ (ex creator == NoHandlerError and:[HaltInterrupt handles:ex exception]) ifTrue:[
+ "/ 'Halt ignored' infoPrintCR.
+ ^ nil
+ ].
+ "don't output the message, if the exception is a UserInterrupt (CTRL-C)"
+ (ex creator == NoHandlerError
+ and:[ex exception creator == UserInterrupt]) ifTrue:[
+ ex description errorPrintCR.
+ OperatingSystem exit:130.
+ ].
+ ].
+
+ (Dialog notNil and:[Screen default notNil]) ifTrue:[
false "oldCode" ifTrue:[
- AbortOperationRequest isHandled ifTrue:[
- answer := OptionBox
- request:msgString
- label:msgString
- buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' 'Abort' )
- values:#(exit terminate ignore abort)
- default:#abort.
- ] ifFalse:[
- answer := OptionBox
- request:msgString
- label:msgString
- buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' )
- values:#(exit terminate ignore )
- default:#terminate.
- ].
- answer isNil ifTrue:[ answer := #ignore].
-
- answer == #abort ifTrue:[
- ^ AbortOperationRequest raiseRequest
- ].
- answer == #ignore ifTrue:[
- ^ nil
- ].
- answer == #terminate ifTrue:[
- Processor activeProcess isSystemProcess ifTrue:[
- (Dialog confirm:'Are you sure (this might finish the application)') ifFalse:[
- ^ nil
- ].
- ].
- ^ Processor activeProcess terminate.
- ].
- "asking second time here to prevent the user from accidently closing his app"
- answer == #exit ifTrue:[
- answer := OptionBox
- request:'Do you really wish to exit this application (all changes will be lost)?'
- label:msgString
- buttonLabels:#('Yes' 'No' )
- values:#(exit abort)
- default:#abort.
- ].
- answer == #abort ifTrue:[
- ^ AbortOperationRequest raiseRequest
- ].
-
- (Dialog confirm:'Are you sure you want to finish the application ?') ifFalse:[
- ^ nil
- ].
+ AbortOperationRequest isHandled ifTrue:[
+ answer := OptionBox
+ request:msgString
+ label:msgString
+ buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' 'Abort' )
+ values:#(exit terminate ignore abort)
+ default:#abort.
+ ] ifFalse:[
+ answer := OptionBox
+ request:msgString
+ label:msgString
+ buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' )
+ values:#(exit terminate ignore )
+ default:#terminate.
+ ].
+ answer isNil ifTrue:[ answer := #ignore].
+
+ answer == #abort ifTrue:[
+ ^ AbortOperationRequest raiseRequest
+ ].
+ answer == #ignore ifTrue:[
+ ^ nil
+ ].
+ answer == #terminate ifTrue:[
+ Processor activeProcess isSystemProcess ifTrue:[
+ (Dialog confirm:'Are you sure (this might finish the application)') ifFalse:[
+ ^ nil
+ ].
+ ].
+ ^ Processor activeProcess terminate.
+ ].
+ "asking second time here to prevent the user from accidently closing his app"
+ answer == #exit ifTrue:[
+ answer := OptionBox
+ request:'Do you really wish to exit this application (all changes will be lost)?'
+ label:msgString
+ buttonLabels:#('Yes' 'No' )
+ values:#(exit abort)
+ default:#abort.
+ ].
+ answer == #abort ifTrue:[
+ ^ AbortOperationRequest raiseRequest
+ ].
+
+ (Dialog confirm:'Are you sure you want to finish the application ?') ifFalse:[
+ ^ nil
+ ].
] ifFalse:[
- self
- errorNotify:msgString
- from:ex suspendedContext
- allowDebug:false
- mayProceed:ex willProceed.
-
- "/ arrive here if proceeded...
- ^ nil
+ self
+ errorNotify:msgString
+ from:ex suspendedContext
+ allowDebug:false
+ mayProceed:ex willProceed.
+
+ "/ arrive here if proceeded...
+ ^ nil
].
- ].
-
- "don't output the message, if the exception is a UserInterrupt (CTRL-C)"
- (ex creator == NoHandlerError
- and:[ex exception creator == UserInterrupt]) ifTrue:[
- OperatingSystem exit:130.
- ].
- msgString errorPrintCR.
- thisContext fullPrintAll.
- OperatingSystem exit:1
+ ].
+
+ "don't output the message, if the exception is a UserInterrupt (CTRL-C)"
+ (ex creator == NoHandlerError
+ and:[ex exception creator == UserInterrupt]) ifTrue:[
+ OperatingSystem exit:130.
+ ].
+ msgString errorPrintCR.
+ thisContext fullPrintAll.
+ OperatingSystem exit:1
].
"
@@ -4556,7 +4545,7 @@
"
debugger := self appropriateDebugger:(thisContext selector).
debugger isNil ifTrue:[
- ^ AbortOperationRequest raiseRequest
+ ^ AbortOperationRequest raiseRequest
].
^ debugger enterException:ex.
@@ -4640,7 +4629,7 @@
sender := thisContext sender.
^ UnimplementedFunctionalityError
- raiseRequestWith:(Message selector:sender selector arguments:sender args)
+ raiseRequestWith:(Message selector:sender selector arguments:sender args)
"
self shouldImplement
@@ -4661,8 +4650,8 @@
sender := thisContext sender.
^ UnimplementedFunctionalityError
- raiseRequestWith:(Message selector:sender selector arguments:sender args)
- errorString:what
+ raiseRequestWith:(Message selector:sender selector arguments:sender args)
+ errorString:what
"
self shouldImplement:'foobar'
@@ -4675,7 +4664,7 @@
<resource: #skipInDebuggersWalkBack>
^ ExecutionError
- raiseRequestErrorString:'Oops, this may never reached. Something somewhere was terribly wrong.'.
+ raiseRequestErrorString:'Oops, this may never reached. Something somewhere was terribly wrong.'.
"Modified: / 20-04-2005 / 18:59:28 / janfrog"
!
@@ -4751,8 +4740,8 @@
<resource: #skipInDebuggersWalkBack>
^ SubscriptOutOfBoundsError
- raiseRequestWith:anIndex
- errorString:('subscript (' , anIndex printString , ') out of bounds')
+ raiseRequestWith:anIndex
+ errorString:('subscript (' , anIndex printString , ') out of bounds')
"Modified: / 17.11.2001 / 22:49:56 / cg"
!
@@ -4769,9 +4758,9 @@
"/ ' (' , self class name , ') to typed variable'
^ InvalidTypeError
- raiseRequestErrorString:
- ('bad assign of ' , self printString ,
- ' (' , self class name , ') to typed variable')
+ raiseRequestErrorString:
+ ('bad assign of ' , self printString ,
+ ' (' , self class name , ') to typed variable')
"Modified: / 02-11-2012 / 10:19:15 / cg"
! !
@@ -4787,7 +4776,7 @@
^ 0
"
- [1 // 0] on:ArithmeticError do:9999
+ [1 // 0] on:ArithmeticError do:9999
"
!
@@ -4801,16 +4790,16 @@
style ... (the idea was borrowed from the Self language).
WARNING: dont 'optimize' away ifXXX: blocks
- (i.e. do NOT replace
- foo ifTrue:[var1] ifFalse:[var2]
- by:
- foo ifTrue:var1 ifFalse:var2
- )
- - the compilers will only generate inline code for the if,
- iff the argument(s) are blocks - otherwise, a true send is
- generated.
- This 'oprimization' will work semantically correct,
- but execute SLOWER instead."
+ (i.e. do NOT replace
+ foo ifTrue:[var1] ifFalse:[var2]
+ by:
+ foo ifTrue:var1 ifFalse:var2
+ )
+ - the compilers will only generate inline code for the if,
+ iff the argument(s) are blocks - otherwise, a true send is
+ generated.
+ This 'oprimization' will work semantically correct,
+ but execute SLOWER instead."
^ self
@@ -4954,30 +4943,30 @@
used from other C subsystems too, to upcast errors.
Especially, for subsystems which call errorHandler functions asynchronously.
IDs (currently) used:
- #DisplayError ..... x-error interrupt
- #XtError ..... xt-error interrupt (Xt interface is not yet published)
+ #DisplayError ..... x-error interrupt
+ #XtError ..... xt-error interrupt (Xt interface is not yet published)
"
|handlers handler|
handlers := ObjectMemory registeredErrorInterruptHandlers.
handlers notNil ifTrue:[
- handler := handlers at:errorID ifAbsent:nil.
- handler notNil ifTrue:[
- "/
- "/ handler found; let it do whatever it wants ...
- "/
- handler errorInterrupt:errorID with:aParameter.
- ^ self
- ].
+ handler := handlers at:errorID ifAbsent:nil.
+ handler notNil ifTrue:[
+ "/
+ "/ handler found; let it do whatever it wants ...
+ "/
+ handler errorInterrupt:errorID with:aParameter.
+ ^ self
+ ].
].
"/
"/ no handler - raise errorSignal passing the errorId as parameter
"/
^ Error
- raiseRequestWith:errorID
- errorString:('Subsystem error. ErrorID = ' , errorID printString)
+ raiseRequestWith:errorID
+ errorString:('Subsystem error. ErrorID = ' , errorID printString)
!
exceptionInterrupt
@@ -5003,12 +4992,12 @@
where := thisContext sender.
rec := where receiver.
rec isNumber ifTrue:[
- ^ rec class
- raise:#domainErrorSignal
- receiver:rec
- selector:where selector
- arguments:(where args asArray)
- errorString:'floating point exception'
+ ^ rec class
+ raise:#domainErrorSignal
+ receiver:rec
+ selector:where selector
+ arguments:(where args asArray)
+ errorString:'floating point exception'
].
"/ could be in some C-library ...
@@ -5073,31 +5062,31 @@
"/ 'Stray recursionInterrupt ...' infoPrintCR.
"/ ^ self
"/ ].
- ObjectMemory infoPrinting ifTrue:[
- 'Object [info]: recursionInterrupt from:' printCR.
- con := con sender.
- remaining := 50.
- [con notNil and:[remaining > 0]] whileTrue:[
- sender := con sender.
- '| ' print. con fullPrint.
-
- nSkipped := 0.
- [sender notNil and:[sender sender notNil
- and:[sender selector == con selector
- and:[sender sender selector == con selector
- and:[sender method == con method]]]]] whileTrue:[
- nSkipped := nSkipped + 1.
- con := sender.
- sender := con sender.
- ].
- nSkipped > 0 ifTrue:[
- '| ... ***** ' print. nSkipped print. ' recursive contexts skipped *****' printCR.
- ].
- con := sender.
- remaining := remaining - 1
- ].
- ].
- ^ RecursionInterruptSignal raiseSignal
+ ObjectMemory infoPrinting ifTrue:[
+ 'Object [info]: recursionInterrupt from:' printCR.
+ con := con sender.
+ remaining := 50.
+ [con notNil and:[remaining > 0]] whileTrue:[
+ sender := con sender.
+ '| ' print. con fullPrint.
+
+ nSkipped := 0.
+ [sender notNil and:[sender sender notNil
+ and:[sender selector == con selector
+ and:[sender sender selector == con selector
+ and:[sender method == con method]]]]] whileTrue:[
+ nSkipped := nSkipped + 1.
+ con := sender.
+ sender := con sender.
+ ].
+ nSkipped > 0 ifTrue:[
+ '| ... ***** ' print. nSkipped print. ' recursive contexts skipped *****' printCR.
+ ].
+ con := sender.
+ remaining := remaining - 1
+ ].
+ ].
+ ^ RecursionInterruptSignal raiseSignal
]
"Modified: / 10.11.2001 / 15:15:56 / cg"
@@ -5129,42 +5118,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.
@@ -5174,7 +5163,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
@@ -5186,105 +5175,105 @@
"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:[
- 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 cought 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 == #core ifTrue:[
- Smalltalk fatalAbort
- ].
- action == #exit ifTrue:[
- Smalltalk exit
- ].
- 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:[
+ 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 cought 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 == #core ifTrue:[
+ Smalltalk fatalAbort
+ ].
+ action == #exit ifTrue:[
+ Smalltalk exit
+ ].
+ 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"
@@ -5303,10 +5292,10 @@
Start a mini debugger or exit if none is present"
MiniDebugger isNil ifTrue:[
- "a system without debugging facilities (i.e. a standalone system)
- output a message and exit."
- ('Object [error]: exit due to ', text, ' - and no debugger.') errorPrintCR.
- OperatingSystem exit:99.
+ "a system without debugging facilities (i.e. a standalone system)
+ output a message and exit."
+ ('Object [error]: exit due to ', text, ' - and no debugger.') errorPrintCR.
+ OperatingSystem exit:99.
].
MiniDebugger enterWithMessage:text mayProceed:true.
!
@@ -5359,16 +5348,12 @@
REGISTER OBJ sel = aSelector;
if (InterruptPending == nil) {
- struct inlineCache *pIlc;
- /* JV @ 2010-22-07: To improve performance I use 256 ILCs instead
- of default 4. This significantly reduces ILC misses. The code
- should be further optimized by remembering last selector index and
- try a first shot on that index. Another option is to use kind of
- hashing on lower bits of sel variable. However, a more detailed
- statistical data should be gathered before doing further optimizations.
- */
-
-#define SEL_AND_ILC_INIT_1(l) { nil , __ILCPERF0(l) }
+ struct inlineCache *pIlc;
+
+#define nways 2
+#define nilcs 131
+
+#define SEL_AND_ILC_INIT_1(l) { { nil, nil } , { __ILCPERF0(l) , __ILCPERF0(l) } , 0 }
#define SEL_AND_ILC_INIT_2(l) SEL_AND_ILC_INIT_1(l) , SEL_AND_ILC_INIT_1(l)
#define SEL_AND_ILC_INIT_4(l) SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_2(l)
#define SEL_AND_ILC_INIT_8(l) SEL_AND_ILC_INIT_4(l) , SEL_AND_ILC_INIT_4(l)
@@ -5378,9 +5363,10 @@
#define SEL_AND_ILC_INIT_64(l) SEL_AND_ILC_INIT_32(l) , SEL_AND_ILC_INIT_32(l)
#define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l) , SEL_AND_ILC_INIT_64(l)
#define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
-#define nilcs 256
-
- static struct { OBJ sel; struct inlineCache ilc; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) };
+
+#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) };
#undef SEL_AND_ILC_INIT_1
#undef SEL_AND_ILC_INIT_2
@@ -5392,28 +5378,37 @@
#undef SEL_AND_ILC_INIT_128
#undef SEL_AND_ILC_INIT_256
- static flip = 0;
- int i;
- for (i = 0; i < nilcs; i++) {
- if (sel == sel_and_ilc[i].sel) {
- pIlc = &sel_and_ilc[i].ilc;
- goto perform0_send_and_return;
- }
- }
- /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
- pIlc = &sel_and_ilc[flip].ilc;
- sel_and_ilc[flip].sel = sel;
- flip = (flip + 1) % nilcs;
- pIlc->ilc_func = __SEND0ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
+#undef SEL_AND_ILC_INIT_131
+#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; \
+ }
+
+
+ int hash0 = __MAKE_HASH__(__GET_HASH(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;
+ }
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:#()
@@ -5426,7 +5421,7 @@
to execute a method in ANY superclass of the receiver (not just the
immediate superclass).
Thus, it is (theoretically) possible to do
- '5 perform:#< inClass:Magnitude withArguments:#(6)'
+ '5 perform:#< inClass:Magnitude withArguments:#(6)'
and evaluate Magnitudes compare method even if there was one in Number.
This method is used by the interpreter to evaluate super sends
and could be used for very special behavior (language extension ?).
@@ -5440,174 +5435,174 @@
"
myClass := self class.
(myClass == aClass or:[myClass isSubclassOf:aClass]) ifFalse:[
- self error:'lookup-class argument is not a superclass of the receiver'.
- ^ nil
+ self error:'lookup-class argument is not a superclass of the receiver'.
+ ^ nil
].
%{
REGISTER OBJ *argP;
int nargs, i;
if (__isArrayLike(argArray)) {
- nargs = __arraySize(argArray);
- argP = __arrayVal(argArray);
+ nargs = __arraySize(argArray);
+ argP = __arrayVal(argArray);
} else {
- if (__isNonNilObject(argArray)) {
- static struct inlineCache ilcSize = __ILC0(@line+1);
- numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
- if (!__isSmallInteger(numberOfArgs))
- goto bad;
- nargs = __intVal(numberOfArgs);
- argP = (OBJ *)(&a1);
- for (i=1; i <= nargs; i++) {
- *argP++ = __AT_(argArray, __mkSmallInteger(i));
- }
- argP = (OBJ *)(&a1);
- } else {
- nargs = 0;
- }
+ if (__isNonNilObject(argArray)) {
+ static struct inlineCache ilcSize = __ILC0(@line+1);
+ numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
+ if (!__isSmallInteger(numberOfArgs))
+ goto bad;
+ nargs = __intVal(numberOfArgs);
+ argP = (OBJ *)(&a1);
+ for (i=1; i <= nargs; i++) {
+ *argP++ = __AT_(argArray, __mkSmallInteger(i));
+ }
+ argP = (OBJ *)(&a1);
+ } else {
+ nargs = 0;
+ }
}
switch (nargs) {
- case 0:
- {
- static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
- RETURN ( _SEND0(self, aSelector, aClass, &ilc0));
- }
-
- case 1:
- {
- static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
- RETURN ( _SEND1(self, aSelector, aClass, &ilc1, argP[0]));
- }
-
- case 2:
- {
- static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
- RETURN ( _SEND2(self, aSelector, aClass, &ilc2, argP[0], argP[1]));
- }
-
- case 3:
- {
- static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
- RETURN ( _SEND3(self, aSelector, aClass, &ilc3,
- argP[0], argP[1], argP[2]));
- }
-
- case 4:
- {
- static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
- RETURN ( _SEND4(self, aSelector, aClass, &ilc4,
- argP[0], argP[1], argP[2], argP[3]));
- }
-
- case 5:
- {
- static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
- RETURN ( _SEND5(self, aSelector, aClass, &ilc5,
- argP[0], argP[1], argP[2], argP[3], argP[4]));
- }
-
- case 6:
- {
- static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
- RETURN ( _SEND6(self, aSelector, aClass, &ilc6,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5]));
- }
-
- case 7:
- {
- static struct inlineCache ilc7 = __DUMMYILCSELF7(@line+1);
- RETURN ( _SEND7(self, aSelector, aClass, &ilc7,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6]));
- }
-
- case 8:
- {
- static struct inlineCache ilc8 = __DUMMYILCSELF8(@line+1);
- RETURN ( _SEND8(self, aSelector, aClass, &ilc8,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7]));
- }
-
- case 9:
- {
- static struct inlineCache ilc9 = __DUMMYILCSELF9(@line+1);
- RETURN ( _SEND9(self, aSelector, aClass, &ilc9,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8]));
- }
-
- case 10:
- {
- static struct inlineCache ilc10 = __DUMMYILCSELF10(@line+1);
- RETURN ( _SEND10(self, aSelector, aClass, &ilc10,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9]));
- }
-
- case 11:
- {
- static struct inlineCache ilc11 = __DUMMYILCSELF11(@line+1);
- RETURN ( _SEND11(self, aSelector, aClass, &ilc11,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10]));
- }
-
- case 12:
- {
- static struct inlineCache ilc12 = __DUMMYILCSELF12(@line+1);
- RETURN ( _SEND12(self, aSelector, aClass, &ilc12,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10],
- argP[11]));
- }
-
- case 13:
- {
- static struct inlineCache ilc13 = __DUMMYILCSELF13(@line+1);
- RETURN ( _SEND13(self, aSelector, aClass, &ilc13,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10],
- argP[11], argP[12]));
- }
-
- case 14:
- {
- static struct inlineCache ilc14 = __DUMMYILCSELF14(@line+1);
- RETURN ( _SEND14(self, aSelector, aClass, &ilc14,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10],
- argP[11], argP[12], argP[13]));
- }
-
- case 15:
- {
- static struct inlineCache ilc15 = __DUMMYILCSELF15(@line+1);
- RETURN ( _SEND15(self, aSelector, aClass, &ilc15,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10],
- argP[11], argP[12], argP[13], argP[14]));
- }
+ case 0:
+ {
+ static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
+ RETURN ( _SEND0(self, aSelector, aClass, &ilc0));
+ }
+
+ case 1:
+ {
+ static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
+ RETURN ( _SEND1(self, aSelector, aClass, &ilc1, argP[0]));
+ }
+
+ case 2:
+ {
+ static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
+ RETURN ( _SEND2(self, aSelector, aClass, &ilc2, argP[0], argP[1]));
+ }
+
+ case 3:
+ {
+ static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
+ RETURN ( _SEND3(self, aSelector, aClass, &ilc3,
+ argP[0], argP[1], argP[2]));
+ }
+
+ case 4:
+ {
+ static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
+ RETURN ( _SEND4(self, aSelector, aClass, &ilc4,
+ argP[0], argP[1], argP[2], argP[3]));
+ }
+
+ case 5:
+ {
+ static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
+ RETURN ( _SEND5(self, aSelector, aClass, &ilc5,
+ argP[0], argP[1], argP[2], argP[3], argP[4]));
+ }
+
+ case 6:
+ {
+ static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
+ RETURN ( _SEND6(self, aSelector, aClass, &ilc6,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5]));
+ }
+
+ case 7:
+ {
+ static struct inlineCache ilc7 = __DUMMYILCSELF7(@line+1);
+ RETURN ( _SEND7(self, aSelector, aClass, &ilc7,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6]));
+ }
+
+ case 8:
+ {
+ static struct inlineCache ilc8 = __DUMMYILCSELF8(@line+1);
+ RETURN ( _SEND8(self, aSelector, aClass, &ilc8,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7]));
+ }
+
+ case 9:
+ {
+ static struct inlineCache ilc9 = __DUMMYILCSELF9(@line+1);
+ RETURN ( _SEND9(self, aSelector, aClass, &ilc9,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8]));
+ }
+
+ case 10:
+ {
+ static struct inlineCache ilc10 = __DUMMYILCSELF10(@line+1);
+ RETURN ( _SEND10(self, aSelector, aClass, &ilc10,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9]));
+ }
+
+ case 11:
+ {
+ static struct inlineCache ilc11 = __DUMMYILCSELF11(@line+1);
+ RETURN ( _SEND11(self, aSelector, aClass, &ilc11,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10]));
+ }
+
+ case 12:
+ {
+ static struct inlineCache ilc12 = __DUMMYILCSELF12(@line+1);
+ RETURN ( _SEND12(self, aSelector, aClass, &ilc12,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10],
+ argP[11]));
+ }
+
+ case 13:
+ {
+ static struct inlineCache ilc13 = __DUMMYILCSELF13(@line+1);
+ RETURN ( _SEND13(self, aSelector, aClass, &ilc13,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10],
+ argP[11], argP[12]));
+ }
+
+ case 14:
+ {
+ static struct inlineCache ilc14 = __DUMMYILCSELF14(@line+1);
+ RETURN ( _SEND14(self, aSelector, aClass, &ilc14,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10],
+ argP[11], argP[12], argP[13]));
+ }
+
+ case 15:
+ {
+ static struct inlineCache ilc15 = __DUMMYILCSELF15(@line+1);
+ RETURN ( _SEND15(self, aSelector, aClass, &ilc15,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10],
+ argP[11], argP[12], argP[13], argP[14]));
+ }
#ifdef _SEND16
- case 16:
- {
- static struct inlineCache ilc16 = __DUMMYILCSELF16(@line+1);
- RETURN ( _SEND16(self, aSelector, aClass, &ilc15,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10],
- argP[11], argP[12], argP[13], argP[14], argP[15]));
- }
+ case 16:
+ {
+ static struct inlineCache ilc16 = __DUMMYILCSELF16(@line+1);
+ RETURN ( _SEND16(self, aSelector, aClass, &ilc15,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10],
+ argP[11], argP[12], argP[13], argP[14], argP[15]));
+ }
#endif
#ifdef _SEND17
- case 17:
- {
- static struct inlineCache ilc17 = __DUMMYILCSELF17(@line+1);
- RETURN ( _SEND17(self, aSelector, aClass, &ilc15,
- argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
- argP[6], argP[7], argP[8], argP[9], argP[10],
- argP[11], argP[12], argP[13], argP[14], argP[15], argP[16]));
- }
+ case 17:
+ {
+ static struct inlineCache ilc17 = __DUMMYILCSELF17(@line+1);
+ RETURN ( _SEND17(self, aSelector, aClass, &ilc15,
+ argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
+ argP[6], argP[7], argP[8], argP[9], argP[10],
+ argP[11], argP[12], argP[13], argP[14], argP[15], argP[16]));
+ }
#endif
@@ -5627,11 +5622,11 @@
REGISTER OBJ sel = aSelector;
if (InterruptPending == nil) {
- struct inlineCache *pIlc;
- /* JV @ 2010-22-07: To improve performance I use 256 ILCs instead
- of default 4. For details, see comment in perform: */
-
-#define SEL_AND_ILC_INIT_1(l) { nil , __ILCPERF1(l) }
+ struct inlineCache *pIlc;
+#define nways 2
+#define nilcs 131
+
+#define SEL_AND_ILC_INIT_1(l) { { nil, nil } , { __ILCPERF1(l) , __ILCPERF1(l) } , 0 }
#define SEL_AND_ILC_INIT_2(l) SEL_AND_ILC_INIT_1(l) , SEL_AND_ILC_INIT_1(l)
#define SEL_AND_ILC_INIT_4(l) SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_2(l)
#define SEL_AND_ILC_INIT_8(l) SEL_AND_ILC_INIT_4(l) , SEL_AND_ILC_INIT_4(l)
@@ -5641,9 +5636,10 @@
#define SEL_AND_ILC_INIT_64(l) SEL_AND_ILC_INIT_32(l) , SEL_AND_ILC_INIT_32(l)
#define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l) , SEL_AND_ILC_INIT_64(l)
#define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
-#define nilcs 256
-
- static struct { OBJ sel; struct inlineCache ilc; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) };
+
+#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) };
#undef SEL_AND_ILC_INIT_1
#undef SEL_AND_ILC_INIT_2
@@ -5655,28 +5651,38 @@
#undef SEL_AND_ILC_INIT_128
#undef SEL_AND_ILC_INIT_256
- static flip = 0;
- int i;
- for (i = 0; i < nilcs; i++) {
- if (sel == sel_and_ilc[i].sel) {
- pIlc = &sel_and_ilc[i].ilc;
- goto perform1_send_and_return;
- }
- }
- /*printf("Object >> #perform: #%s with: arg --> no PIC found\n", __symbolVal(aSelector));*/
- pIlc = &sel_and_ilc[flip].ilc;
- sel_and_ilc[flip].sel = sel;
- flip = (flip + 1) % nilcs;
- pIlc->ilc_func = __SEND1ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
+#undef SEL_AND_ILC_INIT_131
+#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; \
+ }
+
+
+ int hash0 = __MAKE_HASH__(__GET_HASH(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;
+ }
+
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)
@@ -5691,11 +5697,10 @@
struct inlineCache *pIlc;
if (InterruptPending == nil) {
-
- /* JV @ 2010-22-07: To improve performance I use 256 ILCs instead
- of default 4. For details, see comment in perform: */
-
-#define SEL_AND_ILC_INIT_1(l) { nil , __ILCPERF2(l) }
+#define nways 2
+#define nilcs 131
+
+#define SEL_AND_ILC_INIT_1(l) { { nil, nil } , { __ILCPERF2(l) , __ILCPERF2(l) } , 0 }
#define SEL_AND_ILC_INIT_2(l) SEL_AND_ILC_INIT_1(l) , SEL_AND_ILC_INIT_1(l)
#define SEL_AND_ILC_INIT_4(l) SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_2(l)
#define SEL_AND_ILC_INIT_8(l) SEL_AND_ILC_INIT_4(l) , SEL_AND_ILC_INIT_4(l)
@@ -5705,9 +5710,10 @@
#define SEL_AND_ILC_INIT_64(l) SEL_AND_ILC_INIT_32(l) , SEL_AND_ILC_INIT_32(l)
#define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l) , SEL_AND_ILC_INIT_64(l)
#define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
-#define nilcs 256
-
- static struct { OBJ sel; struct inlineCache ilc; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) };
+
+#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) };
#undef SEL_AND_ILC_INIT_1
#undef SEL_AND_ILC_INIT_2
@@ -5719,28 +5725,38 @@
#undef SEL_AND_ILC_INIT_128
#undef SEL_AND_ILC_INIT_256
- static flip = 0;
- int i;
- for (i = 0; i < nilcs; i++) {
- if (sel == sel_and_ilc[i].sel) {
- pIlc = &sel_and_ilc[i].ilc;
- goto perform2_send_and_return;
- }
- }
- /*printf("Object >> #perform: #%s with: with: --> no PIC found\n", __symbolVal(aSelector));*/
- pIlc = &sel_and_ilc[flip].ilc;
- sel_and_ilc[flip].sel = sel;
- flip = (flip + 1) % nilcs;
- pIlc->ilc_func = __SEND2ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
+#undef SEL_AND_ILC_INIT_131
+#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; \
+ }
+
+
+ int hash0 = __MAKE_HASH__(__GET_HASH(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;
+ }
+
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)
@@ -5759,32 +5775,32 @@
static flip = 0;
if (InterruptPending == nil) {
- if (aSelector != last_0) {
- if (aSelector != last_1) {
- if (flip) {
- pIlc = &ilc_0;
- flip = 0;
- last_0 = aSelector;
- } else {
- pIlc = &ilc_1;
- flip = 1;
- last_1 = aSelector;
- }
- pIlc->ilc_func = __SEND3ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- } else {
- pIlc = &ilc_1;
- }
- } else {
- pIlc = &ilc_0;
- }
- RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2, arg3) );
+ if (aSelector != last_0) {
+ if (aSelector != last_1) {
+ if (flip) {
+ pIlc = &ilc_0;
+ flip = 0;
+ last_0 = aSelector;
+ } else {
+ pIlc = &ilc_1;
+ flip = 1;
+ last_1 = aSelector;
+ }
+ pIlc->ilc_func = __SEND3ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ } else {
+ pIlc = &ilc_1;
+ }
+ } else {
+ pIlc = &ilc_0;
+ }
+ RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2, arg3) );
} else {
- static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
- RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3));
+ static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
+ RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3));
}
%}.
^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3)
@@ -5803,34 +5819,34 @@
static flip = 0;
if (InterruptPending == nil) {
- if (aSelector != last_0) {
- if (aSelector != last_1) {
- if (flip) {
- pIlc = &ilc_0;
- flip = 0;
- last_0 = aSelector;
- } else {
- pIlc = &ilc_1;
- flip = 1;
- last_1 = aSelector;
- }
- pIlc->ilc_func = __SEND4ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- } else {
- pIlc = &ilc_1;
- }
- } else {
- pIlc = &ilc_0;
- }
- RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
- arg1, arg2, arg3, arg4) );
+ if (aSelector != last_0) {
+ if (aSelector != last_1) {
+ if (flip) {
+ pIlc = &ilc_0;
+ flip = 0;
+ last_0 = aSelector;
+ } else {
+ pIlc = &ilc_1;
+ flip = 1;
+ last_1 = aSelector;
+ }
+ pIlc->ilc_func = __SEND4ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ } else {
+ pIlc = &ilc_1;
+ }
+ } else {
+ pIlc = &ilc_0;
+ }
+ RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
+ arg1, arg2, arg3, arg4) );
} else {
- static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
- RETURN (_SEND4(self, aSelector, nil, &ilc4,
- arg1, arg2, arg3, arg4));
+ static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
+ RETURN (_SEND4(self, aSelector, nil, &ilc4,
+ arg1, arg2, arg3, arg4));
}
%}.
^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
@@ -5849,38 +5865,38 @@
static flip = 0;
if (InterruptPending == nil) {
- if (aSelector != last_0) {
- if (aSelector != last_1) {
- if (flip) {
- pIlc = &ilc_0;
- flip = 0;
- last_0 = aSelector;
- } else {
- pIlc = &ilc_1;
- flip = 1;
- last_1 = aSelector;
- }
- pIlc->ilc_func = __SEND5ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- } else {
- pIlc = &ilc_1;
- }
- } else {
- pIlc = &ilc_0;
- }
- RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
- arg1, arg2, arg3, arg4, arg5) );
+ if (aSelector != last_0) {
+ if (aSelector != last_1) {
+ if (flip) {
+ pIlc = &ilc_0;
+ flip = 0;
+ last_0 = aSelector;
+ } else {
+ pIlc = &ilc_1;
+ flip = 1;
+ last_1 = aSelector;
+ }
+ pIlc->ilc_func = __SEND5ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ } else {
+ pIlc = &ilc_1;
+ }
+ } else {
+ pIlc = &ilc_0;
+ }
+ RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
+ arg1, arg2, arg3, arg4, arg5) );
} else {
- static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
- RETURN (_SEND5(self, aSelector, nil, &ilc5,
- arg1, arg2, arg3, arg4, arg5));
+ static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
+ RETURN (_SEND5(self, aSelector, nil, &ilc5,
+ arg1, arg2, arg3, arg4, arg5));
}
%}.
^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
- with:arg5)
+ with:arg5)
!
@@ -5896,39 +5912,39 @@
static flip = 0;
if (InterruptPending == nil) {
- if (aSelector != last_0) {
- if (aSelector != last_1) {
- if (flip) {
- pIlc = &ilc_0;
- flip = 0;
- last_0 = aSelector;
- } else {
- pIlc = &ilc_1;
- flip = 1;
- last_1 = aSelector;
- }
- pIlc->ilc_func = __SEND6ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- } else {
- pIlc = &ilc_1;
- }
- } else {
- pIlc = &ilc_0;
- }
-
- RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
- arg1, arg2, arg3, arg4, arg5, arg6) );
+ if (aSelector != last_0) {
+ if (aSelector != last_1) {
+ if (flip) {
+ pIlc = &ilc_0;
+ flip = 0;
+ last_0 = aSelector;
+ } else {
+ pIlc = &ilc_1;
+ flip = 1;
+ last_1 = aSelector;
+ }
+ pIlc->ilc_func = __SEND6ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ } else {
+ pIlc = &ilc_1;
+ }
+ } else {
+ pIlc = &ilc_0;
+ }
+
+ RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
+ arg1, arg2, arg3, arg4, arg5, arg6) );
} else {
- static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
- RETURN (_SEND6(self, aSelector, nil, &ilc6,
- arg1, arg2, arg3, arg4, arg5, arg6));
+ static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
+ RETURN (_SEND6(self, aSelector, nil, &ilc6,
+ arg1, arg2, arg3, arg4, arg5, arg6));
}
%}.
^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
- with:arg5 with:arg6)
+ with:arg5 with:arg6)
!
@@ -5944,398 +5960,398 @@
OBJ l;
if (__isArrayLike(argArray)) {
- nargs = __arraySize(argArray);
- argP = __arrayVal(argArray);
+ nargs = __arraySize(argArray);
+ argP = __arrayVal(argArray);
} else {
- if (__isNonNilObject(argArray)) {
- static struct inlineCache ilcSize = __ILC0(@line);
- int i;
-
- numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
- if (!__isSmallInteger(numberOfArgs))
- goto bad;
- nargs = __intVal(numberOfArgs);
- argP = (OBJ *)(&a1);
- for (i=1; i <= nargs; i++) {
- *argP++ = __AT_(argArray, __mkSmallInteger(i));
- }
- argP = (OBJ *)(&a1);
- } else {
- nargs = 0;
- }
+ if (__isNonNilObject(argArray)) {
+ static struct inlineCache ilcSize = __ILC0(@line);
+ int i;
+
+ numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
+ if (!__isSmallInteger(numberOfArgs))
+ goto bad;
+ nargs = __intVal(numberOfArgs);
+ argP = (OBJ *)(&a1);
+ for (i=1; i <= nargs; i++) {
+ *argP++ = __AT_(argArray, __mkSmallInteger(i));
+ }
+ argP = (OBJ *)(&a1);
+ } else {
+ nargs = 0;
+ }
}
switch (nargs) {
- case 0:
- if (InterruptPending == nil) {
- static OBJ last0_0 = nil; static struct inlineCache ilc0_0 = __ILCPERF0(@line);
- static OBJ last0_1 = nil; static struct inlineCache ilc0_1 = __ILCPERF0(@line);
- static OBJ last0_2 = nil; static struct inlineCache ilc0_2 = __ILCPERF0(@line);
- static OBJ last0_3 = nil; static struct inlineCache ilc0_3 = __ILCPERF0(@line);
- static int flip0 = 0;
- struct inlineCache *pIlc;
-
- if (aSelector == last0_0) {
- pIlc = &ilc0_0;
- } else if (aSelector == last0_1) {
- pIlc = &ilc0_1;
- } else if (aSelector == last0_2) {
- pIlc = &ilc0_2;
- } else if (aSelector == last0_3) {
- pIlc = &ilc0_3;
- } else {
- if (flip0 == 0) {
- pIlc = &ilc0_0;
- flip0 = 1;
- last0_0 = aSelector;
- } else if (flip0 == 1) {
- pIlc = &ilc0_1;
- flip0 = 2;
- last0_1 = aSelector;
- } else if (flip0 == 2) {
- pIlc = &ilc0_2;
- flip0 = 3;
- last0_2 = aSelector;
- } else {
- pIlc = &ilc0_3;
- flip0 = 0;
- last0_3 = aSelector;
- }
-
- pIlc->ilc_func = __SEND0ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- }
- RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc));
- } else {
- static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
- RETURN (_SEND0(self, aSelector, nil, &ilc0));
- }
-
- case 1:
- if (InterruptPending == nil) {
- static OBJ last1_0 = nil; static struct inlineCache ilc1_0 = __ILCPERF1(@line);
- static OBJ last1_1 = nil; static struct inlineCache ilc1_1 = __ILCPERF1(@line);
- static OBJ last1_2 = nil; static struct inlineCache ilc1_2 = __ILCPERF1(@line);
- static OBJ last1_3 = nil; static struct inlineCache ilc1_3 = __ILCPERF1(@line);
- static int flip1 = 0;
- struct inlineCache *pIlc;
-
- if (aSelector == last1_0) {
- pIlc = &ilc1_0;
- } else if (aSelector == last1_1) {
- pIlc = &ilc1_1;
- } else if (aSelector == last1_2) {
- pIlc = &ilc1_2;
- } else if (aSelector == last1_3) {
- pIlc = &ilc1_3;
- } else {
- if (flip1 == 0) {
- pIlc = &ilc1_0;
- flip1 = 1;
- last1_0 = aSelector;
- } else if (flip1 == 1) {
- pIlc = &ilc1_1;
- flip1 = 2;
- last1_1 = aSelector;
- } else if (flip1 == 2) {
- pIlc = &ilc1_2;
- flip1 = 3;
- last1_2 = aSelector;
- } else {
- pIlc = &ilc1_3;
- flip1 = 0;
- last1_3 = aSelector;
- }
-
- pIlc->ilc_func = __SEND1ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- }
- RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0]));
- } else {
- static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
- RETURN (_SEND1(self, aSelector, nil, &ilc1, argP[0]));
- }
-
- case 2:
- if (InterruptPending == nil) {
- static OBJ last2_0 = nil; static struct inlineCache ilc2_0 = __ILCPERF2(@line);
- static OBJ last2_1 = nil; static struct inlineCache ilc2_1 = __ILCPERF2(@line);
- static int flip2 = 0;
- struct inlineCache *pIlc;
-
- if (aSelector == last2_0) {
- pIlc = &ilc2_0;
- } else if (aSelector == last2_1) {
- pIlc = &ilc2_1;
- } else {
- if (flip2 == 0) {
- pIlc = &ilc2_0;
- flip2 = 1;
- last2_0 = aSelector;
- } else {
- pIlc = &ilc2_1;
- flip2 = 0;
- last2_1 = aSelector;
- }
-
- pIlc->ilc_func = __SEND2ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- }
- RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1]));
- } else {
- static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
- RETURN (_SEND2(self, aSelector, nil, &ilc2, argP[0], argP[1]));
- }
-
- case 3:
- if (InterruptPending == nil) {
- static OBJ last3_0 = nil; static struct inlineCache ilc3_0 = __ILCPERF3(@line);
- static OBJ last3_1 = nil; static struct inlineCache ilc3_1 = __ILCPERF3(@line);
- static int flip3 = 0;
- struct inlineCache *pIlc;
-
- if (aSelector == last3_0) {
- pIlc = &ilc3_0;
- } else if (aSelector == last3_1) {
- pIlc = &ilc3_1;
- } else {
- if (flip3 == 0) {
- pIlc = &ilc3_0;
- flip3 = 1;
- last3_0 = aSelector;
- } else {
- pIlc = &ilc3_1;
- flip3 = 0;
- last3_1 = aSelector;
- }
-
- pIlc->ilc_func = __SEND3ADDR__;
- if (pIlc->ilc_poly) {
- __flushPolyCache(pIlc->ilc_poly);
- pIlc->ilc_poly = 0;
- }
- }
- RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1], argP[2]));
- } else {
- static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
- RETURN (_SEND3(self, aSelector, nil, &ilc3, argP[0], argP[1], argP[2]));
- }
-
- case 4:
- {
- static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
-
- if ((InterruptPending != nil) || (aSelector != last4)) {
- ilc4.ilc_func = __SEND4ADDR__;
- if (ilc4.ilc_poly) {
- __flushPolyCache(ilc4.ilc_poly);
- ilc4.ilc_poly = 0;
- }
- last4 = aSelector;
- }
- RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
- argP[0], argP[1], argP[2], argP[3]));
- }
-
- case 5:
- {
- static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
-
- if ((InterruptPending != nil) || (aSelector != last5)) {
- ilc5.ilc_func = __SEND5ADDR__;
- if (ilc5.ilc_poly) {
- __flushPolyCache(ilc5.ilc_poly);
- ilc5.ilc_poly = 0;
- }
- last5 = aSelector;
- }
- RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5,
- argP[0], argP[1], argP[2], argP[3], argP[4]));
- }
-
- case 6:
- {
- static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
-
- if ((InterruptPending != nil) || (aSelector != last6)) {
- ilc6.ilc_func = __SEND6ADDR__;
- if (ilc6.ilc_poly) {
- __flushPolyCache(ilc6.ilc_poly);
- ilc6.ilc_poly = 0;
- }
- last6 = aSelector;
- }
- RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5]));
- }
-
- case 7:
- {
- static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
-
- if ((InterruptPending != nil) || (aSelector != last7)) {
- ilc7.ilc_func = __SEND7ADDR__;
- if (ilc7.ilc_poly) {
- __flushPolyCache(ilc7.ilc_poly);
- ilc7.ilc_poly = 0;
- }
- last7 = aSelector;
- }
- RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6]));
- }
-
- case 8:
- {
- static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
-
- if ((InterruptPending != nil) || (aSelector != last8)) {
- ilc8.ilc_func = __SEND8ADDR__;
- if (ilc8.ilc_poly) {
- __flushPolyCache(ilc8.ilc_poly);
- ilc8.ilc_poly = 0;
- }
- last8 = aSelector;
- }
- RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7]));
- }
-
- case 9:
- {
- static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
-
- if ((InterruptPending != nil) || (aSelector != last9)) {
- ilc9.ilc_func = __SEND9ADDR__;
- if (ilc9.ilc_poly) {
- __flushPolyCache(ilc9.ilc_poly);
- ilc9.ilc_poly = 0;
- }
- last9 = aSelector;
- }
- RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8]));
- }
-
- case 10:
- {
- static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
-
- if ((InterruptPending != nil) || (aSelector != last10)) {
- ilc10.ilc_func = __SEND10ADDR__;
- if (ilc10.ilc_poly) {
- __flushPolyCache(ilc10.ilc_poly);
- ilc10.ilc_poly = 0;
- }
- last10 = aSelector;
- }
- RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9]));
- }
-
- case 11:
- {
- static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
-
- if ((InterruptPending != nil) || (aSelector != last11)) {
- ilc11.ilc_func = __SEND11ADDR__;
- if (ilc11.ilc_poly) {
- __flushPolyCache(ilc11.ilc_poly);
- ilc11.ilc_poly = 0;
- }
- last11 = aSelector;
- }
- RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10]));
- }
-
- case 12:
- {
- static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
-
- if ((InterruptPending != nil) || (aSelector != last12)) {
- ilc12.ilc_func = __SEND12ADDR__;
- if (ilc12.ilc_poly) {
- __flushPolyCache(ilc12.ilc_poly);
- ilc12.ilc_poly = 0;
- }
- last12 = aSelector;
- }
- RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11]));
- }
-
- case 13:
- {
- static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
-
- if ((InterruptPending != nil) || (aSelector != last13)) {
- ilc13.ilc_func = __SEND13ADDR__;
- if (ilc13.ilc_poly) {
- __flushPolyCache(ilc13.ilc_poly);
- ilc13.ilc_poly = 0;
- }
- last13 = aSelector;
- }
- RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11], argP[12]));
- }
-
- case 14:
- {
- static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
-
- if ((InterruptPending != nil) || (aSelector != last14)) {
- ilc14.ilc_func = __SEND14ADDR__;
- if (ilc14.ilc_poly) {
- __flushPolyCache(ilc14.ilc_poly);
- ilc14.ilc_poly = 0;
- }
- last14 = aSelector;
- }
- RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11], argP[12], argP[13]));
- }
-
- case 15:
- {
- static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
-
- if ((InterruptPending != nil) || (aSelector != last15)) {
- ilc15.ilc_func = __SEND15ADDR__;
- if (ilc15.ilc_poly) {
- __flushPolyCache(ilc15.ilc_poly);
- ilc15.ilc_poly = 0;
- }
- last15 = aSelector;
- }
- RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11], argP[12], argP[13],
- argP[14]));
- }
+ case 0:
+ if (InterruptPending == nil) {
+ static OBJ last0_0 = nil; static struct inlineCache ilc0_0 = __ILCPERF0(@line);
+ static OBJ last0_1 = nil; static struct inlineCache ilc0_1 = __ILCPERF0(@line);
+ static OBJ last0_2 = nil; static struct inlineCache ilc0_2 = __ILCPERF0(@line);
+ static OBJ last0_3 = nil; static struct inlineCache ilc0_3 = __ILCPERF0(@line);
+ static int flip0 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last0_0) {
+ pIlc = &ilc0_0;
+ } else if (aSelector == last0_1) {
+ pIlc = &ilc0_1;
+ } else if (aSelector == last0_2) {
+ pIlc = &ilc0_2;
+ } else if (aSelector == last0_3) {
+ pIlc = &ilc0_3;
+ } else {
+ if (flip0 == 0) {
+ pIlc = &ilc0_0;
+ flip0 = 1;
+ last0_0 = aSelector;
+ } else if (flip0 == 1) {
+ pIlc = &ilc0_1;
+ flip0 = 2;
+ last0_1 = aSelector;
+ } else if (flip0 == 2) {
+ pIlc = &ilc0_2;
+ flip0 = 3;
+ last0_2 = aSelector;
+ } else {
+ pIlc = &ilc0_3;
+ flip0 = 0;
+ last0_3 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND0ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc));
+ } else {
+ static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
+ RETURN (_SEND0(self, aSelector, nil, &ilc0));
+ }
+
+ case 1:
+ if (InterruptPending == nil) {
+ static OBJ last1_0 = nil; static struct inlineCache ilc1_0 = __ILCPERF1(@line);
+ static OBJ last1_1 = nil; static struct inlineCache ilc1_1 = __ILCPERF1(@line);
+ static OBJ last1_2 = nil; static struct inlineCache ilc1_2 = __ILCPERF1(@line);
+ static OBJ last1_3 = nil; static struct inlineCache ilc1_3 = __ILCPERF1(@line);
+ static int flip1 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last1_0) {
+ pIlc = &ilc1_0;
+ } else if (aSelector == last1_1) {
+ pIlc = &ilc1_1;
+ } else if (aSelector == last1_2) {
+ pIlc = &ilc1_2;
+ } else if (aSelector == last1_3) {
+ pIlc = &ilc1_3;
+ } else {
+ if (flip1 == 0) {
+ pIlc = &ilc1_0;
+ flip1 = 1;
+ last1_0 = aSelector;
+ } else if (flip1 == 1) {
+ pIlc = &ilc1_1;
+ flip1 = 2;
+ last1_1 = aSelector;
+ } else if (flip1 == 2) {
+ pIlc = &ilc1_2;
+ flip1 = 3;
+ last1_2 = aSelector;
+ } else {
+ pIlc = &ilc1_3;
+ flip1 = 0;
+ last1_3 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND1ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0]));
+ } else {
+ static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
+ RETURN (_SEND1(self, aSelector, nil, &ilc1, argP[0]));
+ }
+
+ case 2:
+ if (InterruptPending == nil) {
+ static OBJ last2_0 = nil; static struct inlineCache ilc2_0 = __ILCPERF2(@line);
+ static OBJ last2_1 = nil; static struct inlineCache ilc2_1 = __ILCPERF2(@line);
+ static int flip2 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last2_0) {
+ pIlc = &ilc2_0;
+ } else if (aSelector == last2_1) {
+ pIlc = &ilc2_1;
+ } else {
+ if (flip2 == 0) {
+ pIlc = &ilc2_0;
+ flip2 = 1;
+ last2_0 = aSelector;
+ } else {
+ pIlc = &ilc2_1;
+ flip2 = 0;
+ last2_1 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND2ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1]));
+ } else {
+ static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
+ RETURN (_SEND2(self, aSelector, nil, &ilc2, argP[0], argP[1]));
+ }
+
+ case 3:
+ if (InterruptPending == nil) {
+ static OBJ last3_0 = nil; static struct inlineCache ilc3_0 = __ILCPERF3(@line);
+ static OBJ last3_1 = nil; static struct inlineCache ilc3_1 = __ILCPERF3(@line);
+ static int flip3 = 0;
+ struct inlineCache *pIlc;
+
+ if (aSelector == last3_0) {
+ pIlc = &ilc3_0;
+ } else if (aSelector == last3_1) {
+ pIlc = &ilc3_1;
+ } else {
+ if (flip3 == 0) {
+ pIlc = &ilc3_0;
+ flip3 = 1;
+ last3_0 = aSelector;
+ } else {
+ pIlc = &ilc3_1;
+ flip3 = 0;
+ last3_1 = aSelector;
+ }
+
+ pIlc->ilc_func = __SEND3ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+ }
+ RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1], argP[2]));
+ } else {
+ static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
+ RETURN (_SEND3(self, aSelector, nil, &ilc3, argP[0], argP[1], argP[2]));
+ }
+
+ case 4:
+ {
+ static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last4)) {
+ ilc4.ilc_func = __SEND4ADDR__;
+ if (ilc4.ilc_poly) {
+ __flushPolyCache(ilc4.ilc_poly);
+ ilc4.ilc_poly = 0;
+ }
+ last4 = aSelector;
+ }
+ RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
+ argP[0], argP[1], argP[2], argP[3]));
+ }
+
+ case 5:
+ {
+ static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last5)) {
+ ilc5.ilc_func = __SEND5ADDR__;
+ if (ilc5.ilc_poly) {
+ __flushPolyCache(ilc5.ilc_poly);
+ ilc5.ilc_poly = 0;
+ }
+ last5 = aSelector;
+ }
+ RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5,
+ argP[0], argP[1], argP[2], argP[3], argP[4]));
+ }
+
+ case 6:
+ {
+ static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last6)) {
+ ilc6.ilc_func = __SEND6ADDR__;
+ if (ilc6.ilc_poly) {
+ __flushPolyCache(ilc6.ilc_poly);
+ ilc6.ilc_poly = 0;
+ }
+ last6 = aSelector;
+ }
+ RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5]));
+ }
+
+ case 7:
+ {
+ static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last7)) {
+ ilc7.ilc_func = __SEND7ADDR__;
+ if (ilc7.ilc_poly) {
+ __flushPolyCache(ilc7.ilc_poly);
+ ilc7.ilc_poly = 0;
+ }
+ last7 = aSelector;
+ }
+ RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6]));
+ }
+
+ case 8:
+ {
+ static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last8)) {
+ ilc8.ilc_func = __SEND8ADDR__;
+ if (ilc8.ilc_poly) {
+ __flushPolyCache(ilc8.ilc_poly);
+ ilc8.ilc_poly = 0;
+ }
+ last8 = aSelector;
+ }
+ RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7]));
+ }
+
+ case 9:
+ {
+ static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last9)) {
+ ilc9.ilc_func = __SEND9ADDR__;
+ if (ilc9.ilc_poly) {
+ __flushPolyCache(ilc9.ilc_poly);
+ ilc9.ilc_poly = 0;
+ }
+ last9 = aSelector;
+ }
+ RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8]));
+ }
+
+ case 10:
+ {
+ static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last10)) {
+ ilc10.ilc_func = __SEND10ADDR__;
+ if (ilc10.ilc_poly) {
+ __flushPolyCache(ilc10.ilc_poly);
+ ilc10.ilc_poly = 0;
+ }
+ last10 = aSelector;
+ }
+ RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9]));
+ }
+
+ case 11:
+ {
+ static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last11)) {
+ ilc11.ilc_func = __SEND11ADDR__;
+ if (ilc11.ilc_poly) {
+ __flushPolyCache(ilc11.ilc_poly);
+ ilc11.ilc_poly = 0;
+ }
+ last11 = aSelector;
+ }
+ RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10]));
+ }
+
+ case 12:
+ {
+ static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last12)) {
+ ilc12.ilc_func = __SEND12ADDR__;
+ if (ilc12.ilc_poly) {
+ __flushPolyCache(ilc12.ilc_poly);
+ ilc12.ilc_poly = 0;
+ }
+ last12 = aSelector;
+ }
+ RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11]));
+ }
+
+ case 13:
+ {
+ static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last13)) {
+ ilc13.ilc_func = __SEND13ADDR__;
+ if (ilc13.ilc_poly) {
+ __flushPolyCache(ilc13.ilc_poly);
+ ilc13.ilc_poly = 0;
+ }
+ last13 = aSelector;
+ }
+ RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12]));
+ }
+
+ case 14:
+ {
+ static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last14)) {
+ ilc14.ilc_func = __SEND14ADDR__;
+ if (ilc14.ilc_poly) {
+ __flushPolyCache(ilc14.ilc_poly);
+ ilc14.ilc_poly = 0;
+ }
+ last14 = aSelector;
+ }
+ RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12], argP[13]));
+ }
+
+ case 15:
+ {
+ static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
+
+ if ((InterruptPending != nil) || (aSelector != last15)) {
+ ilc15.ilc_func = __SEND15ADDR__;
+ if (ilc15.ilc_poly) {
+ __flushPolyCache(ilc15.ilc_poly);
+ ilc15.ilc_poly = 0;
+ }
+ last15 = aSelector;
+ }
+ RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12], argP[13],
+ argP[14]));
+ }
}
bad:;
%}.
@@ -6351,7 +6367,7 @@
If the message expects an argument, pass arg."
aSelector numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:arg
+ ^ self perform:aSelector with:arg
].
^ self perform:aSelector
@@ -6376,10 +6392,10 @@
numArgs := aSelector numArgs.
numArgs == 0 ifTrue:[
- ^ self perform:aSelector
+ ^ self perform:aSelector
].
numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:optionalArg1
+ ^ self perform:aSelector with:optionalArg1
].
^ self perform:aSelector with:optionalArg1 with:optionalArg2.
@@ -6404,13 +6420,13 @@
numArgs := aSelector numArgs.
numArgs == 0 ifTrue:[
- ^ self perform:aSelector
+ ^ self perform:aSelector
].
numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:optionalArg1
+ ^ self perform:aSelector with:optionalArg1
].
numArgs == 2 ifTrue:[
- ^ self perform:aSelector with:optionalArg1 with:optionalArg2
+ ^ self perform:aSelector with:optionalArg1 with:optionalArg2
].
^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3.
@@ -6435,16 +6451,16 @@
numArgs := aSelector numArgs.
numArgs == 0 ifTrue:[
- ^ self perform:aSelector
+ ^ self perform:aSelector
].
numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:optionalArg1
+ ^ self perform:aSelector with:optionalArg1
].
numArgs == 2 ifTrue:[
- ^ self perform:aSelector with:optionalArg1 with:optionalArg2
+ ^ self perform:aSelector with:optionalArg1 with:optionalArg2
].
numArgs == 3 ifTrue:[
- ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
+ ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
].
^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3 with:optionalArg4.
@@ -6466,8 +6482,8 @@
This is a non-object-oriented entry, applying a method
in a functional way on a receiver.
Warning:
- Take care for the method to be appropriate for the
- receiver - no checking is done by the VM."
+ Take care for the method to be appropriate for the
+ receiver - no checking is done by the VM."
^ aMethod valueWithReceiver:self arguments:#()
@@ -6496,8 +6512,8 @@
This is a non-object-oriented entry, applying a method
in a functional way on a receiver.
Warning:
- Take care for the method to be appropriate for the
- receiver - no checking is done by the VM."
+ Take care for the method to be appropriate for the
+ receiver - no checking is done by the VM."
^ aMethod valueWithReceiver:self arguments:argumentArray
@@ -6517,8 +6533,8 @@
This is a non-object-oriented entry, applying a method
in a functional way on a receiver.
Warning:
- Take care for the method to be appropriate for the
- receiver - no checking is done by the VM."
+ Take care for the method to be appropriate for the
+ receiver - no checking is done by the VM."
^ aMethod valueWithReceiver:self arguments:(Array with:arg)
@@ -6538,8 +6554,8 @@
This is a non-object-oriented entry, applying a method
in a functional way on a receiver.
Warning:
- Take care for the method to be appropriate for the
- receiver - no checking is done by the VM."
+ Take care for the method to be appropriate for the
+ receiver - no checking is done by the VM."
^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2)
@@ -6561,8 +6577,8 @@
This is a non-object-oriented entry, applying a method
in a functional way on a receiver.
Warning:
- Take care for the method to be appropriate for the
- receiver - no checking is done by the VM."
+ Take care for the method to be appropriate for the
+ receiver - no checking is done by the VM."
^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2 with:arg3)
@@ -6742,10 +6758,10 @@
ret := 0.
anAspectSymbol notNil ifTrue:[
- ret := self perform:anAspectSymbol ifNotUnderstood:[0].
+ ret := self perform:anAspectSymbol ifNotUnderstood:[0].
].
ret == 0 ifTrue:[
- ^ self elementDescriptorForNonNilInstanceVariables
+ ^ self elementDescriptorForNonNilInstanceVariables
].
^ ret.
!
@@ -6778,16 +6794,16 @@
instVarNames := theClass allInstVarNames.
1 to:instSize do:[:i | |var|
- var := self instVarAt:i.
- (aBlock value:var) ifTrue:[
- children add:((instVarNames at:i) -> var)
- ]
+ var := self instVarAt:i.
+ (aBlock value:var) ifTrue:[
+ children add:((instVarNames at:i) -> var)
+ ]
].
varSize ~~ 0 ifTrue:[
- 1 to:varSize do:[:i |
- children add:(i -> (self basicAt:i))
- ]
+ 1 to:varSize do:[:i |
+ children add:(i -> (self basicAt:i))
+ ]
].
^ children.
@@ -6840,10 +6856,10 @@
| cls|
(cls := self class) == self ifTrue:[
- ^ 'a funny object'
+ ^ 'a funny object'
].
cls isNil ifTrue:[
- ^ 'a nil-classes object' "/ cannot happen
+ ^ 'a nil-classes object' "/ cannot happen
].
^ cls nameWithArticle
@@ -6863,11 +6879,11 @@
headless applications."
Stderr isNil ifTrue:[
- "/ the following allows errorPrint to be used during
- "/ the early init-phase, when no Stderr has been set up.
- "/ (depends on string to respond to #errorPrint)
- self printString utf8Encoded errorPrint.
- ^ self.
+ "/ the following allows errorPrint to be used during
+ "/ the early init-phase, when no Stderr has been set up.
+ "/ (depends on string to respond to #errorPrint)
+ self printString utf8Encoded errorPrint.
+ ^ self.
].
self withErrorStreamDo:[:s | self printOn:s].
@@ -6883,11 +6899,11 @@
headless applications."
Stderr isNil ifTrue:[
- "/ the following allows errorPrintCR to be used during
- "/ the early init-phase, when no Stderr has been set up.
- "/ (depends on string to respond to #errorPrintCR)
- self printString utf8Encoded errorPrintCR.
- ^ self.
+ "/ the following allows errorPrintCR to be used during
+ "/ the early init-phase, when no Stderr has been set up.
+ "/ (depends on string to respond to #errorPrintCR)
+ self printString utf8Encoded errorPrintCR.
+ ^ self.
].
self withErrorStreamDo:[:s | self printOn:s. s cr].
@@ -6933,7 +6949,7 @@
These messages can be turned on/off by 'Object infoPrinting:true/false'"
InfoPrinting == true ifTrue:[
- self errorPrint
+ self errorPrint
]
!
@@ -6946,7 +6962,7 @@
These messages can be turned on/off by 'Object infoPrinting:true/false'"
InfoPrinting == true ifTrue:[
- self errorPrintCR
+ self errorPrintCR
]
"Created: 20.5.1996 / 10:21:28 / cg"
@@ -6970,8 +6986,8 @@
"/ (depends on string to respond to #print)
Stdout isNil ifTrue:[
- self printString utf8Encoded print.
- ^ self
+ self printString utf8Encoded print.
+ ^ self
].
self printOn:Stdout
@@ -6986,8 +7002,8 @@
"/ (depends on string to respond to #printCR)
Stdout isNil ifTrue:[
- self printString utf8Encoded printCR.
- ^ self
+ self printString utf8Encoded printCR.
+ ^ self
].
self printOn:Stdout.
Stdout cr
@@ -7215,9 +7231,9 @@
|rslt|
Error handle:[:ex |
- rslt := exceptionBlock value
+ rslt := exceptionBlock value
] do:[
- rslt := self printString
+ rslt := self printString
].
^ rslt
!
@@ -7462,13 +7478,13 @@
|stream|
stream := Processor activeProcess isSystemProcess
- ifTrue:[Stderr]
- ifFalse:[Transcript].
+ ifTrue:[Stderr]
+ ifFalse:[Transcript].
StreamError catch:[
- aBlock value:stream.
+ aBlock value:stream.
].
stream ~~ Stderr ifTrue:[
- aBlock value:Stderr.
+ aBlock value:Stderr.
].
"Created: / 21-04-2011 / 12:46:21 / cg"
@@ -7498,43 +7514,43 @@
nInstBytes = OHDR_SIZE + __OBJS2BYTES__( __intVal(__ClassInstPtr(myClass)->c_ninstvars) );
switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
- case __MASKSMALLINT(POINTERARRAY):
- case __MASKSMALLINT(WKPOINTERARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(__BYTES2OBJS__(nbytes)) );
-
- case __MASKSMALLINT(BYTEARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes / sizeof(char)) );
-
- case __MASKSMALLINT(FLOATARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
-
- case __MASKSMALLINT(DOUBLEARRAY):
+ case __MASKSMALLINT(POINTERARRAY):
+ case __MASKSMALLINT(WKPOINTERARRAY):
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(__BYTES2OBJS__(nbytes)) );
+
+ case __MASKSMALLINT(BYTEARRAY):
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nbytes / sizeof(char)) );
+
+ case __MASKSMALLINT(FLOATARRAY):
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
+
+ case __MASKSMALLINT(DOUBLEARRAY):
#ifdef __NEED_DOUBLE_ALIGN
- nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
+ nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
#endif
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
-
- case __MASKSMALLINT(WORDARRAY):
- case __MASKSMALLINT(SWORDARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
-
- case __MASKSMALLINT(LONGARRAY):
- case __MASKSMALLINT(SLONGARRAY):
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
-
- case __MASKSMALLINT(LONGLONGARRAY):
- case __MASKSMALLINT(SLONGLONGARRAY):
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
+
+ case __MASKSMALLINT(WORDARRAY):
+ case __MASKSMALLINT(SWORDARRAY):
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nbytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
+
+ case __MASKSMALLINT(LONGARRAY):
+ case __MASKSMALLINT(SLONGARRAY):
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nbytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
+
+ case __MASKSMALLINT(LONGLONGARRAY):
+ case __MASKSMALLINT(SLONGLONGARRAY):
#ifdef __NEED_LONGLONG_ALIGN
- nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
+ nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
#endif
- nbytes -= nInstBytes;
- RETURN ( __mkSmallInteger(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
+ nbytes -= nInstBytes;
+ RETURN ( __mkSmallInteger(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
}
%}.
^ 0
@@ -7551,36 +7567,36 @@
myClass := self class.
myClass isVariable ifTrue:[
- myClass isPointers ifFalse:[
- myClass isBytes ifTrue:[
- ^ self basicSize.
- ].
- myClass isWords ifTrue:[
- ^ self basicSize * 2.
- ].
- myClass isSignedWords ifTrue:[
- ^ self basicSize * 2.
- ].
- myClass isLongs ifTrue:[
- ^ self basicSize * 4.
- ].
- myClass isSignedLongs ifTrue:[
- ^ self basicSize * 4.
- ].
- myClass isLongLongs ifTrue:[
- ^ self basicSize * 8.
- ].
- myClass isSignedLongLongs ifTrue:[
- ^ self basicSize * 8.
- ].
- myClass isFloats ifTrue:[
- ^ self basicSize * (ExternalBytes sizeofFloat)
- ].
- myClass isDoubles ifTrue:[
- ^ self basicSize * (ExternalBytes sizeofDouble)
- ].
- self error:'unknown variable size class species'.
- ]
+ myClass isPointers ifFalse:[
+ myClass isBytes ifTrue:[
+ ^ self basicSize.
+ ].
+ myClass isWords ifTrue:[
+ ^ self basicSize * 2.
+ ].
+ myClass isSignedWords ifTrue:[
+ ^ self basicSize * 2.
+ ].
+ myClass isLongs ifTrue:[
+ ^ self basicSize * 4.
+ ].
+ myClass isSignedLongs ifTrue:[
+ ^ self basicSize * 4.
+ ].
+ myClass isLongLongs ifTrue:[
+ ^ self basicSize * 8.
+ ].
+ myClass isSignedLongLongs ifTrue:[
+ ^ self basicSize * 8.
+ ].
+ myClass isFloats ifTrue:[
+ ^ self basicSize * (ExternalBytes sizeofFloat)
+ ].
+ myClass isDoubles ifTrue:[
+ ^ self basicSize * (ExternalBytes sizeofDouble)
+ ].
+ self error:'unknown variable size class species'.
+ ]
].
^ 0
@@ -7622,7 +7638,7 @@
%{ /* NOCONTEXT */
if (__lookup(__Class(self), aSelector) == nil) {
- RETURN ( false );
+ RETURN ( false );
}
RETURN ( true );
%}
@@ -7663,7 +7679,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?: selector
@@ -7729,17 +7744,17 @@
|val ok|
MessageNotUnderstood handle:[:ex |
- "/ reject, if the bad message is not the one
- "/ we have sent originally
- (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
- ex reject
- ].
+ "/ reject, if the bad message is not the one
+ "/ we have sent originally
+ (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
+ ex reject
+ ].
] do:[
- val := self perform:aSelector.
- ok := true.
+ val := self perform:aSelector.
+ ok := true.
].
ok isNil ifTrue:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
^ val
@@ -7763,17 +7778,17 @@
|val ok|
MessageNotUnderstood handle:[:ex |
- "/ reject, if the bad message is not the one
- "/ we have sent originally
- (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
- ex reject
- ]
+ "/ reject, if the bad message is not the one
+ "/ we have sent originally
+ (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
+ ex reject
+ ]
] do:[
- val := self perform:aSelector with:argument.
- ok := true.
+ val := self perform:aSelector with:argument.
+ ok := true.
].
ok isNil ifTrue:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
^ val
@@ -7800,17 +7815,17 @@
|val ok|
MessageNotUnderstood handle:[:ex |
- "/ reject, if the bad message is not the one
- "/ we have sent originally
- (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
- ex reject
- ]
+ "/ reject, if the bad message is not the one
+ "/ we have sent originally
+ (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
+ ex reject
+ ]
] do:[
- val := self perform:aSelector with:arg1 with:arg2.
- ok := true.
+ val := self perform:aSelector with:arg1 with:arg2.
+ ok := true.
].
ok isNil ifTrue:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
^ val
!
@@ -7828,17 +7843,17 @@
|val ok|
MessageNotUnderstood handle:[:ex |
- "/ reject, if the bad message is not the one
- "/ we have sent originally.
- (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
- ex reject
- ]
+ "/ reject, if the bad message is not the one
+ "/ we have sent originally.
+ (ex selector == aSelector and:[ex receiver == self]) ifFalse:[
+ ex reject
+ ]
] do:[
- val := self perform:aSelector withArguments:argumentArray.
- ok := true.
+ val := self perform:aSelector withArguments:argumentArray.
+ ok := true.
].
ok isNil ifTrue:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
^ val
@@ -7894,148 +7909,148 @@
int nInsts, inst;
if (! __isNonNilObject(self)) {
- RETURN (false);
+ RETURN (false);
}
if (__isArrayLike(aCollection)) {
- int nObjs = __arraySize(aCollection);
- char *minAddr = 0, *maxAddr = 0;
-
- if (nObjs == 0) {
- RETURN (false);
- }
-
- /*
- * a little optimization: use the fact that all old objects
- * refering to a new object are on the remSet; if I am not,
- * a trivial reject is possible, if all objects are newbees.
- * as a side effect, gather min/max addresses
- */
- if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
- int allNewBees = 1;
- int i;
-
- minAddr = (char *)(__ArrayInstPtr(aCollection)->a_element[0]);
- maxAddr = minAddr;
-
- for (i=0; i<nObjs; i++) {
- OBJ anObject;
-
- anObject = __ArrayInstPtr(aCollection)->a_element[i];
-
- if (__isNonNilObject(anObject)) {
- int spc;
-
- if (((spc = __qSpace(anObject)) != NEWSPACE) && (spc != SURVSPACE)) {
- allNewBees = 0;
- }
- }
-
- if ((char *)anObject < minAddr) {
- minAddr = (char *)anObject;
- } else if ((char *)anObject > maxAddr) {
- maxAddr = (char *)anObject;
- }
- }
- if (allNewBees) {
- RETURN (false);
- }
- }
-
- /*
- * fetch min/max in searchList (if not already done)
- */
- if (minAddr == 0) {
- int i;
-
- for (i=0; i<nObjs; i++) {
- OBJ anObject;
-
- anObject = __ArrayInstPtr(aCollection)->a_element[i];
- if ((char *)anObject < minAddr) {
- minAddr = (char *)anObject;
- } else if ((char *)anObject > maxAddr) {
- maxAddr = (char *)anObject;
- }
- }
- }
-
- cls = __qClass(self);
- if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) {
+ int nObjs = __arraySize(aCollection);
+ char *minAddr = 0, *maxAddr = 0;
+
+ if (nObjs == 0) {
+ RETURN (false);
+ }
+
+ /*
+ * a little optimization: use the fact that all old objects
+ * refering to a new object are on the remSet; if I am not,
+ * a trivial reject is possible, if all objects are newbees.
+ * as a side effect, gather min/max addresses
+ */
+ if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
+ int allNewBees = 1;
+ int i;
+
+ minAddr = (char *)(__ArrayInstPtr(aCollection)->a_element[0]);
+ maxAddr = minAddr;
+
+ for (i=0; i<nObjs; i++) {
+ OBJ anObject;
+
+ anObject = __ArrayInstPtr(aCollection)->a_element[i];
+
+ if (__isNonNilObject(anObject)) {
+ int spc;
+
+ if (((spc = __qSpace(anObject)) != NEWSPACE) && (spc != SURVSPACE)) {
+ allNewBees = 0;
+ }
+ }
+
+ if ((char *)anObject < minAddr) {
+ minAddr = (char *)anObject;
+ } else if ((char *)anObject > maxAddr) {
+ maxAddr = (char *)anObject;
+ }
+ }
+ if (allNewBees) {
+ RETURN (false);
+ }
+ }
+
+ /*
+ * fetch min/max in searchList (if not already done)
+ */
+ if (minAddr == 0) {
+ int i;
+
+ for (i=0; i<nObjs; i++) {
+ OBJ anObject;
+
+ anObject = __ArrayInstPtr(aCollection)->a_element[i];
+ if ((char *)anObject < minAddr) {
+ minAddr = (char *)anObject;
+ } else if ((char *)anObject > maxAddr) {
+ maxAddr = (char *)anObject;
+ }
+ }
+ }
+
+ cls = __qClass(self);
+ if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) {
#if defined(memsrch4)
- if (memsrch4(__arrayVal(aCollection), (INT)cls, nObjs)) {
- RETURN (true);
- }
+ if (memsrch4(__arrayVal(aCollection), (INT)cls, nObjs)) {
+ RETURN (true);
+ }
#else
- int i;
-
- for (i=0; i<nObjs; i++) {
- OBJ anObject;
-
- anObject = __ArrayInstPtr(aCollection)->a_element[i];
- if (cls == anObject) {
- RETURN (true);
- }
- }
+ int i;
+
+ for (i=0; i<nObjs; i++) {
+ OBJ anObject;
+
+ anObject = __ArrayInstPtr(aCollection)->a_element[i];
+ if (cls == anObject) {
+ RETURN (true);
+ }
+ }
#endif /* memsrch4 */
- }
-
- flags = __ClassInstPtr(cls)->c_flags;
- if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
- nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
- } else {
- nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
- }
- if (! nInsts) {
- RETURN (false);
- }
-
- if (nObjs == 1) {
- /* better reverse the loop */
- OBJ anObject;
-
- anObject = __ArrayInstPtr(aCollection)->a_element[0];
+ }
+
+ flags = __ClassInstPtr(cls)->c_flags;
+ if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
+ nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
+ } else {
+ nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
+ }
+ if (! nInsts) {
+ RETURN (false);
+ }
+
+ if (nObjs == 1) {
+ /* better reverse the loop */
+ OBJ anObject;
+
+ anObject = __ArrayInstPtr(aCollection)->a_element[0];
#if defined(memsrch4)
- if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
- RETURN (true);
- }
+ if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
+ RETURN (true);
+ }
#else
- for (inst=0; inst<nInsts; inst++) {
- if ((__InstPtr(self)->i_instvars[inst]) == anObject) {
- RETURN (true);
- }
- }
+ for (inst=0; inst<nInsts; inst++) {
+ if ((__InstPtr(self)->i_instvars[inst]) == anObject) {
+ RETURN (true);
+ }
+ }
#endif
- RETURN (false);
- }
-
- for (inst=0; inst<nInsts; inst++) {
- OBJ instVar = __InstPtr(self)->i_instvars[inst];
- int i;
-
- if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) {
+ RETURN (false);
+ }
+
+ for (inst=0; inst<nInsts; inst++) {
+ OBJ instVar = __InstPtr(self)->i_instvars[inst];
+ int i;
+
+ if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) {
#if defined(memsrch4)
- if (memsrch4(__arrayVal(aCollection), (INT)instVar, nObjs)) {
- RETURN (true);
- }
+ if (memsrch4(__arrayVal(aCollection), (INT)instVar, nObjs)) {
+ RETURN (true);
+ }
#else
- for (i=0; i<nObjs; i++) {
- OBJ anObject;
-
- anObject = __ArrayInstPtr(aCollection)->a_element[i];
- if (instVar == anObject) {
- RETURN (true);
- }
- }
+ for (i=0; i<nObjs; i++) {
+ OBJ anObject;
+
+ anObject = __ArrayInstPtr(aCollection)->a_element[i];
+ if (instVar == anObject) {
+ RETURN (true);
+ }
+ }
#endif /* memsrch4 */
- }
- }
- RETURN (false);
+ }
+ }
+ RETURN (false);
}
%}.
aCollection do:[:el |
- (self referencesObject:el) ifTrue:[^ true].
+ (self referencesObject:el) ifTrue:[^ true].
].
^ false
!
@@ -8055,19 +8070,19 @@
"check the instance variables"
numInst := myClass instSize.
1 to:numInst do:[:i |
- ((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
+ ((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
].
"check the indexed variables"
myClass isVariable ifTrue:[
- myClass isPointers ifFalse:[
- "no need to search in non pointer fields"
- ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
- ].
- numInst := self basicSize.
- 1 to:numInst do:[:i |
- ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
- ]
+ myClass isPointers ifFalse:[
+ "no need to search in non pointer fields"
+ ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
+ ].
+ numInst := self basicSize.
+ 1 to:numInst do:[:i |
+ ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
+ ]
].
^ false
@@ -8086,21 +8101,21 @@
"check the instance variables"
numInst := myClass instSize.
1 to:numInst do:[:i |
- inst := self instVarAt:i.
- (checkBlock value:inst) ifTrue:[actionBlock value:inst].
+ inst := self instVarAt:i.
+ (checkBlock value:inst) ifTrue:[actionBlock value:inst].
].
"check the indexed variables"
myClass isVariable ifTrue:[
- myClass isPointers ifTrue:[
- "no need to search in non pointer fields"
-
- numInst := self basicSize.
- 1 to:numInst do:[:i |
- inst := self basicAt:i.
- (checkBlock value:inst) ifTrue:[actionBlock value:inst].
- ]
- ]
+ myClass isPointers ifTrue:[
+ "no need to search in non pointer fields"
+
+ numInst := self basicSize.
+ 1 to:numInst do:[:i |
+ inst := self basicAt:i.
+ (checkBlock value:inst) ifTrue:[actionBlock value:inst].
+ ]
+ ]
].
"
@@ -8124,24 +8139,24 @@
"check the instance variables"
numInst := myClass instSize.
1 to:numInst do:[:i |
- ((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
+ ((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
].
"check the indexed variables"
myClass isVariable ifTrue:[
- myClass isPointers ifFalse:[
- "no need to search in non-pointer indexed fields"
- myClass isLongs ifTrue:[
- (aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
- ] ifFalse:[
- myClass isFloatsOrDoubles ifTrue:[^ aClass == Float].
- ^ aClass == SmallInteger
- ]
- ].
- numInst := self basicSize.
- 1 to:numInst do:[:i |
- ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
- ]
+ myClass isPointers ifFalse:[
+ "no need to search in non-pointer indexed fields"
+ myClass isLongs ifTrue:[
+ (aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
+ ] ifFalse:[
+ myClass isFloatsOrDoubles ifTrue:[^ aClass == Float].
+ ^ aClass == SmallInteger
+ ]
+ ].
+ numInst := self basicSize.
+ 1 to:numInst do:[:i |
+ ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
+ ]
].
^ false
@@ -8161,7 +8176,7 @@
int nInsts, i;
if (! __isNonNilObject(self)) {
- RETURN (false);
+ RETURN (false);
}
/*
@@ -8170,38 +8185,38 @@
* a trivial reject is possible, if anObject is a newbee
*/
if (__isNonNilObject(anObject)) {
- if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
- int spc;
-
- if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
- RETURN (false);
- }
- }
+ if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
+ int spc;
+
+ if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
+ RETURN (false);
+ }
+ }
}
cls = __qClass(self);
if (cls == anObject) {
- RETURN (true);
+ RETURN (true);
}
flags = __ClassInstPtr(cls)->c_flags;
if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
- nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
+ nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
} else {
- nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
+ nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
}
if (! nInsts) {
- RETURN (false);
+ RETURN (false);
}
#if defined(memsrch4)
if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
- RETURN (true);
+ RETURN (true);
}
#else
for (i=0; i<nInsts; i++) {
- if (__InstPtr(self)->i_instvars[i] == anObject) {
- RETURN (true);
- }
+ if (__InstPtr(self)->i_instvars[i] == anObject) {
+ RETURN (true);
+ }
}
#endif /* memsrch4 */
@@ -8266,7 +8281,6 @@
"
! !
-
!Object methodsFor:'synchronized evaluation'!
freeSynchronizationSemaphore
@@ -8277,8 +8291,8 @@
sema := self synchronizationSemaphore.
sema notNil ifTrue:[
- sema wait. "/ get lock
- self synchronizationSemaphore:nil.
+ sema wait. "/ get lock
+ self synchronizationSemaphore:nil.
].
"
@@ -8309,10 +8323,10 @@
subclasses may redefine this method"
aSemaphore isNil ifTrue:[
- "/ remove Semaphore
- SynchronizationSemaphores removeKey:self ifAbsent:nil.
+ "/ remove Semaphore
+ SynchronizationSemaphores removeKey:self ifAbsent:nil.
] ifFalse:[
- SynchronizationSemaphores at:self put:aSemaphore.
+ SynchronizationSemaphores at:self put:aSemaphore.
].
"Modified: 28.1.1997 / 19:37:48 / stefan"
@@ -8327,8 +8341,8 @@
sema := self synchronizationSemaphore.
sema isNil ifTrue:[
- sema := RecursionLock new name:self className.
- self synchronizationSemaphore:sema.
+ sema := RecursionLock new name:self className.
+ self synchronizationSemaphore:sema.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -8367,7 +8381,7 @@
%{ /* NOCONTEXT */
if (! __isNonNilObject(self)) {
- RETURN (self);
+ RETURN (self);
}
__beImmutable(self);
%}
@@ -8378,7 +8392,7 @@
%{ /* NOCONTEXT */
if (! __isNonNilObject(self)) {
- RETURN (self);
+ RETURN (self);
}
__beMutable(self);
%}
@@ -8402,7 +8416,7 @@
- the Collection-classes have been rewritten to not use it.)"
%{
if (__primBecome(self, anotherObject)) {
- RETURN ( self );
+ RETURN ( self );
}
%}.
self primitiveFailed
@@ -8418,7 +8432,7 @@
%{
if (__primBecomeNil(self)) {
- RETURN ( nil );
+ RETURN ( nil );
}
%}.
self primitiveFailed
@@ -8439,7 +8453,7 @@
or nil, or is a context of a living method (i.e. one that has not already returned)."
%{
if (__primBecomeSameAs(self, anotherObject)) {
- RETURN ( self );
+ RETURN ( self );
}
%}.
self primitiveFailed
@@ -8460,74 +8474,74 @@
"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 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 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;
+ {
+ OBJ me = self;
// gcc4.4 does not like this:
- // __qClass(me) = otherClass;
- __objPtr(me)->o_class = (CLASS_OBJ)otherClass;
- __STORE(me, otherClass);
- RETURN (me);
- }
+ // __qClass(me) = otherClass;
+ __objPtr(me)->o_class = (CLASS_OBJ)otherClass;
+ __STORE(me, otherClass);
+ RETURN (me);
+ }
%}.
].
@@ -8555,7 +8569,7 @@
%{ /* NOCONTEXT */
if (! __isNonNilObject(self)) {
- RETURN (true);
+ RETURN (true);
}
RETURN (__isImmutable(self) ? true : false);
%}
@@ -8633,27 +8647,27 @@
the recevier is retuned here.
Thus, if foo and bar are simple variables or constants,
- foo ? bar
+ foo ? bar
is the same as:
- (foo isNil ifTrue:[bar] ifFalse:[foo])
+ (foo isNil ifTrue:[bar] ifFalse:[foo])
if they are message sends, the equivalent code is:
- [
- |t1 t2|
-
- t1 := foo.
- t2 := bar.
- t1 isNil ifTrue:[t2] ifFalse:[t1]
- ] value
+ [
+ |t1 t2|
+
+ t1 := foo.
+ t2 := bar.
+ t1 isNil ifTrue:[t2] ifFalse:[t1]
+ ] value
Can be used to provide defaultValues to variables,
as in:
- foo := arg ? #defaultValue
+ foo := arg ? #defaultValue
Note: this method should never be redefined in classes other than UndefinedObject.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
^ self
@@ -8715,8 +8729,8 @@
This is much like #?, but sends #value to the argument in case of a nil
receiver.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
^ self
!
@@ -8725,11 +8739,11 @@
"return the value of the first arg, if I am nil,
the result from evaluating the 2nd argument, if I am not nil.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
(notNilBlockOrValue isBlock and:[notNilBlockOrValue numArgs == 1]) ifTrue:[
- ^ notNilBlockOrValue value:self.
+ ^ notNilBlockOrValue value:self.
].
^ notNilBlockOrValue value
!
@@ -8738,11 +8752,11 @@
"return myself if nil, or the result from evaluating the argument,
if I am not nil.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
(aBlockOrValue isBlock and:[aBlockOrValue numArgs == 1]) ifTrue:[
- ^ aBlockOrValue value:self.
+ ^ aBlockOrValue value:self.
].
^ aBlockOrValue value
!
@@ -8751,11 +8765,11 @@
"return the value of the 2nd arg, if I am nil,
the result from evaluating the 1st argument, if I am not nil.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
(notNilBlockOrValue isBlock and:[notNilBlockOrValue numArgs == 1]) ifTrue:[
- ^ notNilBlockOrValue value:self.
+ ^ notNilBlockOrValue value:self.
].
^ notNilBlockOrValue value
!
@@ -9116,21 +9130,21 @@
"return true, if the receiver is an instance of aClass or one of its
subclasses, false otherwise.
Advice:
- use of this to check objects for certain attributes/protocol should
- be avoided; it limits the reusability of your classes by limiting use
- to instances of certain classes and fences you into a specific inheritance
- hierarchy.
- Use check-methods to check an object for a certain attributes/protocol
- (such as #isXXXX, #respondsTo: or #isNumber).
-
- Using #isKindOf: is considered BAD STYLE.
+ use of this to check objects for certain attributes/protocol should
+ be avoided; it limits the reusability of your classes by limiting use
+ to instances of certain classes and fences you into a specific inheritance
+ hierarchy.
+ Use check-methods to check an object for a certain attributes/protocol
+ (such as #isXXXX, #respondsTo: or #isNumber).
+
+ Using #isKindOf: is considered BAD STYLE.
Advice2:
- Be aware, that using an #isXXX method is usually much faster than
- using #isKindOf:; because isKindOf: has to walk up all the superclass
- hierarchy, comparing every class on the way.
- Due to caching in the VM, a call to #isXXX is normally reached via
- a single function call.
+ Be aware, that using an #isXXX method is usually much faster than
+ using #isKindOf:; because isKindOf: has to walk up all the superclass
+ hierarchy, comparing every class on the way.
+ Due to caching in the VM, a call to #isXXX is normally reached via
+ a single function call.
"
%{ /* NOCONTEXT */
@@ -9138,10 +9152,10 @@
thisClass = __Class(self);
while (thisClass != nil) {
- if (thisClass == aClass) {
- RETURN ( true );
- }
- thisClass = __ClassInstPtr(thisClass)->c_superclass;
+ if (thisClass == aClass) {
+ RETURN ( true );
+ }
+ thisClass = __ClassInstPtr(thisClass)->c_superclass;
}
RETURN ( false );
%}
@@ -9195,16 +9209,16 @@
isMemberOf:aClass
"return true, if the receiver is an instance of aClass, false otherwise.
Advice:
- use of this to check objects for certain attributes/protocol should
- be avoided; it limits the reusability of your classes by limiting use
- to instances of a certain class.
- Use check-methods to check an object for a certain attributes/protocol
- (such as #isXXX, #respondsTo: or #isNumber);
-
- Using #isMemberOf: is considered BAD STYLE.
+ use of this to check objects for certain attributes/protocol should
+ be avoided; it limits the reusability of your classes by limiting use
+ to instances of a certain class.
+ Use check-methods to check an object for a certain attributes/protocol
+ (such as #isXXX, #respondsTo: or #isNumber);
+
+ Using #isMemberOf: is considered BAD STYLE.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
^ (self class) == aClass
!
@@ -9255,8 +9269,8 @@
Because isNil is redefined in UndefinedObject,
the receiver is definitely not nil here, so unconditionally return false.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
^ false
!
@@ -9279,11 +9293,11 @@
^ false
"
- 21 isNonByteCollection
- 'abc' isNonByteCollection
- #'abc' isNonByteCollection
- #[1 2 3] isNonByteCollection
- #(1 2 3) isNonByteCollection
+ 21 isNonByteCollection
+ 'abc' isNonByteCollection
+ #'abc' isNonByteCollection
+ #[1 2 3] isNonByteCollection
+ #(1 2 3) isNonByteCollection
"
!
@@ -9522,8 +9536,8 @@
Because notNil is redefined in UndefinedObject,
the receiver is definitely not nil here, so unconditionally return true.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
^ true
! !
@@ -9552,7 +9566,7 @@
It could also be put into some logfile or printed on the standard output/error."
ActivityNotification isHandled ifTrue:[
- ^ ActivityNotification raiseRequestWith:self errorString:aString
+ ^ ActivityNotification raiseRequestWith:self errorString:aString
].
"
@@ -9562,12 +9576,12 @@
"
ActivityNotification handle:[:ex |
- ex errorString printCR.
- ex proceed.
+ ex errorString printCR.
+ ex proceed.
] do:[
- 'hello' printCR.
- self activityNotification:'doing some long time computation'.
- 'world' printCR.
+ 'hello' printCR.
+ self activityNotification:'doing some long time computation'.
+ 'world' printCR.
]
"
@@ -9599,7 +9613,7 @@
answer := self confirmWithCancel:aString.
answer isNil ifTrue:[
- ^ cancelBlock value
+ ^ cancelBlock value
].
^ answer
@@ -9635,10 +9649,10 @@
by handling the UserConfirmation."
^ UserConfirmation new
- defaultAnswer:defaultAnswerOrNil;
- canCancel:true;
- errorString:aString;
- raiseRequest
+ defaultAnswer:defaultAnswerOrNil;
+ canCancel:true;
+ errorString:aString;
+ raiseRequest
"
nil confirmWithCancel:'hello' defaultAnswer:true
@@ -9651,10 +9665,10 @@
and give user a chance to enter debugger."
^ self
- errorNotify:aString
- from:thisContext sender
- allowDebug:true
- mayProceed:true
+ errorNotify:aString
+ from:thisContext sender
+ allowDebug:true
+ mayProceed:true
"
nil errorNotify:'hello there'
@@ -9847,12 +9861,12 @@
"
InformationSignal handle:[:ex |
- 'no box popped' printCR.
- ex proceed.
+ 'no box popped' printCR.
+ ex proceed.
] do:[
- 'hello' printCR.
- self information:'some info'.
- 'world' printCR.
+ 'hello' printCR.
+ self information:'some info'.
+ 'world' printCR.
]
"
@@ -9867,9 +9881,9 @@
Smalltalk isInitialized ifFalse:[
- "/ thisContext fullPrintAll.
- 'information: ' print. aString printCR.
- ^ self
+ "/ thisContext fullPrintAll.
+ 'information: ' print. aString printCR.
+ ^ self
].
UserNotification raiseRequestWith:self errorString:aString.
@@ -9897,12 +9911,12 @@
"
Warning handle:[:ex |
- Transcript showCR:ex description.
- ex proceed.
+ Transcript showCR:ex description.
+ ex proceed.
] do:[
- 'hello' printCR.
- self warn:'some info'.
- 'world' printCR.
+ 'hello' printCR.
+ self warn:'some info'.
+ 'world' printCR.
]
"
@@ -9924,7 +9938,6 @@
^ aVisitor visitObject:self with:aParameter
! !
-
!Object class methodsFor:'documentation'!
version
@@ -9935,6 +9948,11 @@
^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.745 2014-01-23 16:11:47 stefan Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: Object.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
--- a/ObjectMemory.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ObjectMemory.st Sun Feb 02 14:16:24 2014 +0000
@@ -916,6 +916,52 @@
%}
! !
+!ObjectMemory class methodsFor:'VM unwind protect support'!
+
+lookupMethodForSelectorUnwindHandlerFor: lookup
+
+ "
+ An unwind handler for external method lookup
+ (MOP). This method effectively called only
+ from handler block returned by
+ ObjectMemory>>unwindHandlerInContext:.
+
+ The VM also create an artifical context with
+ ObjectMemory as receiver and selector if this
+ method as selector and marks it for unwind.
+
+ See: ObjectMemory>>unwindHandlerInContext:
+ "
+
+ Processor activeProcess externalLookupPopIfEqual: lookup.
+
+ "Created: / 06-10-2011 / 16:31:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+unwindHandlerInContext:aContext
+
+ "
+ Return an unwind handler block for given context.
+ Selector of that context denotes which unwind handler
+ to use.
+
+ Occasionally, the VM needs to unwind-protect some C code.
+ If so, it creates and artificial context on the stack and
+ marks it for unwind, so stack unwinding logic finds it
+ and handles it.
+
+ Now, only #lookupMethodForSelectorUnwindProtect is supported
+ (ensures the lookup is popped out from the lookupActications)
+ "
+ aContext selector == #lookupMethodForSelectorUnwindHandlerFor: ifTrue:[
+ ^[self lookupMethodForSelectorUnwindHandlerFor: (aContext argAt: 1)]
+ ].
+
+ self internalError:'Unknown VM unwind protect action'
+
+ "Created: / 01-10-2011 / 19:15:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!ObjectMemory class methodsFor:'access debugging'!
debugPrivacyChecks:aBoolean
--- a/OpenVMSFileHandle.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OpenVMSFileHandle.st Sun Feb 02 14:16:24 2014 +0000
@@ -53,5 +53,8 @@
!OpenVMSFileHandle class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OpenVMSFileHandle.st,v 1.1 1999-09-18 11:11:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OpenVMSFileHandle.st,v 1.1 1999/09/18 11:11:28 cg Exp $'
! !
+
+
+
--- a/OpenVMSFilename.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OpenVMSFilename.st Sun Feb 02 14:16:24 2014 +0000
@@ -1170,5 +1170,8 @@
!OpenVMSFilename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OpenVMSFilename.st,v 1.18 1997-10-16 10:41:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OpenVMSFilename.st,v 1.18 1997/10/16 10:41:25 cg Exp $'
! !
+
+
+
--- a/OsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Error subclass:#OsError
@@ -44,5 +43,12 @@
!OsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsError.st,v 1.3 2003-08-30 12:31:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsError.st,v 1.3 2003/08/30 12:31:08 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsIllegalOperation.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsIllegalOperation.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsIllegalOperation
@@ -38,5 +37,12 @@
!OsIllegalOperation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsIllegalOperation.st,v 1.3 2003-08-30 12:31:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsIllegalOperation.st,v 1.3 2003/08/30 12:31:20 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsIllegalOperation.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsInaccessibleError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsInaccessibleError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsInaccessibleError
@@ -38,5 +37,12 @@
!OsInaccessibleError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsInaccessibleError.st,v 1.3 2003-08-30 12:31:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsInaccessibleError.st,v 1.3 2003/08/30 12:31:14 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsInaccessibleError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsInvalidArgumentsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsInvalidArgumentsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsInvalidArgumentsError
@@ -38,5 +37,12 @@
!OsInvalidArgumentsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsInvalidArgumentsError.st,v 1.3 2003-08-30 12:31:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsInvalidArgumentsError.st,v 1.3 2003/08/30 12:31:17 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsInvalidArgumentsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsNeedRetryError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsNeedRetryError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsNeedRetryError
@@ -38,5 +37,12 @@
!OsNeedRetryError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsNeedRetryError.st,v 1.3 2003-08-30 12:31:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsNeedRetryError.st,v 1.3 2003/08/30 12:31:04 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsNeedRetryError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsNoResourcesError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsNoResourcesError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsNoResourcesError
@@ -38,5 +37,12 @@
!OsNoResourcesError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsNoResourcesError.st,v 1.3 2003-08-30 12:31:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsNoResourcesError.st,v 1.3 2003/08/30 12:31:11 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsNoResourcesError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsNotification.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsNotification.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsNotification
@@ -38,5 +37,12 @@
!OsNotification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsNotification.st,v 1.3 2003-08-30 12:31:22 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsNotification.st,v 1.3 2003/08/30 12:31:22 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsNotification.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OsTransferFaultError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OsTransferFaultError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OsError subclass:#OsTransferFaultError
@@ -38,5 +37,12 @@
!OsTransferFaultError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OsTransferFaultError.st,v 1.3 2003-08-30 12:31:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OsTransferFaultError.st,v 1.3 2003/08/30 12:31:25 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OsTransferFaultError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/OverflowError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/OverflowError.st Sun Feb 02 14:16:24 2014 +0000
@@ -41,16 +41,22 @@
"
! !
+
!OverflowError class methodsFor:'initialization'!
initialize
NotifierString := 'overflow'.
! !
+
!OverflowError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/OverflowError.st,v 1.4 2013-03-13 23:43:48 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: OverflowError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/PeekableStream.st Sun Feb 02 00:13:55 2014 +0100
+++ b/PeekableStream.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
Stream subclass:#PeekableStream
- instanceVariableNames:''
- classVariableNames:'ErrorDuringFileInSignal CurrentFileInDirectoryQuerySignal
+ instanceVariableNames: ''
+ classVariableNames: 'ErrorDuringFileInSignal CurrentFileInDirectoryQuerySignal
CurrentSourceContainerQuery'
- poolDictionaries:''
- category:'Streams'
+ poolDictionaries: ''
+ category: 'Streams'
!
!PeekableStream class methodsFor:'documentation'!
@@ -46,6 +46,7 @@
"
! !
+
!PeekableStream class methodsFor:'initialization'!
initialize
@@ -64,6 +65,7 @@
"Modified: / 23-10-2006 / 16:34:41 / cg"
! !
+
!PeekableStream class methodsFor:'Signal constants'!
currentFileInDirectoryQuerySignal
@@ -100,6 +102,7 @@
"Modified: / 23-10-2006 / 16:32:49 / cg"
! !
+
!PeekableStream class methodsFor:'queries'!
currentFileInDirectory
@@ -118,6 +121,7 @@
"Modified: / 23-10-2006 / 16:33:40 / cg"
! !
+
!PeekableStream methodsFor:'chunk input/output'!
nextChunk
@@ -219,21 +223,14 @@
^ theString
! !
+
!PeekableStream methodsFor:'fileIn'!
fileIn
"file in from the receiver, i.e. read chunks and evaluate them -
return the value of the last chunk."
- |notifiedLoader lastValue s|
-
- self isEncodedStream ifFalse:[
- s := EncodedStream decodedStreamFor:self.
- "/ may return myself, in case no decoding is required...
- s ~~ self ifTrue:[
- ^ s fileIn
- ]
- ].
+ |notifiedLoader lastValue|
SourceFileLoader notNil ifTrue:[
notifiedLoader := SourceFileLoader on:self.
@@ -268,6 +265,7 @@
"Modified: / 13.11.2001 / 10:14:04 / cg"
! !
+
!PeekableStream methodsFor:'positioning'!
skipAny:skipCollection
@@ -370,6 +368,7 @@
"
! !
+
!PeekableStream methodsFor:'private fileIn'!
basicFileInNotifying:someone passChunk:passChunk
@@ -377,154 +376,11 @@
return the value of the last chunk.
Someone (which is usually some codeView) is notified of errors."
- |lastValue pkg nameSpace usedNameSpaces
- packageQuerySignal nameSpaceQuerySignal usedNameSpaceQuerySignal
- changeDefaultApplicationNotificationSignal
- defaultApplicationQuerySignal defaultApplication
- confirmationQuerySignal handledSignals passedSignals askSomeoneForPackage outerContext askForVariableTypeOfUndeclaredQuery|
-
- self skipSeparators.
- lastValue := self peek.
- lastValue == $< ifTrue:[
- "/ assume, it's an xml file
- ^ self fileInXMLNotifying:someone passChunk:passChunk.
- ].
- lastValue == $# ifTrue:[
- "assume unix interpreter name:
- '#!!stx -e' or something like this"
- self nextPeek == $!! ifTrue:[
- "skip the unix command line"
- self nextLine
- ] ifFalse:[
- self error:'Invalid chunk start'
- ]
- ].
-
- Smalltalk::Compiler isNil ifTrue:[
- self isFileStream ifTrue:[
- Transcript show:('[' , self pathName , '] ').
- ].
- Transcript showCR:'cannot fileIn (no compiler).'.
- ^ nil.
- ].
-
- "/ support for V'Age applications
- defaultApplicationQuerySignal := Class defaultApplicationQuerySignal.
- changeDefaultApplicationNotificationSignal := Class changeDefaultApplicationNotificationSignal.
-
- "/ support for ST/X's nameSpaces & packages
- packageQuerySignal := Class packageQuerySignal.
- nameSpaceQuerySignal := Class nameSpaceQuerySignal.
- usedNameSpaceQuerySignal := Class usedNameSpaceQuerySignal.
-
- (someone respondsTo:#packageToInstall) ifTrue:[
- pkg := someone packageToInstall.
- askSomeoneForPackage := true.
- ] ifFalse:[
- pkg := packageQuerySignal query.
- askSomeoneForPackage := false.
- ].
- (someone respondsTo:#currentNameSpace) ifTrue:[
- nameSpace := someone currentNameSpace
- ] ifFalse:[
- nameSpace := nameSpaceQuerySignal query.
- ].
- (someone respondsTo:#usedNameSpaces) ifTrue:[
- usedNameSpaces := someone usedNameSpaces
- ] ifFalse:[
- usedNameSpaces := usedNameSpaceQuerySignal query.
- ].
- (someone respondsTo:#defaultApplication) ifTrue:[
- defaultApplication := someone defaultApplication
- ] ifFalse:[
- defaultApplication := defaultApplicationQuerySignal query.
- ].
-
- confirmationQuerySignal := Metaclass confirmationQuerySignal.
-
- handledSignals := SignalSet new.
- passedSignals := IdentitySet new.
-
- handledSignals add:changeDefaultApplicationNotificationSignal.
- passedSignals add:changeDefaultApplicationNotificationSignal.
- handledSignals add:defaultApplicationQuerySignal.
- passedSignals add:defaultApplicationQuerySignal.
+ ^(EncodedStream decodedStreamFor:self) basicFileInNotifying:someone passChunk:passChunk
- handledSignals add:packageQuerySignal.
- handledSignals add:usedNameSpaceQuerySignal.
- handledSignals add:nameSpaceQuerySignal.
- handledSignals add:confirmationQuerySignal.
- passedSignals add:confirmationQuerySignal.
- Parser notNil ifTrue:[
- "only if libcomp is present"
- "Also catch a 'Parser askForVariableTypeOfUndeclaredQuery' and proceed with nil.
- Imagine somebody has autodefine workspace variables on and then
- evaluate Smalltalk loadPackage:'xyz' that loads code from source (using file-in),
- certainly we don't want to compile workspace variable access for every
- not-yet-loaded class in some namespace.
- This is demonstrated by Regression::CompilerTests2>>test_01
- and this change actually fixes this test."
- askForVariableTypeOfUndeclaredQuery := Parser askForVariableTypeOfUndeclaredQuery.
- handledSignals add:askForVariableTypeOfUndeclaredQuery.
- ].
-
-
- outerContext := thisContext.
-
- handledSignals handle:[:ex |
- |sig|
-
- sig := ex creator.
- ((passedSignals includes:sig) and:[sig isHandledIn:outerContext]) ifTrue:[
- ex reject
- ].
-
- sig == changeDefaultApplicationNotificationSignal ifTrue:[
- "/ invoked via #becomeDefault to set the defaultApp and the package.
- "/ (only when filing in V'Age code)
- defaultApplication := ex parameter.
- pkg := defaultApplication name asSymbol.
- ex proceedWith:nil
- ].
- sig == defaultApplicationQuerySignal ifTrue:[
- "/ query for the application to add classes & methods into
- "/ (only when filing in V'Age code)
- ex proceedWith:defaultApplication
- ].
- sig == packageQuerySignal ifTrue:[
- "answer the package to use for classes & methods"
- askSomeoneForPackage ifTrue:[
- ex proceedWith:someone packageToInstall
- ] ifFalse:[
- ex proceedWith:pkg
- ]
- ].
- sig == usedNameSpaceQuerySignal ifTrue:[
- "answer the nameSpaces to be searched when encountering globals"
- ex proceedWith:usedNameSpaces
- ].
- sig == nameSpaceQuerySignal ifTrue:[
- "answer the nameSpace to install new classes in"
- ex proceedWith:nameSpace
- ].
- sig == confirmationQuerySignal ifTrue:[
- "don't pop up dialogs"
- ex proceedWith:false
- ].
- sig == askForVariableTypeOfUndeclaredQuery ifTrue:[
- "no autodefined variables or so"
- ex proceedWith:nil.
- ].
- ] do:[
- [self atEnd] whileFalse:[
- lastValue := self fileInNextChunkNotifying:someone passChunk:passChunk
- ]
- ].
- ^ lastValue
-
- "Modified: / 10.9.1999 / 16:54:01 / stefan"
- "Modified: / 16.11.2001 / 16:21:28 / cg"
- "Modified: / 18-03-2013 / 17:45:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-09-1999 / 16:54:01 / stefan"
+ "Modified: / 16-11-2001 / 16:21:28 / cg"
+ "Modified: / 25-03-2013 / 22:57:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileInNextChunkNotifying:someone
@@ -667,6 +523,7 @@
"/ self halt.
! !
+
!PeekableStream methodsFor:'reading'!
nextDecimalInteger
@@ -912,6 +769,7 @@
"Modified: 4.1.1997 / 23:38:05 / cg"
! !
+
!PeekableStream methodsFor:'reading-strings'!
nextAlphaNumericWord
@@ -1046,6 +904,7 @@
"Modified: 15.5.1996 / 17:51:42 / cg"
! !
+
!PeekableStream class methodsFor:'documentation'!
version
@@ -1054,6 +913,11 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/PeekableStream.st,v 1.44 2013-04-19 09:39:39 cg Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
--- a/Point.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Point.st Sun Feb 02 14:16:24 2014 +0000
@@ -1184,7 +1184,14 @@
!Point class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Point.st,v 1.73 2009-05-26 06:31:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Point.st,v 1.73 2009/05/26 06:31:07 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: Point.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
Point initialize!
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PolymorphicInlineCache.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,106 @@
+"
+ COPYRIGHT (c) 2011 by Jan Vrany & Jan Kurs
+ SWING Research Group, Czech Technical University in Prague
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the 'Software'), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+"
+"{ Package: 'stx:libbasic' }"
+
+Object subclass:#PolymorphicInlineCache
+ instanceVariableNames:'address numArgs'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
+!
+
+!PolymorphicInlineCache class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2011 by Jan Vrany & Jan Kurs
+ SWING Research Group, Czech Technical University in Prague
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the 'Software'), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+
+"
+!
+
+documentation
+"
+ This class provides a basic access to inline cache structure as
+ used by the virtual machine.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+ Janb Kurs <kursjan@fit.cvut.cz>
+
+ [instance variables:]
+ address <ExternalAddress> a pointer to the VM inline cache structure.
+ if the adress is NULL, then PolymorphicInlineCache
+ is invalid.
+ numArgs <SmallInteger> a number of arguments
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+!PolymorphicInlineCache methodsFor:'binding / unbinding'!
+
+bindTo: aMethod forClass: aClass
+
+ | selector |
+ selector := aMethod selector.
+%{
+ __ilcBind(self, aClass, aMethod, selector);
+ RETURN(self);
+%}.
+ self primitiveFailed.
+
+ "Created: / 02-10-2011 / 18:05:26 / Jan Kurs <kursjan@fit.cvut.cz>"
+! !
+
+!PolymorphicInlineCache class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PolymorphicInlineCache.st 10712 2011-10-04 21:59:41Z kursjan $'
+! !
--- a/PositionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/PositionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#PositionError
@@ -38,5 +37,12 @@
!PositionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PositionError.st,v 1.2 2005-02-02 11:02:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PositionError.st,v 1.2 2005/02/02 11:02:33 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: PositionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/PositionOutOfBoundsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/PositionOutOfBoundsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#PositionOutOfBoundsError
@@ -44,5 +43,12 @@
!PositionOutOfBoundsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PositionOutOfBoundsError.st,v 1.3 2003-08-29 19:14:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PositionOutOfBoundsError.st,v 1.3 2003/08/29 19:14:46 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: PositionOutOfBoundsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/PrimitiveFailure.st Sun Feb 02 00:13:55 2014 +0100
+++ b/PrimitiveFailure.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
ExecutionError subclass:#PrimitiveFailure
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-ExecutionErrors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-ExecutionErrors'
!
!PrimitiveFailure class methodsFor:'documentation'!
@@ -43,6 +43,7 @@
"
! !
+
!PrimitiveFailure class methodsFor:'initialization'!
initialize
@@ -53,6 +54,7 @@
"
! !
+
!PrimitiveFailure methodsFor:'printing & storing'!
description
@@ -66,10 +68,15 @@
^ desc
! !
+
!PrimitiveFailure class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/PrimitiveFailure.st,v 1.8 2013-04-27 10:11:13 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: PrimitiveFailure.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/PrivateMetaclass.st Sun Feb 02 00:13:55 2014 +0100
+++ b/PrivateMetaclass.st Sun Feb 02 14:16:24 2014 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1996 by eXept Software AG
All Rights Reserved
@@ -11,9 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
-
-
"{ Package: 'stx:libbasic' }"
Metaclass subclass:#PrivateMetaclass
@@ -132,5 +127,12 @@
!PrivateMetaclass class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PrivateMetaclass.st,v 1.13 2004-03-05 17:53:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PrivateMetaclass.st,v 1.13 2004/03/05 17:53:16 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: PrivateMetaclass.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/ProceedError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ProceedError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Warning subclass:#ProceedError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!ProceedError class methodsFor:'documentation'!
@@ -53,6 +53,7 @@
! !
+
!ProceedError class methodsFor:'initialization'!
initialize
@@ -66,6 +67,7 @@
! !
+
!ProceedError methodsFor:'default actions'!
defaultAction
@@ -94,10 +96,15 @@
"
! !
+
!ProceedError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ProceedError.st,v 1.6 2013-04-19 08:40:03 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ProceedError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/Process.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Process.st Sun Feb 02 14:16:24 2014 +0000
@@ -463,6 +463,7 @@
"Created: 15.11.1996 / 11:41:06 / cg"
! !
+
!Process methodsFor:'accessing'!
beGUIProcess
@@ -1353,6 +1354,17 @@
!Process methodsFor:'special'!
+externalLookupPopIfEqual: lookupObject
+ "Called by method lookup MOP when an lookup context is to be unwound
+ to cleanup lookup stack"
+ lookupActivations first == lookupObject ifTrue:[
+ lookupActivations := lookupActivations second.
+ ].
+
+ "Created: / 04-10-2013 / 10:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 04-10-2013 / 12:08:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
millisecondDelay:millis
"suspend the current process for some time.
If the receiver is a system process (i.e. scheduler or event dispatcher)
@@ -2072,6 +2084,11 @@
^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.179 2013-04-19 09:35:37 cg Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ ' Id: Process.st 10643 2011-06-08 21:53:07Z vranyj1 '
! !
--- a/ProjectDefinition.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ProjectDefinition.st Sun Feb 02 14:16:24 2014 +0000
@@ -840,6 +840,37 @@
"Created: / 14-09-2006 / 14:59:53 / cg"
! !
+!ProjectDefinition class methodsFor:'accessing - coverage'!
+
+excludedFromCoverage
+ "List of classes and/or methods excluded from coverage report.
+ Entries maybe ClassName or #(ClassName selector)
+
+ Please note that certain classes and methods are excluded
+ in #Builder::CoverageReport>>excludedFromCoverage:.
+ "
+ ^ #()
+
+ "Created: / 28-06-2013 / 02:11:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 28-06-2013 / 11:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+excludedFromCoverage: aMethod
+ "Return true if given method should be excluded from coverage
+ info. This method may be overridden automagically omit methods
+ matching some criteria.
+
+ Please note that certain classes and methods are excluded
+ in Builder::CoverageReport>>excludedFromCoverage:.
+ "
+
+ ^false
+
+ "Created: / 28-06-2013 / 02:14:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 28-06-2013 / 11:25:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+
!ProjectDefinition class methodsFor:'accessing - packaging'!
@@ -1103,6 +1134,7 @@
].
! !
+
!ProjectDefinition class methodsFor:'accessing - tests'!
excludedFromTestSuite
@@ -1647,9 +1679,14 @@
value: 'description'.
].
- aTwoArgBlock
- value: self subProjects_code
- value: 'description'.
+ "/ JV: No, subProjects **should not** be automatically generated.
+ "/ Remember, they are not required to be loaded!! So, generate
+ "/ subProjects only if there's no such method yet.
+ (self class methodDictionary includesKey: #subProjects) ifFalse:[
+ aTwoArgBlock
+ value: self subProjects_code
+ value: 'description'.
+ ].
(self monticelloPackageName notNil and:[self respondsTo:#monticelloTimestamps_code]) ifTrue:[
aTwoArgBlock
@@ -1657,7 +1694,7 @@
value: 'description - monticello'.
].
- "Modified: / 09-11-2010 / 18:41:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-11-2013 / 13:56:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
forEachMethodsCodeToCompileDo:aTwoArgBlock
@@ -1899,6 +1936,7 @@
"Modified: / 29-03-2012 / 18:43:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ProjectDefinition class methodsFor:'defaults'!
applicationTypes
@@ -2550,6 +2588,7 @@
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
+
!ProjectDefinition class methodsFor:'description - project information'!
applicationAdditionalIconFileNames
@@ -4186,7 +4225,7 @@
generateLocalIncludes_unix
^ String streamContents:[:s |
s nextPutAll:(self localIncludes_unix).
- self searchForProjectsWhichProvideHeaderFiles
+ self searchForProjectsWhichProvideHeaderFiles asSortedCollection
do:[:includeProject |
s nextPutAll:' -I$(INCLUDE_TOP)/',(self topRelativePathToPackage_unix: includeProject)
]
@@ -4204,12 +4243,13 @@
"Created: / 09-08-2006 / 16:46:49 / fm"
"Modified: / 07-12-2006 / 17:47:06 / cg"
+ "Modified: / 25-11-2013 / 16:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateLocalIncludes_win32
^ String streamContents:[:s |
s nextPutAll:(self localIncludes_win32).
- self searchForProjectsWhichProvideHeaderFiles
+ self searchForProjectsWhichProvideHeaderFiles asSortedCollection
do:[:includeProject |
s nextPutAll:' -I$(INCLUDE_TOP)\',(self topRelativePathToPackage_win32: includeProject)
]
@@ -4225,6 +4265,7 @@
"Created: / 09-08-2006 / 16:46:49 / fm"
"Modified: / 07-12-2006 / 17:47:10 / cg"
+ "Modified: / 25-11-2013 / 16:40:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateObjects_make_dot_spec
@@ -4598,7 +4639,11 @@
@REM type bmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
-make.exe -N -f bc.mak %%*
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%%%i in (''hg root'') do SET HGROOT=%%%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak %DEFINES% %*
%(SUBPROJECT_BMAKE_CALLS)
'
@@ -4789,16 +4834,21 @@
@REM type mingwmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%%%i in (''hg root'') do SET HGROOT=%%%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
@pushd %(TOP)\rules
@call find_mingw.bat
@popd
-make.exe -N -f bc.mak %%USEMINGW_ARG%% %%*
+make.exe -N -f bc.mak %DEFINES% %%USEMINGW_ARG%% %%*
%(SUBPROJECT_MINGWMAKE_CALLS)
'
"Created: / 05-09-2012 / 19:44:51 / cg"
+ "Modified: / 19-03-2013 / 08:54:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
objectLine_make_dot_spec
@@ -4906,7 +4956,13 @@
call vcsetup.bat
popd
)
-make.exe -N -f bc.mak -DUSEVC %%*
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%%%i in (''hg root'') do SET HGROOT=%%%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
+
+
%(SUBPROJECT_VCMAKE_CALLS)
'
@@ -5150,10 +5206,15 @@
test resources, as they are not neccessary for the package
and should not be compiled (because of unwanted dependency
on stx:goodies/sunit package)
- "
-
- (aClass inheritsFrom: TestCase) ifTrue:[^#(autoload)].
- (aClass inheritsFrom: TestResource) ifTrue:[^#(autoload)].
+
+ But not make them autoloaded when the package is separate
+ test-package - by conventions such package should by named
+ #'module:package/subpackage/tests'
+ "
+ ((self package endsWith: '/tests') or:[(self package endsWith: '/tests')]) ifFalse:[
+ (aClass inheritsFrom: TestCase) ifTrue:[^#(autoload)].
+ (aClass inheritsFrom: TestResource) ifTrue:[^#(autoload)].
+ ].
"No additional attributes"
^#()
@@ -5169,6 +5230,7 @@
"
"Created: / 26-10-2009 / 12:54:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 20-03-2013 / 19:33:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
checkIfClassesArePresent
@@ -6132,6 +6194,20 @@
"Created: / 17-08-2006 / 00:21:39 / cg"
!
+loadExtensionsForLanguage: lang
+ "load extension methods for given programming language"
+
+ | filename file |
+ filename := 'extensions.' , lang sourceFileSuffix.
+ file := self packageDirectory / filename.
+ file exists ifTrue:[
+ lang fileIn: file.
+ ]
+
+ "Created: / 17-08-2006 / 00:21:39 / cg"
+ "Created: / 25-11-2011 / 18:13:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
loadMandatoryPreRequisitesAsAutoloaded:asAutoloaded
"load those packages which are required for loading.
Called after my definition has been loaded, but before the rest of the
@@ -7487,6 +7563,11 @@
^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.489 2014-01-28 20:45:30 cg Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: ProjectDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
--- a/QualifiedName.st Sun Feb 02 00:13:55 2014 +0100
+++ b/QualifiedName.st Sun Feb 02 14:16:24 2014 +0000
@@ -1,4 +1,4 @@
-"{ Package: 'stx:libbasic' }"
+"{ Package: '__NoProject__' }"
Object subclass:#QualifiedName
instanceVariableNames:'pathString'
--- a/QueryWithoutDefault.st Sun Feb 02 00:13:55 2014 +0100
+++ b/QueryWithoutDefault.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Query subclass:#QueryWithoutDefault
@@ -83,7 +82,14 @@
!QueryWithoutDefault class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/QueryWithoutDefault.st,v 1.3 2005-01-20 12:26:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/QueryWithoutDefault.st,v 1.3 2005/01/20 12:26:17 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: QueryWithoutDefault.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
QueryWithoutDefault initialize!
+
+
+
--- a/RangeError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/RangeError.st Sun Feb 02 14:16:24 2014 +0000
@@ -41,16 +41,22 @@
"
! !
+
!RangeError class methodsFor:'initialization'!
initialize
NotifierString := 'numeric range error'.
! !
+
!RangeError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/RangeError.st,v 1.5 2013-03-13 23:43:54 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: RangeError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/ReadError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ReadError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#ReadError
@@ -38,5 +37,12 @@
!ReadError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ReadError.st,v 1.2 2005-02-02 10:59:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ReadError.st,v 1.2 2005/02/02 10:59:36 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ReadError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/ReadOnlySequenceableCollection.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ReadOnlySequenceableCollection.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
SequenceableCollection subclass:#ReadOnlySequenceableCollection
@@ -106,5 +105,12 @@
!ReadOnlySequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ReadOnlySequenceableCollection.st,v 1.4 2005-06-27 10:24:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ReadOnlySequenceableCollection.st,v 1.4 2005/06/27 10:24:03 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ReadOnlySequenceableCollection.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/RecursionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/RecursionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Error subclass:#RecursionError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!RecursionError class methodsFor:'documentation'!
@@ -41,6 +41,7 @@
"
! !
+
!RecursionError class methodsFor:'initialization'!
initialize
@@ -51,6 +52,7 @@
"
! !
+
!RecursionError class methodsFor:'queries'!
mayProceed
@@ -61,10 +63,15 @@
"Created: / 10.11.2001 / 15:10:56 / cg"
! !
+
!RecursionError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/RecursionError.st,v 1.6 2013-04-27 10:09:34 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: RecursionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/RecursiveExceptionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/RecursiveExceptionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Error subclass:#RecursiveExceptionError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!RecursiveExceptionError class methodsFor:'documentation'!
@@ -47,6 +47,7 @@
! !
+
!RecursiveExceptionError class methodsFor:'initialization'!
initialize
@@ -60,6 +61,7 @@
! !
+
!RecursiveExceptionError class methodsFor:'queries'!
mayProceed
@@ -69,6 +71,7 @@
! !
+
!RecursiveExceptionError methodsFor:'accessing'!
exception
@@ -78,10 +81,15 @@
^ parameter
! !
+
!RecursiveExceptionError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/RecursiveExceptionError.st,v 1.6 2013-04-19 08:40:19 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: RecursiveExceptionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/RestartProcessRequest.st Sun Feb 02 00:13:55 2014 +0100
+++ b/RestartProcessRequest.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ControlRequest subclass:#RestartProcessRequest
@@ -45,5 +44,12 @@
!RestartProcessRequest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/RestartProcessRequest.st,v 1.2 2003-08-29 19:18:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/RestartProcessRequest.st,v 1.2 2003/08/29 19:18:11 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: RestartProcessRequest.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/RomanNumberFormatError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/RomanNumberFormatError.st Sun Feb 02 14:16:24 2014 +0000
@@ -49,5 +49,9 @@
!RomanNumberFormatError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/RomanNumberFormatError.st,v 1.4 2008-08-06 09:53:04 cg Exp $'
+ ^ '$Id: RomanNumberFormatError.st 10808 2012-05-09 15:04:12Z vranyj1 $'
+!
+
+version_SVN
+ ^ '$Id: RomanNumberFormatError.st 10808 2012-05-09 15:04:12Z vranyj1 $'
! !
--- a/SignalError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/SignalError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,9 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
-
-
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#SignalError
@@ -49,5 +46,12 @@
!SignalError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SignalError.st,v 1.5 2004-04-22 15:28:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SignalError.st,v 1.5 2004/04/22 15:28:24 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: SignalError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/Smalltalk.st Sun Feb 02 00:13:55 2014 +0100
+++ b/Smalltalk.st Sun Feb 02 14:16:24 2014 +0000
@@ -383,9 +383,9 @@
ObjectMemory recursionInterruptHandler:self.
OperatingSystem isOSXlike ifTrue:[
- "/ OSX sends SIGABRT for NSExceptions
- OperatingSystem operatingSystemSignal:(OperatingSystem sigABRT) install:NSException.
- OperatingSystem enableAbortInterrupts.
+ "/ OSX sends SIGABRT for NSExceptions
+ OperatingSystem operatingSystemSignal:(OperatingSystem sigABRT) install:NSException.
+ OperatingSystem enableAbortInterrupts.
].
"
@@ -1038,7 +1038,6 @@
"Created: 20.6.1997 / 16:58:28 / cg"
! !
-
!Smalltalk class methodsFor:'browsing'!
browseAllCallsOn:aSelectorSymbol
@@ -1334,24 +1333,24 @@
i2 := 1.
ns := self.
[i2 ~~ 0] whileTrue:[
- i2 := newName indexOfSubCollection:'::' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- nm := newName copyFrom:i1 to:i2-1.
- ns isNameSpace ifTrue:[
- subns := ns at:nm asSymbol ifAbsent:nil.
- subns isNil ifTrue:[
- self error:'Nonexisting namespace: ',nm.
- ^ nil.
- ].
- ] ifFalse:[
- subns := ns privateClassesAt:nm asSymbol.
- subns isNil ifTrue:[
- self error:'Cannot create a namespace below a class'
- ]
- ].
- ns := subns.
- i1 := i2 + 2.
- ].
+ i2 := newName indexOfSubCollection:'::' startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ nm := newName copyFrom:i1 to:i2-1.
+ ns isNameSpace ifTrue:[
+ subns := ns at:nm asSymbol ifAbsent:nil.
+ subns isNil ifTrue:[
+ self error:'Nonexisting namespace: ',nm.
+ ^ nil.
+ ].
+ ] ifFalse:[
+ subns := ns privateClassesAt:nm asSymbol.
+ subns isNil ifTrue:[
+ self error:'Cannot create a namespace below a class'
+ ]
+ ].
+ ns := subns.
+ i1 := i2 + 2.
+ ].
].
oldName := aClass name.
@@ -1362,8 +1361,8 @@
privateClasses := aClass privateClassesSorted.
((self at:oldSym) ~~ aClass) ifTrue:[
- 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
- ^ self
+ 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
+ ^ self
].
"/ rename the class
@@ -1372,42 +1371,42 @@
"/ change the owning class
ns isNameSpace ifFalse:[
- aClass isPrivate ifTrue:[
- aClass class setOwningClass:ns.
- ] ifFalse:[
- "/ sigh - must make a PrivateMetaclass from Metaclass
- oldMetaclass := aClass class.
- newMetaclass := PrivateMetaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
- newMetaclass setOwningClass:ns.
-
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ aClass class setOwningClass:ns.
+ ] ifFalse:[
+ "/ sigh - must make a PrivateMetaclass from Metaclass
+ oldMetaclass := aClass class.
+ newMetaclass := PrivateMetaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+ newMetaclass setOwningClass:ns.
+
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
] ifTrue:[
- aClass isPrivate ifTrue:[
- newCategory := aClass topOwningClass category.
-
- "/ sigh - must make a Metaclass from PrivateMetaclass
- oldMetaclass := aClass class.
-
- newMetaclass := Metaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
-
- aClass category:newCategory.
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ newCategory := aClass topOwningClass category.
+
+ "/ sigh - must make a Metaclass from PrivateMetaclass
+ oldMetaclass := aClass class.
+
+ newMetaclass := Metaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+
+ aClass category:newCategory.
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
].
aClass setName:newSym.
@@ -1427,32 +1426,32 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- oldCVSym := (oldSym , ':' , name) asSymbol.
- value := self at:oldCVSym.
- self at:oldCVSym put:nil.
-
- "/
- "/ see comment in #removeKey: on why we dont remove it it here
- "/
- "/ self removeKey:cSym.
-
- newCVSym := (newSym , ':' , name) asSymbol.
- self at:newCVSym put:value.
-
- oldNameToNewName at:oldCVSym put:newCVSym.
+ oldCVSym := (oldSym , ':' , name) asSymbol.
+ value := self at:oldCVSym.
+ self at:oldCVSym put:nil.
+
+ "/
+ "/ see comment in #removeKey: on why we dont remove it it here
+ "/
+ "/ self removeKey:cSym.
+
+ newCVSym := (newSym , ':' , name) asSymbol.
+ self at:newCVSym put:value.
+
+ oldNameToNewName at:oldCVSym put:newCVSym.
].
"/ patch methods literal arrays from oldCVname to newCVname
oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
- aClass withAllSubclasses do:[:aSubClass |
- Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
- aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- ].
-
- "/ and also in privateClasses ? ...
+ aClass withAllSubclasses do:[:aSubClass |
+ Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
+ aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -1475,85 +1474,85 @@
newNameSpace := aClass topNameSpace.
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- Class withoutUpdatingChangesDo:[
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
-
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ "/ must rename privateClasses as well
+ Class withoutUpdatingChangesDo:[
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
"/ ClassBuilder
"/ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
"/ in:newNameSpace
"/ except:nil.
- ]
- ]
+ ]
+ ]
].
oldNameSpace ~~ newNameSpace ifTrue:[
- "/ all those referencing the class from the old nameSpace
- "/ must be recompiled ...
- "/ (to now access the global from smalltalk)
-
- oldNameSpace ~~ Smalltalk ifTrue:[
- Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldName asSymbol
- in:oldNameSpace
- except:nil.
- ].
-
- "/ all referencing the class in the new namespace
- "/ as well; to now access the new class.
-
- (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldBaseName asSymbol
- in:newNameSpace
- except:nil.
- ].
+ "/ all those referencing the class from the old nameSpace
+ "/ must be recompiled ...
+ "/ (to now access the global from smalltalk)
+
+ oldNameSpace ~~ Smalltalk ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldName asSymbol
+ in:oldNameSpace
+ except:nil.
+ ].
+
+ "/ all referencing the class in the new namespace
+ "/ as well; to now access the new class.
+
+ (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldBaseName asSymbol
+ in:newNameSpace
+ except:nil.
+ ].
] ifFalse:[
- "/ all references to a global with my new name in my owning class
- "/ must now be redirected to myself.
-
- aClass isPrivate ifTrue:[
- newBaseName := aClass nameWithoutNameSpacePrefix.
- newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
- ]
+ "/ all references to a global with my new name in my owning class
+ "/ must now be redirected to myself.
+
+ aClass isPrivate ifTrue:[
+ newBaseName := aClass nameWithoutNameSpacePrefix.
+ newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
+ ]
].
aClass changed:#definition.
"/ because of the change of my superclasses name ...
aClass allSubclassesDo:[:subClass |
- subClass changed:#definition.
+ subClass changed:#definition.
].
"/ because of the change of my superclasses name ...
aClass subclassesDo:[:subClass |
- subClass addChangeRecordForClass:subClass.
+ subClass addChangeRecordForClass:subClass.
].
self changed:#definition.
self changed:#classRename with:(Array with:aClass with:oldName).
@@ -2141,7 +2140,9 @@
"
if there is a sourceCodeManager, ask it first for the extensions
"
- mgr := Smalltalk at:#SourceCodeManager.
+ (Smalltalk at:#AbstractSourceCodeManager) notNil ifTrue:[
+ mgr := AbstractSourceCodeManager managerForPackage: aPackageId
+ ].
mgr notNil ifTrue:[
extensionsFilename := 'extensions.' , language sourceFileSuffix.
@@ -2153,7 +2154,21 @@
extensionsRevisionString notNil ifTrue:[
extensionsRevisionInfo := mgr revisionInfoFromString:extensionsRevisionString inClass:nil.
extensionsRevisionInfo notNil ifTrue:[
- extensionsRevisionInfo fileName = extensionsFilename ifFalse:[^ false].
+ extensionsRevisionInfo fileName = extensionsFilename ifFalse:[
+ "JV@2011-10-23: following condition is never satisfied for
+ filed-in packages. The whole scheme of extensionVersion_XXX
+ works ONLY for compiled packages as it depends on fact, that
+ extension Init() routine is called AFTER all classes are inited,
+ therefore the extensionVersion_XXX methods from extensions.st
+ overwrites methods coming from package definition class. All this
+ is so tricky and error prone, that we have to come up with better
+ solution!!"
+ packageDirName notNil ifTrue:[
+ ^ self loadExtensionsFromDirectory:packageDirName language: language
+ ] ifFalse:[
+ ^ false
+ ]
+ ]
]
].
SourceCodeManagerError handle:[:ex |
@@ -2187,6 +2202,7 @@
"Created: / 02-01-2010 / 10:41:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-03-2011 / 10:03:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-11-2011 / 13:41:29 / cg"
+ "Modified: / 23-10-2011 / 19:35:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
loadExtensionsFromDirectory:packageDirOrString
@@ -2208,18 +2224,19 @@
f := packageDir / ('extensions.' , language sourceFileSuffix).
f exists ifTrue:[
- Class withoutUpdatingChangeSetDo:[
- f fileIn.
- ].
- VerboseLoading ifTrue:[
- Transcript showCR:('loaded extensions: ' , f pathName).
- ].
- ^ true
- ].
- ^ false
+ Class withoutUpdatingChangeSetDo:[
+ f fileIn.
+ ].
+ VerboseLoading ifTrue:[
+ Transcript showCR:('loaded extensions: ' , f pathName).
+ ].
+ ^ true
+ ].
+ ^ true"/false
"Created: / 02-01-2010 / 10:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-11-2011 / 13:41:19 / cg"
+ "Modified: / 31-01-2013 / 11:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
loadPackage:aPackageStringArg asAutoloaded:doLoadAsAutoloaded
@@ -2237,28 +2254,28 @@
"/ if there is a projectDefinition, let it load itself...
def := packageId projectDefinitionClass.
(def notNil and:[def isLoaded]) ifTrue:[
- def loadAsAutoloaded:doLoadAsAutoloaded.
- ^ true.
+ def loadAsAutoloaded:doLoadAsAutoloaded.
+ ^ true.
].
packageDir := self packageDirectoryForPackageId:packageId.
packageDir isNil ifTrue:[
- (packageString includes:$:) ifFalse:[
- "/ assume stx
- packageDir := self packageDirectoryForPackageId:('stx:',packageString).
- ].
+ (packageString includes:$:) ifFalse:[
+ "/ assume stx
+ packageDir := self packageDirectoryForPackageId:('stx:',packageString).
+ ].
].
(self
- loadPackage:packageString
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded) ifTrue: [^ true].
+ loadPackage:packageString
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded) ifTrue: [^ true].
AbstractSourceCodeManager notNil ifTrue:[
- sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage: packageString.
- sourceCodeManager notNil ifTrue:[
- ^ sourceCodeManager loadPackageWithId: packageString fromRepositoryAsAutoloaded: doLoadAsAutoloaded
- ].
+ sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage: packageString.
+ sourceCodeManager notNil ifTrue:[
+ ^ sourceCodeManager loadPackageWithId: packageString fromRepositoryAsAutoloaded: doLoadAsAutoloaded
+ ].
].
^ false
@@ -2836,7 +2853,7 @@
methods := OrderedCollection new.
self allClassesDo:[:eachClass |
- methods addAll:(eachClass extensionsFrom:aProjectID).
+ methods addAll:(eachClass extensionsFrom:aProjectID).
].
^ methods
!
@@ -3420,6 +3437,16 @@
"
!
+isAmber
+ "return false here - this may be useful to write portable
+ applications - add #isAmber to your Amber Smalltalk,
+ returning true there."
+
+ ^ false
+
+ "Created: / 18-12-2013 / 15:43:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
isDolphinSmalltalk
"return false here - this may be useful to write portable
applications - add #isDolphinSmalltalk to your dolphin,
@@ -3428,6 +3455,26 @@
^ false
!
+isGemStone
+ "return false here - this may be useful to write portable
+ applications - add #isGemStone to your GemStone/S,
+ returning true there."
+
+ ^ false
+
+ "Created: / 18-12-2013 / 15:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isPharo
+ "return false here - this may be useful to write portable
+ applications - add #isPharo to your Pharo,
+ returning true there."
+
+ ^ false
+
+ "Created: / 18-12-2013 / 15:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
isSmalltalkMT
"return false here - this may be useful to write portable
applications - add #isSmalltalkMT to your smalltalk-MT,
@@ -4208,12 +4255,15 @@
commandFile := self commandName asFilename withSuffix:'rc'.
(didReadRCFile := commandFile exists and:[self secureFileIn:commandFile]) ifFalse:[
StandAlone ifFalse:[
- defaultRC := 'smalltalk.rc' asFilename
+ defaultRC := 'smalltalk.rc' "/asFilename
] ifTrue:[
- defaultRC := 'stxapp.rc' asFilename
+ defaultRC := 'stxapp.rc' "/asFilename
].
-
- didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
+ "JV@2011-11-01: DO NOT check defaultRC exist - this prevents smalltalk to
+ to be started with different working directory than stx/projects/smalltalk !!!!!!"
+
+ "/didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
+ didReadRCFile := self secureFileIn:defaultRC.
didReadRCFile ifFalse:[
StandAlone ifFalse:[
'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
@@ -5190,6 +5240,10 @@
|dir noAutoloadHere dirName directoryContents haveAbbrevDotSTC|
dir := aDirectory asFilename.
+
+ "/ Care for non-existent directories"
+ dir exists ifFalse:[ ^ self ].
+
dirName := dir physicalPathName. "take care of symbolic links"
(dirsConsulted includes:dirName) ifTrue:[
@@ -6327,54 +6381,77 @@
"return a actual or expected (or most wanted) filename for aClassOrClassName
- only the base name (without directory part) and without suffix."
- |cls nonMetaclass nm nameWithPrefix nameWithoutPrefix|
+ |cls nonMetaclass nm nameWithPrefix nameWithoutPrefix compatQuery compatPkg |
"/ This was added as an extension of libsvn - should be no longer needed
-"/ compatQuery := Smalltalk classNamed: 'SVN::CompatModeQuery'.
-"/ (compatQuery notNil
-"/ and:[compatQuery isLoaded
-"/ and:[compatQuery query not]]) ifTrue:[
-"/ nm := aClassOrClassName isBehavior
-"/ ifTrue:[aClassOrClassName name]
-"/ ifFalse:[aClassOrClassName].
-"/ nm := nm copyReplaceAll:$: with:$_.
-"/ ^nm
-"/ ].
+"/ JV@2012-09-25: but it actually is. The problem is that class filename
+"/ is stored in the class itself and used to generate abbrev.stc and
+"/ prerequisites in makefiles. But if you renamed such a stc-compiled class,
+"/ the filename remains the same, but SVN __ALWAYS__ keep container name
+"/ and class name in sync. Therefore build files gets messed up. Indeed, this
+"/ should be fixed in code that files-out the package and generates build files.
+"/ Certainly a hack, but do not remove this until fixed elsewhere
+
+ compatQuery := Smalltalk classNamed: 'SVN::CompatModeQuery'.
+ (compatQuery notNil
+ and:[compatQuery isLoaded
+ and:[compatQuery query not]]) ifTrue:[
+ nm := aClassOrClassName isBehavior
+ ifTrue:[aClassOrClassName name]
+ ifFalse:[aClassOrClassName].
+ nm := nm copyReplaceAll:$: with:$_.
+ ^nm
+ ].
+
+"/ Same for another query for new libscm...
+ compatQuery := Smalltalk classNamed: 'SCMCompatModeQuery'.
+ (compatQuery notNil
+ and:[compatQuery isLoaded
+ and:[(compatPkg := compatQuery query) notNil]]) ifTrue:[
+ nm := aClassOrClassName isBehavior
+ ifTrue:[aClassOrClassName name]
+ ifFalse:[aClassOrClassName].
+ cls := Smalltalk at: nm asSymbol.
+ (cls notNil and:[cls package == compatPkg]) ifTrue:[
+ nm := nm copyReplaceAll:$: with:$_.
+ ^nm
+ ].
+ ].
aClassOrClassName isBehavior ifTrue:[
- cls := aClassOrClassName.
+ cls := aClassOrClassName.
] ifFalse:[
- cls := Smalltalk classNamed:aClassOrClassName.
- cls isNil ifTrue:[
- nameWithPrefix := aClassOrClassName.
- nameWithoutPrefix := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
- ].
+ cls := Smalltalk classNamed:aClassOrClassName.
+ cls isNil ifTrue:[
+ nameWithPrefix := aClassOrClassName.
+ nameWithoutPrefix := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
+ ].
].
cls notNil ifTrue:[
- nonMetaclass := cls theNonMetaclass.
- nm := nonMetaclass getClassFilename.
- nm isNil ifTrue:[
- cls revisionInfo notNil ifTrue:[
- nm := cls revisionInfo fileName.
- ].
- ].
- nm notNil ifTrue:[
- ^ nm asFilename withoutSuffix baseName
- ].
- nameWithPrefix := nonMetaclass name.
- nameWithoutPrefix := nonMetaclass nameWithoutPrefix.
+ nonMetaclass := cls theNonMetaclass.
+ nm := nonMetaclass getClassFilename.
+ nm isNil ifTrue:[
+ cls revisionInfo notNil ifTrue:[
+ nm := cls revisionInfo fileName.
+ ].
+ ].
+ nm notNil ifTrue:[
+ ^ nm asFilename withoutSuffix baseName
+ ].
+ nameWithPrefix := nonMetaclass name.
+ nameWithoutPrefix := nonMetaclass nameWithoutPrefix.
].
CachedAbbreviations notNil ifTrue:[
- nameWithPrefix := nameWithPrefix asSymbol.
- (CachedAbbreviations includesKey:nameWithPrefix) ifTrue:[
- ^ (CachedAbbreviations at:nameWithPrefix) asFilename baseName
- ].
- nameWithoutPrefix := nameWithoutPrefix asSymbol.
- (CachedAbbreviations includesKey:nameWithoutPrefix) ifTrue:[
- ^ (CachedAbbreviations at:nameWithoutPrefix) asFilename baseName
- ].
+ nameWithPrefix := nameWithPrefix asSymbol.
+ (CachedAbbreviations includesKey:nameWithPrefix) ifTrue:[
+ ^ (CachedAbbreviations at:nameWithPrefix) asFilename baseName
+ ].
+ nameWithoutPrefix := nameWithoutPrefix asSymbol.
+ (CachedAbbreviations includesKey:nameWithoutPrefix) ifTrue:[
+ ^ (CachedAbbreviations at:nameWithoutPrefix) asFilename baseName
+ ].
].
^ nameWithPrefix copyReplaceAll:$: with:$_
@@ -6394,6 +6471,8 @@
"
"Modified: / 06-10-2006 / 16:16:01 / cg"
+ "Modified: / 04-12-2012 / 17:44:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 05-12-2012 / 10:47:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
filenameAbbreviations
@@ -7520,7 +7599,7 @@
packageDir := self getPackageFileName:packageDirName.
packageDir isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
^ packageDir asFilename
@@ -7536,11 +7615,11 @@
projectDefinition := aPackageIdOrPackage.
projectDefinition isProjectDefinition ifFalse:[
- projectDefinition := projectDefinition asPackageId projectDefinitionClass.
- projectDefinition isNil ifTrue:[
- 'Smalltalk [info] trying to unload non-existing package: ' infoPrint. aPackageIdOrPackage infoPrintCR.
- ^ self.
- ].
+ projectDefinition := projectDefinition asPackageId projectDefinitionClass.
+ projectDefinition isNil ifTrue:[
+ 'Smalltalk [info] trying to unload non-existing package: ' infoPrint. aPackageIdOrPackage infoPrintCR.
+ ^ self.
+ ].
].
projectDefinition unloadPackage.
@@ -7826,13 +7905,13 @@
Now releaseNr is the build number (BUILD_NUMBER from Jenkins)
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
|releaseNumber|
releaseNumber := Smalltalk versionBuildNumber.
releaseNumber isEmpty ifTrue:[
- ^ 0.
+ ^ 0.
].
^ releaseNumber
@@ -7854,7 +7933,7 @@
to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 3
@@ -7943,7 +8022,7 @@
self minorVersionNr printString ,
'.',
self revisionNr printString,
- '.',
+ 'jv.',
self releaseNr printString)
@@ -7976,6 +8055,11 @@
^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1040 2013-12-17 15:45:11 cg Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- a/SmalltalkChunkFileSourceWriter.st Sun Feb 02 00:13:55 2014 +0100
+++ b/SmalltalkChunkFileSourceWriter.st Sun Feb 02 14:16:24 2014 +0000
@@ -534,11 +534,33 @@
fileOutMethods: methods on: stream
- methods do:
- [:method| |cat source privacy|
+ methods do:[:method|
+ |cat source privacy|
stream nextPutChunkSeparator.
- method mclass name printOn:stream.
+ "JV@2012-09-05: Support for filing out Java extension methods"
+ method mclass theNonMetaclass isJavaClass ifTrue:[
+ | class classBinaryName comps |
+
+ class := method mclass theNonMetaclass .
+ "Sigh, make it compatible with old and new naming of Java classes
+
+ old -> aJavaClass name == #'java/lang/Object'
+ new -> aJavaClass name == JAVA::java::lang::Object
+ aJavaClass binaryName == #'java/lang/Object'
+ "
+ classBinaryName := (class respondsTo: #binaryName)
+ ifTrue:[ class binaryName ]
+ ifFalse:[ class name ].
+ stream nextPutAll:'(Java classForName:'''.
+ stream nextPutAll:(classBinaryName copyReplaceAll:$/ with: $.).
+ stream nextPutAll:''')'.
+ method mclass isMetaclass ifTrue:[
+ stream nextPutAll: ' class'.
+ ].
+ ] ifFalse:[
+ method mclass name printOn:stream.
+ ].
"/ self printClassNameOn:aStream.
(privacy := method privacy) ~~ #public ifTrue:[
@@ -558,6 +580,7 @@
stream cr]
"Created: / 30-12-2009 / 18:43:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 09-10-2013 / 08:57:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutPackageDefinition:pkg on:aStream
@@ -617,6 +640,11 @@
^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.23 2013-06-23 22:22:44 cg Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: SmalltalkChunkFileSourceWriter.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
--- a/SnapshotError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/SnapshotError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
Error subclass:#SnapshotError
@@ -44,7 +43,14 @@
!SnapshotError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SnapshotError.st,v 1.3 2005-03-29 22:25:15 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SnapshotError.st,v 1.3 2005/03/29 22:25:15 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: SnapshotError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
SnapshotError initialize!
+
+
+
--- a/SomeNumber.st Sun Feb 02 00:13:55 2014 +0100
+++ b/SomeNumber.st Sun Feb 02 14:16:24 2014 +0000
@@ -110,5 +110,13 @@
!SomeNumber class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SomeNumber.st,v 1.3 2003-07-02 09:52:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SomeNumber.st,v 1.3 2003/07/02 09:52:23 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: SomeNumber.st 10790 2012-03-13 15:46:50Z vranyj1 $'
+
! !
+
+
+
--- a/StreamIOError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/StreamIOError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#StreamIOError
@@ -38,5 +37,12 @@
!StreamIOError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StreamIOError.st,v 1.2 2005-02-02 11:03:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StreamIOError.st,v 1.2 2005/02/02 11:03:44 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: StreamIOError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/StreamNotOpenError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/StreamNotOpenError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#StreamNotOpenError
@@ -44,5 +43,12 @@
!StreamNotOpenError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StreamNotOpenError.st,v 1.3 2005-02-02 10:59:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StreamNotOpenError.st,v 1.3 2005/02/02 10:59:49 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: StreamNotOpenError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/SubscriptOutOfBoundsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/SubscriptOutOfBoundsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
IndexNotFoundError subclass:#SubscriptOutOfBoundsError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Exceptions-Errors'
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Exceptions-Errors'
!
!SubscriptOutOfBoundsError class methodsFor:'documentation'!
@@ -41,6 +41,7 @@
"
! !
+
!SubscriptOutOfBoundsError class methodsFor:'initialization'!
initialize
@@ -51,10 +52,15 @@
"
! !
+
!SubscriptOutOfBoundsError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/SubscriptOutOfBoundsError.st,v 1.5 2013-04-27 10:07:39 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: SubscriptOutOfBoundsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/SystemNotification.st Sun Feb 02 00:13:55 2014 +0100
+++ b/SystemNotification.st Sun Feb 02 14:16:24 2014 +0000
@@ -37,5 +37,8 @@
!SystemNotification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SystemNotification.st,v 1.3 2008-10-04 08:42:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SystemNotification.st,v 1.3 2008/10/04 08:42:18 cg Exp $'
! !
+
+
+
--- a/TerminateProcessRequest.st Sun Feb 02 00:13:55 2014 +0100
+++ b/TerminateProcessRequest.st Sun Feb 02 14:16:24 2014 +0000
@@ -68,5 +68,12 @@
!TerminateProcessRequest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/TerminateProcessRequest.st,v 1.3 2007-11-07 10:37:10 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/TerminateProcessRequest.st,v 1.3 2007/11/07 10:37:10 ca Exp $'
+!
+
+version_SVN
+ ^ '$Id: TerminateProcessRequest.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/TextCollectorStream.st Sun Feb 02 00:13:55 2014 +0100
+++ b/TextCollectorStream.st Sun Feb 02 14:16:24 2014 +0000
@@ -195,5 +195,8 @@
!TextCollectorStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/TextCollectorStream.st,v 1.2 2006-04-06 10:54:06 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/TextCollectorStream.st,v 1.2 2006/04/06 10:54:06 stefan Exp $'
! !
+
+
+
--- a/TimeConversionError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/TimeConversionError.st Sun Feb 02 14:16:24 2014 +0000
@@ -43,7 +43,14 @@
!TimeConversionError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/TimeConversionError.st,v 1.1 2008-08-06 09:22:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/TimeConversionError.st,v 1.1 2008/08/06 09:22:57 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: TimeConversionError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
TimeConversionError initialize!
+
+
+
--- a/TimeoutError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/TimeoutError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#TimeoutError
@@ -67,7 +66,14 @@
!TimeoutError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/TimeoutError.st,v 1.5 2004-08-22 17:47:07 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/TimeoutError.st,v 1.5 2004/08/22 17:47:07 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: TimeoutError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
TimeoutError initialize!
+
+
+
--- a/UnboundedExternalStream.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnboundedExternalStream.st Sun Feb 02 14:16:24 2014 +0000
@@ -67,5 +67,8 @@
!UnboundedExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnboundedExternalStream.st,v 1.8 1996-04-25 17:02:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnboundedExternalStream.st,v 1.8 1996/04/25 17:02:20 cg Exp $'
! !
+
+
+
--- a/UnderflowError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnderflowError.st Sun Feb 02 14:16:24 2014 +0000
@@ -41,16 +41,22 @@
"
! !
+
!UnderflowError class methodsFor:'initialization'!
initialize
NotifierString := 'underflow'.
! !
+
!UnderflowError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/UnderflowError.st,v 1.4 2013-03-13 23:43:59 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: UnderflowError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/UnimplementedFunctionalityError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnimplementedFunctionalityError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ProceedableError subclass:#UnimplementedFunctionalityError
@@ -63,7 +62,14 @@
!UnimplementedFunctionalityError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnimplementedFunctionalityError.st,v 1.2 2006-03-03 19:13:11 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnimplementedFunctionalityError.st,v 1.2 2006/03/03 19:13:11 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: UnimplementedFunctionalityError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
UnimplementedFunctionalityError initialize!
+
+
+
--- a/UnixFileHandle.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnixFileHandle.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
OSFileHandle subclass:#UnixFileHandle
@@ -60,5 +59,12 @@
!UnixFileHandle class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnixFileHandle.st,v 1.4 2003-08-30 12:36:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixFileHandle.st,v 1.4 2003/08/30 12:36:42 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: UnixFileHandle.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/UnixOperatingSystem.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnixOperatingSystem.st Sun Feb 02 14:16:24 2014 +0000
@@ -16,7 +16,7 @@
classVariableNames:'HostName DomainName SlowFork ForkFailed CurrentDirectory
LastTimeInfo LastTimeInfoSeconds LastTimeInfoMilliseconds
LastTimeInfoIsLocal CachedMountPoints CacheMountPointsTimeStamp
- Codeset'
+ Codeset CodesetEncoder'
poolDictionaries:''
category:'OS-Unix'
!
@@ -530,349 +530,6 @@
%}
! !
-!UnixOperatingSystem primitiveFunctions!
-%{
-
-/*
- * some systems' system() is broken in that it does not correctly
- * handle EINTR and returns failure even though it actually succeeded.
- * (LINUX is one of them)
- * Here is a fixed version. If you encounter EINTR returns from
- * UnixOperatingSystem>>executeCommand, you ought to define WANT_SYSTEM
- * in the xxxIntern.h file to get this fixed version.
- *
- * As an added BONUS, this system() enables interrupts while waiting
- * for the child which enables other threads to continue.
- * (i.e. it is RT safe)
- */
-
-#if defined(WANT_SYSTEM)
-
-/* # define DPRINTF(x) printf x */
-# define DPRINTF(x) /* nothing */
-
-# ifndef _STDDEF_H_INCLUDED_
-# include <stddef.h>
-# define _STDDEF_H_INCLUDED_
-# endif
-
-# ifndef _STDLIB_H_INCLUDED_
-# include <stdlib.h>
-# define _STDLIB_H_INCLUDED_
-# endif
-
-# ifndef _UNISTD_H_INCLUDED_
-# include <unistd.h>
-# define _UNISTD_H_INCLUDED_
-# endif
-
-# ifndef _SYS_WAIT_H_INCLUDED
-# include <sys/wait.h>
-# define _SYS_WAIT_H_INCLUDED
-# endif
-
-# ifndef _SIGNAL_H_INCLUDED_
-# include <signal.h>
-# define _SIGNAL_H_INCLUDED_
-# endif
-
-# ifndef _SYS_TYPES_H_INCLUDED_
-# include <sys/types.h>
-# define _SYS_TYPES_H_INCLUDED_
-# endif
-
-# if (!defined(HAVE_GNU_LD) && !defined (__ELF__)) || !defined(LINUX)
-# define __environ environ
-# if 1 /* !defined(LINUX) */
-# define __sigemptyset sigemptyset
-# define __sigaction sigaction
-# define __sigaddset sigaddset
-# define __sigprocmask sigprocmask
-# define __execve execve
-# define __wait wait
-# define __waitpid waitpid
-# endif /* ! LINUX */
-// # ifndef __osx__
- extern char **environ;
-// # endif
-# endif
-
-# define __sigprocmask sigprocmask
-# define __execve execve
-
-# define SHELL_PATH "/bin/sh" /* Path of the shell. */
-# define SHELL_NAME "sh" /* Name to give it. */
-
-
-static int
-mySystem(line)
- register CONST char *line;
-{
- int status, save;
- pid_t pid;
- struct sigaction sa, intr, quit;
- sigset_t block, omask;
-
- if (line == NULL)
- return -1;
-
- sa.sa_handler = SIG_IGN;
- sa.sa_flags = 0;
- __sigemptyset (&sa.sa_mask);
-
- if (__sigaction (SIGINT, &sa, &intr) < 0) {
- DPRINTF(("1: errno=%d\n", errno));
- return -1;
- }
- if (__sigaction (SIGQUIT, &sa, &quit) < 0) {
- save = errno;
- (void) __sigaction (SIGINT, &intr, (struct sigaction *) NULL);
- errno = save;
- DPRINTF(("2: errno=%d\n", errno));
- return -1;
- }
-
- __sigemptyset (&block);
- __sigaddset (&block, SIGCHLD);
- save = errno;
- if (__sigprocmask(SIG_BLOCK, &block, &omask) < 0) {
- if (errno == ENOSYS)
- errno = save;
- else {
- save = errno;
- (void) __sigaction(SIGINT, &intr, (struct sigaction *) NULL);
- (void) __sigaction (SIGQUIT, &quit, (struct sigaction *) NULL);
- errno = save;
- DPRINTF(("3: errno=%d\n", errno));
- return -1;
- }
- }
-
- pid = FORK ();
- if (pid == (pid_t) 0) {
- /* Child side. */
- CONST char *new_argv[4];
- new_argv[0] = SHELL_NAME;
- new_argv[1] = "-c";
- new_argv[2] = line;
- new_argv[3] = NULL;
-
- /* Restore the signals. */
- (void) __sigaction (SIGINT, &intr, (struct sigaction *) NULL);
- (void) __sigaction (SIGQUIT, &quit, (struct sigaction *) NULL);
- (void) __sigprocmask (SIG_SETMASK, &omask, (sigset_t *) NULL);
-
- /* Exec the shell. */
- (void) __execve (SHELL_PATH, (char *CONST *) new_argv, __environ);
- _exit (127);
- } else {
- if (pid < (pid_t) 0) {
- /* The fork failed. */
- DPRINTF(("4: errno=%d\n", errno));
- status = -1;
- } else {
- /* Parent side. */
-#ifdef NO_WAITPID
- pid_t child;
-
- do {
- __BEGIN_INTERRUPTABLE__
- child = __wait (&status);
- __END_INTERRUPTABLE__
- if (child < 0 && errno != EINTR) {
- DPRINTF(("5: errno=%d\n", errno));
- status = -1;
- break;
- }
- } while (child != pid);
-#else
- pid_t child;
-
- /* claus: the original did not care for EINTR here ... */
- do {
- __BEGIN_INTERRUPTABLE__
- child = __waitpid (pid, &status, 0);
- __END_INTERRUPTABLE__
- } while ((child != pid) && (errno == EINTR));
- if (child != pid) {
- DPRINTF(("6: errno=%d\n", errno));
- status = -1;
- }
-#endif /* NO_WAITPID */
- }
- }
- save = errno;
- if ((__sigaction (SIGINT, &intr, (struct sigaction *) NULL)
- | __sigaction (SIGQUIT, &quit, (struct sigaction *) NULL)
- | __sigprocmask (SIG_SETMASK, &omask, (sigset_t *) NULL)) != 0) {
- if (errno == ENOSYS) {
- errno = save;
- } else {
- status = -1;
- DPRINTF(("7: errno=%d\n", errno));
- }
- }
-
- return status;
-}
-#else
-# define __wait wait
-#endif /* WANT_SYSTEM */
-
-
-/*
- * some systems do not have realpath();
- * the alternative of reading from a 'pwd'-pipe
- * is way too slow. Here is a realpath for the rest of us.
- * define WANT_REALPATH in the xxxIntern-file to get it.
- */
-
-#if defined(HAS_REALPATH)
-# undef WANT_REALPATH
-#endif
-#if !defined(HAS_GETWD) && !defined(HAS_GETCWD)
-# undef WANT_REALPATH
-#endif
-
-#if defined(WANT_REALPATH)
-
-# ifndef NULL
-# define NULL (char *)0
-# endif
-
-# define MAX_READLINKS 32
-
-# ifndef MAXPATHLEN
-# define MAXPATHLEN 1024
-# endif
-
-static char *
-realpath(const char *path, char *resolved_path)
-{
- char copy_path[MAXPATHLEN];
- char link_path[MAXPATHLEN];
- char *new_path, *max_path, *mallocedPath;
- int readlinks = 0;
- int n;
-
- if (resolved_path == NULL) {
- mallocedPath = resolved_path = malloc(MAXPATHLEN+1);
- }
- new_path = resolved_path;
-
- /* Make a copy of the source path since we may need to modify it. */
- strcpy(copy_path, path);
- path = copy_path;
- max_path = copy_path + MAXPATHLEN - 2;
- /* If it's a relative pathname use getwd for starters. */
- if (*path != '/') {
-#ifdef HAS_GETCWD
- new_path = getcwd(new_path, MAXPATHLEN - 1);
-#else
- new_path = getwd(new_path);
-#endif
- if (new_path == NULL) {
- if (mallocedPath) free(mallocedPath);
- return(NULL);
- }
-
- new_path += strlen(new_path);
- if (new_path[-1] != '/')
- *new_path++ = '/';
- }
- else {
- *new_path++ = '/';
- path++;
- }
- /* Expand each slash-separated pathname component. */
- while (*path != '\0') {
- /* Ignore stray "/". */
- if (*path == '/') {
- path++;
- continue;
- }
- if (*path == '.') {
- /* Ignore ".". */
- if (path[1] == '\0' || path[1] == '/') {
- path++;
- continue;
- }
- if (path[1] == '.') {
- if (path[2] == '\0' || path[2] == '/') {
- path += 2;
- /* Ignore ".." at root. */
- if (new_path == resolved_path + 1)
- continue;
- /* Handle ".." by backing up. */
- while ((--new_path)[-1] != '/')
- ;
- continue;
- }
- }
- }
- /* Safely copy the next pathname component. */
- while (*path != '\0' && *path != '/') {
- if (path > max_path) {
- if (mallocedPath) free(mallocedPath);
- errno = ENAMETOOLONG;
- return NULL;
- }
- *new_path++ = *path++;
- }
-#ifdef S_IFLNK
- /* Protect against infinite loops. */
- if (readlinks++ > MAX_READLINKS) {
- if (mallocedPath) free(mallocedPath);
- errno = ELOOP;
- return NULL;
- }
- /* See if latest pathname component is a symlink. */
- *new_path = '\0';
- n = readlink(resolved_path, link_path, MAXPATHLEN - 1);
- if (n < 0) {
- /* EINVAL means the file exists but isn't a symlink. */
- if (errno != EINVAL) {
- if (mallocedPath) free(mallocedPath);
- return NULL;
- }
- }
- else {
- /* Note: readlink doesn't add the null byte. */
- link_path[n] = '\0';
- if (*link_path == '/')
- /* Start over for an absolute symlink. */
- new_path = resolved_path;
- else
- /* Otherwise back up over this component. */
- while (*(--new_path) != '/')
- ;
- /* Safe sex check. */
- if (strlen(path) + n >= MAXPATHLEN) {
- if (mallocedPath) free(mallocedPath);
- errno = ENAMETOOLONG;
- return NULL;
- }
- /* Insert symlink contents into path. */
- strcat(link_path, path);
- strcpy(copy_path, link_path);
- path = copy_path;
- }
-#endif /* S_IFLNK */
- *new_path++ = '/';
- }
- /* Delete trailing slash but don't whomp a lone slash. */
- if (new_path != resolved_path + 1 && new_path[-1] == '/')
- new_path--;
- /* Make sure it's null terminated. */
- *new_path = '\0';
- return resolved_path;
-}
-# define HAS_REALPATH
-#endif /* WANT_REALPATH && not HAS_REALPATH */
-
-%}
-! !
-
!UnixOperatingSystem class methodsFor:'documentation'!
copyright
@@ -3336,10 +2993,10 @@
Here we get an absolute path to the running executable."
info := '/proc/self/exe' asFilename linkInfo.
info notNil ifTrue:[
- path := info path.
- path notEmptyOrNil ifTrue:[
- ^ path
- ].
+ path := info path.
+ path notEmptyOrNil ifTrue:[
+ ^ path
+ ].
].
"Fall back - do it the hard way"
@@ -3360,31 +3017,31 @@
commandFilename := aCommand asFilename.
commandFilename isAbsolute ifTrue:[
- ^ commandFilename pathName
+ ^ commandFilename pathName
].
commandFilename isExplicitRelative ifTrue:[
- ^ commandFilename pathName
+ ^ commandFilename pathName
].
path := self getEnvironment:'PATH'.
path notEmptyOrNil ifTrue:[
- (path asCollectionOfSubstringsSeparatedBy:self pathSeparator) do:[:eachPathComponent |
- eachPathComponent isEmpty ifTrue:[
- f := commandFilename
- ] ifFalse:[
- f := eachPathComponent asFilename construct:aCommand.
- ].
- self executableFileExtensions do:[:eachExtension |
- eachExtension notEmpty ifTrue:[
- fExt := f addSuffix:eachExtension.
- ] ifFalse:[
- fExt := f.
- ].
- fExt isExecutable ifTrue:[
- ^ fExt pathName
- ].
- ].
- ].
+ (path asCollectionOfSubstringsSeparatedBy:self pathSeparator) do:[:eachPathComponent |
+ eachPathComponent isEmpty ifTrue:[
+ f := commandFilename
+ ] ifFalse:[
+ f := eachPathComponent asFilename construct:aCommand.
+ ].
+ self executableFileExtensions do:[:eachExtension |
+ eachExtension notEmpty ifTrue:[
+ fExt := f addSuffix:eachExtension.
+ ] ifFalse:[
+ fExt := f.
+ ].
+ fExt isExecutable ifTrue:[
+ ^ fExt pathName
+ ].
+ ].
+ ].
].
^ nil
@@ -4872,18 +4529,18 @@
if (__isStringLike(encodedPathName)) {
# ifdef TRACE_STAT_CALLS
- printf("stat on '%s' for isValidPath\n", __stringVal(encodedPathName));
-# endif
- __BEGIN_INTERRUPTABLE__
- do {
- ret = stat((char *) __stringVal(encodedPathName), &buf);
- } while ((ret < 0) && (errno == EINTR));
- __END_INTERRUPTABLE__
- if (ret < 0) {
- @global(LastErrorNumber) = __mkSmallInteger(errno);
- RETURN (false);
- }
- RETURN ( ret ? false : true );
+ printf("stat on '%s' for isValidPath\n", __stringVal(encodedPathName));
+# endif
+ __BEGIN_INTERRUPTABLE__
+ do {
+ ret = stat((char *) __stringVal(encodedPathName), &buf);
+ } while ((ret < 0) && (errno == EINTR));
+ __END_INTERRUPTABLE__
+ if (ret < 0) {
+ @global(LastErrorNumber) = __mkSmallInteger(errno);
+ RETURN (false);
+ }
+ RETURN ( ret ? false : true );
}
%}.
^ self primitiveFailed
@@ -5119,66 +4776,66 @@
|p path command|
path = '.' ifTrue:[
- ^ self getCurrentDirectory.
+ ^ self getCurrentDirectory.
].
"some systems have a convenient function for this ..."
path := self primPathNameOf:(self encodePath:pathName).
path notNil ifTrue:[
- path := self decodePath:path.
+ path := self decodePath:path.
] ifFalse:[
- (self isValidPath:pathName) ifFalse:[
- p := pathName.
- [(p size > 1)
- and:[p endsWith:(self fileSeparator)]
- ] whileTrue:[
- p := p copyButLast:1.
- ].
- ^ p
- ].
-
- (SlowFork==true or:[PipeFailed==true]) ifFalse:[
- |directoryName fileBaseName|
-
- (self isDirectory:pathName) ifTrue:[
- directoryName := pathName.
- fileBaseName := nil.
- ] ifFalse:[
- |pathFilename|
- pathFilename := pathName asFilename.
- directoryName := pathFilename directoryName.
- fileBaseName := pathFilename baseName.
- ].
-
- PipeStream openErrorSignal handle:[:ex |
- PipeFailed := true.
- 'UnixOperatingSystem [warning]: cannot fork/popen' errorPrintCR.
- ex return.
- ] do:[
- "have to fall back ..."
- command := 'cd "' , directoryName , '"; pwd'.
- p := PipeStream readingFrom:command.
- ].
-
- (p isNil or:[p atEnd]) ifTrue:[
- ('UnixOperatingSystem [warning]: PipeStream for <' , command , '> failed') errorPrintCR.
- ] ifFalse:[
- path := p nextLine.
- p close.
- ].
- fileBaseName notNil ifTrue:[
- path := path, '/', fileBaseName.
- ].
- ].
- path isNil ifTrue:[
- "/
- "/ return the original - there is nothing else can we do
- "/
- path := pathName
- ].
- (SlowFork==true or:[ForkFailed==true]) ifTrue:[
- path := self compressPath:path
- ]
+ (self isValidPath:pathName) ifFalse:[
+ p := pathName.
+ [(p size > 1)
+ and:[p endsWith:(self fileSeparator)]
+ ] whileTrue:[
+ p := p copyButLast:1.
+ ].
+ ^ p
+ ].
+
+ (SlowFork==true or:[PipeFailed==true]) ifFalse:[
+ |directoryName fileBaseName|
+
+ (self isDirectory:pathName) ifTrue:[
+ directoryName := pathName.
+ fileBaseName := nil.
+ ] ifFalse:[
+ |pathFilename|
+ pathFilename := pathName asFilename.
+ directoryName := pathFilename directoryName.
+ fileBaseName := pathFilename baseName.
+ ].
+
+ PipeStream openErrorSignal handle:[:ex |
+ PipeFailed := true.
+ 'UnixOperatingSystem [warning]: cannot fork/popen' errorPrintCR.
+ ex return.
+ ] do:[
+ "have to fall back ..."
+ command := 'cd "' , directoryName , '"; pwd'.
+ p := PipeStream readingFrom:command.
+ ].
+
+ (p isNil or:[p atEnd]) ifTrue:[
+ ('UnixOperatingSystem [warning]: PipeStream for <' , command , '> failed') errorPrintCR.
+ ] ifFalse:[
+ path := p nextLine.
+ p close.
+ ].
+ fileBaseName notNil ifTrue:[
+ path := path, '/', fileBaseName.
+ ].
+ ].
+ path isNil ifTrue:[
+ "/
+ "/ return the original - there is nothing else can we do
+ "/
+ path := pathName
+ ].
+ (SlowFork==true or:[ForkFailed==true]) ifTrue:[
+ path := self compressPath:path
+ ]
].
^ path.
@@ -5274,19 +4931,19 @@
#ifdef HAS_REALPATH
extern char *realpath();
- // POSIX-2008 says, that a NULL namebuffer causes realPath to malloc()
- // the required memory. But this does not work as of 2013-04
- char nameBuffer[MAXPATHLEN+1];
- char *nameP = realpath(__stringVal(pathName), nameBuffer);
- if (nameP) {
- OBJ ret = __MKSTRING(nameP);
- // free(nameP);
- RETURN ( ret );
- }
- // fprintf(stderr, "stx[warning]: realpath(\"%s\") failed: %s\n", __stringVal(pathName), strerror(errno));
+ // POSIX-2008 says, that a NULL namebuffer causes realPath to malloc()
+ // the required memory. But this does not work as of 2013-04
+ char nameBuffer[MAXPATHLEN+1];
+ char *nameP = realpath(__stringVal(pathName), nameBuffer);
+ if (nameP) {
+ OBJ ret = __MKSTRING(nameP);
+ // free(nameP);
+ RETURN ( ret );
+ }
+ // fprintf(stderr, "stx[warning]: realpath(\"%s\") failed: %s\n", __stringVal(pathName), strerror(errno));
#endif /* ! HAS_REALPATH */
} else {
- error = @symbol(argument); // argument is not a string
+ error = @symbol(argument); // argument is not a string
}
%}.
"/ Does not work as of 2013-04 (UNLIMITEDSTACK problem?)
@@ -5296,9 +4953,9 @@
^ nil
"
- self primPathNameOf:'.'
- self primPathNameOf:'/murks/quatsch/bla/.'
- self primPathNameOf:5555
+ self primPathNameOf:'.'
+ self primPathNameOf:'/murks/quatsch/bla/.'
+ self primPathNameOf:5555
"
!
@@ -6508,36 +6165,36 @@
closeLeftOverFiles
"a bad bad kludge and workaround for a big bug in the linux
getAddrInfo implementation:
- if it gets interrupted (via a timer, for example), its domain-name
- socket remains open and is NEVER closed.
- These open files collect up and lead to no-more-files eventually.
+ if it gets interrupted (via a timer, for example), its domain-name
+ socket remains open and is NEVER closed.
+ These open files collect up and lead to no-more-files eventually.
Invoking this method helps in this situation."
|p|
p := PipeStream
- readingFrom:('lsof -p ' , (OperatingSystem getProcessId printString)).
+ readingFrom:('lsof -p ' , (OperatingSystem getProcessId printString)).
p linesDo:[:line |
- |words fd|
-
- words := line asCollectionOfWords.
- "/ COMMAND PID USER FD TYPE DEVICE SIZE NODE NAME
- words first = 'stx' ifTrue:[
- words second = (OperatingSystem getProcessId printString) ifTrue:[
- (words fourth endsWith:'u') ifTrue:[
- (words fifth = 'IPv4') ifTrue:[
- (words seventh = 'UDP') ifTrue:[
- (words last endsWith:'domain') ifTrue:[
- fd := Number readFrom:(words fourth copyButLast:1).
+ |words fd|
+
+ words := line asCollectionOfWords.
+ "/ COMMAND PID USER FD TYPE DEVICE SIZE NODE NAME
+ words first = 'stx' ifTrue:[
+ words second = (OperatingSystem getProcessId printString) ifTrue:[
+ (words fourth endsWith:'u') ifTrue:[
+ (words fifth = 'IPv4') ifTrue:[
+ (words seventh = 'UDP') ifTrue:[
+ (words last endsWith:'domain') ifTrue:[
+ fd := Number readFrom:(words fourth copyButLast:1).
Transcript showCR:line.
- OperatingSystem closeFd:fd.
- ]
- ]
- ]
- ]
- ]
- ]
+ OperatingSystem closeFd:fd.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
].
p close.
@@ -6601,6 +6258,25 @@
^ Codeset
!
+getCodesetEncoder
+ "Initialize CodesetEncoder used to encode/decode strings passed to/from
+ the operating system (like file names, command output, environment ect.).
+
+ NOTE: DO NOT CALL this in #initialize as CharacterEncoder might not yet
+ be initialized. Therefore this method is called from CharacterEncoder class>>
+ #initialize. Certainly a hack, but class initialization order is undefined,
+ so some sort of hack is necessary.
+
+ NOTE2: This should be called initializeCodesetEncoder but to make it consistent
+ with getCodeset it is getCodesetEncoder
+ "
+
+ Codeset isNil ifTrue:[self getCodeset].
+ CodesetEncoder := CharacterEncoder encoderFor: Codeset.
+
+ "Created: / 23-01-2013 / 09:54:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
getDomainName
"return the domain this host is in.
Notice:
@@ -7354,8 +7030,8 @@
getNetworkMACAddresses
"return a dictionary filled with
- key -> name of interface
- value -> the MAC adress (as ByteArray)
+ key -> name of interface
+ value -> the MAC adress (as ByteArray)
for each interface"
|addressArray nameArray noOfIf retDictionary error|
@@ -7379,8 +7055,8 @@
afinet_socket = socket(AF_INET, SOCK_DGRAM, 0);
if (afinet_socket < 0) {
- error = __MKSTRING("Cannot open socket");
- goto bad;
+ error = __MKSTRING("Cannot open socket");
+ goto bad;
}
/*
@@ -7391,8 +7067,8 @@
ifc.ifc_buf = (caddr_t) buf;
if (ioctl (afinet_socket, SIOCGIFCONF, (caddr_t) &ifc) < 0) {
- error = __MKSTRING("ioctl(SIOCGIFCONF) failed");
- goto bad;
+ error = __MKSTRING("ioctl(SIOCGIFCONF) failed");
+ goto bad;
}
n_ifs = ifc.ifc_len / sizeof (struct ifreq);
@@ -7401,9 +7077,9 @@
addressArray = __ARRAY_NEW_INT(n_ifs);
if (nameArray == nil || addressArray == nil) {
- /* Creating a string wouldn/t work here */
- error = @symbol(allocationFailure);
- goto bad;
+ /* Creating a string wouldn/t work here */
+ error = @symbol(allocationFailure);
+ goto bad;
}
/*
@@ -7414,55 +7090,55 @@
countOfIf = 0;
for (i=0, ifr = ifc.ifc_req; i < n_ifs; i++, ifr++) {
- /*
- ** Get Flags for this interface
- */
-
- memcpy(&ifreq, ifr, sizeof(ifreq));
- if (ioctl (afinet_socket, SIOCGIFFLAGS, &ifreq) < 0) {
- if (@global(InfoPrinting) == true) {
- fprintf(stderr, "OS [warning]: ioctl(SIOCGIFFLAGS) failed");
- }
- } else {
- /*
- ** Get Hardware address for this interface
- */
- memcpy(&ifreq, ifr, sizeof(ifreq));
- if (ioctl (afinet_socket, SIOCGIFHWADDR, &ifreq) >= 0) {
- t = __MKBYTEARRAY(&ifreq.ifr_hwaddr.sa_data, IFHWADDRLEN);
- __arrayVal(addressArray)[countOfIf] = t; __STORE(addressArray, t);
- t = __MKSTRING(&ifreq.ifr_name);
- __arrayVal(nameArray)[countOfIf] = t; __STORE(nameArray, t);
- countOfIf += 1;
- }
- }
+ /*
+ ** Get Flags for this interface
+ */
+
+ memcpy(&ifreq, ifr, sizeof(ifreq));
+ if (ioctl (afinet_socket, SIOCGIFFLAGS, &ifreq) < 0) {
+ if (@global(InfoPrinting) == true) {
+ fprintf(stderr, "OS [warning]: ioctl(SIOCGIFFLAGS) failed");
+ }
+ } else {
+ /*
+ ** Get Hardware address for this interface
+ */
+ memcpy(&ifreq, ifr, sizeof(ifreq));
+ if (ioctl (afinet_socket, SIOCGIFHWADDR, &ifreq) >= 0) {
+ t = __MKBYTEARRAY(&ifreq.ifr_hwaddr.sa_data, IFHWADDRLEN);
+ __arrayVal(addressArray)[countOfIf] = t; __STORE(addressArray, t);
+ t = __MKSTRING(&ifreq.ifr_name);
+ __arrayVal(nameArray)[countOfIf] = t; __STORE(nameArray, t);
+ countOfIf += 1;
+ }
+ }
}
noOfIf = __mkSmallInteger(countOfIf);
bad:
if (afinet_socket >= 0)
- close(afinet_socket);
+ close(afinet_socket);
#else
error = @symbol(notSupported);
#endif /* SIOCGIFHWADDR */
%}.
error notNil ifTrue:[
- self primitiveFailed:error.
- "return an empty dictionary if proceed from error"
- ^ Dictionary new.
- ].
-
- "we prefer OrderedDictionary here, because we want to keep the
+ self primitiveFailed:error.
+ "return an empty dictionary if proceed from error"
+ ^ Dictionary new.
+ ].
+
+ "we prefer OrderedDictionary here, because we want to keep the
order as defined in the OS."
retDictionary := OrderedDictionary new:noOfIf.
1 to:noOfIf do:[:cnt|
- |macAddress|
-
- macAddress := addressArray at:cnt.
- macAddress ~= #[0 0 0 0 0 0] ifTrue:[
- retDictionary at:(nameArray at:cnt) put:macAddress.
- ].
+ |macAddress|
+
+ macAddress := addressArray at:cnt.
+ macAddress ~= #[0 0 0 0 0 0] ifTrue:[
+ retDictionary at:(nameArray at:cnt) put:macAddress.
+ ].
].
^ retDictionary
@@ -8747,15 +8423,23 @@
so the pathName has been UTF-8 decoded."
"linux strings are in UTF8 (in contemporary linux versions)"
- (encodedPathName notNil and:[Codeset == #utf8]) ifTrue:[
- [
- ^ encodedPathName utf8Decoded.
- ] on:InvalidEncodingError do:[:ex|
- "maybe there are old filenames in ISO8859-x,
- just keep them untranslated"
- ].
+ encodedPathName notNil ifTrue:[
+ [
+ Codeset == #utf8 ifTrue:[
+ ^ encodedPathName utf8Decoded.
+ ].
+ "/ Codeset encoder might not yet be initialized, sigh...
+ CodesetEncoder notNil ifTrue:[
+ ^ CodesetEncoder decodeString: encodedPathName
+ ].
+ ] on:InvalidEncodingError do:[:ex|
+ "maybe there are old filenames in ISO8859-x,
+ just keep them untranslated"
+ ].
].
^ encodedPathName
+
+ "Modified: / 23-01-2013 / 10:02:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
defaultSystemPath
@@ -8813,10 +8497,18 @@
E.g. linux system calls accept single byte strings only,
so the pathName has been UTF-8 encoded, before using it in a system call."
- (pathName notNil and:[Codeset == #utf8]) ifTrue:[
- ^ pathName utf8Encoded.
- ].
- ^ pathName asSingleByteString.
+ pathName notNil ifTrue:[
+ Codeset == #utf8 ifTrue:[
+ ^ pathName utf8Encoded
+ ].
+ "/ Codeset encoder might not yet be initialized, sigh...
+ CodesetEncoder notNil ifTrue:[
+ ^ CodesetEncoder encodeString: pathName.
+ ].
+ ].
+ ^ pathName
+
+ "Modified: / 23-01-2013 / 10:00:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UnixOperatingSystem class methodsFor:'private'!
@@ -10547,7 +10239,7 @@
OpenFiles addDependent:self.
"
- self initialize
+ self initialize
"
"Created: 26.9.1997 / 17:15:50 / stefan"
@@ -10600,13 +10292,13 @@
fd := aFileDescriptor.
"JV@2013-03-15: It may happen that OS returns a filedescriptor whose value
- is larger than twice the lenght of the weakarray. Care for this.
- Spotted by Martin Kobetic."
+ is larger than twice the lenght of the weakarray. Care for this.
+ Spotted by Martin Kobetic."
oldHandle := OpenFiles at:aFileDescriptor ifAbsent: [nil].
"/ the 0 is possible, if an fd was open when saving a snapshot image,
"/ and we come up in the new image with no one referring to it.
(oldHandle notNil and:[oldHandle ~~ 0 and:[ oldHandle ~~ self]]) ifTrue:[
- oldHandle invalidate.
+ oldHandle invalidate.
].
self register.
@@ -11195,21 +10887,21 @@
sz := OpenFiles size.
fd > sz ifTrue:[
- "grow for more descriptors"
- old := OpenFiles.
-
- "JV@2013-03-15: It may happen that OS returns a filedescriptor whose value
- is larger than twice the lenght of the weakarray. Care for this.
- Spotted by Martin Kobetic."
- OpenFiles := WeakArray new:((sz * 2) max:fd).
- old removeDependent:(self class).
- OpenFiles addDependent:(self class).
- old keysAndValuesDo:[:index :elem|
- "be careful to not overwrite new entries in OpenFiles"
- elem notNil ifTrue:[
- OpenFiles at:index put:elem.
- ].
- ].
+ "grow for more descriptors"
+ old := OpenFiles.
+
+ "JV@2013-03-15: It may happen that OS returns a filedescriptor whose value
+ is larger than twice the lenght of the weakarray. Care for this.
+ Spotted by Martin Kobetic."
+ OpenFiles := WeakArray new:((sz * 2) max:fd).
+ old removeDependent:(self class).
+ OpenFiles addDependent:(self class).
+ old keysAndValuesDo:[:index :elem|
+ "be careful to not overwrite new entries in OpenFiles"
+ elem notNil ifTrue:[
+ OpenFiles at:index put:elem.
+ ].
+ ].
].
OpenFiles at:fd put:self.
@@ -11998,7 +11690,7 @@
domain:#'AF_INET' type:nil protocol:nil flags:nil
self getAddressInfo:'www.exept.de' serviceName:nil
domain:#'AF_INET6' type:nil protocol:nil flags:nil
- self getAddressInfo:'www.baden-wrttemberg.de' serviceName:nil
+ self getAddressInfo:'www.baden-wrttemberg.de' serviceName:nil
domain:#'AF_INET' type:#stream protocol:nil flags:nil
"
!
@@ -13404,8 +13096,13 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.339 2014-01-25 00:30:52 cg Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !
+UnixOperatingSystem::FileDescriptorHandle initialize!
UnixOperatingSystem initialize!
-UnixOperatingSystem::FileDescriptorHandle initialize!
--- a/UnorderedNumbersError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnorderedNumbersError.st Sun Feb 02 14:16:24 2014 +0000
@@ -40,16 +40,22 @@
"
! !
+
!UnorderedNumbersError class methodsFor:'initialization'!
initialize
NotifierString := 'unordered'.
! !
+
!UnorderedNumbersError class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/UnorderedNumbersError.st,v 1.5 2013-03-13 23:44:03 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: UnorderedNumbersError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/UnprotectedExternalBytes.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UnprotectedExternalBytes.st Sun Feb 02 14:16:24 2014 +0000
@@ -1,3 +1,14 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic' }"
ExternalBytes subclass:#UnprotectedExternalBytes
@@ -9,6 +20,20 @@
!UnprotectedExternalBytes class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
documentation
"
This is just a factory to generate ExternalBytes.
@@ -43,5 +68,12 @@
!UnprotectedExternalBytes class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnprotectedExternalBytes.st,v 1.1 2002-04-09 15:23:15 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnprotectedExternalBytes.st,v 1.1 2002/04/09 15:23:15 stefan Exp $'
+!
+
+version_SVN
+ ^ '$Id: UnprotectedExternalBytes.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/UserConfirmation.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UserConfirmation.st Sun Feb 02 14:16:24 2014 +0000
@@ -61,6 +61,7 @@
"
! !
+
!UserConfirmation methodsFor:'accessing'!
aspect
@@ -104,6 +105,7 @@
defaultAnswer := aBooleanOrNil
! !
+
!UserConfirmation methodsFor:'default actions'!
defaultAction
@@ -150,6 +152,7 @@
"
! !
+
!UserConfirmation class methodsFor:'documentation'!
version
@@ -158,5 +161,9 @@
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/UserConfirmation.st,v 1.7 2013-03-25 14:00:49 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: UserConfirmation.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/UserInformation.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UserInformation.st Sun Feb 02 14:16:24 2014 +0000
@@ -63,7 +63,14 @@
!UserInformation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UserInformation.st,v 1.4 2008-10-04 08:42:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserInformation.st,v 1.4 2008/10/04 08:42:26 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: UserInformation.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
UserInformation initialize!
+
+
+
--- a/UserPreferences.st Sun Feb 02 00:13:55 2014 +0100
+++ b/UserPreferences.st Sun Feb 02 14:16:24 2014 +0000
@@ -609,7 +609,6 @@
"Modified: / 15-01-2012 / 14:26:53 / cg"
! !
-
!UserPreferences methodsFor:'accessing-locale'!
dateInputFormat
@@ -861,7 +860,18 @@
!UserPreferences methodsFor:'accessing-pref''d tools'!
changeSetBrowserClass
- "using old or jan's changeSet browser for package diffs"
+
+ | class className |
+
+ className := self at: #changeSetBrowserClassName ifAbsent:[nil].
+ className notNil ifTrue:[
+ class := Smalltalk at: className asSymbol.
+ class notNil ifTrue:[ ^ class ].
+ ].
+
+ "Original code"
+ ^ ChangeSetBrowser.
+ "/^ Tools::ChangeSetBrowser2 ? ChangeSetBrowser
self useNewChangeSetBrowser ifTrue:[
^ Tools::ChangeSetBrowser2 ? ChangeSetBrowser
@@ -874,18 +884,54 @@
"Created: / 01-07-2011 / 16:33:13 / cg"
"Modified: / 25-07-2011 / 12:21:42 / sr"
- "Modified (comment): / 26-07-2012 / 15:07:43 / cg"
+ "Modified: / 25-01-2012 / 17:11:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+changeSetBrowserClass: aClass
+
+ self at: #changeSetBrowserClassName put: aClass name.
+
+ "
+ UserPreferences current changeSetBrowserClass
+ UserPreferences current changeSetBrowserClass: Tools::ChangeSetBrowser2.
+ UserPreferences current changeSetBrowserClass: ChangeSetBrowser.
+ "
+
+ "Created: / 25-01-2012 / 17:08:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changesBrowserClass
"the browser to be used for the changeFile"
+ | class className |
+
+ className := self at: #changesBrowserClassName ifAbsent:[nil].
+ className notNil ifTrue:[
+ class := Smalltalk at: className asSymbol.
+ class notNil ifTrue:[ ^ class ].
+ ].
+
+ "/ Old code
self useNewChangesBrowser ifTrue:[
^ (NewChangesBrowser ? ChangesBrowser)
].
^ ChangesBrowser
"Created: / 17-10-1998 / 14:37:46 / cg"
+ "Modified: / 25-01-2012 / 17:11:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+changesBrowserClass: aClass
+
+ self at: #changesBrowserClassName put: aClass name.
+
+ "
+ UserPreferences current changesBrowserClass
+ UserPreferences current changesBrowserClass: Tools::ChangeSetBrowser2.
+ UserPreferences current changesBrowserClass: ChangeSetBrowser.
+ "
+
+ "Created: / 25-01-2012 / 17:12:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
externalDiffCommandTemplate
@@ -920,16 +966,7 @@
"
!
-fileBrowserClass
- self useNewFileBrowser ifTrue:[
- ^ (FileBrowserV2 ? FileBrowser)
- ].
- ^ FileBrowser
-
- "
- UserPreferences current fileBrowserClass
- "
-!
+
inspectorClassSetting
self useNewInspector ifTrue:[
@@ -3572,7 +3609,9 @@
!
variableBackgroundColorForNavigationService
- ^ (Color gray: "80" 90)
+ ^ self at: #variableBackgroundColorForNavigationService ifAbsent: [(Color red:93.7254901960784 green:84.3137254901961 blue:65.4901960784314)]
+
+ "Modified: / 01-10-2013 / 11:35:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-prefs-editor'!
@@ -4671,6 +4710,11 @@
^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.357 2014-02-01 23:13:55 cg Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '$ Id: UserPreferences.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- a/WeakValueIdentityDictionary.st Sun Feb 02 00:13:55 2014 +0100
+++ b/WeakValueIdentityDictionary.st Sun Feb 02 14:16:24 2014 +0000
@@ -251,5 +251,8 @@
!WeakValueIdentityDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakValueIdentityDictionary.st,v 1.4 2006-03-06 10:04:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WeakValueIdentityDictionary.st,v 1.4 2006/03/06 10:04:38 cg Exp $'
! !
+
+
+
--- a/WriteError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/WriteError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
StreamError subclass:#WriteError
@@ -38,5 +37,12 @@
!WriteError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WriteError.st,v 1.2 2005-02-02 11:04:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WriteError.st,v 1.2 2005/02/02 11:04:48 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: WriteError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
+
+
--- a/WrongNumberOfArgumentsError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/WrongNumberOfArgumentsError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ArgumentError subclass:#WrongNumberOfArgumentsError
@@ -56,7 +55,14 @@
!WrongNumberOfArgumentsError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WrongNumberOfArgumentsError.st,v 1.5 2003-12-05 15:47:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WrongNumberOfArgumentsError.st,v 1.5 2003/12/05 15:47:45 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: WrongNumberOfArgumentsError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
WrongNumberOfArgumentsError initialize!
+
+
+
--- a/WrongProceedabilityError.st Sun Feb 02 00:13:55 2014 +0100
+++ b/WrongProceedabilityError.st Sun Feb 02 14:16:24 2014 +0000
@@ -9,9 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
-
-
"{ Package: 'stx:libbasic' }"
SignalError subclass:#WrongProceedabilityError
@@ -67,7 +64,14 @@
!WrongProceedabilityError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WrongProceedabilityError.st,v 1.4 2003-08-29 19:14:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WrongProceedabilityError.st,v 1.4 2003/08/29 19:14:38 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: WrongProceedabilityError.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
WrongProceedabilityError initialize!
+
+
+
--- a/ZeroDivide.st Sun Feb 02 00:13:55 2014 +0100
+++ b/ZeroDivide.st Sun Feb 02 14:16:24 2014 +0000
@@ -65,12 +65,14 @@
"
! !
+
!ZeroDivide class methodsFor:'initialization'!
initialize
NotifierString := 'division by zero'.
! !
+
!ZeroDivide methodsFor:'accessing'!
defaultResumeValue
@@ -123,10 +125,15 @@
"
! !
+
!ZeroDivide class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ZeroDivide.st,v 1.8 2013-01-25 17:19:34 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: ZeroDivide.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
--- a/abbrev.stc Sun Feb 02 00:13:55 2014 +0100
+++ b/abbrev.stc Sun Feb 02 14:16:24 2014 +0000
@@ -18,6 +18,7 @@
CharacterEncoderImplementations::HANGUL CharacterEncoderImplementations__HANGUL stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::ISO10646_to_JavaText CharacterEncoderImplementations__ISO10646_to_JavaText stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::ISO10646_to_SGML CharacterEncoderImplementations__ISO10646_to_SGML stx:libbasic 'Collections-Text-Encodings' 0
+CharacterEncoderImplementations::ISO10646_to_XMLUTF8 CharacterEncoderImplementations__ISO10646_to_XMLUTF8 stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::JIS0201 CharacterEncoderImplementations__JIS0201 stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::JIS0208 CharacterEncoderImplementations__JIS0208 stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::JIS0208_to_EUC CharacterEncoderImplementations__JIS0208_to_EUC stx:libbasic 'Collections-Text-Encodings' 0
@@ -47,7 +48,6 @@
ClassBuilder ClassBuilder stx:libbasic 'Kernel-Support' 0
ClassCategoryReader ClassCategoryReader stx:libbasic 'Kernel-Support' 0
CmdLineOption CmdLineOption stx:libbasic 'System-Support-Command line' 0
-CmdLineOptionError CmdLineOptionError stx:libbasic 'System-Support-Command line' 1
CmdLineParser CmdLineParser stx:libbasic 'System-Support-Command line' 0
CmdLineParserTest CmdLineParserTest stx:libbasic 'System-Support-Command line' 1
Collection Collection stx:libbasic 'Collections-Abstract' 0
@@ -78,16 +78,11 @@
NaiveRomanNumberFormatNotification NaiveRomanNumberFormatNotification stx:libbasic 'Magnitude-Numbers' 1
NameSpace NameSpace stx:libbasic 'Kernel-Classes' 0
NotANumber NotANumber stx:libbasic 'Magnitude-Numbers' 0
-NumberConversionError NumberConversionError stx:libbasic 'Magnitude-Numbers' 1
-NumberFormatError NumberFormatError stx:libbasic 'Magnitude-Numbers' 1
OSErrorHolder OSErrorHolder stx:libbasic 'OS-Support' 0
OSProcess OSProcess stx:libbasic 'System-Support' 0
ObjectMemory ObjectMemory stx:libbasic 'System-Support' 0
-OpenVMSFileHandle OpenVMSFileHandle stx:libbasic 'unknownCategory' 0
-OpenVMSFilename OpenVMSFilename stx:libbasic 'unknownCategory' 0
-OpenVMSOperatingSystem OpenVMSOperatingSystem stx:libbasic 'unknownCategory' 0
-PCFilename PCFilename stx:libbasic 'unknownCategory' 0
PackageId PackageId stx:libbasic 'System-Support-Projects' 0
+PolymorphicInlineCache PolymorphicInlineCache stx:libbasic 'Kernel-Classes' 0
ProcessorScheduler ProcessorScheduler stx:libbasic 'Kernel-Processes' 0
ProgrammingLanguage ProgrammingLanguage stx:libbasic 'Kernel-Languages' 1
Project Project stx:libbasic 'System-Support' 0
@@ -96,7 +91,6 @@
ReadEvalPrintLoop ReadEvalPrintLoop stx:libbasic 'System-Support' 0
RecursionLock RecursionLock stx:libbasic 'Kernel-Processes' 0
Registry Registry stx:libbasic 'System-Support' 0
-RomanNumberFormatError RomanNumberFormatError stx:libbasic 'Magnitude-Numbers' 1
Semaphore Semaphore stx:libbasic 'Kernel-Processes' 0
SharedPool SharedPool stx:libbasic 'Kernel-Classes' 0
Signal Signal stx:libbasic 'Kernel-Exceptions' 0
@@ -109,17 +103,10 @@
TextCollectorStream TextCollectorStream stx:libbasic 'Streams-Misc' 0
UnboundedExternalStream UnboundedExternalStream stx:libbasic 'Streams-External' 0
UndefinedObject UndefinedObject stx:libbasic 'Kernel-Objects' 0
-UnixDesktop UnixDesktop stx:libbasic 'System-Desktop' 0
UserMessage UserMessage stx:libbasic 'Interface-Internationalization' 0
Visitor Visitor stx:libbasic 'System-Visiting' 0
WeakValueIdentityDictionary WeakValueIdentityDictionary stx:libbasic 'Collections-Weak' 0
-Win32Constants Win32Constants stx:libbasic 'unknownCategory' 0
-Win32FILEHandle Win32FILEHandle stx:libbasic 'unknownCategory' 0
-Win32Handle Win32Handle stx:libbasic 'unknownCategory' 0
-Win32OperatingSystem Win32OperatingSystem stx:libbasic 'unknownCategory' 0
-Win32Process Win32Process stx:libbasic 'unknownCategory' 0
WindowsDesktop WindowsDesktop stx:libbasic 'System-Desktop' 0
-XDGDesktop XDGDesktop stx:libbasic 'System-Desktop' 0
AbstractTime AbstractTime stx:libbasic 'Magnitude-Time' 0
ApplicationDefinition ApplicationDefinition stx:libbasic 'System-Support-Projects' 3
ArithmeticValue ArithmeticValue stx:libbasic 'Magnitude-Numbers' 0
@@ -159,11 +146,13 @@
SmalltalkChunkFileSourceReader SmalltalkChunkFileSourceReader stx:libbasic 'Kernel-Classes-Support' 0
SmalltalkLanguage SmalltalkLanguage stx:libbasic 'Kernel-Languages' 1
True True stx:libbasic 'Kernel-Objects' 0
+UnixDesktop UnixDesktop stx:libbasic 'System-Desktop' 0
UnixFilename UnixFilename stx:libbasic 'OS-Unix' 0
WeakInterestConverter WeakInterestConverter stx:libbasic 'Interface-Support-Models' 0
ArrayedCollection ArrayedCollection stx:libbasic 'Collections-Abstract' 0
Association Association stx:libbasic 'Collections-Support' 0
Block Block stx:libbasic 'Kernel-Methods' 0
+CascadingNotification CascadingNotification stx:libbasic 'Kernel-Exceptions' 1
CharacterEncoderImplementations::ASCII CharacterEncoderImplementations__ASCII stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::CP437 CharacterEncoderImplementations__CP437 stx:libbasic 'Collections-Text-Encodings' 0
CharacterEncoderImplementations::EBCDIC CharacterEncoderImplementations__EBCDIC stx:libbasic 'Collections-Text-Encodings' 0
@@ -197,7 +186,7 @@
Complex Complex stx:libbasic 'Magnitude-Numbers' 0
ControlRequest ControlRequest stx:libbasic 'Kernel-Exceptions-Control' 1
Dictionary Dictionary stx:libbasic 'Collections-Unordered' 0
-EncodedStream EncodedStream stx:libbasic 'Streams-Misc' 0
+EncodedStream EncodedStream stx:libbasic 'Collections-Text-Encodings' 0
EndOfStreamNotification EndOfStreamNotification stx:libbasic 'Kernel-Exceptions-Errors' 1
Error Error stx:libbasic 'Kernel-Exceptions-Errors' 1
ExternalFunctionCallback ExternalFunctionCallback stx:libbasic 'System-Support' 0
@@ -212,8 +201,10 @@
OSFileHandle OSFileHandle stx:libbasic 'System-Support' 0
ObjectCoder ObjectCoder stx:libbasic 'System-Storage' 0
OrderedCollection OrderedCollection stx:libbasic 'Collections-Sequenceable' 0
+OrderedSet OrderedSet stx:libbasic 'Collections-Sequenceable' 0
Point Point stx:libbasic 'Graphics-Geometry' 0
PositionableStream PositionableStream stx:libbasic 'Streams' 0
+ProceedingNotification ProceedingNotification stx:libbasic 'Kernel-Exceptions' 1
Query Query stx:libbasic 'Kernel-Exceptions' 1
ReadOnlySequenceableCollection ReadOnlySequenceableCollection stx:libbasic 'Collections-Abstract' 0
RecursiveStoreError RecursiveStoreError stx:libbasic 'Kernel-Exceptions-Errors' 1
@@ -221,8 +212,10 @@
Time Time stx:libbasic 'Magnitude-Time' 0
TimeoutNotification TimeoutNotification stx:libbasic 'Kernel-Exceptions-Notifications' 1
Timestamp Timestamp stx:libbasic 'Magnitude-Time' 0
+UserConfirmation UserConfirmation stx:libbasic 'Kernel-Exceptions-Notifications' 1
UserInterrupt UserInterrupt stx:libbasic 'Kernel-Exceptions-Control' 1
UserNotification UserNotification stx:libbasic 'Kernel-Exceptions-Notifications' 1
+XDGDesktop XDGDesktop stx:libbasic 'System-Desktop' 0
YesToAllConfirmation YesToAllConfirmation stx:libbasic 'Kernel-Exceptions-Notifications' 1
stx_libbasic stx_libbasic stx:libbasic '* Projects & Packages *' 3
AbortAllOperationRequest AbortAllOperationRequest stx:libbasic 'Kernel-Exceptions-Control' 1
@@ -236,6 +229,7 @@
CharacterEncoderImplementations::KOI8_U CharacterEncoderImplementations__KOI8_U stx:libbasic 'Collections-Text-Encodings' 0
CheapBlock CheapBlock stx:libbasic 'Kernel-Methods' 0
ClassBuildError ClassBuildError stx:libbasic 'Kernel-Support' 1
+CmdLineOptionError CmdLineOptionError stx:libbasic 'System-Support-Command line' 1
ElementBoundsError ElementBoundsError stx:libbasic 'Kernel-Exceptions-Errors' 1
FileDirectory FileDirectory stx:libbasic 'Compatibility-Squeak' 0
Fraction Fraction stx:libbasic 'Magnitude-Numbers' 0
@@ -250,6 +244,7 @@
MetaNumber MetaNumber stx:libbasic 'Magnitude-Numbers' 0
Metaclass Metaclass stx:libbasic 'Kernel-Classes' 0
MethodWithBreakpoints MethodWithBreakpoints stx:libbasic 'Kernel-Methods' 0
+OrderedDictionary OrderedDictionary stx:libbasic 'Collections-Sequenceable' 0
OsError OsError stx:libbasic 'OS-Support' 1
PluginSupport PluginSupport stx:libbasic 'System-Support' 0
ProceedableError ProceedableError stx:libbasic 'Kernel-Exceptions-Errors' 1
@@ -269,7 +264,6 @@
UnixFileDescriptorHandle UnixFileDescriptorHandle stx:libbasic 'OS-Unix' 0
UnixFileHandle UnixFileHandle stx:libbasic 'OS-Unix' 0
UnixOperatingSystem UnixOperatingSystem stx:libbasic 'OS-Unix' 0
-UserConfirmation UserConfirmation stx:libbasic 'Kernel-Exceptions-Notifications' 1
UserInformation UserInformation stx:libbasic 'Kernel-Exceptions-Notifications' 1
UtcTimestamp UtcTimestamp stx:libbasic 'Magnitude-Time' 0
VMInternalError VMInternalError stx:libbasic 'Kernel-Exceptions-Errors' 1
@@ -307,6 +301,7 @@
NoModificationError NoModificationError stx:libbasic 'Kernel-Exceptions-Errors' 1
NotFoundError NotFoundError stx:libbasic 'Kernel-Exceptions-Errors' 1
OSSignalInterrupt OSSignalInterrupt stx:libbasic 'Kernel-Exceptions-Control' 1
+OSXOperatingSystem OSXOperatingSystem stx:libbasic 'OS-Unix' 0
OsIllegalOperation OsIllegalOperation stx:libbasic 'OS-Support' 1
OsInaccessibleError OsInaccessibleError stx:libbasic 'OS-Support' 1
OsInvalidArgumentsError OsInvalidArgumentsError stx:libbasic 'OS-Support' 1
@@ -346,9 +341,12 @@
InvalidCodeError InvalidCodeError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
InvalidModeError InvalidModeError stx:libbasic 'Kernel-Exceptions-Errors' 1
InvalidOperationError InvalidOperationError stx:libbasic 'Kernel-Exceptions-Errors' 1
+InvalidTypeError InvalidTypeError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
KeyNotFoundError KeyNotFoundError stx:libbasic 'Kernel-Exceptions-Errors' 1
MallocFailure MallocFailure stx:libbasic 'System-Support' 1
+MethodNotAppropriateError MethodNotAppropriateError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
NonBooleanReceiverError NonBooleanReceiverError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
+NumberConversionError NumberConversionError stx:libbasic 'Magnitude-Numbers' 1
OpenError OpenError stx:libbasic 'Kernel-Exceptions-Errors' 1
PositionError PositionError stx:libbasic 'Kernel-Exceptions-Errors' 1
PositionOutOfBoundsError PositionOutOfBoundsError stx:libbasic 'Kernel-Exceptions-Errors' 1
@@ -365,6 +363,7 @@
WeakDependencyDictionary WeakDependencyDictionary stx:libbasic 'Collections-Weak' 0
WriteError WriteError stx:libbasic 'Kernel-Exceptions-Errors' 1
WrongProceedabilityError WrongProceedabilityError stx:libbasic 'Kernel-Exceptions-Errors' 1
+AbstractClassInstantiationError AbstractClassInstantiationError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
BadLiteralsError BadLiteralsError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
DecodingError DecodingError stx:libbasic 'Collections-Text-Encodings' 1
EncodingError EncodingError stx:libbasic 'Collections-Text-Encodings' 1
@@ -378,6 +377,7 @@
NoByteCodeError NoByteCodeError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
NonIntegerIndexError NonIntegerIndexError stx:libbasic 'Kernel-Exceptions-Errors' 1
NonPositionableExternalStream NonPositionableExternalStream stx:libbasic 'Streams-External' 0
+NumberFormatError NumberFormatError stx:libbasic 'Magnitude-Numbers' 1
OverflowError OverflowError stx:libbasic 'Kernel-Exceptions-Errors' 1
SubscriptOutOfBoundsError SubscriptOutOfBoundsError stx:libbasic 'Kernel-Exceptions-Errors' 1
Symbol Symbol stx:libbasic 'Collections-Text' 0
@@ -389,12 +389,4 @@
DirectoryStream DirectoryStream stx:libbasic 'Streams-External' 0
InvalidEncodingError InvalidEncodingError stx:libbasic 'Collections-Text-Encodings' 1
PipeStream PipeStream stx:libbasic 'Streams-External' 0
-MethodNotAppropriateError MethodNotAppropriateError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
-AbstractClassInstantiationError AbstractClassInstantiationError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
-InvalidTypeError InvalidTypeError stx:libbasic 'Kernel-Exceptions-ExecutionErrors' 1
-OSXOperatingSystem OSXOperatingSystem stx:libbasic 'OS-Unix' 0
-MethodOverrideTests MethodOverrideTests stx:libbasic '* as yet unknown category *' 0
-OrderedDictionary OrderedDictionary stx:libbasic 'Collections-Sequenceable' 0
-OrderedSet OrderedSet stx:libbasic 'Collections-Sequenceable' 0
-CascadingNotification CascadingNotification stx:libbasic 'Kernel-Exceptions' 1
-ProceedingNotification ProceedingNotification stx:libbasic 'Kernel-Exceptions' 1
+RomanNumberFormatError RomanNumberFormatError stx:libbasic 'Magnitude-Numbers' 1
--- a/bc.mak Sun Feb 02 00:13:55 2014 +0100
+++ b/bc.mak Sun Feb 02 14:16:24 2014 +0000
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/bc.mak,v 1.200 2013-08-24 12:29:12 cg Exp $
+# $Header$
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libbasic.
@@ -59,9 +59,15 @@
+
+test: $(TOP)\goodies\builder\reports\NUL
+ pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
+ $(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
+
clean::
del *.$(CSUFFIX)
+
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
$(OUTDIR)Autoload.$(O) Autoload.$(H): Autoload.st $(STCHDR)
$(OUTDIR)Object.$(O) Object.$(H): Object.st $(STCHDR)
@@ -99,6 +105,7 @@
$(OUTDIR)OSProcess.$(O) OSProcess.$(H): OSProcess.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ObjectMemory.$(O) ObjectMemory.$(H): ObjectMemory.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PackageId.$(O) PackageId.$(H): PackageId.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PolymorphicInlineCache.$(O) PolymorphicInlineCache.$(H): PolymorphicInlineCache.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ProcessorScheduler.$(O) ProcessorScheduler.$(H): ProcessorScheduler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ProgrammingLanguage.$(O) ProgrammingLanguage.$(H): ProgrammingLanguage.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)Project.$(O) Project.$(H): Project.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -286,7 +293,7 @@
$(OUTDIR)ByteArray.$(O) ByteArray.$(H): ByteArray.st $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)CharacterArray.$(O) CharacterArray.$(H): CharacterArray.st $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)CharacterWriteStream.$(O) CharacterWriteStream.$(H): CharacterWriteStream.st $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)Class.$(O) Class.$(H): Class.st $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Array.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Association.$(H) $(INCLUDE_TOP)\stx\libbasic\LookupKey.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(STCHDR)
+$(OUTDIR)Class.$(O) Class.$(H): Class.st $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Association.$(H) $(INCLUDE_TOP)\stx\libbasic\LookupKey.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Array.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(STCHDR)
$(OUTDIR)ContextError.$(O) ContextError.$(H): ContextError.st $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ConversionError.$(O) ConversionError.$(H): ConversionError.st $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)DeepCopyError.$(O) DeepCopyError.$(H): DeepCopyError.st $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -389,11 +396,14 @@
$(OUTDIR)DirectoryStream.$(O) DirectoryStream.$(H): DirectoryStream.st $(INCLUDE_TOP)\stx\libbasic\FileStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadWriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)InvalidEncodingError.$(O) InvalidEncodingError.$(H): InvalidEncodingError.st $(INCLUDE_TOP)\stx\libbasic\DecodingError.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderError.$(H) $(INCLUDE_TOP)\stx\libbasic\ConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PipeStream.$(O) PipeStream.$(H): PipeStream.st $(INCLUDE_TOP)\stx\libbasic\NonPositionableExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadWriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PCFilename.$(O) PCFilename.$(H): PCFilename.st $(STCHDR)
-$(OUTDIR)Win32Constants.$(O) Win32Constants.$(H): Win32Constants.st $(STCHDR)
-$(OUTDIR)Win32FILEHandle.$(O) Win32FILEHandle.$(H): Win32FILEHandle.st $(STCHDR)
-$(OUTDIR)Win32Handle.$(O) Win32Handle.$(H): Win32Handle.st $(STCHDR)
-$(OUTDIR)Win32OperatingSystem.$(O) Win32OperatingSystem.$(H): Win32OperatingSystem.st $(STCHDR)
-$(OUTDIR)Win32Process.$(O) Win32Process.$(H): Win32Process.st $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
+
+# **Must be at end**
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+!IFDEF HGROOT
+$(OUTDIR)stx_libbasic.$(O): $(HGROOT)\.hg\dirstate
+!ENDIF
--- a/bmake.bat Sun Feb 02 00:13:55 2014 +0100
+++ b/bmake.bat Sun Feb 02 14:16:24 2014 +0000
@@ -3,6 +3,10 @@
@REM type bmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
-make.exe -N -f bc.mak %*
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak %DEFINES% %*
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lcmake.bat Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using lcc compiler
+@REM type lcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak USELCC=1 %1 %2
+
+
--- a/libInit.cc Sun Feb 02 00:13:55 2014 +0100
+++ b/libInit.cc Sun Feb 02 14:16:24 2014 +0000
@@ -1,5 +1,5 @@
/*
- * $Header: /cvs/stx/stx/libbasic/libInit.cc,v 1.192 2013-08-24 12:29:46 cg Exp $
+ * $Header$
*
* DO NOT EDIT
* automagically generated from the projectDefinition: stx_libbasic.
@@ -63,6 +63,7 @@
_OSProcess_Init(pass,__pRT__,snd);
_ObjectMemory_Init(pass,__pRT__,snd);
_PackageId_Init(pass,__pRT__,snd);
+_PolymorphicInlineCache_Init(pass,__pRT__,snd);
_ProcessorScheduler_Init(pass,__pRT__,snd);
_ProgrammingLanguage_Init(pass,__pRT__,snd);
_Project_Init(pass,__pRT__,snd);
--- a/libbasic.rc Sun Feb 02 00:13:55 2014 +0100
+++ b/libbasic.rc Sun Feb 02 14:16:24 2014 +0000
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_libbasic.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 6,2,1,118
+ FILEVERSION 6,2,32767,32767
PRODUCTVERSION 6,2,3,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
@@ -20,12 +20,12 @@
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Basic Classes (LIB)\0"
- VALUE "FileVersion", "6.2.1.118\0"
+ VALUE "FileVersion", "6.2.32767.32767\0"
VALUE "InternalName", "stx:libbasic\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2013\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Sat, 24 Aug 2013 12:28:58 GMT\0"
+ VALUE "ProductDate", "Mon, 25 Nov 2013 16:42:51 GMT\0"
END
END
--- a/mingwmake.bat Sun Feb 02 00:13:55 2014 +0100
+++ b/mingwmake.bat Sun Feb 02 14:16:24 2014 +0000
@@ -3,10 +3,14 @@
@REM type mingwmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
@pushd ..\rules
@call find_mingw.bat
@popd
-make.exe -N -f bc.mak %USEMINGW_ARG% %*
+make.exe -N -f bc.mak %DEFINES% %USEMINGW_ARG% %*
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/not_delivered/.cvsignore Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,2 @@
+*.bad
+*.new
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/not_delivered/SysDict.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,316 @@
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Collection subclass:#SystemDictionary
+ instanceVariableNames:'sysId'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support'
+!
+
+!SystemDictionary class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/not_delivered/SysDict.st,v 1.1 1996/09/12 01:05:30 cg Exp $'
+!
+
+documentation
+"
+ SystemDictionaries are nameSpaces, which are also known in the c-world
+ somehow (i.e. names found in SystemDictionaries may also be known as
+ a c-global).
+
+ As you will notice, this is NOT a Dictionary
+ - my implementation of globals is totally different
+ (due to the need to be able to access globals from c-code as well).
+ However, it provides the known enumeration protocol.
+
+ Instance variables:
+ sysId <SmallInteger> the dictionaries id
+"
+! !
+
+!SystemDictionary methodsFor:'accessing'!
+
+at:aKey
+ "retrieve the value stored under aKey, which must be some kind of symbol.
+ Return nil if not present."
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_GET();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_GET(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+at:aKey ifAbsent:aBlock
+ "retrieve the value stored under aKey.
+ If there is none stored this key, return the value of
+ the evaluation of aBlock"
+
+ (self includesKey:aKey) ifTrue:[
+ ^ self at:aKey
+ ].
+ ^ aBlock value
+!
+
+at:aKey put:aValue
+ "store the argument aValue under aKey, which must be some kind of symbol."
+
+%{ /* NOCONTEXT */
+ if (__isSmallInteger(__INST(sysId))) {
+ _SYSDICT_SET(__intVal(__INST(sysId)), aKey, aValue, (OBJ *)0);
+ RETURN (aValue);
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+removeKey:aKey
+ "remove the argument from the globals dictionary"
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_REMOVE();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_REMOVE(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+includesKey:aKey
+ "return true, if the key is known"
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_KEYKNOWN();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_KEYKNOWN(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+keyAtValue:anObject
+ "return the symbol under which anObject is stored - or nil"
+
+ self allKeysDo:[:aKey |
+ (self at:aKey) == anObject ifTrue:[^ aKey]
+ ]
+
+ "Smalltalk keyAtValue:Object"
+!
+
+keys
+ "return a collection with all keys in the Smalltalk dictionary"
+
+ |keys|
+
+ keys := IdentitySet new.
+ self allKeysDo:[:k | keys add:k].
+ ^ keys
+! !
+
+!SystemDictionary class methodsFor:'copying'!
+
+shallowCopy
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+!
+
+simpleDeepCopy
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+!
+
+deepCopyUsing:aDictionary
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+!
+
+deepCopy
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+! !
+
+!SystemDictionary methodsFor:'inspecting'!
+
+inspect
+ "redefined to launch a DictionaryInspector on the receiver
+ (instead of the default InspectorView)."
+
+ DictionaryInspectorView isNil ifTrue:[
+ super inspect
+ ] ifFalse:[
+ DictionaryInspectorView openOn:self
+ ]
+! !
+
+!SystemDictionary methodsFor:'enumeration'!
+
+do:aBlock
+ "evaluate the argument, aBlock for all values in the dictionary"
+%{
+ if (__isSmallInteger(__INST(sysId))) {
+ _SYSDICT_DO(__intVal(__INST(sysId)), &aBlock COMMA_CON);
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+
+ "
+ Smalltalk do:[:value | value class name printNL]
+ "
+!
+
+allKeysDo:aBlock
+ "evaluate the argument, aBlock for all keys in the dictionary"
+%{
+ if (__isSmallInteger(__INST(sysId))) {
+ _SYSDICT_KEYSDO(__intVal(__INST(sysId)), &aBlock COMMA_CON);
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+
+ "
+ Smalltalk allKeysDo:[:key | key printNL]
+ "
+!
+
+associationsDo:aBlock
+ "evaluate the argument, aBlock for all key/value pairs
+ in the dictionary"
+
+ self allKeysDo:[:aKey |
+ aBlock value:(aKey -> (self at:aKey))
+ ]
+
+ "
+ Smalltalk associationsDo:[:assoc | assoc printNL]
+ "
+!
+
+keysAndValuesDo:aBlock
+ "evaluate the two-arg block, aBlock for all keys and values"
+
+ self allKeysDo:[:aKey |
+ aBlock value:aKey value:(self at:aKey)
+ ]
+! !
+
+!SystemDictionary methodsFor:'queries'!
+
+cellAt:aKey
+ "return the address of a global cell
+ - used internally for compiler only"
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_GETCELL();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_GETCELL(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+references:anObject
+ "return true, if I refer to the argument, anObject
+ must be reimplemented since systemDictionaries are no real collections."
+
+ self do:[:o |
+ (o == anObject) ifTrue:[^ true]
+ ].
+ ^ false
+! !
+
+!SystemDictionary class methodsFor: 'binary storage'!
+
+addGlobalsTo:globalDictionary manager: manager
+ |pools|
+
+ pools := Set new.
+ self associationsDo:[:assoc |
+ |value|
+
+ value := assoc value.
+ value == self ifFalse:[
+ value isClass ifTrue:[
+ value addGlobalsTo:globalDictionary manager:manager.
+ pools addAll:value sharedPools
+ ] ifFalse:[
+ globalDictionary at:assoc put:self
+ ].
+ value isNil ifFalse:[
+ globalDictionary at:value put:self
+ ]
+ ]
+ ].
+
+ pools do:[:poolDictionary|
+ poolDictionary addGlobalsTo:globalDictionary manager:manager
+ ]
+!
+
+storeBinaryDefinitionOf:anObject on:stream manager:manager
+ |string|
+
+ anObject class == Association ifTrue:[
+ string := 'Smalltalk associationAt:', anObject key storeString
+ ] ifFalse: [
+ string := 'Smalltalk at:', (self keyAtValue: anObject) storeString
+ ].
+ stream nextNumber:2 put:string size.
+ string do:[:char | stream nextPut:char asciiValue]
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/not_delivered/SystemDictionary.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,321 @@
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Collection subclass:#SystemDictionary
+ instanceVariableNames:'sysId'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support'
+!
+
+!SystemDictionary class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/not_delivered/SysDict.st,v 1.1 1996/09/12 01:05:30 cg Exp $'
+!
+
+documentation
+"
+ SystemDictionaries are nameSpaces, which are also known in the c-world
+ somehow (i.e. names found in SystemDictionaries may also be known as
+ a c-global).
+
+ As you will notice, this is NOT a Dictionary
+ - my implementation of globals is totally different
+ (due to the need to be able to access globals from c-code as well).
+ However, it provides the known enumeration protocol.
+
+ Instance variables:
+ sysId <SmallInteger> the dictionaries id
+"
+! !
+
+!SystemDictionary methodsFor:'accessing'!
+
+at:aKey
+ "retrieve the value stored under aKey, which must be some kind of symbol.
+ Return nil if not present."
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_GET();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_GET(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+at:aKey ifAbsent:aBlock
+ "retrieve the value stored under aKey.
+ If there is none stored this key, return the value of
+ the evaluation of aBlock"
+
+ (self includesKey:aKey) ifTrue:[
+ ^ self at:aKey
+ ].
+ ^ aBlock value
+!
+
+at:aKey put:aValue
+ "store the argument aValue under aKey, which must be some kind of symbol."
+
+%{ /* NOCONTEXT */
+ if (__isSmallInteger(__INST(sysId))) {
+ _SYSDICT_SET(__intVal(__INST(sysId)), aKey, aValue, (OBJ *)0);
+ RETURN (aValue);
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+removeKey:aKey
+ "remove the argument from the globals dictionary"
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_REMOVE();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_REMOVE(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+includesKey:aKey
+ "return true, if the key is known"
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_KEYKNOWN();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_KEYKNOWN(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+keyAtValue:anObject
+ "return the symbol under which anObject is stored - or nil"
+
+ self allKeysDo:[:aKey |
+ (self at:aKey) == anObject ifTrue:[^ aKey]
+ ]
+
+ "Smalltalk keyAtValue:Object"
+!
+
+keys
+ "return a collection with all keys in the Smalltalk dictionary"
+
+ |keys|
+
+ keys := IdentitySet new.
+ self allKeysDo:[:k | keys add:k].
+ ^ keys
+! !
+
+!SystemDictionary class methodsFor:'copying'!
+
+shallowCopy
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+!
+
+simpleDeepCopy
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+!
+
+deepCopyUsing:aDictionary
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+!
+
+deepCopy
+ "redefine copy - there is only one instance of each dictionary"
+
+ ^ self
+! !
+
+!SystemDictionary methodsFor:'inspecting'!
+
+inspect
+ "redefined to launch a DictionaryInspector on the receiver
+ (instead of the default InspectorView)."
+
+ DictionaryInspectorView isNil ifTrue:[
+ super inspect
+ ] ifFalse:[
+ DictionaryInspectorView openOn:self
+ ]
+! !
+
+!SystemDictionary methodsFor:'enumeration'!
+
+do:aBlock
+ "evaluate the argument, aBlock for all values in the dictionary"
+%{
+ if (__isSmallInteger(__INST(sysId))) {
+ _SYSDICT_DO(__intVal(__INST(sysId)), &aBlock COMMA_CON);
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+
+ "
+ Smalltalk do:[:value | value class name printNL]
+ "
+!
+
+allKeysDo:aBlock
+ "evaluate the argument, aBlock for all keys in the dictionary"
+%{
+ if (__isSmallInteger(__INST(sysId))) {
+ _SYSDICT_KEYSDO(__intVal(__INST(sysId)), &aBlock COMMA_CON);
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+
+ "
+ Smalltalk allKeysDo:[:key | key printNL]
+ "
+!
+
+associationsDo:aBlock
+ "evaluate the argument, aBlock for all key/value pairs
+ in the dictionary"
+
+ self allKeysDo:[:aKey |
+ aBlock value:(aKey -> (self at:aKey))
+ ]
+
+ "
+ Smalltalk associationsDo:[:assoc | assoc printNL]
+ "
+!
+
+keysAndValuesDo:aBlock
+ "evaluate the two-arg block, aBlock for all keys and values"
+
+ self allKeysDo:[:aKey |
+ aBlock value:aKey value:(self at:aKey)
+ ]
+! !
+
+!SystemDictionary methodsFor:'queries'!
+
+cellAt:aKey
+ "return the address of a global cell
+ - used internally for compiler only"
+
+%{ /* NOCONTEXT */
+ extern OBJ _SYSDICT_GETCELL();
+
+ if (__isSmallInteger(__INST(sysId))) {
+ RETURN ( _SYSDICT_GETCELL(__intVal(__INST(sysId)), aKey) );
+ }
+%}.
+ "
+ the receiver is not a valid systemDictionary
+ "
+ self pimitiveFailed
+!
+
+references:anObject
+ "return true, if I refer to the argument, anObject
+ must be reimplemented since systemDictionaries are no real collections."
+
+ self do:[:o |
+ (o == anObject) ifTrue:[^ true]
+ ].
+ ^ false
+! !
+
+!SystemDictionary class methodsFor: 'binary storage'!
+
+addGlobalsTo:globalDictionary manager: manager
+ |pools|
+
+ pools := Set new.
+ self associationsDo:[:assoc |
+ |value|
+
+ value := assoc value.
+ value == self ifFalse:[
+ value isClass ifTrue:[
+ value addGlobalsTo:globalDictionary manager:manager.
+ pools addAll:value sharedPools
+ ] ifFalse:[
+ globalDictionary at:assoc put:self
+ ].
+ value isNil ifFalse:[
+ globalDictionary at:value put:self
+ ]
+ ]
+ ].
+
+ pools do:[:poolDictionary|
+ poolDictionary addGlobalsTo:globalDictionary manager:manager
+ ]
+!
+
+storeBinaryDefinitionOf:anObject on:stream manager:manager
+ |string|
+
+ anObject class == Association ifTrue:[
+ string := 'Smalltalk associationAt:', anObject key storeString
+ ] ifFalse: [
+ string := 'Smalltalk at:', (self keyAtValue: anObject) storeString
+ ].
+ stream nextNumber:2 put:string size.
+ string do:[:char | stream nextPut:char asciiValue]
+! !
+
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/not_delivered/VMBehavior.st Sun Feb 02 14:16:24 2014 +0000
@@ -0,0 +1,615 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Object subclass:#VMBehavior
+ instanceVariableNames:'superclass flags selectorArray methodArray'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
+!
+
+!VMBehavior class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ This class describes what the VM considers to be a classLike object.
+ Every class in the system inherits from VMBehavior (via Behavior, Class, ClassDescription).
+
+ In contrast to Behavior (which describes smalltalk behavior), the things defined
+ here are valid for all objects for which the VM can do a method lookup.
+ In theory, you can create totally different object systems on top of VMBehavior.
+ This class is purely abstract - therefore, no smalltalk behavior is defined here.
+
+ This is certainly not for normal applications.
+
+ Instance variables:
+
+ superclass <Class> where lookup continues when a selector is not
+ found in the selector array
+ (i.e. the superclass in Smalltalk terms)
+
+ selectorArray <Array of Symbol> the selectors for which inst-methods are defined here
+
+ methodArray <Array of Method> the inst-methods corresponding to the selectors
+
+ flags <SmallInteger> special flag bits coded in a number
+ not for application use
+
+ flag bits (see stc.h):
+
+ NOTICE: layout known by compiler and runtime system; be careful when changing
+"
+! !
+
+!VMBehavior class methodsFor:'initialization'!
+
+initialize
+ self == VMBehavior ifTrue:[
+ self flags:(self flagBehavior).
+ ]
+
+ "
+ self initialize
+ "
+! !
+
+!VMBehavior class methodsFor:'flag bit constants'!
+
+flagBehavior
+ "return the flag code which marks Behavior-like instances.
+ You have to check this single bit in the flag value when
+ checking for behaviors."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(BEHAVIOR_INSTS) );
+%}
+
+ "consistency check:
+ all class-entries must be behaviors;
+ all behaviors must be flagged so (in its class's flags)
+ (otherwise, VM will bark)
+ all non-behaviors may not be flagged
+
+ |bit|
+ bit := Class flagBehavior.
+
+ ObjectMemory allObjectsDo:[:o|
+ o isBehavior ifTrue:[
+ (o class flags bitTest:bit) ifFalse:[
+ self halt
+ ].
+ ] ifFalse:[
+ (o class flags bitTest:bit) ifTrue:[
+ self halt
+ ].
+ ].
+ o class isBehavior ifFalse:[
+ self halt
+ ] ifTrue:[
+ (o class class flags bitTest:bit) ifFalse:[
+ self halt
+ ]
+ ]
+ ]
+ "
+!
+
+flagBlock
+ "return the flag code which marks Block-like instances.
+ You have to check this single bit in the flag value when
+ checking for blocks."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(BLOCK_INSTS) );
+%}
+!
+
+flagBlockContext
+ "return the flag code which marks BlockContext-like instances.
+ You have to check this single bit in the flag value when
+ checking for blockContexts."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(BCONTEXT_INSTS) );
+%}
+!
+
+flagBytes
+ "return the flag code for byte-valued indexed instances.
+ You have to mask the flag value with indexMask when comparing
+ it with flagBytes."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(BYTEARRAY) );
+%}
+ "
+ Behavior flagBytes
+ "
+!
+
+flagContext
+ "return the flag code which marks Context-like instances.
+ You have to check this single bit in the flag value when
+ checking for contexts."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(CONTEXT_INSTS) );
+%}
+!
+
+flagDoubles
+ "return the flag code for double-valued indexed instances (i.e. 8-byte reals).
+ You have to mask the flag value with indexMask when comparing
+ it with flagDoubles."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(DOUBLEARRAY) );
+%}
+ "
+ Behavior flagDoubles
+ "
+!
+
+flagFloat
+ "return the flag code which marks Float-like instances.
+ You have to check this single bit in the flag value when
+ checking for floats."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(FLOAT_INSTS) );
+%}
+!
+
+flagFloats
+ "return the flag code for float-valued indexed instances (i.e. 4-byte reals).
+ You have to mask the flag value with indexMask when comparing
+ it with flagFloats."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(FLOATARRAY) );
+%}
+ "
+ Behavior flagFloats
+ "
+!
+
+flagLongs
+ "return the flag code for long-valued indexed instances (i.e. 4-byte).
+ You have to mask the flag value with indexMask when comparing
+ it with flagLongs."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(LONGARRAY) );
+%}
+ "
+ Behavior flagLongs
+ "
+!
+
+flagMethod
+ "return the flag code which marks Method-like instances.
+ You have to check this single bit in the flag value when
+ checking for methods."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(METHOD_INSTS) );
+%}
+!
+
+flagNotIndexed
+ "return the flag code for non-indexed instances.
+ You have to mask the flag value with indexMask when comparing
+ it with flagNotIndexed."
+
+ ^ 0
+!
+
+flagPointers
+ "return the flag code for pointer indexed instances (i.e. Array of object).
+ You have to mask the flag value with indexMask when comparing
+ it with flagPointers."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(POINTERARRAY) );
+%}
+ "
+ Behavior flagPointers
+ "
+!
+
+flagSymbol
+ "return the flag code which marks Symbol-like instances.
+ You have to check this single bit in the flag value when
+ checking for symbols."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(SYMBOL_INSTS) );
+%}
+!
+
+flagWeakPointers
+ "return the flag code for weak pointer indexed instances (i.e. WeakArray).
+ You have to mask the flag value with indexMask when comparing
+ it with flagWeakPointers."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(WKPOINTERARRAY) );
+%}
+!
+
+flagWords
+ "return the flag code for word-valued indexed instances (i.e. 2-byte).
+ You have to mask the flag value with indexMask when comparing
+ it with flagWords."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(WORDARRAY) );
+%}
+ "
+ Behavior flagWords
+ "
+!
+
+maskIndexType
+ "return a mask to extract all index-type bits"
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( _MKSMALLINT(ARRAYMASK) );
+%}
+! !
+
+!VMBehavior class methodsFor:'private'!
+
+basicNew
+ "I dont know how to do this ..."
+
+ ^ self subclassResponsibility
+!
+
+basicNew:size
+ "I dont know how to do this ..."
+
+ ^ self subclassResponsibility
+!
+
+new
+ "I dont know how to do this ..."
+
+ ^ self subclassResponsibility
+!
+
+new:size
+ "I dont know how to do this ..."
+
+ ^ self subclassResponsibility
+! !
+
+!VMBehavior class methodsFor:'queries'!
+
+isBuiltInClass
+ "this class is known by the run-time-system"
+
+ ^ true
+! !
+
+!VMBehavior methodsFor:'accessing'!
+
+flags
+ "return the receivers flag bits"
+
+ ^ flags
+!
+
+methodArray
+ "return the receivers method array.
+ Notice: this is not compatible with ST-80."
+
+ ^ methodArray
+!
+
+selectorArray
+ "return the receivers selector array.
+ Notice: this is not compatible with ST-80."
+
+ ^ selectorArray
+!
+
+selectors:newSelectors methods:newMethods
+ "set both selector array and method array of the receiver,
+ and flush caches"
+
+ ObjectMemory flushCaches.
+ selectorArray := newSelectors.
+ methodArray := newMethods
+!
+
+superclass
+ "return the receivers superclass"
+
+ ^ superclass
+! !
+
+!VMBehavior methodsFor:'private accessing'!
+
+setFlags:aNumber
+ "set the flags.
+ Do NOT use it."
+
+ flags := aNumber
+!
+
+setMethodArray:anArray
+ "set the method array of the receiver.
+ this method is for special uses only - there will be no recompilation
+ and no change record written here.
+ NOT for general use."
+
+ methodArray := anArray
+!
+
+setSelectorArray:anArray
+ "set the selector array of the receiver.
+ this method is for special uses only - there will be no recompilation
+ and no change record written here.
+ NOT for general use."
+
+ selectorArray := anArray
+!
+
+setSelectors:sels methods:m
+ "set some inst vars.
+ this method is for special uses only - there will be no recompilation
+ and no change record written here;
+ Do NOT use it."
+
+ selectorArray := sels.
+ methodArray := m.
+!
+
+setSuperclass:aClass
+ "set the superclass of the receiver.
+ this method is for special uses only - there will be no recompilation
+ and no change record written here. Also, if the receiver class has
+ already been in use, future operation of the system is not guaranteed to
+ be correct, since no caches are flushed.
+ Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
+
+ superclass := aClass
+! !
+
+!VMBehavior methodsFor:'queries'!
+
+cachedLookupMethodFor:aSelector
+ "return the method, which would be executed if aSelector was sent to
+ an instance of the receiver. I.e. the selector arrays of the receiver
+ and all of its superclasses are searched for aSelector.
+ Return the method, or nil if instances do not understand aSelector.
+ This interface provides exactly the same information as #lookupMethodFor:,
+ but uses the lookup-cache in the VM for faster search.
+ However, keep in mind, that doing a lookup through the cache also adds new
+ entries and can thus slow down the system by polluting the cache with
+ irrelevant entries. (do NOT loop over all objects calling this method).
+ Does NOT (currently) handle MI"
+
+%{ /* NOCONTEXT */
+ RETURN ( __lookup(self, aSelector, SENDER) );
+%}
+
+ "
+ String cachedLookupMethodFor:#=
+ String cachedLookupMethodFor:#asOrderedCollection
+ "
+!
+
+isBits
+ "return true, if instances have indexed byte or short instance variables.
+ Ignore long, float and double arrays, since ST-80 code using isBits are probably
+ not prepared to handle them correctly."
+
+%{ /* NOCONTEXT */
+
+ REGISTER int flags;
+
+ RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == BYTEARRAY)
+ || (flags == WORDARRAY)) ? true : false );
+%}
+!
+
+isBytes
+ "return true, if instances have indexed byte instance variables"
+
+ "this could be defined as:
+ ^ (flags bitAnd:(VMBehavior maskIndexType)) == VMBehavior flagBytes
+ "
+%{ /* NOCONTEXT */
+
+ RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == BYTEARRAY) ? true : false );
+%}
+!
+
+isDoubles
+ "return true, if instances have indexed double instance variables"
+
+ "this could be defined as:
+ ^ (flags bitAnd:(VMBehavior maskIndexType)) == VMBehavior flagDoubles
+ "
+%{ /* NOCONTEXT */
+
+ RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == DOUBLEARRAY) ? true : false );
+%}
+!
+
+isFixed
+ "return true, if instances do not have indexed instance variables"
+
+ "this could be defined as:
+ ^ self isVariable not
+ "
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? false : true );
+%}
+!
+
+isFloats
+ "return true, if instances have indexed float instance variables"
+
+ "this could be defined as:
+ ^ (flags bitAnd:(VMBehavior maskIndexType)) == VMBehavior flagFloats
+ "
+%{ /* NOCONTEXT */
+
+ RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == FLOATARRAY) ? true : false );
+%}
+!
+
+isLongs
+ "return true, if instances have indexed long instance variables"
+
+ "this could be defined as:
+ ^ (flags bitAnd:(VMBehavior maskIndexType)) == VMBehavior flagLongs
+ "
+%{ /* NOCONTEXT */
+
+ RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == LONGARRAY) ? true : false );
+%}
+!
+
+isPointers
+ "return true, if instances have pointer instance variables
+ i.e. are either non-indexed or have indexed pointer variables"
+
+ "QUESTION: should we ignore WeakPointers ?"
+
+%{ /* NOCONTEXT */
+
+ REGISTER int flags;
+
+ flags = _intVal(_INST(flags)) & ARRAYMASK;
+ switch (flags) {
+ default:
+ /* normal objects */
+ RETURN ( true );
+
+ case BYTEARRAY:
+ case WORDARRAY:
+ case LONGARRAY:
+ case FLOATARRAY:
+ case DOUBLEARRAY:
+ RETURN (false );
+
+ case WKPOINTERARRAY:
+ /* what about those ? */
+ RETURN (true );
+ }
+%}
+!
+
+isVariable
+ "return true, if instances have indexed instance variables"
+
+ "this could be defined as:
+ ^ (flags bitAnd:(VMBehavior maskIndexType)) ~~ 0
+ "
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? true : false );
+%}
+!
+
+isWords
+ "return true, if instances have indexed short instance variables"
+
+ "this could be defined as:
+ ^ (flags bitAnd:(VMBehavior maskIndexType)) == VMBehavior flagWords
+ "
+%{ /* NOCONTEXT */
+
+ RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == WORDARRAY) ? true : false );
+%}
+!
+
+lookupMethodFor:aSelector
+ "return the method, which would be executed if aSelector was sent to
+ an instance of the receiver. I.e. the selector arrays of the receiver
+ and all of its superclasses are searched for aSelector.
+ Return the method, or nil if instances do not understand aSelector.
+ EXPERIMENTAL: take care of multiple superclasses."
+
+ |m cls|
+
+ cls := self.
+ [cls notNil] whileTrue:[
+ m := cls compiledMethodAt:aSelector.
+ m notNil ifTrue:[^ m].
+ cls := cls superclass
+ ].
+ ^ nil
+! !
+
+!VMBehavior class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/not_delivered/VMBehavior.st,v 1.1 1996/09/12 01:03:24 cg Exp $'
+! !
+VMBehavior initialize!
+
+
+
+
+
--- a/resources/af.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/af.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/af.rs,v 1.3 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/af.rs,v 1.3 2004/03/15 16:39:09 cg Exp $
;
; Afrikaans strings
;
@@ -48,3 +48,10 @@
'oct' 'okt'
'nov' 'nov'
'dec' 'des'
+
+
+
+
+
+
+
--- a/resources/el.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/el.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-7
-; $Header: /cvs/stx/stx/libbasic/resources/el.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/el.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Greek strings
;
@@ -48,3 +48,10 @@
'oct' ''
'nov' ''
'dec' ''
+
+
+
+
+
+
+
--- a/resources/eo.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/eo.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding utf8
-; $Header: /cvs/stx/stx/libbasic/resources/eo.rs,v 1.3 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/eo.rs,v 1.3 2004/03/15 16:39:09 cg Exp $
;
; Esperanto strings
;
@@ -48,3 +48,10 @@
'oct' 'okt'
; 'nov' 'nov'
; 'dec' 'dec'
+
+
+
+
+
+
+
--- a/resources/fr.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/fr.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/fr.rs,v 1.3 2008-02-05 12:23:42 sr Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/fr.rs,v 1.3 2008/02/05 12:23:42 sr Exp $
;
; French strings
;
@@ -50,3 +50,10 @@
'oct' 'oct'
'nov' 'nov'
'dec' 'dc'
+
+
+
+
+
+
+
--- a/resources/hu.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/hu.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding utf-8
-; $Header: /cvs/stx/stx/libbasic/resources/hu.rs,v 1.2 2006-10-23 10:20:55 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/hu.rs,v 1.2 2006/10/23 10:20:55 cg Exp $
;
; Hungarian strings
;
@@ -48,3 +48,10 @@
'oct' 'okt'
'nov' 'nov'
'dec' 'dec'
+
+
+
+
+
+
+
--- a/resources/it.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/it.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/it.rs,v 1.4 2006-10-28 14:11:17 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/it.rs,v 1.4 2006/10/28 14:11:17 cg Exp $
;
; Italian strings
;
@@ -54,3 +54,10 @@
'oct' 'ott'
'nov' 'nov'
'dec' 'dic'
+
+
+
+
+
+
+
--- a/resources/ja.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/ja.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding utf-8
-; $Header: /cvs/stx/stx/libbasic/resources/ja.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/ja.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Japanese strings
;
@@ -59,3 +59,10 @@
'fri' '金曜'
'sat' '土曜'
'sun' '日曜'
+
+
+
+
+
+
+
--- a/resources/nl.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/nl.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/nl.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/nl.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Dutch strings
;
@@ -48,3 +48,10 @@
'oct' 'okt'
'nov' 'nov'
'dec' 'dec'
+
+
+
+
+
+
+
--- a/resources/no.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/no.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/no.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/no.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Norwegian strings
;
@@ -48,3 +48,10 @@
'oct' 'okt'
'nov' 'nov'
'dec' 'des'
+
+
+
+
+
+
+
--- a/resources/pt.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/pt.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/pt.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/pt.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Portuguese strings
;
@@ -49,3 +49,10 @@
'oct' 'out'
'nov' 'nov'
'dec' 'dez'
+
+
+
+
+
+
+
--- a/resources/resources.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/resources.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,7 +1,7 @@
#encoding ascii
;
-; $Header: /cvs/stx/stx/libbasic/resources/resources.rs,v 1.8 2008-11-28 16:44:55 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/resources.rs,v 1.8 2008/11/28 16:44:55 cg Exp $
;
#if Language == #af
@@ -128,3 +128,10 @@
#else
'TIME_FORMAT' ? 24
#endif
+
+
+
+
+
+
+
--- a/resources/ro.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/ro.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-2
-; $Header: /cvs/stx/stx/libbasic/resources/ro.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/ro.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Romanian strings
;
@@ -48,3 +48,10 @@
'oct' 'oct'
'nov' 'noi'
'dec' 'dec'
+
+
+
+
+
+
+
--- a/resources/ru.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/ru.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-5
-; $Header: /cvs/stx/stx/libbasic/resources/ru.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/ru.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Russian strings
;
@@ -48,3 +48,10 @@
'oct' '' "/ ???
'nov' '' "/ ???
'dec' '' "/ ???
+
+
+
+
+
+
+
--- a/resources/sv.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/sv.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/sv.rs,v 1.3 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/sv.rs,v 1.3 2004/03/15 16:39:09 cg Exp $
;
; Swedish strings
;
@@ -52,3 +52,10 @@
'oct' 'okt'
'nov' 'nov'
'dec' 'dec'
+
+
+
+
+
+
+
--- a/resources/tr.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/tr.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding iso8859-1
-; $Header: /cvs/stx/stx/libbasic/resources/tr.rs,v 1.2 2004-03-15 16:39:09 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/tr.rs,v 1.2 2004/03/15 16:39:09 cg Exp $
;
; Turkish strings
;
@@ -48,3 +48,10 @@
'oct' 'eki'
'nov' 'kas'
'dec' 'ara'
+
+
+
+
+
+
+
--- a/resources/zh.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/zh.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding utf8
-; $Header: /cvs/stx/stx/libbasic/resources/zh.rs,v 1.2 2008-11-28 16:44:28 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/zh.rs,v 1.2 2008/11/28 16:44:28 cg Exp $
;
; Chinese simplified
; extracted from google by claus - can someone proofread, please.
@@ -48,3 +48,10 @@
'oct' '十月'
'nov' '十一月'
'dec' '十二月'
+
+
+
+
+
+
+
--- a/resources/zh_trad.rs Sun Feb 02 00:13:55 2014 +0100
+++ b/resources/zh_trad.rs Sun Feb 02 14:16:24 2014 +0000
@@ -1,6 +1,6 @@
#encoding utf8
-; $Header: /cvs/stx/stx/libbasic/resources/zh_trad.rs,v 1.2 2008-11-28 16:50:03 cg Exp $
+; $Header: /cvs/stx/stx/libbasic/resources/zh_trad.rs,v 1.2 2008/11/28 16:50:03 cg Exp $
;
; Chinese traditional
; this file contains 8bit national characters;
@@ -9,3 +9,10 @@
#include 'zh.rs'
; please redefine any differences to traditional chinese below
+
+
+
+
+
+
+
--- a/stx_libbasic.st Sun Feb 02 00:13:55 2014 +0100
+++ b/stx_libbasic.st Sun Feb 02 14:16:24 2014 +0000
@@ -11,7 +11,7 @@
"
"{ Package: 'stx:libbasic' }"
-LibraryDefinition subclass:#stx_libbasic
+LibraryDefinition subclass:#'stx_libbasic'
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -48,25 +48,25 @@
preRequisites scan. See #preRequisites for more."
^ #(
- #'exept:ctypes' "CType - referenced by ExternalLibraryFunction>>ffiTypeSymbolForType: "
- #'exept:expecco' "Expecco::ExpeccoXMLDecoder - referenced by ClassDescription>>iconInBrowserForVariableNamed: "
- #'exept:libcrypt' "HashRandom - referenced by HashStream class>>random "
- #'stx:goodies' "LockedFileStream - referenced by ClassDescription>>changesStream "
- #'stx:goodies/simpleServices' "STXScriptingServer - referenced by StandaloneStartup class>>handleScriptingOptionsFromArguments: "
- #'stx:goodies/sunit' "TestRunner - referenced by UserPreferences>>testRunnerClass "
- #'stx:goodies/xml/stx' "XMLCoder - referenced by ClassDescription>>fileOutXMLString:on: "
- #'stx:goodies/xml/vw' "XML::XMLParser - referenced by PeekableStream>>fileInXMLNotifying:passChunk: "
- #'stx:libbasic2' "List - referenced by Collection>>asList "
- #'stx:libbasic3' "ClassOrganizer - referenced by ClassDescription>>organization "
- #'stx:libboss' "BinaryObjectStorage - referenced by PeekableStream>>fileInBinary "
- #'stx:libcomp' "Parser - referenced by CharacterArray>>isValidSmalltalkIdentifier "
- #'stx:libcompat' "Dolphin::ClassCategoriesReader - referenced by ClassDescription>>categoriesForClass "
- #'stx:libhtml' "URL - referenced by CharacterArray>>asURL "
- #'stx:libtool' "Tools::ToDoListBrowser - referenced by ClassBuilder>>checkInstvarRedefsWith:subclassOf:old:name: "
- #'stx:libview' "Image - referenced by UserPreferences class>>saveSettings:in: "
- #'stx:libview2' "ApplicationModel - referenced by ApplicationDefinition class>>startupClassName_code "
- #'stx:libwidg' "Button - referenced by UserPreferences class>>saveSettings:in: "
- #'stx:libwidg2' "ProgressNotification - referenced by UserNotification class>>notify:progress: "
+ #'exept:ctypes' "CType - referenced by ExternalLibraryFunction>>ffiTypeSymbolForType: "
+ #'exept:expecco' "Expecco::ExpeccoXMLDecoder - referenced by ClassDescription>>iconInBrowserForVariableNamed: "
+ #'exept:libcrypt' "HashRandom - referenced by HashStream class>>random "
+ #'stx:goodies' "LockedFileStream - referenced by ClassDescription>>changesStream "
+ #'stx:goodies/simpleServices' "STXScriptingServer - referenced by StandaloneStartup class>>handleScriptingOptionsFromArguments: "
+ #'stx:goodies/sunit' "TestRunner - referenced by UserPreferences>>testRunnerClass "
+ #'stx:goodies/xml/stx' "XMLCoder - referenced by ClassDescription>>fileOutXMLString:on: "
+ #'stx:goodies/xml/vw' "XML::XMLParser - referenced by PeekableStream>>fileInXMLNotifying:passChunk: "
+ #'stx:libbasic2' "List - referenced by Collection>>asList "
+ #'stx:libbasic3' "ClassOrganizer - referenced by ClassDescription>>organization "
+ #'stx:libboss' "BinaryObjectStorage - referenced by PeekableStream>>fileInBinary "
+ #'stx:libcomp' "Parser - referenced by CharacterArray>>isValidSmalltalkIdentifier "
+ #'stx:libcompat' "Dolphin::ClassCategoriesReader - referenced by ClassDescription>>categoriesForClass "
+ #'stx:libhtml' "URL - referenced by CharacterArray>>asURL "
+ #'stx:libtool' "Tools::ToDoListBrowser - referenced by ClassBuilder>>checkInstvarRedefsWith:subclassOf:old:name: "
+ #'stx:libview' "Image - referenced by UserPreferences class>>saveSettings:in: "
+ #'stx:libview2' "ApplicationModel - referenced by ApplicationDefinition class>>startupClassName_code "
+ #'stx:libwidg' "Button - referenced by UserPreferences class>>saveSettings:in: "
+ #'stx:libwidg2' "ProgressNotification - referenced by UserNotification class>>notify:progress: "
)
!
@@ -96,15 +96,7 @@
)
!
-subProjects
- "list packages which are known as subprojects.
- The generated makefile will enter those and make there as well.
- However: they are not forced to be loaded when a package is loaded;
- for those, redefine requiredPrerequisites"
-
- ^ #(
- )
-! !
+ !
!stx_libbasic class methodsFor:'description - compilation'!
@@ -222,10 +214,10 @@
OSErrorHolder
OSProcess
ObjectMemory
- (OpenVMSFileHandle vms)
- (OpenVMSFilename vms)
- (OpenVMSOperatingSystem vms)
- (PCFilename win32)
+ (OpenVMSFileHandle vms )
+ (OpenVMSFilename vms )
+ (OpenVMSOperatingSystem vms )
+ (PCFilename win32 )
PackageId
ProcessorScheduler
ProgrammingLanguage
@@ -252,11 +244,11 @@
UserMessage
Visitor
(WeakValueIdentityDictionary autoload)
- (Win32Constants win32)
- (Win32FILEHandle win32)
- (Win32Handle win32)
- (Win32OperatingSystem win32)
- (Win32Process win32)
+ (Win32Constants win32 )
+ (Win32FILEHandle win32 )
+ (Win32Handle win32 )
+ (Win32OperatingSystem win32 )
+ (Win32Process win32 )
(WindowsDesktop autoload)
(XDGDesktop autoload)
AbstractTime
@@ -531,10 +523,8 @@
MethodNotAppropriateError
AbstractClassInstantiationError
InvalidTypeError
+ (#'CharacterEncoderImplementations::ISO10646_to_XMLUTF8' autoload)
(OSXOperatingSystem unix)
- (MethodOverrideTests autoload)
- OrderedDictionary
- OrderedSet
CascadingNotification
ProceedingNotification
)
--- a/vcmake.bat Sun Feb 02 00:13:55 2014 +0100
+++ b/vcmake.bat Sun Feb 02 14:16:24 2014 +0000
@@ -9,6 +9,12 @@
call vcsetup.bat
popd
)
-make.exe -N -f bc.mak -DUSEVC %*
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
+
+
--- a/vms.mak Sun Feb 02 00:13:55 2014 +0100
+++ b/vms.mak Sun Feb 02 14:16:24 2014 +0000
@@ -2,7 +2,7 @@
# DO NOT EDIT
# automatically generated from Make.proto
#
-# $Header: /cvs/stx/stx/libbasic/vms.mak,v 1.9 2001-10-31 15:02:19 cg Exp $
+# $Header: /cvs/stx/stx/libbasic/vms.mak,v 1.9 2001/10/31 15:02:19 cg Exp $
#
TOP=..
LIBNAME=libbasic
@@ -296,3 +296,10 @@
$(OUTDIR)WriteStream.$(O) WriteStream.$(H): WriteStream.st $(STCHDR) ../include/PositionableStream.$(H) ../include/PeekableStream.$(H) ../include/Stream.$(H) ../include/Object.$(H)
$(OUTDIR)WrongProceedabilityError.$(O) WrongProceedabilityError.$(H): WrongProceedabilityError.st $(STCHDR) ../include/SignalError.$(H) ../include/ProceedableError.$(H) ../include/Error.$(H) ../include/Exception.$(H) ../include/GenericException.$(H) ../include/Object.$(H)
# ENDMAKEDEPEND
+
+
+
+
+
+
+